; Pull-Down shell demonstrating utility of VLIB Version 4
; Author: Harold F. Bower
; Date  : 23 Dec 1990

; Revision History:
; 1.0	23 Dec 90 - Updated Help, changed name from PDMSHZ, integrated support
;			with PDMMCL, the version for Command Line Opn.  HFB
; 0.2	18 Feb 90 - Revised to use Shell Stack for return to PMSHELL, added
;			fourth menu Selection for Exit Shell and expanded
;			tables to eight Items per Menu Selection.  Now works
;			correctly under WordStar 4.			HFB
; 0.1	17 Feb 90 - First test version.  HFB

VER	EQU	10		; This Version Number

; ..From VLIB Get..

	EXT	GZ3INIT, PDMINI, SETPDR, MCLS, SELPDM

; ..From Z3LIB Get..

	EXT	WHRENV, GETEFCB, GCMDDU, Z33CHK, PDEFDU, PUTCL
	EXT	PUTCST, SHPUSH, SHPOP

; ..From SYSLIB Get..

	EXT	EPRINT, CODEND, CIN, BBLINE, RETUD

; ASCII Character Constants

BELL	EQU	7
LF	EQU	10
CR	EQU	13

; System References

BDOS	EQU	0005H		; Dos vector location
FCB	EQU	005CH		; Default File Control Block

; Go to the beginning of the routine bypassing header information

	JP	START		; Go to real beginning
	DEFB	'Z3ENV'		; This is a Z-System Tool
	DEFB	1		; Use Z3 Environment
ENVADR:	DEFW	0000		; Store the Environment Address
	DEFW	0000		; ..dummy fill for Type 4

; These tables are variable in content.  Overlay with Hex data for
; your files

TBL0:	DEFB	'D       ',0FFH	; "Files" Entries
MENLEN	EQU	$-TBL0
	DEFB	'DIR     ',0
	DEFB	'FD      ',0FFH
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	' '		; Single space to end

TBL1:	DEFB	'COPY    ',0FFH	; "Utils" Entries
	DEFB	'DSWEEP  ',0
	DEFB	'FA      ',0FFH
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	' '

TBL2:	DEFB	'ZDE     ',0FFH	; "Tools" Entries
	DEFB	'WS      ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	'        ',0
	DEFB	' '

TBL3:	DEFB	'Confirm?',0
	DEFB	' '

CATS0:	DEFB	'Files    '	; Null-terminated Menu bar headings
CATLEN	EQU	$-CATS0		; ..length of heading entries
CATS1:	DEFB	'Utilities'
CATS2:	DEFB	'Tools    '
CATS3:	DEFB	'<Exit>   '

; Begin the real code

START:	LD	(STACK),SP	; Save entry stack pointer
	LD	SP,STACK	; ..and set up a local stack

	LD	A,(FCB+1)	; Is this a Help request?
	CP	'/'
	JP	NZ,START0	; ..bypass Help if Not

	CALL	EPRINT
	DB  CR,LF,'Pull-Down Menu Shell (stack), V ',VER/10+'0','.'
	DB  VER MOD 10 + '0','  by Harold F. Bower  23 Dec 90',CR,LF,LF
	DB  'This program uses Version 4 Library support for an advanced',CR,LF
	DB  'user interface under ZCPR 3.x.  Execute PDMSTK by entering',CR,LF
	DB  'its name (and optional DU: or DIR: as:',CR,LF
	DB  '          PDMSTK [du:|dir:]',CR,LF
	DB  'If another directory was specified, you will be logged',CR,LF
	DB  'there on exit.'
	DB  CR,LF,LF
	DB  'Move the cursor horizontally to the desired selection with',CR,LF
	DB  'Control-S (left) and Control-D (right), and select with the',CR,LF
	DB  'Enter (Return) key to display Item selections.  Move up',CR,LF
	DB  '(Control-E) or down (Control-X) to the desired program and',CR,LF
	DB  'start execution with the Enter (Return) key.'
	DB  CR,LF,LF
	DB  'The ESCape key aborts a pull-down menu and returns to the',CR,LF
	DB  'main heading bar.  Selecting <exit> prompts before exitting;',CR,LF
	DB  '<Return> to Exit, <ESCape> to abort exit.',CR,LF,LF
	DB  '[return for more]',0
	CALL	CIN
	CALL	EPRINT
	DB  CR,'The entries (up to 8 in each pull-down menu) may be set',CR,LF
	DB  'to your desires as:',CR,LF
	DB  ' 1. Edit the PDMSHELL.OVL to reflect desired file names',CR,LF
	DB  ' 2. Assemble to a .HEX file using ZMAC, Z80ASM or similar',CR,LF
	DB  ' 3. Overlay PDMSTK with the .HEX file using MYLOAD or',CR,LF
	DB  '    equivalent program.'
	DB  CR,LF,LF,0

EXIT:	LD	SP,(STACK)	; Restore User stack
	RET			; ..and exit

START0:	LD	HL,(BDOS+1)	; Get Dos Vector address
	CALL	WHRENV		; ..and scan for Environment
	LD	(ENVADR),HL	; Store the pointer
	CALL	GZ3INIT		; Initialize everything
	AND	0110B		; Are needed functions present?
	CP	0110B
	JP	NZ,CANTT	; ..take error exit if not

	CALL	Z33CHK		; Is this ZCPR 3.3 or later?
	JR	Z,START1	; ..jump if it is
	CALL	EPRINT		; Else print error and exit
	DEFB	BELL,CR,LF,'+++ Requires ZCPR 3.3 or later!! +++',0
	JR	EXIT

START1:	CALL	SHPOP		; Insure everything popped off stack
	OR	A		; More to go?
	JR	Z,START1	; ..loop til Shell Stack clear
	CALL	PDMINI		; Initialize the Pulldown system
	CALL	STMENU		; Set up the menu items
	LD	HL,(MENU0)	; Point to 1st menu
	CALL	SETPDR		; ..and set it
	JP	Z,CANTT
	LD	HL,(MENU1)	; Do 2nd
	CALL	SETPDR
	JP	Z,CANTT
	LD	HL,(MENU2)	; .3rd
	CALL	SETPDR
	JP	Z,CANTT
	LD	HL,(MENU3)	; ..and 4th
	CALL	SETPDR
	JP	Z,CANTT

; Pause for a keystroke before entering the menu system

	CALL	EPRINT
	DEFB	'<--- Press any key to Enter Menus --->',0
	CALL	CIN
	CALL	MCLS		; Clear the main screen
NOESC:	CALL	SELPDM		; Choose from the Menu
	JR	Z,NOESC		; ..loop if Escape char

; H now has Menu Selection, L has Item Selection.  Parse and move.

	EX	DE,HL		; Move H to D, L to E
	LD	A,D		; ..and move Menu #
	CP	4		; Is it the "Exit" selection?
	JP	Z,0		; ..Exit w/Warm Boot if so
	LD	HL,TBL0		; Point to first Menu Selection table
	DEC	A		; First?
	JR	Z,SELECT	; ..jump if so
	LD	HL,TBL1		; Point to second table
	DEC	A		; Second?
	JR	Z,SELECT	; ..jump if so
	LD	HL,TBL2		; Else must be third table
SELECT:	LD	A,E		; Move Item #
	LD	BC,MENLEN	; ..and set entry length
	DEC	A		; First Item?
	JR	Z,SELEC0	; ..jump if so
	ADD	HL,BC		; Else offset to next
	DEC	A		; Second Item?
	JR	Z,SELEC0	; ..jump if so
	ADD	HL,BC		; Else offset to next
	DEC	A		; Third Item?
	JR	Z,SELEC0	; ..jump if so
	ADD	HL,BC		; Else must be fourth Item

; Come here with HL pointing to the program to execute.  Save the address
; while we set up the return string to return us to the Shell.

SELEC0:	LD	DE,CMDSTR	; Now address String for Shell entry
	PUSH	HL		; Save pointer to command to execute
	CALL	GCMDDU		; Get the External FCB DU
	RES	7,C		; Clear any ZSDOS User bit
	CALL	ENTRDU		; ..and stuff in MCL to locate Shell
	CALL	GETEFCB		; Get External FCB pointer
	INC	HL		; ..point to name invoked by
	CALL	MOV8		; ..and move to output string
	LD	A,' '		; Add space for DU arg
	LD	(DE),A
	INC	DE
	CALL	RETUD		; Get Current DU in BC
	LD	A,(FCB)		; Get Destination Drive from FCB
	OR	A		; Default?
	JR	Z,DEFDRV	; ..jump if using default
	LD	B,A		; Else save
	DEC	B		; ..and make Zero-based (A=0)
	LD	A,(FCB+13)	; Get Destination User from FCB
	AND	7FH		; .masking any outside effects
	LD	C,A		; ..and save in C
DEFDRV:	CALL	ENTRDU
	XOR	A		; Terminate Command string
	LD	(DE),A
	LD	(DUSAVE),BC	; Save DU for Exit
	LD	HL,CMDSTR	; Point to Command String Start
	CALL	SHPUSH		; ..and push on Shell Stack
	JR	NZ,NOSTAK	; Jump to Error exit if no Stack space

; We have the return name on the Shell Stack, no do transient

	LD	DE,CMDSTR	; Point to String for Shell entry again
	POP	HL		; ..and restore command name
	CALL	MOV8		; Move up to 8 chars to output
	LD	A,(HL)		; ..and get argument flag
	OR	A		; Argument needed?
	JR	Z,NOARG		; ..jump if not

; If we execute this, we are looking for an argument string..get it

	LD	A,' '		; Provide separator to arg list
	LD	(DE),A
	PUSH	DE		; ..and preserve pointer
	CALL	EPRINT		; Get argument string
	DEFB	CR,LF,'Arguments: ',0
	CALL	BBLINE		; Get them
	POP	DE		; Restore the destination addr
	OR	A		; Any chars?
	JR	Z,NOARG		; ..jump if not
	LD	C,A		; Else set count
	LD	B,0
	LD	A,' '		; Add a separator before args
	LD	(DE),A
	INC	DE
	LDIR			; ..and move arg string
NOARG:	XOR	A		; Terminate Command string
	LD	(DE),A
	LD	HL,CMDSTR	; Point to Command String Start
	CALL	PUTCL		; ..and push on Mult Comnd Line
	JR	Z,NOSPAC	; Jump to error exit if No MCL Space
	LD	BC,(DUSAVE)	; Get the User's DU
	CALL	PDEFDU		; ..and make current in ZCPR 3.x
	XOR	A		; Clear the Command Status Message
	CALL	PUTCST
	JP	EXIT		; Exit via ZCPR 3.x return function

NOSTAK:	CALL	EPRINT		; Else print error
	DEFB	CR,LF,'+++ No space in Shell Stack +++',0
	JP	0		; ..and Warm Boot

NOSPAC:	CALL	EPRINT		; Else print error
	DEFB	CR,LF,'+++ No space in Command Buffer +++',0
	JP	0		; ..and Warm Boot

CANTT:	CALL	EPRINT
	DEFB	BELL,'+++ Termcap doesn''t support Menus!! +++',0
	JP	0

; Move Zero to 8 characters to DE from left-justified string in HL
; Return HL pointing to char after 8th one in Input string

MOV8:	LD	B,8
MOV80:	LD	A,(HL)		; Get a char
	CP	' '		; Anything there?
	JR	Z,MOV8A		; ..jump if not
	LD	(DE),A		; Else save it
	INC	DE		; Bump output ptr
MOV8A:	INC	HL		; Bump input ptr
	DJNZ	MOV80		; ..and loop til done
	RET

; Save DU in BC as ASCII chars in the Command String being built

ENTRDU:	LD	A,B		; Get Drive (A=0)
	ADD	A,'A'		; Make ASCII char
	LD	(DE),A		; ..and store
	INC	DE
	LD	A,C		; Get User (0..15)
	CP	10		; Greater than 10?
	JR	C,ENTRD0	; ..jump if Not
	SUB	10		; Else subtract 10
	EX	DE,HL		; .swap regs
	LD	(HL),'1'	; ..stuff an ASCII 1
	INC	HL		; ...and bump ptr
	EX	DE,HL
ENTRD0:	ADD	A,'0'		; Offset digit from ASCII 0
	LD	(DE),A		; .stuff it
	INC	DE		; ..and bump ptr
	LD	A,':'		; Set DU delimiter
	LD	(DE),A		; ..and stuff
	INC	DE
	RET

;.....
; Set up three menu strings in scratch area for menu bars

STMENU:	CALL	CODEND		; Get highest available free address
	LD	(MENU0),HL	; ..saving in first menu column
	EX	DE,HL		; Move to DE
	LD	A,1
	LD	HL,CATS0	; Move menu bar header for this item
	CALL	LDMEN0		; ..adding separator bar
	LD	HL,TBL0		; Point to first file list
	CALL	LDMENU		; ..and form string
	LD	(MENU1),DE	; Save ptr to second menu string
	LD	A,2
	LD	HL,CATS1	; Move menu bar header for this item
	CALL	LDMEN0		; ..adding separator bar
	LD	HL,TBL1		; Point to second file list
	CALL	LDMENU		; ..and add
	LD	(MENU2),DE	; Save ptr to third menu string
	LD	A,3
	LD	HL,CATS2	; Move menu bar header for this item
	CALL	LDMEN0		; ..adding sep bar
	LD	HL,TBL2		; Point to third file list
	CALL	LDMENU		; ..and add
	LD	(MENU3),DE	; Save ptr to fourth menu string
	LD	A,4
	LD	HL,CATS3	; Move menu bar header for this item
	CALL	LDMEN0		; ..adding sep bar
	DEC	DE		; Remove separator bar for exit
	LD	HL,TBL3		; Point to fourth file list
			;..and fall thru, returning at end
LDMENU:	LD	A,(HL)		; Get first char of entry
	CP	' '		; Is it space?
	JR	Z,LDMENX	; ..exit if so
	LD	BC,8		; Else move 8 char file name
	LDIR
	LD	A,3		; Set Item terminator
	LD	(DE),A
	INC	DE		; .bump ptr past item end
	INC	HL		; ..and past Rqd Arg flag
	JR	LDMENU		; ...loop

LDMENX:	XOR	A		; Enter End of Menu char
	LD	(DE),A
	INC	DE
	RET

LDMEN0:	LD	(DE),A		; This is first menu item
	INC	DE
	LD	BC,CATLEN
	LDIR
	LD	A,1		; ..and terminate header
	LD	(DE),A
	INC	DE
	LD	A,4		; Add separator
	LD	(DE),A
	INC	DE
	RET			; ..and quit


MENU0:	DEFS	2		; Store ptrs to menu item strings
MENU1:	DEFS	2
MENU2:	DEFS	2
MENU3:	DEFS	2
DUSAVE:	DEFS	2		; Storage for User DU
CMDSTR:	DEFS	64		; Command String for output
	DEFS	64		; Space for a stack
STACK:	DEFS	2		; Storage for entry stack

	END