859 lines
19 KiB
Plaintext
859 lines
19 KiB
Plaintext
; cf.z - creeping featurism (i.e. file operations in chat scripts)
|
|
; plus stuff to look after numbers in chat scripts
|
|
|
|
.incl "c:vars"
|
|
|
|
; stest - compare two strings !% = .s1.s2. `label jump if equal
|
|
; !% _ .s1.s2. `label jump if equal case insens.
|
|
; !% # .s1.s2. `label jump if not equal
|
|
|
|
.extern stest
|
|
stest: xor a
|
|
ld (casefl),a
|
|
call areabp
|
|
cp '#'
|
|
jr z,ckseq ; '#' for inequality
|
|
xor '='
|
|
jr z,ckseq ; '=' for equality
|
|
ld (casefl),a ; set case flag true
|
|
xor '_' ^ '=' ; '_' for equality case insensitive
|
|
ret nz
|
|
ckseq: or a ; z equality, nz inequality
|
|
push af ; save test value
|
|
call incbyp ; step up to strings
|
|
push hl
|
|
ld hl,work2
|
|
ld de,work2 + 1
|
|
ld bc,255
|
|
ld (hl),b
|
|
ldir ; clear space where strings will live
|
|
pop hl
|
|
or a
|
|
jr z,testzz
|
|
ld de,work2 + 1
|
|
ld b,2
|
|
seqslp: push bc
|
|
call scanst ; scan a string
|
|
inc de
|
|
pop bc
|
|
jr c,testzz ; exit if end of input
|
|
djnz seqslp ; otherwise loop till both read
|
|
inc hl ; skip trailing terminator
|
|
push hl ; save input pointer
|
|
ld hl,work2 + 1
|
|
ld de,work2 + 42 ; get the two strings
|
|
csl: ld b,0x7f
|
|
call cmptst ; check a characters
|
|
jr nz,phltz ; different, so finish test operation
|
|
ld a,(hl)
|
|
or a ; end of string?
|
|
jr z,phltz ; yes - finish test this way too
|
|
inc hl
|
|
inc de ; next chars .....
|
|
jr csl
|
|
|
|
; the !~ creeping featurism entry
|
|
|
|
.extern cf
|
|
cf:
|
|
call areabu ; what's wanted?
|
|
inc hl
|
|
cp '-'
|
|
jr z,cf_era ; '-' erases
|
|
cp '='
|
|
jr z,cf_ren
|
|
cp '+'
|
|
jr z,cf_copy ; '+' copies
|
|
cp 'Y'
|
|
jr z,cf_filq ; 'Y' file query: jump if file exists
|
|
xor 'N'
|
|
ret nz ; 'N' file query: jump if file doesn't exist
|
|
|
|
; fall into file query routine
|
|
|
|
; file query: check see if a file exists or not, and then jump to a label if
|
|
; it does.
|
|
|
|
cf_filq:
|
|
or a ; z for 'N', nz for 'Y'
|
|
push af
|
|
call scnfcb ; get a fcb
|
|
ld de,fcb
|
|
ld c,open ; try to open it - note that this will also
|
|
; work with wildcards
|
|
push hl
|
|
call usrbds ; open
|
|
inc a
|
|
phltz: pop hl
|
|
testzz: jr z,nofil ; not there - do test one way round
|
|
pop af ; 'Y' / 'N' result back
|
|
ret z ; 'N' and file exists => no skip
|
|
jr dskp1 ; 'Y' and file => skip
|
|
nofil: pop af ; no file .....
|
|
ret nz ; 'Y' and no file => no skip
|
|
dskp1: jp doskip ; go skip to the new line
|
|
|
|
; rename: du: is taken from the first name - a1:x = b7:y will rename a1:y
|
|
|
|
cf_ren: call gettwo
|
|
ret c ; exit on an error
|
|
ld hl,(auxfcb)
|
|
ld (fcb),hl ; xfer drive / user info
|
|
ld de,fcb
|
|
ld c,open
|
|
call usrbds ; open
|
|
inc a
|
|
ret z ; not there - exit
|
|
ld a,(fcb + 10)
|
|
add a,a
|
|
ret c ; if it's R/O stop now
|
|
ld de,auxfcb
|
|
ld c,open
|
|
call usrbds ; open
|
|
inc a
|
|
ret nz ; replacement _IS_ there - so exit
|
|
ld hl,auxfcb + 1
|
|
ld de,fcb + 17
|
|
ld bc,16
|
|
ldir ; shift stuff for rename
|
|
ld de,fcb
|
|
ld c,rename
|
|
jp usrbds ; go do it
|
|
|
|
; erase subroutine: no wildcards, single file erase
|
|
|
|
cf_era: call scnfcb
|
|
ret z ; no wildcards allowed
|
|
ld de,fcb
|
|
ld c,open
|
|
call usrbds ; open the file
|
|
ld a,(fcb + 10)
|
|
add a,a
|
|
ret c ; if it's R/O stop now
|
|
ld de,fcb
|
|
ld c,erase
|
|
jp usrbds ; otherwise erase it
|
|
|
|
; copy file routine
|
|
|
|
cf_copy:
|
|
call gettwo ; get two fcb's - one to fcb, one to auxfcb
|
|
ret c ; exit on an error
|
|
ld de,fcb
|
|
ld c,open
|
|
call usrbds ; open file1
|
|
inc a
|
|
ret z ; not there: exit
|
|
ld de,auxfcb
|
|
ld c,open
|
|
call usrbds ; open file2
|
|
inc a
|
|
ret nz ; is there: exit
|
|
ld de,auxfcb
|
|
ld c,create
|
|
call usrbds ; create file2
|
|
inc a
|
|
ret z ; create failed: exit
|
|
ld de,xbuff
|
|
ld c,setdma
|
|
call bdos ; set dma address
|
|
cplp: ld de,fcb
|
|
ld c,read
|
|
call usrbds ; read a sector
|
|
or a
|
|
jr nz,copied ; all done
|
|
ld de,auxfcb
|
|
ld c,write
|
|
call usrbds ; write it back
|
|
or a
|
|
jr z,cplp ; exit if write failed
|
|
copied: ld de,auxfcb
|
|
ld c,close
|
|
jp usrbds ; close output file
|
|
|
|
; parse two filenames, separated by an '=' sign
|
|
|
|
gettwo: call scnfcb ; get one
|
|
scf
|
|
ret z ; exit w/ carry if wildcards
|
|
call byp
|
|
cp '=' ; need an '='
|
|
scf
|
|
ret nz ; not there: exit
|
|
push hl
|
|
call xferax ; shift it to auxfcb
|
|
pop hl
|
|
inc hl
|
|
call scnfcb ; get a second
|
|
scf
|
|
ret z ; exit with carry on an error
|
|
or a
|
|
ret ; else clear carry for OK
|
|
|
|
; !@ evaluation subroutine
|
|
|
|
.extern eval
|
|
eval:
|
|
call areabu ; set to read the string
|
|
sub 'A' ; get the variable number
|
|
cp 26
|
|
jr nc,eerr0 ; not legal, exit now
|
|
call ivar
|
|
push de ; save it's address
|
|
inc hl
|
|
call scan ; scan a term
|
|
jr c,eerr1 ; no good - exit
|
|
push af ; save the value
|
|
call byp
|
|
cp '-'
|
|
jr z,opok
|
|
xor '+' ; check the operator
|
|
jr nz,eerr2
|
|
opok: push af ; save the operator (zero for '+', nz for '-')
|
|
inc hl
|
|
call scan ; get a second term
|
|
jr nc,s2ok ; all OK, go set the variable
|
|
pop de
|
|
eerr2: pop de
|
|
eerr1: pop de ; clean up the stack
|
|
eerr0: call ilprt
|
|
db 'Bad expression: \0'
|
|
call dim ; tell the user
|
|
ld hl,0x80
|
|
call prtslp
|
|
jp crlf ; and return
|
|
s2ok: ld l,a ; second term to l
|
|
pop bc ; operator to b
|
|
pop af ; first term to a
|
|
dec b
|
|
inc b ; zero => '+'
|
|
jr z,addem ; go do it
|
|
sub l
|
|
sub l ; setup for subtraction
|
|
addem: add a,l ; do the addition
|
|
pop hl ; restore variable address
|
|
ld (hl),a ; save result
|
|
ret
|
|
|
|
; !# test routine: compare variables with other variables or numbers
|
|
|
|
.extern test
|
|
test:
|
|
call areabu
|
|
sub 'A' ; get the variable
|
|
cp 26
|
|
jr nc,eerr0 ; exit on an error
|
|
call ivar
|
|
ld a,(de) ; get te value
|
|
push af ; save it
|
|
call incbyp ; get the operator
|
|
cp '<'
|
|
jr z,cmpok
|
|
cp '>'
|
|
jr z,cmpok
|
|
cp '#'
|
|
jr z,cmpok
|
|
xor '='
|
|
jr nz,eerr1 ; exit if it's no good
|
|
cmpok: push af ; save the operator
|
|
inc hl
|
|
call scan ; get the term
|
|
jr c,eerr2 ; something wrong, exit
|
|
ld e,a ; term to e
|
|
pop af ; restore the operator
|
|
or a
|
|
jr nz,nocpe ; z => '=' => equality
|
|
pop af
|
|
cp e ; test for equality
|
|
ret nz ; exit if no good
|
|
jr doskip ; go do the goto
|
|
|
|
; this is here for jr length reasons
|
|
|
|
cplt: pop af
|
|
cp e ; compare
|
|
skipnc: ret nc ; if it failed exit now
|
|
|
|
; jump to a line number
|
|
|
|
doskip: call scnnum ; get the number to go to
|
|
pop hl ; get return address back
|
|
pop de ; get the next line
|
|
dec a ; save it away (needs to be -1)
|
|
push af ; save the new line away
|
|
jp (hl) ; jump to return address
|
|
|
|
nocpe: cp '#' ; '#' => inequality
|
|
jr nz,nocpne
|
|
pop af ; restore variable value
|
|
cp e
|
|
ret z ; exit if test failed
|
|
jr doskip ; else do the goto
|
|
nocpne: cp '>'
|
|
jr nz,cplt ; '>' => greater than
|
|
pop af ; var to a
|
|
ld d,a ; and to d
|
|
ld a,e ; term to e
|
|
cp d ; and compare
|
|
jr skipnc ; go check the result
|
|
|
|
; initch - do odd bits and pieces of setup for chat operation
|
|
|
|
.extern initch
|
|
initch: ld a,1
|
|
ld (opentr),a ; clear number of open tries
|
|
|
|
.extern clrvar
|
|
clrvar:
|
|
ld a,'A'
|
|
ld (_check_),a
|
|
ld hl,vars ; nuke all variables to zero
|
|
ld de,vars + 1
|
|
ld bc,26 + 9 + 26 ; 26 numbers, plus 35 strings 0 - 9 & a - z
|
|
ld (hl),b ; start with a zero from b
|
|
ldir
|
|
dec b ; b comes out of the ldir w/ zero: dec to -1
|
|
ld (hl),b ; -1 byte to end strings
|
|
ld bc,512 - 9 - 27
|
|
ldir ; fill remaining space with -1's
|
|
ret
|
|
|
|
ivar: push hl ; save hl
|
|
ld l,a
|
|
ld h,0 ; offset in a to hl
|
|
ld de,vars
|
|
add hl,de ; index into table
|
|
ex de,hl ; swap to de
|
|
pop hl ; restore hl
|
|
ret
|
|
|
|
scan: call byp
|
|
or 0x20
|
|
sub 'a' ; was it a letter?
|
|
cp 26
|
|
jr nc,scnnum ; no, go see about a number
|
|
inc hl ; step over it
|
|
call ivar ; index into array
|
|
ld a,(de) ; get the value
|
|
ret ; and return - carry cleared by ivar
|
|
|
|
scnnum: ld e,0
|
|
call byp ; find the number
|
|
snlp: ld a,(hl) ; get char back
|
|
sub '0'
|
|
cp 10 ; number?
|
|
ccf
|
|
ret c ; return if not
|
|
ld d,a ; save in d
|
|
ld a,e
|
|
add a,a
|
|
add a,a
|
|
add a,e
|
|
add a,a ; a = e * 10
|
|
add a,d ; + d
|
|
ld e,a
|
|
inc hl
|
|
ld a,(hl) ; next letter
|
|
cp '-'
|
|
jr z,rete
|
|
cp '+'
|
|
jr z,rete ; + and - are legal delimiters
|
|
or ' '
|
|
xor ' ' ; so are ' ' and null
|
|
rete: ld a,e ; get value from e
|
|
jr nz,snlp
|
|
ret ; return, carry clear from compare
|
|
|
|
; mattog - handle !& toggles: 'm' & 'l' for matches, 'o' for modem output echo
|
|
|
|
.extern mattog
|
|
mattog: call areabu ; get command letter and upper case it
|
|
cp 'O'
|
|
ld c,op_bit ; 'O' - do output bit
|
|
jr z,dotog
|
|
cp 'L'
|
|
ld c,lf_bit ; 'L' - do looking for message bit
|
|
jr z,dotog
|
|
cp 'M' ; 'M' - do match bit
|
|
ret nz
|
|
ld c,mat_bit
|
|
dotog: call incbyp ; now look for a char to say what to do
|
|
ld hl,mode ; point hl at mode byte
|
|
or a
|
|
jr z,xorit ; nothing: toggle the bit
|
|
cp '0'
|
|
jr nz,clrit ; not '0': clear the bit to enable
|
|
ld a,(hl)
|
|
or c ; otherwise set it
|
|
jr smret
|
|
clrit: ld a,c
|
|
cpl ; toggle bit in c
|
|
and (hl) ; clear the bit in questin
|
|
jr smret
|
|
xorit: ld a,(hl)
|
|
xor c ; flip the bit
|
|
smret: ld (hl),a ; save and we're done
|
|
ret
|
|
|
|
; messag - process a !> printout
|
|
|
|
.extern messag
|
|
messag: call areabp ; point at first non-white
|
|
ld de,packet ; somewhere to put it
|
|
push de
|
|
ld bc,128 << 8 ; 128 chars max, and eoln is the delimiter
|
|
call parst ; crunch up the string
|
|
pop hl
|
|
jp prtslp ; and dump it out
|
|
|
|
; fileio - process !( r/w commands to read / write variables from the file
|
|
|
|
.extern fileio
|
|
fileio:
|
|
call areabu ; get R or W
|
|
cp 'R'
|
|
jr z,setrd
|
|
cp 'W'
|
|
ret nz
|
|
ld a,34 ; write random
|
|
db 0x11 ; ld de,XXXX - kills ld a below
|
|
setrd: ld a,33 ; read random
|
|
ld (hibit),a ; save it away for later
|
|
call incbyp
|
|
or 0x20
|
|
sub 'a'
|
|
cp 26
|
|
ret nc ; check valid string name
|
|
push af ; save string index
|
|
call incbyp
|
|
sub '0' ; number zero to nine for file record
|
|
|
|
ld hl,lbrs ; get /QTERM.LBR as a filename
|
|
push af
|
|
call scnfcb ; parse into 0x5b
|
|
pop af
|
|
ld hl,['T' << 8] + 'S'
|
|
ld (0x65),hl ; convert extent from LBR to STR
|
|
ld hl,(chtusr)
|
|
inc h
|
|
ld (0x5b),hl ; set drive / user
|
|
ld hl,0x68 ; point hl / de at nulls
|
|
ld de,0x69
|
|
ld bc,0xff - 0x68 ; clear to end of name
|
|
ldir
|
|
ld (0x7d),a ; save record number now
|
|
|
|
ld de,0x5b
|
|
ld c,15
|
|
call usrbds ; open it
|
|
pop de
|
|
inc a
|
|
ret z ; exit if no good
|
|
ld a,d
|
|
add a,9
|
|
call fparam ; point at string
|
|
ld de,0x80
|
|
push de ; save string address to read from
|
|
push hl ; save string address in table
|
|
push de ; and read address again
|
|
ld b,d
|
|
ld c,0x7f
|
|
ldir ; shift the string
|
|
pop de ; address to de
|
|
ld c,26
|
|
call bdos ; set dma
|
|
ld bc,(hibit) ; r/w BDOS opcode to c
|
|
ld de,0x5b
|
|
push de
|
|
call usrbds ; do the operation
|
|
pop de
|
|
ld c,16
|
|
call usrbds ; close the file
|
|
pop hl
|
|
jr repstr ; replace string in table
|
|
|
|
; sinput - handle two cases of input processing for !<
|
|
|
|
.extern sinput
|
|
sinput: call areabp ; get the command character
|
|
ld d,a ; command char to d
|
|
call incbyp ; get variable / string letter
|
|
call ucsa ; upper case it
|
|
sub 'A'
|
|
cp 26 ; is it valid?
|
|
ret nc ; nope
|
|
ld e,a ; letter code to e
|
|
ld a,d ; command char back from d
|
|
xor '-'
|
|
jr z,strin ; '-' for string input
|
|
xor '.' ^ '-'
|
|
ret nz ; '.' for hot key input
|
|
ld d,a ; make code in e fill de
|
|
push de ; save
|
|
call kbdin ; go get a character
|
|
pop de
|
|
ld hl,vars
|
|
add hl,de ; index into variables
|
|
ld (hl),a ; save the letter
|
|
ret
|
|
|
|
strin: ld d,e
|
|
push de
|
|
ld de,work2 ; point at input area
|
|
ld a,40
|
|
ld (de),a ; 40 chars maximum
|
|
ld c,10
|
|
call bdos ; go get them
|
|
call crlf ; throw a new line just for the hell of it
|
|
ld hl,work2 + 1
|
|
ld e,(hl) ; get the length
|
|
inc hl ; point at real text
|
|
pop af
|
|
push hl
|
|
ld d,0 ; extend length to de
|
|
add hl,de ; point at end of string
|
|
ld (hl),d ; add a null terminating byte
|
|
savstr: add a,9 ; get string index to a
|
|
call fparam ; point at string
|
|
repstr: call kilstr ; kill it
|
|
xor a
|
|
pop de
|
|
jp insstr ; and replace it
|
|
|
|
; now starts the middle of the "read string variable from modem" code - this
|
|
; is kinda cut to shreds for jr length reasons - we enter at the bottom and
|
|
; leave via savstr above
|
|
|
|
; the very end - we've read the string, now it's time to save it
|
|
|
|
gotit: inc de ; point back to start
|
|
push de ; save this point for later
|
|
ld h,d
|
|
ld l,e ; copy to hl
|
|
kcclp: ld a,(hl) ; get a char
|
|
and 0x7f ; nuke bit 7
|
|
ld (de),a ; save it
|
|
inc hl ; bump read ptr
|
|
or a
|
|
jr z,hsav ; exit on a null
|
|
cp ' '
|
|
jr c,kcclp ; ditch control chars
|
|
cp 0x7f
|
|
jr z,kcclp ; and deletes
|
|
inc de ; otherwise step up to allow saved character
|
|
jr kcclp
|
|
|
|
hsav: ld a,(hibit) ; get string number
|
|
jr savstr ; go and save it
|
|
|
|
; now the loop to find the start
|
|
|
|
stlp: call redsch ; check a character
|
|
jr z,wasec ; check for end character
|
|
ld a,(de) ; no - we'll want to save original char back
|
|
wasec: ld c,a ; save char to save
|
|
push hl
|
|
ld h,l ; load start char into h
|
|
call chksch ; did we find it?
|
|
pop hl
|
|
ld a,c
|
|
ld (de),a ; drop terminator in
|
|
jr z,gotit ; yes - go save it away
|
|
djnz stlp ; count chars
|
|
ret ; return when we run out chars
|
|
|
|
; ![ ^ a c1c2
|
|
;
|
|
; After ![ - and ![ : and normal lines have left text in w2 (a la stufw2),
|
|
; parse a string starting with c1 (but not including it), and ending with c2
|
|
; (again not including it) - save in string a. If c1 (or c2) are a null
|
|
; then the string becomes any whitespace delimited string: whitespace is
|
|
; taken as ' ', tab, cr, lf. Note also that all control characters are
|
|
; thrown away.
|
|
|
|
ipstr: call ucsahl
|
|
sub 'A' ; convert .....
|
|
cp 26 ; and test string index
|
|
ret nc
|
|
ld (hibit),a ; save it
|
|
call incbyp ; step up to delimiter chars
|
|
push hl
|
|
ld hl,work2 + 257
|
|
ld de,packet
|
|
ld bc,66
|
|
ldir
|
|
pop hl
|
|
ld de,pack + 1 ; save them in pack
|
|
ld b,2 ; two, null terminates
|
|
xor a
|
|
ld (de),a ; preload chars with two nulls
|
|
dec de
|
|
ld (de),a
|
|
call parst ; crunch up the string
|
|
ld hl,(pack) ; load delimiters from where parst put them
|
|
ld bc,64 << 8 ; max of 64 chars to look at / c == 0
|
|
ld de,packet + 65 ; point de at saved text
|
|
|
|
; now loop looking for the end
|
|
|
|
endlp: call redsch ; check a character
|
|
jr nz,noend ; check for end character
|
|
inc c ; flag we saw an end char
|
|
ld (de),a ; add a zero to terminate
|
|
jr cntend ; jump to count
|
|
noend: dec c
|
|
inc c
|
|
jr nz,stlp ; we've seen an end - go do it
|
|
cntend: djnz endlp ; count chars
|
|
ret ; return when we run out chars
|
|
|
|
; handle ![ multiple choice thingies from the modem
|
|
|
|
.extern multi
|
|
multi:
|
|
call areabp ; what's wanted?
|
|
ld c,a ; save the second character
|
|
call incbyp ; strip spaces
|
|
xor a
|
|
ld (casefl),a
|
|
ld a,c
|
|
cp '^'
|
|
jr z,ipstr
|
|
cp ':'
|
|
jp z,silnce
|
|
cp '-' ; '-' input ......
|
|
jr z,minput
|
|
xor '+' ; '+' for 8 bit string compare
|
|
jr z,str8b
|
|
cp '=' ^ '+' ; '=' for 7 bit
|
|
jr z,str7b
|
|
cp '_' ^ '+' ; '_' for 7 bit and case insensitive
|
|
ret nz ; oops - don't grok it.
|
|
ld (casefl),a ; set case flag
|
|
str7b: ld a,0x7f ; set 7 bit flag
|
|
db 0x06 ; makes the next byte the operand of a ld b,xx
|
|
str8b: dec a ; really ld a,0xff since a == 0:
|
|
; set all 8 bits
|
|
push af ; save comparison mask
|
|
ld de,packet ; somewhere to put match string
|
|
ld bc,[40 << 8] + ' ' ; 40 chars max, space is the delimiter
|
|
call parst ; crunch up the string
|
|
pop bc ; comparison mask back to b
|
|
ret c ; oops - bad string
|
|
push hl
|
|
ld hl,work2 + 322 ; point at stuff we read ..... (don't ask why
|
|
mclp: dec hl ; it's there :-)
|
|
ld a,(hl) ; end of string yet?
|
|
or a
|
|
pop de ; keep stack safe
|
|
ret z ; end of string: exit
|
|
push de ; save word back on stack
|
|
ld de,packet
|
|
call cmptst ; do we have a match??
|
|
jr nz,mclp ; skip if no good
|
|
push hl
|
|
cmplp: ld a,(de)
|
|
or a ; end of string we're searching for?
|
|
jr nz,mtchmo ; yes - we got a hit
|
|
pop hl
|
|
pop hl ; get string pointer back to hl
|
|
doskp1: jp doskip
|
|
mtchmo: call cmptst
|
|
jr nz,mchbad ; oops - didn't match, so exit now
|
|
inc hl
|
|
inc de
|
|
jr cmplp ; and back for more
|
|
mchbad: pop hl ; restore pointer
|
|
jr mclp ; and back for more
|
|
|
|
minput: call scnnum ; get a time
|
|
or a
|
|
jr nz,timok
|
|
ld a,15 ; none given, default to 15 seconds
|
|
timok: push af
|
|
push hl
|
|
ld hl,work2
|
|
ld de,work2 + 1
|
|
ld bc,512
|
|
ld (hl),c
|
|
ldir ; clear space where strings will live
|
|
pop hl
|
|
call byp
|
|
or a
|
|
jr z,nostr ; no strings, all done
|
|
ld de,work2 + 1
|
|
ld b,4
|
|
sslp: push bc
|
|
call scanst ; scan a string
|
|
inc de
|
|
pop bc
|
|
jr c,nostr ; exit if end of input
|
|
djnz sslp ; otherwise loop till 4 read
|
|
nostr: ld hl,work2 + 1
|
|
call finstr ; get address of it's end
|
|
ld (work2 + 240),hl ; and save it
|
|
ld hl,work2 + 42
|
|
call finstr
|
|
ld (work2 + 242),hl ; and for string 2
|
|
ld hl,work2 + 83
|
|
call finstr
|
|
ld (work2 + 244),hl ; and 3
|
|
ld hl,work2 + 124
|
|
call finstr
|
|
ld (work2 + 246),hl ; and 4
|
|
pop af ; get time back
|
|
ld c,a ; save it
|
|
second: dec c
|
|
ret z ; all out of time - exit
|
|
ld de,600
|
|
call setspd ; set the speed
|
|
qrtrms: ld b,96 ; hang loose a while
|
|
qmslp: djnz qmslp
|
|
push hl
|
|
push bc
|
|
call procch
|
|
jr c,nochar
|
|
call stufw2 ; save the char
|
|
inc de
|
|
ld hl,(work2 + 240)
|
|
call chkbak ; did we get string1
|
|
jr z,gotone ; exit if so
|
|
ld hl,(work2 + 242)
|
|
call chkbak ; string 2?
|
|
jr z,gotone ; exit if so
|
|
ld hl,(work2 + 244)
|
|
call chkbak ; string 3
|
|
jr z,gotone ; exit if so
|
|
ld hl,(work2 + 246)
|
|
call chkbak ; and lastly check string 4
|
|
jr z,gotone
|
|
nochar: pop bc
|
|
pop hl
|
|
dec hl ; count down second timer
|
|
ld a,h
|
|
or l
|
|
jr nz,qrtrms
|
|
jr second ; loop back
|
|
|
|
gotone: pop bc
|
|
pop hl
|
|
ret
|
|
|
|
.extern stufw2
|
|
stufw2: ld hl,work2 + 258
|
|
ld de,work2 + 257
|
|
ld bc,64
|
|
ldir
|
|
ld (de),a ; save the character
|
|
ret
|
|
|
|
.extern clerw2
|
|
clerw2: ld hl,work2 + 256
|
|
ld de,work2 + 257
|
|
ld bc,70
|
|
ld (hl),b
|
|
ldir
|
|
ret
|
|
|
|
finstr: ld a,(hl)
|
|
or a
|
|
ret z
|
|
inc hl
|
|
jr finstr
|
|
|
|
chkbak: dec hl
|
|
ld a,(hl)
|
|
inc hl
|
|
or a
|
|
jr nz,isastr
|
|
inc a
|
|
ret
|
|
isastr: push de
|
|
cklp: dec de
|
|
dec hl
|
|
ld a,(hl)
|
|
or a
|
|
jr z,pdret
|
|
ld a,(de)
|
|
xor (hl)
|
|
and 0x7f
|
|
jr z,cklp
|
|
pdret: pop de
|
|
ret
|
|
|
|
cmptst: ld a,(casefl)
|
|
or a ; case insensitive?
|
|
push af ; save z flag
|
|
ld a,(de)
|
|
jr z,noucs1 ; nope - use the character as is
|
|
and 0x7f
|
|
call ucsa ; force upper case
|
|
noucs1: ld c,a
|
|
pop af ; get z flag back for case insensitive
|
|
ld a,(hl)
|
|
jr z,noucs2
|
|
and 0x7f
|
|
call ucsa ; mask and force upper case
|
|
noucs2: xor c ; get in the rest of it
|
|
and b ; mask as necessary
|
|
ret
|
|
|
|
silnce: call scnnum ; get a time
|
|
or a
|
|
jr nz,stimok
|
|
ld a,15 ; none given, default to 15 seconds
|
|
stimok: call clerw2
|
|
ld b,a
|
|
inc b
|
|
setsil: ld c,b
|
|
xsecnd: dec c
|
|
ret z
|
|
push bc
|
|
ld de,600
|
|
call setspd ; set the speed
|
|
xrtrms: ld b,96 ; hang loose a while
|
|
xmslp: djnz xmslp
|
|
push hl
|
|
call procch
|
|
pop hl
|
|
jr c,xnchar
|
|
call stufw2
|
|
pop bc
|
|
jr setsil
|
|
xnchar: dec hl ; cound down second
|
|
ld a,h
|
|
or l
|
|
jr nz,xrtrms
|
|
pop bc
|
|
jr xsecnd ; loop back
|
|
|
|
; read a char, and see if it matches the delimiter in c
|
|
|
|
redsch: dec de
|
|
chksch: ld a,(de)
|
|
and 0x7f ; nuke parity
|
|
inc h
|
|
dec h ; is h zero?
|
|
jr nz,nowsp ; no - don't do white space check
|
|
call iswa ; is it white space?
|
|
scf
|
|
ccf ; clear carry
|
|
ret nz ; return nz if not (no match)
|
|
xor a ; clear a so 'cp h' below forces zero
|
|
nowsp: xor h ; see if char matches delimiter
|
|
ret
|
|
|
|
.dseg
|
|
.extern mode
|
|
mode: db lf_bit
|
|
|
|
.useg
|
|
casefl: ds 1 ; case insensitive string match?
|
|
.extern vars
|
|
vars: ds 26 ; space for 'a' through 'z'
|
|
.extern strngs
|
|
strngs: ds 512 ; space for 35 strings
|
|
.extern _check_
|
|
_check_:
|
|
ds 1 ; check space
|
|
|