; 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).
;
;
; 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
