title	DELBR - Library extractor
	name	('DELBR')
	maclib	base80

; Program bases upon DELBR12.C
; Assembler version by W.Cirsovius - Initial version from 9.90

LBRdir	equ	32		; Directory entry length of LBR
active	equ	0		; Active indicator
maxrec	equ	128		; CP/M+ max multisector count
_minarg	equ	2		; Min arguments in command line
_maxarg	equ	3		; Max arguments in command line

_YES	equ	'Y'
_NO	equ	'N'
_QUIT	equ	'Q'
_REN	equ	'R'

prg	macro
	db	'DELBR'
	endm

version	macro
	prg
	db	' v3.1 02-Oct-97'
	endm

	entry	$memry

	extrn	string,crlf,fidrus,upincl,filnam,curdrv
	extrn	getver,cmdarg,parse,getdu,setdma,mulsec
	extrn	usrget,usrset,open,close,delete,getlin
	extrn	create,dskred,dskwrt,rndred,combrk
	extrn	dirmax,files,sort

;
; Get next file for processing
; EXIT	Zero set on end of files
;
GetFile:
	ld	hl,(FilCnt)	; Get count
	ld	a,l		; Test end
	or	h
	ret	z		; .. yeap
	dec	hl		; Count down
	ld	(FilCnt),hl
	ld	de,FCB+.fdrv
	ld	hl,(Fptr)	; Get file pointer
	inc	hl		; Skip user
	ld	bc,.fname+.fext
	ldir			; Unpack name
	ld	(Fptr),hl
	xor	a
	inc	a		; Set success
	ret
;
; Sample files
;
SampFiles:
	ld	de,FCBext
	ld	hl,$LBR
	call	set.ext		; Set default
	ld	a,(FCB)		; Get drive
	dec	a
	call	dirmax		; Get max files on disk
	ld	c,l		; .. unpack
	ld	b,h
	ld	de,FCB		; Get back FCB
	call	setDU		; .. select user
	ld	hl,(Heap)	; Fetch dynamic start
	call	files		; Read files
	ld	(Heap),de	; .. save new heap
	ld	de,$ILL.FIL
	jp	c,abort		; .. none found
	ld	(FilCnt),bc	; Save count
	call	sort		; Sort file
	ret
; 
; Do base file I/O checking different user areas
; ENTRY	Reg DE points to FCB, <DE>-1 holds user
; EXIT	Carry set indicates file error
;
Udelete:
	call	setDU		; Select user
	call	delete		; .. then delete
	ret
Ucreate:
	call	setDU		; Select user
	call	create		; .. then create
	ret
Uopen:
	call	setDU		; Select user
	call	open		; .. then open
	ret
Uclose:
	call	setDU		; Select user
	call	close		; .. then close
	ret
Udskred:
	call	setDU		; Select user
	call	dskred		; .. then read
	ret
Udskwrt:
	call	setDU		; Select user
	call	dskwrt		; .. then write
	ret
Urndred:
	call	setDU		; Select user
	call	rndred		; .. then write
	ret
; 
; Set user on request
; ENTRY	Reg <DE>-1 holds user
;
setDU:
	push	hl
	ld	hl,curusr
	dec	de
	ld	a,(de)		; Get user
	cp	(hl)		; .. test same
	ld	(hl),a
	call	nz,usrset
	inc	de
	pop	hl
	ret
;
; Get drive and user
; ENTRY	Reg HL points to string
; EXIT	Reg C holds user
;	Reg B holds drive
;
DU:
	call	getdu		; .. get it
	ret	nc		; .. ok
	ld	de,$INV.DU
	ret
;
; Parse file from argument
; ENTRY	Reg HL points to argument string
;	Reg DE points to FCB
;
ArgParse:
	call	f.parse		; Parse file
	ret	nc		; .. well done
	jp	abort		; .. tell error
;
; Extract member from .LBR file
;
extract:
	call	abort.check	; Test abort
	ld	de,(memtop)
	call	setdma		; Set buffer
	ld	hl,(leng)
	call	setrec		; Set multisector count
	call	do.ext		; .. real extraction
	ld	de,DMA
	call	setdma		; Set old buffer
	ld	a,1
	call	mulsec		; .. and sector count
	ret
;
; Extract ...
;
do.ext:
	ld	a,(Conf)	; Test confirmation
	or	a
	call	z,Tell.ext	; .. give info
	ld	de,memFCB
	call	Udelete		; Delete possible file
	call	Ucreate
	ld	de,$NO.DIR
	jp	c,Fabort	; .. cannot create
nxt.part:
	ld	de,FCB
	call	Udskred
	ld	hl,$RDERR
	jr	c,memb.err	; .. illegal end
	ld	de,memFCB
	call	Udskwrt		; Write records
	ld	hl,$WRTERR
	jr	c,memb.err
	ld	hl,(remrecs)
	bit	7,h		; Test remaining records
	jr	nz,end.file	; .. ready
	dec	hl
	bit	7,h
	jr	nz,end.file
	inc	hl
	call	setrec		; Set new record count
	jr	nxt.part
end.file:
	ld	de,memFCB
	call	Uclose		; Close file
	ret	nc
	ld	hl,$CLOSERR
memb.err:
	ld	de,memFCB
	call	Udelete		; Delete file
	ex	de,hl
	jp	Fabort		; Tell abort
;
; Set multi sector count
; ENTRY	Reg HL holds total sectors
;
setrec:
	ld	de,maxrec
	push	hl
	or	a
	sbc	hl,de		; Test sector length
	ld	(remrecs),hl	; Save remaining
	pop	hl
	jr	c,sec.less
	ld	l,maxrec
sec.less:
	ld	a,l
	call	mulsec		; Set multisector count
	ret
;
; Ask for extracting a file
; EXIT	Zero flag set if YES
;
ask.extract:
	ld	hl,$EXTRACT	; Ask for extraction
	ld	bc,$YES.NO
get.rsp:
	call	conFN$MS	; Give name of file and print message
	cp	_QUIT		; Test quit
	ld	de,$QUIT
	jp	z,_abort	; .. stop
	cp	_YES
	ret
;
; Ask for deletion a file
; EXIT	Accu holds response
;
ask.delete:
	ld	hl,$EXIST	; Tell file exist
	ld	bc,$Y.N.R
	jr	get.rsp		; .. get response
;
; Print file name and messages, return answer
; ENTRY	Regs HL and BC point to messages
; EXIT	Accu holds character
;
conFN$MS:
	ld	de,memFCB+.fdrv
	call	filnam		; Tell file name
	ex	de,hl
	call	string		; .. message
	ld	e,c
	ld	d,b
	call	string		; .. next
	call	upincl		; Get answer
	ret
;
; Test abort before extraction
;
abort.check:
	call	combrk		; Test key pressed
	ret	nc		; .. nope
	cp	CtrlC		; Test break
	ret	nz		; .. nope
	ld	de,$CTRLC	; .. tell abortion
	call	string
	call	upincl		; Get answer
	cp	_YES
	push	af
	ld	de,Cl$CTRLC
	call	string
	pop	af
	ret	nz		; .. no break
	ld	de,$QUIT
	jp	abort		; .. user break
;
; Tell file to be extracted
;
Tell.ext:
	ld	de,$DOEXTR
	call	string
	ld	de,memFCB+.fdrv
	call	filnam		; .. tell it
	call	crlf
	ret
;
; Get file name from library and open it
; EXIT	Carry set if file not on disk
;
create.member:
	ld	hl,(sector)
	ld	(FCBrnd),hl	; Set sector
	xor	a
	ld	(FCBrnd+2),a
	ld	de,FCB
	call	Urndred		; Position sector
	ld	de,$ILL.MEM
	jp	c,Fabort	; .. not possible
	ld	de,memFCB
	call	Uopen		; Look for member file
	ret
;
; Extract next member of .LBR file
; EXIT	Zero flag reset if member not active
;
next.member:
	ld	hl,(dirent)	; Get current pointer
	add	hl,hl		; *  2
	add	hl,hl		; *  4
	add	hl,hl		; *  8
	add	hl,hl		; * 16
	add	hl,hl		; * 32
	ld	de,(Heap)
	add	hl,de		; Get member pointer
	ld	a,(hl)
	cp	active		; Test active
	ret	nz		; .. no
	inc	hl
	ld	de,memFCB+.fdrv
	ld	bc,.fname+.fext
	ldir			; Set name and extension
	push	hl
	pop	ix
	ld	l,(ix+0)	; Get first sector
	ld	h,(ix+1)
	ld	(sector),hl
	ld	l,(ix+2)	; Get length
	ld	h,(ix+3)
	ld	(leng),hl
	xor	a
	ret
;
; Test requested file to be extracted
; EXIT	Zero set if file does match
;
check.mask:
	ld	de,FMask	; .. set mask
	ld	hl,memFCB+.fdrv
	ld	b,.fname+.fext
..check:
	ld	a,(de)
	cp	'?'		; Test wild card
	jr	z,nxt.check
	cp	(hl)		; Compare
	ret	nz		; .. not the same
nxt.check:
	inc	hl
	inc	de
	djnz	..check
	ret
;
; Check legal directory entry
; ENTRY	Reg HL points to directory entry
;	Reg B  holds  length of data to be checked
;	Accu   holds  data to be checked for
;
DIR.check:
	cp	(hl)		; Compare
	jp	nz,_abort	; .. error
	inc	hl
	djnz	DIR.check
	ret
;
; Set default extension if empty
; ENTRY	Reg DE points to extension
;	Reg HL points to default
;
set.ext:
	ld	a,(de)
	cp	' '		; Test any
	jr	z,..set.it
	cp	'?'
	ret	nz
..set.it:
	ld	bc,.fext
	ldir			; Unpack
	ret
;
; Open the library file
;
open.LBR:
	ld	de,$LBR.ACT
	call	string
	ld	de,FCB+.fdrv
	call	filnam		; .. tell active
	call	crlf
	ld	de,FCB
	call	Uopen		; Open file
	ld	de,$ILL.FIL
	jp	c,_abort	; .. not found
	ld	de,FCB
	call	Udskred		; Read a record
	ld	de,$EMPTY
	jp	c,_abort
	ld	de,$ILL.DIR
	ld	hl,DMA
	ld	b,1
	ld	a,0
	call	DIR.check	; Check legal directory
	ld	b,.fname+.fext
	ld	a,' '
	call	DIR.check
	ld	b,2
	ld	a,0
	call	DIR.check
	ld	e,(hl)		; Get number of member
	inc	hl
	ld	d,(hl)
	ld	(DIRrecs),de
	ex	de,hl
	add	hl,hl		; * 2
	add	hl,hl		; * 4
	dec	hl		; .. one for the directory
	ld	(ndir),hl
	ld	de,(Heap)
	ld	hl,DMA+LBRdir
	ld	bc,reclng-LBRdir
DIRunpack:
	ldir			; Unpack code
	ld	(memtop),de
	ld	hl,(DIRrecs)
	dec	hl
	ld	(DIRrecs),hl
	ld	a,l
	or	h		; Test more
	ret	z
	push	de
	ld	de,FCB
	call	Udskred		; Read record
	pop	hl
	ld	de,$ILL.FORM
	jp	c,_abort	; .. error
	ex	de,hl
	ld	hl,DMA
	ld	bc,reclng
	jr	DIRunpack
;
; Give message on non Z80
;
ill.cpu:
	ld	c,.string
	call	BDOS
	jp	OS
;
; #################################
; ########## START DELBR ##########
; #################################
;
DELBR:
	sub	a
	ld	de,$ILL.CPU
	jp	pe,ill.cpu	; .. need Z80
	call	getver		; Test CP/M+
	ld	de,$ILL.OS
	jp	c,abort
	ld	hl,($memry)
	ld	(Heap),hl	; Init heap
	ld	(Fptr),hl	; .. and file pointer
	ld	sp,(BDOS+1)	; Get stack
	call	usrget
	ld	(curusr),a	; Save user
	ld	(memFCB-1),a	; .. as current
	call	curdrv
	inc	a
	ld	(memFCB),a	; .. same for drive
	ld	de,CCPbuf
	ld	hl,ARGV
	ld	b,_maxarg
	call	cmdarg		; Get arguments and count
	ld	de,$HELP
	jp	c,abort		; .. invalid
	ld	(ARGC),a
	ld	hl,(ARGV)
	ld	de,FCB
	call	ArgParse	; Get environment
	ld	a,(ARGC)
	dec	a		; Test one argument only
	jr	z,OneArg
	ld	hl,(ARGV+2)
	ld	a,(hl)		; Test option
	cp	'-'
	jr	nz,memFn	; .. nope
	ld	a,(ARGC)	; Verify no file
	cp	_maxarg
	ld	de,$HELP
	jp	z,abort
	ld	ix,(ARGV+2)
	jr	..gotOpt	; .. get option
memFn:
	ld	de,memFCB
	call	ArgParse	; Get environment for mask
	ld	hl,memFCB+.fdrv
	ld	a,(hl)
	cp	' '		; Test mask
	jr	z,NoMask
	ld	de,FMask
	ld	bc,.fname+.fext
	ldir			; .. unpack mask
NoMask:
	ld	a,(ARGC)
	sub	_minarg		; Test option
	jr	z,OneArg
	ld	de,$HELP
	ld	ix,(ARGV+4)	; Get option
	ld	a,(ix+0)	; Test valid selection
	cp	'-'
	jr	nz,abort	; .. invalid
..gotOpt:
	ld	a,(ix+1)
	cp	'C'
	jr	nz,abort
	ld	a,TRUE
	ld	(Conf),a	; Set flag
OneArg:
	ld	de,$HEADER
	call	string		; Give title message
	call	SampFiles	; Sample files
	ld	(stksav),sp	; Save stack
LBR.files:
	call	GetFile		; Get next file
	jr	z,end.LBRfiles	; .. that's all
	call	proc.LBRfile	; Process file
	jr	LBR.files
_abort:
	ld	sp,(stksav)	; Get back stack
	call	string		; Give message
	call	crlf
	jr	LBR.files	; Try next
end.LBRfiles:
	ld	de,$READY
abort:
	call	string		; Tell anything
	call	crlf
	jp	OS
Fabort:
	call	string		; Tell message
	ld	de,memFCB
	call	fidrus		; Tell file
	ld	de,$ABORT
	call	string
	jp	OS
;
; Process one LBR file
;
proc.LBRfile:
	call	open.LBR	; Open library file
	ld	hl,0
	ld	(dirent),hl	; Init loop
LBR.loop:
	call	next.member	; Get next member
	jr	nz,skp.member	; .. deleted
	call	check.mask	; Test file to be extract
	jr	nz,skp.member	; .. nope
try.extract:
	call	create.member	; Create member file
	jr	c,newfile
new.answ:
	call	ask.delete	; Ask for deletion
	jr	z,do.extract	; .. yeap
	cp	_NO		; Test ignore
	jr	z,skp.member	; Yeap, skip
	cp	_REN		; Verify rename
	jr	nz,new.answ
	call	get.new.name	; Get new member file
	jr	try.extract
newfile:
	ld	a,(Conf)	; Test confirmation
	or	a
	call	nz,ask.extract	; Test extracting
do.extract:
	call	z,extract	; .. do it
skp.member:
	ld	hl,(dirent)
	inc	hl
	ld	(dirent),hl
	ld	hl,(ndir)
	dec	hl
	ld	(ndir),hl
	ld	a,l
	or	h		; Test more
	jr	nz,LBR.loop
	ret
;
; Get new name of member file
;
get.new.name:
	ld	de,$NEW.NAME
	call	string		; Tell expecting new name
	ld	de,(memtop)	; Get to of memory
	push	de
	ld	a,254
	ld	(de),a
	call	getlin		; Get name
	pop	hl
	jr	c,get.new.name	; .. not empty one
	call	crlf
	inc	hl		; Skip length
	inc	hl
	ld	de,memFCB
	call	f.parse		; Parse file
	ret	nc		; .. ok
	call	string		; Tell error
	jr	get.new.name	; Try again
;
; Parse file
; ENTRY	Reg DE points to FCB
;	Reg HL points to name of file
; EXIT	Carry set on error - Reg DE points to error message
;
f.parse:
	ld	(PB+2),de	; Save FCB pointer
	call	DU		; Get drive and user
	ret	c		; .. error
	push	bc		; .. save
	ld	(PB),hl		; Set actual string pointer
	ld	de,PB
	call	parse		; .. parse file
	pop	bc
	ld	ix,(PB+2)	; Get FCB pointer
	ld	(ix+0),b	; Set drive
	ld	(ix-1),c	; .. and user
	ld	de,$INV.PRS
	ret

	dseg

$HELP:
	version
	db	cr,lf,lf
	db	'Strip all files from a "Novosielski" archive'
	db	' with confirmation'
	db	cr,lf,lf
	db	'Usage: '
	prg
	db	' {DU:}filename(.LBR defaulted) {DU:}{mask}'
	db	' {-C}'
	db	cr,lf,lf
	db	'Mask selects files from archive, '
	db	'defaults to all'
	db	cr,lf
	db	'May select confirmation on extraction, '
	db	'defaults to no confirmation'
	db	cr,lf
	db	'LBR filename may contain wildcards for '
	db	'extracting multiple LBRs simultaneously'
	db	eot
$HEADER:
	version
	db	cr,lf,eot
$ILL.OS:
	db	'Requires CP/M PLUS (3.x)',eot
$ILL.CPU:
	db	'Requires Z80 CPU',cr,lf,eot
$READY:
	db	'.. done',eot
$INV.PRS:
	db	'Invalid file name',eot
$INV.DU:
	db	'Invalid drive or user',eot
$ILL.FIL:
	db	'Cann''t find .LBR file',eot
$ILL.MEM:
	db	'Error reading entry ',eot
$ILL.DIR:
	db	'Illegal directory entry',eot
$EMPTY:
	db	'.LBR file empty',eot
$ILL.FORM:
	db	'.LBR file directory too short',eot
$NEW.NAME:
	db	'New name: ',eot
$EXIST:
	db	' already exist - overwrite',eot
$EXTRACT:
	db	' found, extract it',eot
$YES.NO:
	db	' [Y,N,Q - Quit] ',eot
$Y.N.R:
	db	' [Y,N,Q,R - Quit,Rename] ',eot
$CTRLC:
	db	'.. found Ctrl-C, abort ? [Y,N] ',eot
Cl$CTRLC:
	db	cr,'                               ',eot
$QUIT:
	db	cr,lf,'.. quit by user',eot
$NO.DIR:
	db	'Cann''t create directory entry for ',eot
$WRTERR:
	db	'Error writing file ',eot
$CLOSERR:
	db	'Cann''t close file ',eot
$RDERR:
	db	'Illegal size of member file ',eot
$ABORT:
	db	cr,lf,'+++ ABORT',cr,lf,eot
$DOEXTR:
	db	'Extract file ',eot
$LBR.ACT:
	db	cr,lf,lf,'-->> Process .LBR file ',eot
$LBR:
	db	'LBR'
FMask:
	db	'???????????'
$memry:
	ds	2
Heap:
	ds	2
Fptr:
	ds	2
FilCnt:
	ds	2
memtop:
	ds	2
DIRrecs:
	ds	2
dirent:
	ds	2
ndir:
	ds	2
leng:
	ds	2
sector:
	ds	2
remrecs:
	ds	2
Conf:
	db	FALSE
stksav:
	ds	2
ARGV:
	ds	2*_maxarg
ARGC:
	ds	1
PB:
	dw	0,0
curusr:
	ds	1
;
	ds	1
memFCB:
	ds	FCBlen

	end	DELBR