TITLE	'SCRRTN - SCREEN HANDLER SUBROUTINES'
;PROGRAM
;		SCRNRTN - SCREEN HANDLER SUBROUTINES
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		DECEMBER 1, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS SET OF SUBROUTINES GIVE THE USER VARIOUS
;		SCREEN PROCESSING SUBROUTINES LIKE CLEAR, ERASE-
;		TO-END-OF-LINE, ETC.
;REMARKS
;		1. SEE EACH ROUTINE FOR A DESCRIPTION OF WHAT
;		   IT DOES.
;		2. THESE ROUTINES WERE MEANT TO BE UTILIZED WITH
;		   THE PL/I-80 SYSTEM DISTRIBUTED BY DIGITAL 
;		   RESEARCH OF CALIFORNIA.
;		3. ALL ROUTINES ASSUME THAT THE CP/M CONSOLE IS
;		   A VIDEO DEVICE SUCH AS A SOROC-120 OR TRS-80.

;		* * *  MACLIBS & MISC INITIALIZATION  * * *
	MACLIB	SCRNMAC
BDOS	EQU	00005H		;BDOS ENTRY POINT
DFCB	EQU	005CH		;DEFAULT FCB
	TRMDFN			;DEFINE THE TERMINAL ENVIRONMENT.
	NAME	'SCRRTN'
SCRRTN:	CSEG

	PAGE
;***********************************************************
;*        GET A CHARACTER FROM THE CONSOLE W/O WAIT        *
;***********************************************************
;	PERFORM CONSOLE INPUT, CHAR RETURNED IN STACK,
;				000H IF NO CHAR
CONINP:
	PUBLIC	CONINP
	MVI	E,0FFH		;SET FOR INPUT.
	MVI	C,6		;GET IT.
	CALL	BDOS
	POP	H		;RETURN ADDRESS
	PUSH	PSW		;CHARACTER TO STACK
	INX	SP		;DELETE FLAGS
	MVI	A,1		;CHARACTER LENGTH IS 1
	PCHL			;BACK TO CALLING ROUTINE


;***********************************************************
;*           PUT A CHARACTER TO THE CONSOLE.               *
;***********************************************************
;	DIRECT CONSOLE OUTPUT
;	1->CHAR(1)
CONOUT:
	PUBLIC	CONOUT
	CALL	GETP1		;GET PARAMETER
	MVI	C,6		;DIRECT CONSOLE I/O
	JMP	?BDOS		;DO IT AND RETURN.
	EXTRN	?BDOS


;***********************************************************
;*                                                         *
;*       GENERAL PURPOSE ROUTINES USED UPON ENTRY          *
;*                                                         *
;***********************************************************
;
;	GET SINGLE BYTE PARAMETER TO REGISTER E
GETP1:
	MOV	E,M		;LOW (ADDR)
	INX	H
	MOV	D,M		;HIGH(ADDR)
	XCHG			;HL = .CHAR
	MOV	E,M		;TO REGISTER DE
	INX	H
	MOV	D,M
	RET
	PAGE
;****************************************************************
;*      CHRINP/CHROUT - CHARACTER I/O ROUTINES                  *
;****************************************************************

;PROGRAM
;		CHRINP/CHROUT - CHARACTER I/O ROUTINES
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THESE ROUTINES GET OR PUT A CHARACTER FROM/TO THE
;		VIDEO TERMINAL.
;REMARKS
;		1. FOR INTERNAL USE ONLY.

;		GET A CHARACTER.
CHRINP:	
	PUSH	B		;SAVE REGISTERS.
	PUSH	D
	PUSH	H
CHRINP$LOOP:
	MVI	E,0FFH		;SET FOR INPUT.
	MVI	C,6		;GET IT.
	CALL	BDOS
	ORA	A		;CHARACTER AVAILABLE?
	JZ	CHRINP$LOOP	;...NO.
	POP	H		;RESTORE REGS.
	POP	D
	POP	B
	RET			;RETURN TO CALLER.

;		PUT A CHARACTER.
CHROUT:	
	PUSH	B		;SAVE REGISTERS.
	PUSH	D
	PUSH	H
	MOV	E,A		;GET THE CHAR.
	MVI	C,6		;OUTPUT IT.
	CALL	BDOS
	POP	H		;RESTORE REGS.
	POP	D
	POP	B
	RET			;RETURN TO CALLER.

;		PUT A STRING.
STROUT:	
	PUBLIC	STROUT
	MOV	C,M		;GET ITS LENGTH.
	INX	H
STROUT$LOOP:
	MOV	A,M		;OUTPUT A CHAR.
	CALL	CHROUT
	INX	H		;BUMP PTR.
	DCR	C		;DECR COUNT.
	JNZ	STROUT$LOOP	;LOOP FOR ALL CHARS.
	RET			;RETURN TO CALLER.

	PAGE
;****************************************************************
;*              CLRSCR - CLEAR THE SCREEN                       *
;****************************************************************

;PROGRAM
;		CLRSCR - CLEAR THE SCREEN
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		DECEMBER 1, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS SUBROUTINE CLEARS THE VIDEO SCREEN HOMING
;		THE CURSOR.
;INPUT
;		NONE
;REMARKS

;		DO INITIALIZATION.
CLRSCR:
	PUBLIC	CLRSCR

;		DO IT.
	IF	SOROC$120
	CALL	$+3+6
	DB	5,01BH,02AH,000H,000H,000H
	POP	H
	JMP	STROUT
	ENDIF
	IF	ADM3A
	MVI	A,01AH
	JMP	CHROUT
	ENDIF
	PAGE
;****************************************************************
;*              EOL - ERASE TO END OF LINE                      *
;****************************************************************

;PROGRAM
;		TERMINAL ERASE LINE PROGRAM
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE ERASES A LINE ON THE CP/M CONSOLE.
;INPUT
;		HL <= PL/1 PARAMETER LIST (2 PARMS)
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;OUTPUT
;REMARKS

;		DO INITIALIZATION.
EOL:	
	PUBLIC	EOL

;		SET THE CURSOR.
	CALL	GOTOXY

;		ISSUE THE ERASE LINE COMMAND.
	IF	SOROC$120
	CALL	$+3+4
	DB	3,01BH,054H,000H
	POP	H
	JMP	STROUT
	ENDIF
	IF	ADM3A
	MVI	A,TRMCOL	;GET # OF REMAINING COLS.
	SUB	C
	MOV	C,A		;SAVE IT.
EOL$LOOP:
	MVI	A,' '		;OUTPUT A BLANK.
	CALL	CHROUT
	DCR	C		;LOOP FOR REMAINING COLS.
	JNZ	EOL$LOOP
	RET			;RETURN TO CALLER.
	ENDIF
	PAGE
;****************************************************************
;*             GETB15 - GET A BINARY NUMBER (15 BIT)            *
;****************************************************************

;PROGRAM
;		GETB15 - GET A BINARY NUMBER (15 BIT)
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		DECEMBER 1, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PUTS A CHARACTER STRING
;		TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;			PARM3 = BINARY NUMBER (RETURNED)
;			PARM4 = LOW RANGE CHECK NUMBER
;			PARM5 = HIGH RANGE CHECK NUMBER
;			PARM6 = RETURN CODE
;REMARKS

;		DO INITIALIZATION.
GETB15:	
	PUBLIC	GETB15
	MVI	A,6		;SET # OF PARMS.
	CALL	MOVPRM		;GET THE PARAMETER PTRS.
	CALL	SAVPRM		;SAVE THEM

;		GET A SIX-BYTE STRING FROM CONSOLE.
GETB15$BGN:
	LXI	H,CONSIX	;PASS ON STRING LENGTH.
	SHLD	PRM3PTR
	LXI	H,WRKSTR+1	;PASS ON STRING AREA.
	SHLD	WRKPTR
	LXI	H,WRKPTR
	SHLD	PRM4PTR
	LHLD	PRM6PTR		;PASS ON RETURN CODE.
	SHLD	PRM5PTR
	LXI	H,PRMPTRS	;GET THE STRING.
	CALL	GETSTR

;		CONVERT THE STRING TO A NUMBER.
	MVI	A,6		;GET LENGTH.
	LXI	D,WRKSTR+1	;POINT TO STRING.
	CALL	AB16		;DO IT.
	JNC	GETB15$OK	;...CONVERSION ERROR.
GETB15$ERO:
	MVI	A,7		;BEEP OPERATOR.
	CALL	CHROUT
	JMP	GETB15$BGN
GETB15$OK:
	PUSH	H		;SAVE THE NUMBER.
	XCHG
	LHLD	WRK3PTR		;SAVE IT IN CALLER'S AREA.
	MOV	M,E
	INX	H
	MOV	M,D

;		* * *  RANGE CHECK IT  * * *
;		PUT LOW VALUE IN BC.
	LHLD	WRK4PTR		;GET PTR TO IT.
	MOV	C,M		;PUT IT IN BC.
	INX	H
	MOV	B,M

;		PUT HIGH VALUE IN DE.
	LHLD	WRK5PTR		;GET PTR TO IT.
	MOV	E,M		;PUT IT IN DE.
	INX	H
	MOV	D,M

;		IF BOTH ZERO, BYPASS CHECK.
	MOV	A,B		;ARE THEY ZERO?
	ORA	C
	ORA	D
	ORA	E
	JZ	GETB15$NCK	;...YES, SKIP CHECK.

;		CHECK LOW RANGE.
	POP	H		;GET NUMBER.
	PUSH	H
	MOV	A,L		;SUBTRACT BC FROM IT.
	SUB	C
	MOV	A,H
	SBB	B
	POP	H
	JC	GETB15$ERO	;**TOO SMALL**

;		CHECK HIGH RANGE.
	PUSH	H
	MOV	A,E		;SUBTRACT IT FROM DE.
	SUB	L
	MOV	A,D
	SBB	H
	POP	H
	JC	GETB15$ERO	;**TOO LARGE**
	PUSH	H
GETB15$NCK:

;		PUT IT BACK TO SCREEN.
	LXI	H,WRKPTRS	;SET FOR ORIGINAL PARMS.
	CALL	PUTB15		;DO IT.

;		RETURN TO CALLER W/STRING.
	POP	H		;RETURN THE NUMBER.
	MOV	A,L
	RET

	PAGE
;****************************************************************
;*             GETSTR - GET A CHARACTER STRING                  *
;****************************************************************

;PROGRAM
;		GETSTR - GET A CHARACTER STRING
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		DECEMBER 1, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PUTS A CHARACTER STRING
;		TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;			PARM3 = STRING LENGTH (MAXIMUM)
;			PARM4 = PTR -> STRING AREA (RETURNED)
;			PARM5 = RETURN CODE
;REMARKS

;		DO INITIALIZATION.
GETSTR:	
	PUBLIC	GETSTR
	MVI	A,5		;SET FOR 5 PARMS.
	CALL	MOVPRM		;GET THE PARM PTRS.

;		GET THE STRING LENGTH.
	LHLD	PRM3PTR		;GET ITS PTR.
	MOV	A,M		;GET STRING LENGTH.
	ORA	A		;IF ZERO,
	RZ			;...SIMPLY RETURN.
	CPI	80+1
	RNC

;		SET THE CURSOR.
GETSTR$BGN:
	LXI 	H,PRMPTRS	;GET X,Y PTR.
	CALL	GOTOXY		;DO IT.

;		FILL AREA WITH FIELD INDICATOR.
	LHLD	PRM3PTR		;GET SIZE OF AREA.
	MOV	C,M
GETSTR$INT:
	MVI	A,'_'		;OUTPUT CHAR.
	CALL	CHROUT
	DCR	C		;LOOP FOR ALL CHARS.
	JNZ	GETSTR$INT

;		RESET THE CURSOR.
	LXI	H,PRMPTRS	;GET X,Y COORD.
	CALL	GOTOXY		;DO IT.

;		INITIALIZE FOR INPUT LOOP.
	MVI	C,0		;ZERO INPUT STRING LENGTH.
	LXI	H,PRM4PTR	;POINT TO STRING.
	CALL	GETP1
	XCHG

;		LOOP GETTING NEXT CHARACTER.
GETSTR$LOOP:
	CALL	CHRINP		;GET THE NEXT CHAR.

;		CHECK FOR TERMINATION.
	CPI	1		;CTRL A?
	JZ	GETSTR$RTN	;...YES, RETURN.
	CPI	2		;CTRL B?
	JZ	GETSTR$RTN	;...YES, RETURN.
	CPI	3		;CTRL C?
	JZ	GETSTR$RTN	;...YES, RETURN.
	SUI	13		;RETURN?
	JZ	GETSTR$RTN	;...YES, RETURN.
	ADI	13		;...NO.

;		CHECK FOR RESTART INPUT.
	CPI	7		;CTRL I(TAB)?
	JZ	GETSTR$BGN	;...YES, START OVER.
	CPI	21		;CTRL U?
	JZ	GETSTR$BGN	;...YES, START OVER.

;		CHECK FOR REMOVE-LAST-CHARACTER.
	CPI	8		;CTRL H(BS)?
	JZ	$+8		;...YES, REMOVE LAST CHAR.
	CPI	127		;RUB?
	JNZ	GETSTR$RBB	;...NO, BYPASS THIS SECTION.
	MOV	A,C		;IF NO CHAR YET,
	ORA	A		;...BEEP OPERATOR.
	JNZ	GETSTR$RBC
GETSTR$ERR:
	MVI	A,7		;BEEP OPERATOR.
	CALL	CHROUT
	JMP	GETSTR$LOOP	;GET NEXT CHARACTER.
GETSTR$RBC:
	DCR	C		;RUB THE CHARACTER.
	DCX	H
	MVI	A,8		;REPLACE IT ON SCREEN.
	CALL	CHROUT
	MVI	A,'_'
	CALL	CHROUT
	MVI	A,8
	CALL	CHROUT
	JMP	GETSTR$LOOP	;GET NEXT CHARACTER.
GETSTR$RBB:

;		ADD THE CHARACTER TO THE STRING.
	PUSH	PSW
	PUSH	H
	LHLD	PRM3PTR
	MOV	A,M		;TOO MANY CHARACTERS?
	POP	H
	CMP	C		;...NO, ADD IT.
	JNZ	GETSTR$CHA
	POP	PSW
	JMP	GETSTR$ERR	;BEEP OPERATOR.
GETSTR$CHA:
	POP	PSW
	CPI	32		;VALID CHAR?
	JNC	GETSTR$CHO	;...YES, ADD IT TO STRING.
	JMP	GETSTR$ERR	;BEEP OPERATOR.
GETSTR$CHO:
	INR	C		;BUMP COUNT.
	MOV	M,A		;SAVE THE CHARACTER.
	INX	H
	CALL	CHROUT		;ECHO THE CHARACTER.
	JMP	GETSTR$LOOP	;GET NEXT CHARACTER.

;		ADD TRAILING SPACES TO THE STRING.
GETSTR$RTN:
	PUSH	H
	LHLD	PRM5PTR		;SET RETURN CODE.
	MOV	M,A
	LHLD	PRM3PTR		;GET LENGTH.
	MOV	A,M
	POP	H
	SUB	C		;GET NUMBER OF SPACES.
	JZ	GETSTR$ASB	;NONE, BYPASS.
	MOV	C,A
	MVI	M,' '		;ADD A SPACE.
	INX	H
	DCR	C		;LOOP FOR ALL.
	JNZ	$-4
GETSTR$ASB:

;		REWRITE THE STRING ON THE VIDEO.
	LXI 	H,PRMPTRS	;POINT TO INPUT PARMS.
	CALL	PUTSTR		;PUT IT TO CONSOLE.

;		RETURN TO CALLER.
	RET

	PAGE
;****************************************************************
;*             GOTOXY - SET CURSOR TO (X,Y) COORDINATES         *
;****************************************************************

;PROGRAM
;		TERMINAL SET CURSOR PROGRAM
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE SET THE CURSOR ON THE CP/M CONSOLE
;		TO A PARTICULAR (X,Y) COORDINATES.
;REMARKS

;		DO INITIALIZATION.
GOTOXY:	
	PUBLIC	GOTOXY

;		GET THE X COORDINATE.
	MOV	E,M		;GET X PTR.
	INX	H
	MOV	D,M
	INX	H
	XCHG
	MOV	B,M
	XCHG

;		GET THE Y COORDINATE.
	MOV	E,M		;GET Y PTR.
	INX	H
	MOV	D,M
	INX	H
	XCHG
	MOV	C,M
	XCHG

;		ISSUE SET CURSOR SEQUENCE.
	IF	SOROC$120
	MVI	A,01BH		;ISSUE <ESC>.
	CALL	CHROUT
	MVI	A,'='		;ISSUE '='.
	CALL	CHROUT
	MOV	A,B		;ISSUE X COORDINATE.
	ADI	31
	CALL	CHROUT
	MOV	A,C		;ISSUE Y COORDINATE.
	ADI	31
	CALL	CHROUT
	ENDIF
	IF	ADM3A
	MVI	A,01BH		;ISSUE <ESC>.
	CALL	CHROUT
	MVI	A,'='		;ISSUE '='.
	CALL	CHROUT
	MOV	A,B		;ISSUE X COORDINATE.
	ADI	31
	CALL	CHROUT
	MOV	A,C		;ISSUE Y COORDINATE.
	ADI	31
	CALL	CHROUT
	ENDIF

;		RETURN TO CALLER.
	RET			;RETURN TO CALLER.

	PAGE
;****************************************************************
;*             PUTB15 - PUT A BINARY NUMBER (15 BIT)            *
;****************************************************************

;PROGRAM
;		PUTB15 - PUT A BINARY NUMBER (15 BIT)
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		DECEMBER 1, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PUTS A CHARACTER STRING
;		TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;			PARM3 = NUMBER TO BE PUT
;REMARKS

;		DO INITIALIZATION.
PUTB15:	
	PUBLIC	PUTB15
	MVI	A,3		;SET FOR 3 PARMS.
	CALL	MOVPRM		;SAVE THE PTRS.

;		MOVE IN CURSOR. POSITION IN.
	LXI	H,PRMPTRS
	CALL	GOTOXY		;DO IT.

;		CONVERT THE NUMBER TO ASCII.
	LHLD	PRM3PTR		;GET THE INPUT NUMBER.
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	LXI	D,WRKSTR+1	;POINT TO AREA.
	CALL	BA16		;CONVERT IT.

;		REMOVE LEADING ZEROES.
	LXI	H,WRKSTR+2
	MVI	C,4		;LEAVE AT LEAST ONE.
	MOV	A,M		;IS IT A ZERO?
	CPI	'0'
	JNZ	$+10		;...NO, SKIP REST.
	MVI	M,' '		;...YES, BLANK IT.
	INX	H		;BUMP PTR.
	DCR	C		;DECR COUNT.
	JNZ	$-10		;LOOP FOR ALL CHARS.

;		PUT THE STRING TO THE SCREEN AND RETURN.
	LXI	H,WRKSTR
	MVI	M,6
	JMP	STROUT

	PAGE
;****************************************************************
;*             PUTMSG - PUT A VARYING CHARACTER STRING          *
;****************************************************************

;PROGRAM
;		PUTMSG - PUT A CHARACTER STRING TO THE SCREEN
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PUTS A CHARACTER STRING
;		TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;			PARM3 = STRING
;REMARKS

;		DO INITIALIZATION.
PUTMSG:	
	PUBLIC	PUTMSG

;		SET THE CURSOR.
	PUSH	H		;SAVE POINTER.
	CALL	GOTOXY		;DO IT.
	POP	H		;RESTORE POINTER.

;		POINT TO THE STRING.
	LXI	D,4		;BUMP OVER X,Y STUFF.
	DAD	D
	MOV	E,M		;GET POINTER TO STRING.
	INX	H
	MOV	D,M
	XCHG			;PUT IT IN HL.
	MOV	A,M		;GET STRING LENGTH.
	ORA	A		;NULL STRING?
	RZ			;...YES, RETURN.

;		OUTPUT THE STRING AND RETURN.
	JMP	STROUT		;PUT IT.

	PAGE
;****************************************************************
;*             PUTSTR - PUT A VARYING CHARACTER STRING          *
;****************************************************************

;PROGRAM
;		PUTSTR - PUT A CHARACTER STRING TO THE SCREEN
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PUTS A CHARACTER STRING
;		TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;			PARM3 = STRING LENGTH
;			PARM4 = PTR -> STRING AREA
;REMARKS

;		DO INITIALIZATION.
PUTSTR:	
	PUBLIC	PUTSTR
	MVI	A,4		;GET INPUT PARMS.
	CALL	MOVPRM

;		SET THE CURSOR.
	LXI	H,PRMPTRS	;POINT TO COORDS.
	CALL	GOTOXY		;DO IT.

;		GET ITS LENGTH.
	LHLD	PRM3PTR
	MOV	A,M		;GET STRING LENGTH.
	ORA	A		;NULL STRING?
	RZ			;...YES, RETURN.
	MOV	C,A		;SAVE IT.

;		POINT TO THE STRING.
	PUSH	B		;SAVE LENGTH.
	LXI	H,PRM4PTR	;GET IT.
	CALL	GETP1
	XCHG
	POP	B		;RESTORE IT.

;		OUTPUT THE STRING AND RETURN.
	JMP	STROUT$LOOP	;PUT IT.


	PAGE
;****************************************************************
;*             PUTD92 - PUT A DECIMAL NUMBER (9.2)              *
;****************************************************************

;PROGRAM
;		PUTD92 - PUT A DECIMAL NUMBER (9.2) TO THE SCREEN.
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 23, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PUTS A DECIMAL NUMBER
;		TO A PARTICULAR (X,Y) COORDINATES.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;			PARM1 = X COORDINATE
;			PARM2 = Y COORDINATE
;			PARM3 = PTR -> DECIMAL NUMBER
;REMARKS

;		DO INITIALIZATION.
PUTD92:	
	PUBLIC	PUTD92
	MVI	A,3		;GET INPUT PARMS.
	CALL	MOVPRM

;		SET THE CURSOR.
	LXI	H,PRMPTRS	;POINT TO COORDS.
	CALL	GOTOXY		;DO IT.

;		MOVE THE  NUMBER TO THE WORK AREA.
	LHLD	PRM3PTR		;POINT TO THE NUMBER.
	MOV	E,M
	INX	H
	MOV	D,M
	LXI	H,WRKDEC	;POINT TO WORK AREA.
	MVI	C,5
PUTD92$LOOP:
	LDAX	D
	MOV	M,A
	INX	H
	INX	D
	DCR	C
	JNZ	PUTD92$LOOP

;		SET THE SIGN.
	LXI 	H,WRKDEC+4	;POINT TO THE SIGN BYTE.
	MOV	A,M
	ANI	0F0H
	MVI	A,' '		;DEFAULT TO POSITIVE.
	JZ	$+5		;...POSITIVE.
	MVI	A,'-'
	STA	WRKSGN		;SAVE IT.

;		COMPLEMENT THE NUMBER IF NEGATIVE.
	LXI	H,WRKDEC	;POINT TO THE NUMBER.
	CPI	'-'		;IS IT NEGATIVE?
	CZ	CMPD92		;...YES, COMPLEMENT THE NUMBER.

;		UNPACK THE NUMBER AND EDIT IT.
	LXI	D,WRKSTR+14	;POINT TO OUTPUT AREA.
	LXI 	H,WRKDEC	;POINT TO THE NUMBER.
	CALL	UPKD92		;UNPACK THE NUMBER.
	XCHG
	LXI	D,WRKSTR+1	;POINT TO OUTPUT AREA.
	CALL	EDTD92

;		OUTPUT THE STRING AND RETURN.
	LXI	H,WRKSTR+1	;POINT TO THE STRING.
	MVI	C,13		;SET ITS LENGTH.
	JMP	STROUT$LOOP	;PUT IT.

	PAGE
;****************************************************************
;*             AB16 - CONVERT BINARY 16 ASCII TO BINARY         *
;****************************************************************

;PROGRAM
;		CONVERT ASCII TO BINARY (16 BIT).
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE CONVERTS AN ASCII STRING TO A 16  
;		BIT BINARY NUMBER.
;REMARKS

;		DO INITIALIZATION.
AB16:	
	PUSH	B	;SAVE REGS.
	PUSH	D
	MOV	C,A	;SAVE STRING LENGTH.
	LXI	H,0	;INITIALIZE NUMBER.
	ORA	A	;ANY INPUT?
	JZ	AB16E	;...NO, JUST RETURN ZERO.

;		HANDLE SIGN IF ANY.
	MVI	B,0	;DEFAULT TO PLUS.
	LDAX	D	;GET THE FIRST BYTE.
	CPI	'+'	;IS IT PLUS?
	JZ	AB16S	;...YES, ADJUST FOR IT.
	CPI	'-'	;IS IT MINUS?
	JNZ	AB16L	;...NO, SKIP SIGN.
	MVI	B,0FFH	;...YES.
AB16S:
	INX	D	;BUMP PTR.
	DCR	C	;DECR COUNT.
	STC		;IF ONLY CHAR, RETURN W/ERROR.
	JZ	AB16E

;		GET THE NEXT CHAR AND CHECK IT.
AB16L:
	LDAX	D 	;GET IT.
	CPI	' '	;RETURN IF WE FOUND A BLANK.
	JZ	AB16R
	SUI	'0'	;REMOVE ASCII BIAS.
	JC	AB16E	;...ERROR.
	CPI	9+1
	CMC
	JC	AB16E	;...ERROR.

;		MULTIPLY ACCUMULATOR BY 10.
	PUSH	D	;MULTIPLY HL BY 10.
	DAD	H	;*2
	MOV	E,L
	MOV	D,H
	DAD	H	;*4
	DAD	H	;*8
	DAD	D	;*10
	POP	D

;		ACCUMULATE THE NUMBER.
	ADD	L
	MOV	L,A
	JNC	$+4
	INR	H

;		BUMP PTRS AND LOOP FOR COUNT.
	INX	D	;BUMP INPUT PTR.
	DCR	C
	JNZ	AB16L	;LOOP FOR ALL CHARS.
	ORA	A	;RESET CY.

;		IF NEG, COMPLEMENT NUMBER.
AB16R:
	MOV	A,B	;GET SIGN INDICATOR.
	ORA	A	;NEGATIVE?
	JZ	AB16E	;...NO.
	MOV	A,L	;COMPLEMENT HL.
	CMA
	MOV	L,A
	MOV	A,H
	CMA
	MOV	H,A
	INX	H	;FORCE 2'S COMPLEMENT.

;		RETURN TO CALLER.
AB16E:
	POP	D	;RESTORE REGS.
	POP	B
	RET			;RETURN TO CALLER.

	PAGE
;****************************************************************
;*             BA16 - CONVERT BINARY 16 TO ASCII                *
;****************************************************************

;PROGRAM
;		CONVERT BINARY (16 BIT) TO ASCII.
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		AUGUST 4, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE CONVERTS AN 16 BIT BINARY NUMBER
;		TO ASCII.
;REMARKS

;		DO INITIALIZATION.
BA16:	
	PUSH	B	;SAVE REGS.
	PUSH	D
	PUSH	H

;		PUT SPACE FOR SIGN.
	MVI	A,' '
	STAX	D
	INX	D

;		GET 10000 DIGIT.
	PUSH	D	;SUBTRACT OUT NUMBER.
	LXI	B,-10000
	LXI	D,-1
	DAD	B
	INX	D
	JC	$-2
	LXI	B,10000
	DAD	B
	MOV	A,E
	POP	D
	ADI	'0'	;ADD IN ASCII BIAS.
	STAX	D	;SAVE CHAR.
	INX	D	;BUMP PTR.

;		GET 1000 DIGIT.
	PUSH	D	;SUBTRACT OUT NUMBER.
	LXI	B,-1000
	LXI	D,-1
	DAD	B
	INX	D
	JC	$-2
	LXI	B,1000
	DAD	B
	MOV	A,E
	POP	D
	ADI	'0'	;ADD IN ASCII BIAS.
	STAX	D	;SAVE CHAR.
	INX	D	;BUMP PTR.

;		GET 100 DIGIT.
	PUSH	D	;SUBTRACT OUT NUMBER.
	LXI	B,-100
	LXI	D,-1
	DAD	B
	INX	D
	JC	$-2
	LXI	B,100
	DAD	B
	MOV	A,E
	POP	D
	ADI	'0'	;ADD IN ASCII BIAS.
	STAX	D	;SAVE CHAR.
	INX	D	;BUMP PTR.

;		GET 10 DIGIT.
	PUSH	D	;SUBTRACT OUT NUMBER.
	LXI	B,-10
	LXI	D,-1
	DAD	B
	INX	D
	JC	$-2
	LXI	B,10
	DAD	B
	MOV	A,E
	POP	D
	ADI	'0'	;ADD IN ASCII BIAS.
	STAX	D	;SAVE CHAR.
	INX	D	;BUMP PTR.

;		GET 1 DIGIT.
	MOV	A,L
	ADI	'0'	;ADD IN ASCII BIAS.
	STAX	D	;SAVE CHAR.
	INX	D	;BUMP PTR.

;		RETURN TO CALLER.
	POP	H	;RESTORE REGS.
	POP	D
	POP	B
	RET			;RETURN TO CALLER.

	PAGE
;****************************************************************
;*             ADDD92 - ADD A DECIMAL NUMBER (9.2)              *
;****************************************************************

;PROGRAM
;		PUTD92 - ADD A DECIMAL NUMBER (9.2) TO A CONSTANT.
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 23, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE ADDS A DECIMAL NUMBER
;		WITH A CONSTANT.
;INPUT
;		HL <= DECIMAL NUMBER
;		A = CONSTANT
;REMARKS

;		DO INITIALIZATION.
ADDD92:	
	PUSH	H		;SAVE REGS.
	PUSH	B

;		ADD CONSTANT TO FIRST BYTE.
	ADD	M		;DO IT.
	DAA			;ADJUST FOR DECIMAL VALUE.
	MOV 	M,A		;SAVE VALUE.
	JNC	ADDD92$END	;...NO CARRY.

;		BUMP REST OF DIGITS FOR CARRY.
	MVI	C,4		;SET MAX DIGITS.
ADDD92$LOOP:
	INX	H		;BUMP TO NEXT BYTE.
	MOV	A,M		;ADD 1 TO IT.
	ADI	1
	DAA
	MOV	M,A
	JNC	ADDD92$END
	DCR	C		;LOOP FOR REMAINING BYTES.
	JNZ	ADDD92$LOOP

;		RETURN TO CALLER.
ADDD92$END:
	POP	B		;RESTORE REGS.
	POP	H
	RET


	PAGE
;****************************************************************
;*             CMPD92 - COMPLEMENT A DECIMAL NUMBER (9.2)       *
;****************************************************************

;PROGRAM
;		PUTD92 - COMPLEMENT A DECIMAL NUMBER (9.2).
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 23, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE COMPLEMENTS A DECIMAL
;		NUMBER USING 10'S COMPLEMENT.
;INPUT
;		HL <= DECIMAL NUMBER
;REMARKS

;		DO INITIALIZATION.
CMPD92:	
	PUSH	H		;SAVE REGS.
	PUSH	B

;		SUBTRACT ALL DIGITS FROM 9.
	MVI	C,5		;SET MAX DIGITS.
CMPD92$LOOP:
	MVI	A,099H		;GET 9'S.
	SUB	M		;SUBTRACT DIGITS FROM IT.
	DAA
	MOV	M,A
	INX	H		;BUMP PTR.
	DCR	C		;LOOP FOR REMAINING BYTES.
	JNZ	CMPD92$LOOP

;		MAKE IT 10'S COMPLEMENT BY ADDING ONE TO IT
;		AND RETURN TO CALLER.
	POP	B		;RESTORE REGS.
	POP	H
	MVI	A,1
	JMP	ADDD92


	PAGE
;****************************************************************
;ª             EDTD9² - EDIT Á DECIMAÌ NUMBEÒ (9.2©             *
;****************************************************************

;PROGRAM
;		EDTD92 - EDIT A DECIMAL NUMBER (9.2).
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 23, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE EDITS A DECIMAL NUMBER.
;INPUT
;		HL <= DECIMAL NUMBER
;		DE <= OUTPUT AREA (13 BYTES)
;REMARKS
;		EDIT MASK = '-Z,ZZZ,ZZ9.99'

;		DO INITIALIZATION.
EDTD92:	
	PUSH	H		;SAVE REGS.
	PUSH	D
	PUSH	B
	PUSH	D		;SAVE OUTPUT PTR.
	MVI	A,' '		;BLANK SIGN OUTPUT POSITION.
	STAX	D

;		POINT TO END OF BOTH FIELDS.
	PUSH	D		;POINT TO END OF NUMBER.
	LXI	D,10-1
	DAD	D
	POP	D
	PUSH	H		;POINT TO END OF OUTPUT AREA.
	LXI	H,13-1
	DAD	D
	XCHG
	POP	H

;		GET LOW ORDER DIGITS.
	MVI	C,2		;SET DECIMAL NUMBERS.
	CALL	EDTD92$DIGIT
	MVI	A,'.'		;SET DECIMAL POINT.
	STAX	D
	DCX	D
	MOV	A,M		;SET FIRST DIGIT.
	STAX	D
	DCX	H
	DCX	D

;		GET NEXT TWO DIGITS.
	MVI	C,2
	CALL	EDTD92$DIGIT

;		SET COMMA SEPERATOR.
	MVI	A,','
	STAX	D
	DCX	D

;		GET NEXT THREE DIGITS.
	MVI	C,3
	CALL	EDTD92$DIGIT

;		SET COMMA SEPERATOR.
	MVI	A,','
	STAX	D
	DCX	D

;		GET LAST DIGITS.
	MVI	C,1
	CALL	EDTD92$DIGIT

;		BLANK FILL FIRST 9 POSITIONS.
	POP	H		;POINT TO OUTPUT.
	MVI	C,8		;SET FOR MAX OF 9 POSITIONS.
EDTD92$FILL:
	INX	H		;BUMP PTR.
	MOV	A,M		;GET THE BYTE.
	CPI	'0'		;IS IT ZERO?
	JZ	EDTD92$BLNK	;...YES, BLANK FILL.
	CPI	','		;IS IT A COMMA?
	JNZ	EDTD92$FLEN	;...NO, WE'RE DONE.
EDTD92$BLNK:
	MVI	M,' '		;...YES, BLANK OUT THE CHAR.
	DCR	C		;LOOP FOR MAX CHARS.
	JNZ	EDTD92$FILL
EDTD92$FLEN:

;		SET THE SIGN.
	DCX	H
	LDA	WRKSGN		;GET IT.
	MOV 	M,A		;PUT IT IN OUTPUT.

;		RETURN TO CALLER.
	POP	B		;RESTORE REGS.
	POP	D
	POP	H
	RET

;		GET NEXT DIGIT.
EDTD92$DIGIT:
EDTD92$LOOP:
	MOV	A,M		;GET THE NEXT BYTE.
	STAX	D		;...NO, ADD IT TO OUTPUT.
	DCX	H		;DECR PTRS.
	DCX	D
	DCR	C		;LOOP FOR REMAINING BYTES.
	JNZ	EDTD92$LOOP

;		RETURN.
	RET


	PAGE
;****************************************************************
;ª             UPKD9² - UNPACË Á DECIMAÌ NUMBEÒ (9.2©           *
;****************************************************************

;PROGRAM
;		UPKD92 - UNPACK A DECIMAL NUMBER (9.2).
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 23, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE UNPACKS A DECIMAL NUMBER.
;INPUT
;		HL <= DECIMAL NUMBER
;		DE <= OUTPUT AREA
;REMARKS

;		DO INITIALIZATION.
UPKD92:	
	PUSH	H		;SAVE REGS.
	PUSH	D
	PUSH	B

;		POINT TO LAST BYTE.
	INX	H
	INX	H
	INX	H
	INX	H

;		EXPAND ALL BYTES.
	MVI	C,5		;SET MAX DIGITS.
UPKD92$LOOP:
	MOV	A,M		;GET HIGH ORDER DIGIT.
	RAR			;PUT HIGH ORDER DIGIT IN
	RAR			;LOW ORDER DIGIT.
	RAR
	RAR
	CALL	UPKD92$DIGIT	;PUT THIS DIGIT.
	MOV	A,M		;GET LOW ORDER DIGIT.
	CALL	UPKD92$DIGIT	;PUT THIS DIGIT.
	DCX	H		;BUMP PTR.
	DCR	C		;LOOP FOR REMAINING BYTES.
	JNZ	UPKD92$LOOP

;		RETURN TO CALLER.
	POP	B		;RESTORE REGS.
	POP	D
	POP	H
	RET

;		UNPACK A DIGIT.
UPKD92$DIGIT:
	ANI	00FH		;LIMIT TO LOW ORDER DIGIT.
	ADI	'0'		;CONVERT IT TO ASCII.
	STAX	D		;SAVE IT.
	INX	D		;BUMP OUTPUT PTR.
	RET


	PAGE
;****************************************************************
;*             MOVPRM - MOVE IN PARAMETER LIST                  *
;****************************************************************

;PROGRAM
;		MOVE IN PL/1 PARAMETER.
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 11, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE MOVES IN THE PARAMETER LIST FROM
;		PL/1.
;INPUT
;		HL <= PL/1 PARAMETER LIST
;		A = NUMBER OF PARAMETERS
;REMARKS

;		DO INITIALIZATION.
MOVPRM:
	PUSH	B		;SAVE REGS.
	PUSH	D
	PUSH	H
	SHLD	PRMPTR		;SAVE PL/1 PRM LIST PTR.
	ADD	A		;CONVERT NUMBER OF PARMS
	MOV	C,A		;TO BYTES AND SAVE IT.

;		MOVE THE PARAMETERS TO WORK AREA.
	LXI	D,PRMPTRS	;POINT TO PARAMETER LIST.
MOVPRM$LOOP:
	MOV	A,M		;GET A BYTE.
	STAX	D		;PUT THE BYTE.
	INX	D		;BUMP PTR.
	INX	H
	DCR	C		;LOOP FOR ALL PARMS.
	JNZ	MOVPRM$LOOP

;		RETURN TO CALLER.
	POP	H	;RESTORE REGS.
	POP	D
	POP	B
	RET			;RETURN TO CALLER.

	PAGE
;****************************************************************
;*             SAVPRM - SAVE THE PARAMETER LIST                 *
;****************************************************************

;PROGRAM
;		SAVE THE PL/1 PARAMETER.
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		APRIL 11, 1981
;(C)COPYRIGHT	1981,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE SAVES THE PARAMETER LIST FROM
;		PL/1.
;INPUT
;		NONE
;REMARKS

;		DO INITIALIZATION.
SAVPRM:
	PUSH	B		;SAVE REGS.
	PUSH	D
	PUSH	H

;		MOVE THE PARAMETERS TO WORK AREA.
	MVI	C,2*6
	LXI	D,WRKPTRS	;POINT TO PARAMETER LIST.
	LXI	H,PRMPTRS
SAVPRM$LOOP:
	MOV	A,M		;GET A BYTE.
	STAX	D		;PUT THE BYTE.
	INX	D		;BUMP PTR.
	INX	H
	DCR	C		;LOOP FOR ALL PARMS.
	JNZ	SAVPRM$LOOP

;		RETURN TO CALLER.
	POP	H	;RESTORE REGS.
	POP	D
	POP	B
	RET			;RETURN TO CALLER.

	PAGE
;****************************************************************
;*             DATA AREAS FOR ALL SUBROUTINES                   *
;****************************************************************

;		GENERAL AREAS
SCRRTN:	DSEG
PRMPTR:	DW	0	;PL1 PARAMETER LIST PTR
PRMPTRS	EQU	$	;PL1 PARAMETER PTRS
PRM1PTR: DW	0	;PL1 PARM 1 PTR
PRM2PTR: DW	0	;PL1 PARM 2 PTR
PRM3PTR: DW	0	;PL1 PARM 3 PTR
PRM4PTR: DW	0	;PL1 PARM 4 PTR
PRM5PTR: DW	0	;PL1 PARM 5 PTR
PRM6PTR: DW	0	;PL1 PARM 6 PTR
PRM7PTR: DW	0	;PL1 PARM 7 PTR
PRM8PTR: DW	0	;PL1 PARM 8 PTR
PRM9PTR: DW	0	;PL1 PARM 9 PTR

;		WORK DATA AREAS
WRKPTRS	EQU	$	;WORK PARAMETER PTRS
WRK1PTR: DW	0	;WORK PARM 1 PTR
WRK2PTR: DW	0	;WORK PARM 2 PTR
WRK3PTR: DW	0	;WORK PARM 3 PTR
WRK4PTR: DW	0	;WORK PARM 4 PTR
WRK5PTR: DW	0	;WORK PARM 5 PTR
WRK6PTR: DW	0	;WORK PARM 6 PTR
WRK7PTR: DW	0	;WORK PARM 7 PTR
WRK8PTR: DW	0	;WORK PARM 8 PTR
WRK9PTR: DW	0	;WORK PARM 9 PTR
WRKPTR:	DW	0	;WORK PTR
WRKSTR:	DB	0	;WORK STRING LENGTH
	DS	80	;WORK STRING
WRKSGN:	DB	' '	;WORK SIGN
WRKDEC:	DS	5	;WORK DECIMAL NUMBER

;		CONSTANTS
CONSIX: DB	6	;BIN(7) INITIAL(6)

;		CAUSE CERTAIN PL/1 ROUTINES TO BE INCLUDED AT
;		LINK-EDIT TIME.
	DW	GETD92
	EXTRN	GETD92
	DW	PUTERR
	EXTRN	PUTERR

;		END OF SCRRTN.ASM
	END