C	PROGRAM BMAX6.FT
C	------------------
C
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C
C
C	NOV 14, 1977
C	JULY 11, 1977
C	JUNE 14, 1977
C	MARCH 31, 1977
C	FEB 25, 1977
C	FEB 16, 1977
C	FEB 14, 1977
C	FEB 7, 1977
C	JAN 20, 1977 /DELETED HELP SO NOW USE HELP.SV
C	NOV 10, 1976
C	OCT 19, 1976
C	OCT 18, 1976
C	OCT 15, 1976
C	OCT 8, 1976
C	OCT 1, 1976
C	SEPT 19, 1976
C	SEPT 18, 1976
C	SEPT 17, 1976
C	SEPT 16, 1976
C	SEPT 15, 1976
C	SEPT 14, 1976
C	SEPT 13, 1976
C	SEPT 11, 1976
C	SEPT 9, 1976
C	SEPT 8, 1976
C	AUG 31, 1976
C
C	PURPOSE
C	-------
C	AUXILLARY PACKAGE NUMBER 6
C
C	IT HAS THE FOLLOWING OPERATIONS DIRECTED BY IVAL
C
C	IVAL	FUNCTION
C	----	--------
C	1	PARAMETERS
C	2	NOP ---
C	3	LOAD THRESHOLDS B,C
C
C
C	OPDEFS
C	------
S	OPDEF DETB 6420
S	OPDEF DETC 6421
C
S	OPDEF	HPR	6320
S	OPDEF	VPR	6322
S	OPDEF	HSR	6321
S	OPDEF	VSR	6323
C
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
C
C
C	A/D OPRS
S	OPDEF	ADCL	6530
S	OPDEF	ADLM	6531
S	OPDEF	ADST	6532
S	OPDEF	ADRB	6533
S	SKPDF	ADSK	6534
C
C
C	[0] ENTRY PT
S	ENTRY BMAX6
S BMAX6,	BLOCK 2
C
C
C	[0] DISPATCHER
	GOTO(1,2,3),IVAL
C
C	[1] PARAMETERS
C	IF /9 THEN PRINT KINFILE[[5:8] ON LPT: AND RETURN;
1	IF(ISW(36))98,99,98
98	WRITE(3,97)(KINFILE(IX),IX=5,8)
97	FORMAT(' [',3A2,'.',A2,']')
	GOTO 2047
C
C	SETUP THE PRINT OUTPUT DEVICE
99	LSNUM=1+IOUTSPOOL
	KDEVOUT=4
C
C	IF /8
C		THEN LSNUM_2, KDEVOUT_3;
	IA=ISW(35)
S	TAD \IA
S	SNA CLA
S	JMP \96 /NO
	LSNUM=2
	KDEVOUT=3
C
96	CALL BMAP(LENS,ZOOM,PUC,UNAME)
C
C	COPY SWITCHES TO LOCAL VARIABLES
	ISWP=ISW(16)
C
C	IF /R THEN ONLY PRINT THE Q-REGISTERS
	IX=ISW(18)
S	TAD \IX
S	SZA CLA
S	JMP \146 /ONLY PRINT Q-REGISTERS
C
C
C	IF /K THEN ONLY PRINT THE KNOBS
	I11=ISW(11)
S	TAD \I11
S	SZA CLA
S	JMP \150 /ONLY KNOBS
C
C
C	IF /M THEN ONLY PRINT THE MOTORS
	I12=ISW(13)
S	TAD \I12
S	SZA CLA
S	JMP \116 /ONLY THE MOTORS
C
C	IF /E THEN PRINT=ICNUM AND RETURN
	IX=ISW(5)
S	TAD \IX
S	SNA CLA
S	JMP \108
C
C	WRITE ICNUM AS MAGNITUDE NUMBER
	CALL DPCVRT(ICNUM,FA,-1)
	LSNEW=1
	DO 148 INDEX=1,LSNUM
	WRITE(LSNEW,147)FA
147	FORMAT(' =',F6.0)
148	LSNEW=KDEVOUT
	GOTO 2047
C
C
C	GET THE GENSYM NAME
108	IB=IGENSYM
S	TAD \IGENSYM#
S	DCA \IC
	IVAL=3
	CALL BMAX7
	CURSYM=FC
C
C
C	[1.1] LIST F&S
S	HPR
S	DCA \IX
S	VPR
S	DCA \IY
S	HSR
S	DCA \IX1
S	VSR
S	DCA \IY1
C
	IX=IBCD(IX,1)
	IY=IBCD(IY,1)
	IX1=IBCD(IX1,1)
	IY1=IBCD(IY1,1)
	FA=PUC*FLOAT(IX1)
	FB=PUC*FLOAT(IY1)
C
C	COMPUTE AREA:
	FC=FA*FB
C
C	GET THE /G FLAG
	IX1=ISW(7)
C
	LSNEW=1
	DO 107 INDEX=1,LSNUM
	WRITE(LSNEW,109)CURSYM
109	FORMAT(' GENSYM=',A6)
C
C	IF /G THEN DO PRINT ANYMORE IN THSI PRINT LOOP
S	TAD \IX1
S	SZA CLA
S	JMP \107
C
	WRITE(LSNEW,101)LENS,ZOOM,PUC,UNAME
101	FORMAT(' ',I3,'X OBJ., ',F7.3,'X ZOOM,',F7.4,' ',A6,'S/PIX.')
	WRITE(LSNEW,112)IX,IY,FA,FB,FC
112	FORMAT(' F&S (HP,VP,HS,VS)=(',I3,',',I3,',',F7.2,',',F7.2,
     1'), AREA=',F12.3,/)
107	LSNEW=KDEVOUT
C
C	IF /G THEN RETURN
S	TAD \IX1
S	SZA CLA
S	JMP \2047
C
S	JMS WAITKBD /TEST IF DONE
C
C
C	[1.2] LIST THE POST STATUS
C	IF NOT /P SWITCH
S	TAD \ISWP
S	SZA CLA
S	JMP \116
C
	SFILE(2)='BINARY'
	SFILE(1)='GRAY  '
	SEXT(2)='MASK  '
	SEXT(1)='GRAY  '
C
C	FORM A BINARY WORD AND SELECT WORD FOR SCANNING
	IA=IPSTA
S	TAD \IA
S	AND (0360
S	MQL
S	TAD \IPSTB
S	RTR; RTR
S	AND (0017
S	MQA
S	DCA \IA
C
	IB=IPSTA
S	TAD \IB
S	RTL; RTL
S	AND (0360
S	MQL
S	TAD \IPSTB
S	AND (0017
S	MQA
S	DCA \IB
C
	IC=IPSTA
S	TAD \IC
S	RTR;RTR
S	AND (0360
S	MQL
S	TAD \IPSTB
S	BSW; RTR
S	AND (0017
S	MQA
S	DCA \IC
C
C
C	NOW TEST FOR ACTIVE SELECTED BITS FOR ALL 8 BMS
	DO 102 IZ=1,8
	IX=IZ-1
C	NOW PICK OUT BITS AND SET FLAGS
S	TAD \IA
S	AND (0200
S	SZA CLA
S	IAC
S	DCA \KX
S	TAD \IA
S	RAL
S	DCA \IA
C
S	TAD \IB
S	AND (0200
S	SZA CLA
S	IAC
S	DCA \KY
S	TAD \IB
S	RAL
S	DCA \IB
C
S	TAD \IC
S	AND (0200
S	SZA CLA
S	IAC
S	DCA \KMODE
S	TAD \IC
S	RAL
S	DCA \IC
C
C
C	WRITE OUT STATUS IF ACTIVE
S	TAD \KY
S	SNA CLA
S	JMP \102 /NO
C
	FA=SFILE(KX+1)
	FB=SEXT(KMODE+1)
	LSNEW=1
	DO 151 INDEX=1,LSNUM
	WRITE(LSNEW,104)IX,FA,FB
104	FORMAT(' BM',I1,' ACT.; ',A6,' DATA MODE,
     1 POSTED AS ',A6,' QMT VIDEO.')
	WRITE(LSNEW,106)IX,(LSAVE(IY,IZ),IY=13,14)
106	FORMAT('     BM',I1,' [XP,YP]=[',I3,',',I3,']')
151	LSNEW=KDEVOUT
C	TEST IF WAIT
S	JMS WAITKBD
102	CONTINUE
C
C
	LSNEW=1
	DO 152 INDEX=1,LSNUM
	WRITE(LSNEW,105)
105	FORMAT(/)
152	LSNEW=KDEVOUT
C
C
C
C	[1.3] PRINT OUT THE STAGE COORDINATES - (LIKE READSTAGE)
C	GET "/N" TO PRINT AS STEPS RATHER THAN MICRONS
116	INSW=ISW(14)
	DO 110 MTRNUM=1,8
C	GET THE  VALUES OF ZOOM, X,Y,Z FROM BMAP IF /U
C	ALWAYS DO IT
C
C
C
C
C		[1.3.1] DO THE EIGHT MOTORS
		DO 115 IZ=1,2
C		COPY CURREN
115		IVAL(IZ)=MDPDATA(IZ+6,MTRNUM)
C
C
C		[1.3.2] CONVERT IVAL TO FC
C		CONVERT TO NUMBER FORMAT
		CALL DPCVRT(IVAL,FC,-1)
		CURSYM='MICRON'
C
C		GET FROM BMAP
		GOTO(161,162,163,164,165,166,167,167),MTRNUM
C
C		[1.3.3] GET FROM BMAP
C		WAVELENGTH IN NANOMETERS
161		CURSYM=' NM.  '
		GOTO 169
C
C		NEUTRAL DENSITY IN O.D.
162		CURSYM=' O.D. '
		GOTO 169
C
C		ZOOM
163		FC=ZOOM
		CURSYM=' X    '
S		TAD \INSW /IF /N THEN USE # STEPS
S		SNA CLA
S		JMP \169 /NOT /N, USE POWER
		FC=IVAL
		GOTO 169
C
C		FOCUS
S\164,	TAD \INSW
S		SZA CLA
S		JMP \169 /"/N" USE STEPS
		FC=FC*0.200
		GOTO 169
C
C		Y
S\165,		TAD \INSW
S		SZA CLA
S		JMP \169 /"/N" USE STEPS
		FC=FC*0.506
		GOTO 169
C
C		X
S \166,		TAD \INSW
S		SZA CLA
S		JMP \169 /"/N" USE STEPS
		FC=FC*0.509
		GOTO 169
C
C		T1 AND T2
167		CURSYM='/0:255'
		FC=FC/16.0
C
C
C		[1.3.4] PRINT A MOTORS POSITION
C		LOOKUP THE MOTOR NAME
S \169,		CLA CMA
S		TAD \MTRNUM
S		TAD PMNAME /POINTER TO MNAME ARRAY
S		DCA 7
S		TAD I 7
S		DCA \IX1
		IX2=9-MTRNUM
C
C		IF /N THEN PRINT AS STEPS
S		TAD \INSW
S		SNA CLA
S		JMP \190 /NOT /N, USE MICRONS
		CURSYM=' STEPS'
C
190		LSNEW=1
		DO 153 INDEX=1,LSNUM
		WRITE(LSNEW,111)IX2,IX1,FC,CURSYM
111		FORMAT(' [',I2,':',A2,']=',F10.3,' ',A6)
153		LSNEW=KDEVOUT
C
C	WAIT FOR KBD
S	JMS WAITKBD
110	CONTINUE
C
C	IF /M THEN RETURN NOW
S	TAD \I12
S	SZA CLA
S	JMP \2047 /RETURN
C
C
C	[1.4] IF NOT /P THEN MP THE KNOBPOTS AND LIST Q-REGISTERS
S \150,	TAD \ISWP
S	SZA CLA
S	JMP \2047 /NO
C
C	YES,
	LSNEW=1
	DO 140 INDEX=1,LSNUM
	WRITE(LSNEW,105)
	DO 141 IX1=1,8
C	GET THE KNOB POT VALUES==>IBUF1[1:8]
S	ADCL
S	TAD \IX1
S	TAD (7 /10:17
S	ADLM
S	ADST
S ADWAIT,	ADSK
S	JMP ADWAIT
S	ADRB
S	TAD (1000
S	CLL RAR /0:511
S	DCA \IZ
	IBUF1(IX1)=IZ
	IX=IX1-1
S	JMS WAITKBD
	WRITE(LSNEW,142)IX,IBUF1(IX1)
142	FORMAT(' KNOB[',I1,']=',I4)
C	WAIT FOR KBD
S	JMS WAITKBD
141	CONTINUE
140	LSNEW=KDEVOUT
C	IF /K THEN RETURN NOW
S	TAD \I11
S	SZA CLA
S	JMP \2047 /RETURN NOW
C
C	PRINT BLANK LINE
	WRITE(LSNEW,105)
C
C
C
C	[1.5] PRINT THE Q-REGISTERS
146	LSNEW=1
	DO 143 INDEX=1,LSNUM
	DO 144 IX=1,26
	IA=ITMPSTK(IX)
	IZ=IQREG(IX)
S	TAD \IZ
S	DCA \IA#
	CALL DPCVRT(IA,FA,-1)
S	TAD \IX
S	BSW
S	DCA \IZ
S	JMS WAITKBD
	WRITE(LSNEW,145)IZ,FA
145	FORMAT(' Q-REG[',A1,']=',F7.0)
144	CONTINUE
143	LSNEW=KDEVOUT
C
S \2047,	RETRN BMAX6
C
C
C
C	****POINTERS****
S PMNAME,	MNAMES
S	CPAGE 10
S MNAMES,	TEXT /WVNDZOFOY X T1T2/
C	[2] --FREE--
2	CONTINUE
	GOTO 2047
C
C	[3] LOAD THRESHOLDS B,C
3	CONTINUE
S	TAD \ICNUM
S	AND (3777
S	TAD (-D255
S	SMA
S	CLA
S	TAD (D255 /CLIP TO 255
S	RTL;RTL
S	AND (7760
S	DCA \IB
S	TAD \IB
S	DETB
C
S	TAD \ICNUM#
S	AND (3777
S	TAD (-D255
S	SMA
S	CLA
S	TAD (D255
S	RTL;RTL
S	AND (7760
S	DCA \IB#
S	TAD \IB#
S	DETC
C
C	UPDATE COMMON DESIRE AND CURRENT
	DO 300 IX1=1,2
	MTRNUM=6+IX1
C	DO FOR CURRENT AND DESIRE LOW
	DO 300 IY1=5,7,2
300	MDPDATA(IY1,MTRNUM)=IB(IX1)
	GOTO 2047
C
C
C
C	**************************************************
C	* SUBROUTINE     W A I T K B D                  *
C	**************************************************
C	TEST FOR ^O AND ^S
S	CPAGE 3
S RWAITKBD,	JMP I WAITKBD
S WAITKBD,	0
S	6034 /KRS
S	AND (177
S	TAD (-23 /^S
S	SNA CLA
S	JMP WAITKBD# /NOT YET
C
S	6034
S	AND (177
S	TAD (-17 /^O
S	SZA CLA
S	JMP RWAITKBD /RETURN
C
C	TERMINATE THIS STUFF
	GOTO 2047
C
	END