.PREL
	.IDENT	CHAR
	.INSERT	HVG.LIB
	.INSERT	MACRO.LIB
	.INSERT	BBEQU.ASM
	.RELOC
; SOME SLEAZY EQUATES
WXR=0	; WINDOW FELLAS
WXL=2
WYU=4
WYL=6
BACKUP=8	; CONTROL H MEANS BACK UP 1 CHAR
; TABLE GIVING ASCII CHARS FOR TOKENS
TOKTXT:	
	.ASCII	   'LIS'
	.BYTE	'T'+80H
	.ASCII	   'CLEA'
	.BYTE	'R'+80H
	.ASCII	   'RU'
	.BYTE	'N'+80H
	.ASCII	   'NEX'
	.BYTE	'T'+80H
	.ASCII	   'LIN'
	.BYTE	'E'+80H
	.BYTE	'I'
	.BYTE	'F'+80H
	.ASCII	   'GOT'
	.BYTE	'O'+80H
	.ASCII	   'GOSU'
	.BYTE	'B'+80H
	.ASCII	   'RETUR'
	.BYTE	'N'+80H
	.ASCII	   'BO'
	.BYTE	'X'+80H
	.ASCII	   'FO'
	.BYTE	'R'+80H
	.ASCII	   'INPU'
	.BYTE	'T'+80H
	.ASCII	   'PRIN'
	.BYTE	'T'+80H
	.ASCII	   'STE'
	.BYTE	'P'+80H
	.ASCII	   'RN'
	.BYTE	'D'+80H
	.BYTE	'T'
	.BYTE	'O'+80H
	.ASCIS	'DATA'
	.ASCIS	'CIRCLE'
	.ASCIS	'POINT'
	.ASCIS	'DEFAULT'
	.ASCIS	'SHOW'
	.ASCIS	'SNAP'
	.ASCIS	'ZERO'
	.ASCIS	'SCROLL'
; FUNCTION TO RETURN FONT DESCRIPTOR ADDRESS FOR SMALL FONT
SMALF::	LXI	H,SMLFNT
	RET
; SIMILAR FUNCTION FOR LARGE FONT DESCRIPTOR
LARGEF:: LXI	H,LRGFNT#
	RET
; DEVICE VARIABLE TO OUTPUT CHARACTER ON VDM
PUTCD::	TSTC    '=',PUTCD2
	RSTEXP
	MOV	A,L
	RSTOCH
	RSTFIN
PUTCD2:	JMP	QWHAT#
CRLF::	MVI	A,CR
; OUTPUT CHARACTER ROUTINE
OUTCLA:: PUSH	H
	PUSH	D
	PUSH	B
	PUSH	PSW
	MOV	D,A
	CALL	TOUTCK#	; CHECK FOR TAPE OUTPUT
VDMCAL:	MOV	A,D
	STA	VDMLC#
	CALL	VDM
	POP	PSW
	POP	B
	POP	D
	POP	H
	RET
; ROUTINE TO DISPLAY A TOKEN IN FULL FORM
TOKEP:	CALL	TOKEPT
TOKEP1:	MOV	A,M
	ANI	7FH
	PUSH	H
	CALL	VDMTOK
	POP	H
	MOV	A,M
	INX	H
	RLC	
	JRNC	TOKEP1
TOKEP2:	MVI	A,' '	; PUT SPACE AFTER TOKEN
	JMPR	VDMTOK	; AND WANDER BACK
; SUBROUTINE TO POINT AT STRING FOR TOKEN
TOKEPT:: LXI	H,TOKTXT	; POINT AT LIST
	SUI	68H
JOKEP1:	RZ
JOKEP2:	BIT	7,M	; MOVE PAST NEXT WORD
	INX	H
	JRZ	JOKEP2
	DCR	A
	JMPR	JOKEP1
SMLFNT:: .BYTE	20H
	.BYTE	3,5,4,6
	.WORD	FNT35
; *****
; *
; * CHARACTER DISPLAY ROUTINE
; *
; *****
; DEVICE VARIABLE OFFSETS
CF.X=0
CF.Y=2
CF.M=4
CF.C=6
CF.F=8
; FIELDS IN FONT DESCRIPTOR
FD.BASE=0
FD.XCS=1
FD.YCS=2
FD.XF=3
FD.YF=4
FD.AD=5
FD.FLG=7
; ENTRY FOR TOKEN PRINTING
VDMTOK:	MOV	L,A
	LDA	TAPEST#
	CPI	6
	MOV	A,L
	JRZ	OUTCLA
; SOME CLOWNS COME IN HERE
VDM::
	PUSH	X
	PUSH	Y
	LHLD	WINPTR#		; FIX WINDOW PTR
	PUSH	H
	LXI	H,VDMCR#
	SHLD	WINPTR#
	LXI	Y,VDMX#	; POINT AT DEVICES
	LIXD	VDMCF#		; IX= CHAR FONT
	CPI	CR
	JRNZ	..NONL
; NEW LINE CASE
	CALL	RESCX		; RESET CX
	CALL	CYSCROLL	; SCROLL IF CY IS OFFSCREEN
	CALL	BUMPCY		; ADVANCE CY
	JMPR	..DONE
..NONL:
	CPI	RUBOUT		; HOW ABOUT RUBOUT ?
	JRNZ	..NORB		; JUMP IF NOT HIM
; WE GOT THE RUBOUT KEY FOLKS
	MVI	A,BACKUP	; BACKUP
	CALL	VDM
	MVI	A,' '		; ERASE PREVIOUS FELLA
	CALL	VDM
	MVI	A,BACKUP	; THEN BACK UP AGAIN!
..NORB:
	CPI	BACKUP		; HOW ABOUT BACKUP KEY?
	JRNZ	..NBKU
	CALL	LEFTX		; MOVE CX LEFT
	CALL	XCHECK
	JRNC	..DONE		; JUMP IF OK
	CALL	UPY		; ELSE BACK UP Y
	CALL	FINDLAST ; FIND LAST CHAR POS ON PREV LINE
	JMPR	..DONE
; CHECK FOR TOKEN
..NBKU:
	CPI	68H
	JRC	..NTOK
	CPI	80H
	JRNC	..FLK	; IF >80 ITS A FLAKE
	CALL	TOKEP	; PRINT THE TOKEN
	JMPR	..DONE	; THEN GO HOME
..NTOK:	CPI	' '	; CONTROL CHARS TO ?
	JRNC	..COK
..FLK:	MVI	A,'?'		; FLAKE CHAR - MAKE A ?
..COK:
	CALL	PNOTE#		; PLAY A NOTE
	PUSH	PSW
	CALL	XCHECK		; IS X OFFSCREEN
	JRNC	..XON
	CALL	RESCX		; RESET CX
	CALL	CYTOPCK		; CHECK FOR CY ABOVE TOP
	CALL	BUMPCY		; ADVANCE CY
..XON:
	CALL	CYSCROLL	; SCROLL IF CY NEEDS IT
	POP	PSW
	CALL	DCHAR		; BUG CHARACTER DISPLAYER
	CALL	BUMPCX		; ADVANCE CX
..DONE:
	POP	H
	SHLD	WINPTR#
	POP	Y
	POP	X
	RET
; SUBROUTINE TO DISPLAY CHARACTER ON THE SCREEN
DCHAR:
; FIRST DRAW BOX TO ERASE
	PUSH	PSW
	MVI	A,4	; ERASETH
	BIT	2,CF.M(Y)	; SHOULD WE GHOST THE CHARACTER?
	CNZ	CALBOX		; ONLY IF PLOP OPTION
; PERFORM PATTERN LOOKUP
	POP	PSW		; A=CHAR
..NOTC:	SUB	FD.BASE(X)
	MOV	E,A
	MOV	A,CF.M(Y)
	RLC
	RLC
	OUT	XPAND
	MVI	D,0
	MOV	A,FD.XCS(X)	; CONVERT X BITS INTO BYTES
	ADI	7
	RRC
	RRC
	RRC
	ANI	1FH
	MOV	B,A
	MOV	C,FD.YCS(X)
	MOV	L,FD.AD(X)
	MOV	H,FD.AD+1(X)
	PUSH	B
..MPY1:	PUSH	B
..MPY2:	DAD	D
	DJNZ	..MPY2
	POP	B
	DCR	C
	JRNZ	..MPY1
	PUSH	H
	MOV	A,FD.XCS(X)	; FUDGE COORDINATE TO ULHC
	CALL	COMLV
	ADD	CF.X(Y)
	MOV	E,A
	MOV	A,FD.YCS(X)
	CALL	COMUV
	ADD	CF.Y(Y)
	MOV	D,A
	CALL	R2A#
	ORI	28H	; SET XOR AND EXPAND
	OUT	MAGIC
	RES	6,H		; MAKE ADDR MAGIC
	POP	D
	POP	B
..WX1:	PUSH	B
	PUSH	H
..WX2:	LDAX	D
	INX	D
	MOV	M,A
	INX	H
	MOV	M,A
	INX	H
	DJNZ	..WX2
	MOV	M,B
	INX	H
	MOV	M,B
	POP	H
	MVI	C,BYTEPL
	DAD	B
	POP	B
	DCR	C
	JRNZ	..WX1
	RET
; DRAW THE CURSOR AT CX, CY
CURSE::	PUSH	PSW
	LDA	CURFLG#
	ANA	A
	CZ	DCURSE
	MVI	A,1
	STA	CURFLG#
	POP	PSW
	RET
; CURSOR UNWRITER
UNCURSE:: PUSH	PSW
	LDA	CURFLG#
	ANA	A
	CNZ	DCURSE
	XRA	A
	STA	CURFLG#
	POP	PSW
	RET
; CURSOR WRITER/UNWRITER
DCURSE:	PUSH	X
	PUSH	Y
	LHLD	WINPTR#
	PUSH	H
	LXI	H,VDMCR#
	SHLD	WINPTR
	LXI	Y,VDMX#
	LIXD	VDMCF#
	LDA	VDMCC#
	ANI	3	; ALWAYS XOR THE CURSOR
	CALL	CALBOX
	POP	H
	SHLD	WINPTR
	POP	Y
	POP	X
	RET
; SUBROUTINE TO LINK TO BOX COMMAND
; A= COLOR TO USE
CALBOX:
	MOV	E,CF.X(Y)
	MOV	D,CF.X+1(Y)
	MOV	L,CF.Y(Y)
	MOV	H,CF.Y+1(Y)
	PUSH	D
	PUSH	H
	MOV	E,FD.XF(X)
	MVI	D,0
	MOV	L,FD.YF(X)
	MOV	H,D
	PUSH	D
	PUSH	H
	MOV	L,A	; LOAD UP DA COLOR
	PUSH	H
	JMP	DOBOX#
; MOVE X TO THE LEFT
LEFTX:
	MOV	L,CF.X(Y)
	MOV	H,CF.X+1(Y)
	MOV	E,FD.XF(X)
	MVI	D,0
	ANA	A
	DSBC	D
	MOV	CF.X(Y),L
	MOV	CF.X+1(Y),H
	RET
; MOVE CY UP
UPY:
	MOV	L,CF.Y(Y)
	MOV	H,CF.Y+1(Y)
	MOV	E,FD.YF(X)
	MVI	D,0
	DAD	D
	MOV	CF.Y(Y),L
	MOV	CF.Y+1(Y),H
	RET
; SET CX TO LAST POSITION ON LINE
FINDLAST:
	CALL	RESCX
..MORE:	MOV	L,CF.X(Y)
	MOV	H,CF.X+1(Y)
	PUSH	H
	CALL	BUMPCX
	CALL	XCHECK
	POP	H
	JRNC	..MORE
	MOV	CF.X(Y),L
	MOV	CF.X+1(Y),H
	RET
; RESET CX AND CY TO UPPER LEFT HAND CORNER OF WINDOW
RESCXY:: 
	PUSH	X
	PUSH	Y
	LHLD	WINPTR#
	PUSH	H
	LXI	H,VDMCR#
	SHLD	WINPTR#
	LXI	Y,VDMX#
	LIXD	VDMCF#
	CALL	RESCX
	CALL	RESCY
	POP	H
	SHLD	WINPTR#
	POP	Y
	POP	X
	RET
; RESET CX TO LHS OF WINDOW
RESCX:	MOV	A,FD.XCS(X)
	DCR	A
	CALL	COMUV
	MOV	L,A
	MVI	H,0
	CALL	DEPARM
	.BYTE	WXL
	DAD	D
	MOV	CF.X(Y),L
	MOV	CF.X+1(Y),H
	RET
; SCROLL IF CY OFFSCREEN AT BOTTOM
CYSCROLL:
; IS CY ABOVE SCREEN TOP?
	CALL	CYTOPCK
	CALL	YCHECK	; IS Y OFFSCREEN AT BOTTOM
	RNC		; NO
; SET CY TO BOTTOM MOST LINE THAT IS OK MEASURED FROM TOP
	CALL	RESCY
..LOPR:	MOV	L,CF.Y(Y)
	MOV	H,CF.Y+1(Y)
	PUSH	H
	CALL	BUMPCY
	CALL	YCHECK
	POP	H
	JRNC	..LOPR
	MOV	CF.Y(Y),L
	MOV	CF.Y+1(Y),H
; BUILD CALL TO SCROLLER
	MOV	C,FD.YF(X)	; BC=SCROLL AMOUNT
	MVI	B,0
	LXI	H,0
	PUSH	H
	PUSH	H
	INR	H	; SET HL=256
	PUSH	H	; AND LET CLIPPER FIX IT
	PUSH	H
	PUSH	B
	JMP	SCROLE#
; CHECK FOR Y ABOVE UPPER LIMIT
; AND CORRECT IF NECCESSARY
CYTOPCK:
	MOV	A,FD.YCS(X)
	CALL	COMUV
	MOV	E,A
	MVI	D,0
	MOV	L,CF.Y(Y)
	MOV	H,CF.Y+1(Y)
	DAD	D
	CALL	DEPARM
	.BYTE	WYU
	CALL	CPHLDE#
; IF OFFSCREEN AT TOP RESET TO TOP OF SCREEN
	RC
; FALL TRHU IF ABOVE
; RESET CY TO SCREEN TOP
RESCY:
	CALL	DEPARM
	.BYTE	WYU
	XCHG
	MOV	A,FD.YCS(X)
	CALL	COMUV
	MOV	E,A
	MVI	D,0
	ANA	A
	DSBC	D
	MOV	CF.Y(Y),L
	MOV	CF.Y+1(Y),H
	RET
; CHECK FOR CY ONSCREEN AT BOTTOM
; CY SET IF SCROLL NEEDED
YCHECK:
	MOV	A,FD.YCS(X)
	CALL	COMLV
	MOV	E,A
	MVI	D,0FFH
	MOV	L,CF.Y(Y)
	MOV	H,CF.Y+1(Y)
	DAD	D
	CALL	DEPARM
	.BYTE	WYL
	CALL	CPHLDE#
	RET
; ROUTINE TO CHECK CX FOR BEING ONSCREEN
; RETURNS CY SET IF OFFSCREEN
XCHECK:
	MOV	L,CF.X(Y)
	MOV	H,CF.X+1(Y)
	MOV	A,FD.XCS(X)
	CALL	COMUV
	MOV	E,A
	MVI	D,0
	PUSH	H
	DAD	D
	CALL	DEPARM
	.BYTE	WXR
	XCHG		; HL=LMT, DE=EXTENT
	CALL	CPHLDE#
	POP	H
	RC
	MOV	A,FD.XCS(X)
	CALL	COMLV
	MOV	E,A
	MVI	D,0FFH
	DAD	D
	CALL	DEPARM
	.BYTE	WXL
	CALL	CPHLDE#
	RET
; ROUTINE TO BUMP CX
BUMPCX:	MOV	E,FD.XF(X)
	MVI	D,0
	MOV	L,CF.X(Y)
	MOV	H,CF.X+1(Y)
	DAD	D
	MOV	CF.X(Y),L
	MOV	CF.X+1(Y),H
	RET
; SUBTRACT YF FROM CY
BUMPCY:	MOV	E,FD.YF(X)
	MVI	D,0
	MOV	L,CF.Y(Y)
	MOV	H,CF.Y+1(Y)
	ANA	A
	DSBC	D
	MOV	CF.Y(Y),L
	MOV	CF.Y+1(Y),H
	RET
; ROUTINE TO GET WINDOW PARM INTO DE
DEPARM:
	XTHL
	MOV	E,M
	INX	H
	XTHL
	MVI	D,0
	PUSH	H
	LHLD	WINPTR#
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	POP	H
	RET
COMLV:
	DCR	A
	RRC
	ANI	7FH
	CMA
	INR	A
	RET
COMUV:
	RRC
	ANI	7FH
	RET
; *****
; *
; * 3 X 5 CHAR FONT
; *
; *****
FNT35:
 .BYTE 000H,000H,000H,000H,000H,040H,040H,040H,000H,040H,0A0H,0A0H
 .BYTE 000H,000H,000H,0A0H,0E0H,0A0H,0E0H,0A0H,040H,0E0H,080H,0E0H
 .BYTE 040H,080H,020H,040H,080H,020H,000H,000H,040H,0A0H,0A0H,040H
 .BYTE 040H,000H,000H,000H,040H,080H,080H,080H,040H,040H,020H,020H
 .BYTE 020H,040H,0A0H,040H,0E0H,040H,0A0H,000H,040H,0E0H,040H,000H
 .BYTE 000H,000H,000H,040H,080H,000H,000H,0E0H,000H,000H,000H,000H
 .BYTE 000H,000H,040H,000H,020H,040H,080H,000H,040H,0A0H,0A0H,0A0H
 .BYTE 040H,040H,040H,040H,040H,040H,0E0H,020H,0E0H,080H,0E0H,0E0H
 .BYTE 020H,060H,020H,0E0H,0A0H,0A0H,0E0H,020H,020H,0E0H,080H,0C0H
 .BYTE 020H,0C0H,0E0H,080H,0E0H,0A0H,0E0H,0E0H,020H,040H,040H,040H
 .BYTE 0E0H,0A0H,0E0H,0A0H,0E0H,0E0H,0A0H,0E0H,020H,0E0H,000H,040H
 .BYTE 000H,040H,000H,000H,040H,000H,040H,080H,020H,040H,080H,040H
 .BYTE 020H,000H,0E0H,000H,0E0H,000H,080H,040H,020H,040H,080H,0E0H
 .BYTE 020H,040H,000H,040H,0E0H,0A0H,0E0H,080H,0C0H,0E0H,0A0H,0E0H
 .BYTE 0A0H,0A0H,0E0H,0A0H,0C0H,0A0H,0E0H,0E0H,080H,080H,080H,0E0H
 .BYTE 0C0H,0A0H,0A0H,0A0H,0C0H,0E0H,080H,0C0H,080H,0E0H,0E0H,080H
 .BYTE 0C0H,080H,080H,0E0H,080H,0A0H,0A0H,0E0H,0A0H,0A0H,0E0H,0A0H
 .BYTE 0A0H,0E0H,040H,040H,040H,0E0H,020H,020H,020H,0A0H,0E0H,0A0H
 .BYTE 0A0H,0C0H,0A0H,0A0H,080H,080H,080H,080H,0E0H,0A0H,0E0H,0E0H
 .BYTE 0A0H,0A0H,0C0H,0A0H,0A0H,0A0H,0A0H,0E0H,0A0H,0A0H,0A0H,0E0H
 .BYTE 0E0H,0A0H,0E0H,080H,080H,0E0H,0A0H,0A0H,0E0H,020H,0C0H,0A0H
 .BYTE 0C0H,0A0H,0A0H,0E0H,080H,0E0H,020H,0E0H,0E0H,040H,040H,040H
 .BYTE 040H,0A0H,0A0H,0A0H,0A0H,0E0H,0A0H,0A0H,0A0H,0A0H,040H,0A0H
 .BYTE 0A0H,0E0H,0E0H,0A0H,0A0H,0A0H,040H,0A0H,0A0H,0A0H,0A0H,040H
 .BYTE 040H,040H,0E0H,020H,040H,080H,0E0H,0C0H,080H,080H,080H,0C0H
 .BYTE 000H,080H,040H,020H,000H,060H,020H,020H,020H,060H,040H,0E0H
 .BYTE 040H,040H,040H,020H,040H,0E0H,040H,020H
 .BYTE 040H,040H,040H,0E0H,040H
 .BYTE 080H,040H,0E0H,040H,080H
 .BYTE 000H,0A0H,040H,0A0H,000H
 .BYTE 040H,000H,0E0H,000H,040H
	.END