home *** CD-ROM | disk | FTP | other *** search
- ; 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