Files
RomWBW/Source/Images/hd0/s0/u15/TCSELECT.MAC
2016-09-30 18:07:16 -07:00

607 lines
12 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; 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