Rev 1470 |
Blame |
Compare with Previous |
Last modification |
View Log
| Download
| RSS feed
;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 #5C78 ;50Hz counter
;Enter a filename
NAMEBUF
DEFS 20
FNBUF
DEFS 20
FNAME_
DEFB 13,10,"Filename> $"
GNAME
LD DE,FNAME_
LD C,9
CALL ZXFDOS
LD A,pg3
;Z-address 4000h
CALL selmem
LD HL,#C000
LD DE,NAMEBUF
LD BC,20
LDIR
;Backup Z-machine memory at #4000
LD HL,#C000
LD (HL),16
;Max. 16 characters in name
INC HL
LD (HL),0
;None provided
LD A,pg6
CALL selmem
LD DE,0
LD HL,#4000
;Filename buffer
;CALL LINEINP
LD A,pg3
CALL selmem
LD HL,tsavename;#C000
LD DE,FNBUF
LD BC,20
PUSH BC
PUSH HL
LDIR
POP DE
POP BC
;Length of buffer
LD HL,NAMEBUF
LD DE,#C000
LDIR
;Original contents of buffer
LD HL,FNBUF+1 ;len
LD E,(HL)
LD D,0
INC HL
ADD HL,DE
LD (HL),#FF
;FFh-terminated filename string
LD A,pg6
CALL selmem
LD HL,FNBUF+2
;jr $
LD A,E
;<< v1.01 A = length of input
OR A
SCF
; IF it's 0, then no name was input.
RET NZ
CCF ;>> v1.01
RET
tsavename
db 0
db tsavename_end-(tsavename+2)
db "zsave.!"
tsavename_end
MORE
;Rather than print [MORE], use a flashing cursor.
PUSH HL
;LD A,pg7
CALL selmemscr
LD HL,#DAFF
;Bottom right hand corner
LD A,(HL)
XOR #C0
;Bright and flashing!
LD (HL),A
MORE1
CALL CON6
OR A
JR Z,MORE1
LD A,(HL)
XOR #C0
;Remove the bright/flashing attribute
LD (HL),A
LD A,pg6
CALL selmem
POP HL
RES_MORE
PUSH HL
LD A,31
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
if 1
GET_KEY
cp key_del
ld c,'G'-64;RDEL ;^G
jr z,CON6_keyc
cp key_left
ld c,'H'-64;MOVLT ;^H
jr z,CON6_keyc
cp key_right
ld c,'I'-64;MOVRT ;^I
jr z,CON6_keyc
cp key_backspace
ld c,'L'-64;DELETE ;^L
jr z,CON6_keyc
cp key_enter
ld c,'M'-64;FINISH ;^M
jr z,CON6_keyc
cp key_end
ld c,'N'-64;LINEOL ;^N
jr z,CON6_keyc
ld c,a
CON6_keyc
ld a,c
or a
jr nz,CON6X2
else
XOR A ;L mode
LD IY,#5C3A
;IY required by subroutine
SET 3,(IY+1)
RES 5,(IY+2)
RES 3,(IY+2)
CALL #10A8 ;Get keyboard character
JR C,CON6X2
endif
;Input OK.
;Check specially for BREAK ;FIXME
LD BC,#FEFE
IN A,(C) ;Port FEFE
CPL
AND 1 ;CAPS
JR Z,CON6X2
LD B,#7F
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
;
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,pg7
CALL selmemscr
POP AF
CALL PR64
LD A,pg6
CALL selmem
JP POPA
;
ANYCHAR
CALL PUSHA
PUSH AF
;LD A,pg7
CALL selmemscr
POP AF
CALL PR64A
LD A,pg6
CALL selmem
JP POPA
;
PRINAT
DI
PUSH AF
;Move cursor, limiting it to within the screen
PUSH DE
LD A,E
CP 64
JR C,PRINA1
LD A,63
PRINA1
LD A,D ;Y
CP 32
JR C,PRINA2
LD A,31
PRINA2
ADD A,A ;*2
LD D,A
ADD A,A ;*4
ADD A,D ;*6
LD D,A
LD (XPOS),DE
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
;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)
push bc
push de
OS_GETTIMER ;dehl
ld a,l;e
pop de
pop bc
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
;to Z-machine control codes, B=code to do.
LD HL,XLTAB
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,8 ;Delete
DEFB 8,131 ;Left
DEFB 9,132 ;Right
DEFB 11,129 ;Up
DEFB 10,130 ;Down
DEFB 0 ;End of table
;
RCHAR1
push bc
push de
OS_GETTIMER ;dehl
ld a,l;e
pop de
pop bc
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
;jr $
;Line input into buffer at HL, timeout DE (0 for none)
CALL CURON
CALL INITIME
LD (ZIBUF),HL
LD HL,(lwx)
EX DE,HL
CALL PRINAT
EX DE,HL
LD A,(cwin)
OR A
JR NZ,LINEI1
LD HL,(uwx)
LINEI1
LD (INPPOS),HL
LD HL,(ZIBUF)
CALL peek64
LD (MAXL),A
INC HL
CALL peek64
LD (ACTL),A
LD (CURP),A
;IF the game has printed text already, step back past it & reset
;our X,Y.
LD B,A ;CURP
LD A,(INPPOS)
SUB B
LD (INPPOS),A
;Input is now at correct coordinates.
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 INPUT3 ;^J
DEFW INPUT3 ;^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 RCHAR1
;Get character with timer
INPUT2
CALL MOVXY
;Move cursor to the right place
CP " "
JP NC,INPUT3
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)
TIMED0
LD B,0 ;Input timed out!
JR CEND
FINISH
LD B,#0A
JR CEND
ABANDON
LD B,27
JR CEND
CEND
PUSH BC
;B = terminating character
LD HL,(INPPOS)
LD A,(cwin)
OR A
JR Z,CENDU
LD (lwx),HL
JR CENDC
CENDU
LD (uwx),HL
CENDC
;LD HL,#0D
;CALL ZXZCHR
LD A,(ACTL)
LD B,A
LD HL,(ZIBUF)
INC HL
CALL ZXPOKE
LCLP
INC HL ;Force it to lowercase
CALL peek64
PUSH AF
PUSH BC
PUSH DE
PUSH HL
LD L,A
LD H,0
CALL ts_char
POP HL
POP DE
POP BC
POP AF
CALL LCASE
CALL ZXPOKE
DJNZ LCLP
CALL CUROFF
PUSH AF
CALL RES_MORE
POP AF
POP BC
SCF
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
;B= no, to shift
LD B,A
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
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
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
LD DE,(INPPOS)
LD A,(CURP)
ADD A,E
LD E,A
;PRINT AT CURSOR POSITION.
CALL PRINAT
JP POPA
UPDLN
CALL PUSHA
LD DE,(INPPOS)
CALL PRINAT
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
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
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
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,pg7
CALL selmemscr
LD A,"_"
CALL OPC64
LD A,pg6
CALL selmem
JP POPA
DOLF
LD A,(YPOS)
ADD A,6
LD (YPOS),A
JR NOCR1
PR64
LD A,E
CP #0D
JR Z,DOCR
CP #0A
JR Z,DOLF
CP #07
JP Z,CHIME
CP #20
RET C
CP #E0
RET NC
PR64A
XOR A
LD (OVER),A
LD A,(HVF)
OR A
JR Z,PR64B
LD A,143
PUSH DE
CALL OPC64
POP DE
LD A,#FF
;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,#FF
LD (OVER),A
PR64C
LD A,(XPOS)
CP #40
JR C,GOODX
BADPARS
ld hl,0x0019
QUIT
;RST 8
;DEFB #19 ;Parameter error
GOODX
LD A,(YPOS)
CP 191
JR NC,BADPARS
LD A,E ;A=character
PUSH HL
PUSH BC
CALL OPC64 ;Print character
POP BC
POP HL
LD A,(XPOS)
INC A
LD (XPOS),A
CP #40 ;Auto CRLF?
JR NZ,NOCR1
LD A,(WRAP) ;Wrap text at EOL?
OR A
JR NZ,WRAP1
LD A,(XPOS)
DEC A
LD (XPOS),A
RET
WRAP1
LD A,(YPOS)
ADD A,6
LD (YPOS),A
DOCR
XOR A
LD (XPOS),A
NOCR1
LD A,(YPOS)
CP #BB
RET C
PUSH HL
PUSH BC
CALL SCROLL
POP BC
POP HL
LD A,#BA
LD (YPOS),A
XOR A
LD (XPOS),A
RET
SCRL_N
CALL PUSHA
PUSH AF
;LD A,pg7
CALL selmemscr
POP AF
CALL RFCD5
LD A,pg6
CALL selmem
JP POPA
ZAPLN
PUSH BC
;Clear a screen line (line passed in B)
LD A,B
ADD A,A
ADD A,A
ADD A,B
ADD A,B
LD (SCRATCH),A
LD B,6
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
DI ;???
XOR A ;Scroll from line 0
RFCD5
PUSH AF
ADD A,A
LD B,A
ADD A,A
ADD A,B
LD (SCRATCH),A
LD B,6
RFCDF
PUSH BC
LD A,(SCRATCH)
CALL YCOORD
EX DE,HL
LD A,(SCRATCH)
ADD A,6
CALL YCOORD
LD BC,32
LD A,(HL)
LD (DE),A
LDIR
LD A,(SCRATCH)
INC A
LD (SCRATCH),A
POP BC
DJNZ RFCDF ;$-1F
POP AF
INC A
CP #1F
JR NZ,RFCD5 ;$-2F
LD A,#BA
RFD08
PUSH AF
CALL YCOORD
;PUSH HL
;POP DE
LD D,H
LD E,L
INC DE
LD BC,31
LD (HL),0
LDIR
POP AF
INC A
CP #C0
JR NZ,RFD08 ;$-12
EI ;???
RET
OPC64
LD (SCRATCH),A
SRL A
LD L,A
LD H,0
ADD HL,HL
;PUSH HL
;POP BC
LD B,H
LD C,L
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 #F0
JR RFDC6 ;L -> L
RFDA6
LD A,(DE)
AND #0F
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 #0F
JR RFDE2
RFDDF
LD A,(HL)
AND #F0 ;Left-hand character
RFDE2
OR B
LD (HL),A
NXCHR
INC DE
POP AF
INC A
CP 6
RET Z
JR RFD79 ;$-70
YCOORD
LD B,A
;Convert Y coordinates to screen address
AND #38
SLA A ;/2
SLA A ;/4
LD L,A
LD A,B
AND 7
LD H,A
LD A,B
AND #C0
SRL A
SRL A
SRL A
OR H
LD H,A
LD BC,#C000
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 #20
;First character defined
DEFB #E0
;First character which is undefined
FONT EQU $-96
INCBIN "zxfont64.bin"
;Programatically generated from FONT64.XBM
DEFB "64FONT->"
DEFB 1,#20,#E0
FONT3 EQU $-96
INCBIN "zxfnt643.bin"
;Generated from FONT64_3.XBM