C	PROGRAM BMAX9.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	APRIL 26, 1977
C	APRIL 22, 1977
C	FEB 25, 1977 /SHORTED SOME COMMENTS IN OUTPUT
C	OCT 18, 1976
C	OCT 14, 1976
C	SEPT 22, 1976
C	SEPT 21, 1976
C	SEPT 20, 1976
C	SEPT 19, 1976
C	SEPT 18, 1976
C	SEPT 17, 1976
C	SEPT 16, 1976
C
C	PURPOSE
C	-------
C	AUXILLARY PACKAGE NUMBER 2
C
C	QDATA - DO QMT DATA ACQUISITION
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	HPL	6360
S	OPDEF	VPL	6362
S	OPDEF	HSL	6361
S	OPDEF	VSL	6363
S	OPDEF	HPR	6320
S	OPDEF	VPR	6322
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
S	OPDEF	FBW3	6343
S	SKPDF	SKPKPD	6313
S	OPDEF	RKYPDH	6340
S	OPDEF	RKYPDL	6353
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	QPROG7	6433
S	OPDEF	QSTAT	6374
C
S	OPDEF	LQDT1	6375
S	OPDEF	LQDT2	6376
S	OPDEF	QDAT1	6324
S	OPDEF	QDAT2	6325
S	OPDEF	STQMT	6300
S       OPDEF CSRGI 6315 /ZERO THE SRG INDEX CNTR
S       OPDEF ZSRGI 6316 /ADVANCE THE SRG INDEX CNTR
C                        /AND SRG TO 0.(MOVE DATA TO FRONT).
S	OPDEF IZSKP 6317 /TEST IF ZSRGI IS DONE
S       OPDEF RSRGI 6332 /READ SRGI==>AC
S       OPDEF RSRGX 6330 /READ SRGI X-ACP FRONT==>AC
S       OPDEF RSRGY 6331 /READ SRGI Y-ACP FRONT==>AC
S       OPDEF RFC1H 6334 /READ SRGI FUNC.1 MSW FRONT==>AC
S       OPDEF RFC1L 6335 /READ SRGI FUNC.1 LSW FRONT==>AC
S       OPDEF RFC2H 6336 /READ SRGI FUNC.2 MSW FRONT==>AC
S       OPDEF RFC2L 6337 /READ SRGI FUNC.2 LSW FRONT==>AC
S       OPDEF ADVSR 6314 /ADVANCE THE SRG
S       OPDEF QSTAT 6374 /LOAD THE QMT STATUS REGISTER
S       OPDEF RQSTAT 6327 /READ THE QMT STATUS REG==>AC
S	SKPDF	QMSKP	6301
C
C
S	OPDEF	READGP	6146
S	SKPDF	GPSKP	6141
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DCM	7575
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DPIC	7573
S	OPDEF	CAM	7621
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
S	OPDEF	IOCLR	6007
C
C
C	[0] ENTRY PT
S	ENTRY BMAX9
S BMAX9,	BLOCK 2
C
C
C	[1] QDATA - GET AND PRINT QMT DATA
C	GET THE CALIB COEFF
	CALL BMAP(LENS,ZOOM,PUC,UNAME)
C
C	SETUP THE NAME TABLE
	DO 100 IPROGRAM=1,7
	J=(IPROGRAM-1)*3
S	TAD PNTBL
S	TAD \J
S	DCA NARG#
S	CALL 1,FAD
S NARG,	ARG NTBL
S	CALL 1,STO
S	ARG \CURSYM
100	SDEVICE(IPROGRAM)=CURSYM
C
	ISERIAL=ISERIAL+1
C	SAVE /W SWITCH
	KWC=ISW(23)
C
C
C	CLEAR KEYPAD
S	RKYPDL
S	RKYPDH
S	CLA
C
C
C	[1.1] PROGRAM FC1/FC2 6X10 IN QPROG7 PROGRAMS FC1=X, FC2=AREA
C	ISW(28) EQV /1
C	DEFAULT IS AREA,AREA
	IPROGRAM=2
S	TAD (0210
S	MQL
S	TAD \IFILTOP /COMMON SAVED STATUS
S	AND (6000
S	MQA
S	DCA \IFILTOP
S	TAD \IFILTOP
S	QPROG7
	DO 14 IX=28,34
	IY=ISW(IX)
S	TAD \IY
S	SNA CLA
S	JMP \14
C	OK, LOAD THE QPROG WORD
S	TAD \IX
S	TAD (-D27 /1:7
S	DCA \IPROGRAM
S	TAD \IPROGRAM
S	BSW /MOVE TO LEFT BYTE
S	AND (0700
S	TAD (0010 /PROGRAM  FC1=IX-27,FC2=AREA
S	QPROG7
14	CONTINUE
C
C	SETUP THE FUNCTION NAME
	FILE=SDEVICE(IPROGRAM)
C
C	[1.1.1] RUN THE QMT
S	CSRGI
S	RQSTAT
S	MQL
S	TAD (0400
S	QSTAT
S	STQMT
S QS,	QMSKP
S	JMP QS
S	MQA
S	QSTAT /RESTORE
C
C
C	[1.1.2] GET THE NUMBER OF DATUMS AND PUT INTO K
S	RSRGI
S	DCA \K
S	TAD \K
S	DISP1
C
C
C	[1.1.3] ADVANCE THE STACK
S	ZSRGI
S MQD,	IZSKP
S	JMP MQD
C
C
C	[1.2] DO WHOLE FIELD
S	QDAT1
S	DCA \IB
S	QDAT2
S	DCA \IA
C
C	CONVERT BCD TO INTEGER AND THEN TO FLOATING IN DATA.
S	JMS BCDTOFLOAT
C
C	IF /2 (AREA) THEN COMPUTE MICRONS SQ.
S	TAD \IPROGRAM
S	TAD (-2
S	SNA CLA
S	IAC
S	IAC
S	DCA \IA
	DO 501 LSNEW=1,IA
501	CURSYM=PUC*CURSYM
C
C
C	[1.2.1] GET THRESHOLDS SCALED TO 0:255
	DO 502 MTRNUM=7,8
502	IA(MTRNUM-6)=MDPDATA(7,MTRNUM)
C
C	CVT TO 0:255
S	TAD \IA
S	RTR;RTR
S	AND (377
S	DCA \IA
S	TAD \IA#
S	RTR;RTR
S	AND (377
S	DCA \IA#
C
	LSNUM=1+IOUTSPOOL
	LSNEW=1
	DO 101 INDEX=1,LSNUM
	WRITE(LSNEW,102)FILE,CURSYM,K,ISERIAL,LENS,ZOOM,UNAME,IA
102	FORMAT(/,' FIELD ',A6,' =',F10.3,',',I5,' OBJS., SEQ. #=',I5,/
     1,' ',I3,'X',', ',F5.2,'X ZOOM,',A6,'S, THB:C=[',I3,':',I3,']')
101	LSNEW=4
C
C
C	[1.3] IF /F THEN DO FUNCTION COMPUTER ELSE DO WHOLE FIELD
	IF(ISW(6)) 10,2047,10
C
C
C	[1.4] WRITE OUT FOR FUNCTION COMPUTER
10	CONTINUE
C	COMPUTE THE FLOATING SIZES
	IVAL=ICNUM
S	DCA \IVAL#
	CALL DPCVRT(IVAL,DMIN,-1)
C
C
C	[1.4.1] SETUP SIZING FOR CDSPEC
C	IF ICNUM(2)=0 THEN MAKE DMAX (HIGH SIZE)=1777&0000;
S	TAD \ICNUM#
S	DCA \IVAL
S	TAD \IVAL
S	SNA CLA
S	TAD (1777
S	DCA \IVAL#
	CALL DPCVRT(IVAL,DMAX,-1)
C
C
C	[1.4.2] SET UP OPT. N,D IF /H
	INUMERATOR=ICNUM(3)
S	TAD \INUMERATOR
S	SNA
S	CLA IAC
S	DCA \INUMERATOR
C
	IDENUMERATOR=ICNUM(4)
S	TAD \IDENUMERATOR
S	SNA
S	CLA IAC
S	DCA \IDENUMERATOR
C
C	[1.5] CHECK ALL SEGMENTS
	J=0
	DO 199 I=1,K
C
C
C	[1.5.1] SHOW THE SEGMENT # LOOKING AT
S	TAD \K
S	DISP2 /SHOW THE SEGMENT LOOKING AT
C
C
C	[1.5.2] GET FC1 DATA
S       RFC1H
S	DCA \IA
C
S       RFC1L
S	DCA \IB
C
C
C	DISPLAY IN RIGHT QMT DISPLAY
S	TAD \IA
S	LQDT2 /HIGH
S	TAD \IB
S	LQDT1 /LOW
C
S	JMS BCDTOFLOAT
	FA=CURSYM
C
C
C	[1.5.3] GET FC2 DATA
S       RFC2H
S	DCA \IA
C
S       RFC2L
S	DCA \IB
C
S	JMS BCDTOFLOAT
	FB=CURSYM
C
C
C
C	[1.5.4] GET X,Y DATA
S       RSRGX
C@ ****NOTE: PROBLEM - THE FUNCTION COMPUTER ACP CALLED THE
C@ ***"FUNCTION COMPUTER STROBE" IS DELAYED P+17
C@ ***PICTURE POINTS. THEREFORE, (IF THE NUMBER 17 IS CORRECT)
C@ ***WE MUST SUBTRACT THIS FROM THE X ACP COORDINATE.
S       TAD (-D17 /***POSSIBLE CONSTANT*** - CHECK LATER
S       DCA \IX
C
S       RSRGY
S	AND (1777
S	DCA \IY
C
C	PUT THE CURSOR AT THIS POINT
S	TAD \IX
S	LDXP
S	TAD \IY
S	LDYP
C
C
C	ADVANCE TO NEXT DATA ENTRY
S       ADVSR
C
C	[1.5.5] EDIT POINT
	LSUCLASS=0
C	CONVERT TO MICRONS IF /U
	FB=PUC*PUC*FB
C	DO NOT CVT DENSITY
	IF(IPROGRAM-1)211,214,211
211	FA=PUC*FA
C
C	IF AREA (/2) THEN FA IS MICRONS SQ
C	POSSIBLY CVT TO MICRONS IF /U, ELSE LEAVE AS (1.00) PIXELS
	IF(IPROGRAM-2)214,213,214
213	FA=PUC*FA
C
214	FC=FA/FB
C	IF /Q THEN COMPUTE FC1*FC1/A INSTEAD OF FC1/A
	IF(ISW(17)-1)183,184,183
184	FC=FC*FA
183	CONTINUE
C
C
C
C
C	[1.5.5.1] TEST IF (DMIN < FA LEQ DMAX)
C		 THEN RELEASE FOR FURTHER EDITING
	CURSYM=FA-DMIN
S	TAD \CURSYM
S	SPA CLA
S	JMP \199
C
	CURSYM=DMAX-FA
S	TAD \CURSYM
S	SPA CLA
S	JMP \199
C
C
C
C	[1.5.5.2] IF /W SWITCH 
C		THEN WAIT FOR FBW3[0]=1 TO ACCEPT, FBW3[1]=1 TO REJECT.
S	TAD \KWC
S	SNA CLA
S	JMP \160 /NO SWITCHES NEEDED
S HOLD,	FBW3
S	AND(4000 /BIT 0
S	SZA CLA
S	JMP \160 /OK, PASS IT ON
C
S	FBW3
S	AND (2000 /BIT 1 = ERASE IT
S	SZA CLA
S	JMP W1KBD /ERASE IT
C
C	IF FBW3[11]=1 THEN RETURN
S	FBW3
S	AND (0001
S	SZA CLA
S	JMP \2047 /EXIT
S	JMP HOLD /KEEP WAITING
C
C
C	[1.5.5.3] IF /K THEN GET THE CLASS KEY ELSE ACCEPT
160	IF(ISW(11)) 161,13,161
S \161,	TAD (4040 /SPACE
S	DCA \IZ
	WRITE(1,162)IZ
162	FORMAT(' KEYPAD#?',A1)
S KW,	SKPKPD
S	JMP KW
C
	IA=0
S	RKYPDL
S	DCA \IB
S	RKYPDH /CLEAR KEYPAD
S	CLA
C
C	TEST IF 0, THEN ERASE IT
S	TAD \IB
S	SNA CLA
S	JMP W1KBD /ERASE IT
C
C	NO, COMPUTE THE CLASS # BCD==>DECIMAL
S	JMS BCDTOFLOAT
	LSUCLASS=CURSYM
C
C
C	[1.5.6] PRINT THE DATUM
13	J=J+1
C
	LSNUM=1+IOUTSPOOL
	LSNEW=1
	DO 12 INDEX=1,LSNUM
	WRITE(LSNEW,11)J,FILE,FA,FB,FILE,FC,IX,IY,LSUCLASS(1)
11	FORMAT(' [',I3,']',A6,'=',F9.2,',A=',F9.2,',',A6,'/A='
     1,F10.3,',(X,Y)=',I3,I4,',C=',I3)
12	LSNEW=4
C
C
C	[1.5.7] IF /H THEN UPDATE IH[IA_SCALE*FC]_IH[IA]+1
	IA=ISW(8)
S	TAD \IA
S	SNA CLA
S	JMP W1KBD /NO /H, CONTINUE
C
	IA=FLOAT(INUMERATOR)*FC/FLOAT(IDENUMERATOR)
C
S	TAD \IA
S	CLL RAL /X2
S	AND (777
S	TAD PIH
S	DCA DOIH
S	TAD DOIH
S	DCA DOIH2
S	SWAB
S	CPAGE 10
S	DCA \IA /FORCE DATA FIELD TO COMMON
S	DAD
S DOIH,	0
S	DPIC
S	DST
S DOIH2, 0
S	SWBA
S	CAM
C
C
C	[1.6] TEST IF WAIT HERE OR EXIT
C	TEST FOR ^S,^O
SW1KBD,	6034
S	AND (177
S	TAD (-17 /CONTROL/O
S	SNA CLA
S	JMP \2047 /DONE
C
S	6034
S	AND (177
S	TAD (-23 /^S
S	SNA CLA
S	JMP W1KBD
199	CONTINUE
C
C
C	[1.7] RETURN
S\2047,	RETRN BMAX9
C
C
C	*****SUBROUTINE    B C D T O F L O A T   ****
S	CPAGE 3
S RBCDTOFLOAT,	JMP I BCDTOFLOAT
S BCDTOFLOAT,	0
	CURSYM=FLOAT(IBCD(IA,0))*1000.0 + FLOAT(IBCD(IB,0))
S	JMP RBCDTOFLOAT
C
C
C
C	****PARAMTERS****
S PIH,	\IH /POINTER
C
S PNTBL,	NTBL
S	CPAGE 25
S NTBL,	TEXT /DENS. AREA  PERIM.V PROJH PROJH FEREV FERE/
C
	END