title ARRAY		array handling routines
;
;
; equates for assembly
;
INCLUDE RSOPT.INC


entry	select,reselect,editarray,locate,locahl,sortarray,dsptxt,getans,puterr
entry	help,xhelp,ourbyte,lcarr0
entry	nmlins,gtnisk,gtlncl,fldst,movehl,cmpde,copyhl,subde,dsptch,linel0
entry	gtnlsk,error,error1,error3,erchar

; IOPACK/USER

ext	hite		;number of lines on screen
ext	inputc		;input a character
ext	chkinp		;return NZ if input character waiting
ext	mycur		;cursor position
ext	chrout		;output character in C
ext	clears		;clear screen
ext	dsplay		;display message
ext	printc		;print character
ext	blkflg,blkaddr	;flag to blink and address to blink at
ext	msgrsp		;display a message and get a response
ext	clrline		;clear number of lines in ACC, starting with line in B
ext	blkflg		;if nz, blink cursor
ext	ourwid		;allowed screen width
	IF KANJI
ext	knjtst		;test if byte in ACC is first of a Kanji character
ext	chk2nd		;test if byte at H,L is second of a Kanji character
ext	knjflg		;set when Kanji character input in IOPACK
ext	knjchr		;holds Kanji character input in IOPACK
	ENDIF

; OTHER

ext	indptr		;convert indirect message pointer
ext	addbase		;add message file base
ext	upper		;convert to upper case
ext	clused,fdused	;get number of columns, fields used so far
ext	fldm04,fldm06	;error message
ext	charbf		;bad character buffer
ext	bdcmsg		;bad character message
;
; equates
;

nx	equ 1
cr	equ 0DH
escape	equ 1BH
hole	equ '_'

arrays	equ 0FFH	;array start flag
arraye	equ 0FFH	;array end flag
blinkc	equ 0FEH	;code to blink on
cursrc	equ 0FDH	;code to put cursor on

	IF HILITE	
remvid	equ 7fh		;true for HIGHLIGHTING
fieldl	equ 32		;field name length
	ENDIF
	IF ATEBIT
remvid	equ 0FFH	;true for 8 BIT CHAR SET
fieldl	equ 33		;field name length
	ENDIF

mc	equ 0		;count, message
al	equ mc+1	;another list
sc	equ al+1	;set cursor position
sa	equ sc+1	;set current array
da	equ sa+1	;display array
dr	equ da+1	;do routine
ce	equ dr+1	;conditional end
cs	equ ce+1	;clear to screen end & end list
el	equ cs+1	;list end

	page 60
;****************************************
;
; 	sort array
;
;****************************************

sortarray:
	call setarray	;set current array from pointer in BC
sorta1:	xra a
	sta swflag	;init swap flag
	lhld array
	call sorta2
	lda swflag
	ora a
	jnz sorta1
	ret	
;
sorta2:	mov a,m
	cpi arraye
	rz
	xchg
	lhld offset	;offset to next
	mvi h,0
	dad d
	xchg
	call cmpstr	;compare strings, set CY if HL > DE
	db 0FFH		;mask
	xchg
	cc swpstr	;swap if out of order
	jmp sorta2

	page
;
; compare strings
;  mask follows call
;
cmpstr:	lda offset
	mov b,a
cmpst0:	xthl
	mov a,m		;get mask byte
	inx h
	xthl
	push h
	push d
	push b
	mov c,a
cmpst1:	push b
	mov a,m
	ana c
	mov b,a
	ldax d
	ana c
	cmp b
	pop b
	jnz cmpst2
	inx h
	inx d
	dcr b
	jnz cmpst1
cmpst2:	pop b
	pop d
	pop h
	ret
;
; swap strings
;
swpstr:	push h
	push b
	mov a,b
	sta swflag	;say we swapped
swpst1:	mov c,m
	ldax d
	mov m,a
	mov a,c
	stax d
	inx d
	inx h
	dcr b
	jnz swpst1
	pop b
	pop h
	ret

	page
;****************************************
;
; find position in array that matches string in HL
;
;	BC = array to look in
;	ACC= length of string to match in HL
;	returns Z set if matched, ACC = item number
; 
;****************************************

locate:	call setarray	;set current array from pointer in BC
locat0:	push d
	xchg
	lhld array	;array
	push b
	mov b,a
	lda offset
lcarr0:	push h
	mov l,a
	mvi h,0		;offset to next array item
	mov c,h		;item number of match
	xthl		;put offset on stack, restore array pointer
lcarr1:	call cmpst0	
	db remvid	;mask
	mov a,c
	jz lcarr2	;match
	inr c
	xchg		;all this just to add HL to value on stack
	xthl		;first swap DE with stack
	xchg
	dad d		;add it in
	xchg
	xthl		;swap DE with stack
	xchg
	mov a,m
	cpi arraye
	jnz lcarr1
	lhld array	;set pointer to start
	ora a		;ACC = 0FFH
lcarr2:	pop b		;clean stack
	pop b
	pop d
	ret
;
; locate string in DE from array in HL
;
locahl:	push d
	push b
	mov b,a
	jmp lcarr0

	page
;****************************************
;
;	process input character
;
;****************************************

prchar:	call upper	;convert to upper case
	mov c,a
	call ckchar	;check against legal list, return code
	jc erchar	;jif bad character
	cpi ' '
	jnc putchr	;jif not control character
	lxi h,stable	;dispatch table
;
; dispatch to routine for list in HL, number in ACC
;
mvcurr:	call gtword	;get address into HL
	shld routine
	lhld macaddr
	xchg
	lda entoff
	mov b,a
over:	push b		;save entry offset in case nogood
	push d		;save cursor position in array in case nogood
	lhld routine
	call ppchl	;go do it
	pop d
	pop b
	rc		;jif not done here
	call ckboth	;check legal, array end
	rnz		;is all ok
	jnc over	;not at end, retry
;
; can't do cursor move, restore position
;
	xchg
	shld macaddr
	mov a,b
	sta entoff
	xra a		;clear CY
	ret
;
ckend:	lhld macaddr
	mvi a,arraye
	cmp m		;note compare this direction always leaves CY clear
	ret
;
; check for array end, illegal
;
ckboth:	call ckend
	stc
	rz
;
; set Z if position illegal
;  HL destroyed
;
chkleg:	call fldst	;point field start
	mov a,m
	sui '('
	rz		;n.g intermediate
	lhld macaddr
	call ckspace
	rnz		;ok if not at a space
	lda entoff
	ora a
	rz		;NG if empty entry
	lda spacfg
	ora a
	rz		;NG if can't position at a space (in summary selection)
	dcx h
;
; set Z if space
;
ckspac:	mov a,m
	sui ' '
	ani remvid		;ignore parity
	mov a,m
	ret
;
; dispatch table for array selection
;
stable:	dw pfield	;^A  previous field
	dw imdone	;^C  I'm done
	dw nchar	;^D  next character
	dw upline	;^E  cursor up line
	dw nfield	;^F  next field
	dw pchar	;^H  cursor previous character
	dw toghlp	;^J  toggle help
	dw tgxhlp	;^K  toggle extra help
	dw logdsk	;^L  change logged disk
	dw enter	;^M  enter item
	dw nxtscn	;^N  next screen
	dw prvscn	;^P  previous screen
	dw pchar	;^S  previous character
	dw delitm	;^T  delete item
	dw repitm	;^V  replace item
	dw dscrll	;^W  scroll down
	dw dnline	;^X  down line
	dw uscrll	;^Z  scroll up
;
; get word offset 2*ACC
;
gtword:	push d
	mov e,a
	mvi d,0
	dad d
	dad d
	mov e,m
	inx h
	mov d,m
	xchg
	pop d
	ret



;
; check character list
;
ckchar:	mov a,c
	cpi '('
	stc
	rz		;n.g. if intermediate
	cpi ' '
	rnc
ckchr0:	ani remvid
	lhld okchars
	mvi b,0		;count here
	inr m
ckchr1:	dcr m		;restore
	cmp m
	inx h
	jz ckchr2
	inr b
	inr m
	jnz ckchr1
	dcr m		;restore
	stc
ckchr2:	mov a,b
	ret
;
; put ascii character in C
;
putchr:	lhld putaddr
	IF KANJI
	mov a,m		;get first old byte
	sta oldhld	;save it
	inx h		;bump pointer
	mov a,m		;get second old byte
	sta oldhld+1	;save it
	dcx h		;point back to current position
	mov m,c		;put ANK/1st byte of Kanji into destination buffer
	lda knjflg	;was input character a Kanji?
	ora a
	lda entoff	;get current field offset
	jz ptchr1	;jif not Kanji input
	lda knjchr	;get 2nd byte of Kanji
	inx h		;bump pointer
	mov m,a		;put 2nd byte into destination buffer
	lda entoff	;get current field offset
	inr a		;increment it 
ptchr1:	lhld putaddr	;load putaddr
	xchg
	lhld destbf	;load address of destination buffer
	inr a		;increment current field offset = count for LOCAT0
	call locat0	;locate (partial) field name in array
	lda oldhld	;get first old byte
	stax d		;restore it
	inx d		;bump pointer
	lda oldhld+1	;get second old byte
	stax d		;restore it
	dcx d
	jnz erchar	;jif bad character
	xra a
	sta knjflg	;don't need Kanji flag anymore now	
	ELSE
	mov b,m		;save old
	mov m,c		;put character into destination buffer
	xchg		;save putaddr
	lhld destbf
	lda entoff
	inr a		;count
	call locat0	;locate in array
	mov a,b
	stax d		;restore character
	jnz erchar	;jif bad character
	ENDIF
	call pntent	;point current offset in array
	shld macaddr
	lda iteml
	dcr a
	lxi h,entoff
	cmp m
	jnz nchar	;if not at end, bump character
	mvi c,cr
	call enter	;enter it
	ret		;if at end, exit
;
; bad character, display error message
;
erchar:	call puterr	;put character into error message
	push h
	lxi h,bdcmsg	;bad character message
	call error
	pop h
	ora a		;clear cy
	ret
;
; put character into error message
;
puterr:	push h
	IF KANJI
	lda knjflg	;was input character a Kanji?
	ora a
	jz puter1	;jif not
	xra a
	sta knjflg	;don't need Kanji flag anymore	
	lxi h,charbf	;address bad character buffer
	lda knjchr+1	;get 1st byte of Kanji
	mov m,a		;store in buffer
	inx h		;bump pointer
	lda knjchr	;get 2nd byte of Kanji
	mov m,a		;store in buffer
	pop h
	ret
puter1:
	ENDIF
	mov a,c
	cpi ' '
	lxi h,charbf	;bad character buffer
	jnc pterr1
	mvi m,'^'
	inx h
	adi 40H
pterr1:	mov m,a
	inx h
	mvi m,0
	pop h
	ret

	page
;****************************************
;
;	control character routines
;
;****************************************

pfield:			;^A  previous field
	lda entoff
	ora a
	cz pchar	;if already at field start
pfld1:	lda entoff
	ora a
	cnz pchar	;do while entoff is nz
	rz		;at array start
	jmp pfld1	

;
imdone:			;^C  i'm done
	stc
	ret
;
nchar:			;^D  next character
	IF KANJI
	xra a
	sta knjyes	;we haven't moved over a Kanji character yet
	ENDIF
	call ckend	;just checks current position
	rz		;at array start/end
nchar1:
	IF KANJI
	mov a,m		;get current field character
	call knjtst	;is it a Kanji?
	jnc nchar2	;jif not
	inx h		;bump pointer past 1st byte of Kanji
	shld macaddr	;set updated current field address
	lxi h,entoff	;address current field offset
	inr m		;increment it
	lda iteml	;get length of displayed fields
	cmp m		;test if at end of field
	jz nchar3	;jif at end
	mvi a,1		;else
	sta knjyes	;indicate that we have moved over a Kanji character
	lhld macaddr	;reload current field address
nchar2:
	ENDIF
	inx h
	shld macaddr
	lxi h,entoff
	inr m
	lda iteml
	cmp m
	IF KANJI
	jz nchar3	;jif at end of field
	push h
	lhld macaddr	;address current field byte
	mov a,m		;get current field byte
	call knjtst	;is it the 1st byte of a Kanji?
	pop h
	rnc		;return if not Kanji
	lda iteml	;get length of displayed field
	dcr a		;offset of last byte in displayed field 
	cmp m		;is this Kanji byte the last in the displayed field
	rnz		;return if not
	lxi h,knjyes	;add one to flag to say that we 
	inr m		; have gone over two Kanji chars
nchar3:
	ELSE
	rnz
	ENDIF
	call fldst	;point field start
	xchg
	call pntnxt	;point start next field
	xchg
	shld macaddr	;in case iteml <> offset
	xra a
	sta entoff
	ret
;
upline:			;^E  cursor up line
	call moveln	;get line length into HL
uplin1:	push h
	call pchar	;previous character
	pop h
	dcx h
	IF KANJI
	lda knjyes	;did we move over a Kanji character?
	ora a
	jz uplin2	;jif not
	mov a,h
	ora l
	jz uplin2	;jif count already expired - must not decrement
	push d
	lda knjyes	;get number of Kanjis moved over
	mov e,a
	mvi d,0
	call subde	;subtract from count in HL
	pop d
uplin2:
	ENDIF
	mov a,h
	ora l
	jnz uplin1
;
; move cursor left if not at entry end
;
entend:	call ckend
	rz		;array start
enten1:	call chkleg	;set NZ if legal
	rnz		;legal
	lda entoff
	ora a
	rz		;at item start
	call pchar
	jmp enten1
;
moveln:	lda itempl
	lxi h,iteml
	jmp mult
;
nfield:			;^F  next field
	call nchar
	lda entoff
	ora a
	jnz nfield
	ret
;
pchar:			;^H  cursor previous character
	IF KANJI
	xra a
	sta knjyes	;we haven't moved over a Kanji character yet
	ENDIF
	call ckend
	rz
pchar1:	lhld macaddr
	dcx h
	shld macaddr
	lxi h,entoff
	dcr m
	IF KANJI
	jz pchar3	;jif at start of field
	jm pchar3	;jif at end of field
	lhld macaddr	;load current field aaddress
	lda entoff	;get current field offset
	call chk2nd	;are we at the 2nd byte of a Kanji character?
	jnc pchar2	;jif not
	lhld macaddr
	dcx h		;go back to 1st byte of Kanji
	shld macaddr
	mvi a,1
	sta knjyes	;indicate that we have moved over a Kanji character
	lxi h,entoff	;address current field offset
	dcr m		;decrement it
pchar2:	lxi h,entoff	;address current field offset
	xra a
	ora m		;test current field offset
pchar3:
	ENDIF
	rp
	lda offset
	dcr a
	mov m,a
	call ckend
	rz		;don't reset macaddr if array start
	call fldst	;point field start
	lda iteml
	dcr a
	sta entoff	;set entry offset
	call pntent
	shld macaddr	;reset for iteml < offset
	IF KANJI
	push psw	;save entry offset
	push h		;save macaddr
	call chk2nd	;are we at the 2nd byte of a Kanji character?
	jc pchar4	;jif yes
	lhld macaddr	;load current field address
	mov a,m		;get current field byte
	call knjtst	;is it the 1st byte of a Kanji?
	jnc pchar5	;jif not
	dcx h		;else go back to previous byte
	shld macaddr	;set new current field address
	lda knjyes
	inr a
	sta knjyes	;indicate that we have moved over 1 Kanji byte
	lda entoff	;get entry offset
	dcr a		;decrement it
	sta entoff	;set new offset
	call chk2nd	;are we now at the 2nd byte of a kanji?
	jnc pchar5	;jif not
pchar4:	lhld macaddr
	dcx h		;go back to 1st byte of Kanji
	shld macaddr
	lda knjyes
	inr a
	sta knjyes	;indicate that we have moved over 1 more Kanji byte
	lxi h,entoff	;address current field offset
	dcr m		;decrement it
pchar5:	pop h
	pop psw
	ENDIF
	ori 0FFH
	ret
;
toghlp:			;^J  toggle help
	lxi h,help
	mov a,m
	cma
	mov m,a
	ret

;
tgxhlp:			;^K  toggle extra help
	lxi h,xhelp
	mov a,m
	cma
	mov m,a
	ret

;
logdsk:			;^L  change logged disk
	stc
	ret

;
enter:			;^M  enter
	lhld destbf
	xchg
	call fldst
	lda offset
	mov b,a
	call enbuff	;fill destination buffer
	cmc		;ignore if error, else return to caller
	ret

;
nxtscn:			;^N  next screen
	stc
	ret
;
prvscn:			;^P  previous screen
	stc
	ret

;
delitm:			;^T  delete item
	stc
	ret

;
repitm:			;^V replace item
	stc
	ret

;
dscrll:			;^W  scroll down
	lxi h,nlskip
	dcr m
	rm		;can't if already at array top
	call rarray	;restore array
	lhld macaddr
	call nmlinp	;get number of lines to cursor in ACC
	mov c,a
	lda nlskip
	lxi h,window
	add m		;first line nor displayed
	sub c
	ora a		;clear CY
	rnz
dscr1:	call upline
	call ckboth
	rnz		;at a legal position
	jnc dscr1	;jif not at array start
	lxi h,nchar
	shld routine	;set routine address for retry
	jmp nchar1	;move off array start
;
dnline:			;^X  down line
	call moveln	;get line length into HL
dnlin1:	push h
	call nchar	;previous character
	pop h
	dcx h
	IF KANJI
	lda knjyes	;did we move over a Kanji character?
	ora a
	jz dnlin2	;jif not
	mov a,h
	ora l
	jz dnlin2	;jif count already expired - must not decrement 
	push d
	lda knjyes	;get number of Kanjis moved over
	mov e,a
	mvi d,0
	call subde	;subtract from count in HL
	pop d
dnlin2:
	ENDIF
	mov a,h
	ora l
	jnz dnlin1
	call entend	;put cursor at entry end if at illegal place
	ret	
;
uscrll:			;^Z  scroll up
	lxi h,nlskip	;number of lines to skip
	lda nlines	;number in array
	inr m
	cmp m
	rz		;don't if won't have anything left to display
	call rarray	;copy array back
	lhld macaddr
	call nmlinp	;get number of lines to cursor into ACC
	lxi h,nlskip
	cmp m
	rnc
uscr1:	call dnline	;move cursor down if not in screen
	call ckboth
	rnz		;at a legal position
	jnc uscr1	;try again
	lxi h,pchar
	shld routine	;set for retry
	jmp pchar1	;get off end marker

	page
;****************************************
;
; select item from array
;
;	HL = address of array element to start cursor at
;	DE = destination buffer
;	BC = list address
;
; returns
;	HL = updated cursor address
;	DE = current address in destination buffer
;	 C = last character typed
;	ACC= entry offset
;
;****************************************
select:	xra a
reselect:		;entry to reselect
	call entry	;set entry parameters
	mvi a,0FFH
	sta spacfg	;allow cursor at a space at entry end
selec1:	call dspsc0	;display screen
	call inputc
	call prchar	;process character
	jnc selec1	;jif no exit
	call exit	;restore registers
	ret
;
; set entry parameters
;
entry:	sta entoff
	shld macaddr
	xchg
	shld destbf
	mov h,b
	mov l,c
	shld curscn	;set current screen
	ret
;
; restore exit parameters
;
exit:	xra a
	sta blkflg
	lhld destbf
	xchg
	lhld macaddr
	lda entoff
	ret

	page
;****************************************
;
; edit array
;
;	HL = address of array element to start cursor at
;	DE = destination buffer
;	BC = list address
;
;****************************************
editarray:
	xra a		;entry offset
	call entry	;set entry parameters
	xra a		;don't allow cursor at a space
	sta spacfg
edarr1:	call dspsc0	;display screen
	call inputc
	call edchar	;process edit character
	jnc edarr1	;jif no exit
	call exit
	ret
;
; process edit character
;

edchar:	call upper	;convert to upper case
	mov c,a
	call ckchr0	;check against legal list, return code
	sta chrnum	;save character number
	jc erchar	;jif bad character
	lxi h,etable	;dispatch table
	jmp mvcurr
;
; delete character from destbf
;
delchr:	lhld putaddr
	mvi m,hole
	lhld macaddr
	mvi m,hole
	xra a
	ret

	page
;
; dispatch table for array edit
;
etable:	dw pfield	;^A  previous field
	dw imdone	;^C  i'm done
	dw nchar	;^D  next character
	dw upline	;^E  cursor up line
	dw nfield	;^F  next field
	dw delchr	;^G  delete character
	dw pchar	;^H  cursor previous character
	dw toghlp	;^J  toggle help
	dw tgxhlp	;^K  toggle extra help
	dw enitem	;^M  enter item
	dw nxtscn	;^N  next screen
	dw prvscn	;^P  previous screen
	dw pchar	;^S  previous character
	dw dscrll	;^W  scroll down
	dw dnline	;^X  down line
	dw uscrll	;^Z  scroll up

nmchar	equ ($-etable)/2

	dw ptbuff	; T put into destbf
	dw ptbuff	; A
	dw ptbuff	; L
	dw ptbuff	; S
	dw ptno		; N
	dw ptno		; Y
;
; put character into destbf
;
ptno:	xra a
	call ptbuf1
	call nfield
	ret
;
ptbuff:	lda chrnum	;character number
	sui nmchar
ptbuf1:	mov e,a
	mvi d,0
	lhld destbf
	dad d
	mov m,c		;put into entry buffer
	call fldst
	xchg		;put field start pointer into DE
	dad d
	lda iteml
	mov b,a
	call svbuff	;save buffer the way it is
	mov m,c		;put into summary table
	call ckbuff	;check buffer, setting CY and restoring if no good
	xra a		;clear CY and continue
	ret

	page
;
; put entry into array
;
enitem:	call fldst	;point start of array field
	xchg
	lhld destbf
	lda iteml
	mov b,a
	call enbuff	;enter buffer
	jnc nfield	;jif not too big
	xra a		;clear cy and continue
	ret
;
; enter buffer @DE with stuff @HL, including:
;   save destination
;   enter buffer
;   test result
;   if form now too big:
;	restore destination
;	type error
;	return CY set
;
enbuff:	call svbuff	;save buffer
	push d
	push b
	call movehl	;enter buffer
	pop b
	pop d
;
; check array
;  if too big, restore buffer @DE
;
ckbuff:	call fdused
	lxi h,fldm06
	jc enbuf2	;jif too many fields
	call clused	;check if form too big
	rnc
enbuf1:	lxi h,fldm04
enbuf2:	call rsbuff	;restore the buffer
;
; display error message and get response
;
error:	mvi c,escape	;required response
error1:	mvi b,2
error3:	mvi a,5
	call clrline	;clear to line 6
error2:	push h		;save message address to return
	push h
	lxi h,blkflg
	mov a,m
	mvi m,0
	xthl
	push psw
	call msgrsp	;display a message and get response
	pop psw
	pop h
	mov m,a
	mov a,c
	pop h		;restore message address
	stc
	ret
;
; save destination buffer
;
svbuff:	mov a,b
	sta buffln
	push h
	push d
	push b
	xchg
	lxi d,savbuf
	call copyhl
	pop b
	pop d
	pop h
	ret
;
; restore destination buffer
;
rsbuff:	push h
	lxi h,savbuf	;what we saved
	lda buffln
	mov b,a
	call copyhl	;put it back
	pop h
	ret
;
movehl:	mov a,m
	cpi cursrc
	jnz movhl1
	lda cursrb	;this is for the call from enter
movhl1:	ani remvid
	stax d
	inx h
	inx d
	dcr b
	jnz movehl
	ret
;
; point field start
;
fldst:	lhld macaddr
	lda entoff
	push d
	mov e,a
	mvi d,0
	ora a
	cnz subde
	pop d
	ret
;
; point entry position
;
pntent:	push d
	lda entoff
	mov e,a
	mvi d,0
	dad d
	pop d
	ret


	page
;****************************************
;
;	display current screen 
;
;****************************************
dspscn:	shld curscn
dspsc0:	xra a		;entry with macaddr, putaddr, destbf & entoff set
	sta blkflg	;assume no blink
	lhld destbf
	call pntent
	shld putaddr	;set put address
	call setcp	;set cursor positions
	lhld curscn	;current screen
	call dsptxt	;display text
	lhld curpos
	shld mycur
restcp:	lhld putaddr	;restore cursor positions
	lda blinkb
	mov m,a		;restore blink character
	lhld macaddr
	lda cursrb
	mov m,a		;restore cursor byte
	ret
;
; set cursor positions
;
setcp:	lhld putaddr
	mov a,m
	sta blinkb	;save blink byte
	mvi m,blinkc	;set blink into message
	lhld macaddr
	shld curaddr	;set cursor address in array
	mov a,m
	sta cursrb	;cursor byte
	mvi m,cursrc	;set cursor into message
	ret

	page
;****************************************
;
; display text at list in HL:
;
;	(mc)  count, message
;	(al)  another list
;	(sc)  set cursor position
;	(sa)  set current array
;	(da)  display array
;	(dr)  do routine
;	(ce)  conditional end list
;	(cs)  clear to screen end & end list
;	(el)  list end
;
;****************************************
dsptxt:	call chkinp
	jz dsptx0
	mvi a,0FFH
dsptx0:	sta outflg	;set flag NZ to suppress output
	push h
	push d
	push b
dsptx1:	mov e,m
	inx h
	mov d,m
	inx h
	call dsptx2	;do it
	jz dsptx1
	pop b
	pop d
	pop h
	ret
;
; display message / take care of flag in HL
;
dsptx2:	inr d
	dcr d
	jnz dspmsg	;jif not a flag
	mov a,e		;flag byte
	mov e,m
	inx h
	mov d,m
	inx h
	push h
	lxi h,dsptx3	;list
	call dsptch
	pop h
	ret
;
dsptch:	call gtword
ppchl:	pchl
;
dsptx3:	dw dspctm	;count terminated message
	dw dspanl	;another list
	dw setcur	;set cursor
	dw sarray	;set current array
	dw dsparr	;display array
	dw cllsub	;call subroutine
	dw cndend	;conditional end list
	dw cleare	;clear to screen end
	dw enlist	;done

;****************************************
;
;	routines for text display
;
;****************************************

;
; display message, zero terminated
;
dspmsg:	lda outflg
	inr a
	rz		;skip if input waiting
	xchg
	call indptr
dspms0:	xchg
	ldax d
	ora a
	rz
	push b
dspms1:	cpi nx
	inx d
	cz dspms2	;continuation
	IF KANJI
	call knjfrs	;set flag if this is the first byte of a Kanji char.
	ENDIF
	call dspchr
	ldax d
	ora a
	jnz dspms1
	pop b
	ret
;
; do continuation message
;
dspms2:	push h
	xchg
	mov e,m		;get next message
	inx h
	mov d,m
	inx h
	xchg
	push d		;save old message pointer
	call addbase	;add message file base
	call dspms0	;display it
	pop d
	pop h
	ret
;
; display character
;  if high bit set, save cursor position
;
dspchr:	ora a
	IF HILITE
	cm savcur
	ELSE
	call savcur
	ENDIF
	mov c,a
	call chkdsp	;set CY if enough room to display
	rnc
;
; conditional output
;
cndout:	lda outflg
	inr a
	cnz chrout	;output if nothing waiting
	ret
;
; set CY if enough room to display character in ACC/C
;
chkdsp:	cpi ' '
	rc		;always room for ctl charcs
	push h
	IF KANJI
	lda knj1st	;is this the 1st byte of a Kanji character
	ora a
	jz ckdsp1	;jif not 1st byte of Kanji
	lda mycur	;get current cursor column number
	inr a		;increment cursor position
	inr a		;and again
	lhld ourwid	;address screen width
	cmp l		;will we have room to display both byte of Kanji?
	pop h
	rc		;return if yes
	push h
	mvi c,' '	;else replace 1st byte with a space
ckdsp1:
	ENDIF
	lda mycur	;col in ACC
	inr a		;chrout will make a new line when mycur hits ourwid
	lhld ourwid
	cmp l		;set CY if enuf
	pop h
	ret
;
; save cursor position
;
savcur:	push h
	lhld mycur
	cpi blinkc	;blink code
	cz svcur1	;set blink address
	cpi cursrc	;cursor code
	cz svcur2	;set cursor address
	pop h
	IF HILITE
	ora a
	rp
	ELSE
	cpi blinkc	;test if blink code
	jz svcura
	cpi cursrc	;test if cursor code
	rnz
svcura:
	ENDIF
	mvi a,' '	;replace with space to not display
	ret
;
svcur1:	sta blkflg	;enable blink
	shld blkadd
	lda blinkb
	ret
;
svcur2:	shld curpos
	lda cursrb
	ret


;
; display count terminated message
;
dspctm:	lda outflg
	inr a
	rz		;skip if input waiting
	xchg
	call indptr
	xchg
	ldax d
	inx d
;
; display string at DE, count in ACC
;
dspstr:	ora a
	rz
	push d
	push b
	mov b,a
dspst1:	ldax d
	IF KANJI
	cpi cursrc	;test if this is the cursor byte
	lda cursrb	;get byte which is under cursor
	jz dspst6	;jif cursor byte 
	ldax d		;get string byte
	cpi blinkc	;test if this is the blink byte
	lda blinkb	;get byte which is under blink
	jz dspst6	;jif blink byte
	ldax d		;get string byte
dspst6:	call knjfrs	;test if first byte of Kanji character
	lda knj1st	;get Kanji first byte flag
	ora a
	jz dspst4	;jif not 1st byte of Kanji
	mov a,b		;get remaining count
	dcr a		;decrement it
	jnz dspst4	;jif count will allow output of both Kanji bytes
	ldax d		;get string byte
	cpi cursrc	;test if this is the cursor byte
	jnz dspst7	;jif not
	mvi a,' '
	sta cursrb	;replace byte under cursor with a space
	jmp dspst4	;j to display cursor byte
dspst7:	cpi blinkc	;test if this is the blink byte
	mvi a,' '
	jnz dspst5	;jif not
	sta blinkb	;replace byte under blink with a space
dspst4:	ldax d		;get byte
dspst5:
	ENDIF
	inx d
	call dspchr
	dcr b
	jnz dspst1
	pop b
	pop d
	xra a		;clear CY
	ret
;
; display another list
;
dspanl:	xchg
	call dsptxt	;recursive
	rc		;abort
	xra a
	ret
;
; set cursor
;
setcur:	xchg
	shld mycur
	xra a
	ret
;
; set array from pointer in DE
;
sarray:	xchg
	shld carray	;save current array address
	lxi d,array
	mvi b,arrayl
	call copyhl	;make more accessable
	ret
;
; restore array from carray
;
rarray:	lhld carray	;save current array address
	lxi d,array
	xchg
	mvi b,reslen	;length to restore
	call copyhl	;make more accessable
	ret

	page
;
; call subroutine
; 
cllsub:	call clsub1	;put return address on the stack
	sta entoff
	shld macaddr
	xchg
	shld destbf
	call pntent
	shld putaddr
	call setcp	;set cursor positions
	mov h,b
	mov l,c
	shld curaddr
	xra a
	ret
;
clsub1:	push d		;routine to call
	lhld curaddr	;load registers
	mov b,h
	mov c,l
	lhld destbf
	xchg
	call restcp	;restor cursor positions, set HL = macaddr
	lda entoff
	ret		;call routine

	page
;
; display array in DE
;
dsparr:	call sarray	;set array
	call gtnlsk	;get nlskip and window
	call rarray	;restore array
	lda nlskip
	inr a
	mov c,a		;number of lines to skip + 1
	lda niskip
	mov e,a
	mvi d,0
	lhld linem
	dad d
	shld linem	;offset the line mask	
	lda outflg
	inr a
	rz		;skip if input waiting
	lhld array
	lda offset
dspar0:	dad d		;offset the array pointer
	dcr a
	jnz dspar0
	lda nlines	;number of lines
	mov b,a
	xchg
	lhld mycur
	xchg		;save cursor postion in DE, display address in HL
dspar1:	xchg
	shld mycur	;set line on screen
	xchg
	dcr c
	jnz dspar2	;jif skipping lines
	inr c		;restore
	call dspline	;display line
	lda lastln
	cmp d
	rz		;at last line
	inr d
dspar2:	push d
	xchg		;array ptr -> DE
	call lineln	;get line length into HL
	dad d		;next line
	pop d
	dcr b		;number of lines in array
	jnz dspar1
	ret

	page
;
; display line in HL
;  E = cursor column at start
;
dsplin:	push h
	push d
	push b
	lda lastcl	;last column
	sub e
	inr a
	mov b,a		;number of columns left
	xchg		;put array pointer in DE
	lhld linem	;line mask
	lda niskip	;number of items to skip
	mov c,a
	lda itempl	;number of items on line
	sub c
	mov c,a		;number of items left on line
	xra a		;don't skip any spaces to start
dspln1:	call ckroom	;another item?
	jc dspln2	;jif not enough room or end array
	ora a
	cnz dspspace	;display spaces, count in ACC
	ldax d
	cpi arraye
	lda iteml
	IF HILITE
	cnz dspln3	;display string, count in ACCIF ATEBIT
	ELSE
	jz   dspln5
	push h
	xchg
	shld karray	;save string start address
	xchg
	lda  blinkb
	sta  blinkk
	lda  cursrb
	sta  cursrk
	lxi  h,fieldl-1
	dad  d 
	mov  a,m	;get extra flag byte at end of field
	cpi  0a0h	;is this field blanked out
	jnz  dspln4	;jif not
	xchg
	lxi  d,spacek	;address field of spaces instead
	push b
	push d
	lda  iteml	;get length of displayed field
	mov b,a		;move to B
	mov c,a		;move to C
	mvi a,' '
dsplna:	stax d		;ensure that space filled field is just that
	inx d
	dcr c
	jnz dsplna
	pop d		;reload start address of space filled field
	push d
dspln0:	mov  a,m	;get string byte
	cpi  blinkc	;test if it is the blink byte
	jnz  dspln7	;jif not
	mvi  a,' ' 
	sta  blinkb	;replace byte under blink with a space
	mov  a,m	;get blink byte
	jmp  dspln8	;j to display field
dspln7:	cpi  cursrc	;test if it is the cursor byte
	jnz  dspln9	;jif not
	mvi  a,' '
	sta  cursrb	;replace byte under cursor with a space
	mov  a,m	;get cursor byte
dspln8:	stax d		;store in space field
	jmp  dspln6	;j to display field
dspln9:	inx d		;bump space field pointer
	inx h		;bump actual field pointer
	dcr b		;decrement count
	jnz dspln0	;jif not end of field
dspln6: pop d
	pop b
dspln4:	pop  h
	lda  iteml
	call dspln3	;display string, count in ACC
	lda  blinkk
	sta  blinkb
	lda  cursrk
	sta  cursrb
dspln5:	
	ENDIF
	mov a,m		;number of spaces to skip for next
	inx h
	dcr c
	jnz dspln1	;jif more items in line
dspln2:	mvi c,cr
	call cndout
	pop b
	pop d
	pop h
	ret	
;
dspln3:	call dspstr
	IF ATEBIT
	xchg
	lhld karray
	xchg
	ENDIF
pntnxt:	push h
	lhld offset
	mvi h,0
	dad d		;point next
	xchg
	pop h
	ret
;
; check for enough room in display space
;  B = number of bytes left, adjust
; ACC= number of spaces, don't change
;
ckroom:	push h
	mov l,a
	lda iteml
	add l
	mov h,a
	mov a,b
	sub h
	mov b,a
	mov a,l
	pop h
	ret

	page
;
; display number of spaces in ACC
;
dspspa:	push b
	mov b,a		;count
	mvi c,' '
dspsp1:	call cndout
	dcr b
	jnz dspsp1
	pop b
	ret



;
; conditional end list
;
cndend:	ldax d
	ora a		;set nz if end
	ret
;
; end list with clear to screen end
;
clear0:	push b
	mvi c,cr
	call cndout
	pop b
cleare:	lda outflg
	ora a
	rnz		;skip if input waiting, returning NZ to end list
	xchg		;save HL
	lhld mycur
	xchg
	lda hite
	dcr a
	cmp d
	jnc clear0	
;
; endlist
;
enlist:	ori 0FFH	;done
	ret

	page
;****************************************
;
; set nlskip (# lines to skip) & HL pointing to it
;
;****************************************

gtnlsk:	call nmlins	;get number of lines left on screen into C
	lxi h,nlskip
	mov e,m
	mvi m,0		;assume start is ok
	lda nlines	;number of lines in array
	sub c		;minus number of lines left on screen
	rz		;it fits
	rc
	mov b,a		;number of lines to final screen
	mov a,e		;old number to skip
	ora a
	jp gtnls2	;already set, see if cursor is in screen
	mov a,c		;number of lines on screen
	rar		;divide by 2, (CY is clear)
	mov c,a		;number of lines on screen to cursor
	push h		;save HL to return
	lhld curaddr	;cursor address
	call nmlinp	;get number of lines to cursor postion into ACC
	cmp c
	pop h		;set HL to return
	rc		;cursor should be at start
	rz
	cmp b
	mov m,b		;assume finale screen
	rnc
	sub c
	mov m,a		;ACC = number lines to cursor - number to screen center
	ret
;
; reset cursor position
;
gtnls2:	cmp b		;set CY if final screen would skip more lines
	jc gtnls3
	mov a,b		;extend display so don't display less than whole screen
gtnls3:	mov m,a		;restore what it was/replace with whole screen
	push h		;save pointer to nlskip
	lhld curaddr
	call nmlinp	;get number of lines to cursor
	pop h		;restore
	rc		;cursor not in array, don't do anything
	cmp m
	jc gtnls4	;cursor above screen, ACC = number of lines to cursor
	sub m		;number of lines past screen start
	sub c		;number of lines past screen end
	rc		;its fine the way it is
	inr a		;number of lines to move
	add m
gtnls4:	mov m,a
	ret

	page			
;****************************************
;
;	set niskip (# items to skip)
;
;****************************************
;
gtnisk:	lda niskip	;number of items we skip for current display window
	mov b,a
	call gtcols	;get number of columns not currently displayed into ACC
	mov d,a
	call gtlncl	;get cursor line and item # into BC
	mov b,c		;item number of cursor
	push b
	call gtcols	;get number of columns to item after cursor
	pop b
	cmp d
	jc gtnis1	;jif cursor to left of current display
	add m		;add spacing to next item
	sub d
	mov d,a		;number of columns needed at current window setting
	lhld mycur	;L = current cursor location
	lda lastcl
	sub l
	inr a		;number of columns alotted on screen for this array
	cmp d
	lda niskip	;return in ACC as well
	rnc		;it fits, nothing to do
	lxi h,niskip
	inr m
	jmp gtnisk	;try it skipping one more item
;
gtnis1:	mov a,c
	sta niskip
	ret
;
; return number of columns needed in ACC
;   B = number of items
;
gtcols:	lhld linem	;line mask
	lda iteml	;item length
	mov c,a
	xra a
	inr b
gtcol1:	dcr b
	rz
	add c		;add item length
	add m		;add spacing length
	inx h
	jmp gtcol1

	page
;
; get line number of cursor into B, column into C
;
gtlncl:	push h
	push d
	lhld curaddr
	call nmlin1	;get number of lines into B
	jc gtlin2
	mvi c,0FFH
	lda iteml
	mov e,a
	mvi d,0
gtlin1:	inr c
	call subde
	jnc gtlin1
	xra a
gtlin2:	pop d
	pop h
	ret
;
; get number of lines left on screen into C
;
nmlins:	lhld mycur	;where to put
	lda lastln
	sub h
	inr a		;number of lines on screen
	sta window	;set window size
	mov c,a
	ret
;
; get line length into HL
;
lineln:	lxi h,itempl	;point number of items per line
linel0:	mov a,m
	inx h
mult:	push d
	mov e,m
	lxi h,0
	mov d,h
linel1:	dad d
	dcr a
	jnz linel1
	pop d
	ret

	page
;
; get number of lines to position in HL into ACC
;
nmlinp:	push h
	push d
	push b
	call nmlin1
	mov a,b
	pop b
	pop d
	pop h
	ret
;
nmlin1:	xchg
	lhld array	;array start
	xchg
	call subde	;number of bytes
	rc		;cursor not in array
	xchg
	call lineln
	xchg
	mvi b,0FFH
nmlin2:	inr b
	call subde
	jnc nmlin2
	dad d
	xra a
	ret
;
; set array from pointer in BC
;
setarr:	push h
	push d
	push b
	push psw
	mov d,b
	mov e,c
	call sarray
	pop psw
	pop b
	pop d
	pop h
	ret

	page
;****************************************
;
;	misc routines
;
;****************************************

;
; get answer from operator
;  HL = pointer to:
;	message, al, default, answer list, 0
;  B  = line number
;
; return answer number in ACC
;
gtans0:	pop h		;clean stack
	pop b		;restore entry registers
	pop h		;...retry:
getans:	push h		;save message start
	push b		;line number
	mov a,b
	dcr a
	cz clears	;clear screen if line 1
	mvi c,0		;column
	call dsplay	;display message
	mov c,m		;get default
	push h
	lhld mycur
	call printc	;display default
	shld mycur	;restore cursor
	pop h
	push h		;save pointer to default
	call inputc	;get responce into ACC
	call upper	;convert to upper case
	cpi cr
	jz gtans1	;jif to use default in C
	mov c,a
	call printc	;echo responce
gtans1:	inx h
	mov a,m
	ora a
	jz gtans0	;jif end list (bad input)
	cmp c
	jnz gtans1	;jif not yet matched
	dcx h
	mov a,l
	pop h		;restore pointer to default
	sub l		;answer number
	pop b		;restore entry registers
	pop h
	ret

cmpde:	mov a,d
	cmp h
	rnz
	mov a,e
	cmp l
	ret
;
copyhl:	mov a,m
	stax d
	inx h
	inx d
	dcr b
	jnz copyhl
	ret
;
subde:	mov a,l
	sub e
	mov l,a
	mov a,h
	sbb d
	mov h,a
	ret

	IF KANJI
;
; set KNJ1ST if the byte in A is the first byte of a Kanji character
; else clear it
;
knjfrs:	push psw	;save byte in A
	call knjtst	;is byte in the Kanji range?
	jnc kjfrs1	;jif not
	lda knj1st	;get Kanji character flag,set if previous was Kanji
	xri 1		;if previous was Kanji clear flag else set it
	jmp kjfrs2	;j to store flag
kjfrs1:	xra a		;not Kanji character so clear flag
kjfrs2:	sta knj1st	;set/clear flag
	pop psw		;restore byte to A
	ret
	ENDIF
	page
;****************************************
;
;	data
;
;****************************************


ourbyt:	dw 0		;kludge to make iopack work
routin:	ds 2		;current routine address
macadd:	ds 2		;address of cursor in array
putadd:	ds 2		;where to put entry
destbf:	ds 2		;pointer to destination buffer
curadd:	ds 2		;cursor address for getdst only 
entoff:	ds 1		;offset in entry
buffln:	ds 1		;save/restore buffer length
chrnum:	ds 1		;character number for ptbuff
swflag:	ds 1		;if nz, we swapped
spacfg:	ds 1		;if nz, cursor ok at a space at end of entry
help:	ds 1		;if nz, help is disenabled
xhelp:	ds 1		;if nz, xtra help is disabled
curpos:	ds 2		;mycur to set
outflg:	ds 1		;NZ to suppress output because input is waiting
cursrb:	ds 1		;saved cursor byte
blinkb:	ds 1		;saved blink byte
curscn:	ds 2		;current screen for display
carray:	ds 2		;current array block pointer
	IF ATEBIT
karray:	ds 2		;current KANA array block pointer
blinkk: ds 1		;saved blink byte for 8 BIT CHAR SET
cursrk: ds 1		;saved cursor byte for 8 BIT CHAR SET
	ENDIF
	IF KANJI
oldhld:	dw 0		;used in PUTCHR to save two old characters
knj1st:	db 0		;set in KNJFRS if byte in A is 1st of Kanji character
knjyes:	db 0		;set in PCHAR/NCHAR to indicate that we have moved
			;over a Kanji character
	ENDIF
;
; current array parameters
;  **** must be in this order *****
;
array:	ds 2		;array start
window:	ds 1		;array window number of lines
nlskip:	ds 1		;number to lines to skip
niskip:	ds 1		;number of items to skip

reslen	equ $-array	;length to restore

nlines:	ds 1		;number of lines in array
itempl:	ds 1		;number of items per line
offset:	ds 1		;offset to next item to display in array
iteml:	ds 1		;item length
linem:	ds 2		;line mask
okchar:	ds 2		;ok control characters
lastln:	ds 1		;last line
lastcl:	ds 1		;last column

arrayl	equ $-array	;length to save

savbuf:	ds fieldl	;save entry buffer here

	IF ATEBIT
spacek: db '        '
	db '        '
	db '        '
	db '        '
	db ' '
	ENDIF

	end