;    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.

SCRFONT	equ	05000h	;Where we keep a copy of the default screen font
PCWFONT	equ	0B800h	;Where the PCW keeps its current font

inited:	defb	0	;Screen initialised?

scrinit:
	ld	a,(inited)
	or	a
	scf
	ret	nz
	ld	a,1
	ld	(inited),a

	ld	c,6Dh		;Get the console mode (to disable ctrl-C)
	ld	de,0FFFFh
	call	FDOS
	ld	(conmode),hl
	ld	d,h
	ld	a,l
	and	0F1h		;Reset bits 1,2,3 of the word
	ld	e,a
	ld	c,6Dh
	call	FDOS

	ld	de,initstr
	ld	c,9
	call	FDOS
	xor	a
	call	ZXSTYL
	call	font_init
	call	disable_M
;;;	call	inthook		;<< v0.04 >> Disabled, it causes problems
	xor	a
	ld	(crtplus),a
	call	iscrt		;Returns Carry set if CRT+ is loaded
	ccf
	ret	c
	ld	a,1
	ld	(crtplus),a
	scf
	ret
;
deinit:
	call	pusha
	ld	a,(inited)
	or	a
	jp	z,popa
	xor	a
	ld	(inited),a
	ld	de,(conmode)
	ld	c,6Dh
	call	FDOS
	xor	a
	call	ZXSTYL
	ld	de,unitstr
	ld	c,9
	call	FDOS
	call	font_deinit
	call	cleanram	;Empty M:
	call	enable_M
;;;	call	intoff		;<< v0.04 >> disabled, it causes problems
	ld	c,0Dh
	call	FDOS
	jp	popa
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Set colours. The PCW doesn't have any colours - unless you're running ZXZVM
;under the JOYCE emulator, and why would you be doing that when there are 
;native interpreters for anything JOYCE runs on?
;
;Well, OK, so I'm using JOYCE as the test environment, but that's different,
;honest.
;
scol1:	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
crtplus:
	defb	0	;Set to 1 if CRT+ is present. CRT+ allows true bold
			;and italic text.
;
conmode:
	defw	0	;The console mode
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
cls1:	ld	de,clsstr
	call	printstr
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Escape sequences:
;
initstr:	defb	esc,'0',esc,'y',esc,'f',esc,'w',esc,'E',esc,'H$'
unitstr:	defb	esc,'1',esc,'y',esc,'e',esc,'v',esc,'E',esc,'H$'
clsstr:	defb	esc,'y',esc,'w',esc,'H'
clwinstr:	defb	esc,'E$'
winustr:	defb	esc,'X  '	;Select upper window
winuh:	defb	    ' y',0FFh
winlstr:	defb	esc,'X'		;Select lower window
winlt:	defb	    '  '
winlh:	defb	    ' y',0FFh
curpostr:	defb	esc,'Y'		;Set cursor position
curpos:	defb	    '  ',0FFh
alloff1: defb	esc,'q',esc,'-b',esc,'-i$'
alloff2: defb	esc,'q',esc,'u$'
revonstr:	 defb	esc,'p$'	;Reverse video on
italon1: defb	esc,'+i$'	;CRT+ italic on
italon2: defb	esc,'r$'	;Underline on
bldon1:	 defb	esc,'+b$'	;CRT+ bold on
bldon2:	 defb	'$'		;No normal bold on
curoff:	 defb	esc,'f$'	;Cursor off
curon:	 defb	esc,'e$'	;Cursor on
morestr1:	 defb	cr,lf,esc,'+g[More]',esc,'-g',8,8,8,8,8,8,'$'
morestr:	 defb	cr,lf,'[More]',8,8,8,8,8,8,'$'
morecstr:	 defb	      '      ',8,8,8,8,8,8,'$'
eralstr:	 defb	esc,'K$'
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Font bitmaps
;
;Accents not present in the standard font
;
thorns:
	include	joyfonta.zsm
thornend:
;
;The "picture drawing" characters
;
font3:
	include	joyfont3.zsm
font3e:
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Font selection code
;
;This code uses direct access to the memory banking hardware. This is NOT
;the preferred technique for memory access (USERF should be used instead,
;because it's portable to other computers such as the CPC and Spectrum+3)
;but since I'm tying myself to the PCW hardware in other ways, I might as
;well have the benefits of direct memory manipulation here.
;
zfont:	defb	1		;Start in font 1
;
font_init:
	di	
	ld	a,82h		;Memory bank containing the font
	out	(0F2h),a	;Bring the font in at 0B800h
	ld	hl,PCWFONT
	ld	de,SCRFONT
	ld	bc,800h
	ldir			;Take a copy of the screen font
	ld	hl,thorns	;Put in our "Thorn" characters as numbers
	ld	de,PCWFONT+400h	;80h-83h
	ld	bc,thornend-thorns
	ldir
	ld	a,86h		;TPA bank
	out	(0F2h),a
	ei
	ret
;
font_deinit:
	di	
	ld	a,82h		;Memory bank containing the font
	out	(0F2h),a	;Bring the font in at 0B800h
	ld	de,PCWFONT
	ld	hl,SCRFONT
	ld	bc,800h
	ldir			;Restore the original screen font
	ld	a,86h		;TPA bank
	out	(0F2h),a
	ei
	ret
;
sfont4:	ld	(zfont),a
	push	hl		;L = old font
				;Select normal Z-font 1 (or 4). 
	di			;Copy in characters 0-127.
	ld	a,82h		;Memory bank containing the font
	out	(0F2h),a	;Bring the font in at 0B800h
	ld	de,PCWFONT
	ld	hl,SCRFONT
	ld	bc,400h
	ldir			;Restore the original screen font
	ld	a,86h		;TPA bank
	out	(0F2h),a
	ei
	pop	hl
	ld	a,l
	scf
	ret

sfont3:	ld	(zfont),a
	push	hl		;Select Z-font 3. 
	di			;Copy in characters 0-127.
	ld	a,82h		;Memory bank containing the font
	out	(0F2h),a	;Bring the font in at 0B800h
	ld	de,PCWFONT
	ld	hl,font3
	ld	bc,font3e-font3
	ldir			;Restore the original screen font
	ld	a,86h		;TPA bank
	out	(0F2h),a
	ei
	pop	hl
	ld	a,l		;Old font
	scf
	ret
;
sfont1:	ld	hl,(zfont)	;L = old font
	cp	3
	jr	z,sfont3	;Graphics font
	cp	1
	jr	z,sfont4	;Normal font
	cp	4
	jr	z,sfont4	;Fixed font
	xor	a
	scf
	ret
;	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
eraw1:	cp	0FFh		;Erase screen?
	jr	z,erall
	cp	0FEh
	jp	z,erascr
	or	a
	jr	z,eratop
	cp	1
	jr	z,erawin
erawi:	ld	hl,badera
	xor	a
	ret
;
eratop:	ld	a,0FFh
	defb	1Eh		;LD E, - swallow the XOR A
erascr:	xor	a		;Clear all the screen
erawin:	call	setwin
	ld	de,clwinstr
	call	printstr
	ld	a,(cwin)
	call	setwin
	call	movcur
	scf
	ret
;
erall:	call	ZXCLS		;Clear screen and reset everything
	ld	a,(scrh)
	dec	a
	dec	a
	ld	(scrls),a
	xor	a
	ld	(lwtop),a
	ld	(lwx),a
	ld	(lwy),a
	ld	(uwx),a
	ld	(uwy),a
	ld	a,1
	ld	(cwin),a
	ld	a,(zver)
	cp	5
	jr	nc,erall1
	ld	a,(scrh)
	dec	a
	ld	(lwy),a
	call	movcur
erall1:	scf
	ret
;
movcur:	push	af	;Move the cursor to UWX or LWX as appropriate
	push	hl
	push	de
	ld	hl,(uwx)
	ld	a,(cwin)
	or	a
	jr	z,movcr1
	ld	hl,(lwx)
movcr1:	ld	a,h
	ld	h,l
	ld	l,a
	ld	de,2020h
	add	hl,de
	ld	(curpos),hl
	ld	de,curpostr
	call	printff
	pop	de
	pop	hl
	pop	af
	ret
;
setwin:	push	af	;Set window in A: 0 = screen 1 = bottom -1 = top
	cp	0ffh
	jr	z,setuw
	or	a
	jr	z,setscr
	ld	a,(lwtop)
	ld	b,a
	add	a,32
	ld	(winlt),a
	ld	a,(scrh)
	and	a
	sub	b
	add	a,31
	ld	(winlh),a
	push	de
	ld	de,winlstr
	call	printff
	pop	de
	pop	af
	ret
;
setuw:	ld	a,(lwtop)
	jr	setu1	
;
setscr:	ld	a,(scrh)
setu1:	add	a,31
	ld	(winuh),a
	push	de
	ld	de,winustr
	call	printff
	pop	de
	pop	af
	ret
;
printff:
	call	pusha	; Print 0FFh-terminated string. Used if 
	ex	de,hl	; the text might contain a '$' character
prff1:	ld	a,(hl)
	inc	hl
	cp	0ffh
	jp	z,popa
	push	hl
	ld	e,a
	ld	c,2
	call	FDOS
	pop	hl
	jr	prff1
;
printstr:	call	pusha
	ld	c,9
	call	FDOS
	jp	popa	
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Get X position in L, chars left in H, total screen width in A
;
getx1:	ld	hl,(uwx)
	ld	a,(cwin)
	or	a
	jr	z,getx2
	ld	hl,(lwx)
getx2:	ld	a,90
	sub	l
	ld	h,a
	ld	a,90
	scf
	ret
;
;Get Y position in L
;
gety1:	ld	hl,(uwx)
	ld	a,(cwin)
	or	a
	jr	z,gety2
	ld	hl,(lwx)
gety2:	ld	l,h
	ld	h,0
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Work out whether a word will fit on the line. Since the PCW uses a
;fixed-pitch font, we don't need to bother with what the text
;actually says, only with its length. B=no. of letters and C=no. of
;spaces. Return 0 to print everything, 1 to print letters only, 2
;to print carriage return and then everything.
;
bfit1:	call    ZXGETX  ;H = amount of space on the line
	ld	d,0	;D = value to return.
        ld      a,c
        add     a,b     ;A = total chars in line
        cp      h
	ld	a,d
        ret	c	;The whole lot will fit.
	scf
	ret	z	;The whole lot will fit but cause a wrap.
;
;See if the word will fit.
;
	inc	d
        ld      a,b
        cp      h
	ld	a,d
	ret	c	;Letters only will fit
	scf
	ret	z	;The letters will fit but cause a wrap.
	inc	a	;Nothing will fit, return 2.
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
wrapped:	
	defb	0
scrls:	defb	31	;Number of scrolls to [MORE] prompt
lwtop:	defb	0	;Top line of lower window
lwx:	defb	0	;Lower window X,Y
lwy:	defb	0
uwx:	defb	0	;Upper window X,Y
uwy:	defb	0
cwin:	defb	1	;1 = lower
;
badera:	defb	'Invalid call to erase_windo',0F7h	;'w'+80h
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;

zchr1:	cp	1
	jr	z,out1
	cp	2
	jr	z,ts_char	;Output to transcript
	scf
	ret
;
ts_char:
	ld	a,(printing)	;<< v1.00 rewritten
	or	a
	jr	z,tsend		;Don't if not printing
	ld	a,(cwin)
	or	a
	jr	z,tsend		;Don't print status line text
	ld	a,l	
	cp	0Dh
	jr	nz,ts_ch1
	ld	e,0Dh		;Append LF to CR
	ld	c,5
	call	FDOS
	ld	l,0Ah
ts_ch1:	ld	e,l		;Print it
	ld	c,5
	call	FDOS
tsend:	scf			;>> v1.00
	ret
;
out1:	ld	a,l	;Output to stream 1 (screen)
	cp	0dh
	jr	nz,zchr2
;
; << v1.11 Swallow a LF immediately after an automatic wrap. This should allow
; us to print right up to the edge of a page without vertical gaps appearing.
;
	ld	a,(wrapped)
	or	a
	jr	z,out1a
	xor	a
	ld	(wrapped),a
	scf
	ret
;
; >> v1.11
;
out1a:	ld	a,(cwin)
	or	a
	jr	z,ulf
	jr	llf

zchr2:	xor	a
	ld	(wrapped),a
	ld	a,(cwin)
	call	xlchar
	ld	e,l
	call	anych1
	ld	a,(cwin)
	or	a
	jr	z,stepcu
	ld	a,(lwx)
	inc	a
	ld	(lwx),a
	cp	90
	ret	c
	ld	a,1
	ld	(wrapped),a
llf:	xor	a
	ld	(lwx),a
	ld	a,(lwy)
	inc	a
	ld	(lwy),a
	push	af
	ld	a,(scrls)
	or	a
	call	nz,crlf
	call	z,more
	dec	a
	ld	(scrls),a
	ld	a,(scrh)
	ld	b,a
	pop	af	
	cp	b
	ret	c
	ld	a,(scrh)
	dec	a
	ld	(lwy),a
	scf
	ret
;
stepcu:	ld	a,(uwx)
	inc	a
	ld	(uwx),a
	cp	90
	ret	c
	ld	a,1
	ld	(wrapped),a
ulf:	xor	a
	ld	(uwx),a
	ld	a,(uwy)
	inc	a
	ld	(uwy),a
	call	movcur
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Split_window...
;
swnd1:	push	af
	ld	a,(lwtop)
	ld	h,a	;H = old LWTOP
	ld	a,(scrh)
	ld	l,a	;L = screen height
	pop	af
	ld	(lwtop),a
	ld	b,a
	call	res_more
	ld	a,(lwy)	;Ensure lower window y >= lwtop
	add	a,h	;A = current Y coordinate
	cp	b
	jr	c,swnd1z
	sub	b	;Make it relative to new window top
	jr	swnd1a
;
swnd1z:	xor	a
swnd1a:	ld	(lwy),a
	ld	a,(uwy)
	cp	b
	ret	c	;Ensure upper window y < lwtop
	ld	hl,0
	ld	(uwx),hl
	ld	a,(cwin)
	call	setwin
	call	movcur
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Set_window...
;
swnd2:	and	1
	xor	1	;set_window opcode uses 0 to mean lower window
	ld	(cwin),a
	call	setwin
	call	movcur
	scf
	ret	nz
	ld	hl,0
	ld	(uwx),hl
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Set_text_style
;
styl1:	and	7
	call	z,alloff
	bit	0,a
	call	nz,revon
	bit	1,a
	call	nz,bldon
	bit	2,a
	call	nz,italon
	scf
	ret
;
alloff:	ld	de,alloff1
	ld	hl,alloff2
	jr	crtdef
;
revon:	ld	de,revonstr
	call	printstr
	scf
	ret
;
bldon:	ld	de,bldon1
	ld	hl,bldon2
	jr	crtdef
;
italon:	ld	de,italon1
	ld	hl,italon2
crtdef:	push	af
	ld	a,(crtplus)
	or	a
	call	nz,printstr
	ex	de,hl	;<<v0.04>> If CRT+ is not present, print
	call	z,printstr
	ex	de,hl	;<<v0.04>> the alternative string
	pop	af
	scf
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;set_cursor_position
;
scur1:	xor	a
	ld	(wrapped),a
	ld	a,(scrh)
	ld	e,a
	bit	7,c		;Negative => set cursor on/off
	jr	nz,cursw
	dec	b
	dec	c		;0-based
	ld	a,c
	cp	90
	jr	c,scur1a
	ld	c,89
scur1a:	ld	a,(cwin)
	or	a
	jr	z,scur2
	ld	a,b
	cp	e
	jr	c,scur1b
	ld	a,e
	dec	a
scur1b:	ld	b,a
	ld	a,e	;Reset the scroll counter
	dec	a
	dec	a
	sub	b
	ld	(scrls),a
	ld	(lwx),bc
	call	movcur
	scf
	ret
;
scur2:	ld	a,b		; << v0.02  Don't bother to check if
	cp	e		;           this takes the cursor outside
	jr	c,scur2b	;           the upper window.
	ld	b,e
	dec	b
scur2b:	ld	(uwx),bc	; >> v0.02
	call	movcur
	scf
	ret
;
cursw:	cp	0ffh
	ld	de,curoff
	call	z,printstr
	ld	de,curon
	call	nz,printstr
	scf
	ret
;
curson:	push	de
	ld	de,curon
	call	printstr
	pop	de
	ret
;
cursoff:
	push	de
	ld	de,curoff
	call	printstr
	pop	de	
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
snd1:	ld	e,7	;Beep!
	ld	c,2
	call	FDOS
	scf
	ret
;
bleep:	call	pusha
	call	snd1
	jp	popa
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
xlchar:	ld	a,l
	cp	128
	ret	c
	sub	128
	push	hl
	push	bc
	ld	l,a
	ld	h,0
	ld	bc,xtab
	add	hl,bc
	ld	a,(hl)
	pop	bc
	pop	hl
	ld	l,a
	ret	;Translate character in L
;
xtab:	defb	080h,081h,082h,083h,084h,085h,086h,087h
	defb	088h,089h,08Ah,08Bh,08Ch,08Dh,08Eh,08Fh
	defb	090h,091h,092h,093h,094h,095h,096h,097h
	defb	098h,099h,09Ah,0F0h,0F3h,0F4h,0D0h,0D3h
	defb	0D4h,0BAh,0ACh,0ABh,0F1h,0F2h,0EFh,0D1h
	defb	0D2h,0E0h,0E1h,0E2h,0E3h,0E4h,84h, 0C0h
	defb	0C1h,0C2h,0C3h,0C4h,85h, 0EAh,0EBh,0ECh
	defb	0EDh,0EEh,0CAh,0CBh,0CCh,0CDh,0CEh,0E5h
	defb	0E6h,0E7h,0E8h,0E9h,0C5h,0C6h,0C7h,0C8h
	defb	0C9h,0F7h,0D7h,0F8h,0D8h,0FAh,0F9h,0FBh
	defb	0DAh,0D9h,0DBh,0F6h,0D6h,0F5h,0D5h,080h
	defb	082h,081h,083h,0A3h,087h,086h,0AFh,0AEh
	defb	0E0h,0E1h,0E2h,0E3h,0E4h,0E5h,0E6h,0E7h
	defb	0E8h,0E9h,0EAh,0EBh,0ECh,0EDh,0EEh,0EFh
	defb	0F0h,0F1h,0F2h,0F3h,0F4h,0F5h,0F6h,0F7h
	defb	0F8h,0F9h,0FAh,0FBh,0FCh,0FDh,0FEh,0FFh
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
res_more:
	push	hl
	ld	a,(scrh)
	dec	a
	ld	hl,lwtop
	sub	(hl)		;A = no. of scrolls to next [MORE]
	dec	a
	ld	(scrls),a
	pop	hl
	inc	a
	ret
;
crlf:	call	pusha
	ld	de,crlfstr
	call	printstr
	jp	popa
;
more:	push	hl
	push	de
	push	bc
	ld	a,(crtplus)
	or	a
	ld	de,morestr
	call	z,printstr
	ld	de,morestr1
	call	nz,printstr
	ld	c,6
	ld	e,0FDh
	call	FDOS
	ld	de,morecstr
	call	printstr
	pop	bc
	pop	de
	pop	hl
	call	res_more
	ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Print any character as a character (not as an escape code)
;
anychar:
	call	pusha
	ld	l,e
	call	xlchar
	ld	e,l
	call	anych1
	jp	popa
;
anych1:	ld	a,e
	cp	20h
	jr	nc,opc1
	push	de
	ld	e,1Bh
	ld	c,2
	call	FDOS
	pop	de
opc1:	ld	c,2
	jp	FDOS	;Print character
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Erase to end of line
;
eral1:	call	movcur
	ld	de,eralstr
	ld	c,9
	call	FDOS
	scf
	ret