; This software is provided 'as-is', without any express or implied
; warranty.  In no event will the authors be held liable for any damages
; arising from the use of this software.
;
; Permission is granted to anyone to use this software for any purpose,
; including commercial applications, and to alter it and redistribute it
; freely, subject to the following restrictions:
; 
; 1. The origin of this software must not be misrepresented; you must not
;    claim that you wrote the original software.  If you use this software
;    in a product, an acknowledgment in the product documentation would be
;    appreciated but is not required.
; 
; 2. Altered source versions must be plainly marked as such, and must not be
;    misrepresented as being the original software.
; 
; 3. This notice may not be removed or altered from any source distribution.
;
;Patch program to implement new BASIC statements on Z88.
;For use with BASIC version 3.00 and O.S. versions 2.2 & 3.0 ONLY.
;Statements/commands/functions implemented:
;	*EDIT line number
;	CLG
;	DRAW x,y
;	MODE n
;	MOVE x,y
;	PLOT n,x,y
;	POINT(x,y)
;(C) Copyright R.T.Russell, 1988
;Version 1.0: 28-02-88
;Version 2.0: 27-03-88
;Version 2.1: 29-10-88  Use :RAM.0 for temporary files
;
PROMPT_RET	EQU	0DA21H
SETLIN_RET	EQU	0E0A5H
LOAD0_RET	EQU	0E665H
;
ERRWDS	EQU	0DDB8H
MARK1	EQU	0E09BH
MARK2	EQU	0E09EH
WARM	EQU	0FE73H
XEQ	EQU	0FE79H
;
LINENO	EQU	22E6H
ERRTXT	EQU	22EEH
RANDOM	EQU	22F6H
ERR	EQU	22FDH
;
STACK	EQU	0C000H-256
;
LF	EQU	10
CR	EQU	13
MAXERR	EQU	45
PAGER	EQU	90H
HIMEMR	EQU	93H
NEW	EQU	0CAH
PAGEL	EQU	0D0H
TIMEL	EQU	0D1H
HIMEML	EQU	0D3H
CHAIN	EQU	0D7H
END	EQU	0E0H
IF	EQU	0E7H
PRINT	EQU	0F1H
ITEMHI	EQU	0F8H
;
DIGIT	MACRO	NIBBLE
	IF	(NIBBLE) LT 10
	DEFB	'0'+(NIBBLE)
	ELSE
	DEFB	'7'+(NIBBLE)
	ENDIF
	ENDM
;
HEX	MACRO	BYTE
	IF1
	DEFB	'00'
	ELSE
	DIGIT	<(BYTE)/16>
	DIGIT	<(BYTE)MOD 16>
	ENDIF
	ENDM
;				
	ASEG
	ORG	2300H
;
;BASIC program:
;
;     IFHIMEM<&C000 PRINT"No RAM":END
;     TIME=0:HIMEM=&C000:IFPAGE<>&2300THENPAGE=&2300:CHAIN$&2000
;     !!HIMEM=&A2300CD:?&22E4=2:PAGE=&xx00:PRINT"Z88 BASIC Patch V0":NEW
;
;The first three bytes are both the BASIC line length/number AND
;an assembly language relative jump instruction.
;
START:	JR	ENTRY
	DEFB	0
	DEFB	IF,HIMEMR,'<&C000 ',PRINT,'"No RAM":',END,CR
FIRST:
;
	IF	(FIRST-START) NE 18H
	.PRINTX	'** Error in BASIC program line **'
	ENDIF
;
	DEFB	NEXT-$		;Line length
	DEFW	0		;Line number
	DEFB	TIMEL,'=0:',HIMEML,'=&C000:'
	DEFB	IF,PAGER,'<>&2300',PAGEL,'=&2300:',CHAIN,'$&2000',CR
NEXT:
;
	DEFB	LAST-$		;Line length
	DEFW	0		;Line number
	DEFB	'!!',HIMEMR,'=&A2300CD:?&22E4=2:',PAGEL,'=&'
	HEX	<(FINISH+255)/256>
	DEFB	'00:',PRINT,'"Z88 BASIC Patch V2.1":',NEW,CR
LAST:
;
	DEFB	0		;Program end marker
	DEFW	0FFFFH
;
	PAGE
;
;The patch code starts here:
;
;First determine which of five LD SP,(HIMEM) statements within the
;interpreter have resulted in the intercept.  The A-register is the
;primary key:
;
;	A = 253		EXTERR intercept ("Sorry, not implemented")
;	A = 254		EXTERR intercept ("Bad command")
;	A = 62		CLOOP intercept (return to PROMPT_RET)
;
;In the case of the following values, if HL<>(LINENO) and IX=RANDOM
;then jump to LOAD0_RET rather than performing the action listed:
;
;	127 < A < 253	EXTERR intercept (return to SETLIN_RET)
;	13 < A < 128	ERROR intercept (return to SETLIN_RET)
;	A = 13		(1) CHAIN0 intercept (return to LOAD0_RET)
;			(2) ERROR intercept ("No PROC")
;	0 < A < 13	ERROR intercept (return to SETLIN_RET)
;	A = 0		(1) ERROR intercept ("No room")
;			(2) ERROR intercept with error code in A'
;
;In the ambiguous cases (A=0 and A=13) examine the other registers
;etc. for further clues.
;
ENTRY:	CP	253
	JR	Z,FINDSP	;Trap "Sorry, not implemented"
	LD	SP,(STKTOP)
	CP	254
	JP	Z,STAR		;Trap "Bad command"
	CP	'>'
	JP	Z,PROMPT_RET	;Return from CALL PROMPT
	LD	BC,(LINENO)
	OR	A		;Clear carry
	SBC	HL,BC		;HL = (LINENO) ?
	JR	Z,ERROR		;Must be a BASIC error
	PUSH	IX
	POP	HL		;HL <- IX
	LD	BC,RANDOM
	OR	A		;Clear carry
	SBC	HL,BC
	JR	Z,CLEAR		;Return from CALL CLEAR
	CP	CR
CLEAR:	JP	Z,LOAD0_RET	;Return from CALL LOAD0
	OR	A
	JR	NZ,ERROR	;Not ambiguous
	EX	AF,AF'		;Most probably in ERROR0
ERROR:	LD	(ERR),A		;In case early interrupt
	OR	A		;Test error code
	JP	M,SETLIN_RET
	LD	HL,ERRWDS
	JR	Z,ERROR1
	CP	MAXERR+1
	JP	NC,WARM		;Re-prompt (prob. CLOOP)
	LD	B,A
	XOR	A
ERROR0:	CP	(HL)
	INC	HL
	JR	NZ,ERROR0	;Find error message
	DJNZ	ERROR0		;for this error
ERROR1:	LD	(ERRTXT),HL	;Pointer to message
EXIT:	LD	A,(ERR)		;Error code
	LD	SP,(STKTOP)
	JP	SETLIN_RET	;for return to BASIC
;
	PAGE
;
	IF	(MARK1 AND 0FF00H)NE(MARK2 AND 0FF00H)
	.PRINTX	'Marks out of range'
	ENDIF
;
;Discover old value of stack pointer (search stack for marker):
;
FINDSP:	LD	HL,(STKTOP)
	LD	BC,(ERRTXT)
	LD	DE,MARK1
FIND:	LD	A,H		;Get high byte
	CP	(FINISH-1)/256
	JR	Z,EXIT		;Couldn't find marker
	DEC	HL
	LD	A,(HL)		;MS byte
	DEC	HL
	CP	B
	JR	Z,FIND1
	CP	D
	JR	NZ,FIND
	LD	A,(HL)		;LS byte
	CP	E
	JR	Z,TRAP		;Found MARK1
	CP	MARK2 AND 0FFH
	JR	NZ,FIND
	JR	TRAP		;Found MARK2
;
FIND1:	LD	A,(HL)		;LS byte
	CP	C
	JR	NZ,FIND
;
;	Falls through...
;
;Find which statement caused trapped error:
;(HL points into stack; preserve BCDEHL)
;
TRAP:	DEC	IY
	LD	A,(IY)		;Get "token"
	CP	' '
	JR	Z,TRAP		;Skip spaces
	INC	IY
;
;	Falls through...
;
TCLG	EQU	0DAH
TDRAW	EQU	0DFH
TMODE	EQU	0EBH
TMOVE	EQU	0ECH
TPLOT	EQU	0F0H
TPOINT	EQU	0B0H
;
;Test for implemented commands/statements/functions:
;
;Check for POINT (special case):
;
	CP	TPOINT
	JR	NZ,OTHERS
	INC	HL
	INC	HL
	INC	HL
	LD	A,(HL)		;High byte of return address
	DEC	HL
	DEC	HL
	DEC	HL
	CP	ITEMHI		;Correct for CALL ITEM ?
	JR	NZ,FIND		;No, look for another
OTHERS:	LD	SP,HL
	POP	HL		;Level stack
	JP	Z,POINT		;POINT
	CP	TCLG
	JP	Z,CLG		;CLG
	CP	TDRAW
	JP	Z,DRAW		;DRAW
	CP	TMODE
	JP	Z,MODE		;MODE
	CP	TMOVE
	JP	Z,MOVE		;MOVE
	CP	TPLOT
	JP	Z,PLOT		;PLOT
EXIT1:	JR	EXIT		;Still not implemented
;
	PAGE
;
;"Bad command" - test for *EDIT:
;
STAR:	LD	HL,EDITST
	PUSH	IY
	POP	DE
	LD	BC,4		;Number of characters
	LD	A,(DE)
STAR1:	AND	5FH		;Convert lower to upper
	CPI
	INC	DE
	JR	NZ,EXIT		;No match
	JP	PO,EDIT		;Found *EDIT
	LD	A,(DE)
	CP	'.'
	JR	NZ,STAR1
;
;	Falls through...
;
;The line editor, a direct compilation of the BASIC version:
;
OSKEY	EQU	0FE8EH
OSWRCH	EQU	0FE94H
OSOPEN	EQU	0FEA9H
OSSHUT	EQU	0FEACH
OSBGET	EQU	0FEAFH
OSBPUT	EQU	0FEB2H
OSCLI	EQU	0FEC1H
;
ACCS	EQU	2000H
PPC	EQU	2240H
;
EDIT:	LD	A,4
	SUB	C
	LD	C,LISTST-EDITST-1
	ADD	HL,BC		;Address LISTST
	LD	C,A
	DEC	DE
	LDDR			;Replace EDIT with LIST
;
	LD	A,-1
	LD	HL,EF		;Address "E" or "F"
	INC	(HL)		;-> "F"
	PUSH	HL
	CALL	OPEN		;A=OPENOUT":RAM.0/F.cli"
	POP	HL
	DEC	(HL)		;-> "E"
	LD	HL,DOT+1
	LD	(HL),'>'
	DEC	HL
	CALL	BPUTS		;PRINT#A,".>:RAM.0/E.cli"
	CALL	BPUTS		;PRINT#A,".J"
	PUSH	IY
	EX	(SP),HL
	CALL	BPUTS		;PRINT#A,"LIST nnnn"
	POP	HL
	CALL	BPUTS		;PRINT#A,"CALLP%"
	LD	A,'*'
	LD	HL,EF		;Address "E" or "F"
	INC	(HL)		;-> "F"
	PUSH	HL
	CALL	CLI		;*CLI .*:RAM.0/F.cli
	POP	HL
	DEC	(HL)		;-> "E"
	LD	HL,PROCF
	LD	(PPC),HL
	JP	WARM		;ENDPROC
;
EXEC:	DEFB	'CLI '
DOT:	DEFB	'.>'
FN:	DEFB	':RAM.0/'
EF:	DEFB	'E.cli',CR
J:	DEFB	'.J',CR
CALLP:	DEFB	'CALLP%',CR
;
PROCF:	LD	HL,0
	CALL	OSKEY		;A=INKEY(0)
	XOR	A
	CALL	OPEN		;A=OPENIN ":RAM.0/E.cli"
PROCF1:	CALL	OSBGET		;Skip first record
	CP	CR
	JR	NZ,PROCF1
	LD	HL,ACCS
PROCF2:	CALL	OSBGET
	CP	' '
	JR	NC,PROCF3
	CP	LF
	JR	NZ,PROCF2
	CALL	OSBGET
	CP	'>'		;Prompt ?
	JR	Z,PROCF4
PROCF3:	LD	(HL),A
	INC	L
	JR	NZ,PROCF2
	DEC	L
PROCF4:	LD	(HL),0
	CALL	OSSHUT		;CLOSE#A
	LD	A,-1
	CALL	OPEN		;A=OPENOUT ":RAM.0/E.cli"
	LD	HL,J
	CALL	BPUTS		;PRINT#A,".J"
	LD	HL,ACCS
	CALL	BPUTS		;PRINT#A,A$
	LD	A,8
	CALL	OSWRCH		;VDU 8
	LD	A,'<'
CLI:	LD	(DOT+1),A
	CALL	OSSHUT
	LD	HL,EXEC
	JP	OSCLI		;OSCLI"CLI .<:RAM.0/E.cli"
;
BPUTS:	LD	A,(HL)
	OR	A
	RET	Z
	CALL	OSBPUT
	LD	A,(HL)
	CP	CR
	INC	HL
	RET	Z
	JR	BPUTS
;
OPEN:	LD	HL,FN
	CALL	OSOPEN
	LD	E,A
	RET
;
EDITST:	DEFB	'EDIT'
LISTST:	DEFB	'LIST'
;
	PAGE
;
;GRAPHICS INTERFACE FOR BBC BASIC (Z80)
;CAMBRIDGE COMPUTER Z88 VERSION
;
CHECK	EQU	0EF68H
;
EXTERR	EQU	0FE76H
XEQ	EQU	0FE79H
ITEMI	EQU	0FE7CH
EXPRI	EQU	0FE7FH
COMMA	EQU	0FE82H
BRAKET	EQU	0FE85H
FPP	EQU	0FEFDH
;
STACK0	EQU	STACK
STACK1	EQU	STACK0-32*64
;
USERSP	EQU	1F8AH
OSSP	EQU	1FFEH
COUNT	EQU	22FBH
;
BAD	EQU	3
;
OS_MAP	EQU	0F406H
MP_WR	EQU	1
MP_GRA	EQU	3
MP_DEL	EQU	4
;
SYS	MACRO	SYS_CODE
	LD	(USERSP),SP
	LD	SP,(OSSP)
	RST	20H
	DEFW	SYS_CODE
	LD	SP,(USERSP)
	ENDM
;
BADMOD:	LD	A,25+128
	CALL	EXTERR		;"Bad MODE"
	DEFB	BAD,TMODE,0
;
SETUP0:	DEFB	1,'6#5S  (',1,'6#1  ~(',1,'2C1',1,'3+CS',0
SETUP1:	DEFB	1,'6#1  R(',1,'6#5S K(',1,'2C1',1,'3+CS',0
;
MODE:	CALL	EXPRI		;Get mode number
	LD	HL,(STKTOP)	;Top of stack
	OR	A		;Clear carry
	SBC	HL,SP		;Stack in use ?
	JR	NZ,BADMOD	;Yes, so "Bad mode"
	LD	A,0CH
	CALL	OSWRCH		;CLS (must be first)
	EXX			;Mode number to L
	LD	A,L		;and to A
	AND	1		;Allow values 0 & 1
	LD	HL,modeno	;Mode save location
	CP	(HL)		;Mode changed ?
	JR	Z,RESWIN	;No, so just clear
	LD	(HL),A		;Update saved value
	OR	A		;Which mode ?
	LD	BC,MP_DEL	;Delete map, 'cos
	LD	HL,SETUP0	;text only mode
	LD	DE,STACK0	;Stack pointer 
	JR	Z,MODE1
	LD	C,MP_GRA	;Create map, 'cos
	LD	HL,SETUP1	;text & graphics mode
	LD	D,STACK1/256	;Stack pointer
MODE1:	LD	A,(HL)		;VDU code
	INC	HL		;Bump pointer
	OR	A		;End of string ?
	CALL	NZ,OSWRCH	;Send to O.S.
	JR	NZ,MODE1	;Continue until NUL
	LD	A,'5'		;Use window 5
	LD	HL,255		;Map width (pixels)
	SYS	OS_MAP		;Create/delete map
	EX	DE,HL		;HL = new stack pointer
	LD	SP,HL		;Update SP
	CALL	CHECK		;Test for "No room"
	LD	(STKTOP),HL	;And update RAM copy
RESWIN:	XOR	A
	LD	(COUNT),A	;Zero COUNT
	LD	H,A
	LD	L,A		;HL <- 0
	LD	(xorig),HL
	LD	(yorig),HL
	LD	H,80H
	LD	(lastx),HL
	LD	(lasty),HL
	LD	(prevx),HL
	LD	(prevy),HL
CLG:	LD	A,(modeno)	;Get mode number
	OR	A		;Text only mode ?
	JR	Z,XEQ1		;Yes, so quit
	LD	HL,STACK1	;"Screen" RAM
CLG1:	PUSH	HL
	LD	BC,32*256
CLG2:	LD	(HL),C		;Clear screen RAM
	INC	HL
	DJNZ	CLG2
	EX	(SP),HL		;Restore old HL
	CALL	UPDATE
	POP	HL		;HL <- HL + 32
	LD	A,H
	CP	STACK0/256	;All done ?
	JR	C,CLG1
	JR	XEQ1
;
POINT:	CALL	GETXY		;DE <- X, HL <- Y
	CALL	BRAKET
	LD	A,(modeno)
	CP	1		;Text-only mode ?
	JR	C,POINT1	;Yes, return -1
	CALL	ascale
	CALL	locate
	JR	C,POINT1	;OUT OF RANGE
	AND	(HL)		;TEST BIT
	LD	A,1
	JR	NZ,POINT2
POINT1:	SBC	A,A
POINT2:	LD	L,A
	ADD	A,A		;SIGN EXTEND
	SBC	A,A
	LD	H,A
	EXX
	LD	H,A
	LD	L,A
	XOR	A		;MARK NUMERIC (A=0)
	LD	C,A		;MARK INTEGER (C=0)
	RET
;
MOVE:	LD	L,4
	JR	PLOT1
;
DRAW:	LD	L,5
	JR	PLOT1
;
PLOT:	CALL	EXPRI		;PLOT NUMBER
	CALL	COMMA
	EXX
PLOT1:	PUSH	HL
	CALL	GETXY		;DE <- X, HL <- Y
	POP	BC
	LD	A,(modeno)
	OR	A		;Text-only mode ?
	LD	A,C
	PUSH	IY
	CALL	NZ,plotit
	POP	IY
XEQ1:	JP	XEQ
;
GETXY:	CALL	EXPRI		;"X"
	EXX
	PUSH	HL
	CALL	COMMA
	CALL	EXPRI		;"Y"
	EXX
	POP	DE
	RET
;
origin:	LD	(xorig),DE	;set origin
	LD	(yorig),HL
	RET
;
;plot - multi-function plotting routine
;   Inputs:  A = plot code (0-87)
;           DE = x-ordinate (0-255)
;           HL = y-ordinate (0-63)
;     0 : move relative
;     1 : draw relative (foreground)
;     2 : draw relative (inverse)
;     3 : draw relative (background)
;   4-7 : as 0-3 but absolute
;  8-15 : as 0-7 but omit last point
; 16-23 : as 0-7 but dotted
; 24-31 : as 16-23 but omit last point
; 64-71 : as 0-7 but plot single point
; 72-79 : horizontal fill until lit
; 80-87 : plot & fill triangle
;    -1 : set origin
;
plotit:	CP	-1
	JR	Z,origin	;set origin
	BIT	2,A
	CALL	NZ,ascale	;absolute
	BIT	2,A
	CALL	Z,rscale	;relative
;
;      (stack) = prevx,prevy
;  prevx,prevy = lastx,lasty
;  lastx,lasty = x,y :
;
	EXX
	LD	DE,(prevx)
	LD	HL,(prevy)
	PUSH	DE
	PUSH	HL
	LD	DE,(lastx)
	LD	HL,(lasty)
	LD	(prevx),DE
	LD	(prevy),HL
	EXX
	LD	(lastx),DE
	LD	(lasty),HL
	CP	64
	JR	NC,hitype
	POP	BC		;level stack
	POP	BC
;
;if just MOVE, return:
;
	LD	B,A
	AND	3
	RET	Z
	LD	A,B
	AND	11011B
;
;Plot first point if bit 5,B:
;
	EXX
	PUSH	AF
	PUSH	DE
	PUSH	HL
	BIT	5,B
	CALL	NZ,setpt
	POP	HL
	POP	DE
	POP	AF
;
;clip to graphics window limits:
;
	EX	AF,AF'
	CALL	clip
	RET	NZ		;All out of range
	EX	AF,AF'
;
;find dx,dy and flag signs in A:
;
	PUSH	DE		;lastx
	EXX
	EX	DE,HL
	POP	BC
	RRCA
	OR	A
	SBC	HL,BC		;find dx
	CALL	C,neg0		;negate and set A5 (A6)
	EX	DE,HL
	EXX
	PUSH	HL		;lasty
	EXX
	POP	BC
	RLCA
	OR	A
	SBC	HL,BC		;find dy
	CALL	C,neg0		;negate and set A5
;
;find slope and flag whether >1
;
	OR	A
	SBC	HL,DE		;dx>dy?
	ADD	HL,DE
	JR	C,xgey
	SET	7,A
	EX	DE,HL
xgey:	PUSH	AF
	PUSH	DE
	LD	B,D
	LD	C,E
	LD	DE,65535
	CALL	NZ,divide	;find slope
	POP	HL
	LD	C,H
	INC	C
	LD	B,L
	INC	B
	LD	HL,32768	;fine tweak
	POP	AF
	EXX
;
;A bits now 0,1: plotting mode
;             2: dot toggle (=0)
;             3: omit last point
;             4: dotted line
;             5: dy sign
;             6: dx sign
;             7: slope flag
;
;locate start point and draw the line:
;
	EX	AF,AF'
	CALL	locate
	RET	C		;Internal error
	LD	D,A		;bit mask
	EX	AF,AF'
	LD	E,A		;flag byte
	LD	BC,32		;Bytes per line
	CALL	drawit
	EXX
	PUSH	DE
	CALL	UPDATE
	POP	DE
	BIT	3,E		;re-plot last point?
	RET	Z
	LD	A,E
	LD	DE,(lastx)
	LD	HL,(lasty)
setpt:
	EX	AF,AF'
	CALL	locate		;plot point
	RET	C		;out of range
	LD	D,A
	EX	AF,AF'
	LD	E,A
	CALL	modify
	JP	UPDATE		;Update physical screen
;
;plot codes above 64:
;
hitype:	LD	(plotyp),A
	CP	80
	JR	NC,plot80	;triangle fill
	POP	BC
	POP	BC		;level stack
	CP	72
	JR	C,setpt
;
;	Falls through...
;
;horizontal fill until set bit:
;	
filler:	LD	(prevy),HL	;prevy=lasty
	PUSH	DE
	CALL	locate
	POP	DE
	RET	C
	DEC	A
	CPL			;Right mask
	LD	BC,9
lsrch:	AND	(HL)
	JR	NZ,lend
	LD	A,L
	DEC	HL
	AND	11111B
	LD	A,0FFH
	JR	NZ,lsrch
	INC	HL
	LD	C,1
lend:	RRA
	DEC	BC
	JR	NC,lend
	LD	A,L
	AND	11111B
	LD	L,A
	LD	H,10H
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,BC
	LD	(prevx),HL	;left end
	LD	HL,(prevy)
	CALL	locate
	ADD	A,A
	DEC	A		;Left mask
	LD	BC,-2
rsrch:	AND	(HL)
	JR	NZ,rend
	INC	HL
	LD	A,L
	AND	11111B
	LD	A,0FFH
	JR	NZ,rsrch
redge:	DEC	HL
	LD	BC,7-1
rend:	RLA
	INC	BC
	JR	NC,rend
	LD	A,L
	AND	11111B
	LD	L,A
	LD	H,10H
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,BC
	LD	(lastx),HL	;right end
	LD	DE,(prevx)
	LD	A,(prevy)
	JP	hdraw		;draw line
;
;plot codes above 80:
;
plot80:	CP	88
	JR	C,triang
	POP	BC		;level stack
	POP	BC
	CP	96
	JR	NC,plot96
;
;	Falls through...
;
;right horizontal fill until unset bit:
;	
	LD	(prevx),DE	;left end
	LD	(prevy),HL
	CALL	locate
	RET	C
	ADD	A,A
	DEC	A		;Left mask
	LD	BC,-2
frsrch:	LD	E,A
	LD	A,(HL)
	CPL
	AND	E
	JR	NZ,rend
	INC	HL
	LD	A,L
	AND	11111B
	LD	A,0FFH
	JR	NZ,frsrch
	JR	redge
;
;plot codes above 96:
;
plot96:	CP	104
	RET	NC
;
;Plot and fill rectangle:
;
	PUSH	DE		;(SP) = X1
	CALL	sety		;A = Y1
	EXX
	LD	B,A		;B = Y1
	CALL	sety		;A = Y2
	LD	C,A		;C = Y2
	CP	B
	JR	NC,rect0
	LD	C,B
	LD	B,A
rect0:	POP	HL		;HL = X1
	OR	A
	SBC	HL,DE
	ADD	HL,DE
	JR	NC,rect1
	EX	DE,HL
rect1:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	A,B		;Y
	CALL	hclip
	POP	HL
	POP	DE
	POP	BC
	LD	A,B
	CP	C
	RET	Z
	INC	B
	JR	rect1
;
;triangle filling:
;
;Define vertices x1,y1 x2,y2 x3,y3 such that y1<=y2<=y3
;
;swap vertices until x1,y1 (apex) is (SP+2),(SP):
;
triang:	POP	BC
	PUSH	BC
	OR	A
	SBC	HL,BC
	ADD	HL,BC
	JR	NC,nswap1
	EX	(SP),HL
	POP	BC
	EX	DE,HL
	EX	(SP),HL
	EX	DE,HL
	PUSH	BC
nswap1:	EXX
	POP	BC
	PUSH	BC
	OR	A
	SBC	HL,BC
	ADD	HL,BC
	JR	NC,nswap2
	EX	(SP),HL
	POP	BC
	EX	DE,HL
	EX	(SP),HL
	EX	DE,HL
	PUSH	BC
;
;exchange so x2,y2 is DEHL & x3,y3 is D'E'H'L':
;
nswap2:	PUSH	HL
	EXX
	POP	BC
	OR	A
	SBC	HL,BC
	ADD	HL,BC
	JR	C,lowy
	EXX
;
;DE=x2, HL=y2, D'E'=x3, H'L'=y3
;save x3,y3,x2,y2 on stack:
;
lowy:	POP	BC		;y1
	EXX
	POP	BC		;x1
	PUSH	DE		;x3
	EXX
	PUSH	DE		;x2
	EXX
	PUSH	HL		;y3
	EXX
	PUSH	HL		;y2
	EXX
	PUSH	BC		;x1
	EXX
;
;DE=x2, HL=y2, D'E'=x3, H'L'=y3
;find x2-x1,y2-y1,x3-x1,y3-y1:
;
	OR	A
	SBC	HL,BC		;y2-y1
	EXX
	POP	BC
	EX	DE,HL
	OR	A
	SBC	HL,BC		;x2-x1
	EX	DE,HL
	PUSH	BC
	EXX
	PUSH	BC
	EXX
	POP	BC
	OR	A
	SBC	HL,BC		;y3-y1
	EXX
	POP	BC
	EX	DE,HL
	OR	A
	SBC	HL,BC		;x3-x1
	EX	DE,HL
	PUSH	BC
	EXX
	PUSH	BC
	EXX
;
;DE=x2-x1,HL=y2-y1,D'E'=x3-x1,H'L'=y3-y1
;if flat top, make divisor 1 so quotient=width:
;
	LD	A,H
	OR	L		;y2-y1=0?
	JR	NZ,anz
	INC	HL
anz:	EX	AF,AF'
;
;calculate edge slopes:
;
	CALL	edge
	EXX
	CALL	edge
	EXX
;
;BCDE=slope2,B'C'D'E'=slope3,Z'=flat top
;calculate start point (apex):
;
	POP	HL		;y1
	LD	A,L		;y1 MOD 256
	EX	AF,AF'
	LD	A,H		;y1 DIV 256
	EX	AF,AF'
	EXX
	POP	HL		;x1
	PUSH	HL
	EXX
	POP	HL		;x1
	LD	IX,8000H
	LD	IY,8000H
;
;HL=H'L'=x1,A'A=y1,BCDE=slope2,B'C'D'E'=slope3,Z'=flat top
;adjust for "flat top":
;(quotient is width so add it to LHS)
;
	EX	AF,AF'
	JR	NZ,anz2
	EX	AF,AF'
	ADD	IX,DE
	ADC	HL,BC
	RL	B
	EXX
	JR	xswap
;
;find numerically smaller slope (left)
;
anz2:	EX	AF,AF'
	PUSH	DE
	EXX
	EX	(SP),HL
	OR	A
	SBC	HL,DE
	POP	HL
	EXX
	PUSH	BC
	EXX
	EX	(SP),HL
	SBC	HL,BC
	RL	H
	POP	HL
xswap:	JR	NC,noswap
	EXX
	PUSH	IX
	EX	(SP),IY
	POP	IX
noswap:	EXX
;
;HL=H'L'=x1,A'A=y1,BCDE=sloper,B'C'D'E'=slopel
;Z'=flat top, carry=left/right
;draw first part:
;
	EX	AF,AF'
	CALL	NZ,fill
;
;swap so main registers are side 2:
;
	EX	AF,AF'
	JR	NC,noex1
	EXX
noex1:	EX	AF,AF'
;
;H'L'=x4,AA'=y2,B'C'D'E'=slope3,carry'=left/right
;set up for second part:
;
	POP	BC		;y2
	POP	HL		;y3
	PUSH	HL
	OR	A
	SBC	HL,BC		;y3-y2
	EX	DE,HL
	POP	HL		;y3
	INC	HL		;y3+1
	POP	BC		;x2
	EX	(SP),HL		;x3
	OR	A
	SBC	HL,BC		;x3-x2
	EX	DE,HL
	PUSH	AF
	PUSH	BC
	CALL	edge
	POP	HL
	POP	AF
;
;HL=x2,BCDE=slope4,H'L'=x4,B'C'D'E'=slope3,AA'=y2
;swap back:
;
	EX	AF,AF'
	JR	NC,noex2
	EXX
noex2:	EX	AF,AF'
;
;fill second part:
;
	CALL	fill
	POP	BC		;level stack
	RET
;
	PAGE
;
;sety - get y-value into range:
;   Inputs: HL = Y-value
;  Outputs: A = adjusted Y-value
; Destroys: A,F
;
sety:	LD	A,L
	DEC	H
	INC	H
	RET	PE
	LD	A,H
	ADD	A,A
	SBC	A,A
	RET
;
;fill - fill part of triangle:
;   Inputs: HLIX    = right x start
;           BCDE    = right slope
;           H'L'IY  = left x start
;           B'C'D'E'= left slope
;           AA'     = y start
;           (SP)    = y end + 1
;  Outputs: AA',HLIX,H'L'IY updated
; Destroys: A,H,L,A',H',L',IX,IY,F
;
fill:	DEC	A
	INC	A
	CALL	PE,hfill
	EXX
	ADD	IY,DE
	ADC	HL,BC
	EXX
	ADD	IX,DE
	ADC	HL,BC
	PUSH	BC
	PUSH	HL
	LD	HL,6
	ADD	HL,SP		;address stack
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	LD	H,A		;yhi
	EX	AF,AF'
	LD	L,A		;ylo
	INC	HL
	LD	A,L
	EX	AF,AF'
	LD	A,H
	SBC	HL,BC		;y-limit reached?
	POP	HL
	POP	BC
	JR	C,fill
	RET
;
;A'=ylo,HL=rightx,H'L'=leftx
;
hfill:	EX	AF,AF'
	PUSH	AF
	PUSH	BC
	PUSH	DE
	PUSH	HL
	EXX
	PUSH	HL
	EXX
	POP	DE
	CALL	hclip
	POP	HL
	POP	DE
	POP	BC
	POP	AF
	EX	AF,AF'
	RET
;
;Draw horizontal line segment with/without clipping
;Entry at "hclip" for clipping, "hdraw" for no clipping.
;   Inputs: DE=left x (0-255 + 8000H)
;           HL=right x (0-255 + 8000H)
;            A=y (0-63)
; Destroys: A,B,C,D,E,H,L,F
;
hclip:	LD	BC,8000H	;Min x
	OR	A
	SBC	HL,BC
	ADD	HL,BC
	RET	C
	EX	DE,HL
	OR	A
	SBC	HL,BC
	ADD	HL,BC
	JR	NC,hclip1
	LD	H,B
	LD	L,C
hclip1:	LD	C,255		;Max x
	PUSH	HL
	SCF
	SBC	HL,BC
	POP	HL
	RET	NC
	EX	DE,HL
	OR	A
	SBC	HL,BC
	ADD	HL,BC
	JR	C,hdraw
	LD	H,B
	LD	L,C
hdraw:	PUSH	HL		;Save right-x
	PUSH	AF		;Save y
	LD	L,A		;L <- y
	CALL	locat0
	ADD	A,A
	DEC	A		;Left mask
	POP	BC		;B <- y
	POP	DE		;DE <- right-x
	PUSH	HL		;Save address
	PUSH	AF		;Save left mask
	LD	L,B		;L <- y
	CALL	locat0
	DEC	A
	CPL			;Right mask
	POP	BC		;B <- left mask
	POP	DE		;DE <- address
	SBC	HL,DE		;Byte count (exclusive)
	RET	C
	INC	L		;L = byte count
	LD	H,B		;H = left mask
	LD	B,L		;B = byte count
	LD	C,A		;C = right mask
	EX	DE,HL
	LD	A,(plotyp)
	LD	E,A
	JR	hline
;
;Draw a horizontal straight line
;   Inputs: HL= "Screen" RAM address of left-hand end
;           D = left mask
;	    C = right mask
;           E = plotting mode
;           B = pixel count (inclusive)
; Destroys: A,B,C,D,E,H,L,F
;
hline0:	CALL	modify
	LD	D,0FFH
	INC	HL
hline:	DJNZ	hline0
	LD	A,C
	AND	D
	LD	D,A
	CALL	modify
;
;	Falls through...
;
;Update physical display line:
;   Inputs: HL = "screen" address in line
; Destroys: A,B,C,D,E,H,L,F
;
UPDATE:	EXX
	PUSH	BC
	PUSH	DE
	PUSH	HL
	EXX
	EX	AF,AF'
	PUSH	AF
	LD	A,L
	AND	11100000B
	LD	L,A
	LD	A,H
	SUB	STACK1/256
	OR	L
	RLCA
	RLCA
	RLCA
	LD	E,A
	LD	D,0
	LD	A,'5'		;Window number
	LD	BC,MP_WR
	SYS	OS_MAP
	POP	AF
	EX	AF,AF'
	POP	HL
	POP	DE
	POP	BC
	EXX
	RET
;
;Draw a straight line:
;
;   Inputs: B'C' = point count (special code)
;           D'E' = gradient
;           H'L' = index
;             HL = "Screen" RAM address
;	      BC = 32
;              D = bit mask
;              E = flag byte
;
drawit:	CALL	modify		;plot point (HLDE)
draw1:	EXX
	DJNZ	draw0
	DEC	C
	RET	Z		;all done
draw0:	ADD	HL,DE
	EXX
	BIT	7,E
	JR	NZ,draw3
	CALL	C,stepy
	CALL	stepx
	JR	draw2
;
draw3:	CALL	C,stepx
	CALL	stepy
draw2:	BIT	4,E		;dotted?
	JR	Z,drawit
	BIT	2,E
	RES	2,E
	JR	NZ,drawit
	SET	2,E
	JR	draw1
;
stepy:	PUSH	BC
	PUSH	DE
	PUSH	HL
	CALL	UPDATE		;Update physical screen
	POP	HL
	POP	DE
	POP	BC
	BIT	5,E
	JR	Z,stepy1
	ADD	HL,BC
	RET
;
stepy1:	OR	A		;Clear carry
	SBC	HL,BC
	RET
;
stepx:	BIT	6,E
	JR	NZ,stepx1
	RRC	D		;Rotate bit mask
	RET	NC
	INC	HL
	RET
;
stepx1:	RLC	D
	RET	NC
	DEC	HL
	RET
;
;locate - Get display RAM address and bit mask
;
;   Inputs: DE = x-coord 0-255 + 8000H
;           HL = y-coord 0-63 + 8000H
;  Outputs: HL = "screen" RAM address
;            A = bit mask
;           Carry set if out of range
; Destroys: A,D,E,H,L,F
;
locate:	SCF
	DEC	H
	RET	PO		;OUT OF RANGE
	DEC	D
	RET	PO		;OUT OF RANGE
locat0:	LD	A,63
	SUB	L		;Y-VALUE 0-63
	RET	C		;OUT OF RANGE
	ADD	A,A		;Y * 2
	ADD	A,A		;Y * 4
	LD	L,A
	LD	H,0
	LD	D,H
	ADD	HL,HL		;Y * 8
	ADD	HL,HL		;Y * 16
	ADD	HL,HL		;Y * 32
	LD	A,E
	SRL	E
	SRL	E
	SRL	E
	ADD	HL,DE		;RAM offset
	PUSH	HL
	AND	111B		;BIT NUMBER
	LD	E,A
	LD	HL,masks
	ADD	HL,DE
	LD	A,(HL)		;BIT MASK
	POP	HL
	LD	DE,STACK1
	ADD	HL,DE		;RAM address (clear cy)
	RET
;
masks:	DEFB	10000000B
	DEFB	01000000B
	DEFB	00100000B
	DEFB	00010000B
	DEFB	00001000B
	DEFB	00000100B
	DEFB	00000010B
	DEFB	00000001B
;
ascale:	LD	BC,(yorig)
	ADD	HL,BC
	LD	BC,8000H
	ADD	HL,BC
	EX	DE,HL
	ADD	HL,BC
	LD	BC,(xorig)
	ADD	HL,BC
	EX	DE,HL
	RET
;
rscale:	LD	BC,(lasty)
	ADD	HL,BC
	EX	DE,HL
	LD	BC,(lastx)
	ADD	HL,BC
	EX	DE,HL
	RET
;
;negate HL
;   Inputs: HL
;  Outputs: HL=-HL
; Destroys: H,L,A'
;
neg0:	OR	00100000B
negate:	EX	AF,AF'
	LD	A,H
	CPL
	LD	H,A
	LD	A,L
	CPL
	LD	L,A
	INC	HL
	EX	AF,AF'
	RET
;
;16-bit division routine
;   Inputs: BC,DE,HL
;  Outputs: DE=BCDE/HL
; Destroys: A,B,C,D,E,H,L,F
;
divide:	INC	DE
	LD	A,-17
diva:	OR	A
div0:	SBC	HL,BC
	JR	NC,div1
	ADD	HL,BC
div1:	CCF
divc:	RL	E
	RL	D
	INC	A
	RET	P
	ADC	HL,HL
	JR	NC,div0
	OR	A
	SBC	HL,BC
	SCF
	JP	divc
;
;Modify a byte in graphics RAM
;   Inputs: HL = "Screen" RAM address
;           D = bit mask
;           E = plotting mode
; Destroys: A,F
;
modify:	LD	A,(HL)
	BIT	0,E
	JR	Z,mod02
	OR	D		;OR modification
mod02:	BIT	1,E
	JR	Z,mod01
	XOR	D		;XOR modification
mod01:	LD	(HL),A
	RET
;
;Test point against graphics window:
;   Inputs: DE = x-ordinate
;           HL = y-ordinate
;  Outputs: A = error code (used by search)
;           A=0 & Z-flag set if in range
; Destroys: A,F
;
range:	PUSH	BC
	XOR	A
	LD	BC,8000H	;Min y
	SBC	HL,BC
	ADD	HL,BC
	ADC	A,A
	LD	C,63		;Max y
	PUSH	HL
	SCF
	SBC	HL,BC
	POP	HL
	CCF
	ADC	A,A
	EX	DE,HL
	LD	C,0		;Min x
	SBC	HL,BC
	ADD	HL,BC
	ADC	A,A
	LD	C,255		;Max x
	PUSH	HL
	SCF
	SBC	HL,BC
	POP	HL
	EX	DE,HL
	CCF
	ADC	A,A
	POP	BC
	RET
;
;calculate edge slope:
;   Inputs: DE = dx, HL = dy
;  Outputs: BCDE = dx/dy
; Destroys: A,B,C,D,E,H,L,F
;
edge:	BIT	7,D
	JR	Z,depos
	LD	A,D
	CPL
	LD	D,A
	LD	A,E
	CPL
	LD	E,A
	INC	DE
depos:	EXX
	PUSH	BC
	PUSH	DE
	PUSH	HL
	EXX
	PUSH	HL
	EXX
	POP	DE
	LD	HL,0
	PUSH	HL
	EXX
	EX	DE,HL
	POP	DE		;DE <- 0
	LD	B,D		;Mark integer
	LD	C,E
	PUSH	AF
	EX	AF,AF'
	PUSH	AF
	PUSH	IX
	LD	A,1
	CALL	FPP		;DIV
	POP	IX
	POP	AF
	EX	AF,AF'
	POP	AF
	JR	Z,respos
	XOR	A
	EXX
	EX	DE,HL
	LD	H,A
	LD	L,A
	SBC	HL,DE
	EXX
	EX	DE,HL
	LD	H,A
	LD	L,A
	SBC	HL,DE
respos:	EXX
	PUSH	HL
	EXX
	POP	DE
	LD	B,H
	LD	C,L
	EXX
	POP	HL
	POP	DE
	POP	BC
	EXX
	RET
;
;clip - clip line segment to region within window
;   Inputs: DE,  HL  = x,y coordinates of end 1
;           DE', HL' = x,y coordinates of end 2
;  Outputs: Z-flag reset if none of line in range
;           DE,  HL  = new coordinates of end 1
;           DE', HL' = new coordinates of end 2
; Destroys: A,B,C,D,E,H,L,B',C',D',E',H',L',F
;
clip:	CALL	range		;end 1 inside window?
	EXX
	JR	NZ,clip5
	CALL	range		;end 2 inside window?
	EXX
	RET	Z		;both ends in range
clip1:	LD	A,16		;iteration counter
	PUSH	DE
	PUSH	HL		;save in-range end
clip2:	DEC	A
	JR	Z,clip4
	PUSH	DE
	PUSH	HL
	CALL	mid		;find mid-point
	LD	B,A
	CALL	range
	LD	A,B
	JR	Z,clip3
	EXX
	POP	HL
	POP	DE
	JR	clip2
;
clip3:	POP	BC
	POP	BC
	JR	clip2
;
clip4:	EXX
	POP	HL
	POP	DE
	RET
;
clip5:	CALL	range
	JR	NZ,clip6	;both ends out-of-range
	CALL	clip1
	EXX
	RET
;
clip6:	PUSH	DE
	PUSH	HL
	LD	A,16		;iteration count
	CALL	search		;find a point in range
	CALL	Z,clip1
	POP	HL
	POP	DE
	EXX
	JR	Z,clip1
	RET			;none of line visible
;
searci:	INC	A
search:	DEC	A
	RET	M		;pathological case
	LD	C,A		;save iteration counter
	CALL	range
	RET	Z		;found it!
	LD	B,A
	EXX
	CALL	range
	EXX
	AND	B		;4-way test
	LD	A,C		;restore counter
	RET	NZ		;None in range
	PUSH	DE
	PUSH	HL
	CALL	mid
	CALL	search		;recursive call
	EXX
	POP	BC
	EX	DE,HL
	EX	(SP),HL
	EX	DE,HL
	PUSH	BC
	EX	(SP),HL
	EXX
	CALL	NZ,searci	;recursive call
	EXX
	POP	HL
	POP	DE
	EXX
	RET	Z
	INC	A
	RET
;
;mid - find mid-point of line segment
;   Inputs: DE,  HL  = x,y coordinates of end 1
;           DE', HL' = x,y coordinates of end 2
;  Outputs: DE,  HL  = coordinates of mid-point
; Destroys: B,C,D,E,H,L,F
;
mid:	EXX
	PUSH	DE		;x'
	PUSH	HL		;y'
	EXX
	POP	BC		;y'
	ADD	HL,BC		;y=y+y'
	RR	H		;y=y/2
	RR	L
	EX	DE,HL
	POP	BC		;x'
	ADD	HL,BC		;x=x+x'
	RR	H		;x=x/2
	RR	L
	EX	DE,HL
	RET
;
;Variables:
;
lastx:	DEFW	8000H
lasty:	DEFW	8000H
prevx:	DEFW	8000H
prevy:	DEFW	8000H
xorig:	DEFW	0
yorig:	DEFW	0
modeno:	DEFB	0
plotyp:	DEFB	0
;
STKTOP:	DEFW	STACK
;
;The end
;
	DEFS	256		;Space for Screen Dump
FINISH:
;
	END