Blame |
Last modification |
View Log
| Download
| RSS feed
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;ADD termination bit to ENCBUF
;
eterm: push af
push bc
push de
push hl
ld hl,encbuf
ld a,(encptr) ;A = no. of characters in buffer.
or a
jr z,eterm2
dec a
eterm1: cp 3 ;Reset the "termination" bit on all
jr c,eterm2 ;characters except the last.
res 7,(hl)
inc hl
inc hl
sub 3
jr eterm1
;
eterm2: or a
jr z,eterm3
ld d,5 ;IF no. of characters remaining is not a
call eaddch ;multiple of 3, append character 5 until it is.
dec a
jr nz,eterm2
eterm3: set 7,(hl) ;SET the termination bit at the end.
;
;<< v0.02 Also set termination bits at encbuf+4 (z1-z3) or encbuf+6 (z4+)
;
ld hl,encbuf+2 ;Start of 2nd word
ld a,(zver)
cp 4
jr c,etermz
ld hl,encbuf+4 ;Start of 3rd word
jr etermz
;
etermz: set 7,(hl) ; >> v0.02
jp popd
;
;Append the character in D to ENCBUF
;
eaddch: push af
push bc
push de
push hl
ld a,d
and 1fh
ld d,a
;
;Append character D to encbuf
;
ld hl,encbuf
ld a,(encptr)
inc a
ld (encptr),a
dec a
encoff: cp 3
jr c,encmap
inc hl
inc hl
sub 3
jr encoff
;
;HL->correct part of the buffer.
;
encmap: or a
jr z,eadd0
dec a
jr z,eadd1
eadd2: inc hl
ld a,(hl)
and 0E0h
or d
ld (hl),a
jp popd
;
eadd0: ld a,(hl)
and 083h
rlc d
rlc d
or d
ld (hl),a
jp popd
;
eadd1: ld a,d
rrca
rrca
rrca ;A is now LLL000HH
ld e,a
and 3
ld d,a ;D is 000000HH
ld a,e
and 0E0h
ld e,a ;E is LLL00000
ld a,(hl)
and 07Ch
or d
ld (hl),a
inc hl
ld a,(hl)
and 1Fh
or e
ld (hl),a
jp popd
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Encode B ASCII chars at z-address HL to z-chars in encbuf. encbuf
; holds big-endian words.
;
encal: defb 0 ;Encoding alphabet
encptr: defb 0 ;No. of characters in ENCBUF
;
encode: push af
push bc
push de
push hl
xor a
ld (encal),a
ld (encptr),a
enchar: call peek64 ;A = ascii character
inc hl
push hl
;
;See if the character can be found in the alphabets al0, al1, al2
;
ld hl,al0+6
call findc
jr z,eadd5
ld hl,al1+6
call findc
jr z,eadd6
ld hl,al2+7
call finda2
jr z,eadd7
;
;ADD literal character...
;
ld d,5 ;Shift to alphabet 2
call eaddch
ld e,a ;E = ASCII character
ld d,6 ;ASCII escape
call eaddch
ld a,e ;A = HHHLLLLL
rlca
rlca
rlca
and 7
ld d,a
call eaddch
ld a,e
and 1fh
ld d,a
call eaddch
jr ence
;
eadd5: call eaddch
jr ence
;
eadd6: ld a,d
ld d,4
jp adds
;
eadd7: ld a,d
ld d,5
adds: call eaddch
ld d,a
call eaddch
ence: pop hl
djnz enchar
ence1: ld a,(encptr)
cp 9
call nc,eterm
jp nc,popd
ld d,5
call eaddch
jr ence1
;
finda2: push bc ;Special case for alphabet 2.
ld c,a
ld b,25
ld d,7
jr findcl
findc: push bc ;Returns Zero set if a character matches,
ld c,a ;D = character number
ld d,6
ld b,26
findcl: ld a,(hl)
cp c
jr z,findc2
inc d
inc hl
djnz findcl
xor a
inc a
ld a,c
findc2: pop bc
ret
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Output a z-char in A.
;
abbrev: defb 0 ;nonzero if expanding an abbreviation
dalpha: defb 0 ;Default alphabet number
alpha: defb 0 ;Alphabet number
shift: defb 0 ;Under shift conditions?
multi: defb 0 ;IN multi-char sequence?
multw: defw 0 ;The character to create in multi-char sequence.
;
op_zchar:
push af
push bc
push de
push hl
ld c,a
ld a,(multi)
or a
jr nz,nabb2 ;IF in a multi-byte char, don't try to
ld a,(abbrev) ;expand it as an abbreviation
or a
jp nz,opabb
ld a,(zver)
cp 3
jr c,nabb1
ld a,c
cp 1 ;1,2,3 are abbreviation characters
jr z,abbr
cp 2
jr z,abbr
cp 3
jr z,abbr
jr nabb2
;
nabb1: cp 2
jr c,nabb2
abbr: ld a,c
ld (abbrev),a
jp popd
;
nabb2: ld a,c ;A = packed char
call zchar2
jp popd
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Expand abbreviation string - A is 1st character, C is second
;
opabb: dec a ;<< v0.02 thoroughly rewritten
rlca
rlca
rlca
rlca
rlca ;A = (Z - 1) * 32
and 60h
add a,c ;A = (Z - 1) * 32 + X
ld c,a
ld b,0 ;BC = abbreviation no.
push bc
ld hl,18h
ld e,0
call ZXPKWI ;BC = base of abbreviation table
pop hl
xor a
ld (abbrev),a ;Reset "expand abbreviation" flag
add hl,hl
add hl,bc
ld e,0
call ZXPKWI ;BC = address of abbreviation string
ld h,b ; (word address, so in the bottom 128k)
ld l,c
ld a,h
add hl,hl ;Convert to byte address
bit 7,a
ld e,0
jr z,abblp
inc e ;High byte of address
abblp: call ZXPKWI
push de
push hl
push bc
ld a,b
rrca
rrca
and 01Fh
call op_zchar ;Recursive call.
ld a,b ;According to the Z-Spec, an abbreviation
rlca ;cannot contain other abbreviations.
rlca ;But since Curses (R12) tries to print
rlca ;abbreviations containing abbreviations,
and 18h ;we have to support it.
ld b,a ;Otherwise, these calls would be to zchar2.
ld a,c
rlca
rlca
rlca
and 7
or b
call op_zchar ;Recursive call.
ld a,c
and 1Fh
call op_zchar ;Recursive call.
pop bc
pop hl
pop de
bit 7,b
jr z,abblp
call rshift ;Swallow any "packing" shift characters
jp popd ;>> v0.02
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Output a Z-char, which we know isn't an abbreviation
;
zchar2: push hl
push bc
ld l,a
ld a,(multi)
or a
jp nz,xmult
ld a,l
cp 8
jp nc,zch0
ld h,0
add hl,hl
ld bc,chartbl
add hl,bc
ld e,(hl)
inc hl
ld d,(hl)
ex de,hl
jp (hl)
;
zch6: ld l,a
ld a,(alpha)
cp 2
jr nz,zch0a
ld a,1
ld (multi),a
jr zcret
zch0: ld l,a
zch0a: ld a,(alpha)
or a
ld de,al0
jr z,xlet
ld de,al1
dec a
jr z,xlet
ld de,al2
ld a,(zver)
cp 1
jr nz,xlet
ld de,al2a
xlet: ld h,0
add hl,de
ld l,(hl)
ld h,0
call ll_zchr
zcret: call rshift
zcr1: pop bc
pop hl
ret
;
rshift: push af ;Reset shifts
xor a
ld (shift),a
ld a,(dalpha)
ld (alpha),a
pop af
ret
;
;;;;;;;;;;;;;;;;;;;;;;
;
;Special handlers for the first 8 characters
;
chartbl:
defw zch0, zch1, zch2, zch3, zch4, zch5, zch6, zch0
;
zch1: ld hl,0dh ;Z-char 1 is a newline in v1
call ll_zchr
jp zcret
;
zch2: ld a,(dalpha) ;Z-char 2: shift to next alphabet
inc a
cp 3
jr c,zch2a
xor a
zch2a: ;ld (dalpha),a ;<< v0.02 >> this is a shift not a lock
ld (alpha),a
jp zcr1
;
zch3: ld a,(dalpha) ;Z-char 3: shift to prev alphabet
dec a
jr z,zch2a
ld a,2
jr zch2a
;
zch4: ld (shift),a ;Z-char 4: shift to alphabet 1 (3+)
ld a,(zver) ;or next alphabet (1,2)
cp 3
jr c,zch4a
ld a,1
ld (alpha),a
jp zcr1
;
zch4a: ld a,(alpha) ;Shift lock to next alphabet
inc a
cp 3
jr c,zch4b
xor a
zch4b: ld (alpha),a
ld (dalpha),a ;<< v0.02 >> this is the shift lock
jp zcr1
;
zch5: ld (shift),a ;Z-char 5: Shift to alphabet 2 (3+)
ld a,(zver) ;or previous alphabet (1,2)
cp 3
jr c,zch5a
ld a,2
ld (alpha),a
jp zcr1
;
zch5a: ld a,(alpha) ;Shift lock to previous alphabet
dec a
jr nc,zch4b
ld a,2
jr zch4b
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Alphabets
; ;0123456789abcdef0123456789abcdef
al0: defb ' *****abcdefghijklmnopqrstuvwxyz'
al1: defb ' *****ABCDEFGHIJKLMNOPQRSTUVWXYZ'
al2: defb ' ******'
defb 0dh
defb '0123456789.,!?_#'
defb 027h
defb '"/\-:()'
al2a: defb ' ******0123456789.,!?_#'
defb 027h
defb '"/\<-:()'
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;CREATE a multi-byte char. A = 1 or 2; L = character
;
xmult: dec a
jr nz,xmult2
ld h,0
add hl,hl
add hl,hl
add hl,hl
add hl,hl
add hl,hl
ld (multw),hl
ld a,2
ld (multi),a
jp zcret
;
xmult2: ld a,l
ld hl,(multw)
or l
ld l,a
call ll_zchr
xor a
ld (multi),a
jp zcret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;This code handles buffering and streamed output. Initialise...
;
inibuf: ld hl,buffer ;Initialise buffers and streams
ld (bufptr),hl
ld hl,0
ld (bufcc),hl
ld (bufcs),hl
ld a,1
ld (bufmde),a
ld hl,t3ptr
ld (t3ptr),hl
scf
xor a
ld (strm2),a
ld (strm3),a
ld (strm4),a
inc a
ld (strm1),a
ld hl,21h
call ZXPK64 ;Screen width
ld (buf_maxw),a
ld a,1
ld (cwin),a
ld hl,34h ;<< v0.04 support alphabet table
ld e,0
call ZXPKWD ;Get alphabet table address
ld a,b
or c
scf
ret z ;Default
ld h,b
ld l,c
ld de,al0+6
ld b,26 ;Values for alphabet 0
call mcpy
ld de,al1+6
ld b,26 ;For alphabet 1
call mcpy
ld de,al2+8
inc hl ;For alphabet 2 (skip nos. 6 & 7)
inc hl
ld b,24
call mcpy
scf
ret
;
mcpy: call ZXPK64
ld (de),a
inc hl
inc de
djnz mcpy
ret ;>> v0.04
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Write the buffer contents to screen
;
flush_buf:
push af
push bc
push de
push hl
;
;The buffer contains a word and some separators. See if the whole lot will fit.
;
ld hl,buffer ;<< v0.02
ld a,(bufcc)
ld b,a
ld a,(bufcs)
ld c,a
call ZXBFIT
cp 2
jr c,flushm ;Yes, it will.
ld hl,0Dh ;No. Write CR; then the whole lot.
call char_out ;Write character
bwrd1: xor a
flushm: or a ;A = 0: flush all. A = 1: print text, not separators
ld hl,(bufcc)
jr nz,flush0
ld de,(bufcs)
add hl,de
flush0: ld bc,buffer ;HL = count of chars to print
ld (bufptr),bc
ld bc,0
ld (bufcs),bc ;Reset buffer counters
ld (bufcc),bc
ld a,(bufmde)
or a
jr z,flush1
ld a,1
ld (bufmde),a
flush1: ld b,h ;BC = no. of bytes to print. See if it will fit
ld c,l ;within the margin
ld de,buffer
flushlp:
ld a,b
or c
jp z,popd
dec bc
ld a,(de)
ld l,a
inc de
ld a,(de)
ld h,a
inc de
push de
push bc
call char_out
pop bc
pop de
jr flushlp
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Passed a character in HL, decide where it goes.
;
ll_zchr:
ld a,(strm3) ;To stream 3?
or a
jp z,strm_gen
;
;Write to stream 3
;
push hl
ld hl,(t3ptr)
ld e,(hl)
inc hl
ld d,(hl) ;DE = address of table
ld h,d
ld l,e ;HL = address of table
call peek64
ld b,a
inc hl
call peek64
ld c,a ;BC = length of text so far
inc hl
add hl,bc
ex (sp),hl
ld a,l ;A = byte to write
ex (sp),hl
call ZXPOKE
inc bc
ex de,hl ;DE = address of table
ld a,b
call ZXPOKE
inc hl
ld a,c
call ZXPOKE
pop hl
scf
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Returns Carry set if character in L is a separator
;
issep: ld a,l
cp 21h
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Write character in HL to its streams, taking account of buffering
;
strm_gen:
ld a,(cwin) ;Top window?
or a
jp z,char_out
ld a,(bufmde) ;bufmde is: 1 when reading non-separators
or a ; 2 when reading separators
jp z,char_out ; 0 if not buffered
cp 2
jr nz,bufapp ;Append non-separator
call issep
call nc,flush_buf ;Next word; flush the buffer
bufapp: ld a,l
cp 0Dh ;Newline, flush the buffer.
jp z,bufnl
push hl ;Append character in HL to the buffer.
ex de,hl
ld hl,(bufptr)
ld (hl),e
inc hl
ld (hl),d ;Character buffered.
inc hl
ld (bufptr),hl
ex de,hl
call issep ;Was it a separator?
jr c,isep
ld hl,(bufcc)
inc hl
ld (bufcc),hl
jr ckover
;
isep: ld hl,(bufcs)
inc hl
ld (bufcs),hl
ld a,2
ld (bufmde),a
;
;Check for buffer overflow. This happens when:
;
ckover: pop hl ;The character.
;
;* There are <width> non-separators in the buffer.
;
call ZXGETX
ld l,a ;L = total screen width
ld a,(bufcc)
ld c,a
cp l ;Screen width
ccf
jp c,flush_buf
;
;* There are <width> separators in the buffer.
;
ld a,(bufcs)
ld b,a
cp l
ccf
jp c,flush_buf
;
;* There are <width> characters in the buffer in total.
; (doing it separately avoids overflow on very wide screens :-) )
;
ld a,b
add a,c
cp l
ret c
scf
jp flush_buf
;
bufnl: call flush_buf
ld hl,0dh
;
;Fall through to char_out
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Write a character in HL to its streams, with no buffering
;
char_out:
ld a,(strm1)
or a
push hl
ld a,1 ;Stream 1
call nz,ZXZCHR
pop hl
ld a,(strm2)
or a
ld a,2 ;Stream 2
scf ;<< v0.04 support printer abort. IF ZXZCHR
call nz,ZXZCHR ; returns carry clear, turn off
ret c ; printer output and reset the
xor a ; transcript bit.
ld (strm2),a
jp ts_off ;>> v0.04
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Select output stream.
;
ll_strm:
cp 3
jr z,sets3
cp 0FDh
jp z,usets3
bit 7,a
jr z,strmon
strmoff: push af ;Deactivate a stream
neg
dec a
ld hl,strm1
ld e,a
ld d,0
add hl,de
ld (hl),0
pop af
cp 0FEh ;Transcript
jp nz,ZXSTRM
call ZXSTRM
jr c,ts_off
ld a,1
ld (strm2),a
jp ts_err
;
strmon: push af ;Activate a stream
dec a
ld hl,strm1
ld e,a
ld d,0
add hl,de
ld (hl),1
pop af
cp 2
jp nz,ZXSTRM
call ZXSTRM
jr c,ts_on
xor a
ld (strm2),a
jp ts_err
ts_on: ld hl,11h
call ZXPK64
or 1
call ZXPOKE
scf
ret
;
ts_off: ld hl,11h
call ZXPK64
res 0,a
call ZXPOKE
scf
ret
;
sets3: ex de,hl ;DE = data address
ld a,(strm3)
cp 16
ld hl,s3err
ret nc
ld hl,(t3ptr) ;Open a stream 3.
dec hl
ld (hl),d
dec hl
ld (hl),e
ld (t3ptr),hl
ld a,(strm3)
inc a
ld (strm3),a
;
; << v0.04 Reset the "count" to 0 when the stream is selected
;
ex de,hl
xor a
call ZXPOKE
inc hl
xor a
call ZXPOKE
dec hl
ex de,hl
;
; >> v0.04
;
ld a,3
jp ZXSTRM
;
usets3: ld a,(strm3)
or a
scf ;Close a stream 3.
ret z
dec a
ld (strm3),a
ld hl,(t3ptr)
inc hl
inc hl
ld (t3ptr),hl
ld a,0FDh
jp ZXSTRM
;
;Numeric data.
;
cwin: defb 0 ;Current output window no.
bufmde: defb 0 ;Buffered?
buffer: defs 512 ;Wordwrap buffer
bufptr: defw 0 ;Pointer into same
bufcc: defw 0 ;No. of non-separator chars
bufcs: defw 0 ;No. of separator chars
table3: defs 32 ;Table stack for stream 3 to use
t3ptr: defw 0 ;Pointer into the table stack
strm1: defb 1 ;Stream 1 (screen) active?
strm2: defb 0 ;Stream 2 (transcript) active?
strm3: defb 0 ;Stream 3 (memory) active?
strm4: defb 0 ;Stream 4 (scripting) active?
buf_maxw:
defb 0 ;Screen width
s3err: defb 'O Stream 3 nestin' ;Stream 3 nested too deeply.
defb 0E7h ;'g'+80h
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; << v0.04 Validate an input character in A. Invalid characters become " "
;
valid_char:
cp 8
ret z
cp 13
ret z
cp 27
ret z
cp 32
jr c,valid_c2
cp 127
ret c
cp 129
jr c,valid_c2
cp 251
ret c
valid_c2:
ld a,' '
ret
;
; >> v0.04