;
;  PROGRAM:  WHEEL
;  VERSION:  3.0
;  AUTHOR:  RICHARD CONN
;  DATE:  8 MAR 84
;  PREVIOUS VERSIONS:  1.1 (24 JAN 83), 1.0 (14 Jan 83)
;
vers	equ	30

;
;	WHEEL is used to set and clear the WHEEL byte.  It is invoked by
; one of the following forms:
;
;		WHEEL //		<-- Print Help
;		WHEEL			<-- Print Wheel Status
;		WHEEL password SET	<-- Set Wheel Byte
;		WHEEL password		<-- Set Wheel Byte
;		WHEEL password RESET	<-- Reset (Clear) Wheel Byte
;		WHEEL /S or WHEEL /R	<-- Set or Reset Wheel Byte
;						(Type Password Later Sans Echo)
;

;
; CP/M Constants
;
cpm	equ	0
z3env	SET	0f400h	; Environment Descriptor
bdose	equ	cpm+5
pass	equ	cpm+5dh	; 1st FCB is password
cmnd	equ	cpm+6dh	; 2nd FCB is command
tbuff	equ	cpm+80h
ctrlz	equ	'Z'-'@'
cr	equ	0dh
lf	equ	0ah

;
; SYSLIB Routines
;
	ext	print,caps,codend,inline,z3init,getwhl,putwhl,qprint

;
; 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
	jmp	start0
;
; ** Wheel Password **
;
	db	ctrlz		;prevents reading via TYPE
ppass:
	db	'SYSTEM  '	;Wheel Password (8 Chars)
;
; Print Banner
;
start0:
	call	qprint
	db	'WHEEL, Version '
	db	vers/10+'0','.',(vers mod 10)+'0',cr,lf,0

;
; Begin Processing
;
	lda	pass	; get password
	cpi	' '	; help?
	jz	pwhlstat
	cpi	'/'
	jnz	start1
	lda	pass+1	; get option
	sta	cmnd	; store command
	cpi	'R'	; reset?
	jz	inpass
	cpi	'S'	; Set?
	jz	inpass
;
; Print Help Message
;
help:
	call	print
	db	cr,lf,'	WHEEL is used to Set and Reset (Clear) the Wheel'
	db	cr,lf,'Byte in order to enable (Wheel Byte is Set) or disable'
	db	cr,lf,'(Wheel Byte is Reset) certain commands within ZCPR2.'
	db	cr,lf
	db	cr,lf,'The forms of the WHEEL command are:'
	db	cr,lf,'	WHEEL //		<-- Print Help'
	db	cr,lf,'	WHEEL			<-- Print Wheel Byte Setting'
	db	cr,lf,'	WHEEL password SET	<-- Set Wheel Byte'
	db	cr,lf,'	WHEEL password		<-- Set Wheel Byte'
	db	cr,lf,'	WHEEL password RESET	<-- Reset (Clear) Wheel Byte'
	db	cr,lf,'	WHEEL /S or WHEEL /R	<-- Set or Reset Wheel Byte'
	db	cr,lf,'					but allow user to type'
	db	' in password'
	db	cr,lf,'					without echo'
	db	cr,lf,0
	ret

;
; Print Wheel Byte Setting
;
pwhlstat:
	call	print
	db	' Wheel Byte is ',0
	call	getwhl	;get wheel byte
pronoff:
	ora	a	;0=off
	jz	proff
	call	print
	db	'ON',0
	ret
proff:
	call	print
	db	'OFF',0
	ret

;
; Input Password without echo and then process it
;
inpass:
	call	print
	db	' Wheel Password? ',0
	call	codend	; pt to scratch area
	xra	a	; no echo
	call	inline	; get line from user
	push	h	; save ptr to first char
	mvi	b,8	; 8 chars
inp1:
	mov	a,m	; capitalize input
	call	caps
	mov	m,a
	inx	h	; pt to next
	ora	a	; done?
	jz	inp2
	dcr	b	;count down
	jnz	inp1
	jmp	inp4
inp2:
	dcx	h	;pt to null
	mvi	a,' '	;space fill
inp3:
	mov	m,a	;store space
	inx	h
	dcr	b
	jnz	inp3
inp4:
	pop	h	; get ptr to first char
	jmp	start2
;
; Process Password
;
start1:
	lxi	h,pass	; pt to user password
start2:
	lxi	d,ppass	; pt to WHEEL password
	mvi	b,8	; 8 chars max
passlp:
	ldax	d	; get WHEEL password
	cmp	m	; match?
	jnz	nopass
	inx	h	; pt to next
	inx	d
	dcr	b	; count down
	jnz	passlp
;
; Password Approved
;
	lda	cmnd	; check command
	cpi	'R'	; reset?
	jz	reset
;
; Set Wheel Byte
;
	mvi	a,0ffh	;set wheel byte
	call	putwhl
	jmp	pwhlstat	;print status
;
; Reset Wheel Byte
;
reset:
	xra	a	;reset wheel byte
	call	putwhl
	jmp	pwhlstat	;print status
;
; Password Not Approved
;
nopass:
	call	print
	db	cr,lf,' Invalid Password',0
	ret

	end