title	PRINT utility
	name	('PRINT')
	maclib	base80

; Program PRINT

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

;		Version 3.0, January 1991

; Print text files on printer. How to call:

;	PRINT {d:}file{.ext} {[options]}

; The file may be contain wildcards

; Default of d: is the current drive, default of .ext is .PRN
; or as defined by option [E]

; The following options are available :

;   C	Don't process control characters such as
;	carriage return, form feed, line feed and tab
;	DEFAULT : Process control

;   F	Print form feed prior starting printing
;	DEFAULT : No form feed inserted

;   S	Surpress first form feed
;	DEFAULT : Don't surpress form feed

;   E	Define default extension
;	Syntax : E=ext
;	DEFAULT : ext=.PRN

;   L	Set line width (Switch characters/inch)
;	Syntax : L=80, L=96 or L=136
;	DEFAULT : width=80

;   T	Truncate line on overflow (If greater width)
;	DEFAULT : Don't truncate, process next line

;   D	Delete file-list after printing
;	DEFAULT : Don't delete file-list

;   M	Set left margin in centimeters
;	Syntax : M=N, N in range 0 up to 9
;	DEFAULT : 0 centimeters

; NOTES : 1-After defining [M], option [L] may be defined
; =====     no more.

;	  2-Option [L] outputs an EPSON FX80 (escape)
;	    sequence setting character width:

;		ESC M .. switch to 96 characters
;		ESC P .. switch back to 80
;		SI    .. switch to 136 characters
;		DC2   .. switch back to 80

; The current printout may be interrupted by pushing
; the CAN key

; ===== Constants =====

;DEBUG	equ	TRUE		; Select for testing
DEBUG	equ	FALSE		; Select for normal run

dotpos	equ	3		; Dot position in file name

maxlin	equ	70		; Max lines per page

mask	equ	00000111b
bit	equ	00001000b

ctrbit	equ	00000001b
ffbit	equ	00000010b
extbit	equ	00000100b
surbit	equ	00001000b
linbit	equ	00010000b
trnbit	equ	00100000b
delbit	equ	01000000b
marbit	equ	10000000b

defwid	equ	80		; Default line count
wid96	equ	96		; Next width

si	equ	00fh		; Control 136
dc2	equ	012h		; Return to 80

; From LIB BASELIB

	ext	Fparse,open,rdbfp,delete,geteof,string,combrk
	ext	getver,comp2,tstdig,uppcon,jmptab,multip,round
	ext	crlf,tstlet,SrcFil,FilDrv,conino,condir
if DEBUG
	ext	conout
else
	ext	prnout
endif

; ===== Start of program, absolute at 0100H =====

	ld	sp,(TPAtop)	; Get new stack
	call	getver		; Test CP/M PLUS
	jr	nc,go31
	ld	de,envir
	call	string		; Tell other CP/M
	jp	OS
go31:
	ld	de,deff
	ld	hl,prnl
	ld	bc,.Fext
	ldir			; Set default buffer
	call	tstCCP		; Test CCP command line
	call	fixcom		; Test legal string
	jr	c,abort		; Break on error
	call	fixFiles	; Check files
	jr	c,abort
	call	prset		; Set printer width
;
; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
; %% The Main Processing Loop %%
; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
;
maindo:
	ld	de,FCB
	call	SrcFil		; Fetch file
	jr	c,done		; .. no more
	call	TellProc	; Tell processing
	ld	a,TRUE
	ld	(AnyFile),a	; Set processing
	ld	a,reclng
	ld	(rdbfp),a	; Init pointer
	ld	de,FCB
	call	open		; Open file
	jr	c,noop		; Aha, error
	xor	a
	ld	(errcnt),a	; Set success
	call	print		; Print file
	ld	a,(delflg)
	cp	FALSE		; Test delete flag
	ld	de,FCB
	call	nz,delete	; Delete file
	jr	maindo		; Try more
done:
	ld	a,(AnyFile)	; Test any file
	or	a
	ld	de,ready
	jr	nz,compri
	ld	de,none
	jr	compri
noop:
	call	telnof		; Tell file not found
	ld	a,(errcnt)	; Any retry ?
	inc	a
	ld	(errcnt),a
	cp	2
	jr	nz,maindo	; Try next
abort:
	ld	de,aborms
compri:
	call	string		; Tell bad error
comrst:
	call	preset		; Reset printer width
	jp	OS		; Exit
;
; %%%%%%%%%%%%%%%%%%%%
; %% The PRINT task %%
; %%%%%%%%%%%%%%%%%%%%
;
print:
	ld	de,0		; Init counter
	ld	a,(ffflag)	; Form feed requested ?
	or	a
	call	nz,form		; Do it if so
	call	mar1st		; Set left margin if here
prilop:
	call	geteof		; Get a character
	ret	c		; Test real end of file
	ld	b,a
	ld	a,(ctrlfl)	; Test control processing
	or	a
	jr	nz,prdo
	ld	a,b
	cp	cr		; Ignore carriage return
	jr	z,prilop
	cp	lf
	jr	z,nxtlin	; New line test
	cp	ff
	jr	z,ffdo		; New page test
	cp	tab
	jp	z,tabset	; New position test
	cp	' '		; Test printable
	jr	c,prdo
	inc	e		; Bump character count
	ld	a,(linfl)	; Test overflow
	inc	a
	cp	e
	jr	z,tstcr		; Aha, test truncate
prdo:
	ld	a,b		; Get character
	call	prnout		; Print
	call	tstmar		; Test margin to set
	call	tstCAN		; Test break
	jr	nc,prilop
	call	crout
	jr	comrst		; Exit program
nxtlin:				; Process line feed
	call	cllin		; Close line
	jr	prilop
cllin:
	call	pcrlf		; Close line
	ld	e,0		; Clear character count
	inc	d
	ld	a,d		; Test page full
	cp	maxlin
	call	z,form
mar1st:
	ld	a,(margin)	; Test left margin
	or	a
	call	nz,prblnk	; Ok, set it
	ret
tstcr:				; Test full line to be truncated
	ld	a,(trflag)
	cp	FALSE
	jr	z,setcr		; No, process next line
	call	cllin
tstlf:
	call	geteof		; Find real end of line
	ret	c
	cp	lf
	jr	nz,tstlf
	jr	prilop		; Next line
setcr:				; Process full line
	push	bc		; Save character
	call	cllin		; Close line
	pop	bc		; Get character
	inc	e
	jr	prdo
ffdo:				; Process form feed or full page
	ld	a,(subflg)	; Test surpressing
	cp	FALSE
	jr	z,doffpr
	ld	a,(ffmod)	; First line feed ?
	cp	TRUE
	jr	z,doffpr	; No, go on
	ld	a,TRUE
	ld	(ffmod),a	; Indicate 1st FF done
	jp	prilop
doffpr:
	call	form		; New page
	jp	prilop
form:				; Output form feed or end of file
	ld	a,ff
	call	prnout		; Do new page
	ld	de,0		; Clear line count
	ret
tabset:				; Process tabulator
	ld	a,(margin)
	ld	c,a
	ld	a,e		; Get position
	sub	c		; Fix for margin
	and	mask		; 0 .. 7
	ld	c,a
tabdo:
	ld	a,c
	and	bit		; Position found ?
	jp	nz,prilop	; Yes, try next
	ld	a,' '		; No,  blank
	call	prnout
	inc	c		; Bump counts
	inc	e
	jr	tabdo
;
; Test to set margin on no control option
; ENTRY Character in reg B
;
tstmar:
	ld	a,(ctrlfl)	; Get flag
	or	a
	ret	z		; Control, exit
	ld	a,b		; Get character
	cp	cr		; Test new line
	ret	nz
	ld	a,(margin)	; Test margin to set
	or	a
	ret	z		; No, exit
;
; Print blanks to set left margin
; ENTRY Accu holds margin count
;
prblnk:
	ld	e,a		; Set count
	push	de
bloop:
	ld	a,' '
	call	prnout		; Ok, blank it
	dec	e
	jr	nz,bloop
	pop	de
	ret
;
; Set printer to invoked state
;
prset:
	ld	a,(linfl)	; Test default
	cp	defwid
	ret	z		; Ok, keep cool fellow
	cp	wid96		; Maybe another width
	ld	a,si
	jp	nz,prnout
	ld	a,'M'		; Set switch character
compst:
	push	af		; Save entry
	ld	a,esc
	call	prnout		; Give prefix
	pop	af
	jp	prnout		; Amd the real world
;
; Set printer to initial state
;
preset:
	ld	a,(linfl)
	cp	defwid		; Test default
	ret	z
	cp	wid96		; Test next step
	ld	a,dc2		; Set return from 136
	jp	nz,prnout
	ld	a,'P'		; Set another one
	jr	compst
;
; Output carriage return/line feed to printer
;
pcrlf:
	ld	a,lf
	call	prnout
crout:
	ld	a,cr
	jp	prnout
;
; Tell file not found
;
telnof:
	ld	de,film
	call	string
	ld	de,FCB
	call	FilDrv		; Tell drive and file name
	ld	de,nof
	jp	string
;
; Test any in CCP buffer, give help if empty
; EXIT	Reg HL points to buffer start
;
tstCCP:
	ld	hl,dma		; Point to buffer
	ld	a,(hl)		; Get length
	or	a		; Test empty
	ret	nz		; .. no, OK
	ld	de,$help
	call	string		; Give help
	jp	OS		; .. bye, bye
;
; Check file mask ok
; ENTRY	Reg DE points to start of buffer
; EXIT	Carry set on error found
;
fixFiles:
	ld	(ParsePB),de	; Save buffer
	ld	de,ParsePB
	call	Fparse		; Parse for mask
	ret	c		; .. error
	dec	a		; Check dot
	jr	z,noDot		; Skip extension check
	ld	hl,FCBext
	ld	a,(hl)
	cp	' '		; Test extension
	jr	nz,noDot
	ld	de,FCBext
	ld	hl,deff
	ld	bc,.Fext
	ldir			; Get default
noDot:
	ld	a,(FCBnam)	; Test blank name
	cp	' '
	scf
	ret	z		; .. not so good
	or	a
	ret
;
; Fix possible option, exchange commas
; ENTRY	Reg HL points to buffer start
; EXIT	Reg DE points to file start
;	Carry will be set on error
;
fixcom:
	push	hl
	pop	de		; Copy pointer
	inc	de		; But fix entry for file name
	ld	b,0		; Clear count
skpblk:
	inc	hl
skpnob:
	ld	a,(hl)		; Test end found
	or	a
	ret	z		; Ok, no options
	cp	' '		; Find first non blank
	jr	z,skpblk
	cp	'['		; Test option
	jr	z,stcctr
	inc	b		; Bump count
	jr	skpblk
stcctr:
	ld	(stropt),hl	; Save start of options
	ld	(curopt),hl
	inc	b		; Test any file
	dec	b		; Must not be zero
	jr	z,errst
	ld	b,0		; Clear option bits
	ld	(hl),b		; Set end of files
	inc	hl
	ld	a,(hl)		; Fetch option
nxctr:
	ld	(curopt),hl	; Save current pointer
	call	uppcon		; Set to upper case
	call	jmptab		; Execute option set up
	dw	opttab
errst:
	ld	de,(curopt)
	inc	de
	ld	hl,quote
	ld	bc,qu.len
	ldir			; Set quote
	ld	hl,(stropt)
	ld	(hl),'['
	ex	de,hl
	call	string		; Tell bad option
	jp	abort		; Hard stop
extset:
	ld	c,extbit	; Test access possible
	call	tstac
	call	unpck		; Get extension
	jr	c,errst
	dec	hl
comctr:
	inc	hl
	ld	a,(hl)		; Test illegal end
	or	a
	jr	z,errst
	cp	']'		; Maybe legal end
	jr	nz,nxctr
	ret			; Ok, leave without error
ctrlst:
	ld	c,ctrbit
	call	tstac		; Test access
	ld	a,TRUE
	ld	(ctrlfl),a	; Set flag
	jr	comctr
tstff:
	ld	c,ffbit
	call	tstac		; Test access
	ld	a,TRUE
	ld	(ffflag),a	; Set flag
	jr	comctr
tstdel:
	ld	c,delbit
	call	tstac		; Test access possible
	ld	a,TRUE
	ld	(delflg),a	; Set flag if so
	jr	comctr
trctst:
	ld	c,trnbit
	call	tstac		; Test access possible
	ld	a,TRUE
	ld	(trflag),a	; Set flag
	jr	comctr
tstlin:
	ld	c,linbit
	call	tstac		; Test access possible
	call	unpnum		; Get number
	jr	c,errst
	ld	(linfl),a	; Set new width
	jr	comctr
surtst:
	ld	c,surbit
	call	tstac		; Test access
	ld	a,TRUE
	ld	(subflg),a	; Set bit
	jr	comctr
lmarg:
	ld	c,marbit
	call	tstac		; Test access
	call	setmar		; Set margin
	jp	c,errst
	jr	comctr
;
; Test cancel key, set carry if so
;
tstCAN:
	call	combrk		; Any key ?
	ret	nc		; No, end
	cp	can		; Test cancel
	scf
	ccf
	ret	nz
	ld	de,$break
	call	string		; Tell break
	call	conino		; Wait for key
	and	11011111b	; Make UPPER
	push	af
	call	condir		; Echo
	pop	af
	cp	'Y'
	jr	z,do.break	; Check real break
	ld	de,$no.break
	call	string
	or	a
	ret
do.break:
	ld	de,$stop
	call	string
	scf
	ret
;
; Test access possible, set bit
; ENTRY	Bit to be set in reg C
; EXIT	Carry set on error
;
tstac:
	ld	a,b		; Get bit map
	and	c		; Test bit set
	jp	nz,errst	; Error if set
	ld	a,b
	or	c		; Set bit
	ld	b,a
	or	a
	ret
;
; Test if '=' set before operand
;
tstequ:
	inc	hl
	ld	a,(hl)		; Get it
	cp	'='		; Test it
	inc	hl
	ret	z		; Ok return it
	jp	errst		; Error !
;
; Set left margin in characters
; Computation from centimeters
; Carry set on illegal codition
; Computation algorithm:
; Abbreviations	: cpi = characters/inch
; 		  cpl = characters/line
; 		   m  = margin in centimeters
; 		   c  = number of characters
; c = cpi*m/2.53 = (cpl/8)*m/2.53
; Because of non simple executable floating point
; arithmetic and the limit of the range of integers
; this results in:
; c = cpi*m*100/253 => cpl*m*50/1012
;
setmar:
	call	tstequ		; Test '='
	ld	a,(hl)		; Get digit
	call	tstdig		; Test 0 .. 9
	ret	c
	push	hl
	push	bc
	push	de
	ld	l,a		; Set number (m)
	ld	h,0		; Clear high ends
	ld	d,h
	ld	a,(linfl)	; Get width (cpl)
	ld	e,a
	call	multip
	ld	de,50
	call	multip
	ld	de,1012
	ex	de,hl
	call	round		; Get characters rounded
	ld	a,l
	ld	(margin),a	; Into margin
	pop	de
	pop	bc
	pop	hl
	ld	a,b
	or	linbit		; Stop option L
	ld	b,a
	ret
;
; Unpack an extension string
; Carry set on invalid string
;
unpck:
	call	tstequ		; Test '='
	push	bc
	push	de
	ld	de,deff
	ld	b,.Fext
unpdo:
	ld	a,(hl)
	cp	' '		; Test blank
	jr	z,unpbld	; Fill rest
	call	uppcon		; Set to upper case
	call	tstlet		; Test A .. Z
	jr	c,unper
	ld	(de),a		; Store extension
	inc	hl
	inc	de
	djnz	unpdo
unppop:
	pop	de
	pop	bc
	or	a
	ret
unpbld:
	ld	(de),a		; Set blanks
	inc	de
	djnz	unpbld
	inc	hl		; Bump main pointer
	jr	unppop		; Go end
unper:
	pop	de
	pop	bc
	scf			; Set error
	ret
;
; Find number for line width and get value
; EXIT	A holds hex value
; 	Carry set on error
;
unpnum:
	call	tstequ		; Test '='
	push	hl
	push	de
	ld	de,numtab	; Point to legal numbers
	call	trxnum		; Find it
	pop	de
	pop	hl
	ret	c		; End on error
	push	de
	push	af
	ld	a,(loc?)	; Get count
	ld	e,a
	ld	d,0
	add	hl,de
	dec	hl		; Point to end
	pop	af
	pop	de
	ret
trxnum:
	ld	a,(de)		; Test done
	or	a
	scf
	ret	z
	push	hl
	push	de
	ex	de,hl
	ld	a,(hl)		; Get count
	ld	(loc?),a
	call	comp2		; Compare
	jr	z,valfnd	; Ok, found
	pop	hl
	ld	e,(hl)
	ld	d,0
	add	hl,de		; Point to next element
	inc	hl
	inc	hl
	ex	de,hl
	pop	hl
	jr	trxnum
valfnd:
	inc	hl
	ld	a,(hl)		; Get value
	pop	de
	pop	de		; Fix stack
	or	a
	ret
;
; Tell file processing
;
TellProc:
	ld	de,proc
	call	string
	ld	de,FCB
	call	FilDrv		; Tell file
	call	crlf
	ret

if DEBUG
prnout:
	cp	' '		; Test control
	jr	nc,no.Ctrl
	cp	cr
	jr	z,no.Ctrl	; Allow CR
	cp	lf
	jr	z,no.Ctrl	; .. and LF
	push	af
	ld	a,'^'
	call	conout		; Indicate control
	pop	af
	add	a,'@'
no.Ctrl:
	call	conout
	ret
endif

	dseg

$help:
	db	'Print text files on printer. How to call:'
	db	cr,lf,lf
	db	tab,'PRINT {d:}file{.ext} {[options]}'
	db	cr,lf,lf
	db	'The following options are available :'
	db	cr,lf,lf
	db	'C Don''t process control characters such as '
	db	'carriage return, form feed, line',cr,lf
	db	'  feed and tab',cr,lf,lf
	db	'F form feed prior starting printing',cr,lf,lf
	db	'S Surpress first form feed',cr,lf,lf
	db	'E Define default extension, Syntax : E=ext'
	db	cr,lf,lf
	db	'L Set line width (Switch characters/inch), '
	db	'syntax : L=80, L=96 or L=136',cr,lf,lf
	db	'T Truncate line on overflow (If greater '
	db	'width)',cr,lf,lf
	db	'D Delete file-list after printing',cr,lf,lf
	db	'M left margin in centimeters, syntax : M=N, '
	db	'N in range 0 up to 9',cr,lf,lf
	db	'After defining [M], option [L] may be defined'
	db	' no more.',cr,lf,lf
	db	'Option [L] outputs an EPSON FX80 (escape) '
	db	'sequence setting character width',cr,lf,eot
proc:
	db	'Processing file -> ',eot
ready:
	db	cr,lf,'Printout complete',cr,lf,eot
none:
	db	cr,lf,'No File found',cr,lf,eot
film:
	db	cr,lf,'File ',eot
nof:
	db	' not found',cr,lf,eot
aborms:
	db	cr,lf,'Parameter error, aborted',cr,lf,eot
envir:
	db	cr,lf,'Can run only with CP/M 3.x',eot
$break:
	db	'CAN detected - stop printing [Y,N] ',eot
$no.break:
	db	cr,'                                    '
	db	cr,eot
$stop:
	db	cr,lf,'Listing stopped',cr,lf,eot
;
; Option table
;
opttab:
	db	op.len
	db	'CFSDTLEM'
op.len	equ	$-opttab-1
	dw	lmarg,extset,tstlin,trctst
	dw	tstdel,surtst,tstff,ctrlst
;
; Table of existent line counts
;
numtab:
	db	2,'80',80
	db	2,'96',96
	db	3,'136',136
	db	0
quote:
	db	'?',cr,lf,eot
qu.len	equ	$-quote
prnl:
	db	'PRN'
deff:
	ds	.Fext
ParsePB:
	ds	2		; Parse input buffer
	dw	FCB		; FCB
;
; Option table (shown are selected defaults)
;
ffmod:
	db	FALSE		; Form feed option flag
ffflag:
	db	FALSE		; Form feed possible flag
delflg:
	db	FALSE		; Delete file flag
trflag:
	db	FALSE		; Truncate line flag
linfl:
	db	defwid		; Default line count
subflg:
	db	FALSE		; Surpress form feed flag
ctrlfl:
	db	FALSE		; Control processing flag
AnyFile:
	db	FALSE
margin:
	db	0		; Left margine in centimeters
stropt:
	ds	2		; Start of option
curopt:
	ds	2		; Current option pointer
errcnt:
	db	0		; Error count
loc?:
	ds	1		; Temporary save

	end