
;    ZXZVM: Z-Code interpreter for the Z80 processor
;    Copyright (C) 1998-9,2006,2016  John Elliott <seasip.webmaster@gmail.com>
;
;    This program is free software; you can redistribute it and/or modify
;    it under the terms of the GNU General Public License as published by
;    the Free Software Foundation; either version 2 of the License, or
;    (at your option) any later version.
;
;    This program is distributed in the hope that it will be useful,
;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;    GNU General Public License for more details.
;
;    You should have received a copy of the GNU General Public License
;    along with this program; if not, write to the Free Software
;    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

; 2006, Garry Lancaster: Added 32-cpl output routines
; 2019-05-01, Garry Lancaster: Fixed PRINAT to correctly limit x
; 2019-05-03, Garry Lancaster: Fixed incorrect translation of DELETE char
; 2019-05-14, Garry Lancaster:
;       Fixed random memory corruption on empty input
;       Fix for mid-input character insertion corrupting characters at end
;       Fix multi-line inputs (previously displayed incorrectly and crashed)
;       Fixes for timed input

;
;Spectrum I/O and utility code
;
;I originally wrote these routines to match their namesakes in a CP/M library -
;therefore CON6 refers to the CP/M BDOS, function 6.
;
FRAMES	EQU	5C78h	;50Hz counter

OHL:	DEFW	0
;
PUSHA:	LD	(OHL),HL
	POP	HL	;Return address
	LD	(PA1+1),HL
	LD	HL,(OHL)
	PUSH	AF
	PUSH	BC
	PUSH	DE
	PUSH	HL
	PUSH	IX
	PUSH	IY
PA1:	JP	0
;
POPA:	POP	IY
	POP	IX
	POP	HL
	POP	DE
	POP	BC
	POP	AF
	RET
;

MORE:				;Rather than print [MORE], use a flashing
	PUSH	HL		;cursor.
	LD	A,7
	CALL	SELMEM
	LD	HL,SCRADDR+1AFFh	;Bottom right hand corner
	LD	A,(HL)
	XOR	0C0h		;Bright and flashing!
	LD	(HL),A
MORE1:	CALL	CON6
	OR	A
	JR	Z,MORE1
	LD	A,(HL)
	XOR	0C0h		;Remove the bright/flashing attribute
	LD	(HL),A
	LD	A,6
	CALL	SELMEM
	POP	HL
RES_MORE:
	PUSH	HL
	LD	A,(win_hc)
	dec	a
	LD	HL,LWTOP
	SUB	(HL)		;A = no. of scrolls to next [MORE]
	LD	(SCRLS),A
	POP	HL
	INC	A
	RET
;
UPCASEA:
	CP	'a'	;CONVERT THE CHARACTER IN A TO UPPERCASE.
	RET	C
	CP	'z'+1
	RET	NC
	RES	5,A
	RET
;
LCASE:	CP	'A'	;convert the character in a to lowercase.
	RET	C
	CP	'Z'+1
	RET	NC	;<< v0.02 >> use RET NC not RET C, it might help :-)
	SET	5,A
	RET
;
CON6:	PUSH    BC      ;IF THERE IS NO KEYPRESS, A:=0 ELSE A:=KEYPRESS
	PUSH    DE
	PUSH    HL
	EI
	CALL    PUTCUR
	XOR     A                ;L mode
	LD      IY,05C3AH	;IY required by subroutine
	SET	3,(IY+1)
	RES	5,(IY+2)
	RES	3,(IY+2)
	CALL    10A8H           ;Get keyboard character.
	JR      C,CON6X2        ;Input OK.
;
;Check specially for BREAK.
;
	LD	BC,0FEFEH
	IN	A,(C)		;Port FEFE
	CPL
	AND	1		;CAPS
	JR	Z,CON6X2
	LD	B,07FH
	IN	A,(C)
	CPL
	AND	1		;1 => BREAK, 0 => no character.
CON6X2: CALL    PUTCUR
	POP     HL
	POP     DE
	POP     BC
	RET
;
PRINT:	CALL	PUSHA
	LD	C,E
	LD	B,D
PRI1:	LD	A,(BC)
	CP	'$'
	JP	Z,POPA
	LD	E,A
	CALL	OPCHAR
	INC	BC
	JR	PRI1

; As above, but for bit7-terminated messages
PRINT7: CALL	PUSHA
	LD	C,E
	LD	B,D
PRI71:	LD	A,(BC)
	RES	7,A		; clear terminator bit
	LD	E,A
	CALL	OPCHAR
	LD	A,(BC)
	BIT	7,A		; check terminator
	JP	NZ,POPA
	INC	BC
	JR	PRI71


;
STRING$:		;PRINT THE CHARACTER IN E B TIMES.
	PUSH	BC
STRI$1:	CALL	OPCHAR
	DEC	B
	JP	NZ,STRI$1
	POP	BC
;
OPCHAR:
	CALL	PUSHA
	PUSH	AF
	LD	A,7
	CALL	SELMEM
	POP	AF
	CALL	PR64
	LD	A,6
	CALL	SELMEM
	JP	POPA
;
ANYCHAR:
	CALL	PUSHA
	PUSH	AF
	LD	A,7
	CALL	SELMEM
	POP	AF
	CALL	PR64A
	LD	A,6
	CALL	SELMEM
	JP	POPA
;
PRINAT:
	PUSH	AF	;Move cursor, limiting it to within the screen
	PUSH	DE
	push	hl
	ld	hl,(win_hc)	; H=width, L=height
	LD	A,E
	CP	h
	JR	C,PRINA1
	LD	A,h
	dec	a
	ld	e,a
PRINA1:	LD	A,D	;Y
	CP	l
	JR	C,PRINA2
	LD	A,l
	dec	a
PRINA2: ld	l,a	; L=character line
	ld	a,(win_ch)
	ld	h,a
	xor	a
PRINA3:	add	a,l
	dec	h
	jr	nz,prina3
	ld	d,a	; D=pixel line
	LD	(XPOS),DE
	pop	hl
	POP	DE
	POP	AF
	RET
;
HIVON:	PUSH	AF
	XOR	A
	DEC	A
	LD	(HVF),A
	POP	AF
	RET
;
HIVOFF:
	PUSH	AF
	XOR	A
	LD	(HVF),A
	POP	AF
	RET
;
CURON:	PUSH	AF
	XOR	A
	DEC	A
	LD	(CURFLG),A
	POP	AF
	RET
;
CUROFF:
	PUSH	AF
	XOR	A
	LD	(CURFLG),A
	POP	AF
	RET
;
ZIBUF:	DEFW	0	;Z-address of input buffer
INPPOS:	DEFW	0	;X,Y of start of input buffer
MAXL:	DEFB	0	;Max input length
ACTL:	DEFB	0	;Actual input length
CURP:	DEFB	0	;Cursor position
OFRAME:	DEFB	0	;Last value of FRAMES ticker
TIMEV:	DEFW	0	;Countdown in 50ths of a second to timeout
CACHED_CURP:
	DEFB	255	;cached curp from interrupted input (255=none)
CACHED_CWIN:
	DEFB	0	; cached cwin from interrupted input
INPUTKEYPRESS:
	DEFB	0	; 1=a key was pressed during input
WINDIRTY:
	DEFB	0	; window dirty bits since interrupted input:
				;  bit 0=upper window changed
				;  bit 1=lower window changed
;
;Initialise timed input
;
INITIME:
        PUSH    HL
        LD      H,D     ;DE = timeout in tenths of a second
        LD      L,E
        ADD     HL,HL
        ADD     HL,HL
        ADD     HL,DE   ;HL = timeout in 50ths of a second
        LD      (TIMEV),HL
        LD      A,(FRAMES)
        LD      (OFRAME),A
        POP     HL
	RET
;
;Read character, with timeout
;
RCHAR:	CALL	INITIME
	CALL	RCHAR1
	AND	A
	RET	Z
	PUSH	AF
	CALL	RES_MORE
	POP	AF
XLTCHR:	LD	B,A		;Translate Spectrum control codes
	LD	HL,XLTAB	;to Z-machine control codes. B=code to do.
XLTLP:	LD	A,(HL)
	INC	HL
	INC	HL
	OR	A
	JR	Z,XLTEND
	CP	B
	JR	NZ,XLTLP
	DEC	HL
	LD	A,(HL)
	RET
;
XLTEND:	LD	A,B
	RET
;
;Translation table: Spectrum control codes to Z-machine
;
XLTAB:	DEFB	12,127	;Delete
	DEFB	8,131	;Left
	DEFB	9,132	;Right
	DEFB	11,129	;Up
	DEFB	10,130	;Down
	DEFB	0	;End of table
;
RCHAR1:	LD      HL,OFRAME       ;Has the 50Hz counter changed?
        LD      A,(FRAMES)
        CP      (HL)
        JR      Z,RCHAR2
        LD      (HL),A
        LD      HL,(TIMEV)      ;If time is 0, don't time out.
        LD      A,H
        OR      L
        JR      Z,RCHAR2
        DEC     HL
        LD      A,H
        OR      L
	RET	Z		;Return with timeout
        LD      (TIMEV),HL
RCHAR2:	CALL    CON6
        OR      A
	RET	NZ
        JR      RCHAR1
;
LINEINP:
;
;Line input into buffer at HL, timeout DE (0 for none)
;
	CALL	CURON
	CALL	INITIME
	LD	(ZIBUF),HL
	XOR	A
	LD	(WRAPPED),A
	LD	(INPUTKEYPRESS),A
	LD	HL,(LWX)
	LD	A,(CWIN)
	OR	A
	JR	NZ,LINEI1
	LD	HL,(UWX)
LINEI1: LD	(INPPOS),HL
	EX	DE,HL
	CALL	PRINAT		;set starting position of input
	EX	DE,HL
	LD	HL,(ZIBUF)
	CALL	PEEK64
	LD	(MAXL),A
	INC	HL
	CALL	PEEK64
	LD	(CURP),A	;store length as current position
	LD	HL,ACTL
	CP	(HL)		;does actual length match from last time?
	LD	(HL),A		;store actual length
	JR	NZ,FIND_ISTART	;on if not
	LD	HL,CACHED_CURP
	CP	(HL)		;is the cached curp within preloaded input?
	JR	C,FIND_ISTART
	LD	A,(HL)		;if so, use the cached curp as we are
	LD	(CURP),A	;resuming a timed input
	LD	A,(ACTL)
FIND_ISTART:
	LD	HL,(INPPOS)	;H=start Y, L=start X
	LD	DE,(WIN_WC)	;E=width of main window
FIND_ISTART_LOOP:
	AND	A
	JR	Z,GOT_ISTART_HL
	SUB	E		;need to go up a line?
	JR	C,FIND_ISTART_X	;on if not, to adjust X
	DEC	H		;decrement Y
	JR	FIND_ISTART_LOOP
FIND_ISTART_X:
	ADD	A,E		;add back line width
	LD	D,A
	LD	A,L
	SUB	D		;A=current X - given length
	JR	NC,GOT_ISTART_HA;on if don't need to wrap to previous line
	ADD	A,E		;A=X position on previous line
	DEC	H		;H=previous line
GOT_ISTART_HA:
	LD	L,A
GOT_ISTART_HL:
	LD	(INPPOS),HL	;store start of input, including given
	CALL	UPDLN		;UPDATE LINE
	JR	INPUT
;
COMTAB:	DEFW	TIMED0	;Timeout
	DEFW	INPUTB	;^A (ignore BREAK)
	DEFW	INPUT3	;^B
	DEFW	INPUT3	;^C
	DEFW	INPUT3	;^D
	DEFW	INPUT3	;^E
	DEFW	INPUT3	;^F
	DEFW	RDEL	;^G
	DEFW	MOVLT	;^H
	DEFW	MOVRT	;^I
	DEFW	TRUEVID	;^J
	DEFW	INVVID	;^K
	DEFW	DELETE	;^L
	DEFW	FINISH	;^M
	DEFW	LINEOL	;^N
	DEFW	RDEL	;^O
	DEFW	INPUT3	;^P
	DEFW	INPUT3	;^Q
	DEFW	INPUT3	;^R
	DEFW	INPUT3	;^S
	DEFW	INPUT3	;^T
	DEFW	INPUT3	;^U
	DEFW	INPUT3	;^V
	DEFW	INPUT3	;^W
	DEFW	INPUT3	;^X
	DEFW	INPUT3	;^Y
	DEFW	INPUT3	;^Z
	DEFW	INPUT3	;^[
	DEFW	INPUT3	;^\
	DEFW	INPUT3	;^]
	DEFW	INPUT3	;^^
	DEFW	INPUT3	;^_
;
INPUT:	CALL	MOVXY	;Move cursor to the right place
	CALL	RCHAR1	;Get character with timer
	AND	A
	JR	Z,INPUTCTRL	;process "timeout" (0) as a control char
	LD	HL,INPUTKEYPRESS
	SET	0,(HL)		;any other value means a key has been pressed
	CP	' '
	JP	NC,INPUT3
;
INPUTCTRL:
	LD	L,A		;Command characters
	LD	H,0
	ADD	HL,HL
	LD	DE,COMTAB
	ADD	HL,DE
	LD	D,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,D
	JP	(HL)
;
COMMON_END:
	LD	A,255
	LD	(CACHED_CURP),A	;clear the cached curp
	LD	A,(ACTL)
	CALL	SET_SCRPOS_A	;move print position to after input chars
	CALL	CUROFF		;disable cursor output
	LD	HL,INPUTKEYPRESS
	BIT	0,(HL)		;did anything get pressed during the input?
	CALL	NZ,RES_MORE	;if so, reset scrolls to the next MORE prompt
	LD	A,(ACTL)
	LD	B,A
	LD	HL,(ZIBUF)
	INC	HL
	CALL	ZXPOKE
	RET
;
FINISH:
	CALL	COMMON_END	;restore screen, pack input length in buffer
				;leaves B=input length, HL=buffer Z-Addr + 1
	INC	B
	JR	LCLP_START	;Ensure B=0 case is correctly handled
LCLP:	INC	HL		;Force it to lowercase
	CALL	PEEK64
	PUSH	AF
	PUSH	HL
	LD	L,A
	CALL	cktschar
	POP	HL
	POP	AF
	CALL	LCASE
	CALL	ZXPOKE
LCLP_START:
	DJNZ	LCLP
	CALL	UPDATE_WINPOS	;update appropriate window position
	LD	HL,0Dh		;<< v1.11 Force a CR/LF.
	CALL	OUT1A		;>> v1.11
	LD	B,0Ah		;B=terminating character
	SCF
	RET
;
TIMED0:				;Input timed out!
	CALL	COMMON_END	;restore screen, pack input length in buffer
	XOR	A
	LD	(WINDIRTY),A	;mark windows as "clean"
	LD	A,(CWIN)
	LD	(CACHED_CWIN),A	;cache the current cwin
	CALL	PERFORMWRAP	;do a CRLF and update INPPOS if necessary
	CALL	UPDATE_WINPOS	;update appropriate window position
	LD	A,(SCRLS)
	DEC	A
	LD	(SCRLS),A	;update lines to next MORE
	CALL	M,MORE		;do MORE if needed
	LD	B,0		;B=terminating character
	SCF
	RET
;
;Hint from VM that timed input is about to be resumed
IRES1:
	LD	A,(CURP)
	LD	(CACHED_CURP),A	; cache the current curp
	LD	HL,(CACHED_CWIN)
	LD	A,(CWIN)
	CP	L
	RET	NZ		; nothing to do if different window
	CP	1		; Fc=1 if cwin=0(upper); Fc=0 if cwin=1(lower)
	ADC	A,A		; A=1 (bit 0) for upper, A=2 (bit 1) for lower
	LD	HL,WINDIRTY
	AND	(HL)
	RET	NZ		; nothing to do if window contents changed
	LD	A,(SCRLS)
	INC	A
	LD	(SCRLS),A	; undo the update made at last timeout
	LD	HL,(INPPOS)	; position for buffer contents to be reprinted
	JR	SET_WINPOS	; set position in current window and exit

UPDATE_WINPOS:
	LD	HL,(XPOS)	; L=X in chars, H=Y in pixel lines
	LD	A,(WIN_CH)
	LD	C,A		; C=char height in pixels
	LD	A,H
	LD	B,0		; initialise accumulated Y pos in chars
	JR	FIND_YPOS_START
FIND_YPOS:
	INC	B
	SUB	C
FIND_YPOS_START
	AND	A
	JR	NZ,FIND_YPOS
	LD	H,B		; H=Y in chars
SET_WINPOS:
	LD	A,(CWIN)	; update the appropriate window position
	AND	A
	JR	Z,SET_WINPOS_U
	LD	(LWX),HL
	RET
SET_WINPOS_U:
	LD	(UWX),HL
	RET
;
DELETE:	LD	A,(CURP)
	OR	A		;DEL LEFT/^H. AT THE LH END OF THE LINE?
	CALL	Z,CHIME
	JP	Z,INPUT
;
	LD	D,A
	LD	A,(ACTL)
	CP	D		;LAST CHARACTER SPECIAL CASE
	JP	Z,DELLAST
;
	CALL	GETPPOS		;DE=NEXT CHARACTER
	LD	D,H
	LD	E,L
	DEC	HL		;HL=THIS CHARACTER
	LD	A,(CURP)
	LD	B,A
	LD	A,(ACTL)
	SUB	B		;Length of line - cursor pos = no. to shift
	LD	B,A		;B = no, to shift
DEL1:	EX	DE,HL
	CALL	PEEK64
	EX	DE,HL
	CALL	ZXPOKE
	INC	HL
	INC	DE
	DJNZ	DEL1
	LD	HL,ACTL
	DEC	(HL)
	LD	HL,CURP
	DEC	(HL)
	CALL	UPDLN		;UPDATE LINE
	CALL	MOVXY
	JP	INPUT
;
DELLAST:			;Delete last character
	LD	HL,ACTL
	DEC	(HL)
	LD	HL,CURP
	DEC	(HL)
	CALL	UPDLN
	CALL	MOVXY
	JP	INPUT
;
RDEL:	LD	A,(CURP)	;Delete right
	LD	HL,ACTL
	CP	(HL)
	CALL	Z,CHIME
	JP	Z,INPUT
	CALL	GETPPOS
	LD	D,H
	LD	E,L
	INC	DE		;HL=THIS CHARACTER
	LD	A,(CURP)
	LD	B,A
	LD	A,(ACTL)
	SUB	B		;No. of characters to swallow
	DEC	A
	JR	Z,RDEL2		;No characters need swallowing
	LD	B,A
RDEL1:	EX	DE,HL
	CALL	PEEK64
	EX	DE,HL
	CALL	ZXPOKE
	INC	HL
	INC	DE
	DJNZ	RDEL1
RDEL2:	LD	HL,ACTL
	DEC	(HL)
	CALL	UPDLN		;UPDATE LINE
	CALL	MOVXY
	JP	INPUT
;
CUT:	CALL	DEL2E		;Delete line
	JP	DEL2BOL
;
DEL2EOL:
	CALL	DEL2E		;Delete to end of line
	JP	INPUT
;
DEL2E:	CALL	GETPPOS
	LD	A,(CURP)
	LD	(ACTL),A
	CALL	UPDLN
	CALL	MOVXY
	JP	INPUT
;
DEL2BOL:			;Delete to start of line
	CALL	GETPPOS
	LD	DE,(ZIBUF)
	INC	DE
	INC	DE
	LD	A,(CURP)
	LD	B,A
	LD	A,(ACTL)
	SUB	B
	LD	C,0
	LD	B,A		;B = no. of characters to move to start
	OR	A
	JR	Z,DEL4B
DEL3B:	CALL	PEEK64
	EX	DE,HL
	CALL	ZXPOKE
	EX	DE,HL
	INC	HL
	INC	DE
	INC	C
	DJNZ	DEL3B
DEL4B:	LD	A,C
	LD	(ACTL),A
	XOR	A
	LD	(CURP),A
	CALL	UPDLN
	CALL	MOVXY
	JP	INPUT

;
TRUEVID:ld	a,(ATTR_P)
	ld	e,a
	and	0F8h
	ld	d,a		; D=colour with INK masked out
	ld	a,e
	inc	a
	and	7		; A=next INK
setattr:or	d
	ld	(ATTR_P),a
	ld	(BORDCR),a
	call	clattr		; clear attribs
	ld	a,6
	call	selmem
	jp	input

INVVID:	ld	a,(ATTR_P)
	ld	e,a
	and	0C7h
	ld	d,a		; D=colour with PAPER masked out
	ld	a,e
	add	a,8
	and	038h		; A=next PAPER
	jr	setattr
;
INPUTB:	LD	A,' '	;BREAK -> SPACE
INPUT3:	CALL	INSERT	;Insert a simple character
	CALL	UPDLN
	CALL	MOVXY
	JP	INPUT
;
yil:	defb	0
yes_i_live:
	call	pusha
	ld	a,(yil)
	out	(254),a
	inc	a
	and	7
	ld	(yil),a
yil1:	call	con6
	or	a
	jr	z,yil1
	jp	popa
;
CHAR:	DEFB	0
;
INSERT:	LD	(CHAR),A	;INSERT A CHARACTER
	LD	A,(ACTL)
	LD	HL,MAXL
	CP	(HL)		;IS LENGTH=MAXIMUM?
	CALL	Z,CHIME		;IF YES, BLEEP; DISALLOW
	RET	Z
;
	LD	HL,CURP
	CP	(HL)		;IS THIS THE LAST CHARACTER?
	JR	NZ,INSERT1	;SPECIAL CASE IF JUST ADDING THE LAST CHARACTER
	CALL	GETLPOS
	LD	A,(CHAR)
	CALL	ZXPOKE
	LD	A,(ACTL)
	INC	A
	LD	(ACTL),A
	LD	(CURP),A
	RET
;
INSERT1:
	CALL	GETPPOS		;HL=CURRENT POSITION
	CALL	PEEK64		;Insert, and move up
	LD	C,A
	LD	A,(CURP)
	LD	B,A
	LD	A,(ACTL)
	SUB	B
	INC	A
	LD	B,A		;B = no. of chars to move up
INSERT2:
	CALL	PEEK64
	PUSH	AF
	LD	A,C
	CALL	ZXPOKE
	POP	AF
	LD	C,A
	INC	HL
	DJNZ	INSERT2
	CALL	GETPPOS
	LD	A,(CHAR)
	CALL	ZXPOKE	 ;STORE NEW CHARACTER
	LD	HL,CURP
	INC	(HL)
	LD	HL,ACTL
	INC	(HL)
	RET
;
GETPPOS:
	PUSH	DE
	LD	DE,(ZIBUF)
	INC	DE
	INC	DE
	LD	HL,(CURP)
	LD	H,0
	ADD	HL,DE	;HL=CURSOR POS.
	POP	DE
	RET
;
MOVLT:	LD	A,(CURP)
	OR	A
	JP	Z,INPUT
	DEC	A
	LD	(CURP),A
	CALL	MOVXY
	JP	INPUT
;
MOVRT:	LD	A,(CURP)
	LD	HL,ACTL
	CP	(HL)
	JP	Z,INPUT
	INC	A
	LD	(CURP),A
	CALL	MOVXY
	JP	INPUT
;
GETLPOS:
	PUSH	DE
	LD	DE,(ZIBUF)
	INC	DE
	INC	DE
	LD	HL,(ACTL)
	LD	H,0
	ADD	HL,DE
	POP	DE
	RET
;
MOVXY:	CALL	PUSHA
	CALL	SET_SCRPOS
	JP	POPA

SET_SCRPOS:
	LD	A,(CURP)
SET_SCRPOS_A:
	LD	DE,(INPPOS)	;D=start Y, E=start X
	LD	HL,(WIN_WC)	;L=width of window
SET_SCRPOS2:
	ADD	A,E		;add cursor position to X
	JR	NC,SET_SCRPOS3	;okay if not >255
	SUB	E		;otherwise undo addition
	SUB	L		;and reduce X by window width
	INC	D		;then increment Y
	JR	SET_SCRPOS2	;loop back
SET_SCRPOS3:
	CP	L		;is new X position within window width?
	JR	C,SET_SCRPOS4	;okay if so
	SUB	L		;else reduce X by window width
	INC	D		;and increment Y
	JR	SET_SCRPOS3	;loop back
SET_SCRPOS4:
	LD	E,A
	CALL	PRINAT		;adjust print position
	RET

;Check if a wrap occurred; if so, do a CRLF, scroll if needed & update INPPOS
CHECKWRAP:
	LD	A,(WRAPPED)
	AND	A
	RET	Z		;exit if no wrap occurred
PERFORMWRAP:
	XOR	A
	LD	(WRAPPED),A	;clear wrap flag
	LD	(XPOS),A	;CR
	LD	A,(YPOS)
	LD	L,A
	LD	A,(WIN_CH)
	ADD	A,L		;LF
	LD	(YPOS),A
	LD	H,A
	LD	A,(WIN_CH)
	LD	L,A
	LD	A,(WIN_HP)
	SUB	L
	LD	L,A
	LD	A,H
	CP	L
	RET	C		;exit if still within window
	RET	Z
	LD	A,L
	LD	(YPOS),A	;else clamp to within window
	LD	A,(LWTOP)
	CALL	SCRL_N		;scroll up
	LD	HL,(INPPOS)	;get stored input position
	LD	A,(LWTOP)
	CP	H
	RET	Z		;do nothing if already on top line of lower
	DEC	H		;otherwise decrement to previous line
	LD	(INPPOS),HL
	RET
;
UPDLN:	CALL	PUSHA
	LD	DE,(INPPOS)
	CALL	PRINAT
	XOR	A
	LD	(WRAPPED),A
	LD	HL,(ZIBUF)
	INC	HL
	INC	HL
	LD	A,(ACTL)
	OR	A
	JR	Z,UPDLN3
	LD	B,A
UPDLN1:	CALL	PEEK64
	LD	E,A
	INC	HL
	CALL	ANYCHAR
	PUSH	BC
	PUSH	HL
	CALL	CHECKWRAP
	POP	HL
	POP	BC
	DJNZ	UPDLN1
UPDLN3:	LD	A,(MAXL)
	LD	HL,ACTL
	SUB	(HL)		;A=UNUSED CHARS
	OR	A
	JP	Z,POPA
	LD	B,A
	LD	E,' '
UPDLN4:	CALL	OPCHAR
	PUSH	BC
	PUSH	HL
	CALL	CHECKWRAP
	POP	HL
	POP	BC
	DJNZ	UPDLN4
	JP	POPA
;
LINEOL:	LD	A,(CURP)
	OR	A
	JR	Z,EOL
	XOR	A
	LD	(CURP),A
	CALL	MOVXY
	JP	INPUT
;
EOL:	LD	A,(ACTL)
	LD	(CURP),A
	CALL	MOVXY
	JP	INPUT
;
wrapped:
	defb	0	;Did the last character cause a line wrap?
WRAP:	DEFB	0	;Wrap at end of line?
XPOS:	DEFB	0	;Cursor X, characters
YPOS:	DEFB	0	;Cursor Y, pixels
SCRATCH:
	DEFB	0	;Used while scrolling
OVER:	DEFB	0	;Overprinting on?
HVF:	DEFB	0	;High (reversed) video on?
ITF:	DEFB	0	;Underlining on?
CURFLG:	DEFB	0
;
PUTCUR:	CALL	PUSHA
	LD	A,(CURFLG)
	OR	A
	JP	Z,POPA
	XOR	A
	DEC	A
	LD	(OVER),A
	LD	A,7
	CALL	SELMEM
	LD	A,'_'
	CALL	OPC64
	LD	A,6
	CALL	SELMEM
	JP	POPA
;
DOLF:	LD	A,(YPOS)
	ld	l,a
	ld	a,(win_ch)
	add	a,l
	LD	(YPOS),A
	JP	NOCR1
;
PR64:	LD	A,E
	CP	0DH
	JP	Z,DOCR
	CP	0AH
	JR	Z,DOLF
	CP	07H
	JP	Z,CHIME
	CP	20H
	RET	C
	CP	0E0h
	RET	NC
PR64A:	XOR	A
	LD	(OVER),A
	ld	a,(win_ftype)
	and	a
	jr	nz,PR64B	; 32-char printing handles reverse internally
	LD	A,(HVF)
	OR	A
	JR	Z,PR64B
	LD	A,143
	PUSH	DE
	CALL	OPC64
	POP	DE
	LD	A,0FFh		;The text character will be drawn overprinted
	LD	(OVER),A
PR64B:	LD	A,(ITF)
	OR	A
	JR	Z,PR64C
	LD	A,'_'
	PUSH	DE
	CALL	OPC64
	POP	DE
	LD	A,0FFh
	LD	(OVER),A
PR64C:	ld	a,(win_wc)
	ld	l,a
	LD	A,(XPOS)
	CP	l
	JR	C,GOODX
BADPARS:
	RST	8
	DEFB	19H	;Parameter error
;
GOODX:	ld	a,(win_hp)
	dec	a
	ld	l,a
	LD	A,(YPOS)
	CP	l
	JR	NC,BADPARS
	LD	A,E	;A=character
	CALL	OPC64	;Print character
	ld	a,(win_wc)
	ld	l,a
	LD	A,(XPOS)
	INC	A
	LD	(XPOS),A
	CP	l	;Auto CRLF?
	JR	NZ,NOCR1
	ld	(wrapped),a
	LD	A,(WRAP)	;Wrap text at EOL?
	OR	A
	JR	NZ,WRAP1
	LD	A,(XPOS)
	DEC	A
	LD	(XPOS),A
	RET
;
; Auto linewrap has taken place!
;
WRAP1:	LD	A,(YPOS)
	ld	l,a
	ld	a,(win_ch)
	add	a,l
	LD	(YPOS),A
DOCR:	XOR	A
	LD	(XPOS),A
NOCR1:	ld	a,(win_ch)
	ld	l,a
	ld	a,(win_hp)
	sub	l
	ld	l,a
	LD	A,(YPOS)
	CP	l
	RET	C
	ret	z
	push	hl
	CALL	SCROLL
	pop	hl
	LD	A,l
	LD	(YPOS),A
	XOR	A
	LD	(XPOS),A
	RET
;
SCRL_N:	CALL	PUSHA
	PUSH	AF
	LD	A,7
	CALL	SELMEM
	POP	AF
	CALL	RFCD5
	LD	A,6
	CALL	SELMEM
	JP	POPA
;
ZAPLN:	PUSH	BC	;Clear a screen line (line passed in B)
	ld	a,(win_ch)
	ld	c,a
	xor	a
zapl3:	ADD	a,b
	dec	c
	jr	nz,zapl3
	LD	(SCRATCH),A
	ld	a,(win_ch)
	LD	B,a
ZAPL1:	PUSH	BC
	LD	A,(SCRATCH)
	CALL	YCOORD
	LD	B,32
ZAPL2:	LD	(HL),0
	INC	HL
	DJNZ	ZAPL2
	LD	A,(SCRATCH)
	INC	A
	LD	(SCRATCH),A
	POP	BC
	DJNZ	ZAPL1
	POP	BC
	RET
;
SCROLL:	XOR	A	;Scroll from line 0
RFCD5:	PUSH	AF
	ld	b,a
	ld	a,(win_ch)
	ld	c,a
	xor	a
rfcdx:	add	a,b
	dec	c
	jr	nz,rfcdx
	LD	(SCRATCH),A
	ld	a,(win_ch)
	LD	B,a
RFCDF:	PUSH	BC
	LD	A,(SCRATCH)
	CALL	YCOORD
	EX	DE,HL
	LD	A,(SCRATCH)
	ld	c,a
	ld	a,(win_ch)
	ADD	A,c
	CALL	YCOORD
	LD	BC,32
	LDIR
	LD	A,(SCRATCH)
	INC	A
	LD	(SCRATCH),A
	POP	BC
	DJNZ	RFCDF	;$-1F
	ld	a,(win_hc)
	dec	a
	ld	c,a
	POP	AF
	INC	A
	CP	c
	JR	NZ,RFCD5 ;$-2F
	ld	a,(win_ch)
	ld	b,a
	LD	A,(win_hp)
RFD08:	dec	a
	PUSH	AF
	push	bc
	CALL	YCOORD
	PUSH	HL
	POP	DE
	INC	DE
	LD	BC,31
	LD	(HL),0
	LDIR
	pop	bc
	POP	AF
	djnz	RFD08
	RET

OPC64:	LD	(SCRATCH),A
	ld	a,(win_ftype)
	and	a
	ld	a,(SCRATCH)
	jp	z,OPC_64

; The standard 32-character routine

OPC_32:	cp	128
	jr	nc,opc32trans	; translate chars > 127
	cp	96		; should be `, but Speccy has pound
	jr	nz,opc32np
	ld	a,39		; replace with '
	jr	opc32ok
opc32np:cp	32
	jr	nc,opc32ok
useqm:	ld	a,'?'		; all chars 0-31 undefined
opc32ok:
	ld	l,a
opc32ok2:
	ld	h,0
	add	hl,hl
	add	hl,hl
	add	hl,hl
	ld	bc,(CHARS)
	ld	a,(cfont)
	cp	3
	jr	nz,opc32_2
	ld	bc,font32_3
opc32_2:add	hl,bc
	ex	de,hl		; DE=character address
	ld	a,(ypos)
	call	ycoord		; HL=screen address (top line, char 0)
	ld	a,(xpos)
	add	a,l
	ld	l,a		; HL=screen address
	ld	b,8		; 8 character lines to do
	ld	a,(over)
	and	a
	jr	z,opc32n	; move on if not OVER-printing
opc32o:	ld	a,(hvf)
	and	a
	jr	z,opc32on	; move on if not reverse
opc32or:ld	a,(de)
	cpl
	xor	(hl)
	ld	(hl),a
	inc	de
	inc	h
	djnz	opc32or
	ret
opc32on:ld	a,(de)
	xor	(hl)
	ld	(hl),a
	inc	de
	inc	h
	djnz	opc32on
	ret
opc32n:	ld	a,(hvf)
	and	a
	jr	z,opc32nn	; move on if not reverse
opc32nr:ld	a,(de)
	cpl
	ld	(hl),a
	inc	de
	inc	h
	djnz	opc32nr
	ret
opc32nn:ld	a,(de)
	ld	(hl),a
	inc	de
	inc	h
	djnz	opc32nn
	ret

; 32-character extra character translations
; Non-standard ASCII characters are translated, so any standard
; Spectrum font may be used.

opc32trans:
	sub	155
	jr	c,useqm		; 127-154 undefined
	cp	224-155
	jr	nc,useqm	; 224-255 undefined
	ld	l,a
	ld	h,0
	add	hl,hl
	ld	bc,stdtrans+1
	add	hl,bc		; HL=translation address
	ld	a,(hl)		; optional 2nd char
	dec	hl
	ld	l,(hl)		; 1st char
	and	a
	jr	z,opc32ok2	; only 1 char
	push	af		; save 2nd char
	ld	e,l
	call	PR64
	pop	af
	jr	opc32ok

; Standard translation table. This is only really valid for v1-4, as
; v5+ may optionally specify a custom unicode translation table; however,
; this is not considered here.

stdtrans:
	defb	'ae'	; diaeresis [155-160]
	defb	'oe'
	defb	'ue'
	defb	'Ae'
	defb	'Oe'
	defb	'Ue'
	defb	'ss'	; sz-ligature [161]
	defb	'>>'	; quotations [162-163]
	defb	'<<'
	defb	'e',0	; diaeresis [164-168]
	defb	'i',0
	defb	'y',0
	defb	'E',0
	defb	'I',0
	defb	'a',0	; acute [169-180]
	defb	'e',0
	defb	'i',0
	defb	'o',0
	defb	'u',0
	defb	'y',0
	defb	'A',0
	defb	'E',0
	defb	'I',0
	defb	'O',0
	defb	'U',0
	defb	'Y',0
	defb	'a',0	; grave [181-190]
	defb	'e',0
	defb	'i',0
	defb	'o',0
	defb	'u',0
	defb	'A',0
	defb	'E',0
	defb	'I',0
	defb	'O',0
	defb	'U',0
	defb	'a',0	; circumflex [191-200]
	defb	'e',0
	defb	'i',0
	defb	'o',0
	defb	'u',0
	defb	'A',0
	defb	'E',0
	defb	'I',0
	defb	'O',0
	defb	'U',0
	defb	'a',0	; ring [201-202]
	defb	'A',0
	defb	'o',0	; slash [203-204]
	defb	'O',0
	defb	'a',0	; tilde [205-210]
	defb	'n',0
	defb	'o',0
	defb	'A',0
	defb	'N',0
	defb	'O',0
	defb	'ae'	; ligatures [211-212]
	defb	'AE'
	defb	'c',0	; cedilla [213-214]
	defb	'C',0
	defb	'th'	; Icelandic [215-218]
	defb	'th'
	defb	'Th'
	defb	'Th'
	defb	96,0	; Pound [219]
	defb	'oe'	; ligatures [220-221]
	defb	'OE'
	defb	'!',0	; inverted marks [222-223]
	defb	'?',0


; The 64-character routine
OPC_64:
	SRL	A
	LD	L,A
	LD	H,0
	ADD	HL,HL
	PUSH	HL
	POP	BC
	ADD	HL,HL
	ADD	HL,BC
	LD	BC,FONT
	LD	A,(CFONT)
	CP	3
	JR	NZ,GFD78
	LD	BC,FONT3
GFD78:	ADD	HL,BC
	EX	DE,HL
	XOR	A	;Counter 0-5.
RFD79:	PUSH	AF
	LD	B,A
	LD	A,(YPOS)
	ADD	A,B
	CALL	YCOORD	;HL=address of screen line needed.
	LD	B,0
	LD	A,(XPOS)
	SRL	A	;Calculate X address.
	LD	C,A
	ADD	HL,BC
	LD	A,(SCRATCH)
	AND	1
	LD	B,A
	LD	A,(XPOS)
	AND	1
	XOR	B
	JR	NZ,RFDAB
	LD	A,(SCRATCH)
	AND	1
	JR	NZ,RFDA6
	LD	A,(DE)
	AND	0F0H
	JR	RFDC6	;L -> L

RFDA6:	LD	A,(DE)
	AND	0FH
	JR	RFDC6	;R -> R

RFDAB:	LD	A,(SCRATCH)
	AND	1
	JR	Z,RFDBD	;Character wants to go R -> L
	LD	A,(DE)
	SLA	A
	SLA	A
	SLA	A
	SLA	A
	JR	RFDC6

RFDBD:	LD	A,(DE)	;Character wants to go L -> R
	SRL	A
	SRL	A
	SRL	A
	SRL	A
RFDC6:	LD	B,A
	LD	A,(OVER)
	OR	A
	JR	Z,RFDD3	;If 'over', XOR the data in.
	LD	A,B
	XOR	(HL)
	LD	(HL),A
	JR	NXCHR

RFDD3:	LD	A,(XPOS)
	AND	1
	JR	NZ,RFDDF
	LD	A,(HL)	;Right-hand character
	AND	0FH
	JR	RFDE2

RFDDF:	LD	A,(HL)
	AND	0F0H	;Left-hand character
RFDE2:	OR	B
	LD	(HL),A
NXCHR:	INC	DE
	ld	a,(win_ch)
	ld	l,a
	POP	AF
	INC	A
	CP	l
	RET	Z
	JR	RFD79 ;$-70
;
YCOORD:	LD	B,A	;Convert Y coordinates to screen address
	AND	38H
	SLA	A	;/2
	SLA	A	;/4
	LD	L,A
	LD	A,B
	AND	7
	LD	H,A
	LD	A,B
	AND	0C0H
	SRL	A
	SRL	A
	SRL	A
	OR	H
	LD	H,A
	LD	BC,SCRADDR
	ADD	HL,BC
	RET
;
;This font descriptor record is not used by anything, but in case I ever write
;a font editor for 64-column fonts, this is where it should look :-)
;
	DEFB	'64FONT->'
	DEFB	1	;Descriptor type 1
	DEFB	20H	;First character defined
	DEFB	0E0H	;First character which is undefined
FONT	EQU	$-96

	include	zxfont64.zsm	;Programatically generated from FONT64.XBM
	DEFB	'64FONT->'
	DEFB	1, 20H, 0E0h
FONT3	EQU	$-96
	include	zxfnt643.zsm	;Generated from FONT64_3.XBM

; 32-character fonts
; NB: Only the character graphics font is included here. The current
;     standard Spectrum character set, as defined by CHARS, is used
;     for ASCII characters.

font32_3 equ	6A00h-256

