; mailda/asm - kjw/bqsd - version 2.00 - 01/83
;
; revised 02/23/83 - kjw
;
	SUBTTL	'<mailda/asm - SORT module>'
;
;	system data usage
;
;	+0	3 = 1 = PURGE
;		2 = 1 = FORCED sort, even if sorted now
;	+20	FF = purge duplicates, 00 = no purge
;	+21	drive # for temp files
;	+22,23	address of sort hierarchy table
;	above params passed to PMAILS/CMD for sort
;
	PAGE
;
SORT	BIT	6,(IY+0)	;data file available?
	LD	HL,MSGAC	;error text
	JP	Z,CANNOT	;can't sort nothing!
;
	LD	HL,MSGA1	;'define sort fields'
	CALL	DISPLAY		;display header
;
SORT0	CALL	CLRDATA		;clear out data buffer
;
SORT1	LD	HL,MSGA0	;clear lower video
	CALL	DISPLAY		;via display driver
	PUSH	IY		;save IY
	CALL	SHOW		;display fields
	CALL	GETINFO		;get user information
	CALL	PARAMS		;evaluate params
	POP	IY		;restore pointer
	JR	NC,SORT2	;go if no errors
	LD	HL,MSGA3	;hierarchy error!
	CALL	DISPLAY		;display error message
	CALL	INKEY		;wait for a key
	JP	C,MENU		;go on BREAK
	JR	Z,SORT1		;go if no input
	CALL	UCASE		;make upper case
	CP	'X'		;alternate BREAK?
	JP	Z,MENU		;go if yes
	JR	SORT1		;edit sort mask
;
SORT2	LD	HL,MSGA2	;'edit, begin'
	CALL	DISPLAY		;display prompt
	LD	B,1		;one key input
	CALL	GETSTR		;get from keyboard
	JP	C,MENU		;go menu on BREAK
	JR	Z,BEGINS	;begin sort default!
	CALL	UCASE		;make input upper case
	CP	'B'		;begin?
	JR	Z,BEGINS	;yes, go!
	CP	'Q'		;quit?
	JP	Z,MENU		;go if yes
	CP	'C'		;clear mask?
	JR	Z,SORT0		;yes, go!
	CP	'E'		;edit?
	JR	Z,SORT1		;yes, edit fields
	JR	SORT2		;invalid, ask again
;
;	ask if duplicates to be purged
;
BEGINS	LD	HL,MSGA5	;'purge duplicates?'
	CALL	DISPLAY		;display prompt
	LD	B,1		;one key input
	CALL	GETSTR		;from keyboard
	RES	2,(IY+0)	;set 'smart' sort
	JP	C,MENU		;go on BREAK
	JR	NZ,$+4		;go if any input
	LD	A,'N'		;load default value
	CALL	UCASE		;make upper case
	CP	'X'		;alternate BREAK?
	JP	Z,MENU		;go if yes!
	RES	3,(IY+0)	;set NO purge
	CP	'N'		;no?
	JR	Z,SORT3		;continue if NO
	CP	'Y'		;yes?
	JR	Z,SORT33	;yes, set PURGE
	CP	'F'		;forced sort?
	JR	NZ,BEGINS	;none, prompt again
	SET	2,(IY+0)	;set FORCE sort
	JR	SORT3		;continue
SORT33	SET	3,(IY+0)	;set YES purge
;
;	ask for drive for temp sort files
;
SORT3	LD	HL,MSGA4	;'drive for temp files'
	CALL	DISPLAY		;display prompt
	LD	B,1		;one key input
	CALL	GETSTR		;get from keyboard
	JP	C,MENU		;go on break
	LD	A,-1		;default global
	JR	Z,FORDRV	;force it!
	LD	A,(HL)		;else get first char
	CALL	UCASE		;make upper case
	CP	'X'		;alternate BREAK?
	JP	Z,MENU		;go if yes
	SUB	'0'		;remove ascii
	JR	C,SORT3		;go if invalid
	CP	DRIVES		;in range?
	JR	NC,SORT3	;go if out of range
;
;	init params for SORT module
;
FORDRV	LD	(IY+21),A	;save drive # for temp
	LD	HL,PASSBUF	;start of sort table
	LD	(IY+22),L	;pass to sort module
	LD	(IY+23),H
	LD	HL,PGM2		;PMAILS/CMD - sorter
	LD	BC,RUNERR	;error vector
	JP	RUNPGM		;run it!
;
	PAGE
;
;	fetch input value of string
;
VALUE	LD	C,0		;init value
VALLP	LD	A,(HL)		;get entry
	CP	' '		;done!
	RET	Z		;yes
	CP	CR		;terminator?
	RET	Z		;yes, done!
	SUB	'0'		;remove ascii
	RET	C		;go if error
	CP	10		;0-9?
	CCF			;reverse carry
	RET	C		;go if out of range
	PUSH	AF		;save char
	LD	A,C		;get subtotal
	ADD	A,A		;*2
	ADD	A,A		;*4
	ADD	A,C		;*5
	ADD	A,A		;*10
	LD	C,A		;save subtotal
	POP	AF		;restore new char
	ADD	A,C		;add to subtotal
	LD	C,A		;update subtotal
	RET	C		;go if >256
	INC	HL		;bump string pointer
	JR	VALLP		;go next digit
;
;	evaluate user input sort hierarchy
;
PARAMS	LD	HL,BUFFX	;storage buffer
	LD	DE,BUFFX+1	;start +1
	LD	BC,21		;# fields +1
	LD	(HL),-1		;set field as nil
	LDIR			;nil all fields
;
	LD	IY,BUFFX	;start field table
	XOR	A		;load zero
	LD	(PARPOS),A	;save param posit
	LD	DE,0FFFFH	;load -1
	LD	(PASSBUF),DE	;load 2 nil bytes
	LD	DE,PASSBUF	;param pass buffer
;
PARSLP	CALL	LOCPARP		;locate param @ posit
	RET	C		;go on invalid param
	JR	NZ,PARSLN	;go next if no match
	LD	A,(IX+3)	;get offset
	LD	(IY+0),A	;to table
	LD	A,(IX+2)	;get data length
	LD	(IY+1),A	;to table
	INC	IY		;bump table
	INC	IY		;2 byte entries
PARSLN	LD	A,(PARPOS)	;get param posit
	INC	A		;+1
	LD	(PARPOS),A	;update
	CP	10		;0-9?
	JR	C,PARSLP	;go for length
;
;	make sure at least one field specified
;
	LD	DE,PASSBUF+2	;start passing table
	LD	HL,BUFFX	;created order table
	LD	BC,22		;22 bytes long
	LDIR			;move it in!
	LD	A,(PASSBUF)	;get primary entry
	INC	A		;anything?
	SCF			;C = error
	RET	Z		;nope, go!
	XOR	A		;clear carry
	RET			;table created!
;
;	find matching entry
;
LOCPARP	LD	IX,TABLET	;offset table
	XOR	A		;load zero
	LD	(LOCPC),A	;init current field #
;
PARPLP	LD	HL,BUFFER	;start data field
	LD	C,(IX+3)	;offset into data
	LD	B,0		;BC = offset
	ADD	HL,BC		;HL => start
	LD	A,(HL)		;get first char
	CP	' '		;nil?
	JR	Z,PARSNX	;yes, go next entry
	LD	C,(IX+2)	;length of entry
	PUSH	DE		;save pointer
	LD	DE,STRING	;use input buffer
	PUSH	DE		;save start
	LDIR			;move field to string
	LD	A,CR		;load CR to end
	LD	(DE),A		;to buffer
	POP	HL		;HL => start
	CALL	VALUE		;fetch input value
	POP	DE		;restore pointer
	RET	C		;go if invalid
	DEC	C		;adjust 1-10 => 0-9
	SCF			;set error
	RET	M		;go if was 0
	LD	A,C		;get LSB value
	CP	10		;must be 0-9
	CCF			;reverse carry
	RET	C		;go if invalid
	CP	'$'		;compare to position!
PARPOS	EQU	$-1
	JR	NZ,PARSNX	;go if not a match
	LD	A,'$'		;get location pointer
LOCPC	EQU	$-1
	LD	(DE),A		;save field # in table
	INC	DE		;bump table
	XOR	A		;return Z, NC
	RET			;return Z for match!
;
PARSNX	LD	BC,4		;offset to next entry
	ADD	IX,BC		;BC => next
	LD	A,(LOCPC)	;get location counter
	INC	A		;+1
	LD	(LOCPC),A	;update!
	LD	A,(IX+0)	;get next entry
	OR	(IX+1)		;= 0000H terminator?
	JR	NZ,PARPLP	;go next if more
	OR	-1		;return NZ, NC
	RET			;done!
;	get information from user
;
GETINFO	LD	IX,TABLET	;top video table
	LD	IY,TABLET2	;editor vector table
;
;	special inkeyed editor
;
GETINLP	LD	E,(IX+3)	;data offset
	LD	D,BUFFER<-8	;page data
	LD	B,(IX+2)	;length of input
	LD	L,(IX+0)	;fetch lsb video
	LD	H,(IX+1)	;fetch msb video
	LD	A,EDITCUR	;editor cursor
	LD	(CURCHR),A	;save character
	CALL	KEY		;fetch key
	RET	C		;go if BREAK
	JR	Z,EDITMOD	;go if ENTER
	CP	ESCAPE		;escape key?
	RET	Z		;yes, go!
;
;	evaluate edit command
;
	LD	C,0		;init for vector
	LD	HL,TABLE2	;jump table for arrows
	CALL	GOTABLE		;go if arrow else right
;
;	not an edit key, go next entry
;
	PUSH	AF		;save key
	LD	A,CHARCUR	;character cursor
	LD	(CURCHR),A	;save it
	POP	AF		;restore key
	LD	C,0		;init count
	LD	L,(IX+0)	;fetch LSB video
	LD	H,(IX+1)	;fetch MSB video
	CALL	ONEKEY		;intercept keyboard drvr
	RET	C		;go on BREAK
	JR	ADVNX		;continue
;
EDITMOD	LD	L,(IX+0)	;get lsb video
	LD	H,(IX+1)	;msb video
	CALL	SPGET		;special $getstr
	RET	C		;go on BREAK
;
ADVNX	LD	BC,4		;offset to next entry
	JR	DISPZ		;continue
;
ADVR	INC	C		;+3 - right
ADVL	INC	C		;+2 - left
ADVD	INC	C		;+1 - down
ADVU	EQU	$		;+0 - up
;
	LD	A,C		;fetch offset
	LD	(DISPY),A	;save for load
	LD	C,(IY+0)	;fetch offset value
DISPY	EQU	$-1
	LD	B,0		;BC = table offset
	LD	IX,TABLET	;top table start
	LD	IY,TABLET2	;top arrow vectors
DISPZ	ADD	IX,BC		;IX => new location
	ADD	IY,BC		;IY => new vectors
;
;	check for completed
;
	LD	A,(IX+0)	;fetch table entry
	OR	(IX+1)		;=0000H?
	JR	NZ,GETINLP	;go if more to do
	RET
;
;	display current file data to video
;
SHOW	LD	IX,TABLET	;top video table
;
	IF	MOD2
	CALL	@VIDON		;enable video memory
	ENDIF
;
SHOWLP	LD	E,(IX+0)	;lsb video address
	LD	D,(IX+1)	;msb video address
	LD	C,(IX+2)	;length this field
	LD	L,(IX+3)	;offset into data
	LD	H,BUFFER<-8	;MSB page of data
	LD	B,0		;BC = length of field
	LDIR			;move into video memory
	LD	BC,4		;offset to next entry
	ADD	IX,BC		;IX => next entry
	LD	A,(IX+0)	;check for 0000 term
	OR	(IX+1)		;=000H?
	JR	NZ,SHOWLP	;go if more
;
	IF	MOD2
	CALL	@VIDOFF		;disable video memory
	ENDIF
;
	RET			;done!
;
;	clear out record buffer for new
;
CLRDATA	LD	HL,BUFFER	;start of data
	LD	DE,BUFFER+1	;start +1
	LD	BC,125		;data length
	LD	(HL),SPACE	;load nil data
	LDIR			;fill record
	LD	(HL),0		;clear flag 0
	LD	C,2		;2 more to do
	LDIR			;3 flag bytes (24 bits)
	RET			;temp buffer cleared
;
	SUBTTL	'<mailda/asm - text/tables>'
;
	PAGE
;
MSGA0	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFB	ETX
;
MSGA1	DEFB	SETCUR
	DEFB	12,00
	DEFB	EOF
	DEFM	'Define Sort Hierarchy'
	DEFB	ETX
;
MSGAC	DEFB	SETCUR
	DEFB	12,00
	DEFB	EOF
	DEFM	'Cannot Sort, Data '
	DEFM	'NOT AVAILABLE, (KEY):'
	DEFB	ETX
;
MSGA2	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	')B(egin Sort, (E)dit Fields, '
	DEFM	'(C)lear Mask, (Q)uit ? '
	DEFB	ETX
;
MSGA3	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'Error on Sort Hierarchy, (KEY):'
	DEFB	ETX
;
MSGA4	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'Drive for temporary sort files '
	DEFM	'(0-7) ? '
	DEFB	ETX
;
MSGA5	DEFB	SETCUR
	DEFB	14,00
	DEFB	EOF
	DEFM	'Purge Duplicates (Y/N) or '
	DEFM	'(F)orce Sort: '
	DEFB	ETX
;
;	table of locations for file data
;
;	+0,1	= video memory for field
;	+2	= length of entry
;	+3	= offset into data field
;
	IF	MOD1.OR.MOD3.OR.LDOSSVC
TABLET	DEFW	@VIDEO+192+8	;last
	DEFB	15,0
	DEFW	@VIDEO+192+32	;first
	DEFB	10,15
	DEFW	@VIDEO+256+11	;company
	DEFB	20,25
	DEFW	@VIDEO+320+12	;addr 1
	DEFB	20,45
	DEFW	@VIDEO+320+48	;addr 2
	DEFB	10,65
	DEFW	@VIDEO+384+8	;city
	DEFB	15,75
	DEFW	@VIDEO+384+33	;state
	DEFB	8,90
	DEFW	@VIDEO+384+48	;zip
	DEFB	10,98
	DEFW	@VIDEO+192+50	;data 1
	DEFB	5,108
	DEFW	@VIDEO+256+50	;data 2
	DEFB	12,113
	DEFW	0000H		;terminator
	ENDIF
;
	IF	MOD2
TABLET	DEFW	@VIDEO+240+9	;last
	DEFB	15,0
	DEFW	@VIDEO+240+36	;first
	DEFB	10,15
	DEFW	@VIDEO+320+12	;company
	DEFB	20,25
	DEFW	@VIDEO+400+13	;addr 1
	DEFB	20,45
	DEFW	@VIDEO+400+52	;addr 2
	DEFB	10,65
	DEFW	@VIDEO+480+9	;city
	DEFB	15,75
	DEFW	@VIDEO+480+37	;state
	DEFB	8,90
	DEFW	@VIDEO+480+58	;zip
	DEFB	10,98
	DEFW	@VIDEO+240+60	;data 1
	DEFB	5,108
	DEFW	@VIDEO+320+60	;data 2
	DEFB	12,113
	DEFW	0000H		;terminator
	ENDIF
;
;	lookup table for editing commands
;
;	each entry is offset for UP/DOWN/LEFT/RIGHT
;
TABLET2	DEFB	00,08,00,04	;last
	DEFB	04,08,00,32	;first
	DEFB	00,12,08,36	;company
	DEFB	08,20,12,16	;addr 1
	DEFB	36,28,12,16	;addr 2
	DEFB	12,20,20,24	;city
	DEFB	12,24,20,28	;state
	DEFB	16,28,24,28	;zip
	DEFB	32,36,04,32	;data 1
	DEFB	32,16,08,36	;data 2
	DEFB	00,00,00,00	;terminator
;
;	lookup table for screen editing arrows
;
TABLE2	DEFB	LEFT		;left arrow
	DEFW	ADVL
	DEFB	RIGHT		;right arrow
	DEFW	ADVR
	DEFB	UP		;up arrow
	DEFW	ADVU
	DEFB	DOWN		;down arrow
	DEFW	ADVD
	DEFB	ETBL		;end of table
;
