.COMMENT / MARCH 24 1989. New version of FILEDIRY. MARCH 26 1989 General
clean-up and 'ptrctl' added for Protext. JUNE  10 1989  Modified to combat
bugs caused by PROTEXT.DCT disks. JUNE 12 89 himem check added. JUNE 13 89
PRESORT.GEN incorporated. JULY 06 89 'bug' causing lock-up when filcnt = 0
cleared. Choice of drive for final sorted file added with associated prompts.
July 30 89 Bug in counting groups of six files for setting CR cleared. 
- friendly "Please Wait - " added./
;
	ld	SP,(06)		;set SP to safe value
len	equ	20
CR	equ	13
LF	equ	10
	call	cls
	ld	de,savetxt	;invite user to select drive for
	ld	c,09		;saving file
	call	05
sel_dr	ld	c,01
	call	05
	res	5,a
	sub	#40
	cp	01
	jr	z,dr_ok
	cp	02
	jr	z,dr_ok
	cp	13
	jr	z,dr_ok
	ld	e,27
	ld	c,02
	call	05
	ld	e,"D"
	ld	c,02
	call	05
	call	bel
	jr	sel_dr
dr_ok	ld	(FCB),a
	ld	ix,himem
	ld	hl,(06)
	ld	de,#180		;bring himem to 
	sbc	hl,de		;safe point
	ld	(ix),h
	inc	ix
	ld	(ix),l
start	ld	DE,buffer
	ld	(saveDE),DE
	ld	HL,text1-1
	call	print1
	call	getnam
	ld	A,(wrkspc+2)
	cp	#1B
	jp	Z,endryt
;search for matching file
srch01	ld	C,17		;make first search
	jr	srch02+2
srch02	ld	C,18
	ld	DE,skeltn
	call	05
	cp	#FF
	jp	z,start+07
	call	setMEM
setA	ld	B,05		;=(a*#20)+#80
	rlca
	djnz	setA+2
	set	7,A
xfer01	ld	H,00		;xfr filename
	ld	L,A
	inc	HL
	ld	a,(hl)
	or	a
	jr	z,srch02
	res	7,a
	cp	#60
	jr	nc,srch02
	push	BC
	ld	BC,(filcnt)
	inc	BC
	ld	(filcnt),BC
	pop	BC	
	ld	DE,(saveDE)
	ld	BC,08
	ldir
	ld	a,#20		;insert full-stop
	ld	(DE),A		;xfr filetype	
	inc	DE
	ld	BC,03
	ldir
	ld	A,#20
	ld	(DE),A
	inc	DE
	ld	HL,wrkspc+2	;xfr diskside tag to follow filename
	ld	BC,07
	ldir
	ld	(saveDE),DE
	jp	srch02
endryt	ld	DE,(saveDE)	;put character '$' at final address
	ld	A,36
	ld	(DE),A
rst7	ld	HL,(filcnt)	;routine to reset bit 7 of 1st chr.
	call	djz
	jp	z,out
	ld	DE,len
	ld	IX,buffer
rst7lp	res	7,(IX)		;loop for setting bit 7
	add	IX,DE
	dec	HL
	call	djz
	jr	NZ,rst7lp
; sort routine starts here
; len already defined
tstsgl	ld	a,(filcnt)	;check whether only one file
	cp	01
	jp	z,screen	
	push	de
	ld	de,sortxt
	ld	c,09
	call	05
	pop	de
;	
;presort starts here
presrt	ld	de,len
; outer shell starts here.

	ld	hl,(filcnt)
	ld	ix,buffer
	dec	hl
pres01	ld	c,#7F
	push	hl
	push	ix
	pop	iy
;inner shell starts here

pres02	add	iy,de		

;pres03 starts here
pres03	ld	a,(iy)
	cp	c
	jp	P,pres03+08
	ld	c,a
	
;pres03 ends here

	call	djz_1
	jr	nz,pres02

;swap if needed goes here
	push	ix
	pop	iy	; takes iy back 
pres04	ld	a,(iy)
	cp	c
	jr	z,pres05
	add	iy,de
	jr	pres04
pres05	push	ix
	ld	a,(ix)
	cp	(iy)

	jr	z,pres07
	jp	M,pres07
	ld	hl,len
pres06	ld	b,(ix)
	ld	c,(iy)
	ld	(ix),c
	ld	(iy),b
	inc	ix
	inc	iy
	call	djz_1
	jr	nz,pres06
pres07	pop	ix			;or end of swaplo if used	
;inner shell ends here
	add	ix,de
	pop	hl
	call	djz_1
	jr	z,sort
	jr	pres01

;outer shell ends here



pres08	push	ix
	pop	iy
	add	iy,de
	ret



;presort ends here

sort	ld	hl,(filcnt)	;(filecount-1 )
	dec	HL		;    -
	ld	DE,len
	ld	IX,buffer
lab01	push	HL
	push	IX
	pop	IY	;IY=IX
lab02	add	IY,DE
	ld	B,len
	push	IX
	push	IY
compar	ld	A,(IX+0)
	cp	(IY+0)
	jp	M,nxtcmp
	jp	Z,maybe
swap	ld	D,(IX+0)
	ld	E,(IY+0)
	ld	(IX+0),E
	ld	(IY+0),D
	inc	IX
	inc	IY	
	djnz	swap
nxtcmp	pop	IY	;compare next string
	pop	IX
	ld	DE,len	
	jr	srtend	
maybe	inc	IX
	inc	IY
	dec	B
	jp	compar
srtend	dec	HL
	call	djz	;16 bit equivalent of DJNZ
	jr	NZ,lab02
	pop	HL
	dec	HL
	call	djz
	jr	Z,screen	;sort completed if Z
	add	IX,DE
	jr	lab01
screen	ld	DE,crlf
	ld	c,09
	call	05
	ld	DE,vuport
	ld	c,09
	call	05
	call	cls
	ld	DE,buffer
	ld	C,09
	call	05


;fill one block with 00
fill00	ld	HL,(saveDE)
	ld	(HL),00
	ld	D,H
	ld	E,L
	inc	DE
	ld	BC,128
	ldir
;calculate how many blocks to write to file
block	ld	HL,(filcnt)
	inc	HL		;to compensate for chars in 'ptrctl'
	add	HL,BC			
mult20	add	hl,hl
	add	hl,hl
	ld	(saveHL),hl
	add	hl,hl
	add	hl,hl
	ld	bc,(saveHL)
	add	hl,bc

	ld	A,H
	add	A,A
	inc	A
	bit	7,L
	jr	Z,setCR
	inc	A
	
; short prog for double use of reg. HL in setting CRLF 
;       after every nth line

setCR	
;len already defined
	ld	IX,save_r	;save single registers
	ld	(IX+0),A
n	equ	06		;=number of strings to each CRLF
	ld	bc,n
	ld	de,(len*n)-2
	ld	hl,(filcnt)
	push	hl
	ld	hl,buffer
loop1	ex	(sp),hl		
	scf
	ccf
	sbc	hl,bc
	jr	z,label1
	jp	m,label1
	ex	(sp),hl
	add	hl,de
	ld	(hl),00
	inc	hl
	ld	(hl),13
	inc	hl
	jr	loop1
label1	inc	sp
	inc	sp
prompt	ld	hl,FCB
	ld	a,(hl)
	cp	#0D
	jr	z,file
	ld	de,pr_txt	;probably a CLS would be nice here
	ld	c,09
	call	05
	ld	c,01
	call	05
; Write to file FILEDIRY in chosen drive
;Based on article by Reg Last in APCW p20 March '89

file	LD	C,#13		;delete file if it exists
	LD	DE,FCB
	CALL	05
makFCB	LD	C,#16		;make FCB
	LD	DE,FCB
	CALL	05
prelim	ld	b,(IX+0)	;prelims to bdos 26 and 21
	ld	de,ptrctl
	ld	hl,128
set	LD	C,#1A		;set DMA transfer address
	push	hl
	push	de
	push	bc
	CALL	05
write	LD	C,#15		;write sequential
	LD	DE,FCB
	CALL	05
	pop	bc
	pop	de
	pop	hl
	ex	de,hl
	add	hl,de
	ex	de,hl
	djnz	set	
close	LD	C,#10		;close file
	ld	de,FCB
	CALL	05
	jp	out

FCB	DEFB	#00
	defm	'FILEDIRY   '
	defs	25,00
print1	push	HL
	push	DE
	push	BC
	inc	HL
	ld	a,(HL)
	cp	"$"
	jr	Z,print1+19
	ld	E,A
	ld	C,02
	push	HL
	call	05
	pop	HL
	jr	print1+03
	pop	BC
	pop	DE
	pop	HL
	ret
djz_1	dec	hl
djz	ld	a,h
	or	l
	ret
getnam	push	IX
	ld	IX,wrkspc+1
	ld	b,05
	ld	(IX+0),#20
	inc	IX
	djnz	getnam+08
	ld	C,10
	ld	DE,wrkspc
	push	IX
	push	DE
	call	05
	pop	DE
	pop	IX
	pop	IX
	ret
bel	ld	e,07
	ld	c,02
	call	05
	ret
cls	ld	DE,clstxt
	ld	C,09
	call	05
	ret
setMEM	ld	ix,himem
	ld	h,(ix)
	inc	ix
	ld	l,(ix)
	ld	de,20
	scf
	ccf
	sbc	hl,de
	ld	(ix),l
	dec	ix
	ld	(ix),h
	ret	nc
alarm	call	cls
	ld	de,almtxt
	ld	c,09
	call	05
	ld	c,01
	call	05
	jp	endryt	
clstxt	defb	27,'H',27,'E','$'
out	jp	00
text1	defb	10,10,13,
	defm	'Disktag $'
	DEFS	36
crlf	defb	10,10,13,36
vuport	defb	27,'X',32,32,61,111,36
skeltn	defb	01
	defm	"???????????"
	defs	20,00
wrkspc	defb	04
	defs	08,#20		;holds diskside details
filcnt	defw	00		;total filecount
save_r	defb	00		;save value of single register
saveDE	defw	00		;save Reg.DE
saveHL	defw	00		;save Reg.HL
saveA	defb	00
himem	defw	00		;highest point in 
				;available memory
almtxt	defs	10,LF
	defs	15,CR
	defm	"NO FURTHER MEMORY AVAILABLE. PRESS ANY KEY TO "
	defm	"COMPLETE AND EXIT$"
savetxt	defb	10,10,10,10,10,10,10,10,10,10
	defm	"            ON WHICH DRIVE DO YOU WANT THE FINAL"
	defm	" SORTED FILE SAVED ? A/B/M$"
pr_txt	defb	10,10,10,10,10,13
	defm	"INSERT THE DISC TO WHICH YOU WANT THE SORTED FILE SAVED"
	defb	10,10,10,10,13
	defm	"Press any key to continue"
	defb	10,10,10,36
sortxt	defm	"   SORTING   Please wait  "
	defb	10,10,36
ptrctl	defm	">OC15,27,48,27,69"	;printer control
	defb	13,10
buffer	defb	00efm	"   SORTING   Please wait  "