;************************************************************************
;*									*
;*				 LDIR-B 				*
;*									*
;************************************************************************
;
;
VERS	EQU	22		; current version
SUBVERS	EQU	0		; modification level
;
;
; v1.00  18 Oct 87  Steven Greenberg
; Placed into the public domain by Steven G. Greenberg.
; Responsible updates encouraged, please document in history file.
;
;============================================================================
;
;	.Z80
	ASEG			; For M80, harmless to SLR
	ORG	100H
;
;
LINLEN	EQU	18		; Max # of "comment" characters
;
; --- ASCII equates ---
;
CTRLC	EQU	03H		; ^C
LF	EQU	0AH		; Linefeed
CR	EQU	0DH		; Carriage return
;
; --- CP/M address equates ---
;
DFCB	EQU	5CH		; Default file control block #1
FCB2	EQU	6CH		; Default file control block #2
DDMA	EQU	80H		; Default dma address
BDOS	EQU	0005H		; Bdos entrypoint
;
; --- BDOS function equates ---
;
CONIN	EQU	1		; Console input (single char)
CONOUT	EQU	2		; Output single char to console
PRTSTR	EQU	9		; Print string to console
CONST	EQU	11		; Get console status
OPEN	EQU	15		; Open file
CLOSE	EQU	16		; Close file
READ	EQU	20		; Read file (sequential)
SETDMA	EQU	26		; Set dma address
GSUSER	EQU	32		; Get/set user code
RDRND	EQU	33		; Read random

;----------------------------------------------------------------------------
;
ENTRY:	JP	START
	DB	'Z3ENV',1
Z3EADR:	DW	00		; Set by CPR or the Z3INS utility if Z3
;
WBFLAG:	DB	0		; Warm boot flag. Non-zero if warm boot req'd.
NLN:	DB	22		; #of lines before [more] prompt. Usually 22.
WHLLOC:	DB	3EH		; Wheel byte location. ("3EH" = 003EH).
SPARE:	DB	0		; Spare. (now used - b/m)
;
;
START:	LD	(OLDSTK),SP	; Save system stack pointer
	LD	SP,STACK	; Set to local area
	LD	HL,(Z3EADR)	; Get possible Z3 environment pointer
	LD	A,L
	OR	H
	JR	Z,NOTZ3		; If (Z3EADR) = 0000H, assume non-Z3
	LD	A,(DFCB+1)
	CP	'/'
	JR	Z,JZ2USG
	LD	A,(DFCB+13)	; Otherwise, get CCP-parsed user #
	LD	E,A		; Log in via BDOS function #32
	LD	C,GSUSER
	CALL	BDOSAV		; HL is preserved at BDOSAV
	LD	DE,29H		; Offset to wheel address in DE
	ADD	HL,DE		; Add it to environment address
	LD	E,(HL)		; LSB in E
	INC	HL		; Bump pointer
	LD	D,(HL)		; MSB in D
	LD	(WHLLOC),DE	; Poke into LDIR-B
	LD	DE,6		; Offset to CRT selection
	ADD	HL,DE		; Add it in
	LD	E,3		; D=0, so DE=0003h
	LD	A,(HL)		; Get selected CRT # in A
	OR	A		; Test for zero
	JR	Z,CRT0		; If CRT #0, just 3 bumps
	ADD	HL,DE		; Otherwise 6 bumps
CRT0:	ADD	HL,DE
	LD	A,(HL)		; Get "usable" CRT lines
	LD	(NLN),A		; Poke into LDIR-B

NOTZ3:	LD	A,(DFCB+1)	; Any argument supplied?
	CP	' '
JZ2USG:	JP	Z,GIVUSG	; If not, give usage
;
	LD	A,(BDOS+2)	; Subtract 2k+ (for CCP) from available TPA
	SUB	11		; - and save for later check
	LD	(OVFTPA),A
	LD	A,(NLN)		; Init screen line counter (decrements to 0)
	DEC	A		; Room for heading (1st screenful only)
	DEC	A
	LD	(LINCTR),A
	LD	HL,'RB'		; Last 2 letters of "LBR" (backwords)
	LD	(DFCB+10),HL	; Put at fcb+10, +11
	LD	A,'L'		; Similarly
	LD	(DFCB+9),A	; Now we have a forced "LBR" extension.
	LD	HL,FCB2+1	; Put possible user wildcard
	LD	DE,WLDFCB	; filespec into a safe buffer
	LD	BC,11
	LDIR
	LD	DE,DFCB+12	; Make sure fcb is clr except filename & drive
	LD	B,24		; # of zeroes for the rest
	XOR	A		; A zero, obviously
;
ZLP2:	LD	(DE),A		; Put those in
	INC	DE
	DJNZ	ZLP2
;
	LD	HL,NFILES
	LD	B,ZROLEN
;
ZLP3:	LD	(HL),A
	INC	HL
	DJNZ	ZLP3
;
	LD	E,DFCB		; Open the library file (D = 0)
	LD	C,OPEN
	CALL	BDOSAV
	INC	A
	JP	Z,NOSUCH	; Br to error message if no such file
;
	LD	A,(DFCB+10)	; Check if file has SYS attribute
	AND	80H
	JR	Z,NONSYS	; If not, it's OK
	LD	HL,(WHLLOC)	; Else we must check if wheel byte is set
	LD	A,(HL)		; Get the wheel byte itself
	OR	A
	JP	Z,NOSUCH	; If zero, pretend the file does not exist
;
NONSYS:	LD	C,SETDMA	; Make sure the default DMA is 80H
	LD	E,DDMA		; (D = 0)
	CALL	BDOSAV
	LD	DE,LBRNAM	; Followed by "Library File ="
	CALL	MESAGE
	LD	HL,DFCB+1	; Point to the LBR's filename
	CALL	PFNAME		; Routine types the specified filename
	CALL	BLANK1		; Otherwise print two blanks
	LD	HL,WLDFCB	; Point at wildcard
	LD	A,(HL)		; Has user specified a wildcard?
	CP	' '
	PUSH	AF		; Save flag and possible blank
	JR	Z,NOWILD	; If not, finished with display
	LD	DE,FNMSG	; Point at "( -> "
	CALL	MESAGE		; Print it (HL preserved at BDOSAV)
	CALL	PFNAME		; Type it out as filename.typ
	LD	A,')'		; Close parens
	CALL	TYPE
NOWILD:
	CALL	READ1		; Read the library's 1st record
	LD	HL,DDMA		; Point to first byte
	LD	A,(HL)		; Validity check- the directory entry for the
				; directory itself must be "active" (zero)
;
; We would normally check for eleven blank characters next (the filename area
; of the directory entry for the directory itself. We will skip this validity
; check, however, because some MS-DOS library programs actually insert the
; library's name here. Skipping the check insures compatibility.
;
	LD	L,DDMA+12	; More validity checking (H = 0):
	OR	(HL)		; The library's "index" must be zero
	INC	HL		; If index(lo) >0, lbr is corrupt
	OR	(HL)
	JP	NZ,CORUPT	; Likewise for index(hi)

	INC	HL
	LD	A,(HL)		; Get length of directory(lo)
	INC	HL
	LD	H,(HL)		; Get length of directory(hi)
	LD	L,A		; Full directory length in HL
	OR	H
	JP	Z,CORUPT	; 0-length LBR directory is corrupt
	LD	(DIRLEN),HL	; It's big enough, store it
	LD	(TOTLEN),HL

; Satisfied that the file is in fact a library, we extract the bytes
; which should contain its creation and last modification dates and
; display these for the user's edification.

	POP	AF		; If Z, A = 20H
	LD	B,17		; Breathing room, if required
BREATH:	CALL	Z,TYPE		; TYPE preserves the PSW, neat...
	DJNZ	BREATH
	CALL	BLANK2
	LD	HL,(DDMA+18)	; Get creation date of lbr file
	CALL	DATE		; Print a date if it's good
	LD	DE,CREMSG	; CRFLAG cleared--will not look for stamp
	CALL	NC,MSGDATE	; Display the result of "date"
	LD	HL,(DDMA+20)	; Get last mod date of lbr file
	CALL	DATE
	LD	DE,MODMSG	; 'Mod '
	CALL	NC,MSGDATE
NOMOD:
	CALL	CRLF		; Now do a new line

;
; Program operation: We will read the entire lbr directory into memory in one
; shot, avoiding having to go back to it later as we are reading the first
; record of various member files (should minimize head movement and maximize
; speed).  Only the 19 bytes of interest out of the 32 will be saved for each
; entry, however, and entries flagged as deleted or non-existant will be
; skipped.
;
	LD	DE,DIRBUF	; Dir data will be packed to mem starting here
	JR	SKIP1		; Jump into loop (only 3 entries first record)
;
;............................................................................
;
MAINLP:	LD	HL,DDMA+00	; 1st entry per record
	CALL	ACTIVQ		; Active?
	CALL	Z,PRCENT	; Routine copies 19 of this entry into "DIRBUF"
;
SKIP1:	LD	HL,DDMA+20H	; As above, 3 more times / sector
	CALL	ACTIVQ		; Active?
	CALL	Z,PRCENT
	LD	HL,DDMA+40H
	CALL	ACTIVQ		; Active?
	CALL	Z,PRCENT
	LD	HL,DDMA+60H
	CALL	ACTIVQ		; Active?
	CALL	Z,PRCENT
	LD	HL,(DIRLEN)
	DEC	HL
	LD	A,L
	OR	H
	JR	Z,DUNDIR	; If done reading in directory, go process
	LD	(DIRLEN),HL	; Else store length remaining
	CALL	READ1		; and read another record into DDMA
	JR	MAINLP		; Loop, w/o resetting DE
;
;----------------------------------------------------------------------------
;
; Routine to move 19 key bytes from one entry into sequential mem in "dirbuf"
; HL points to the lbr directory entry in queston, DE continues to increment
; through "dirbuf" for all entries.  CRC is skipped.
;
PRCENT:	INC	HL		; Skip flag byte. We already know its "active"
	LD	BC,15		; # of bytes to be moved
	LDIR			; (DE is incrementing through DIRBUF)
	INC	HL		; skip CRC
	INC	HL
	LD	C,4
	LDIR			; Move date fields
	LD	HL,(NFILES)	; Ok to clobber HL now (not DE!)
	INC	HL		; Increment the "# of files" counter
	LD	(NFILES),HL
	LD	(MEMCTR),HL
	LD	A,(OVFTPA)	; Be extra cautious and make sure "DE" never
	SUB	D		; - approaches the end of the TPA.
	JP	C,CORUPT	; If it does, the consider the LBR corrupt
	RET			; (actually a TPA that small is "corrupt")

;----------------------------------------------------------------------------
;
; Now we are done reading the directory information, and it is time to start
; processing, starting from the beginning of "dirbuf"
;
DUNDIR:	LD	HL,(NFILES)	; Test for no matching members!
	LD	A,L
	OR	H
	JP	Z,EMPTY		; Go home
;
DODIR:
	CALL	DOHEDG		; Type main heading
	LD	HL,DIRBUF	; Back to beg of packed data to be processed

;............................................................................
;
NAMLP:	LD	A,(LINCTR)	; Top of main loop, one loop per entry
	DEC	A
	LD	(LINCTR),A	; Keep track of lines per console screen
	CALL	CKABRT		; Check for ^C, etc. Also pauses if linctr=0
	CALL	DOCR		; In case "CKABRT" echoed extraneous chars,
				; - an extra CR so we'll write over them
	CALL	PFNAME		; Type a filename (increase HL by 11)
	CALL	BLANK2		; Type 2 blanks
	LD	E,(HL)		; Get the entry's "index" for later reference
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	(INDEX),DE	; Put 2 byte index value there for now
	LD	E,(HL)		; Get the member's file size in sectors
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	A,E		; Test for zero-length file
	OR	D
	LD	(ZERFLG),A	; Save as a flag for later
;
; The member's file size can be processed immediately, since according to
; the format it's the next thing we want to type to the screen anyway.
; The code below will take the length in records (now in DE), divide it by
; eight, convert that to BCD, and then print the remainder as the fractional
; part of the size in "k".
;
	PUSH	HL		; Save pointer and size in recs
	PUSH	DE
	EX	DE,HL		; Recs to HL
	CALL	DECOUT		; Print w/leading blanks
	LD	A,'r'		; Type an "r"
	CALL	TYPE
	POP	DE		; Restore pointer and size
	POP	HL
	XOR	A		; We'll accumulate the fractional part in here
	LD	B,3		; Set loop counter

DVLOOP:	SRL	D		; } Divide by 8, shifting remainder into A
	RR	E		; }
	RRA			; }
	DJNZ	DVLOOP
	RRA
	RRA			; A now has the remainder times 8.
	PUSH	AF		; Save that while we type the full number of k.
	PUSH	HL		; Save our pointer too.
	EX	DE,HL
	CALL	DECOUT		; Converts the # in HL to BCD and types it.
	POP	HL
	POP	AF		; Get everything back
	LD	DE,CDATVAL	; Point to cre date storage
	LD	BC,4
	LDIR			; Move cre and mod dates
	LD	(HLSAVE),HL	; Save our pointer again (B still = 0)
	LD	H,B		; Meanwhile, our "fraction" is still in A
	LD	L,A		; Use the value to select appropriate text
	LD	DE,FRACTS	; - from the 8-byte wide table "fracts"
	ADD	HL,DE
	EX	DE,HL
	CALL	MESAGE		; And output that to the console
;
; We read the first record of the file into the default dma and examine it
; to determine compression format.  This is very slightly slower than
; checking the extension first and only reading the record if the middle
; letter indicates a crunched file; it is a great deal more accurate.

	XOR	A
	LD	(CRFLAG),A	; clear flags
	LD	(SQFLAG),A
	LD	(DDMA),A	; Clear 1st byte of dma buffer (nothing read)
	LD	(OFFSET),A	; Offset to cre date is zero
	LD	A,(ZERFLG)	; Zero-length file?
	OR	A
	CALL	NZ,RDHDR	; Read the first record of the file if not
	LD	HL,DDMA		; Pt to first character of record
	LD	A,76H		; Z80 halt instruction
	CPI			; Is it there?
	JR	NZ,COREC0	; No, so we don't know the compression

	LD	A,(HL)		; Get the second character of the file
	LD	(SQFLAG),A	; save as a flag
	LD	DE,TYPE1	; "Squeezed"
	INC	A		; Indicated by 76h 0ffh series
	JR	Z,CORECT

	LD	HL,CRFLAG
	LD	DE,TYPE2	; "Crunched"
	LD	(HL),A		; save as a flag
	INC	A		; Indicated by 76h 0feh series
	JR	Z,CORECT

	LD	DE,TYPE3	; "Cr-lzh"
	LD	(HL),A		; save as a flag
	INC	A		; Indicated by 76h 0feh series
	JR	Z,CORECT

COREC0:	LD	DE,TYPE0	; In case we fall through, "Stored"
;
CORECT:	CALL	MESAGE		; Whatever it is, type it.
	CALL	BLANK2		; Type 2 blanks
;
; The "DATE" routine will, if possible, define "DAY", "MONTH", and "YEAR".
; MONTH will be pointer to a string, while the other two will contain actual
; BCD values.  Returns w/ carry set if no date can be determined.
;
	LD	HL,(CDATVAL)	; Pointer to cre date ("OFFSET"=0)
	CALL	DATE		; Perf date conversion, as described
	JR	C,NODATE	; If no date, go type "---"
	CALL	SHODATE		; Display date
	LD	A,10
	LD	(OFFSET),A	; Offset to mod date is ten
	LD	HL,(MDATVAL)	; Pointer to mod date
	CALL	DATE		; Repeat for mod date
	JR	C,NODATE1	; Just print one "---" entry
	CALL	SHODATE
	JR	DOCMT		; Go do comment field

MSGDATE:
	CALL	MESAGE
SHODATE:
	LD	A,(DAY)		; First get the day of the month
	CALL	HEXO		; Type that
	CALL	BLANK1		; Followed by one space
	LD	DE,(MONTH)	; Get pointer to month string
	CALL	MESAGE		; And type the month
	CALL	BLANK1		; Another space
	LD	A,(YEAR)	; Finally the year, BCD again
	CALL	HEXO		; Type that
	JP	BLANK2		; 2 spaces
;
NODATE:	LD	DE,DATLES	; Special "---" string for dateless files
	CALL	MESAGE
NODATE1:
	LD	DE,DATLES
	CALL	MESAGE
;
DOCMT:
	LD	A,(SQFLAG)	; Re-analyze extension
	INC	A		; 0ffh if squeezed
	JR	Z,NOBRCK	; Print original name if squeezed
	LD	A,(CRFLAG)
	INC	A		; 0ffh if crunched
	JR	NZ,DUNLIN	; If not, we are done. Go to next LBR member.
;
;............................................................................
;
; If the file is crunched, we will attempt to fill in the "comments" column.
; The first priority is to look for text contained between "[" and "]" in
; the crunched file header. Failing that, we will simply display an arrow
; followed by the original filename as extracted from the file header.
;
	LD	B,7FH		; Search for "[" or zero, whichever comes 1st
	LD	HL,DDMA
;
SRCHLP:	LD	A,(HL)
	INC	HL
	OR	A
	JR	Z,NOBRCK	; Zero means done
	CP	'['
	JR	Z,FNDBRK	; If we found it
	DJNZ	SRCHLP		; (limit search to the one record we read)
;
NOBRCK:	CALL	MAKEUP		; No comment found, so invent one, as described
	JR	DUNLIN		; Thats's all, go on to next LBR entry
;
;............................................................................
;
; A "comment" has been found so we will display it. The comment text is nearly
; always in full upper case, because it was originally entered as part of a
; command line and converted to U/C by the CCP. We will fake it by making
; the first char U/C and the rest L/C to make it look good.
;
FNDBRK:	LD	BC,LINLEN*100H+(0FFH)
;	LD	B,LINLEN	; # of characters allowed for the comment
;	LD	C,0FFH		; (used to flag the first loop)
;
COMLP:	LD	A,(HL)		; Get a char
	INC	HL
	OR	A		; If zero we are done
	JR	Z,DUNLIN
	CP	']'		; Likewise a "]" character
	JR	Z,DUNLIN
	INC	C
	CALL	NZ,LCASE	; Convert to lower case if not first loop
	AND	7FH
	CP	20H
	CALL	NC,TYPE
	DJNZ	COMLP		; Continue, but not past max #of chars allowed
;
;..............................................................................
;
DUNLIN:	CALL	CRLF		; Done with whole line; move to next LBR member
	LD	HL,(NFILES)	; Decr the #of files count to see if we're done
	DEC	HL
	LD	(NFILES),HL
	LD	A,H
	OR	L
	LD	HL,(HLSAVE)	; Before looping, restore HL (now pointing to
	JP	NZ,NAMLP	; - next packed directory entry in "dirbuf")
	LD	HL,LINCTR
	DEC	(HL)
	CALL	CKABRT
	CALL	DOCR
	LD	B,78		; print divider string
	CALL	EQUALS
	CALL	CRLF
	LD	HL,LINCTR
	DEC	(HL)
	CALL	CKABRT
EMPTY:	CALL	DOCR		; send carriage return
	LD	HL,DFCB+1
	CALL	PFNAME
	LD	(DCMASK),A	; suppress leading zeros (DECOUT)
	LD	DE,MEMMSG
	CALL	MESAGE
	LD	HL,(MEMCTR)	; get number of matching members
	LD	A,L
	OR	H		; Test for none
	PUSH	AF		; Stack result for much later
	CALL	DECOUT		; ..and print how many members
	LD	DE,MATMSG
	CALL	MESAGE
	LD	HL,(WHLLOC)
	LD	A,(HL)
	OR	A
	JR	Z,JRRSTR	; Non-wheels don't get summary
	LD	DE,CMAMSG
	CALL	MESAGE
	LD	HL,(ACTCNT)
	CALL	DECOUT
	LD	DE,ACTMSG
	CALL	MESAGE
	LD	HL,(OPNCNT)
	CALL	DECOUT
	LD	DE,OPNMSG
	CALL	MESAGE
	LD	HL,(DELCNT)
	CALL	DECOUT
	LD	DE,DELMSG
	CALL	MESAGE
	LD	HL,(TOTLEN)
	ADD	HL,HL
	ADD	HL,HL
	DEC	HL
	CALL	DECOUT
	LD	DE,TOTMSG
	CALL	MESAGE
JRRSTR:	POP	AF
	CPL			; Cheap 255 for error flag if Z
	JR	Z,SETERR	; Branch if no matching members
	JR	RSTERR		; Otherwise no error here!
;
;============================================================================
;			   Subroutines
;============================================================================
;
;____________________________________________________________________________
;
READ1:	PUSH	DE		; Seq. read next sector to DDMA. Kills BC.
	LD	DE,DFCB
	LD	C,READ
	CALL	BDOSAV
	OR	A
	JR	NZ,CORUPT	; If unexpected EOF error
	POP	DE
	RET
;
;____________________________________________________________________________
;
NOSUCH:	LD	DE,NSMSG	; Type "File not found" and exit
	CALL	MESAGE
	LD	A,10		; error code
	JR	SETERR
;
;____________________________________________________________________________
;
; Read in the 1st 128 bytes of a member file. The file's index is in "index"
;
RDHDR:	LD	HL,(INDEX)	; Get index of file
	LD	(DFCB+33),HL	; Put it in the rr field at fcb+33,34
	XOR	A
	LD	(DFCB+35),A	; Make sure this is zero
	LD	C,RDRND		; Prepare for random read
	LD	DE,DFCB
	CALL	BDOSAV		; Read first sector of the file to the ddma
	OR	A
	RET	Z
;	FALL	THROUGH 	; (if read operation failed)
;
;____________________________________________________________________________
;
CORUPT:	LD	DE,CORMSG	; Type "library file corrupt", and exit
	CALL	MESAGE
	LD	A,4		; error code
	JR	SETERR
;
;____________________________________________________________________________
;
GIVUSG:	LD	DE,USAGE	; Give usage instructions and exit
	CALL	MESAGE
	LD	HL,(Z3EADR)	; Running under Z-System?
	LD	A,H
	OR	L
	LD	DE,USAG1	; Get second part of message
	JR	NZ,GIVUS1	; Print as-is if Z-System
	INC	DE		; Else skip over 'ir'
	INC	DE
GIVUS1:	CALL	MESAGE
;	FALL	THROUGH
;
;............................................................................
;
; Set or reset ZCPR error flag.  Entry at SETERR expects error code in A.
;
RSTERR:	XOR	A		; set error code to 0 (no error)
SETERR:	LD	B,A		; store error code in B
	LD	HL,(Z3EADR)	; Running under Z-System?
	LD	A,H
	OR	L
	JR	Z,RETCCP	; No, so exit
	LD	DE,22H		; Point to message buffer address
	ADD	HL,DE
	LD	A,(HL)		; Get address of buffer to HL
	INC	HL
	LD	H,(HL)
	LD	L,A
	OR	H		; Is there an address?
	JR	Z,RETCCP	; No, no message buffer
	LD	E,6		; Yes, add error flag offset (D=0)
	ADD	HL,DE
	LD	(HL),B		; ..and store error code in flag
;	jr	RETCCP		; fall through
;
;............................................................................
;
; Terminate. Return to CCP, or do a warm boot if byte at 111H was patched.
;
RETCCP:	LD	A,(WBFLAG)
	LD	SP,(OLDSTK)	; Else a return to CCP
	OR	A
	RET	Z
	RST	0		; Do a warm boot if so dictated by flag
;
;____________________________________________________________________________
;
; Print a file's real [uncrunched] filename in lieu of a comment in the
; comments column. Only done if no "[..]" comment could be found or if file
; is squeezed.
;
MAKEUP:	LD	DE,FNMSG	; "( -> "
	CALL	MESAGE
	LD	HL,DDMA+2	; Filename area
	LD	A,(SQFLAG)	; Check for squeezed file
	INC	A
	JR	NZ,MAKUP1	; Skip this if crunched
	INC	HL		; Name field offset two bytes farther
	INC	HL		; ..in squeezed files

MAKUP1:
	LD	B,12		; Necessary?
;
MAKELP:	LD	A,(HL)
	INC	HL
	CP	10H		; Usually 00 terminates; stop at any of 16
	JR	C,DUNAME	; - obviously non-ascii bytes for future
	AND	07FH		; reset high bit
	CALL	TYPE		; - expansion of system dependent info area.
	DJNZ	MAKELP		; (also could stop 3 bytes past ".")
;
DUNAME:	LD	A,')'		; Follow with closing parenthesis
	JR	TYPE
;
;____________________________________________________________________________
;
BLANK3:	LD	A,' '		; Type 3 blanks to the console
	CALL	TYPE
;
BLANK2:	LD	A,' '		; Likewise 2 bytes
	CALL	TYPE
;
BLANK1:	LD	A,' '		; A single oarty
	JR	TYPE
;
;____________________________________________________________________________
;
DOCR:	LD	A,CR		; Type a CR to the console
	JR	TYPE		; Jump and return to caller
;
CRLF:	LD	A,CR		; Type a CR/LF sequence to the console
	CALL	TYPE
	LD	A,LF
				; fall through
;
;............................................................................
;
TYPE:	PUSH	AF		; Type the char in A; save all registers
	PUSH	BC
	PUSH	DE
	LD	E,A
	LD	C,CONOUT
	CALL	BDOSAV
	POP	DE
	POP	BC
	POP	AF
	RET
;
;____________________________________________________________________________
;
LCASE:	CP	41H		; Down-case the character in "A"
	RET	C		; "@" and below should be left alone
	CP	5BH		; "[" and above should be left alone
	RET	NC
	ADD	A,20H		; Else down-case it
	RET
;
;____________________________________________________________________________
;
MESAGE:	PUSH	BC		; Type string pointed to by DE ("$" terminated)
	LD	C,PRTSTR
	CALL	BDOSAV
	POP	BC
	RET
;
;____________________________________________________________________________
;
BDOSAV:	PUSH	BC		; Call bdos; save all regs (except A)
	PUSH	DE
	PUSH	HL
	CALL	BDOS
	POP	HL
	POP	DE
	POP	BC
	RET
;
;____________________________________________________________________________
;
; Monitor "linctr"; if zero pause and wait for another char to continue, then
; then reset "LINCRT" to the "nln" value (unless the "continue character was
; a space, in which case reset "LINCTR" to "1").  Check console input status,
; get a character if necessary.  Abort if it is one of the 6 abort characters.
; Space sets "LINCTR" to "1" at any time.  Pause on ^S, waiting for another
; character (and process it as above [except another ^S]).  That should about
; cover it.
;
CKABRT:	PUSH	AF		; Save all regs
	PUSH	BC
	PUSH	DE
	LD	A,(LINCTR)	; # of lines on current screen so far
	OR	A
	JR	NZ,NLNZ		; Br if not zero yet
	LD	A,(NLN)		; Reset the line counter in advance
	LD	(LINCTR),A
	LD	DE,MORPRM	; "[more]" prompt
	CALL	MESAGE
;
WA4CH:
;	LD	C,CONST		; Loop till we get any character
;	CALL	BDOSAV		; ** None of this is necessary because
;	OR	A		; ** CONIN waits for a character
;	JR	Z,WA4CH
	LD	C,CONIN		; Get the character
	CALL	BDOSAV
	JR	GOT1B		; Continue. Process the char also, but not ^S.
;
;............................................................................
;
NLNZ:	LD	C,CONST		; Normally, just check console status.
	CALL	BDOSAV
	OR	A
	JR	NZ,GOT1
;
RETABT:	POP	DE		; Always return from this subr from here
	POP	BC
	POP	AF
	RET
;
;..............................................................................
;
GOT1:	LD	C,CONIN		; Get the pending console character
	CALL	BDOSAV
	CP	'S'-40H		; ^S pauses
	JR	Z,WA4CH
;
GOT1B:	CP	' '		; Space sets the line counter to one
	JR	Z,SET1
;
	AND	1FH		; ^C, ^K, ^X, C, K, X, etc all abort
	CP	'C'-40H
	JR	Z,ABRT
	CP	'K'-40H
	JR	Z,ABRT
	CP	'X'-40H
	JR	NZ,RETABT	; Ignore other keys
;
ABRT:	JP	RSTERR		; Fix stack and exit direct
;				; -----------------------
SET1:	LD	A,1		; Set line counter to '1'
	LD	(LINCTR),A
	JR	RETABT
;
;____________________________________________________________________________
;
PFNAME:	LD	B,8		; Print filename spec'd by HL. Inject the "."
	CALL	FNLP

	LD	A,'.'		; Inject a "."
	CALL	TYPE
	LD	B,3		; Fall through for extension

FNLP:	LD	A,(HL)		; Types 8 filename chars
	INC	HL		; 3 filetype chars
	BIT	7,A
	JR	Z,FNLP1		; Not set, print as is

	AND	07FH
	OR	020H		; Print lowercase for char+80h
	CP	020H
	JR	NZ,FNLP1
	LD	A,'_'		; Print underline for space+80h

FNLP1:	CALL	TYPE
	DJNZ	FNLP
	RET
;
;
;____________________________________________________________________________
;
; Convert a binary number to four chars ASCII & type them, right justified.
;
DECOUT:	CALL	DIV10		; Divide orig # (in hl), by 10
	LD	A,L		; Get remainder from l, (0-9)
	PUSH	AF		; Save in reverse order retrieval later
	EX	DE,HL		; Old dividend becomes new divisor
	CALL	DIV10		; Repeat 3 more times
	LD	A,L
	PUSH	AF
	EX	DE,HL
	CALL	DIV10
	LD	A,L
	PUSH	AF
	EX	DE,HL
	CALL	DIV10
	LD	A,L
	PUSH	AF
	EX	DE,HL
	LD	B,3		; Becomes loop counter
	LD	A,(DCMASK)	; Leading Spaces?
	OR	A
	JR	NZ,NOZR
	LD	C,0EFH		; Mask to convert zeroes to blanks
;	LD	BC,3EFH
;
DECLP:	POP	AF		; Type the 4 digits, with leading 0 suppression
	OR	A		; Is it zero?
	JR	Z,LVMASK	; Lv mask set if so
NOZLP:	LD	C,0FFH		; Else cancel masking (of zeroes to blanks)
;
LVMASK:	ADD	A,'0'		; Convert to ASCII
	AND	C		; Possibly blank a zero
	CALL	TYPE		; Output the character
	DJNZ	DECLP		; Do the first 3 digits
;
LAST1:	POP	AF		; Last digit is easy. Never blank it.
	ADD	A,'0'		; Convert to ACSII
TYPEJP:	JP	TYPE		; Type it and return
;
NOZR:	POP	AF
	OR	A
	JR	NZ,NOZLP
	DJNZ	NOZR
	JR	LAST1
;
;____________________________________________________________________________
;
DIV10:	EX	DE,HL		; Divide 16 bit value in HL by 10
	LD	HL,0		; Zero the low byte
	LD	BC,-10		; We can skip the negation code
	LD	A,11H		; Iterations, 17 req. to get all the de bits
	JR	UM1
UM0:	ADC	HL,HL
;
UM1:	ADD	HL,BC		; Divide HLDE by -BC
	JR	C,UM2		; If it fits
	SBC	HL,BC		; Else restore it
	OR	A		; Make sure carry is 0
;
UM2:	RL	E		; Result bit to DE
	RL	D
	DEC	A
	JR	NZ,UM0		; Continue
	RET
;
;............................................................................
;
HEXO:	PUSH	AF		; Output the byte in A as hex (2 ascii chars)
	RRA
	RRA
	RRA
	RRA			; Get ms nyb
	CALL	NYBOUT		; Output that
	POP	AF		; Orig byte again
;
NYBOUT:	AND	0FH		; Ls nym
	OR	30H		; Embedded subr to output 1 nybble starts here
	CP	3AH		; See if dec --> ascii conv exceeds "9"
	JR	C,SKIP7		; Ok if not
	ADD	A,7		; Else add offset to to get to "A"
;
SKIP7:	JR	TYPEJP		; Type the ascii char
;
;============================================================================
;
; Convert the 2 byte date value in HL, in DRI format, to something
; usable; values returned as "date", "month", and "year"
;
DATE:	LD	A,H		; # of days since Dec 31, 1977
	OR	L		; Zero is indicative of an undated entry
	JR	Z,CHKDS		; If so, go try to get a date some other way
;
	LD	A,78H		; Init to BCD 1978
	LD	DE,365		; Amount to subtract per year (except leap)
	LD	BC,28*100H+(1)	; #of days in Feb for current year in B, 1 in C
;
YRLP:
	CALL	YRTEST
	CALL	YRTEST
	INC	B		; The following year IS a leap year
	INC	DE		; So use 366 for DE and flag B with a "29"
	CALL	YRTEST
	DEC	DE		; Put year and #of Feb days back to normal
	DEC	B
	CALL	YRTEST
	JR	YRLP		; And loop
;
;............................................................................
;
YRTEST:	AND	A		; Clear carry
	SBC	HL,DE		; Subtract 1 year
	JR	Z,GOTYR
	JR	C,GOTYR		; If carry, we've gone too far
	ADD	A,C
	DAA
	RET
;
GOTYR:	LD	(YEAR),A	; The correct year value, BCD
	POP	AF		; Balance stack for return to caller
	ADD	HL,DE		; Reverse the last subtraction with current val
	LD	A,B		; And save current Feb val for future ref
	LD	(FEB),A
	LD	BC,MONTBL	; Table of #of days/month
;
MNTHLP:	LD	A,(BC)		; Get #of days
	LD	E,A		; Put it in DE
	XOR	A		; Clears carry and makes a zero
	LD	D,A		; Now DE = E
	SBC	HL,DE		; Subtract
	JR	Z,GOTMON
	JR	C,GOTMON	; If carry, we've gone too far again
	INC	BC		; Else move ahead to the next month
	INC	BC
	INC	BC
	INC	BC
	INC	BC		; (1 byte for #of days, 4 bytes for abrev.)
	LD	A,C
	CP	LOW ENDTBL	; (table is <256 bytes, so this is OK)
	JR	NZ,MNTHLP
;
	LD	DE,INTERR	; *** this shouldn't happen? ***
	CALL	MESAGE		; (algorithm error; for debugging only)
	LD	A,4		; error code
	JP	SETERR
;
GOTMON:	ADD	HL,DE		; Once again, add back in
	INC	BC		; Meanwhile, keep pointer to month text
	LD	(MONTH),BC
	LD	A,L		; The remainder should be the day#
	CP	0AH		; Final BCD conversion
	JR	C,OKD
	LD	L,6		; We'll use 6 3x, saves a byte
	ADD	A,L
	CP	1AH
	JR	C,OKD
	ADD	A,L
	CP	2AH
	JR	C,OKD
	ADD	A,L

OKD:	LD	(DAY),A
	AND	A		; Return with clear carry
	RET			; And that's it!
;
;............................................................................
;
; Failing to find an LBR date, program will support the system-specific format
; of the CR23D program which embeds a date in the header of the crunched file
; (Recognized by "01" after filename before "00" terminating header area)
;
CHKDS:	LD	A,(CRFLAG)	; If it wasn't crunched, don't even bother
	INC	A		; 0ffh if crunched
NOTD:	SCF			; Else just set carry (means no date info)
	RET	NZ		; And return
	LD	HL,DDMA+2	; Loop to look for DateStamped file
	LD	B,13		; Loop counter
	INC	A		; Value to look for (1)
LOOP01:	CP	(HL)		; Compare, scanning forward
	INC	HL
	JR	Z,GOTIT		; Bingo!
	JR	NC,NOTD		; Must have hit the zero, N/G!
	DJNZ	LOOP01
	RET			; Return with carry set
;
GOTIT:	LD	A,(OFFSET)	; Offset to the date param we want
	ADD	A,L		; We're on Page 0, 8-bit add is OK
	LD	L,A		; Maybe advance, maybe not

	LD	A,(HL)		; Should already be pointing to year
	INC	A		; 00h in datestamp is converted to 0ffh
	JR	Z,$+3		; in header to avoid terminating header
	DEC	A		; convert 0ffh back to 00h
	LD	(YEAR),A	; Already in BCD!

	INC	HL		; Let's skip to day before month
	LD	B,(HL)		; Month in B
	INC	HL
	LD	A,(HL)		; Day in A
	INC	A		; Datestamped files may still have no
	JR	Z,$+3		; dates in them (i.e., 00 00 00)
	DEC	A
	LD	(DAY),A		; (Because that one's easy)
	LD	A,B		; Now back to the month
	INC	A
	JR	Z,$+3
	DEC	A
	CP	0AH		; Leave 00-09 the way they are
	JR	C,LVMON
	SUB	6		; (BCD to binary conversion)
;
LVMON:	LD	B,A
	ADD	A,A		; 2x val
	ADD	A,A		; 4x val
	ADD	A,B		; 5x val
	ADD	A,LOW (MONTBL-4); +1 offsets to chars, -5 since Jan is 1 not 0
	LD	L,A
	LD	H,HIGH (MONTBL-4)
	JR	NC,NCM		; Don't forget about a possible carry
	INC	H
	CCF			; Clr carry
;
NCM:	LD	(MONTH),HL	; Pointer to month text
	LD	DE,MONTBL	; Ptr to months table
	SBC	HL,DE		; Carry indicates 00h for month (no date)
	RET
;
;============================================================================
;
; Check a library directory entry before reading it into DIRBUF.  Returns Z
; if the entry is OK, NZ if it is to be skipped (wildcard matcher adapted
; and shortened from LDIRZ by Rick Conn).
;
ACTIVQ:
	LD	A,(HL)		; Must be an active member
	OR	A
	JR	Z,ACTIV
	INC	A
	JR	NZ,NOTOPN
	LD	HL,(OPNCNT)
	INC	HL
	LD	(OPNCNT),HL
	DEC	A
	RET
NOTOPN:	LD	HL,(DELCNT)
	INC	HL
	LD	(DELCNT),HL
	RET
;
ACTIV:	PUSH	DE		; Save incoming DE
	LD	DE,(ACTCNT)
	INC	DE
	LD	(ACTCNT),DE
	LD	DE,WLDFCB	; Point to user's wildcard
	LD	A,(DE)
	SUB	' '		; Is it blank?
	JR	Z,JUSTDE	; Then just return Z
;
	PUSH	HL		; Now save incoming HL
	INC	HL		; Bump to member filename
	LD	B,11		; Check 11 bytes
GETENT1:
	LD	A,(DE)		; Check for match with wildcards
	CP	'?'		; Wild match?
	JR	Z,GETENT2
	CP	(HL)		; Match?
	JR	NZ,GETE0	; Skip if not, return NZ
GETENT2:
	INC	HL		; Pt to next
	INC	DE
	DJNZ	GETENT1		; Count down until Z
GETE0:
	POP	HL
JUSTDE:
	POP	DE
	RET


;DB '============   ====-======= ========  =========  =========  =================',CR,LF,'$'

DOHEDG:	LD	DE,HEDING
	CALL	MESAGE
	LD	B,12
	CALL	EQUALS
	CALL	BLANK3
	LD	B,4
	CALL	EQUALS
	LD	A,'-'
	CALL	TYPE
	LD	B,7
	CALL	EQUALS
	CALL	BLANK1
	LD	B,8
	CALL	EQUALS
	CALL	BLANK2
	CALL	EQUAL9
	CALL	BLANK2
	CALL	EQUAL9
	CALL	BLANK2
	LD	B,LINLEN
	CALL	EQUALS
	JP	CRLF

EQUAL9:	LD	B,9
EQUALS:	LD	A,'='
EQUALL:	CALL	TYPE
	DJNZ	EQUALL
	RET

;
;............................................................................
;
MONTBL:	DB	31,'Jan$'
FEB:	DB	28,'Feb$'	; This loc is written to with a "29" sometimes
	DB	31,'Mar$'
	DB	30,'Apr$'
	DB	31,'May$'
	DB	30,'Jun$'
	DB	31,'Jul$'
	DB	31,'Aug$'
	DB	30,'Sep$'
	DB	31,'Oct$'
	DB	30,'Nov$'
	DB	31,'Dec$'
;
ENDTBL	EQU	$
;
LBRNAM:	DB	'Library: $'
INTERR:	DB	7,CR,LF,'ERR!$'
NSMSG:	DB	'Library file not found.$'
CORMSG:	DB	CR,LF,'+++Library file is corrupt+++$'
DATLES:	DB	'-- --- --  $'
MORPRM:	DB	'[more] $'
CREMSG:	DB	'Created $'
MODMSG:	DB	'Modified $'
;
FRACTS:	DB	'.00k $  '	; 0k
	DB	'.12k $  '	; 1/8k
	DB	'.25k $  '	; 1/4k
	DB	'.37k $  '	; 3/8k
	DB	'.50k $  '	; 1/2k
	DB	'.62k $  '	; 5/8k
	DB	'.75k $  '	; 3/4k
	DB	'.87k $  '	; 7/8k

TYPE0:	DB	' Stored $'	; [Method = "none"]
TYPE1:	DB	'Squeezed$'
TYPE2:	DB	'Crunched$'
TYPE3:	DB	' Cr-lzh $'
FNMSG:	DB	'(-> $'		; Precedes uncompressed filename display
MEMMSG:	DB	' members: $'
MATMSG:	DB	' matched$'
CMAMSG:	DB	', $'
ACTMSG:	DB	' active, $'
OPNMSG: DB	' free, $'
DELMSG:	DB	' deleted, $'
TOTMSG:	DB	' total$'
;
USAGE:	DB	'LDIR-B, Version '
	DB	VERS/10+'0','.',VERS MOD 10+'0',SUBVERS+'0'
	DB	'   SGG',CR,LF
;
	DB	'Syntax:',CR,LF,'   LDIR {d$'
USAG1:	DB	'ir:}lbrname {afn.typ}$'
;
HEDING:
 DB '   Name           Length     Method    Created   Modified       Comments',CR,LF,'$'

CDATVAL:
	DS	2		; Date in DRI format (# of days
MDATVAL:			; ..since 31 Dec 1977)
	DS	2
OFFSET:	DS	1		; Offset to date param in crunched files
YEAR:	DS	1		; Year in BCD
MONTH:	DS	2		; Pointer to "$" terminated month string
DAY:	DS	1		; Day of month, BCD

OLDSTK:	DS	2		; Save system stack here
DIRLEN:	DS	2		; Directory length, #of records
INDEX:	DS	2		; An RA index value to a beg of a menber file
ZERFLG:	DS	1		; 0 if zero-length member file
HLSAVE:	DS	2		; Temp storage for HL
OVFTPA:	DS	1		; To monitor program case it tries to go nuts
LINCTR:	DS	1		; Line counter for "[more]" prompt
NFILES:	DS	2		; Overall loop counter for program operation
MEMCTR:	DS	2		; entry counter for summary message
TOTLEN:	DS	2		; Storage for intial NFILES value
ACTCNT:	DS	2		; Count of active members
OPNCNT:	DS	2		; Count of open (free) members
DELCNT:	DS	2		; Count of deleted (marked) members
CRFLAG:	DS	1		; 0ffh if crunched, other values undefined
SQFLAG:	DS	1		; 0ffh if squeezed, other values undefined
DCMASK:	DS	1		; 0ffh=leading zeros suppressed
ZROLEN	EQU	$-NFILES
WLDFCB:	DS	11		; Safe storage for FCB2 filenametyp
;
	DS	128		; Stack area for program's use
;
STACK	EQU	$		; TOS
;
DIRBUF	EQU	$		; Buffer begins here

	END