434 lines
10 KiB
Plaintext
434 lines
10 KiB
Plaintext
; file.z - file handling odds and ends
|
||
|
||
.incl "c:vars"
|
||
|
||
.extern gofil ; get a filename, and open into auxfcb
|
||
gofil:
|
||
call gauxfc ; get a filename, parse in aux fcb
|
||
ret c ; esc - exit now
|
||
jr z,nowc ; no wildcards
|
||
|
||
.extern opnaux
|
||
opnaux:
|
||
xor a
|
||
call clrw2 ; set pointers for read
|
||
ld de,auxfcb
|
||
ld c,open ; open the file
|
||
call usrbds
|
||
add a,1
|
||
ret nc ; return now if open ok
|
||
ld a,(scning)
|
||
add a,a
|
||
ret c
|
||
|
||
.extern fnferr
|
||
fnferr: call ilprt ; beef and complain about file not found
|
||
db 'File not found\r\n\0'
|
||
scf
|
||
ret
|
||
|
||
.extern nowc
|
||
nowc:
|
||
.extern nowcp
|
||
nowcp:
|
||
call ilprt
|
||
db 'Can\'t handle wildcards\r\n\0'
|
||
scf
|
||
ret
|
||
|
||
.extern gauxfc
|
||
gauxfc:
|
||
call getfcb ; get a filename to fcb at 0x5b
|
||
push af ; save return status in carry
|
||
call byp
|
||
ld (ppp),hl ; save pointer for chat
|
||
pop af ; restore carry
|
||
|
||
.extern xferax
|
||
xferax: ; transfer fcb at fbc to auxfcb
|
||
ld bc,34 ; load the registers
|
||
|
||
.extern xferaz
|
||
xferaz:
|
||
ld hl,fcb
|
||
ld de,auxfcb
|
||
ldir ; and copy to auxfcb
|
||
ret
|
||
|
||
.extern getfcb
|
||
getfcb:
|
||
call prompt
|
||
db 'Filename? \0' ; prompt and input
|
||
ld a,(ipbuf)
|
||
cp '\e' ; carry?
|
||
scf
|
||
ret z ; return now with carry if so
|
||
ld hl,ipbuf
|
||
|
||
.extern scnfcb ; parse a fcb at hl to 0x5b
|
||
scnfcb:
|
||
call byp ; step over any spaces
|
||
push hl
|
||
ld hl,fcb
|
||
ld de,fcb + 1
|
||
ld bc,33
|
||
ld (hl),b
|
||
ldir ; fill fcb with zeros
|
||
ld bc,(curusr)
|
||
inc b ; bump logged drive for fcb
|
||
ld (fcb),bc ; drop in user and drive now
|
||
pop hl ; get input pointer to hl
|
||
push hl ; but save it again
|
||
call ucsahl ; get (possible) drive spec to a
|
||
cp 'A'
|
||
jr c,trynum
|
||
cp 'P' + 1 ; valid drive letter?
|
||
jr nc,respar
|
||
sub '@'
|
||
ld b,a ; save the drive in b
|
||
inc hl
|
||
ld a,(hl) ; get the next letter
|
||
cp ':' ; is it a ':'?
|
||
jr z,usebc ; yes, only drive was given: use what we have
|
||
trynum: sub '0'
|
||
cp 10 ; do we have a valid digit?
|
||
jr nc,respar ; no - reset and ignore whole mess
|
||
scnusr: ld c,a ; save in c
|
||
inc hl
|
||
ld a,(hl) ; get the next letter
|
||
cp ':' ; is it a ':'?
|
||
jr z,usebc ; yes - we got a user: go process it all
|
||
sub '0'
|
||
cp 10
|
||
jr nc,respar ; oops - not a number: reset and ignore
|
||
ld e,a ; current digit to e
|
||
ld a,c
|
||
add a,a
|
||
add a,a
|
||
add a,c
|
||
add a,a ; a = c * 10
|
||
add a,e ; + e
|
||
and 0x1f ; and 0x1f gives updated user number
|
||
jr scnusr ; loop back for another go
|
||
usebc: inc hl ; point at char after ':'
|
||
ex (sp),hl ; save on stack
|
||
ld (fcb),bc ; save new drive / user codes away
|
||
respar: pop hl ; hl points at filename
|
||
ld de,fcb + 2 ; point de at name area
|
||
ld b,8
|
||
call scanfn ; parse the filenane
|
||
ld a,(hl)
|
||
cp '.' ; '.' => extension
|
||
jr nz,nodot
|
||
inc hl ; step over it
|
||
nodot: ld b,3
|
||
call scanfn ; parse it
|
||
push hl ; save pointer to text
|
||
ld hl,fcb + 2
|
||
ld a,'?' ; check for '?'s in the fcb (wildcards)
|
||
ld bc,11
|
||
cpir
|
||
pop hl ; restore text pointer
|
||
ret ; with z flag set for a match
|
||
|
||
scanfn: call ucsahl ; get a char
|
||
or a ; exit on a zero byte
|
||
jr z,gotnam
|
||
cp '.' ; or a '.'
|
||
jr z,gotnam
|
||
cp ' ' ; or a ' '
|
||
jr z,gotnam
|
||
inc hl ; move input pointer
|
||
dec b
|
||
inc b ; test b
|
||
jr z,scanfn ; loop back if zero
|
||
ld (de),a ; save char in fcb
|
||
cp '*' ; '*'?
|
||
jr z,gotstr ; handle elsewhere if so
|
||
inc de ; move output pointer
|
||
dec b ; one less char to go
|
||
jr scanfn
|
||
gotnam: dec b ; decrease b till all done
|
||
ret m
|
||
ld a,' ' ; get a space
|
||
ld (de),a ; put it in fcb
|
||
inc de ; and move pointer
|
||
jr gotnam
|
||
gotstr: ld a,'?' ; put in a '?'
|
||
ld (de),a
|
||
inc de ; move pointer
|
||
djnz gotstr ; loop till all full of '?'s
|
||
jr scanfn ; continue parse
|
||
|
||
.extern areabu
|
||
areabu: call areabp ; do an areabp, and ucsa the char
|
||
|
||
.extern ucsahl
|
||
ucsahl: ld a,(hl) ; get char at hl
|
||
|
||
.extern ucsa
|
||
ucsa: cp 'a'
|
||
ret c ; return if it's below 'a'
|
||
cp 'z' + 1
|
||
ret nc ; or if it's above 'z'
|
||
and 0x5f ; force lower case
|
||
ret
|
||
|
||
; scnwld - enter with hl pointing at a filename, and add the list of
|
||
; matching filenames to the list at fnbrpt / fnbspt
|
||
|
||
.extern scnwld
|
||
scnwld:
|
||
call byp ; strip leading space
|
||
push hl ; save hl
|
||
call scnfcb ; get a filename
|
||
call xferax ; transfer to auxfcb
|
||
ld hl,(auxfcb)
|
||
ld (newusr),hl ; keep a copy of the drive and user
|
||
ld de,auxlin
|
||
ld c,setdma
|
||
call bdos ; set dma to auxlin (seems like a safe place)
|
||
ld c,srchf ; do a search first first time
|
||
scnlp: ld de,auxfcb
|
||
call usrbds ; any more names?
|
||
inc a
|
||
jr z,scannd ; exit if not
|
||
rrca
|
||
rrca
|
||
rrca ; a *= 32
|
||
ld de,(fnbspt)
|
||
ld hl,work + 1024 ; out of room?
|
||
or a
|
||
sbc hl,de
|
||
jr z,nosav ; skip if so - that's 64 filenames anyway!
|
||
ld hl,(newusr) ; get drive and user
|
||
ex de,hl
|
||
ld (hl),e
|
||
inc hl
|
||
ld (hl),d ; and install them
|
||
inc hl
|
||
ex de,hl ; save save pointer in de
|
||
ld l,a
|
||
ld h,0
|
||
ld bc,auxlin - 31 ; -32 because of the inc a above
|
||
add hl,bc ; hl now points at name portion
|
||
ld bc,14 ; 11 chars to transfer, + 3 for spacing
|
||
ldir ; move them characters
|
||
ld (fnbspt),de ; put save pointer back away
|
||
nosav: ld c,srchn ; go look for next name
|
||
jr scnlp
|
||
scannd: pop hl ; restore string pointer
|
||
; and step over filename to next one
|
||
|
||
.extern unbyp ; move a string pointer in hl to the end of
|
||
unbyp: ; the current word
|
||
ld a,(hl)
|
||
cp ' '
|
||
ret z ; stop when we hit a space
|
||
or a
|
||
ret z ; or a zero
|
||
inc hl
|
||
jr unbyp
|
||
|
||
.extern getlin ; read a line of data from file
|
||
getlin:
|
||
ld de,auxlin ; we'll save data in auxlin
|
||
gallp: xor a
|
||
ld (de),a ; set zero for end of line
|
||
push de
|
||
call getw2c ; get a character
|
||
pop de
|
||
ret c ; return carry on physical end of file
|
||
cp 0x1a
|
||
scf
|
||
ret z ; or logical end of file
|
||
cp 0x0d
|
||
jr z,glstrp ; end of line - stip trailing blanks
|
||
cp 0x7f
|
||
jr z,gallp ; ignore deletes
|
||
cp ' '
|
||
jr c,gallp ; and other control characters
|
||
ld (de),a ; save it
|
||
ld hl,auxlin + 127
|
||
or a
|
||
sbc hl,de ; check line length
|
||
jr z,gallp
|
||
inc de ; and bump pointer if not at end of line
|
||
jr gallp
|
||
glstrp: ld hl,auxlin
|
||
or a
|
||
sbc hl,de ; did we hit the start of the line?
|
||
ret z ; return if so
|
||
dec de
|
||
ld a,(de) ; look at previous character
|
||
xor ' ' ; is it a space?
|
||
ret nz ; no - leave it and return
|
||
ld (de),a ; else turn it into a zero
|
||
jr glstrp
|
||
|
||
.extern print ; print a local file to the remote
|
||
print:
|
||
call gofil ; get and open file
|
||
ret c ; exit now on an error
|
||
ld a,0x7f
|
||
ld (b7flag),a ; set flag to strip bit 7
|
||
ld a,2
|
||
ld (cscqfl),a ; enable ctrl ^S ^Q spotting
|
||
plp: call lstmod ; check incoming chars
|
||
call kbdcc ; check the keyboard
|
||
cp 'x' & 0x1f ; quit on a typed ^X
|
||
jr z,prsent
|
||
ld a,(cscqfl) ; ^S seen?
|
||
rrca
|
||
jr c,plp ; yes, so loop for a while
|
||
call getw2c ; get next char to send
|
||
jr c,prsent ; exit on physical end of file
|
||
and 0x7f
|
||
cp 0x1a
|
||
jr z,prsent ; or logical end of file
|
||
cp '\n'
|
||
jr nz,nonlin ; not a linefeed
|
||
ld a,(lflg)
|
||
or a ; are we sending these?
|
||
plpz: jr z,plp ; it gets thrown if disabled
|
||
ld a,'\n'
|
||
nonlin:
|
||
cp ' '
|
||
jr c,sendit ; if it's a control char, no echo check
|
||
ld hl,ecflg
|
||
inc (hl)
|
||
dec (hl) ; echo check enabled?
|
||
jr z,sendit ; nope - send as is
|
||
inc hl
|
||
ld (hl),a ; save echo check value
|
||
sendit: push af ; save the char
|
||
call modop ; send it
|
||
ld a,(chd) ; get the character delay
|
||
ld e,a
|
||
ld d,0 ; to de
|
||
pop af
|
||
cp '\r' ; did we just send a return?
|
||
jr nz,pwait ; nope - handle char delay / echo check
|
||
ld de,(nld) ; get new line delay
|
||
ld a,(lfecho) ; linefeed echo enabled?
|
||
ld (ecval),a ; save it if so
|
||
ld (lfwflg),a ; set linefeed wait flag if needed
|
||
pwait: call setspd ; make a clock dependant value in hl
|
||
add hl,hl ; and double it
|
||
ld a,h
|
||
or l
|
||
jr nz,pwlp
|
||
inc l ; minimum 1
|
||
pwlp: push hl
|
||
call lstmod ; keep an eye on returning chars
|
||
pop hl
|
||
ld a,(ecval) ; echo check in progress?
|
||
dec a
|
||
jr z,ecok ; we got the needed char - break
|
||
dec hl
|
||
ld a,h
|
||
or l ; count hl down
|
||
jr nz,pwlp
|
||
ecok: ld (ecval),a ; set echo check value to zero
|
||
ld hl,lfwflg ; look at linefeed wait flag
|
||
ld a,(hl)
|
||
ld de,100 ; 100 ms delay in de (prototype)
|
||
ld (hl),d ; turn linefeed wait flag off
|
||
or a ; test original value
|
||
jr z,plpz ; back to send next character if not there
|
||
jr pwait ; back to wait again for the extra 1/10th sec.
|
||
|
||
prsent: call ilprt
|
||
db '\r\nSent\r\n\0'
|
||
jr cb7
|
||
|
||
.extern type ; type a file locally
|
||
type:
|
||
call gofil ; get and open the file
|
||
ret c ; quit now on an error
|
||
ld a,0x7f
|
||
ld (b7flag),a ; set flag to strip bit 7
|
||
call dim ; dim mode
|
||
call clrpsp
|
||
tlp: call getw2c ; get a character
|
||
jr c,teof ; exit on eof
|
||
cp 0x1a
|
||
jr z,teof ; and on CP/M eof char
|
||
call limitc
|
||
jr c,tlp
|
||
ld (lco),a ; save in last char
|
||
call tabexp ; type it
|
||
jr nc,tlp ; loop unless ^X cancelled
|
||
teof: ld a,(lco)
|
||
cp '\n'
|
||
call nz,crlf ; output a newline if needed
|
||
call bright ; back to bright
|
||
cb7: xor a
|
||
ld (cscqfl),a ; clear ^S ^Q flag
|
||
dec a ; effectively ld a,0xff
|
||
ld (b7flag),a ; clear bit 7 zap mask
|
||
ret
|
||
|
||
.extern newdsk
|
||
newdsk:
|
||
call prompt
|
||
db 'Drive? \0' ; prompt and input
|
||
ld hl,ipbuf ; parse a full fcb, although we only want
|
||
call scnfcb ; drive and user
|
||
ld hl,(fcb) ; get new values
|
||
dec h ; set drive correct
|
||
ld (curusr),hl ; and save them
|
||
|
||
.extern reset ; reset: simply reset CP/M to remove R/O
|
||
reset: ; status on changed disks
|
||
ld a,(cflg)
|
||
or a ; catch file open?
|
||
ld c,rescpm
|
||
jr z,zbdos ; nope, full reset
|
||
ld a,(cfcb + 1) ; get catch file drive
|
||
ld hl,fcb + 1
|
||
cp (hl) ; same as reset drive?
|
||
ret z ; yes, exit now
|
||
dec a
|
||
ld e,a
|
||
ld c,seldrv ; select chat file drive
|
||
call bdos
|
||
ld a,(fcb + 1) ; get reset drive
|
||
ld hl,1 ; set hl to 1
|
||
ld c,logdrv
|
||
shlp: dec a ; count down
|
||
zbdos: jp z,bdos ; jump to bdos when done
|
||
add hl,hl
|
||
jr shlp
|
||
|
||
.dseg
|
||
.extern b7flag
|
||
b7flag: db 0xff
|
||
.extern cscqfl
|
||
cscqfl: db 0
|
||
|
||
.extern lfecho
|
||
lfecho: db 0
|
||
.extern ecflg
|
||
ecflg: db 0
|
||
.extern ecval
|
||
ecval: db 0
|
||
lfwflg: db 0
|
||
|
||
.useg
|
||
lco: ds 1
|
||
.extern curusr
|
||
curusr: ds 1
|
||
.extern curdrv
|
||
curdrv: ds 1
|
||
.extern auxfcb
|
||
auxfcb: ds 37
|
||
.extern auxlin
|
||
auxlin: ds 128
|
||
.extern script
|
||
script: ds 1024
|
||
.extern scrwrk
|
||
scrwrk: ds 3072
|
||
.extern work
|
||
work: ds 1536
|
||
|