; WHEEL.MAC
;
;	Sets, Resets, and Displays ZCPR3 Wheel Byte.
;
Vers	equ	33
SubVers	equ	' '
;
; USAGE:
;
;	WHEEL {password {{/}option}}
; or
;
;	WHEEL {{/}option {password}}
;
; OPTIONS:  A slash before the option is accepted, but not necessary.
;
;	D{ISPLAY}	show current wheel byte status.
;
;	R{ESET}		reset wheel byte (turn it off).
;
;	S{ET}		set wheel byte (turn it on).
;
;	OF{F}		turn wheel byte off (reset it).
;
;	ON		turn wheel byte on (set it).
;
; If a password is entered without an option, SET/ON is assumed.  If
; neither a password nor an option is entered, DISPLAY is assumed.
; Preceding an option with a Q (e.g., "QSET") toggles the current default
; quiet mode.  If the ZCPR3 quiet flag is on or if the quiet configuration
; byte is set, WHEEL defaults to quiet mode.  The Q option then puts WHEEL
; into verbose mode.  DISPLAY, the usage message, and error reports work
; at all times.  If a password is needed but was not entered on the
; command line, WHEEL will prompt for one.
;
; For more complete information, see the accompanying documentation.
;
; Version 3.3 -- October 19, 1990 -- Gene Pizzetta
;	Command line parsing completely rewritten.  All options now
;	acceptable as first parameter.  Added configuration bytes for
;	echo/non-echo of password, default to quiet/verbose mode, to
;	always require password for all options.  All options and
;	password configurable with ZCNFG.  (Now the password can be
;	changed quickly and conveniently on a regular basis, as it
;	should be on a secure system.)  Added "DISPLAY", "ON", and
;	"OFF" options.  Added Q option modifier to toggle current
;	setting of quiet mode.  Now allows password as first or second
;	token.  Eliminated INLINE editor from SYSLIB for password input.
;	(This editor allows an unlimited number of characters to be
;	entered and the version 3.2 type-4 used a buffer in low memory.)
;	Now uses new simple editor that writes to a 9-byte internal
;	buffer and saves considerable program size.  Eliminated sign-on
;	except on usage screen, which has also been simplified.  Code
;	has been rearranged for easier maintenance and to allow a
;	greater number of relative jumps.  Incorporated suggestions
;	from Howard Goldstein for making the code more efficient.
;
; Version 3.2 -- May 2, 1989 -- Bruce Morgen
;	Type 3 format and more smarts.
;
; Version 3.1 -- March 12.1985 -- Joe W. Wright
;	Responds to the quiet flag.
;
; Version 3.0 -- March 8, 1984 -- Richard Conn
; Version 1.1 -- January 24, 1983 -- Richard Conn
; Version 1.0 -- January 14, 1983 -- Richard Conn
;
CpmFcb	equ	5Ch		; default fcb
AltFcb	equ	6Ch		; alternate fcb
Z3Env	equ	0FE00h		; environment address
;
CtrlC	equ	03h
BEL	equ	07h
BS	equ	08h
DEL	equ	7Fh
CR	equ	0Dh
LF	equ	0Ah
;
	MACLIB	Z80
;
; SYSLIB & Z3LIB Routines
;
	.request	Z3LIB,SYSLIB
;
	extrn	cin,cout,eprint,caps,phl4hc
	extrn	z3init,getquiet,getwhl,putwhl,prtname,puter2
;
; TYPE 3 HEADER
; Code modified as suggested by Charles Irvine to function correctly with
; interrupts enabled.  Program will abort with an error message when not
; loaded to the correct address (attempt to run it under CP/M or Z30).
;
entry:	jr	start0		; must use relative jump
	db	0		; filler
	db	'Z3ENV',3	; Type-3 environment
Z3EAdr:	dw	Z3Env		; Filled in by Z33
	dw	entry		; Intended load address
;
; Configuration area . . .
;
	db	'WHEEL'		; for ZCNFG
	db	Vers/10+'0',Vers mod 10+'0',' '
	db	'Z'-'@'		; ^Z prevents reading via TYPE
QtFlag:	db	0		; FF=default to quiet mode
CasFlg:	db	0		; FF=case-sensitive password
EPFlag:	db	0FFh		; FF=echo password
PWFlag:	db	0		; FF=always requires password
PWord:	db	'SYSTEM  '	; Wheel password (8 chars)
;
start0:	lxi	h,0		; point to warmboot entry
	mov	a,m		; save the byte there
	di			; protect against interrupts
	mvi	m,0C9h		; replace warmboot with a return opcode
	rst	0		; call address 0, pushing RETADDR
				; onto stack
retaddr:
	mov	m,a		; restore byte at 0
	dcx	sp		; get stack pointer to point
	dcx	sp		; to the value of RETADDR
	pop	h		; get it into HL and restore stack
	ei			; we can allow interrupts again
	lxi	d,retaddr	; this is where we should be
	xra	a		; clear carry flag
	push	h		; save address again
	dsbc	de		; subtract -- we should have 0 now
	pop	h		; restore value of RETADDR
	jrz	start		; if addresses matched, begin real code
;
	lxi	d,notz33msg-retaddr ; offset to message
	dad	d
	xchg			; switch pointer to message into DE
	mvi	c,9
	jmp	0005h		; return via BDOS print string function
notz33msg:
	db	'Not Z33+$'	; abort message if not Z33-compatible
;
; Start of program -- initialize environment
;
Start:	lhld	Z3EAdr		; get descriptor address
	call	z3init		; initialize environment
	sspd	Stack		; save old stack pointer
	lxi	sp,Stack	; ..and set up new stack
;
; Set default Q option
;
	call	getquiet	; is ZCPR quiet flag set?
	rar			; make sure it's 00 or FF
	sbb	a		; set bits according to carry
	jrnz	Start1		; (yes)
	lda	QtFlag		; no, get configuration byte
Start1:	sta	OpQFlg		; ..and store in Q option flag	
;
; Begin processing
;
	lxi	h,ShowIt	; get address of no option routine
	shld	NOpPtr		; ..and store it
	lxi	h,AltFcb+1	; assume password in AltFcb
	shld	PasPtr		; ..and store address
	lxi	h,CpmFcb+1	; check for option in CpmFcb
	mov	a,m
	cpi	' '		; display?
	jz	ShowIt		; (yep)
	inx	h		; point past slash, if it's there
	cpi	'/'
	jrz	GetOpt		; (it's an option)
; Here's the hard part.  We could have a password, then again . . .
	dcx	h
	cpi	'Q'		; Q option?
	jrnz	Start2
	call	SetQOp		; (yes, maybe, so toggle it in case)
	mov	a,m		; see if there's a next character
	cpi	' '		; display?
	jz	ShowIt		; (looks like it)
;
Start2:	xchg			; put pointer in DE
	lxi	h,RStrg		; look for RESET
	call	CkStrg
	jz	ResIt
	lxi	h,SStrg		; look for SET
	call	CkStrg
	jz	SetIt
	lxi	h,DStrg		; look for DISPLAY
	call	CkStrg
	jz	ShowIt
	lxi	h,OnStrg	; look for ON
	call	CkStrg
	jz	SetIt
	lxi	h,OfStrg	; look for OFF
	call	CkStrg
	jz	ResIt
; If we make it here, there was no option
	mvi	a,low CpmFcb+2	; did we toggle the Q option?
	cmp	e
	cz	SetQOp		; (yes, toggle it back)
	lxi	h,CpmFcb+1	; well, we must have a password
	shld	PasPtr		; store its address
	lxi	h,SetIt		; get new no option routine
	shld	NOpPtr		; ..and store address
	lxi	h,AltFcb+1	; check for option in AltFcb
	mov	a,m
	cpi	' '		; set?
	jrz	SetIt		; (yes)
	cpi	'/'		; do we have a slash?
	jrnz	GetOpt		; (nope)
	inx	h		; yes, get past it
;
; GetOpt -- get option and jump to appropriate routine
;
GetOpt:	mov	a,m
	cpi	'/'		; help request?
	jz	Usage		; (it is)
	cpi	'Q'		; quiet option?
	cz	SetQOp
	cpi	' '		; any option at all?
	jrnz	GetOp1		; (yes)
	lhld	NOpPtr		; no, we display or set
	pchl			; ..jmp to correct routine
GetOp1:	cpi	'D'		; display?
	jrz	ShowIt
	cpi	'R'		; reset?
	jrz	ResIt
	cpi	'S'		; set?
	jrz	SetIt
	cpi	'O'		; off or on?
	jrnz	InvOpt		; (no, bad option)
	inx	h		; get next character
	mov	a,m
	cpi	'N'		; set?
	jrz	SetIt
	cpi	'F'		; reset?
	jrz	ResIt
InvOpt:	mvi	a,19		; set error code
	call	eprint		; invalid option
	db	' Invalid option.',0
	jr	ErExit
;
Abort:	mvi	a,4		; set error code
	call	eprint
	db	' Aborted.',0
	jr	ErExit
;	
Exit:	xra	a		; set for no error
ErExit:	call	puter2		; set program error code
	lspd	Stack		; restore old stack
	ret			; ..and return to CCP
;
; Set Wheel Byte
;
SetIt:	call	ChkPas		; always check password first
	mvi	a,0FFh		; set wheel byte
	jr	DoIt
;
; Reset Wheel Byte
;
ResIt:	lda	PWFlag		; do we need a password?
	ora	a
	cnz	ChkPas		; (yep)
	xra	a		; reset wheel byte
DoIt:	call	putwhl
	lda	OpQFlg		; quiet mode?
	ora	a
	jrnz	Exit		; (yep)
	jr	Show1
;
; Print Wheel Byte setting
;
ShowIt:	lda	PWFlag		; do we need a password?
	ora	a
	cnz	ChkPas		; (yes)
Show1:	call	eprint
	db	' Wheel Byte is O',0
	call	getwhl		; check wheel byte
	jrz	PrOff
	call	eprint
	db	'n (Set)',0
	jr	Exit
PrOff:	call	eprint
	db	'ff (Reset)',0
	jr	Exit
;
; Check password
;
ChkPas:	lhld	PasPtr		; point to possible password
	mov	a,m
	cpi	' '		; do we have one?
	jrnz	MatPas		; (yes, let's match it)
;
; Get password from user and match it to WHEEL password
;
GetPas:	call	eprint
	db	' Wheel Password: ',0
	lxi	h,EdBuf		; point to edit buffer
	mvi	b,8		; eight characters maximum
	lda	EPFlag		; pass echo flag
	call	TLine		; get line from user
	call	eprint
	db	CR,LF,0
	jnz	Abort		; user aborted
	push	h		; save pointer to first char
;	mvi	b,8		; 8 characters (already in B)
GetP1:	lda	CasFlg
	ora	a
	mov	a,m		; capitalize input
	cz	caps
	mov	m,a
	inx	h		; point to next
	ora	a		; done?
	jrz	GetP2
	djnz	GetP1		; count down
	jr	GetP4
GetP2:	dcx	h		; point to null
	mvi	a,' '		; space fill
GetP3:	mov	m,a		; store space
	inx	h
	djnz	GetP3
GetP4:	pop	h		; get pointer to first char
;
; Process password -- address of user password in HL
;
MatPas:	lxi	d,PWord		; point to Wheel password
	mvi	b,8		; 8 chars max
PassLp:	mov	a,h
	ora	a
	jrz	PassOK
	lda	CasFlg
	ora	a
PassOK:	ldax	d		; get Wheel password
	cz	caps
	cmp	m		; match?
	jrnz	BadPas
	inx	h		; point to next
	inx	d
	djnz	PassLp		; count down
	ret			; password approved
;
; Password not approved
;
BadPas:	mvi	a,4		; set error code
	call	eprint
	db	' Invalid Password.',0
	jmp	ErExit
;
; Sets Q option -- toggles current setting
;
SetQOp:	lda	OpQFlg		; get Q flag
	cma			; flip
	sta	OpQFlg		; set quiet flag
	inx	h		; advance past Q
	mov	a,m		; get next character
	ret
;
; Check for matching option -- DE points to command line string,
; HL points to string to match.  Returns zero on match, non-zero
; for no match.
;
CkStrg:	push	d		; save DE
	lxi	b,0820h		; B=8 characters, C=space character
CkLoop:	ldax	d
	cmp	m
	inx	h
	inx	d
	jrz	DoLoop
	cmp	c
	jrnz	CkEnd
DoLoop:	djnz	CkLoop
	xra	a
CkEnd:	pop	d
	ret
;
RStrg:	db	'RESET   '
SStrg:	db	'SET     '
DStrg:	db	'DISPLAY '
OnStrg:	db	'ON      '
OfStrg:	db	'OFF     '
;
; Print help message
;
Usage:	lda	PWFlag		; do we need a password?
	ora	a
	cnz	ChkPas		; (yes)
	call	eprint
	db	'WHEEL    Version '
	db	Vers/10+'0','.',Vers mod 10+'0',SubVers,'   (loaded at ',0
	lxi	h,entry
	call	phl4hc
	call	eprint
	db	'h)',CR,LF,'Usage:',CR,LF,'   ',0
	call	prtname
	call	eprint
	db	' {password {{/}option}}',CR,LF,'or',CR,LF,'   ',0
	call	prtname
	call	eprint
	db	' {{/}option {password}}',CR,LF
	db	'Displays, Sets, or Resets ZCPR3 Wheel Byte.',CR,LF
	db	'Options:',CR,LF
	db	'   D{ISPLAY} show wheel byte status.',CR,LF
	db	'   R{ESET}   turn wheel byte off.',CR,LF
	db	'   S{ET}     turn wheel byte on.',CR,LF
	db	'   OF{F}     turn wheel byte off.',CR,LF
	db	'   ON        turn wheel byte on.',CR,LF
	db	'A password with no option defaults to SET/ON.',CR,LF
	db	'No password or option defaults to DISPLAY.',CR,LF
	db	'Q before an option toggles quiet mode ',0
	lda	OpQFlg		; check our quiet flag
	ora	a
	jrz	Usage1		; (default is off)
	call	eprint
	db	'off.',0
	jmp	Exit
;
Usage1:	call	eprint
	db	'on.',0
	jmp	Exit
;
; TLine -- Tiny in-line editor.  Only backspace and delete are available
; for editing input line.  Rejects control characters, except carriage
; return and control-C.  Carriage return ends edit, buffer contains
; null-terminated string.  ^C aborts editor, buffer contents not
; terminated.
;
; Version 1.0 -- October 13, 1990 -- Gene Pizzetta
;	Written for WHEEL 3.3 to replace SYSLIB INLINE editor.  It adds
;	more safety (accepts only number of characters requested),
;	echoes dots in non-echo mode, uses buffer internal to program
;	(not low memory), and saves considerable code size.
;
; Entry:	HL = address of buffer (length=number of characters + 1)
;		B  = number of characters allowed (255 maximum, but must
;			be 1 less that length of buffer).
;		A  = echo user input flag (0=don't echo, non-zero=echo).
; Exit:		A  = 0 and zero flag set (Z) if okay.
;		A  = 3 and zero flag reset (NZ) if user aborted with ^C.
; Uses:		AF
;
;	public	tline
;
;	ext	cin,cout	; SYSLIB
;
;	MACLIB	Z80		; extended Intel mnemonics
;
;CtrlC	equ	03h
;BEL	equ	07h
;BS	equ	08h
;CR	equ	0Dh
;DEL	equ	7Fh
;
; Entry here . . .
;
TLine:	push	h		; save registers
	push	d
	push	b
	mov	e,a		; save echo flag in E
	mov	d,b		; save buffer length in D
TLoop:	call	cin
	cpi	CR		; carriage return?
	jrz	TLEnd
	cpi	BS		; backspace?
	jrz	IsBS
	cpi	DEL		; delete?
	jrz	IsBS
	cpi	' '		; control character?
	jrc	IsCtrl
	mov	c,a		; save character in C
	mov	a,b		; check number of characters
	ora	a
	jrz	BufEnd		; past end of buffer
	mov	m,c		; store character
	xra	a		; check echo flag (in E)
	ora	e		; do we echo it?
	mov	a,c		; get back character
	cnz	cout		; (echo it)
	mvi	a,'.'
	cz	cout		; (echo dot)
	inx	h		; increment buffer pointer
	dcr	b		; decrement character counter
	jr	TLoop	
;
; BufEnd -- we're at the beginning or end of the buffer and somebody's
; trying to push through the boundary.  Ring the console and do nothing.
;
BufEnd:	mvi	a,BEL		; sound bell
	call	cout
	jr	TLoop
;
; IsBS -- we have a backspace or delete.  If we're not at the beginning
; of the buffer, we backspace 1 character, print a space, and backspace
; again, erasing the last character on the screen.  At the beginning of
; the buffer we ring the console and do nothing.
;
IsBS:	mov	a,b		; put character counter in A
	cmp	d		; compare to buffer length in D
	jrnc	BufEnd		; at beginning of buffer
	mvi	a,BS
	call	cout		; print backspace
	mvi	a,' '
	call	cout		; print space
	mvi	a,BS
	call	cout		; print backspace
	inr	b		; increment character counter
	dcx	h		; decrement buffer pointer
	jr	TLoop
;
; IsCtrl -- we have a control character.  If it's ^C, we abort the edit,
; return A=03h and the zero flag reset (NZ).  Otherwise, be ring the
; console and do nothing.
;
IsCtrl:	cpi	CtrlC		; ^C ?
	jrnz	BufEnd		; (no, continue)
	ora	a		; abort, return NZ
	jr	TLEnd1
;
; TLEnd -- we have a carriage return which ends the edit.  Push null
; at end of string and return A=0 and zero flag set (Z).
;
TLEnd:	xra	a		; add null
	mov	m,a
TLEnd1:	pop	b		; restore registers
	pop	d
	pop	h		; get back buffer address
	ret			; return Z, okay
;
;	end			; TLine
;
; Uninitialized data . . .
;
	DSEG
;
OpQFlg:	ds	1		; quiet toggle flag
NOpPtr:	ds	2		; pointer to no option routine
PasPtr:	ds	2		; password pointer temporary storage
	ds	50
Stack:	ds	2		; old stack pointer storage
EdBuf:	ds	9		; buffer for TLine
;
	end