C	PROGRAM BMAX1.FT
C	----------------
C
S	ENTRY BMAX1
S	CPAGE 2
S BMAX1,BLOCK 2
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	DEC 7, 1977
C	NOV 14, 1977
C	MAY 27, 1977
C	FEB 4, 1977
C	OCT 26, 1976
C	OCT 22, 1976
C	OCT 8, 1976
C	SEPT 30, 1976
C	SEPT 23, 1976
C	SEPT 22, 1976
C	SEPT 21, 1976
C	SEPT 20, 1976
C	SEPT 16, 1976
C	SEPT 15, 1976
C	SEPT 14, 1976
C	SEPT 10, 1976
C	SEPT 9, 1976
C	SEPT 7, 1976
C	SEPT 3, 1976
C	SEPT 2, 1976
C	SEPT 1, 1976
C	AUG 31, 1976
C	REV AUG 27, 1976
C	REV AUG 28, 1976
C	REV AUG 24, 1976
C	16 JUL 1976
C
C	PURPOSE
C	-------
C	BMAX1 IS THE AUXILLARY PICTURE PROCESSING PACKAGE OF
C	BMON2.FT,
C	 BMAX1 IS CALLED BY BMON2 WITH
C	THE DESIRED FUNCTION NUMBER IN THE COMMON VARIABLE IVAL.
C	BMAX1 CONTAINS THE FOLLOWING FUNCTIONS:
C
C	IVAL	FUNCTION
C	----	--------
C	1	COLOR			(ICNUM ==> BMJ)
C	2	COPY			(BMI ==> BMJ)
C	3	COMPLIMENT		(BMI ==> BMJ)
C	4	TEXT		(TTY: ==> BMJ)
C	5	GRID		16X16 (GRID ==> BMJ)
C	6	GRAPHPEN		(PEN ==> BMJ)
C	7	SAVCMD		SAVE THE 12 COMMAND KEY COMMANDS IN
C				THE SPECIFIED OUTPUT FILE.
C	8	RSTCMD		RESTORE THE 12 COMMAND KEY COMMAND FROM
C				THE SPECIFIED INPUT FILE.
C	9	SETIOT,<IOT NAME>=NNNN   LOAD NNNN INTO IOT REGISTER
C	OPDEFS
C	------
S	OPDEF	HPR	6320
S	OPDEF	VPR	6322
S	OPDEF	HPL	6360
S	OPDEF	VPL	6362
S	OPDEF	HSL	6361
S	OPDEF	VSL	6363
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
S	OPDEF	READGP	6146
S	SKPDF	GPSKP	6141
S	OPDEF	FBW3	6343
S	OPDEF	FBW12	6352
C
S	SKPDF	SKPKPD	6313
S	OPDEF	RKYPDH	6340
S	OPDEF	RKYPDL	6353
C
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
S	OPDEF	POSTA	6520
S	OPDEF	POSTB	6521
C
S	OPDEF 	RQSTAT	6327
S	OPDEF	QSTAT	6374
C
S	OPDEF	STQMT	6300
S	SKPDF	QMSKP	6301
S	OPDEF	LQDT1	6375 /LOAD LOW BYTE
C
C
S	OPDEF	DMAGO	6070
S	SKPDF	DMASKP	6071
S	OPDEF	DMAWC	6072
S	OPDEF	DMACA	6073
S	OPDEF	DMACLR	6074
S	OPDEF	EXDMA1	6524
S	OPDEF	EXDMA2	6525
C
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	SHL	7413
S	OPDEF	ASR	7415
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
C
S	OPDEF	RDF	6214
C
S	OPDEF BMX0	6500
S	OPDEF BMX4	6510
S	OPDEF BMY0	6504
S	OPDEF BMY4	6514
C	[0] JUMP TO APPROPRIATE ROUTINE
C		IVAL CONTAINS THE ADJUSTED FUNCTION NUMBER
C	SAVE /C SWITCH
	KOMP=ISW(3)
	K=0
C
C	SETUP JBM POSITION FOR GRAPHPEN USE
	IXPOSITION=LSAVE(13,JBM+1)
	IYPOSITION=LSAVE(14,JBM+1)
C
	GOTO(100,200,300,400,500,600,700,800,900),IVAL
C
C
C
C	RETURN
S \2047,	RETRN BMAX1
C	[1] COLOR: CLEAR BMJC	[1] BMJ<==COLOR,ICNUM
C
S\100,	JMS COLOR
	GOTO 2047
C
C
C
C	********** INTERNAL SUBROUTINE    C O L O R ******
C	[1.1] COLOR IBUF1 BUFFER
S	CPAGE 3
S RCOLOR,	JMP I COLOR
S COLOR,	0 /ENTRY
C
C	SEE IF WRITE BLACK
S	TAD \KOMP
S	CLL RAR
S	CLA
S	TAD \ICNUM
S	SZL
S	CMA
S	AND (377
S	DCA \IZ
C
C	GENERATE THE PACKING WORDS
S	TAD \IZ
S	RTL;RTL
S	AND (7400
S	TAD \IZ
S	DCA \IA
C
S	TAD \IZ
C@S	RTR;RTR;RAR
S	BSW; RTL /ALTERNATE MICROCODE
S	AND (7400
S	TAD \IZ
S	DCA \IB
C
C
C
C	SETUP PTR
S	CLA CMA
S	TAD PBUF1
S	DCA 11
C
C
	DO 111 IY=1,512,2
S	CPAGE 4
S	TAD \IA
S	DCAI 11
S	CPAGE 4
S	TAD \IB
S	DCAI 11
111	CONTINUE
C
C
C
C	[1.2] WRITE OUT THE COLOR BUFFER INTO BMJ
C	WRITE 2 BLOCKS AT A TIME IN BYTE-PACKED MODE
C
	DO 125 IY1=1,256,3
S	CLA CMA
S	TAD \IY1
S	DCA \IY
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,1)
C
125	CONTINUE
C
C
S	JMP RCOLOR
C
C
C	[2] COPY BMI INTO BMJ
C
C
C	[2.1] READ IN BMI DATA, 2 BLOCKS AT A TIME
C	IN BYTE-PACKED MODE
C
200	DO 229 IY1=1,256,3
S	CLA CMA
S	TAD \IY1
S	DCA \IY
C
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,0)
C
C	[2.2] WRITE INTO BMJ, 2 BLOCKS IN BYTE-PACKED MODE
C	SET UP POINTERS AND ADDRESSES
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,1)
C
229	CONTINUE
C
C
	GOTO 2047
C
C
C	[3] COMPLIMENT BMI DATA AND PUT IN BMJ
C
C	[3.1] READ IN 2 BLOCKS IN 1BYTE - PACKED MODE
300	DO 339 IY1=1,256,3
S	CLA CMA
S	TAD \IY1
S	DCA \IY
C
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,0)
C
C
C	COMPLEMENT THE DATA
S	CLA CMA
S	TAD PBUF1
S	DCA 11
S	TAD 11
S	DCA 12
C
	DO 301 IX=1,512
S	CPAGE 7
S	6211
S	TADI 11
S	CMA
S	DCAI 12
S	DCA \IZ
301	CONTINUE
C
C
C	[3.3] WRITE OUT 2 BLOCKS IN BYTE-PACKED MODE
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,1)
C
339	CONTINUE
C
C
C
	GOTO 2047
C
C
C	[4] ADD TEXT FROM TTY TO BMJ
C
400	IX=ICNUM
S	TAD \ICNUM#
S	DCA \IY
C	TEST IF WRITE WHITE
	ISHADE=ICNUM(3)
S	TAD \KOMP
S	SNA CLA
S	JMP \401
	ISHADE=255-ISHADE
C
C	IF /G
C		THEN GET X,Y FROM GRAPHPEN
401	IF(ISW(7))407,403,407
S\407,	JMS GRFPEN
S	FBW12
S	AND (0001 /PENTIP
S	SNA CLA
S	JMP \407 /NOT YET
C
C	GET THE 40 CHARACTER TEXT LINE.
403	READ(1,404)(LINE(I),I=1,40)
404	FORMAT('TEXT?: ',40A1)
C
C
C	[4.1] INITIALIZE POINTERS
C
	KTOP=IY
	KBOT=KTOP+5
C
	KLEFT=IX
	KRITE=KLEFT+3
C
	MEM=JBM
	IBYTE=JHGH
C
C
C	[4.2] MAP CHARACTER AND POST
C
	DO 429 INDEX=1,40
	K=LINE(INDEX)
S	TAD \K
S	BSW
S	AND (0077
S	CLL RAL /MULTIPLY BY 2
C
C	GO LOOKUP THE CHARACTER
S	TAD (-1 /FOR AUTOINDEX REG
S	TAD PTAB	/GET TABLE POINTER
S	DCA 11	/STUFF INTO AUTO-INDEX REGISTER
C
S	TAD I 11	/GET FIRST HALF OF BIT PATTERN
S	DCA BUFF#	/PUT IT IN HI-ORDER HALF OF WORD
S	TAD I 11	/GET SECOND HALF OF BIT PATTERN
S	DCA BUFF	/PUT IN IN LOW-ORDER HALF
C
C	WRITE A CHARACTER
	DO 424 IX=KLEFT,KRITE
	DO 424 IY=KTOP,KBOT
C
S	SWAB	/CHANGE TO MODE B
S	CPAGE 16
S	JMS 45
S	NOP
S	DAD	/GET...
S	BUFF	/DOUBLE PRECISION BIT PATTERN INTO AC-MQ
S	SHL	/SHIFT LEFT..
S	0001	/...ONE PLACE (INTO LINK)
S	DST	/RESTORE...
S	BUFF	/...REMAINDER OF BIT PATTERN
S	CAM	/CLEAN IT OUT
S	SWBA	/RESTORE MODE A
S	SNL	/SKIP ON ZERO LINK
S	JMP \424 /DO NOT WRITE IT OUT
C
C	DISPLAY THE LOC
S	TAD \ISHADE
S	DCA \IZ
C
	CALL PACK2D
C
424	CONTINUE
C
	KLEFT=KLEFT+6
	KRITE=KLEFT+3
C	IF KRITE > 255
C		THEN DONE
S	TAD (-D256
S	SMA CLA
S	JMP \2047 /DONE
C
429	CONTINUE
C
C
C
	GOTO 2047
C	[5] GRID: OVERLAY ONTO BMJ
C
C	WRITE 10 MICRON LINES SO NEED TO GET THE NUMBER OF
C	PIXELS EQV TO 10 U. THIS IS 
C		FLOAT(IHSIZE)/PUC
S\500,	TAD \ICNUM#
S	SNA
S	TAD (D10 /DEFAULT
S	DCA \IHSIZE
C
	CALL BMAP(IA,FA,FB,FC)
	K=FLOAT(IHSIZE)/FB
C
C	[5.1] SELECT OUTPUT MEMORY AND BLACK GRAY SCALE.
	MEM=JBM
	IBYTE=JHGH
	IZ=ICNUM
S	TAD \IZ
S	SNA
S	TAD (D255 /NO , MAKE IT BLACK
S	DCA \IZ
C
C	TEST IF /C THEN USE ZERO GRAY VALUE
S	TAD \KOMP
S	SNA CLA
S	JMP \501 /NO
	IZ=255-IZ
C
C
C
C	[5.2] WRITE HORIONTAL LINES
501	DO 503 IY1=1,256,K
S	CLA CMA
S	TAD \IY1
S	DCA \IY
C
	DO 503 IX1=1,256
S	CLA CMA
S	TAD \IX1
S	DCA \IX
C
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \2047
C
	CALL PACK2D
C	NOW WRITE THE OPPOSITE LINE
	IY2=IY
	IY=IX
	IX=IY2
	CALL PACK2D
C	RESTORE IY
	IY=IY2
503	CONTINUE
	GOTO 2047
C	[6] (OPT.BMJ) < GRAPHPEN, OPT GRAY VALUE, OPT BRUSH SIZE
C	USE  OR FBW3[1]  FROM TTY TO EXIT
600	MEM=JBM
	IBYTE=JHGH
C
S	TAD (1126 /256 BCD
S	HSL
S	TAD (1126
S	VSL
C	GET BRUSH SIZE IF NOT ZERO
S	TAD \ICNUM#
S	SNA
S	IAC /MAKE IT 3X3
S	AND (7 /MAX SIZE OF 15X15
S	DCA \KMODE
C
C
C	ENABLE F&S POSITION
S	RQSTAT
S	AND (3777
S	TAD (4000
S	QSTAT
C
C	TEST IF PRINT OUT MESSAGE
S	TAD \KOUTFILE
S	SNA CLA
S	JMP \602 /NO BM
C
	WRITE(1,601)
601	FORMAT('MENU CLASS KEYS:',/,' 0-ERASE',/,' 1-BRUSH',
     1/,' 2-GRAD',/,' 3-LAPLC',/,' 4-BRUSH<KPD',/,' 5-DENS<KPD',/
     2,' 6-CLR BM',/,' 11-EXIT')
C
C
C	IF JBM EXISTS, THEN USE ITS COORDS TO LOAD THE F&S
S \602,	TAD \KOUTFILE
S	SNA CLA
S	JMP \607 /NO, FORGET IT
C
C	LOAD FROM JBM
	IX=IBCD(IXPOSITION,-1)
	IY=IBCD(IYPOSITION,-1)
S	TAD \IX
S	HPL
S	TAD \IY
S	VPL
C
C	GET THE POSITION FROM THE F&S
S \607,	HPR
S	DCA \IX
S	VPR
S	DCA \IY
	IXPOSITION=IBCD(IX,1)
	IYPOSITION=IBCD(IY,1)
C
C
	ISHADE=ICNUM
S	TAD \ISHADE
S	SNA
S	TAD (D255
S	DCA \ISHADE
C
C	TEST IF /C THEN WRITE WHITE
S	TAD \KOMP
S	SNA CLA
S	JMP \610 /NO COMPLEMENT
	ISHADE=255-ISHADE
C
C
C	[6.1] GET PEN DATA
S\610,	JMS GRFPEN /GET (IX,IY) AND USE CURSOR IN (IXPOSITION,ITPOSITION)
C
C
C	[6.2] IF PENTIP DOWN, THEN STORE IN BMJ ELSE NOP
S	FBW12
S	AND (0001 /BIT 11
S	SNA CLA /BIT 11
S	JMP \650 /NOP
C
C	TEST IF BM SPECIFIED
S	TAD \KOUTFILE
S	TAD (-0215 /-"BM"
S	SZA CLA
S	JMP \650 /NOP
C
C
C	[6.3] TEST IF BRUSH A 3X3 MATRIX
	IX1=IX
	IX2=IX
	IY1=IY	
	IY2=IY
C
C	IF /B THEN REVERSE THE SENSE OF THE SWITCH
S	TAD \ISW#
S	CLL RAR /MOVE TO LINK BIT
S	FBW3 /TEST IF BRUSH IT
S	SZL /IF /B THEN COMPLEMENT
S	CMA
S	AND (2000 /BIT 1
S	SNA CLA
S	JMP \622 /NO
C
C	YES, SET UP 3X3
C	IX1=(IX-KMODE) OR 1
S	TAD \KMODE
S	CIA
S	TAD \IX
S	SPA
S	CLA IAC
S	DCA \IX1
C
C	IX2=(IX+KMODE) OR 256
S	TAD \IX
S	TAD \KMODE
S	TAD (-D256
S	SMA
S	CLA /CLIP TO 256
S	TAD (D256
S	DCA \IX2
C
C	IY1=(IY-KMODE) OR 1
S	TAD \KMODE
S	CIA
S	TAD \IY
S	SPA
S	CLA IAC
S	DCA \IY1
C
C	IY2=(IY+KMODE) OR 256
S	TAD \IY
S	TAD \KMODE
S	TAD (-D256
S	SMA
S	CLA /CLIP TO 256
S	TAD (D256
S	DCA \IY2
C
C
C	[6.4] TEST IF ERASE, THEN WRITE THE COMPLMENT
622	DO 621	I11=IY1,IY2
S	CLA CMA
S	TAD \I11
S	DCA \IY
C
	DO 621 I12=IX1,IX2
S	CLA CMA
S	TAD \I12
S	DCA \IX
C
	IZ=ISHADE
S	FBW3
S	AND (4000 /BIT 0=ERASE
S	SNA CLA
S	JMP \620
	IZ=255-IZ
620	CALL PACK2D
621	CONTINUE
C
C
C	[6.6] DISPLAY IT
S\650,	TAD \IX
S	DISP1
S	TAD \IY
S	DISP2
C
C
C	[6.6.1] TEST IF ZERO BM
S	FBW3
S	AND (0040 /BIT 6
S	SNA CLA
S	JMP \662 /NO
C	SAVE GRAY VALUE
	IVAL=1
	ICNUM=0
S	JMS COLOR
C
C
C	[6.6.2] TEST IF CHANGE BRUSH OR DENSITY FROM KPD
S\662,	FBW3 /4==>BRUSH, 5==>DENSITY
S	AND (0300
S	SNA
S	JMP \670 /NO
S	DCA \IY /SAVE IT
C
C	RING THE BELL
S	TAD (207
S	TLS
S	CLA
C
S KWT,	SKPKPD
S	JMP KWT /NOT YET
S	RKYPDL
S	DCA \IZ
S	RKYPDH /CLEAR KBD
S	CLA
	IZ=IBCD(IZ,1)
C	PRINT THE VALUE
	WRITE(1,1111)IZ
1111	FORMAT('KBD='I5)
C
C	SEE WHO GETS IT
S	TAD \IY /FBW3 BACKED UP
S	RTL;RTL;RAL /4==>LINK
S	CLA
S	TAD \IZ
S	SZL
S	DCA \KMODE /BRUSH SIZE
S	CLA
C
S	TAD \IY /FBW3 BACKED UP
S	RTL;RTL;RTL /5==>LINK
S	CLA
S	TAD \IZ
S	SZL
S	DCA \ISHADE
S	CLA
	GOTO 610
C
C
C	[6.7] IF QMT READY, GET DATA FROM BM AND CVT
C	TO BCD AND LOAD IN RIGHT QMT DISPLAY
S \670,	QMSKP
S	JMP \610 /NO
	CALL FETCH2D
C
C	TEST IF FBW3[2:3]
S	FBW3
S	AND (1400
S	SNA CLA
S	JMP \651
C
C
C	NO, GET THE NEIGHBORHOOD
	CALL GETI1
C	COMPUTE ROBERTS GRADIENT OF AVGED NEIGHBORHOOD
	IA=(I10+I11+I12)-(I14+I15+I16)
	IB=(I12+I13+I14)-(I16+I17+I10)
C	COMPUTE ABS VALUES
S	TAD \IA
S	SPA 
S	CIA
S	DCA \IA
S	TAD \IB
S	SPA
S	CIA
S	DCA \IB
C	IC=GRAD(IX,IY)=MAX(IA,IB)
	IC=IA
S	TAD \IB
S	CIA
S	TAD \IA
S	RAL
S	CLA
S	TAD \IB
S	SZL
S	DCA \IC
S	CLA
C
C	COMPUTE LAPLACIAN
S	TAD \I18
S	CLL RAL
S	CLL RAL
S	CLL RAL
S	DCA \IB
	IA=(I10+I11+I12+I13+I14+I15+I16+I17)-IB
S	TAD \IA
S	SPA
S	CIA
S	DCA \IA
C
C	NOW TEST WHICH FUNCTION LOAD INTO IZ
C	IF FBW3[2]=1 THEN LOAD GRADIENT IC
C		     ELSE LOAD LAPLACIAN IA
	IZ=IC
S	FBW3
S	AND (1000 /BIT 2
S	SZA CLA
S	JMP \651
	IZ=IA
C
C	CVT DECIMAL TO BCD FOR QMT DISPLAY
651	IZ=IBCD(IZ,-1)
S	TAD \IZ
S	LQDT1
S	STQMT
C
	GOTO 610
C
C	[7] <FILESPEC> _ SAVCMD,    (SAVE THE LSAVE ARRAY IN FILE)
C	ENTER THE FILE
700	IF(IO(KDEVOUT,KOUTFILE,KOUTFILE(4),3))701,702,701
701	WRITE(1,703)
703	FORMAT('I/O ERR.')
S	RETRN BMAX1
C
C	WRITE OUT A 4 BLOCK FILE
702	IF(IO(4,LSAVE,0,7))701,704,701
C
C	CLOSE THE FILE
704	IF(IO(0,0,0,5))701,705,701
S \705,	RETRN BMAX1
C
C
C
C
C	[8] RSTCMD <FILESPEC>, (RESTORE LSAVEE ARRAY FROM FILE).
C	LOOKUP THE FILE
800	IF(IO(KDEVIN(2),KINFILE(5),KINFILE(8),1))801,802,801
801	WRITE(1,703)
S	RETRN BMAX1
C
C	READ IN A 4 BLOCK FILE
802	IF(IO(4,IBUF1,0,6))801,806,801
C
C	MAP INTO LSAVE
806	DO 805 IX=1,852
805	LSAVE(IX)=IBUF1(IX)
S \804,	RETRN BMAX1
C
C
C
C	[9] SETIOT, <IOT NAME>=NNNNN
900	K=FINDOPR(KINFILE(5))
	IF(K)901,902,902
902	WRITE(1,903)
903	FORMAT('ILL-IOT')
S	RETRN BMAX1
C
C	EVAL THE IOT WITH NNN IN THE AC
901	NNNN=MCD(39)
S	TAD \K
S	DCA DOIOT
S	TAD \NNNN
S DOIOT,  0
S	CLA
S	RETRN BMAX1
C	***********************************************
C	*SUBROUTINE    G R F P E N
C	*******************************************************
C	GET THE IX,IY REL COORDINATES 0:255 AND DISPLAY CURSOR
C	IN IXPOS,IYPOS.
S	CPAGE 3
S RGRFPEN,	JMP I GRFPEN
S GRFPEN,	0 /ENTRY
C
S	CPAGE 3
S 	JMS TTYCTL /TEST OF ^S,^Q,^O
S	JMP \2047 /DONE
S	FBW3
S	AND (0037 /BIT 7:10 &  TO RETURN
S	SZA CLA
S	JMP \2047 /RETURN
C
S	GPSKP /GRAPH PEN DATA READY?
S	JMP GRFPEN# /NO
C
C	YES, GET PEN DATA
S	READGP /GET X
S	CLL RTR; RTR /DIVIDE BY 16 SO COVER [0:255]
S	AND (377
S	DCA \IX
C
S	READGP /GET Y
S	CIA
S	CLL RTR; RTR /DIVIDE BY 16 SO COVER [0:255]
S	AND (377
S	DCA \IY
S	TAD \IX
S	TAD \IXPOSITION
S	LDXP
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
S	JMP RGRFPEN
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
S	LAP
S	PAGE
S TABLE,
S	0000	/@
S	0000
S	7744	/A
S	4477
S	7751	/B
S	5126
S	3641	/C
S	4122
S	7741	/D
S	4136
S	7745	/E
S	4541
S	7744	/F
S	4440
S	3641	/G
S	4526
S	7710	/H
S	1077
S	4177	/I
S	4100
S	4241	/J
S	7640
S	7710	/K
S	2443
S	7701	/L
S	0103
S	7730	/M
S	3077
S	7730	/N
S	0677
S	3641	/O
S	4136
S	7744	/P
S	4430
S	7642	/Q
S	7603
S	7744	/R
S	4631
S	2151	/S
S	5146
S	4040	/T
S	7740
S	7701	/U
S	0177
S	7601	/V
S	0274
S	7706	/W
S	0177
S	6314	/X
S	1463
S	7007	/Y
S	0770
S	4345	/Z
S	5161
S	7741	/[
S	0000
S	6010	/\
S	0403
S	0000	/]
S	4177
S	0010	/^
S	2010
S	0101	/_
S	0101
S	0000	/SPACE
S	0000
S	0075	/!
S	0000
S	6000	/"
S	0060
S	7227	/#
S	7227
S	0677	/$ 
S	7730
S	6374	/% 
S	2543
S	6625	/& 
S	1067
S	0000	/'
S	6000
S	3641	/(
S	0000
S	0000	/)
S	4136
S	2214	/*
S	1422
S	1034	/+
S	1000
S	0102	/,
S	0000
S	1010	/-
S	1000
S	0303	/.
S	0000
S	0304	//
S	1060
S	7745	/0
S	5177
S	0121	/1
S	7701
S	2345	/2
S	5121
S	2241	/3
S	5126
S	1424	/4
S	7704
S	7251	/5
S	5106
S	0615	/6
S	2542
S	4344	/7
S	5060
S	2651	/8
S	5126
S	2051	/9
S	5136
S	0063	/:
S	6300
S	6162	/;
S	0000
S	1024	/<
S	4200
S	2222	/=
S	2222
S	0042	/>
S	2410
S	5550	/?
S	2000
C
C
C
C	POINTERS
C	--------
S PBMX0,	BMX0
S PBMX4,	BMX4
S PBMY0,	BMY0
S PBMY4,	BMY4
S PLINE,	\LINE
S PBUF1,	\IBUF1
S PTAB,	TABLE
S	CPAGE 2
S BUFF,	BLOCK 2
C
C
C
	END