mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
607 lines
12 KiB
607 lines
12 KiB
; ZCPR3 TCAP Facility (Z3TCAP)
|
|
; Program Name: TCSELECT
|
|
; Author: Richard Conn
|
|
; Version: 1.1
|
|
; Date: 1 Mar 85
|
|
; Previous Versions: 1.0 (10 Mar 84)
|
|
version equ 11
|
|
|
|
; Version 1.1 by Richard Conn: Added FILENABLE equate to allow writing
|
|
; files to disk. If FILENABLE is FALSE, TCSELECT may only store in memory.
|
|
|
|
;
|
|
; TCSELECT allows the user to select an entry from a Z3TCAP.TCP
|
|
; file and store it into memory or a Z3T file. TCSELECT is menu-driven.
|
|
; TCSELECT may be assembled to disable the ability to create a disk file
|
|
; (specifically for Z-NODE operation).
|
|
;
|
|
|
|
;
|
|
; Basic Equates
|
|
;
|
|
false equ 0
|
|
true equ not false
|
|
filenable equ true
|
|
entcnt equ 20 ;number of entries per screen
|
|
z3env SET 0f400h ;ZCPR3 Environment Descriptor
|
|
fcb equ 5ch
|
|
tbuff equ 80h
|
|
ctrlc equ 'C'-'@'
|
|
cr equ 0dh
|
|
lf equ 0ah
|
|
|
|
;
|
|
; ZCPR3 and SYSLIB References
|
|
;
|
|
ext z3init,qprint,z3log,getenv
|
|
ext codend,moveb
|
|
ext print,pfn1,pstr,capine,crlf,cout,pafdc,comphd
|
|
ext initfcb,pfind,f$open,f$read,r$read,f$close
|
|
ext f$exist,gfa
|
|
ext putud,getud,logud
|
|
;
|
|
if filenable
|
|
ext f$make,f$write,f$delete
|
|
endif
|
|
|
|
;
|
|
; Environment Definition
|
|
;
|
|
if z3env ne 0
|
|
;
|
|
; External ZCPR3 Environment Descriptor
|
|
;
|
|
jmp start
|
|
db 'Z3ENV' ;This is a ZCPR3 Utility
|
|
db 1 ;External Environment Descriptor
|
|
z3eadr:
|
|
dw z3env
|
|
start:
|
|
lhld z3eadr ;pt to ZCPR3 environment
|
|
;
|
|
else
|
|
;
|
|
; Internal ZCPR3 Environment Descriptor
|
|
;
|
|
MACLIB Z3BASE.LIB
|
|
MACLIB SYSENV.LIB
|
|
z3eadr:
|
|
jmp start
|
|
SYSENV
|
|
start:
|
|
lxi h,z3eadr ;pt to ZCPR3 environment
|
|
endif
|
|
|
|
;
|
|
; Start of Program -- Initialize ZCPR3 Environment
|
|
;
|
|
call z3init ;initialize the ZCPR3 Env and the VLIB Env
|
|
|
|
;
|
|
; Print Banner
|
|
;
|
|
call qprint
|
|
db 'TCSELECT, Version '
|
|
db (version/10)+'0','.',(version mod 10)+'0'
|
|
db cr,lf,0
|
|
|
|
;
|
|
; Check for Entry in FCB
|
|
;
|
|
lda fcb+1 ;get first char
|
|
cpi '/' ;none if slash
|
|
jnz start1
|
|
;
|
|
; Print Help Info
|
|
;
|
|
help:
|
|
call print
|
|
db 'TCSELECT - Select Entry from Z3TCAP.TCP'
|
|
;
|
|
if filenable
|
|
;
|
|
db cr,lf,'Syntax:'
|
|
db cr,lf,' TCSELECT outfile -or- TCSELECT outfile.typ'
|
|
db cr,lf
|
|
db cr,lf,'where "outfile" is the file to be generated by'
|
|
db cr,lf,'the execution of TCSELECT. If no file type is'
|
|
db cr,lf,'given, a file type of Z3T is the default.'
|
|
db cr,lf
|
|
;
|
|
endif
|
|
;
|
|
db cr,lf,'Syntax:'
|
|
db cr,lf,' TCSELECT'
|
|
db cr,lf
|
|
db cr,lf,'where this alternate form may be used to store'
|
|
db cr,lf,'the Z3TCAP entry for the selected terminal directly'
|
|
db cr,lf,'into the Z3 Environment Descriptor.'
|
|
db 0
|
|
ret
|
|
;
|
|
; Resume Processing
|
|
;
|
|
start1:
|
|
;
|
|
if filenable
|
|
;
|
|
; Set Default File Type if None
|
|
;
|
|
lxi d,fcb+9 ;pt to file type
|
|
lxi h,deftyp ;pt to default file type
|
|
mvi b,3 ;3 bytes
|
|
ldax d ;get first char
|
|
cpi ' ' ;none if space
|
|
cz moveb ;set default file type
|
|
;
|
|
endif
|
|
;
|
|
; Begin Reading Z3TCAP.TCP
|
|
;
|
|
call putud ;save current location
|
|
lxi d,z3tfcb ;try to open Z3TCAP.TCP
|
|
call initfcb ;init FCB
|
|
mvi a,0ffh ;search current also
|
|
call pfind ;look for file
|
|
jnz start2 ;file found
|
|
;
|
|
; File Z3TCAP.TCP Not Found
|
|
;
|
|
fnferr:
|
|
call print
|
|
db 'File ',0
|
|
lxi d,z3tfcb+1 ;print file name
|
|
call pfn1
|
|
call print
|
|
db ' Not Found - Aborting',0
|
|
ret
|
|
;
|
|
; Extract Z3TCAP Index
|
|
;
|
|
start2:
|
|
call logud ;log into DU in BC
|
|
lxi d,z3tfcb ;pt to FCB
|
|
call f$open ;open file
|
|
jnz fnferr
|
|
call codend ;read file into buffer
|
|
mvi c,0 ;set block counter
|
|
|
|
;
|
|
; Load Z3TCAP Index
|
|
;
|
|
loadi:
|
|
inr c ;increment block counter
|
|
push b
|
|
lxi d,z3tfcb ;pt to FCB
|
|
call f$read ;read next block
|
|
jnz rerr ;read error
|
|
lxi d,tbuff ;copy from TBUFF
|
|
push h ;save ptr to this block
|
|
xchg
|
|
mvi b,128 ;128 bytes
|
|
call moveb
|
|
pop h ;pt to this block
|
|
lxi d,16 ;every 16
|
|
mvi b,8 ;8 entries possible
|
|
;
|
|
; Check for End of Index
|
|
;
|
|
loadi1:
|
|
mov a,m ;end of index if space
|
|
cpi ' '
|
|
jz loadi2
|
|
dad d ;pt to next
|
|
dcr b ;count down
|
|
jnz loadi1
|
|
pop b ;get count and load next
|
|
jmp loadi ;HL pts to next block to load
|
|
;
|
|
; Error in Reading File
|
|
;
|
|
rerr:
|
|
pop psw ;clear stack
|
|
call print
|
|
db cr,lf,'File Read Error',0
|
|
ret
|
|
;
|
|
; Reached End of Index
|
|
;
|
|
loadi2:
|
|
shld z3tcver ;save ptr to version number
|
|
loadi3:
|
|
dad d ;compute address of next block after last
|
|
dcr b
|
|
jnz loadi3
|
|
shld scratch ;scratch area
|
|
pop b ;get record number of next block
|
|
mov a,c
|
|
sta rec1 ;save count
|
|
lxi d,z3tfcb ;close file
|
|
call f$close
|
|
;
|
|
; Print menu of terminals
|
|
;
|
|
menu:
|
|
mvi a,1 ;set menu number
|
|
sta menunum
|
|
call codend ;pt to first terminal
|
|
shld curtable ;save ptr
|
|
menu1:
|
|
call prmenu ;print menu pted to by HL
|
|
call print
|
|
db cr,lf,'Enter Selection',0
|
|
call chk1st ;first menu?
|
|
lxi h,lstmsg ;pt to last message
|
|
cz pstr
|
|
call chknth ;last menu?
|
|
lxi h,nxtmsg ;pt to next message
|
|
cz pstr
|
|
call print
|
|
db ', or ^C to Exit - ',0
|
|
call capine ;get response
|
|
call crlf ;new line
|
|
cpi ctrlc ;abort?
|
|
rz
|
|
cpi '+' ;next?
|
|
jz nxtmenu
|
|
cpi '-' ;last?
|
|
jz lstmenu
|
|
sui 'A' ;convert to digit
|
|
jc menuerr ;print error message
|
|
mov c,a ;result in C
|
|
mvi a,entcnt-1 ;selection limit?
|
|
cmp c ;range error?
|
|
jc menuerr
|
|
;
|
|
; Set ptr to menu entry
|
|
; On input, C = offset in 20-terminal menu and MENUNUM is menu (1..)
|
|
;
|
|
lda menunum ;get menu number
|
|
dcr a ;adjust to 0 offset
|
|
mvi d,0 ;HL = number
|
|
mov e,a
|
|
lxi h,0 ;init sum
|
|
mvi b,entcnt ;multiply by number of entries
|
|
mult:
|
|
dad d ;+menunumber
|
|
dcr b ;count down
|
|
jnz mult ;B=0 on exit
|
|
dad b ;compute offset from record 1 for entry
|
|
jmp lterm ;load terminal now with offset in HL
|
|
;
|
|
; HL Now Contains Terminal Number (Zero Relative)
|
|
;
|
|
lterm:
|
|
lda rec1 ;get location of terminal data record 1
|
|
mov c,a
|
|
dad b ;HL contains random record number of terminal
|
|
;
|
|
; HL Now Contains Random Record Number for Terminal in File (Zero Relative)
|
|
; Reopen Z3TCAP.TCP
|
|
;
|
|
lxi d,z3tfcb ;pt to FCB of file
|
|
call initfcb ;reinit it
|
|
call f$open
|
|
;
|
|
; Position to Correct Record and Read it in
|
|
;
|
|
call r$read ;read random record in HL
|
|
call f$close ;close file
|
|
;
|
|
; Copy Into Scratch Area
|
|
;
|
|
lhld scratch ;pt to scratch area
|
|
lxi d,tbuff ;pt to TBUFF
|
|
xchg
|
|
mvi b,128 ;128 bytes
|
|
call moveb
|
|
xchg ;HL pts to scratch
|
|
;
|
|
; Confirm Selection
|
|
;
|
|
call print
|
|
db cr,lf,' Selected Terminal is: ',0
|
|
call prent ;print name
|
|
call print
|
|
db ' -- Confirm (Y/N)? ',0
|
|
call capine ;get input
|
|
call crlf
|
|
cpi 'Y'
|
|
jnz menu1 ;continue
|
|
;
|
|
; Check for FCB and do a memory fill if no file given
|
|
;
|
|
if filenable
|
|
;
|
|
lda fcb+1 ;anything in FCB?
|
|
cpi ' '
|
|
jz memory ;place SCRATCH into Z3 Env Descriptor
|
|
;
|
|
; Create Target File
|
|
;
|
|
call getud ;return home
|
|
lxi d,fcb ;pt to FCB
|
|
call z3log ;log into proper directory
|
|
call f$exist ;test of presence of file
|
|
jz make2 ;create file
|
|
call gfa ;get file attributes
|
|
ani 1 ;R/O?
|
|
jz make1
|
|
call print
|
|
db cr,lf,'File ',0
|
|
lxi d,fcb+1
|
|
call pfn1
|
|
call print
|
|
db ' is Read/Only',0
|
|
ret
|
|
make1:
|
|
call f$delete ;delete file
|
|
make2:
|
|
call f$make ;create file
|
|
cpi 0ffh ;error
|
|
jnz writef
|
|
call print
|
|
db cr,lf,'File Create Error',0
|
|
ret
|
|
;
|
|
; Write Block to File
|
|
;
|
|
writef:
|
|
lhld scratch ;pt to entry
|
|
lxi d,tbuff ;copy into buffer
|
|
mvi b,128 ;128 bytes
|
|
call moveb
|
|
lxi d,fcb ;pt to FCB
|
|
call f$write ;write block
|
|
jnz werr
|
|
call f$close ;close file
|
|
call print
|
|
db cr,lf,'File ',0
|
|
lxi d,fcb+1
|
|
call pfn1
|
|
call print
|
|
db ' Created',0
|
|
ret
|
|
;
|
|
; Can't Write File
|
|
;
|
|
werr:
|
|
call print
|
|
db cr,lf,'File Write Error',0
|
|
ret
|
|
;
|
|
endif ;filenable -- MEMORY follows
|
|
|
|
;
|
|
; Place Z3TCAP Entry into Z3 Environment Descriptor
|
|
;
|
|
memory:
|
|
call getenv ;pt to env desc
|
|
lxi d,80h ;pt to TCAP entry
|
|
dad d
|
|
xchg ;DE pts to entry
|
|
lhld scratch ;pt to scratch area
|
|
mvi b,128 ;copy 128 bytes
|
|
call moveb
|
|
call print
|
|
db cr,lf,' ZCPR3 Environment Descriptor Loaded',0
|
|
ret
|
|
;
|
|
; Invalid Selection
|
|
;
|
|
menuerr:
|
|
call print
|
|
db ' -- Error: Invalid Selection',0
|
|
jmp menu1
|
|
;
|
|
; Advance to next menu
|
|
;
|
|
nxtmenu:
|
|
call chknth ;at end?
|
|
jz nmenu
|
|
call print
|
|
db ' -- Error: Already at Last Menu',0
|
|
jmp menu1
|
|
nmenu:
|
|
lhld curtable ;pt to current table
|
|
lxi d,16*entcnt ;advance to next
|
|
dad d
|
|
shld curtable
|
|
lda menunum ;increment menu number
|
|
inr a
|
|
sta menunum
|
|
jmp menu1
|
|
;
|
|
; Backup to last menu
|
|
;
|
|
lstmenu:
|
|
call chk1st ;at beginning?
|
|
jz lmenu
|
|
call print
|
|
db ' -- Error: Already at First Menu',0
|
|
jmp menu1
|
|
lmenu:
|
|
lhld curtable ;pt to current table
|
|
lxi d,-16*entcnt ;backup
|
|
dad d
|
|
shld curtable
|
|
lda menunum ;decrement menu number
|
|
dcr a
|
|
sta menunum
|
|
jmp menu1
|
|
;
|
|
; PRMENU
|
|
; PRMENU performs the following functions:
|
|
; 1. Sets flag if at 1st menu
|
|
; 2. Sets flag if at last menu
|
|
; 3. Prints menu in 2 columns
|
|
;
|
|
prmenu:
|
|
call print
|
|
db cr,lf,'** Terminal Menu ',0
|
|
lda menunum ;print menu number
|
|
call pafdc ;print as floating
|
|
call print
|
|
db ' for Z3TCAP Version ',0
|
|
lhld z3tcver ;get ptr to version
|
|
inx h ;pt to version number
|
|
prmenu0:
|
|
mov a,m ;get char
|
|
inx h ;pt to next
|
|
call cout ;print char
|
|
cpi ' ' ;done if space
|
|
jnz prmenu0
|
|
call print
|
|
db ' **',cr,lf,cr,lf,0
|
|
xra a
|
|
sta m1flag ;set not at 1st menu
|
|
sta mnflag ;set not at nth menu
|
|
;
|
|
; Determine if at 1st menu
|
|
;
|
|
call codend ;pt to terminal table
|
|
xchg ;... in DE
|
|
lhld curtable ;set 1st menu flag
|
|
call comphd ;compare
|
|
jnz prm1
|
|
mvi a,0ffh ;set flag
|
|
sta m1flag
|
|
;
|
|
; Determine if at nth menu
|
|
;
|
|
prm1:
|
|
push h ;save ptr to current table
|
|
lxi d,16 ;size of table entry
|
|
mvi b,entcnt ;entcnt entries per screen
|
|
prm2:
|
|
mov a,m ;end?
|
|
cpi ' ' ;no entry?
|
|
jz prm3
|
|
dad d ;advance
|
|
dcr b ;count down
|
|
jnz prm2
|
|
jmp prm4
|
|
prm3:
|
|
mvi a,0ffh ;at nth menu
|
|
sta mnflag ;set flag
|
|
;
|
|
; Determine menu bounds
|
|
;
|
|
prm4:
|
|
lxi h,0 ;clear ptr to col2
|
|
shld col2
|
|
pop h ;get ptr to current table
|
|
mvi b,entcnt/2 ;try to advance entcnt/2 entries
|
|
prm5:
|
|
mov a,m ;no next entry?
|
|
cpi ' '
|
|
jz prm6
|
|
dad d ;advance to next
|
|
dcr b ;count down
|
|
jnz prm5
|
|
shld col2 ;save ptr to column 2
|
|
;
|
|
; Print menu
|
|
;
|
|
prm6:
|
|
lhld col2 ;get ptr to column 2
|
|
xchg ;... in DE
|
|
lhld curtable ;get ptr to column 1
|
|
mvi b,entcnt/2 ;entcnt/2 lines max
|
|
mvi c,'A' ;current letter
|
|
prm7:
|
|
mov a,m ;get first char?
|
|
cpi ' ' ;done?
|
|
rz
|
|
mov a,c ;output letter
|
|
call prentry ;print entry
|
|
xchg ;HL pts to col 2
|
|
mov a,h ;done?
|
|
ora l
|
|
jz prm8
|
|
mov a,m ;empty?
|
|
cpi ' '
|
|
jz prm8
|
|
mov a,c ;get char
|
|
adi 10 ;add offset
|
|
call prentry
|
|
prm8:
|
|
inr c ;increment menu letter
|
|
xchg ;restore HL/DE
|
|
call crlf
|
|
dcr b ;count down
|
|
jnz prm7
|
|
ret
|
|
;
|
|
; Print entry whose letter is in A and whose text is pted to by HL
|
|
; Advance HL
|
|
;
|
|
prentry:
|
|
call cout ;output char
|
|
call print
|
|
db '. ',0
|
|
prent:
|
|
push b ;save regs
|
|
mvi b,16 ;16 chars
|
|
prent1:
|
|
mov a,m ;get char
|
|
inx h ;pt to next
|
|
call cout ;print char
|
|
dcr b
|
|
jnz prent1
|
|
call print
|
|
db ' ',0 ;separator
|
|
pop b
|
|
ret
|
|
;
|
|
; Check to see if this is the first menu
|
|
;
|
|
chk1st:
|
|
lda m1flag ;get flag
|
|
ora a
|
|
ret
|
|
;
|
|
; Check to see if this is the last menu
|
|
;
|
|
chknth:
|
|
lda mnflag ;get flag
|
|
ora a
|
|
ret
|
|
;
|
|
; Buffers
|
|
;
|
|
z3tfcb:
|
|
db 0
|
|
db 'Z3TCAP TCP'
|
|
ds 24 ;36 bytes total
|
|
;
|
|
if filenable
|
|
;
|
|
deftyp:
|
|
db 'Z3T' ;default file type
|
|
;
|
|
endif
|
|
;
|
|
nxtmsg:
|
|
db ', + for Next',0
|
|
lstmsg:
|
|
db ', - for Last',0
|
|
m1flag:
|
|
ds 1 ;1st menu flag
|
|
mnflag:
|
|
ds 1 ;nth menu flag
|
|
col2:
|
|
ds 2 ;pointer to column 2 entries
|
|
rec1:
|
|
ds 1 ;number of 1st data record
|
|
menunum:
|
|
ds 1 ;number of current menu
|
|
z3tcver:
|
|
ds 2 ;ptr to ZCPR3 TCAP Version Number
|
|
scratch:
|
|
ds 2 ;ptr to scratch area
|
|
curtable:
|
|
ds 2 ;current table ptr
|
|
|
|
end
|
|
|