title	DIRLBR - List members of library files
	name	('DIRLBR')
	maclib	base80

; Program DIRLBR

; Print members of all library files found. How to call:

;	DIRLBR {d}{u}{:}{mask} {member_mask}

; Copyright (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-20253 Hamburg
;		Tel.:+49/040 4223247

;		Version 2.2, October 1993

; Version 1.0 ??-???-?? : Initial version
; Version 2.0 ??-???-?? :
; Version 2.1 ??-???-?? :
; Version 2.2 18-Oct-93 :
; Version 2.3 16-Jul-95 : Allow masks on members

_PRG	macro
	db	'DIRLBR'
	endm

_VERS	macro
	db	'2.3 16-Jul-1995'
	endm

	ext	curdrv,usrget,usrset,prDUfn,drvnam,PhysID
	ext	filnam,SrcFil,open,dskred,rndred,scbpb
	ext	scbfun,getDU,combrk,comchr,decout,defio
	ext	getver,crlf,strcm0,string,parse,cmdarg

	entry	$memry

; ===== Constant declaration =====

MaxUsr	equ	15		; Highest user area
LBRdir	equ	32		; Length of LBR entry
active	equ	 0		; Member active state
.mem	equ	1000b		; RAM memory bit
.PagLen	equ	01ch		; Page length in SCB
.PagMod	equ	02ch		; Page mode in SCB
.File	equ	0		; Currently main file
.prfx	equ	4		; Prefix adjustment
.string	equ	9		; BDOS string function

ARGC	equ	2		; Max arguments

	dseg

$head:
	db	'(NU)LU generated .LBR file directory utility'
	db	' --- '
	_PRG
	db	' v'
	_VERS
	db	cr,lf,lf,eot
$illOS:
	db	'Requires Z80 CPU',cr,lf,eot
$illver:
	db	'Requires CP/M 3.x',cr,lf,eot
$abort:
	db	cr,lf,'*** User BREAK ***',cr,lf,eot
$illfil:
	db	'Cann''t find .LBR file',eot
$illDIR:
	db	'Illegal directory entry',eot
$empty:
	db	'.LBR file empty',eot
$illform:
	db	'.LBR file directory too short',eot
$miss:
	db	'Missing disk in drive ',eot
$scan:
	db	'Scanning for .LBR files ...',cr,lf,eot
$ready:
	db	'.LBR scan done',cr,lf,eot
$none:
	db	'No .LBR file on disk',cr,lf,eot
$indicate:
	db	'     +----------- ',eot
$blank:
	db	' -- ',eot
$imposs:
	db	'** Cannot display members',eot
$entries:
	db	', entries: ',eot
$num:
	db	'12345'
.numlen	equ	$-$num
	db	eot
$recs:
	db	' Records',eot
$Found:
	db	':: ',eot
$SQ:
	db	'   Squeezed file (?), use USQ',eot
$CR:
	db	'   Crunched file (?), use UNCR',eot
$CRL:
	db	'   Crunched file (?), use UNCRLZH',eot
$???:
	db	'   Unknown type',eot
MEM.FN:
	db	'???????????'
LBR.FCB:
	db	0,'????????L?R',0,0,0
$LBRlen	equ	$-LBR.FCB
$filnam:
	db	'duu:'		; Drive and user
	db	'FFFFFFFF.EEE'	; File name and extension
	db	eot
$more:
	db	'Press RETURN to Continue',eot
$no.more:
	db	cr,'                        ',cr,eot
ARGV:
	ds	2*ARGC
PageMode:
	ds	1
PageLen:
	ds	1
Page:
	db	0
DIRrecs:
	ds	2
ndir:
	ds	2
dirent:
	ds	2
Root:
	ds	2
memtop:
	ds	2
callusr:
	ds	1
curusr:
	db	0		; <<== Start user 0
$memry:
	ds	2		; <<== Top of memory
Found:
	db	FALSE
LBRmode:
	db	.File
Prefix:
	db	0
sector:
	ds	2
Base:
	dw	0
ThisSec:
	ds	2
PB:
	dw	0,FCB

	cseg
;
; %%%%%%%%%%%%%%%%%%%%%%%%%
; %% Start the Main part %%
; %%%%%%%%%%%%%%%%%%%%%%%%%
;
DirLBR:
	sub	a		; Verify Z80 processor
	ld	de,$illOS
	ld	c,.string
	jp	pe,BDOS
	ld	sp,(TPAtop)	; Get stack
	call	getver		; Check CP/M+
	ld	de,$illver
	jp	c,Ex..		; .. MUST be
	ld	de,$head
	call	string		; Tell what's going on
	ld	hl,($memry)
	ld	(Root),hl	; Init memory
	ld	a,.PagMod
	call	SysInfo		; Get page mode
	ld	(PageMode),a
	ld	a,.PagLen
	call	SysInfo		; Get page length
	ld	(PageLen),a
	ld	de,CCPbuf	; Point to command line
	ld	hl,ARGV		; .. arguments
	ld	b,ARGC		; .. max
	call	cmdarg		; Get line arguments
	push	af		; Sace result
	ld	hl,CCP
	dec	a
	inc	a		; Test any found
	jr	z,ARG0		; .. nope
	ld	hl,(ARGV)	; Point to library file
ARG0:
	call	getDU		; Get drive and user
	push	de
	push	bc
	call	GetLBRMask	; Get .LBR file mask
	pop	bc
	pop	de
	ld	a,b		; Get drive
	ld	b,e		; .. save status
	ld	de,LBR.FCB
	ld	(de),a
	call	PhysID		; Test drive inserted
	jr	c,MissDrv	; .. nope
	call	usrget		; Fetch user
	ld	(callusr),a
	pop	af		; Get back arguments count
	call	GetMEMmask	; .. get member mask
	ld	de,$scan
	call	string		; Tell starting
	bit	1,b		; Test user defined
	jr	z,LBRusr	; .. nope
	ld	a,c
	call	usrset		; Set requested one
	call	userLBR		; .. tell files
	jr	LBRex
LBRusr:
	ld	a,(curusr)
	call	usrset		; Set new user
	call	userLBR		; Give library files
	ld	a,(curusr)
	inc	a		; Bump user
	ld	(curusr),a
	cp	MaxUsr+1	; Test max
	jr	c,LBRusr
LBRex:
	ld	a,(callusr)
	call	usrset		; Reset user
	ld	de,$ready
	ld	a,(Found)	; Test any found
	cp	TRUE
	jr	z,Ex..
	ld	de,$none	; .. tell it
Ex..:
	call	string		; Give message
	jp	OS		; Exit
MissDrv:
	pop	af		; .. clean stack
	ld	de,$miss
	call	string		; Tell drive missing
	ld	de,LBR.FCB
	call	drvnam
	call	crlf
	jp	OS		; .. stop program
;
; !!!!!!!!!!!!!!!!!!!!!!!!!!!
; !! Execute one user area !!
; !!!!!!!!!!!!!!!!!!!!!!!!!!!
;
userLBR:
	xor	a
	ld	(SrcFil-1),a	; Set 1st access
	ld	hl,LBR.FCB
	ld	de,FCB
	ld	bc,$LBRlen
	ldir			; Init mask
	ld	de,FCB
nxtuser:
	call	SrcFil		; Search file
	ret	c		; .. none
	call	tellLBR		; Process that file
	jr	nxtuser
;
; !!!!!!!!!!!!!!!!!!!!!!!!!!
; !! Execute one LBR file !!
; !!!!!!!!!!!!!!!!!!!!!!!!!!
;
tellLBR:
	ld	a,TRUE
	ld	(Found),a	; Set flag
	ld	de,$Found
	call	string		; Tell what we got
	ld	de,FCB
	ld	hl,prDUfn
	ld	b,5+.Fname+1+.Fext
	call	FormFile	; Give file info
	ld	a,(FCBext+1)	; Tell middle character
	ld	de,$SQ
	cp	'Q'		; Test squeezed
	jr	z,NoCont
	ld	de,$CR
	cp	'Z'		; Test crunched
	jr	z,NoCont
	ld	de,$CRL
	cp	'Y'		; dto.
	jr	z,NoCont
	cp	'B'		; Test correct one
	jr	z,Cont
	ld	de,$???
NoCont:
	call	string		; Give info
	call	.crlf
	ret
Cont:
	call	open.LBR	; Open library
	push	af
	call	.crlf		; Close output
	pop	af
	call	nc,tell.member	; .. be verbose
	ret
;
; Open the library file
;
open.LBR:
	ld	a,(LBRmode)
	cp	.File		; Test file mode
	jr	nz,open.RAM	; .. no
	ld	de,FCB
	call	open		; Open file
	ld	de,$illfil
	jp	c,abort		; .. not found
	jr	rd.LBR		; .. go read
open.RAM:
	ld	hl,(sector)	; Get sector
	ld	(FCBrnd),hl
	xor	a
	ld	(FCBrnd+2),a
	ld	de,FCB
	call	rndred		; Position record
rd.LBR:
	ld	de,FCB
	call	dskred		; Read a record
	ld	de,$empty
	jr	c,abort
	ld	de,$illDIR
	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,$entries
	call	string
	call	Number		; Tell number
	ld	de,(Root)	; Init pointer
	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	dskred		; Read record
	pop	hl
	ld	de,$illform
	jr	c,abort		; .. error
	ex	de,hl
	ld	hl,DMA
	ld	bc,reclng
	jr	DIRunpack
.abort:
	pop	af		; .. fix stack level
abort:
	ex	de,hl
	ld	de,$indicate
	call	string
	ex	de,hl
	call	string		; Give error message
	scf
	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
	jr	nz,.abort	; .. error
	inc	hl
	djnz	DIR.check
	ret
;
; Tell members in LBR file
;
tell.member:
	ld	hl,0
	ld	(dirent),hl	; Clear count
tell.next:
	call	next.member	; Process next member
	ld	hl,(dirent)
	inc	hl		; Bump count
	ld	(dirent),hl
	ld	hl,(ndir)
	dec	hl		; Count down
	ld	(ndir),hl
	ld	a,l
	or	h
	jr	nz,tell.next
	ret
;
; Print next member of .LBR file
;
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,(Root)
	add	hl,de		; Get member pointer
	ld	a,(hl)
	cp	active		; Test active
	ret	nz		; .. no
	inc	hl
	push	hl
	call	isMEMsel?	; Test member selected
	pop	hl
	ret	nz		; .. nope, skip it
	ld	a,(Prefix)
	or	a
	ld	b,a
	ld	e,'.'
	call	nz,comchr	; .. give indicator
	ld	de,$indicate	; Print indicator
	call	string
	push	hl
	ex	de,hl
	ld	hl,filnam	; .. routine
	ld	b,.Fname+1+.Fext
	call	FormFile	; Give formatted file info
	ld	de,$blank
	call	string
	pop	ix
	push	ix
	ld	bc,.fname+.fext
	add	ix,bc		; Point to sector
	ld	l,(ix+0)	; Get sector
	ld	h,(ix+1)
	ld	(ThisSec),hl
	ld	de,(Base)
	add	hl,de		; Add base
	ld	(sector),hl
	ld	l,(ix+2)	; Get length
	ld	h,(ix+3)
	call	Number		; Tell number
	ld	de,$recs
	call	string
	pop	ix
	call	SubLBR		; Test sub-LBR file
;
; Give CR/LF depending on console page mode
;
.crlf:
	call	crlf		; Give new line
	call	Abort?		; Tell abort
	ld	a,(PageMode)
	or	a		; Test page mode
	ret	nz		; .. built in
	exx
	ld	hl,Page
	inc	(hl)		; Bump page
	ld	a,(PageLen)
	cp	(hl)
	exx
	ret	nz		; .. not top
	exx
	ld	(hl),0		; Clear count
	exx
	push	de
	ld	de,$more
	call	string		; Wait for more
Wt.Key:
	call	combrk
	jr	nc,Wt.Key
	cp	CtrlC		; May be abort
	jp	z,break
	cp	cr
	jr	nz,Wt.Key
	ld	de,$no.more
	call	string
	pop	de
	ret
;
; Test sub-LBR file
; ENTRY	Reg IX points to name of member file
;
SubLBR:
	ld	a,(ix+.Fname)
	cp	'L'		; Test L?R
	ret	nz
	ld	a,(ix+.Fname+2)
	cp	'R'
	ret	nz
	ld	a,(ix+.Fname+1)
	cp	'B'		; Verify LBR
	jr	z,Sub..
	ld	de,$blank
	call	string		; Tell coding not possible
	ld	de,$imposs
	call	string
	ret
Sub..:
	ld	a,(LBRmode)
	push	af		; Save state
	ld	a,not .File
	ld	(LBRmode),a	; .. change it
	ld	hl,(Root)
	push	hl		; Save current base
	ld	hl,(memtop)
	ld	(Root),hl	; Set new base
	push	hl
	ld	hl,(dirent)	; .. save environment
	push	hl
	ld	hl,(ndir)
	push	hl
	ld	a,(Prefix)
	add	a,.prfx		; Add prefix
	ld	(Prefix),a
	ld	hl,(Base)
	push	hl
	ld	hl,(ThisSec)
	ld	(Base),hl	; Set new base
	call	Cont		; .. perform member
	pop	hl
	ld	(Base),hl
	ld	a,(Prefix)
	sub	.prfx		; Fix prefix
	ld	(Prefix),a
	pop	hl
	ld	(ndir),hl	; Get back environment
	pop	hl
	ld	(dirent),hl
	pop	hl
	ld	(memtop),hl
	pop	hl
	ld	(Root),hl
	pop	af
	ld	(LBRmode),a
	ret
;
; Test member selected
; ENTRY	Reg HL points to member file name
; EXIT	Zero set if found
;
isMEMsel?:
	ld	de,MEM.FN	; Point to mask
	ld	b,.fname+.fext	; .. set length
..isMEM:
	ld	a,(de)		; Test wildcard
	cp	'?'
	jr	z,..itsMEM
	cp	(hl)		; Test match
	ret	nz		; .. nope
..itsMEM:
	inc	de
	inc	hl
	djnz	..isMEM
	ret
;
; Test abort program
;
Abort?:
	call	combrk		; Test break
	ret	nc
	cp	CtrlC		; Verify Ctrl-C
	ret	nz
break:
	ld	de,$abort
	call	string
	jp	OS		; Hard stop
;
; Output formatted number
; ENTRY	Reg HL holds number
;
Number:
	ld	de,$num
	ld	b,null
	call	decout		; Get ASCII number
	ld	de,$num
	ld	b,.numlen	; Print formatted
;
; Print formatted string
; ENTRY	Reg DE points to string
;	Reg B  holds length
;
format:
	push	de
format.loop:
	ld	a,(de)
	cp	null		; Find end
	jr	z,format.end
	inc	de
	djnz	format.loop
format.end:
	ld	e,' '
	inc	b
	dec	b
	call	nz,comchr	; Give blanks
	pop	de
	call	strcm0		; .. and string
	ret
;
; Give formatted file info
; ENTRY	Reg DE points to FCB (name or real start)
;	Reg HL holds routine to be executed
;	Reg B  holds length of format
;
FormFile:
	ld	a,(defio)
	push	af		; Save I/O flag
	ld	a,.mem
	ld	(defio),a	; Set memory
	exx
	ld	hl,FormRet
	push	hl		; .. set return
	exx
	push	hl		; Set execution address
	ld	hl,$filnam
	ret			; .. Execute
FormRet:
	ld	(hl),null	; .. close line
	pop	af
	ld	(defio),a
	ld	de,$filnam
	call	format		; Print formatted
	ret
;
; Get info from SCB
; ENTRY	Accu holds offset within SCB
; EXIT	Accu holds byte from SCB
;
SysInfo:
	ld	(scbpb),a	; .. set offset
	xor	a
	ld	(scbpb+1),a	; .. set fetch
	call	scbfun		; Get it
	ret
;
; Get LBR file mask if any
; ENTRY	Reg HL points to file string
;
GetLBRMask:
	call	GetMask		; Get mask
	ret	z		; .. no mask found
	ld	de,LBR.FCB+.fdrv
	ld	bc,.fname
	ldir			; .. unpack mask
	ret
;
; Get member file mask if any
; ENTRY	Accu holds value of 2 if member requested
;
GetMEMmask:
	dec	a		; .. count down
	dec	a
	ret	nz		; .. no mask
	ld	hl,(ARGV+2)	; Fetch pointer
	call	GetMask		; Fetch mask
	ld	de,MEM.FN
	ld	bc,.fname+.fext
	ldir			; Get mask
	ret
;
; Get file mask if any
; ENTRY	Reg HL points to file string
; EXIT	Zero set if file name empty
;	Reg HL points to name part of mask
;
GetMask:
	ld	(PB),hl
	ld	de,PB
	call	parse		; Parse file
	ld	hl,FCB+.fdrv
	ld	a,(hl)		; Fix for name defined
	cp	' '
	ret

	end	DirLBR