; 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