/	P?S/8 FOCAL HDS 3200-30 OVERLAY

/	LAST EDIT:	07-JAN-1990	05:00:00	CJL

/	P?S/8 FOCAL OVERLAY FOR POINT, ETC. DISPLAY ON THE HDS 3200-30.

/	THIS OVERLAY PROVIDES A DISPLAY FUNCTION TO P?S/8 FOCAL SIMILAR TO FOCAL-12
/	OR BASIC-RT.

/	IMPLEMENTATION RESTRICTIONS:

/	THE SERIAL INTERFACE TO THE HDS TERMINAL IS RUN WITH  INTERRUPTS OFF;  FOCAL'S
/	INTERRUPT  HANDLER MUST NOT USE THIS DEVICE.  THEREFORE, THE DEVICE  CAN'T  BE
/	03/04,  OR  ANY  OTHER  DEVICE  CONTROLLED  BY  THE SYSTEM CONSOLE OVERLAY (IF
/	PRESENT).

/	THERE IS NO AUTOMATIC WAY TO RESTORE THE TERMINAL TO TEXT MODE.  THE USER MUST
/	RETURN  THE  TERMINAL  TO TEXT MODE USING THE TEXT/GRAPHICS KEY.  THIS MUST BE
/	AVOIDED WHILE  THE  TERMINAL  IS  IN  GRAPHICS  MODE.    IF THE '/X' SWITCH IS
/	INVOKED NO TERMINAL  INITIALIZATION  IS  PERFORMED,  THUS THE TERMINAL MUST BE
/	RESTORED TO GRAPHICS MODE  IF  NECESSARY.  THE ALTERNATIVE APPROACH WOULD HAVE
/	BEEN TO "LOCK OUT" THE  TEXT/GRAPHICS  KEY, BUT THIS WAS CONSIDERED TOO SEVERE
/	FOR NORMAL USE.

/	BOTH OF THE ABOVE PROBLEMS MUST  BE  SOLVED  BEFORE  ATTEMPTING TO USE THE HDS
/	TERMINAL AS A CONSOLE DEVICE.
/	AVAILABLE FUNCTIONS:

/	FDIS(X,Y)			DISPLAY POINT AT (X,Y).

/	FDIS(X,Y,0,"STRING",S,R)	DISPLAY THE CONTENTS OF "STRING" AS CHARACTERS
/					OF THE STATED SIZE  S WITH THE STATED ROTATION
/					R.  THE LOWER LEFT-HAND  CELL  COORDINATE  FOR
/					THE FIRST CHARACTER IS AT (X,Y).

/	FDIS(X,Y,1,CHARACTER,S,R)	DISPLAY THE EVALUATION OF CHARACTER MOD 128 AS
/					A SINGLE ASCII CHARACTER  OF THE STATED SIZE S
/					WITH  THE  STATED  ROTATION  R.     THE  LOWER
/					LEFT-HAND    CELL  COORDINATE  FOR  THE  FIRST
/					CHARACTER IS AT (X,Y).

/	FDIS(X,Y,2,VALUE,LENGTH,S,R)	DISPLAY  THE  EVALUATION  OF  VALUE AS NUMERIC
/					CHARACTERS OF  THE  STATED  SIZE  S  WITH  THE
/					STATED  ROTATION  R.    LENGTH  SPECIFIES  THE
/					NUMBER  OF  SIGNIFICENT  DIGITS.    THE  LOWER
/					LEFT-HAND CELL COORDINATE FOR THE  FIRST DIGIT
/					IS AT (X,Y).

/	FDIS(X,Y,3)			SET INITIAL VECTOR ADDRESS AT (X,Y).

/	FDIS(X,Y,4)			DRAW  STRAIGHT    LINE   (APPROXIMATION)  FROM
/					PREVIOUS VECTOR ADDRESS  TO  (X,Y).  THIS ALSO
/					SETS  UP  AN  INITIAL  VECTOR  ADDRESS  FOR  A
/					SUBSEQUENT USAGE OF FDIS(X,Y,3) (EQUIVALENT TO
/					INVOKING FDIS(X,Y,2) WITH THE CURRENT X  AND Y
/					VALUES).

/	FDIS(0)				CLEAR ALL POINTS FROM GRAPHICS SCREEN.

/	FDIS(NON-ZERO)			IGNORED (PROVIDED FOR COMPATIBILITY WITH OTHER
/					OVERLAYS  WHICH  USE  THIS  FUNCTION  TO  SHOW
/					"GROWING" DISPLAYS).

/	FIO(NEGATIVE)			RETURNS NUMERICAL VALUE (MODULO  128)  OF  THE
/					NEXT  AVAILABLE  ASCII CHARACTER TYPED  (P?S/8
/					FOCAL  WILL  WAIT  FOR  INPUT  IF  NECESSARY).
/					SINCE INTEGER EVALUATION IS USED, THE ARGUMENT
/					MUST BE NEGATIVE OR WITHIN THE RANGE 2048-4095
/					MOD 4096.

/	FIO(CHAR<2048)			OUTPUT  AN ASCII  CHARACTER.    SINCE  INTEGER
/					EVALUATION  IS  USED,  THE  ARGUMENT  MUST  BE
/					POSITIVE  AND  BETWEEN  0000-2047  MOD   4096.
/					NORMAL  OUTPUT  DEVICES  GENERALLY  REDUCE THE
/					CHARACTER  VALUE  RANGE  TO  0000-0255 MOD 256
/					ALLOWING ANY  COMBINATION  OF  ASCII CHARACTER
/					OUTPUT WITH OR WITHOUT PARITY SET.
/	DATA CONSIDERATIONS:

/	X, Y VALUES RANGE FROM -2048 THROUGH 2047 UNLESS '/1' IS INVOKED WHICH CHANGES
/	THE VALUES TO 4010-COMPATIBLE (MODEL-DEPENDANT).

/	STRING CHARACTERS INCLUDE THE SPECIAL CASES:

/	^<NOT ^>	CHANGE CASE.  THE  CHARACTER  FOLLOWING  THE ^ IS TAKEN IN THE
/			NEW CASE.  DEFAULT CASE IS LOWER.

/	^^		OUTPUT A SINGLE ^.  THE CASE IS NOT CHANGED.

/	"		STRING DELIMITER;  MUST BE PRESENT ON THE STRING  ARGUMENT  TO
/			INDICATE  THE  PRESENCE  OF  A  STRING.  ALSO REQUIRED AS  THE
/			TRAILING DELIMITER.

/	""		WHEN IMBEDDED WITHIN THE STRING CAUSES OUTPUT OF A SINGLE ".

/	?		NOT ALLOWED (RESTRICTION OF FOCAL).

/	X, Y  DETERMINE  THE  COORDINATE  FOR THE LOWER-LEFT PIXEL OF THE CELL FOR THE
/	FIRST CHARACTER IN THE STRING.

/	SIZE AND ROTATION  PARAMETERS  CONFORM TO HDS VALUES.  IF THE SIZE IS GIVEN AS
/	NEGATIVE, THE ABSOLUTE VALUE  IS  USED;    THE  CHARACTER  STRING WILL THEN BE
/	OUTPUT WITH SLANTED CHARACTERS.   IF  THE  ROTATION  ARGUMENT  IS OMITTED, THE
/	DEFAULT OF HORIZONTAL OUTPUT (0 DEGREES ROTATION) WILL BE USED.
/	CHARACTER SIZES.

/	CHARACTER SIZE IS DETERMINED BY THE SIZE PARAMETER AS FOLLOWS:

/	ABSOLUTE VALUE		CHARACTER SIZE

/	0			SMALLEST
/	1			VERY SMALL
/	2			SMALL
/	3			STANDARD
/	4			DOUBLE
/	5			TRIPLE
/	6			QUADRUPLE
/	7			STANDARD

/	THE SIGN OF THE SIZE  PARAMETER  DETERMINES  IF THE CHARACTERS WILL BE PLOTTED
/	NORMAL OR SLANTED (PLUS=NORMAL, MINUS=SLANTED TO THE RIGHT).  FOR THE PURPOSES
/	OF THE CHARACTER SIZE, THE ARGUMENT IS TAKEN MOD 8.

/	CHARACTER ROTATION.

/	CHARACTER ROTATION IS DETERMINED BY THE ROTATION PARAMETER AS FOLLOWS:

/	VALUE			ORIENTATION

/	0			ROTATED 270 DEGREES
/	1			HORIZONTAL (ROTATED 0 DEGREES)
/	2			ROTATED 90 DEGREES
/	3			ROTATED 180 DEGREES

/	STARTING CONSIDERATIONS.

/	INVOKING FOCAL WITH THE '/X' SWITCH WILL NOT  INITIALIZE  THE  TERMINAL.  THIS
/	ASSUMES THE TERMINAL IS ALREADY IN GRAPHICS MODE FROM A PRIOR RUN.
/	ASSEMBLY PARAMETERS.

/	SET ONE OF THE FOLLOWING HARDWARE PARAMETERS BY REMOVING THE "/":

/	SET THE DISPLAY FIELD:

/	DFIELD=	20			/DISPLAY FIELD

/	SET THE TERMINAL LINE I/O DEVICE.

/	LINE=	03			/USE DEVICE 03/04 I/O TO TERMINAL
/	LINE=	40			/USE DEVICE 46/47 I/O TO TERMINAL
/	LINE=	46			/USE DEVICE 46/47 I/O TO TERMINAL

/	DEFAULT PARAMETERS.

	DEFLENG=4			/DEFAULT DIGIT STRING LENGTH
	DEFROTA=1			/DEFAULT ROTATE VALUE
	DEFSIZE=3			/DEFAULT CHARACTER SIZE

/	CONDITIONAL ASSEMBLY PARAMETERS.

	IFNDEF	DFIELD	<DFIELD=20>	/USE FIELD TWO FOR DISPLAY CODE
	IFNDEF	LINE	<LINE=	46>	/USE DEVICE 46/47 I/O TO TO TERMINAL

/	REMOTE LINE IOT DEFINITIONS.

/	RECEIVE DEFINITIONS.

	RKIEIOT=LINE^10+6005		/LOAD INTERRUPT ENABLE PER AC[11]
	RKRBIOT=LINE^10+6006		/READ REMOTE, CLEAR FLAG
	RKSFIOT=LINE^10+6001		/SKIP ON REMOTE INPUT FLAG

/	TRANSMIT DEFINITIONS.

	RTLSIOT=LINE+1^10+6006		/TRANSMIT CHARACTER, CLEAR FLAG
	RTSFIOT=LINE+1^10+6001		/SKIP ON TRANSMIT FLAG
/	DEFINITIONS FROM FOCAL, 1969 (ORIGINAL PAPER-TAPE VERSION).

	CHAR=	0066		/FOCAL'S CHARACTER BUFFER
	EFUN3I=	0136		/FUNCTION RETURN POINTER
	ERROR5=	2725		/ERROR FUNCTION
	EVAL=	1613		/EVALUATOR ROUTINE
	FLAC=	0044		/FLOATING AC
	FNTABF=	0374		/FUNCTION ADDRESS TABLE
	FNTABL=	2165		/HASHED FUNCTION NAME TABLE
	GETC=	JMS I	0145	/GET A CHARACTER
	INDEV=	0064		/INPUT ROUTINE POINTER
	INTEGER=0053		/FLOATING TO FIXED CONVERSION POINTER
	OUTDEV=	0063		/OUTPUT ROUTINE POINTER
	PDLXR=	0013		/PUSHDOWN LIST AUTO-INDEX REGISTER
	PUSHA=	JMS I	0142	/PUSH WORD ONTO STACK
	RETURN=	JMP I	EFUN3I	/FUNCTION RETURN INSTRUCTION
	XDYS=	1142		/FDIS FUNCTION ADDRESS
	XINT=	1160		/INTEGER PART ROUTINE

/	DEFINITIONS FROM P?S/8 AND THE P?S/8 FOCAL OVERLAY.

	BEOFZAP=7505		/BINARY LOADER ZAP WORD
	BONCE=	3600		/OVERLAY ONCE-ONLY ADDRESS
	PRGFLD=	0000		/PROGRAM FIELD
	SWAPBLK=2417		/SWAP BLOCK
	SWMX=	7605		/SWITCHES /M-/X
	SWY9=	7606		/SWITCHES /Y, /Z, /0-9

/	NUMERIC LOAD DEFINITIONS.

	NL0001=	CLA IAC		/LOAD AC WITH 0001
	NL7777=	CLA CMA		/LOAD AC WITH 7777

/	CHARACTER DEFINITIONS.

	ESC=	033		/<ESC> CHARACTER
	FS=	"\&37		/<FS> CHARACTER
	US=	037		/<US> CHARACTER
	FIELD	0		/ENSURE FIELD ZERO

	*FNTABF+3		/OVER FUNCTION ADDRESS TABLE

	XDIS			/POINT TO DISPLAY FUNCTION

	*FNTABF+14		/OVER FNEW ADDRESS

	XIO			/POINT TO INPUT/OUTPUT FUNCTION

	*XDYS			/OVER EXISTING XDIS CODE

/	FIO FUNCTION.

XIO,	JMS I	INTEGER		/GET LOW-ORDER FROM FIXED FLAC
	SMA CLA			/SKIP IF INPUT
	JMP	XOUT		/JUMP IF OUTPUT
	JMS I	INDEV		/GET A CHARACTER

/	AC WILL BE NON-ZERO IF FIO(NEGATIVE), ZERO IF FDIS(XX).

/	FDIS FUNCTION ENTERS HERE WITH CLEAR AC.

XDIS,	CIF	DFIELD		/GOTO CODE FIELD
	JMP	XIOMORE		/CINTINUE THERE

/	COMES HERE IF FIN(POSITIVE).

XOUT,	TAD	FLAC+2		/GET LOW-ORDER AGAIN
	JMS I	OUTDEV		/PRINT THE CHARACTER
XRET,	RETURN			/RETURN TO FOCAL

/	FIELD ZERO FLOATING TO FIX CALL.

INTPUSH,SNA			/ANY PASSED VALUE?
	JMS I	INTEGER		/NO, GET LOW-ORDER FROM FIXED FLAC
	PUSHA			/PUSH EITHER WAY
EVALRET,CIF	DFIELD		/GOTO CODE FIELD
	JMP	PUSHMORE	/CONTINUE THERE

	ZBLOCK	XINT-.		/EMPTY SPACE

	XINT=	.		/UPPER LIMIT FOR DISPLAY CODE

	*FNTABL+3		/OVER HASHED NAME TABLE

	"D^2+"I^2+"S		/MAKE SURE FDIS FUNCTION IS PRESENT

	*FNTABL+14		/OVER FNEW

	"I^2+"O			/ENTER FIO FUNCTION HASHED NAME
	*SWAPBLK+3		/OVER EMPTY SPACE PAST SWAPPER

/	FIELD ZERO GETC CALL.

DOGETC,	GETC			/GET LATEST CHARACTER
	CIF	DFIELD		/GOTO CODE FIELD
	JMP	DOGETBACK	/CONTINUE THERE
	FIELD	DFIELD%10	/IN (FIRST) BUFFER FIELD

	*0			/START AT THE BEGINNING

ROTATE,	.-.			/ROTATE VALUE
SIZE,	.-.			/CHARACTER SIZE
STKTMP,	.-.			/TEMPORARY FOR STACK OPERATIONS
STRPTR,	.-.			/STRING BUFFER POINTER

/	FIX THE FLAC AND PUSH ROUTINE.

FIXPUSH,.-.			/FIX AND PUSH ROUTINE
	CIF CDF	PRGFLD		/GOING TO FIELD ZERO
	JMP I	[INTPUSH]	/CONTINUE THERE

/	COMES BACK HERE WHEN THROUGH.

PUSHMOR,JMP I	FIXPUSH		/RETURN

	*10			/GET TO AUTO-INDEX AREA

CASE,	.-.			/LATEST ALPHA CASE
LATCHAR,.-.			/LATEST STRING CHARACTER
PREVCHA,.-.			/PREVIOUS STRING CHARACTER
TERMTMP,.-.			/TERMINAL OUTPUT TEMPORARY
X,	.-.			/"X" COORDINATE
Y,	.-.			/"Y" COORDINATE

	*20			/GET PAST AUTO-INDEX AREA

/	DO A "GETC" ROUTINE.

DOAGETC,.-.			/DO A "GETC" ROUTINE
	CIF CDF	PRGFLD		/GOING TO MAIN FIELD
	JMP I	[DOGETC]	/CONTINUE THERE

/	COMES HERE WHEN RETURNING AFTER A "GETC" CALL.

DOGETBA,JMP I	DOAGETC		/RETURN TO CALLER

/	POP ELEMENT OFF OF STACK ROUTINE.

POPAC,	.-.			/POP INTO AC ROUTINE
	ISZ I	[PDLXR]		/BUMP STACK POINTER
	TAD I	[PDLXR]		/GET THE NEW VALUE
	DCA	STKTMP		/STASH IT
	TAD I	STKTMP		/GET THE VALUE
	JMP I	POPAC		/RETURN

/	COMES HERE TO FINISH THE "FIO", "FDIS" FUNCTIONS.

XIOMORE,JMP I	[XIOMR2]	/CONTINUE THERE
	PAGE

/	COMES HERE TO FINISH "FIO" AND "FDIS" FUNCTIONS.

XIOMR2,	SNA			/INPUT/OUTPUT FUNCTION?
	JMP	DODISP		/NO, MUST BE DISPLAY
	AND	[177]		/JUST SEVEN-BIT
	DCA I	[FLAC+1]	/STORE IN HIGH-ORDER
	DCA I	[FLAC+2]	/CLEAR LOW-ORDER
	TAD	[13]		/GET SHIFT FACTOR
	DCA I	[FLAC]		/SET EXPONENT
DISPRET,CIF CDF	PRGFLD		/GOING TO FIELD ZERO
	JMP I	[XRET]		/FINISH IT THERE

/	COMES HERE TO FINISH "FDIS" FUNCTION.

DODISP,	JMS	FIXPUSH		/FIX AND PUSH FIRST ARGUMENT
	JMS I	[GETARG]	/GET SECOND ARGUMENT
	JMP I	(DISP1)		/WASN'T ANY
	TAD	[4000]		/MAKE IT UNSIGNED
	DCA	Y		/SAVE SECOND ARGUMENT AS Y VALUE
	JMS	POPAC		/GET PREVIOUS ARGUMENT
	TAD	[4000]		/MAKE IT UNSIGNED
	DCA	X		/SAVE FIRST ARGUMENT AS X VALUE
	JMS I	[GETARG]	/GET THIRD ARGUMENT
	JMP I	(DOPOINT)	/WASN'T ANY
	AND	[7]		/JUST VALID BITS
	TAD	(JMP I	MODTABL)/MAKE IT PROPER JUMP INSTRUCTION
	DCA	.+1		/STORE IN-LINE
	JMP I	MODTABLE+.-.	/WILL BE PROPER JUMP INSTRUCTION

/	JUMP TABLE FOR EXTENDED MODES.

MODTABL,DOSTRING		/FDIS(X,Y,0,"STRING",S,R)
	DOCHAR			/FDIS(X,Y,1,CHARACTER,S,R)
	DONUMBER		/FDIS(X,Y,2,VALUE,LENGTH,S,R)
	DOVADDR			/FDIS(X,Y,3) SET VECTOR STARTING ADDRESS
	DOVECTOR		/FDIS(X,Y,4) DRAW VECTOR FROM PREVIOUS ADDRESS
	STRER1			/FDIS(X,Y,5) ILLEGAL
	STRER1			/FDIS(X,Y,6) ILLEGAL
	STRER1			/FDIS(X,Y,7) ILLEGAL
/	COMES HERE TO DO STRING OUTPUT.

DOSTRIN,TAD I	[CHAR]		/GET LAST CHARACTER
	TAD	[-",]		/COMPARE TO COMMA
	SZA CLA			/SKIP IF IT MATCHES
	JMP I	[STRER2]	/COMPLAIN IF NOT
	JMS I	(GETSTRING)	/GET STRING ARGUMENT
NUMENTR,JMS I	[GETARG]	/GET FIFTH ARGUMENT
	TAD	(DEFSIZE)	/USE DEFAULT SIZE (CAN'T HAPPEN IF STRING CALL)
	DCA	SIZE		/SAVE AS SIZE FOR NOW
	JMS I	[GETARG]	/GET FIFTH ARGUMENT
	TAD	(DEFROTATE)	/USE DEFAULT ROTATE VALUE
	DCA	ROTATE		/STORE ROTATE VALUE
	TAD	SIZE		/GET SIZE VALUE
	SPA CLA			/SKIP IF POSITIVE
	TAD	("<-"=)		/MAKE IT "<" IF NEGATIVE
	TAD	("=&177)	/GET "=" AT LEAST
	DCA	SLANTBUFFER+1	/STORE IN STRING
	TAD	SIZE		/GET SIZE VALUE
	SPA			/SKIP IF POSITIVE
	CIA			/ELSE MAKE IT SO
	AND	[7]		/JUST OFFSET BITS
	TAD	(SIZTABLE)	/POINT AT TABLE ELEMENT
	DCA	SIZE		/STASH THE POINTER
	CDF	DFIELD		/GOTO OUR FIELD
	TAD I	SIZE		/GET THE VALUE
	DCA	SIZBUFFER+1	/STORE IN STRING
	TAD	ROTATE		/GET ROTATE VALUE
	AND	[3]		/JUST OFFSET BITS
	CLL RAL			/*2
	TAD	["0&177]	/MAKE IT ASCII
	DCA	ROTBUFFER+2	/STORE IN STRING
	JMS I	[SETADR]	/SETUP ADDRESS STRING
	JMS I	[STROUT]	/OUTPUT TO TERMINAL
	SLANTBUFFER		/SLANT STRING
	SIZBUFFER		/SIZE STRING
	ROTBUFFER		/ROTATE STRING
	VECMODE			/GO INTO VECTOR MODE
	ADRBUFFER		/ADDRESS BUFFER
	ANOMOVE			/BACK TO ALPHA MODE
	STRBUFFER		/STRING BUFFER
	0			/THIS ENDS THE LIST
	JMP	DISPRETURN	/FINISH IT THERE

/	COMES HERE TO DO CHARACTER OUTPUT.

DOCHAR,	JMS I	[GETARG]	/GET CHARACTER ARGUMENT
	JMP I	[STRER2]	/WASN'T ANY
	CDF	DFIELD		/GOTO OUR FIELD
	AND	[177]		/JUST ASCII VALUE
	DCA I	[STRBUFFER]	/STORE IN BUFFER
	DCA I	(STRBUFFER+1)	/DELIMIT BUFFER
	JMP	NUMENTRY	/CONTINUE THERE
ROTBUFF,ESC;	"/&177;	.-.	/ROTATE SEQUENCE BUFFER
	"E&177+40;	0
SIZBUFF,ESC;	ZBLOCK	2	/SIZE SEQUENCE BUFFER
SLANTBU,ESC;	ZBLOCK	2	/SLANT SEQUENCE BUFFER

	PAGE
/	COMES HERE TO DO NUMERIC OUTPUT.

DONUMBE,JMS I	[GETARG]	/GET THE VALUE
	JMP I	[STRER2]	/WASN'T ANY
	DCA	NUMTEMP		/STASH IT FOR NOW
	JMS I	[GETARG]	/GET THE LENGTH
	TAD	(DEFLENGTH)	/WASN'T ANY, USE DEFAULT VALUE
	SNA			/SKIP IF NON-ZERO
	TAD	(DEFLENGTH)	/USE DEFAULT INSTEAD OF ZERO
	TAD	[-5]		/COMPARE TO UPPER LIMIT
	CLL			/CLEAR LINK FOR TEST
	TAD	[4]		/ADD ON RANGE
	SNL			/SKIP IF OK
	JMP I	[STRER1]	/JUMP IF NOT
	CMA			/INVERT SENSE OF LENGTH
	TAD	(DIGBUFFER+4)	/NOW POINTING TO PROPER PLACE IN THE DIGIT BUFFER
	DCA	SIZE		/STASH THE POINTER
	CDF	DFIELD		/GOTO OUR FIELD
	TAD	NUMTEMP		/GET THE VALUE
	JMS	DIVIDE		/DIVIDE BY 1000
	1750			/RIP JSB
	TAD	["0&177]	/MAKE IT ASCII
	DCA	DIGBUFFER+0	/STORE FIRST DIGIT
	TAD	REM		/GET THE REMAINDER
	JMS	DIVIDE		/DIVIDE BY
	144			/100
	TAD	["0&177]	/MAKE IT ASCII
	DCA	DIGBUFFER+1	/STORE SECOND DIGIT
	TAD	REM		/GET THE REMAINDER
	JMS	DIVIDE		/DIVIDE BY
	12			/10
	TAD	["0&177]	/MAKE IT ASCII
	DCA	DIGBUFFER+2	/STORE THIRD DIGIT
	TAD	REM		/GET REMAINDER
	TAD	["0&177]	/MAKE IT ASCII
	DCA	DIGBUFFER+3	/STORE FOURTH DIGIT
	TAD	[-5]		/SETUP THE
	DCA	ROTATE		/MOVE COUNT
	TAD	[STRBUFFER]	/SETUP THE
	DCA	STRPTR		/STRING POINTER
DMVLUP,	TAD I	SIZE		/GET DESIRED DIGIT
	DCA I	STRPTR		/STORE IN STRING BUFFER
	ISZ	SIZE		/BUMP TO NEXT
	ISZ	STRPTR		/BUMP TO NEXT
	ISZ	ROTATE		/DONE ENOUGH?
	JMP	DMVLUP		/NO, KEEP GOING
	JMP I	(NUMENTRY)	/YES, CONTINUE THERE
/	COMES HERE TO SET THE VECTOR ADDRESS.

DOVADDR,JMS I	[SETADR]	/SETUP THE ADDRESS FROM (X,Y)
	JMS I	[STROUT]	/OUTPUT TO TERMINAL
	VECMODE			/GO INTO VECTOR MODE
	ADRBUFFER		/ADDRESS BUFFER
	0			/THIS ENDS THE LIST
	JMP I	(DISPRETURN)	/FINISH IT THERE

/	C0MES HERE TO DRAW A VECTOR.

DOVECTO,JMS I	[SETADR]	/SETUP THE ADDRESS FROM (X,Y)
	JMS I	[STROUT]	/OUTPUT TO TERMINAL
	ADRBUFFER		/ADDRESS BUFFER
	0			/THIS ENDS THE LIST
	JMP I	(DISPRETURN)	/FINISH IT THERE

/	COMES HERE IF "FDIS(ONE ARGUMENT)".

DISP1,	JMS	POPAC		/RETRIEVE THE ARGUMENT
	SZA CLA			/SKIP IF ZERO
	JMP I	(DISPRETURN)	/ELSE IGNORE IT
	JMS I	[STROUT]	/CALL STRING OUTPUT ROUTINE
	CLRMEM			/TO CLEAR THE SCREEN
	0			/END OF LIST
	JMP I	(DISPRETURN)	/FINISH IT THERE

/	COMES HERE TO OUTPUT AN X, Y POINT.

DOPOINT,JMS I	[SETADR]	/SETUP DISPLAY ADDRESS BUFFER
	JMS I	[STROUT]	/SEND THE
	PPM			/GOTO POINT PLOT MODE
	ADRBUFFER		/POINT ADDRESS
	0			/THIS ENDS THE LIST
	JMP I	(DISPRETURN)	/CONTINUE THERE

/	DIVIDE ROUTINE.

DIVIDE,	.-.			/DIVIDE ROUTINE
	DCA	REM		/SAVE IN REMAINDER
	DCA	QUO		/CLEAR QUOTIENT
	TAD	REM		/GET IT BACK
	STL CIA			/INVERT
	SKP			/DON'T FIRST TIME
DVLOOP,	ISZ	QUO		/BUMP UP QUOTIENT
	TAD I	DIVIDE		/ADD ON ARGUMENT
	SNA SZL			/UNDERFLOW?
	JMP	DVLOOP		/NO, KEEP GOING
	CIA			/YES, INVERT IT BACK
	TAD I	DIVIDE		/RESTORE LOST VALUE
	DCA	REM		/SAVE AS REMAINDER
	TAD	QUO		/GET THE QUOTIENT
	ISZ	DIVIDE		/BUMP PAST ARGUMENT
	JMP I	DIVIDE		/RETURN
DIGBUFF,ZBLOCK	5		/DIGIT BUFFER
NUMTEMP,.-.			/NUMBER TEMPORARY
REM,	.-.			/DIVIDE REMAINDER
QUO,	.-.			/DIVIDE QUOTIENT

	PAGE
/	PROCESS STRING ARGUMENT ROUTINE.

GETSTRI,.-.			/GET A STRING ROUTINE
	NL7777			/SET -1
	DCA	PREVCHAR	/INDICATE NO PREVIOUS CHARACTER
	TAD	[STRBUFFER]	/POINT TO
	DCA	STRPTR		/STRING BUFFER
	TAD	[40]		/SETUP THE
	DCA	CASE		/DEFAULT CASE
GETSLUP,JMS	DOAGETC		/GET A CHARACTER FROM FOCAL
	TAD I	[CHAR]		/GET THE CHARACTER
	CDF	DFIELD		/BACK TO OUR FIELD
	AND	[177]		/JUST SEVEN-BIT
	DCA	LATCHAR		/SAVE IT
	TAD	LATCHAR		/GET IT BACK
	AND	[140]		/JUST QUADRANT BITS
	TAD	[-140]		/COMPARE TO LOWER-CASE
	SNA CLA			/SKIP IF OTHER
	TAD	[-40]		/MAKE IT UPPER-CASE
	TAD	LATCHAR		/ADD ON LATEST CHARACTER
	TAD	(-"I!300)	/COMPARE TO <HT>
	SNA			/SKIP IF NOT <HT>
	TAD	(" -"I&77)	/ELSE CONVERT TO <SPACE>
	TAD	("I&37)		/RESTORE THE CHARACTER
	DCA	LATCHAR		/STORE IT
	TAD	LATCHAR		/GET CORRECTED LATEST CHARACTER
	TAD	(-""!200)	/COMPARE TO STRING DELIMITER
	SNA			/SKIP IF OTHER
	JMP	TSTQUOTE	/JUMP IF IT MATCHES
	TAD	(-",+"")	/COMPARE TO COMMA
	SNA			/SKIP IF OTHER
	JMP	TSTCOMMA	/JUMP IF IT MATCHES
	TAD	(-"^+",)	/COMPARE TO UP-ARROW
	SNA CLA			/SKIP IF OTHER
	JMP	TSTUPARROW	/JUMP IF IT MATCHES
	TAD	LATCHAR		/GET LATEST CHARACTER
	AND	[140]		/JUST QUADRANT BITS
	SNA CLA			/SKIP IF NOT CONTROL CHARACTER
	JMP	STRER1		/JUMP IF BAD CONTROL CHARACTER
	TAD	PREVCHAR	/GET PREVIOUS CHARACTER
	SPA CLA			/SKIP IF THIS NON-DELIMITER IS NOT FIRST
	JMP	STRER2		/JUMP IF FIRST NOT DELIMITER
OUTCHAR,TAD	LATCHAR		/GET THE LATEST CHARACTER
	AND	[100]		/JUST ALPHA BIT
	SZA CLA			/SKIP IF NOT SET
	TAD	CASE		/ELSE BIAS WITH LATEST CASE
	TAD	LATCHAR		/ADD ON LATEST CHARACTER
OUTQUOT,DCA I	STRPTR		/STORE IN THE BUFFER
	ISZ	STRPTR		/BUMP TO NEXT
NXTCHAR,CLA			/ENSURE CLEAR AC
	TAD	LATCHAR		/GET LATEST CHARACTER
	DCA	PREVCHAR	/MAKE IT THE PREVIOUS CHARACTER FOR NEXT TIME
	JMP	GETSLUP		/GO GET ANOTHER CHARACTER
/	COMES HERE WHEN STRING DELIMITER IS FOUND.

TSTQUOT,TAD	PREVCHAR	/GET PREVIOUS CHARACTER
	SPA			/SKIP IF NOT FIRST TIME
	JMP	NXTCHAR		/ELSE JUST KEEP GOING
	TAD	(-""!200)	/WAS PREVIOUS SAME AS LATEST?
	SZA CLA			/SKIP IF SO
	JMP	NXTCHAR		/JUST KEEP GOING IF NOT
UPARENT,DCA	LATCHAR		/CLEAR PREVIOUS CHARACTER (EVENTUALLY)
	TAD	PREVCHAR	/GET A QUOTE CHARACTER
	JMP	OUTQUOTE	/CONTINUE THERE

/	COMES HERE WHEN A COMMA IS FOUND.

TSTCOMM,TAD	PREVCHAR	/GET PREVIOUS CHARACTER
	TAD	(-""!200)	/COMPARE TO DELIMITER
	SZA CLA			/SKIP IF AT END OF STRING
	JMP	OUTCHAR		/JUST OUTPUT AN IMBEDDED COMMA
	DCA I	STRPTR		/DELIMIT THE STRING
	JMP I	GETSTRING	/RETURN TO CALLER

/	COMES HERE WHEN AN UP-ARROW IS FOUND.

TSTUPAR,TAD	CASE		/GET CURRENT CASE
	CIA			/INVERT IT
	TAD	[40+0]		/ADD ON SUM OF BOTH VALUES
	DCA	CASE		/SAVE NEW CASE
	TAD	PREVCHAR	/GET PREVIOUS CHARACTER
	TAD	(-"^!200)	/COMPARE TO UP-ARROW
	SZA CLA			/SKIP IF SAME AS PREVIOUS
	JMP	NXTCHAR		/JUST KEEP GOING
	JMP	UPARENTRY	/CONTINUE THERE

/	COMES HERE WHEN FIRST CHARACTER IS NOT STRING DELIMITER.

STRER1,	NL0001			/SET OFFSET

/	COMES HERE WHEN THERE IS NO TERMINATING STRING DELIMITER.

STRER2,	TAD	(XDYS+7)	/GET ERROR ADDRESS
	CIF CDF	PRGFLD		/GOTO MAIN FIELD
	JMP I	[ERROR5]	/GO COMPLAIN THERE
GETARG,	.-.			/GET ARGUMENT EVALUATED ROUTINE
	CDF	PRGFLD		/ENSURE MAIN FIELD
	TAD I	[CHAR]		/GET PREVIOUS CHARACTER
	TAD	[-",]		/COMPARE TO COMMA
	SZA CLA			/SKIP IF IT MATCHES
	JMP I	GETARG		/TAKE IMMEDIATE RETURN IF NO ARGUMENT
	TAD	(EVALRETURN)	/GET OUR ADDRESS
	JMS	FIXPUSH		/PUT ON STACK
	TAD	(GTARGXIT)	/GET OUR ADDRESS
	DCA	FIXPUSH		/MAKE IT COME BACK TO US
	CIF CDF	PRGFLD		/GOTO MAIN FIELD
	JMP I	(EVAL-1)	/GO DO A PUSHJ;EVAL-1

/	COMES BACK HERE FROM EVAL-1.

GTARGXI,JMS	FIXPUSH		/FIX THE ARGUMENT
	JMS	POPAC		/GET IT BACK
	ISZ	GETARG		/BUMP RETURN ADDRESS
	JMP I	GETARG		/TAKE SKIP RETURN

	PAGE
SETADR,	.-.			/ADDRESS SETUP ROUTINE
	CDF	DFIELD		/ENSURE OUR FIELD
SETZAP,	JMP	SET4010		/**** NOT /1 **** NOP
	TAD	Y		/GET Y ADDRESS
	RTL;RTL;RTL		/%200
	AND	[37]		/JUST HIGH FIVE BITS
	TAD	[40]		/MAKE IT ASCII
	DCA	ADRBUFFER+0	/STORE AS HI-Y
	TAD	Y		/GET Y AGAIN
	AND	[3]		/JUST LOW TWO BITS
	CLL RTL			/MOVE UP
	DCA	ADRBUFFER+1	/SAVE FOR NOW
	TAD	Y		/GET Y AGAIN
	RTR			/%4
	AND	[37]		/JUST MIDDLE FIVE BITS
	TAD	[140]		/MAKE IT ASCII
	DCA	ADRBUFFER+2	/STORE AS LO-Y
	TAD	X		/GET X ADDRESS
	RTL;RTL;RTL		/%200
	AND	[37]		/JUST HIGH FIVE BITS
	TAD	[40]		/MAKE IT ASCII
	DCA	ADRBUFFER+3	/STORE AS HI-X
	TAD	X		/GET X AGAIN
	RTR			/%4
	AND	[37]		/JUST MIDDLE FIVE BITS
	TAD	[100]		/MAKE IT ASCII
	DCA	ADRBUFFER+4	/STORE AS LO-X
	TAD	X		/GET X AGAIN
	AND	[3]		/JUST LOW TWO BITS
	TAD	ADRBUFFER+1	/ADD ON LOW Y BITS (SHIFTED)
	TAD	[140]		/MAKE IT ASCII WITH MARGIN 1
	DCA	ADRBUFFER+1	/STORE COMPOSITE EXTRA BYTE
	JMP I	SETADR		/RETURN
/	COMES HERE IF IN 4010 ADDRESS MODE.

SET4010,TAD	Y		/GET UNSIGNED Y VALUE
	MQL			/TO LOW-ORDER
	JMS	XMUY		/MULTIPLY
	1414			/BY 780
	DCA	Y		/STORE BACK
	TAD	Y		/GET Y VALUE
	RTR;RTR;RAR		/%40
	AND	[37]		/JUST HIGH FIVE BITS
	TAD	[40]		/MAKE IT ASCII
	DCA	ADRBUFFER+0	/STORE AS HI-Y
	TAD	Y		/GET Y AGAIN
	AND	[37]		/JUST FIVE LOW BITS
	TAD	[140]		/MAKE IT ASCII
	DCA	ADRBUFFER+1	/STORE AS LO-Y
	TAD	X		/GET X VALUE
	RTL;RTL;RTL		/%200
	AND	[37]		/JUST HIGH FIVE BITS
	TAD	[40]		/MAKE IT ASCII
	DCA	ADRBUFFER+2	/STORE AS HI-X
	TAD	X		/GET X AGAIN
	RTR			/%4
	AND	[37]		/JUST FIVE MIDDLE BITS
	TAD	[100]		/MAKE IT ASCII
	DCA	ADRBUFFER+3	/STORE AS LO-X
	JMP I	SETADR		/RETURN

/	MULTIPLY ROUTINE.

XMUY,	.-.			/MULTIPLY ROUTINE
	CLA CLL			/CLEAN UP
	TAD	(-15)		/SETUP THE
	DCA	XMUYCT		/SHIFT COUNTER
XMUYUP,	RAR			/SHIFT RIGHT
	SWP			/INTO LOW-ORDER; GET LOW-ORDER
	RAR			/SHIFT RIGHT
	SWP			/RETURN TO LOW-ORDER; GET ORIGINAL HIGH-ORDER
	ISZ	XMUYCT		/SHIFTED ENOUGH?
	SKP			/SKIP IF NOT
	JMP	XMUYEXT		/EXIT IF SO
	SNL			/LATEST BIT ON
	JMP	XMUYUP		/NO, JUST KEEP GOING
	CLL			/YES, CLEAR LINK FOR PROPER CARRY
	TAD I	XMUY		/ADD ON ARGUMENT VALUE
	JMP	XMUYUP		/KEEP GOING

XMUYEXT,ISZ	XMUY		/BUMP PAST THE ARGUMENT
	JMP I	XMUY		/RETURN

XMUYCT,	.-.			/SHIFT COUNTER
ADRBUFF,ZBLOCK	6		/ADDRESS TRANSMISSION BUFFER

	PAGE
/	STRING OUTPUT ROUTINE.

STROUT,	.-.			/STRING OUTPUT ROUTINE
	CDF	DFIELD		/ENSURE OUR FIELD
STRLUP,	TAD I	STROUT		/GET AN ARGUMENT
	SNA			/SKIP IF END OF ARGUMENTS
	JMP I	STROUT		/RETURN IF NO MORE STRINGS
	DCA	STRPTR		/STASH THE LATEST POINTER
	ISZ	STROUT		/BUMP TO NEXT ARGUMENT FOR NEXT TIME
STRLOOP,TAD I	STRPTR		/GET A CHARACTER
	SNA			/END OF A STRING?
	JMP	STRLUP		/YES, GO GET ANOTHER STRING
	JMS	TERMOUT		/NO, SEND THIS CHARACTER
	ISZ	STRPTR		/BUMP TO NEXT
	JMP	STRLOOP		/GO DO ANOTHER CHARACTER

TERMOUT,.-.			/TERMINAL OUTPUT ROUTINE
	DCA	TERMTMP		/SAVE PASSED VALUE
TERMLUP,JMS	INTEST		/TEST FOR DC1/DC3
	TAD	TERMTMP		/GET THE CHARACTER
	RTSFIOT			/FLAG UP?
	JMP	TERMLUP		/NO, WAIT FOR IT
	RTLSIOT			/YES, OUTPUT IT
	JMS	INTEST		/TEST FOR DC1/DC3
	JMP I	TERMOUT		/RETURN

INTEST,	.-.			/TEST FOR DC1/DC3 INPUT
	JMS	INCHAR		/TEST FOR A CHARACTER
	JMP I	INTEST		/WASN'T ANY
	TAD	(-"S!300)	/COMPARE TO <^S>
	SZA CLA			/SKIP IF IT MATCHES
	JMP I	INTEST		/RETURN IF NOT
INWAIT,	JMS	INCHAR		/TEST FOR A CHARACTER
	JMP	INWAIT		/MUST WAIT FOR IT
	TAD	(-"Q!300)	/COMPARE TO <^Q>
	SZA CLA			/SKIP IF IT MATCHES
	JMP	INWAIT		/GO BACK AND WAIT FOR IT
	JMP I	INTEST		/RETURN

INCHAR,	.-.			/GET AN INPUT CHARACTER
	CLA			/CLEAN UP
	RKSFIOT			/FLAG UP?
	JMP I	INCHAR		/NO, JUST RETURN
	RKRBIOT			/YES, READ IT IN
	AND	[177]		/JUST SEVEN-BIT
	ISZ	INCHAR		/BUMP RETURN ADDRESS
	JMP I	INCHAR		/TAKE SKIP RETURN
/	TERMINAL INITIALIZATION ROUTINE.

INITERM,.-.			/INITIALIZE THE TERMINAL
	CLA			/CLEAN UP
	RKIEIOT			/PREVENT TERMINAL INTERRUPTS
	RTLSIOT			/SET OUTPUT FLAG
	CDF	PRGFLD		/ENSURE MAIN FIELD
	TAD I	(SWMX)		/GET /M-/X SWITCHES
	RAR			/X TO LINK
	SZL CLA			/SKIP IF NOT SET
	DCA	XZAP		/ELSE ZAP THE LIST OUT
	TAD I	(SWY9)		/GET /Y-/9 SWITCHES
	AND	(400)		/JUST /1 SWITCH
	SZA CLA			/SKIP IF OFF
	JMP	LEAVIT		/JUMP IF ON
	TAD	(NOP)		/GET A NOP
	CDF	DFIELD		/GOTO OUR FIELD
	DCA I	(SETZAP)	/ZAP IT IN
LEAVIT,	JMS I	[STROUT]	/SEND STRINGS TO TERMINAL
XZAP,	BLAMEM			/BLANK THE ALPHA SCREEN **** /X **** 0000
	UNGMEM			/UNBLANK THE GRAPHICS SCREEN
	DSGMEM			/DISPLAY THE GRAPHICS MEMORY
	NDSPACE			/NON-DESTRUCTIVE SPACE IN GRAPHICS ALPHA MODE
	EGACLR			/ENTER GRAPHICS ALPHA MODE, CLEAR SCREEN
	0			/THIS ENDS THE LIST
	CIF CDF	PRGFLD		/GOTO MAIN FIELD
	JMP I	INITERMINAL	/RETURN

	PAGE
STRBUFF,ZBLOCK	201				/STRING BUFFER

/	TERMINAL SEQUENCES.

/	GOTO ALPHA MODE WITHOUT CHANGING POSITION (FROM VECTOR MODE).

ANOMOVE,US;	0				/JUST GOTO ALPHA MODE

/	BLANK ALPHA MEMORY.

BLAMEM,	ESC;	"[&177;	"1&177;	"/&177		/BLANK ALPHA MEMORY
	"V&177+40;	0

/	CLEAR GRAPHICS MEMORY.

CLRMEM,	ESC;	"Y&37;	0			/CLEAR GRAPHICS MEMORY

/	DISPLAY GRAPHICS MEMORY.

DSGMEM,	ESC;	"T&37;	0			/DISPLAY GRAPHICS MEMORY

/	ENTER GRAPHICS ALPHA MODE, CLEAR GRAPHICS MEMORY.

EGACLR,	ESC;	"L&37;	0			/GRAPHICS ALPHA WITH CLEAR

/	NON-DESTRUCTIVE <SPACE> CHARACTER IN GRAPHICS ALPHA MODE.

NDSPACE,ESC;	"/&177;	"2&177;	"L&177+40	/SPACE JUST MOVES

/	ENTER POINT PLOT MODE.

PPM,	FS;	0				/ENTER POINT PLOT MODE
/	UNBLANK GRAPHICS MEMORY.

UNGMEM,	ESC;	"[&177;	"2&177;	"/&177		/UNBLANK GRAPHICS MEMORY
	"V&177+40;	0

/	GOTO VECTOR MODE (FROM POINT PLOT MODE).

VECMODE,"]&37;	0				/GOTO VECTOR MODE

/	CHARACTER SIZE TABLE.

SIZTABL,";&177					/SMALLEST
	":&177					/VERY SMALL
	"9&177					/SMALL
	"8&177					/STANDARD
	"1&177					/DOUBLE
	"2&177					/TRIPLE
	"3&177					/QUADRUPLE
	"8&177					/STANDARD (ALTERNATE)
	FIELD	PRGFLD%10	/BACK TO FIELD ZERO
/	ONCE-ONLY CODE STARTS HERE.

	*BONCE			/OVER DEFAULT ONCE-ONLY AREA

BONCE,	CIF	DFIELD		/GOTO CODE FIELD
	JMS I	(INITERMINAL)	/INITIALIZE TERMINAL INTO POINT PLOT MODE
	DCA I	(BEOFZAP)	/REPAIR LOADER
	JMP I	(BEOFZAP)	/RESUME LOADING

	PAGE

	*BEOFZAP		/OVER LOADER

	SKP			/MAKE IT COME TO US

	$			/THAT'S ALL FOLK!