title	Head Print Utility
	name	('HEAD')
	maclib	base80

; Program executes the UNIX-like program head - display first
; few lines of specified files
; Call it:
;		HEAD [-n] {du:}files
;
; Display the first n lines of each filename on the console.
; The default value of n is 10 lines.
;
; If more than one file is specified, the start of each file
; looks like:
;
;     ==>filename<==
;
; Copyright (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-2000 Hamburg 20
;		Voice +49 40 4223247

_VERS	macro			;; 03-dec-92
	db	'1.1'
	endm

_PRG	macro
	db	'HEAD'
	endm

	ext	strcn0,fidrus,parse,wcard,string,getver
	ext	cmdarg,srcfrst,srcnxt,open,fillin,rdbfp
	ext	combrk,getdu,usrset,decin

_FCB	equ	16

;
; Get number from string
; ENTRY	Reg HL points to number
; EXIT	Reg HL holds number
;	Carry set on conversion error or result zero
;
Numb:
	ex	de,hl
	ld	b,nul
	call	decin		; .. get number
	ret	c		; .. error
	ld	a,l		; Verify non-zero
	or	h
	ret	nz
	scf
	ret
;
; Get number from command line
; EXIT	Carry set on invalid number
;
GetNum:
	ld	hl,(ARGV)	; Get 1st argument
	ld	a,(hl)
	cp	'-'		; Test prefix
	scf
	ccf
	ret	nz		; .. no
	inc	hl
	call	Numb		; Get number
	ret	c		; .. invalid
	ld	(HdLine),hl	; Store
	ld	hl,(ARGV+2)
	ld	(ARGV),hl	; .. shift
	ret
;
; Parse a file name
; ENTRY	Reg DE holds FCB
;	Reg HL holds string
; EXIT	Carry set on invalid parse
;
ParseFile:
	push	de
	call	getdu		; .. find optional drive, user
	pop	de
	ret	c		; .. error
	ld	(DU),bc		; .. save
	ld	(PB),hl
	ld	(PB+2),de
	ld	de,PB
	call	parse		; Do the parse
	ret	c		; .. error
	ld	a,(DU)
	call	usrset		; Set user
	ld	a,(DU+1)	; Get drive
	ld	de,(PB+2)
	ld	(de),a		; .. set drive
	inc	de
	call	wcard		; Check wild card
	scf
	ccf
	ret	nz		; .. nope
	ld	a,TRUE
	ld	(Wild),a	; Set flag
	or	a
	ret
;
; Sample files
; ENTRY	Reg DE holds file mask
;	Reg HL points to data area
; EXIT	Reg BC holds file count
;	Carry set on no file found
;
GetFiles:
	ld	bc,0		; Clear count
	push	hl
	call	srcfrst		; Search for file
	pop	de
	jr	c,EndSrc	; .. that's all
GetNxt:
	push	bc
	ld	bc,_FCB-1
	ldir			; Unpack file name
	pop	bc
	inc	bc		; .. bump
	call	srcnxt
	jr	nc,GetNxt
EndSrc:
	ld	a,c
	or	b		; Test any
	ret	nz
	scf
	ret
;
; Give header
;
TellFile:
	ld	de,$LEFT
	call	strcn0		; Give signs
	ld	de,FCB
	call	fidrus		; Print drive,user and file
	ld	de,$RIGHT
	call	strcn0
	ret
;
; Print file
;
PrintFile:
	ld	a,RecLng
	ld	(rdbfp),a	; Force read
	ld	hl,(HdLine)	; Get count
PrLoop:
	ld	b,0
	ld	de,Line
	call	fillin		; Read line
	ret	c		; .. eof
	ld	de,Line+1
	call	strcn0		; .. print line
	call	IsBRK		; Tell break
	dec	hl
	ld	a,l
	or	h
	jr	nz,PrLoop
	ret
;
; Test BREAK
;
IsBRK:
	call	combrk		; Test character
	ret	nc
	cp	CtrlC		; .. maybe break
	ret	nz
	ld	de,$ABORT
	call	strcn0		; .. give up
	jp	OS

	dseg
Line:
	db	90
	ds	90+1
Wild:
	db	FALSE		; DEFAULT FLAG
PB:
	dw	0,0
ARGV:
	ds	2*2
DU:
	ds	2
HdLine:
	dw	10		; DEFAULT COUNT
$ILL.CPU:
	db	'Requires Z80 CPU',cr,lf,eot
$ILL.OS:
	db	'Requires CP/M 3.x',cr,lf,nul
$HELP:
	db	'Call it:',cr,lf
	db	tab,tab
	_PRG
	db	' [-n] {du:}files',cr,lf,lf
	db	'Display the first n lines of each filename '
	db	'on the console.',cr,lf
	db	'The default value of n is 10 lines.'
	db	cr,lf,nul
$BANNER:
	_PRG
	db	' v'
	_VERS
	db	cr,lf,nul
$INVAL:
	db	'Badly formed number',cr,lf,nul
$INVPARS:
	db	'Badly formed filename',cr,lf,nul
$NOMATCH:
	db	'No match',cr,lf,nul
$ABORT:
	db	cr,lf,' *** ABORT ***',cr,lf,lf,nul
$NOFILE:
	db	': No such file',cr,lf,nul
$LEFT:
	db	cr,lf,'==>',nul
$RIGHT:
	db	'<==',cr,lf,lf,nul
$memry::
	dw	0
SrcFile:
	ds	FCBlen

	cseg
;
; ************
; *** MAIN ***
; ************
;
HEAD:
	sub	a		; Test Z80 CPU
	jp	po,Z80ok
	ld	de,$ILL.CPU
	call	string
	jp	warm		; .. exit
Z80ok:
	call	getver		; Get OS version
	ld	de,$ILL.OS
	jr	c,EndHead
	ld	sp,(TPAtop)	; Get stack
	ld	hl,ARGV
	ld	de,DMA
	ld	b,2
	call	cmdarg		; Fetch arguments
	ld	de,$HELP
	jr	c,EndHead	; .. error
	call	GetNum		; Get linecount
	ld	de,$INVAL
	jr	c,EndHead
	ld	hl,(ARGV)
	ld	de,SrcFile
	call	ParseFile	; Parse file
	ld	de,$INVPARS
	jr	c,EndHead
	ld	hl,($memry)
	ld	de,SrcFile
	call	GetFiles	; Get files
	jr	nc,GoaHEAD	; .. ok
	ld	a,(Wild)	; Test flag
	cp	TRUE
	ld	de,$NOMATCH
	jr	z,EndHead	; Tell no match	
	ld	de,SrcFile	; Get file
	call	fidrus		; .. type
	ld	de,$NOFILE
EndHead:
	call	strcn0		; Give a message
	jp	warm		; .. exit
GoaHEAD:
	ld	de,$BANNER
	call	strcn0		; Tell a bit
	ld	a,(SrcFile)
	ld	(FCB),a		; Set drive
	ld	hl,($memry)	; Init field
Loop:
	ld	de,FCBnam
	push	bc
	ld	bc,_FCB-1
	ldir			; Unpack file
	pop	bc
	ld	de,FCB
	call	open		; Get file
	jr	c,SkpFile	; .. skip it
	push	bc
	push	hl
	ld	a,(Wild)
	or	a		; Test one file
	call	nz,TellFile	; Give header
	call	PrintFile	; .. print
	pop	hl
	pop	bc
SkpFile:
	dec	bc
	ld	a,b
	or	c		; Test end
	jr	nz,Loop
	jp	warm

	end	HEAD