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

; 2019-05-17, Garry Lancaster: New file, based on zxio.zsm


; ***************************************************************************
; * ZX Spectrum Next I/O routines.                                          *
; ***************************************************************************


; ***************************************************************************
; * Definitions                                                             *
; ***************************************************************************


; ***************************************************************************
; * Data                                                                    *
; ***************************************************************************

cfont:          defb    0
zver:           defb    0       ; Z-machine version no.

; Screen settings for a v5 game
;
; << 1.11: Do not specify pixel sizes; they upset Beyond Zork, because
;   it tries to position text using pixel coordinates.
;
scrset5:
; NOTE: These first 4 items are initialised by init80
win_hc:         defb    0               ; window height in chars
win_wc:         defb    0               ; window width in chars
win_wu:         defb    0,0             ; window width in units
win_hu:         defb    0,0             ; window height in units
win_cwu:        defb    1               ; character width in units
win_chu:        defb    1               ; character height in units
scrls:          defb    1               ; 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


; ***************************************************************************
; * Restart game                                                            *
; ***************************************************************************

NXRST:
        ld      hl,10h          ; Flags 2 is preserved through a restart
        call    ZXPK64
        ld      b,a
        inc     hl
        call    ZXPK64
        ld      c,a
        push    bc
        ld      de,rest$
        call    print1
        call    st_reload
        pop     bc
        ret     nc
        ld      hl,10h
        ld      a,b             ; Restore Flags 2
        call    ZXPOKE
        inc     hl
        ld      a,c
        call    ZXPOKE
        call    erall
        ld      a,1
        ld      (cfont),a
        scf
        ret


; ***************************************************************************
; * Check if buffer text will fit on a line                                 *
; ***************************************************************************
; Work out whether a word will fit on the line. Since we use 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.

NXBFIT:
        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 will cause a wrap.

;See if the word will fit.

        inc     d       ;D is now 1
        ld      a,b
        cp      h
        ld      a,d
        ret     c       ;Letters only will fit
        scf
        ret     z       ;The whole lot will fit, but will cause a wrap.
        inc     a       ;Nothing will fit, return 2.
        scf
        ret


; ***************************************************************************
; * Get cursor position info                                                *
; ***************************************************************************

; Get X position in L, chars left in H, total screen width in A
NXGETX:
        ld      hl,(uwx)        ;<< v0.04 use UWX/LWX, not XPOS.
        ld      a,(cwin)
        or      a
        jr      z,getx2
        ld      hl,(lwx)
getx2:  ld      a,(win_wc)      ;>> v0.04
        sub     l
        ld      h,a
        ld      a,(win_wc)
        scf
        ret

; Get Y position in L
NXGETY:
        ld      hl,(uwx)
        ld      a,(cwin)
        or      a
        jr      z,gety2
        ld      hl,(lwx)
gety2:  ld      l,h
        ld      h,0
        scf
        ret


; ***************************************************************************
; * Set font                                                                *
; ***************************************************************************
; Font 4 (fixed width) is aliased to font 1 (standard).
; Font 3 is supported as a separate font (character graphics).
; Font 2 (picture) doesn't need to be supported as it was never used.

NXSFNT:
        cp      1               ;Font is not valid
        jr      z,sfnt2
        cp      3
        jr      z,sfnt2
        cp      4
        jr      z,sfnt2
        xor     a
        ret

sfnt2:  ld      hl,(cfont)      ;Font is valid
        ld      (cfont),a
        ld      a,l
        ret


; ***************************************************************************
; * Set output stream                                                       *
; ***************************************************************************

NXSTRM:
        cp      2       ;Open a transcript
        jp      z,ts_open
        cp      0FEh    ;Close a transcript
        jp      z,ts_close
        scf
        ret


; ***************************************************************************
; * FDOS functions                                                          *
; ***************************************************************************
; A Spectrum clone of CP/M's BDOS functions dealing with console I/O
; These functions are mainly intended for diagnostic code

NXFDOS:
        ld      a,c
        cp      1
        jr      z,ichr1
        cp      6
        jr      z,dcio1
        cp      9
        jr      z,print1
        cp      2
        ld      a,e
        jr      z,opc1
        ld      a,c
        ld      de,badfun
        call    sphex2  ; Write function number into error message
        ld      hl,unimpl
        xor     a
        ret

ichr1:
        call    wait_key        ; get a keypress in A
opc1:   call    out1_a  ; 2. Output character
        scf
        ret
;
dcio1:  ld      a,e     ; 6. Direct console input/output
        cp      0FDh
        jr      c,opc1
        jr      z,ichr2 ; 6/FD: Input character, no echo
        cp      0FEh
        jr      z,pkbd1 ; 6/FE: Poll keyboard, return 1 if char waiting
        call    poll_key
        scf             ; 6/FF: Poll keyboard, return char if char waiting
        ret
;
pkbd1:
        call    poll_key
        scf
        ret     z
        ld      a,1
        ret

ichr2:
        call    wait_key        ; get a keypress in A
        scf
        ret
;
print1:                         ; 9. Print $-terminated string
        ld      a,(de)
        cp      '$'
        scf
        ret     z
        push    de
        cp      0Ah
        call    nz,out1_a
        pop     de
        inc     de
        jr      print1


; ***************************************************************************
; * Output bit7-terminated string at DE                                     *
; ***************************************************************************

print7:
        ex      de,hl
pri71:  ld      a,(hl)
        res     7,a             ; clear terminator bit
        push    hl
        call    out1_a
        pop     hl
        bit     7,(hl)          ; check terminator
        ret     nz
        inc     hl
        jr      pri71


; ***************************************************************************
; * Initialise the header                                                   *
; ***************************************************************************

NXIHDR:
        call    headerin
        ld      a,(HDRADDR+0)   ;Z-machine version
        ld      (zver),a
        ld      de,zvbuf
        ld      l,a
        ld      h,0             ;Create the "invalid version" error
        call    spdec3
        ex      de,hl
        dec     hl
        set     7,(hl)          ; terminate message
        ld      hl,zvbad
        ld      a,(zver)
        cp      3               ;<< v0.04 allow v3 games
        jr      z,okver         ;<< v0.04
        cp      4               ;<< v1.10 allow v4 games
        jr      z,okver         ;>> v1.10
        cp      8
        jr      z,okver
        cp      5
        jr      nz,ihdr_bad
;
;Version is acceptable
;
;nb: the Z-machine is big-endian, but the Spectrum is little-endian. So
;   the LSB of a word will be in H.
;
okver:  cp      4               ; v3 flags or v4 flags?
        ld      hl,(HDRADDR+1)  ; Flags 1
        ld      a,l
        jr      nc,v4flag
        and     %10101111       ; Reset bits: 6 (default font variable width?)
                                ;             4 (status line not available?)
        or      %00100000       ; Set bits:   5 (upper window available?)
                                ; Leave bits unchanged:
                                ;             7 (unused)
                                ;             3 (run in censored mode?)
                                ;             2 (always set)
                                ;             1 (status line type)
                                ;             0 (unused)
        jr      cflag

v4flag:
        and     %11011100       ; Reset bits: 5 (sound effects available?)
                                ;             1 (picture display available?)
                                ;             0 (colours available?)
        or      %10011100       ; Set bits:   7 (input time-out available?)
                                ;             4 (fixed-width available?)
                                ;             3 (emphasis available?)
                                ;             2 (bold available?)
                                ; Leave bits unchanged:
                                ;             6 (unused)
cflag:  ld      l,a
        ld      (HDRADDR+1),hl
        ld      hl,(HDRADDR+10h); Flags 2
        ld      a,h
        and     %00000111       ; Reset bits: 7 (use sound effects?)
                                ;             6 (use colours?)
                                ;             5 (use mouse?)
                                ;             4 (use UNDO?)
                                ;             3 (use pictures?)
                                ; Leave bits unchanged:
                                ;             2 (v6 RAM: must redraw status?)
                                ;             1 (RAM: force fixed-width)
                                ;             0 (RAM: turn on transcript)
        ld      h,a
        res     0,l             ; Reset bits: 8 (use menus?)
                                ; Leave other bits unchanged (all unused)
        ld      (HDRADDR+10h),hl
        ld      hl,scrset5
        ld      de,HDRADDR+20h
        ld      bc,8
        ldir                    ; Copy in screen definitions
        call    get_ibm_defaults
        ld      a,c
        ld      (HDRADDR+2Ch),a ; store default colours
        ld      a,b
        ld      (HDRADDR+2Dh),a
        scf
        ret

ihdr_bad:
        and     a
        ret


; ***************************************************************************
; * Get random number                                                       *
; ***************************************************************************

NXRNDI:
        ld      de,(frames)
        ret


; ***************************************************************************
; * Erase window                                                            *
; ***************************************************************************

NXERAW:
        cp      $ff                     ; Erase screen and remove split
        jr      z,erall
        cp      $fe                     ; erase screen only
        jr      z,erall1
        or      a
        jr      z,erabot                ; clear lower window
        dec     a
        jr      z,eratop                ; clear upper window
erawi:  ld      hl,badera
        xor     a
        ret

eratop:
        ld      hl,windirty
        set     0,(hl)                  ; mark upper window as dirty
        ld      a,(lwtop)
        ld      c,a
        ld      b,0
        jr      erablk

erabot:
        ld      hl,windirty
        set     1,(hl)                  ; mark lower window as dirty
        ld      a,(win_hc)
        ld      c,a
        ld      a,(lwtop)
        ld      b,a
        jr      erablk

erall:
        ld      a,%11
        ld      (windirty),a            ; mark both windows as dirty
        ld      a,(win_hc)
        dec     a
        ld      (scrls),a
        xor     a
        ld      (lwtop),a
        ld      (lwx),a
        ld      (lwy),a
        ld      (uwx),a
        ld      (uwy),a
        ld      (x_pos),a
        ld      (y_pos),a
        ld      a,1
        ld      (cwin),a
        ld      a,(zver)
        cp      5
        jr      nc,erall1
        ld      a,(win_hc)
        dec     a
        ld      (lwy),a
erall1:
        jp      NXCLS

erablk:
        push    bc
        call    zapln
        pop     bc
        inc     b
        ld      a,b
        cp      c
        jr      c,erablk
        scf
        ret


; ***************************************************************************
; * Output ZSCII character                                                  *
; ***************************************************************************

NXZCHR:
        dec     a                       ; 1=screen
        jr      z,out1_l
        dec     a                       ; 2=transcript
        jp      z,ts_char               ; Output to transcript
        scf
        ret

out1_l:
        ld      a,l                     ; Output to stream 1 (screen)
out1_a:
        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,out1_lf
        xor     a
        ld      (wrapped),a
        scf
        ret
;
; >> v1.11
;
out1_lf:
        ld      a,$0d                   ; CR
        call    zchr2
        ld      a,$0a                   ; LF
zchr2:
        ld      c,a
        xor     a
        ld      (wrapped),a
        ld      (linefed),a
        ld      a,(cwin)
        or      a
        jr      z,pchru                 ; on if upper window
        ld      de,(lwx)
        call    prinat
        ld      a,c
        call    opchar                  ; output char
        ld      hl,windirty
        set     1,(hl)                  ; mark lower window as dirty
        ld      hl,(x_pos)
        ld      (lwx),hl                ; store updated position for lower
        ld      a,(linefed)
        and     a
        ret     z                       ; exit unless a LF occurred
        xor     a
        ld      (linefed),a
        ld      a,(scrls)
        dec     a
        ld      (scrls),a               ; update lines to next "MORE"
        call    m,more                  ; do MORE if needed
        ld      a,(win_hc)
        ld      l,a                     ; L=main window height
        ld      a,(lwy)
        cp      l
        ret     c                       ; exit if still within window
        dec     a
        ld      (lwy),a                 ; else clamp to within window
        jp      scroll                  ; scroll up and exit

pchru:
        ld      de,(uwx)
        call    prinat
        ld      a,c
        call    opchar                  ; output char
        ld      hl,windirty
        set     0,(hl)                  ; mark upper window as dirty
        ld      hl,(x_pos)
        ld      (uwx),hl                ; store updated position for upper
        ret                             ; nothing else to do


; ***************************************************************************
; * Split window                                                            *
; ***************************************************************************

NXSWND:
        ld      (lwtop),a
        ld      b,a
        call    res_more
        ld      a,(lwy) ;Ensure lower window y >= lwtop
        cp      b
        jr      nc,swnd1a
        ld      a,b
        ld      (lwy),a
swnd1a: ld      a,(uwy)
        cp      b
        ret     c       ;Ensure upper window y < lwtop
        ld      hl,0
        ld      (uwx),hl
        scf
        ret


; ***************************************************************************
; * Set (use) window                                                        *
; ***************************************************************************

NXUWND:
        and      1
        xor     1       ;set_window opcode uses 0 to mean lower window
        ld      (cwin),a
        scf
        ret     nz
        ld      hl,0
        ld      (uwx),hl
        scf
        ret


; ***************************************************************************
; * Set cursor position                                                     *
; ***************************************************************************

NXSCUR:
        xor     a
        ld      (wrapped),a
        ld      hl,(win_hc)     ;H=width, L=height
        bit     7,c             ;Negative => set cursor on/off
        jr      nz,cursw
        dec     b
        dec     c               ;0-based
        ld      a,c
        cp      h
        jr      c,scur1a
        ld      c,h
        dec     c
scur1a: ld      a,(cwin)
        or      a
        jr      z,scur2
        ld      a,(lwtop)
        add     a,b
        cp      l
        jr      c,scur1b
        ld      a,l
        dec     a
scur1b: ld      b,a
        ld      a,l
        dec     a       ;Reset the scroll counter
        sub     b
        ld      (scrls),a
        ld      (lwx),bc
        ld      hl,windirty
        set     1,(hl)          ; mark lower window as dirty
        scf
        ret

scur2:  ld      a,b             ; << v0.02  Don't bother to check if
        cp      l               ;           this takes the cursor outside
        jr      c,scur2b        ;           the upper window.
        ld      b,l
        dec     b
scur2b: ld      (uwx),bc        ; >> v0.02
        ld      hl,windirty
        set     0,(hl)          ; mark upper window as dirty
        scf
        ret

cursw:  cp      0ffh
        call    z,curoff
        call    nz,curon
        scf
        ret


; ***************************************************************************
; * Sound effects                                                           *
; ***************************************************************************

NXSND:
        ld      a,7             ; Beep!
        call    opchar
        scf
        ret


; ***************************************************************************
; * Verify story file                                                       *
; ***************************************************************************
; Entry: DBC=story file length
; Exit:  HL=checksum

NXVRFY:
        xor     a               ;<< v0.02 - border colour cycling
        ld      (activea),a     ;>> v0.02
        push    de
        push    bc
        ld      b,FILENO
        ld      hl,40h
        ld      e,h             ; Set position just after header
        call    dodos
        defw    DOS_SETPOS
        ld      hl,0            ; initialise checksum
        pop     bc
        pop     de
vloop:  push    bc
        push    de
        push    hl
        ld      b,FILENO
        call    dodos
        defw    DOS_BYTE_READ
        ld      e,a
        ld      d,0             ; DE = byte just read
        pop     hl
        add     hl,de           ; accumulate into checksum
        pop     de
        pop     bc
        dec     bc
        call    activity
        ld      a,b
        or      c
        jr      nz,vloop
        dec     d
        ld      a,d
        cp      0ffh
        jr      nz,vloop
        ld      a,(tilemap_index_paper)
        out     (254),a         ; restore border colour to current
        scf
        ret

;
;<< v0.02 - cycle the border while verify is happening.
;
activity:                       ; Do something every 1k
        ld      a,c
        or      a
        ret     nz
        ld      a,b
        and     3
        ret     nz
        ld      a,(activea)
        out     (254),a
        inc     a
        cp      8
        jr      c,activ1
        xor     a
activ1: ld      (activea),a
        ret


; ***************************************************************************
; * Messages                                                                *
; ***************************************************************************

badera: defb    'Bad ERASE_WINDO'
        defb    0D7h
unimpl: defb    'No ZXFDOS function '
badfun: defb    '00'
        defb    0E8h    ; 'h'+80h

zvbad:  defb    'Unsupported story version '
zvbuf:  defb    '000'
rest$:  defb    cr,lf,'ZXZVM is restarting...',cr,lf,'$'

