C	PROGRAM FLICKER.FT
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	JUNE 19, 1978
C	JUNE 15, 1978
C	JUNE 12, 1978
C	JUNE 8, 1978
C	JUNE 7, 1978
C	JUNE 1, 1978
C	MAY 30, 1978
C	MAY 26, 1978
C	MAY 25, 1978
C	MAY 24, 1978
C	MAY 10, 1978
C	MAY 9, 1978
C	MAY 8, 1978
C	MAY 5, 1978
C	MAY 4, 1978
C
C
C
C	INTRODUCTION
C	------------
C	FLICKER.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	IBM2,IHGH2, JBM, JHGH  VARIABLES IN COMMON. COMMON IS RESTORED
C	FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS
C	EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON
C	IS SAVED AND BMON2 IS CHAINED BACK TO.
C	ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED
C
C
C	*FLICKER, (Opt. calibration starting sample # (default 1) from
C	from 1 to 4 for which to compute the regression calib.), (Opt /A
C	/B, /F, /M)-
C	Flicker a 512x512 size low image memory (BM0:3) 
C	against high image memory (BM0H:3H). Also allow immediate (from
C	TV camera) 512x512 image acquisition into either low or high
C	image memory from the frame and scale (F&S) position.
C	The F&S position is used to position the high (BM0H:3H) while
C	the low image remains in a standard position during flickering.
C	Using the GraphPen, a posted image may be labeled with black
C	sequential letters inside a 14x14 pixel square. The low image
C	is labled in the Logical Coordinate System (LCS) where
C	(x,y) = (0,0) is the upper left hand corner, and (860,700) is the
C	lower right hand corner. The high image is labled with the offset
C	of the F&S added to it as follows:
C		LCS + (Position(Low image) - Position(F&S)).
C	The (x, y, density, high or low image name) is saved in a list.
C	After a list is generated, the distance matrix D of the absolute
C	Euclidian distances between all points in the list may be
C	generated and printed (as well as (x,y,density, image name)).
C	After a difference matrix is generated for one posted image,
C	the matrix may be saved and the posted images restored from
C	the copies (previously saved when the GETs were performed). After
C	acquiring Dn+1, the relative difference matrix of Dn+1 and Dn 
C	may be computed and printed.
C
C	A boundary drawing mode is alternatively available which permits
C	drawing the convex hull around a region. After which various features
C	are computed and printed. These include: area, density, density/area,
C	perimeter, (perimeter**2)/area, boundary length, minimum
C	enclosing rectangle and relative position of 512x512 in LCS,
C	and 1st order moments.
C
C	If the /A switch is used, the microscope stage is actived from the
C	joystick. In addition, when the list of features is printed upon 
C	extracting a region by drawing a boundary with the GraphPen, the 
C	absolute stage position is also printed.
C
C	If /B, then backup the BM0:3's ==>BM4:7's on initial entry.
C
C	If /M then use Merrill's calibration values during calibration.
C
C	If /F then use Freeze's calibration values during calibration.
C
C	If calibratng and neither /F or /M is specified, then
C	get the 6 values from the command decoder specified as:
C		*(mantissa*100), exponent
C	MENU FBW3	FUNCTION
C	----------	--------
C	0 OR FBW4[0]	FLICKER low and high [BM0:3/BM0H:3H] 0.2/sec.
C
C	1		UNPOST currently posted image.
C
C	2		POST low image.
C
C	3		POST high image.
C
C	4		RESET standard F&S, BMs positions, print menu
C			backup the current distance matrix.
C
C	5		TOGGLE on/off GraphPen  mode. When active
C			COMMAND KEYS (FBW2) are active.
C
C	6		RESTORE backed up high and low images
C			from BM4:7L/H.
C
C	7		GET low image at F&S position and back it up
C			in BM4:BM7.
C
C	8		GET high image at F&S position and back it up
C			in BM4H:7H.
C
C	9		Print all labeled points (x,y,density,image name).
C			Compute and print distance matrix of all points
C			2/time.
C	10		Compute and print relative difference matrix RD of 
C			current distance matrix Dn+1 and previous distance
C			matrix Dn. Note Dn was saved when the Reset (key 4) 
C			was pressed after it was generated. 
C			Note n must be > 0. The RD matrix element
C			is defined as:
C				rd(i,j,n+1) = d(i,j,n+1)-d(i,j,n);
C
C	11		EXIT to BMON2.
C
C
C	COMMAND KEYS
C	MENU FBW2	FUNCTION
C	----------	--------
C	0		Enable GraphPen for drawing a boundary in the
C			currently posted image. This destroys the other
C			image in the other 1/2 of the image.
C
C	1		If boundary drawing mode 
C			   Then ERASE the currently drawn image backwards.
C
C	5		If boundary drawing mode
C			   Then CLOSE it. Also compute convex hull of
C			   the boundary, compute and print its:
C				area, density, density/area, perimeter,
C				perimeter**2/area, boundary length,
C				min. encl. rectangle, hor size, vert. size.
C
C	6		Enable mark mode (close boundary drawing mode
C			if open). Pressing the pen records up to
C			18 points labeled in the currently posted
C			image as letters A:P inside of squares.
C
C	7		Start CALIBRATION boundary drawing mode for
C			calibration samples (1 TO 6). Use Key 5 to
C			enter each circled sample's total density. Note:
C			Sample	counts/min
C			------	----------
C			  6    6.00E5
C			  5    5.80E4
C			  4    6.18E3
C			  3    7.00E2
C			  2    1.00E2
C			  1    5.10E1
C
C			After all 6 entries have been entered by drawing
C			the boudaries, the calibration of radiation
C			standards for samples (1 TO 6) is plotted as
C			Log(counts/min) against Log(total density) for each 
C			of the 6 samples. The samples appear as labeled squares.
C			It then fits a minimum square error line on these
C			points.

C
C	OPDEFS
C	------
S	OPDEF	POSTA	6520
S	OPDEF	POSTB	6521
C
S	OPDEF	HPR	6320
S	OPDEF	HSR	6321
S	OPDEF	VPR	6322
S	OPDEF	VSR	6323
C
S	OPDEF	HPL	6360
S	OPDEF	VPL	6362
S	OPDEF	HSL	6361
S	OPDEF	VSL	6363
C
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DAD	7443
S	OPDEF	DCM	7575
S	OPDEF	DST	7445
S	OPDEF	CLAMQ	7621
S	OPDEF	MUY	7405
S	OPDEF	SHL	7413
S	OPDEF	DVI	7407
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	LFBW2	6437
S	OPDEF	FBW3	6343
S	OPDEF	FBW4	6344
C
C
S	OPDEF	BMX0	6500
S	OPDEF	BMY0	6504
C
S	OPDEF	GETA	6522
C@S	OPDEF	GETB	6523
S	OPDEF	LQDT1	6375
S	OPDEF	LQDT2	6376
S	OPDEF	LQDT3	6377
S	OPDEF	STQMT	6300
S	SKPDF	QMSKP	6301
C
C
S	OPDEF	READGP	6146
S	SKPDF	GPSKP	6141
S	OPDEF	FBW12	6352
C
C	NOTE:  THE SDEVICE[1:2] COMMON VARIABLE IS USED TO
C	SAVE THE STATE OF THE REGRESSION EQUATION COEFFICIENTS (FM,B).
C	[1] GLOBAL INITIALIZATION
	LCNT=0
C	SAVE F&S IN IPSTK,IOPSTK
S	HPR
S	DCA \IPSTK
S	VPR
S	DCA \IPSTK#
S	HSR
S	DCA \IOPSTK
S	VSR
S	DCA \IOPSTK#
C
C	ZERO GLOBAL FEATURE COUNTER
	LSUCLASS=0
C
C	CLEAR CALIBRATION MODE
	MODECAL=1
C
C	SET THE STARTING POINT CALIBRATION SAMPLE TO 1 MAX 4
C	IF NOT (1 LEQ ICNUM(1) LEQ 4)
S	TAD \ICNUM
S	SNA 
S	CLA IAC /+1
S	TAD (-D5
S	SMA
S	CLA IAC /SET TO 4
S	TAD (D5
S	DCA \ICNUM
C
C
C	IF /B
C		THEN BACKUP BM0L/H:BM3L/H ==>BM4L/H:BM7L/H;
S	TAD \ISW#
S	SNA CLA
S	JMP \100 /NO
C	YES
	DO 99 I10=1,4
	MEM=I10-1
S	TAD \I10
S	DISP2
	DO 99 I11=1,2
	IBYTE=I11-1
S	TAD \I11
S	DISP1
	DO 99 IY1=1,256,3
	IY=IY1-1
	MEM=(I10-1)
	CALL T3BUF(IBUF1,0)
	MEM=(I10-1)+4
99	CALL T3BUF(IBUF1,1)
C
C
C	[1.1] LOCAL INITIALIZATION
100	LCNT=LCNT+1
	IZ=ICNUM
	DO 98 LSNEW=1,3,2
98	WRITE(LSNEW,995)IZ,(SDEVICE(IX),IX=1,2)
995	FORMAT('1 FLICKER 6/19/78 - 1:06PM, 1ST CAL. POINT=',I2,
     1,/,' OLD CALIB. REGRESSION M=',F7.3,', B=',F8.2)
	CALL DAYTIME(3)
C
	WRITE(1,123)
123	FORMAT(/,' CLASS KEYS',/,' 0 - FLICKER',/' 1 - UNPOST',/
     1,' 2 - POST LOW',/,' 3 - POST HIGH',/' 4 - RESET POSITIONS',
     2/,' 5 - TOGGLE PEN ON/OFF')
	WRITE(1,124)
124	FORMAT(' 6 - RESTORE BMS',/,' 7 - GET LOW'
     1,/,' 8 - GET HIGH',/,' 9 - COMP. DISTS.',/,' 10 - COMP. DIFFS.'
     2,/,' 11 - EXIT BMON2')
C
C
C	[1.1.1] SET UP STD POSITIONS
	KX=184
	KY=131
	IXPOSITION=KX
	IYPOSITION=KY
S	JMS SETBMS
C
C
C	[1.1.2] POSITION F&S AT IXPOSITION, IYPOSITION
S	TAD (0611 /189 BCD
S	HPL
S	TAD (0461 /131 BCD
S	VPL
C
C
C	[1.1.3] UNPOST BMS
S	POSTA
S	POSTB
	K8BIT=-1
C
C
C	[1.1.4] TURN OFF GRAPHPEN
	MODEPENACTIVE=0
C	CLEAR COUNTER
	INDEX=0
C	ZERO QMT RIGHT DISP REGISTER
S	LQDT1
S	LQDT2
S	LQDT3
C
C
C	[1.1.5] BACKUP IBUF3/4[1:36] INTO
C	101:136. TO SAVE (X,Y,DENSITY,HIGH/LOW) DATA/POINT STACK.
	DO 140 IZ=1,36
	I18=IZ+100
	IBUF3(I18)=IBUF3(IZ)
140	IBUF4(I18)=IBUF4(IZ)
C
C
C	[2] MONITOR LOOP
200	CONTINUE
C	LOAD F&S WITH 512X512
S	TAD (2422 /512 BCD
S	HSL
S	TAD (2422 
S	VSL
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /EXIT
C
C
C	[2.1] MOVE THE HIGH BMS ACCORING TO THE F&S
S	HPR
S	JMS BCDDEC
S	DCA \KX1
C
S	VPR
S	JMS BCDDEC
S	DCA \KY1
C
C	POSITION ACCORDING TO WHICH IS POSTED
	IZ=K8BIT+1
	GOTO (1100,1101),IZ
1100	IXPOSITION=KX
	IYPOSITION=KY
	GOTO 1102
1101	IXPOSITION=KX1
	IYPOSITION=KY1
S\1102,	JMS SETBMS
C
C
C
C	[2.2] CHECK FBW3[0] OR FBW4[0] KEYS
S	FBW4
S	AND (4000
S	MQL
S	FBW3
S	AND (4000 /BIT 1 TO FLICKER
S	MQA
S	SNA CLA
S	JMP \223 /NO
C
C	YES, GO FLICKER
C	IF K8BIT < 0
C		THEN K8BIT=0
S	TAD \K8BIT
S	SPA
S	CLA
S	DCA \K8BIT
C
C	DISPLAY LOW (K8BIT=0) OR HIGH (K8BIT=1)
S	TAD \K8BIT
S	SZA CLA
S	TAD (7400 /HIGH BMS
S	TAD (0017 /BM0:3
S	POSTA
C
C	WAIT FOR QMT
S	STQMT
S WQMT,	QMSKP
S	JMP WQMT
C
C	ALTERNATE LOW AND HIGH IMAGES
	K8BIT=1-K8BIT
C
C
C	[2.3] IF FBW3[1] THEN UNPOST/A TURN OFF GRAPHPEN
S\223,	FBW3
S	AND (2000
S	SNA CLA
S	JMP \224 /NO
S	POSTA /UNPOST/A
	MODEPENACTIVE=0
	K8BIT=-1
S	JMS WAITWHILE
C
C
C	[2.4] IF FBW3[2] THEN POST/A
S\224,	FBW3
S	AND (1000
S	SNA CLA
S	JMP \225 /NO
S	TAD (0017
S	POSTA
S	JMS WAITWHILE
	K8BIT=0
C	SET FRAME POSITION
	IXPOSITION=KX
	IYPOSITION=KY
S	JMS SETBMS
C
C
C	[2.5] IF FBW3[3] THEN POST/A/H
S\225,	FBW3
S	AND (0400
S	SNA CLA
S	JMP \226
S	TAD (7417
S	POSTA
	K8BIT=1
S	JMS WAITWHILE
C	SET FRAME POSITION
	IXPOSITION=KX1
	IYPOSITION=KY1
S	JMS SETBMS
C
C
C	[2.6] IF FBW3[4] THEN RESET STD POSITIONS
S\226,	FBW3
S	AND (0200
S	SZA CLA
S	JMP \100 /GOTO [1.1]
C
C
C	[2.7] IF FBW3[5] THEN TOGGLE ON/OFF GRAPHPEN
S	FBW3
S	AND (0100
S	SNA CLA
S	JMP \228 /NO
	MODEPENACTIVE=1-MODEPENACTIVE
S	JMS WAITWHILE /WAIT ABOUT A SECOND
C	PRINT APPROPRIATE MSG
	LSNEW=MODEPENACTIVE+1
	GOTO(1260,1261),LSNEW
C	NO PEN
S\1260,	LFBW2 /ZERO LIGHTS
	WRITE(1,123)
	WRITE(1,124)
	GOTO 228
C	NEW PEN MODE
S\1261,	CLA CMA /ALL LIGHTS
S	LFBW2
	WRITE(1,1265)
1265	FORMAT(/,' CMD KEYS',/,' 0 - DRAW BND.',/
     1,' 1 - ERASE BND',/,' 5 - CLOSE BND',/,' 6 - MARK MODE')
	WRITE(1,1266)
1266	FORMAT(' 7 - START CALIB.')
C
C
C	[2.8] IF FBW3[6] THEN RESTORE BMS 0:3L/H FROM BM4:7L/H
S\228,	FBW3
S	AND (0040
S	SNA CLA
S	JMP \229 /NO
S	JMS WAITWHILE
C	RESTORE ALL BM'S
	DO 528 I=1,4
S	TAD \I
S	DISP1
	DO 528 IY1=1,256
	IY=IY1-1
S	TAD \IY
S	DISP2
	DO 528 JBYTE=1,2
	IBYTE=JBYTE-1
C	READ BM(I+3)(JBYTE-1)
	MEM=I+3
	CALL T3BUF(IBUF1,0)
C
C	WRITE BM(I-1)(JBYTE-1)
	MEM=I-1
	CALL T3BUF(IBUF1,1)
528	CONTINUE
C	ALSO DO FRAME AND POINTER RESET, PRINTING MENU AT [1.1]
	GOTO 100
C
C
C	[2.9] FBW3[7] TO GET/A,BM0:3
S\229,	FBW3
S	AND (0020
S	SNA CLA
S	JMP \1210 /NO
C	SET FRAME POSITION
	IXPOSITION=KX
	IYPOSITION=KY
S	JMS SETBMS
C
S	TAD (0017
S	GETA
S	STQMT
S WQ2,	QMSKP
S	JMP WQ2
S	JMS WAITWHILE
C	BACKUP BM0:3==>BM4:7
	DO 529 I=1,4
S	TAD \I
S	DISP1
	DO 529 IY1=1,256
	IY=IY1-1
S	TAD \IY
S	DISP2
	IBYTE=0
C	READ BM(I-1)L
	MEM=I-1
	CALL T3BUF(IBUF1,0)
C
C	WRITE BM(I+3)L
	MEM=I+3
	CALL T3BUF(IBUF1,1)
529	CONTINUE
C
C
C	[2.10] FBW3[8] TO GET/A,BM0H:3H
1210	CONTINUE
S	FBW3
S	AND (0010
S	SNA CLA
S	JMP \1211 /NO
C	SET FRAME POSITION
	IXPOSITION=KX1
	IYPOSITION=KY1
S	JMS SETBMS
C
S	TAD (7417
S	GETA
S	STQMT
S QMT2,	QMSKP
S	JMP QMT2
S	JMS WAITWHILE
C	BACKUP BM0:3H==>BM4:7H
	DO 610 I=1,4
S	TAD \I
S	DISP1
	DO 610 IY1=1,256
	IY=IY-1
S	TAD \IY
S	DISP2
	IBYTE=1
C	READ BM(I-1)H
	MEM=I-1
	CALL T3BUF(IBUF1,0)
C
C	WRITE BM(I+3)H
	MEM=I+3
	CALL T3BUF(IBUF1,1)
610	CONTINUE
C
C
C	[2.11] IF FBW3[9] THEN
C			COMPUTE TRIANGULAR DISTANCES BETWEEN MARKED POINTS
C	AND PRINT THEM ON TTY: AND LPT:
S\1211,	FBW3
S	AND (0004
S	SNA CLA
S	JMP \1212 /NO
C
C	YES, PRINT THE LIST OF COORDINATES
	DO 712 I=1,INDEX
	IX=IBUF3(I)
	IY=IBUF4(I)
	I17=I+20
	IZ=IBUF3(I17)
	I18=IBUF4(I17)
C
S	TAD \I
S	BSW
S	DCA \MODEM
	CURSYM='LOW   '
S	TAD \I18
S	SNA CLA
S	JMP \812 /LOW
	CURSYM='HIGH  '
812	DO 712 LSNEW=1,3,2
712	WRITE(LSNEW,1712)MODEM,IX,IY,IZ,CURSYM
1712	FORMAT(' POINT # ',A1,' = [',I4,',',I4,'], DENSITY=',I3,
     1' IN ',A5,'IMAGE.')
C
C	PRINT THE HEADER
	DO 1813 LSNEW=1,3,2
1813	WRITE(LSNEW,1814)LCNT,(I16*64,I16=1,INDEX)
1814	FORMAT(/,' DISTANCE MATRIX [',I3,'] BETWEEN PAIRS',/
     1,'      ',19(A1,'   '))
C
	DO 611 I=1,INDEX
	IX=IBUF3(I)
	IY=IBUF4(I)
C
C	ZERO IH[1:INDEX]
	DO 1812 J=1,20
1812	IH(J)=0
C
	DO 1611 J=I,INDEX
	JX=IBUF3(J)
	JY=IBUF4(J)
C
	DX=(JX-IX)
	DY=(JY-IY)
	IA = SQRT(DX*DX + DY*DY)
1611	IH(J)=IA
C
C	PRINT THE ROW
S	JMS PRTROW
611	CONTINUE
C
C
C	[2.12] IF LSNEW > 1 AND  FBW3[10]
C			 THEN COMPUTE DIFFERENCES BETWEEN MATRICES.
S\1212,	FBW3
S	AND (0002
S	SNA CLA
S	JMP \1213 /NO
S	TAD (-2
S	TAD \LSNEW
S	SPA CLA
S	JMP \1213 /NO
C	PRINT THE HEADER
	IA=LCNT
S	CLA CMA
S	TAD \LCNT
S	DCA \IA#
	DO 1823 LSNEW=1,3,2
1823	WRITE(LSNEW,1824)IA,(I16*64,I16=1,INDEX)
1824	FORMAT('1REL. DIFFS. BETWEEN MATRICES [',I3,',',I3,']',/
     1,'      ',19(A1,'   '))
C
	DO 612 I=1,INDEX
	IX=IBUF3(I)
	IY=IBUF4(I)
	IZ=I+100
	IXB=IBUF3(IZ)
	IYB=IBUF4(IZ)
C
C	ZERO IH[1:INDEX]
	DO 1822 J=1,20
1822	IH(J)=0
C
	DO 1612 J=I,INDEX
	JX=IBUF3(J)
	JY=IBUF4(J)
	IZ=J+100
	JXB=IBUF3(IZ)
	JYB=IBUF4(IZ)
C
	DX=(JX-IX)
	DY=(JY-IY)
	IA = SQRT(DX*DX + DY*DY)
C
	DX=(JXB-IXB)
	DY=(JYB-IYB)
	IB = SQRT(DX*DX + DY*DY)
C
1612	IH(J)=IB-IA
C
C	PRINT THE ROW
S	JMS PRTROW
612	CONTINUE
C
C
C	[2.13] TEST IF RETURN FBW3[11]
S\1213,	FBW3
S	AND (0001
S	SZA CLA
S	JMP \998  /YES
C
C
C	[2.14] TEST IF USE GRAPHPEN
C	IF K8BIT=-1
C		THEN NOP
S	TAD \K8BIT
S	SPA CLA
S	JMP \1215 /NOP
C
	CALL FLKR1
C
C
C	[2.15]  IF /A THEN CALL MANUAL
S\1215,	TAD \ISW /"/A"
S	SNA CLA
S	JMP \200 /NO
	CALL MANUAL
	CALL CLOCK
	GOTO 200
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
C	RESTORE POST AND F&S POSITIONS
S\998,	TAD \IPSTA
S	POSTA
S	TAD \IPSTB
S	POSTB
C
C	RESTORE F&S
S	TAD \IPSTK
S	HPL
S	TAD \IPSTK#
S	VPL
S	TAD \IOPSTK
S	HSL
S	TAD \IOPSTK#
S	VSL
C
C	SAVE COMMON
	CALL BSCOMMON(1)
	CALL CHAIN('BMON2')
C	*******************************************
C	*SUBROUTINE   P R T R O W
C	*****************************************************
C	PRINT THE ROW INFORMATION IN I AND IH[1:INDEX]
S	CPAGE 3
S RPRTROW,	JMP I PRTROW
S PRTROW,	0
C	PRINT THE ROW
S	TAD \I
S	BSW
S	DCA \MODEM /PRINT IN A1 FORMAT AS LETTER
	DO 811 LSNEW=1,3,2
	WRITE(LSNEW,1811)MODEM,(IH(KWC),KWC=1,INDEX)
1811	FORMAT('  ',A1,19I4)
811	CONTINUE
S	JMP RPRTROW
C
C	*******************************************
C	*SUBROUTINE   W A I T W H I L E
C	*****************************************************
C	RING THE TTY: BELL AND WAIT ABOUT 1 SECOND.
S	CPAGE 3
S RWAITWHILE,	JMP I WAITWHILE
S WAITWHILE,	0
C	WAIT A WHILE
S	TAD (207 /BELL
S	TLS
S	CLA
C
	DO 1111 IZ=1,200
1111	CALL CLOCK
S	JMP RWAITWHILE
C
C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C	*****************************************
C	*SUBROUTINE    B C D D E C
C	************************************************
C	CVT AC (DECIMAL) FROM AC (BCD)
S	CPAGE 3
S RBCDDEC,	JMP I BCDDEC
S BCDDEC,	0
S	MQL
S	MQA
S	BSW; RTR
S	AND (0017
S	DCA \I11
S	MQA
S	RTR;RTR
S	AND (0017
S	DCA \I12
S	MQA
S	AND (0017
S	DCA \I13
C	COMPUTE:   I11*100 + I12*10 + I13
S	TAD \I11
S	MQL
S	CPAGE 2
S	MUY
S	144 /D100
S	CLA
S	MQA
S	DCA 7 /(I11*100)
C
S	TAD \I12
S	MQL
S	CPAGE 2
S	MUY
S	12 /D10
S	CLA
S	MQA /(I12*10)
C
S	TAD 7
S	TAD \I13
C
S	JMP RBCDDEC
C	*****************************************
C	*SUBROUTINE    D E C B C D
C	************************************************
C	CVT AC (BCD) FROM AC ( DECIMAL)
S	CPAGE 3
S RDECBCD,	JMP I DECBCD
S DECBCD,	0
S	DCA \I10
C	COMPUTE:	I11=I10/100
S	TAD \I10
S	MQL
S	CPAGE 2
S	DVI
S	144 /D100
S	CLA
S	MQA
S	DCA \I11
C
C	COMPUTE:	I10=I10-(I11*100)
S	CPAGE 2
S	MUY /NOTE: C(MQ)= I11
S	144 /D100
S	CLA
S	MQA /I11*100
S	CIA
S	TAD \I10
S	DCA \I10
C
C	COMPUTE:	I12=I10/10
S	TAD \I10
S	MQL
S	CPAGE 2
S	DVI
S	12 /D10
S	CLA
S	MQA
S	DCA \I12 /(I10/10)
C
C	COMPUTE:	I13=I10-(I12*10)
S	CPAGE 2
S	MUY
S	12 /D10
S	CLA
S	MQA /I12*10
S	CIA
S	TAD \I10
S	DCA \I13
C
S	TAD \I11
S	BSW; RTL
S	AND (7400
S	MQL
S	TAD \I12
S	RTL; RTL
S	AND (0360
S	MQA
S	TAD \I13
C
S	JMP RDECBCD
C	**************************************************
C	*SUBROUTINE   S E T F S
C	**************************************************
C	LOAD THE BMX(IBM1), BMY(IBM1) WITH (IX,IY)
S	CPAGE 3
S RSETFS,	JMP I SETFS
S SETFS,	0
C
S	TAD \IBM1 /COMPUTE OFFSET
S	TAD (-4
S	SMA CLA
S	TAD (10 /OFFSET FOR GROUP B
S	MQL
S	TAD \IBM1
S	AND (0003
S	MQA /OR IN POSSIBLE GROUP B
S	MQL / OFFSET OF EITHER 0:3 OR 10:13.
C
S	MQA
S	TAD PBMX0
S	DCA SETX
S	TAD \IX
S SETX,	BMX0
C
S	MQA
S	TAD PBMY0
S	DCA SETY
S	TAD \IY
S SETY,	BMY0
S	JMP RSETFS
C
C	**************************************************
C	*SUBROUTINE   S E T B M S
C	**************************************************
C	LOAD THE BMX(IBM1), BMY(IBM1) WITH (IX,IY)
S	CPAGE 3
S RSETBMS,	JMP I SETBMS
S SETBMS,	0
C
	IBM1=0
	IX=IXPOSITION
	IY=IYPOSITION
S	JMS SETFS
C
	IBM1=1
	IX=IXPOSITION+256
	IY=IYPOSITION
S	JMS SETFS
C
	IBM1=2
	IX=IXPOSITION
	IY=IYPOSITION+256
S	JMS SETFS
C
	IBM1=3
	IX=IXPOSITION+256
	IY=IYPOSITION+256
S	JMS SETFS
S	JMP RSETBMS
C
C************** P A R A M E T E R S *************
S	CPAGE 2
S BUFF,	BLOCK 2
S BMTEXT,	TEXT /BM/
S PBMX0,	BMX0
S PBMY0,	BMY0
C
C
C
	END