RomWBW/Source/Images/d_bp/u15/TCSELECT.MAC

; 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