.H			Copyright (c) 1996, Gary D. Campbell
NAME =PR1
$$$$ CODE=0980	--->	0FE8	[filepath [switches] [pagelist]];...
0000 H.PTR	(2)	@ End of Left Heading (set when L-Head Def'd)
0002 FILE	(9)	filename stored here, 0.
000B LINE	(1)	Used by DO.BODY
000C PAGE	(1)	Current Page Number (INIT=1)
000D HEAD	(1)	Size of Head (3)
000E BODY	(1)	Size of Body (60)
000F FOOT	(1)	Size of Foot (3)
0010 H.DEF	(80)	Heading Definition = "-?P-?7?F?1?T ?M/?D/?Y?1",0
0060 P.LIST	(80)	List of Pages to be printed (1,255)
0980 MAIN	ENTRY
0980		CALL FIX.A2
0983		SI=@P.DEF
0986		DI=@PAGE	Page(1),Head(1),Body(1),Foot(1),H.DEF
0989		$DI+=$SI+
098A		$DI+=$SI+
098B		A=$SI+
098C		DO	$DI+=A
098D			A=$SI+
098E*			A:0
0990		LOOP UNTIL EQ
0992		%H.PTR=DI
0996		$DI+=A
0997		SI=081
099A		DO	CALL GET.FILE		Returns $07C = <filepath>
099D		*	IF CY,EXIT		CY --> bad parameter syntax
099F			CALL SWITCHES		Stop Short of ; or CR
09A2			PUSH SI 		SI=@PageList/Switches
09A3			CALL PREP.FILE		DI=End of Filepath (GET.FILE)
09A6			SI=@ADVICE
09A9			CALL DSPLX
09AC			DO	CALL DO.HEAD	Print the file
09AF				CALL DSP.PAGE
09B2				CALL DO.BODY
09B5				CALL DO.FOOT
09B8				CALL END.PAGE
09BB*				BC:0
09BD			LOOP UNTIL EQ
09BF			CALL DSP.CRLF
09C2			POP SI			SI=@PageList/Switches
09C3			A=$SI+
09C4*			A:";"
09C6		*	IF EQ,LOOP		Loop if continuation ; char
09C8*			A:CR
09CA		*	IF NE,EXIT
09CC			AA=4C00 		Terminate if Done
09CF			INT 021
09D1		SI=@USAGE			Display Usage if Error
09D4		GOTO DSPLY
09D7 DEVICE:	=5		DEVICE=5 for Printer, 6 for StdOut
09D8 DEFS:	="?.SRC",0
09DE FIX.1:	=084,3,0,0	HT->Spaces, Trim WhiteSpace, Prefix 3 spaces.
09E2 P.DEF:	=1,3,60,3,"-?P-?7?F?1?T ?M/?D/?Y?1",0
09FE ADVICE:	="Printing: ",`0,@FILE,0
.PAD=10
0A10 FIX.EXT	SI=DI
0A12		$SI="." 		SI=DI=$EndOfFilename
0A15		AA=%DEFS+2		tack on ".SRC",0 (default extent)
0A18		%(SI+1)=AA
0A1B		AA=%DEFS+4
0A1E		%(SI+3)=AA
0A21+		DO	DI=DI-1 	Now, scan back for a "." before
0A22			A=$DI		finding a "\" or ":" or BeginFilename
0A24*			A:"."
0A26			IF EQ,
0A28				$SI=0	Dot found, so discard the default.
0A2B*			A:"\"
0A2D		*	IF EQ,EXIT	Else, dot not found, so exit loop.
0A2F*			A:":"
0A31		*	IF EQ,EXIT
0A33*			DI:7C
0A36		LOOP UNTIL LT
0A38		SI=@FILE-1
0A3B+		DO	DI=DI+1 	DI = Filename
0A3C+			SI=SI+1 	SI = Where to copy it
0A3D			A=$DI
0A3F			$SI=A
0A41*			A:"."		Dot = End of Filename
0A43		LOOP UNTIL EQ
0A45		$SI=0			(overwrite Dot with Zero)
0A48		RETURN
0A49+DO.NUM.1	SI=SI+1
0A4A DO.NUM	CALL WHITESPACE
0A4D+		SI=SI-1
0A4E		CALL CK.DIGIT		NC-->digit (need to process)
0A51		IF NC,
0A53			$HL=0		Set Prev Value to Zero
0A56			CALL DO.DIGIT	Process the digit; NC-->another digit
0A59		IF NC,CALL DO.DIGIT	Process 2nd digit
0A5E		IF NC,
0A60*			$HL:25		Process 3rd digit
0A63			IF EQ,		Stop short if value will be > 255.
0A65*				A:5
0A67		*	IF GT,EXIT
0A69+DO.DIGIT		SI=SI+1 	Given digit at $SI (A=binary value)
0A6A*			ASL $HL 	Update value at $HL (10xprev + A)
0A6C			A'=$HL
0A6E*			ASL $HL,2
0A71*			$HL=$HL+A'
0A73*			$HL=$HL+A
0A75 CK.DIGIT		A=$SI		Look at next Character
0A77*			A:030		if NOT digit, return CY
0A79			IF GE,		if digit, return value in A
0A7B*				A:03A
0A7D.				CY=~CY
0A7E				IF NC,
0A80*					A=A AND 0F
0A82		RETURN
.P
0A83 END.PAGE	A=$PAGE
0A86+		$PAGE=$PAGE+1
0A8A		SI=@P.LIST
0A8D*		A:$SI
0A8F		IF EQ,
0A91+			A=A+1
0A93			$SI=A
0A95*			A:$(SI+1)
0A98		*	IF LE,EXIT
0A9A			DO	AA=%(SI+2)
0A9D				%SI=AA
0A9F+				SI=SI+2
0AA1*				A:0
0AA3			LOOP UNTIL EQ
0AA5		RETURN
0AA6 DO.BODY	$LINE=0
0AAB+		DO	$LINE=$LINE+1
0AAF			SI,DS=%FILE.PTR
0AB3			DO	A=$SI
0AB5				CALL PRINT.A
0AB8				A=$SI+
0AB9*				A:LF
0ABB			LOOP UNTIL EQ
0ABD			CALL BMP.SRC.P0
0AC0		*	IF ZR,EXIT
0AC2 MORE.BODY		CALL CK.CMD
0AC5			DS=CS
0AC7		*	IF EQ,EXIT
0AC9			A=$LINE
0ACC*			A:$BODY
0AD0		LOOP UNTIL EQ
0AD2		RETURN
0AD3 USAGE:=`0,@COPYRIGHT
0AD6	=CR,LF,"USAGE:	PRINT [filepath[.SRC] [/P[nn][/D]] [pagelist]];..."
0B12	=CR,LF,`8,"A utility to print .SRC files. "
0B34	=" [] encloses an option.		  "
0B5C	=CR,LF,`8,"[];... encloses an optional rep"
0B7E	="eat using ; to separate repetitions.	  "
0BA6	=CR,LF,"pagelist is a list of pages to be print"
0BCF	="ed.  Examples:  2,4-7,12* means skip	  "
0BF7	=CR,LF,`8,"page 1, print pages 2, 4-7, 12,"
0C19	=" and all pages after 12; 3-5 means stop "
0C41	=CR,LF,`8,"printing after page 5; 1* (the "
0C63	="default) means print all pages.	  "
0C8B	=CR,LF,"/P[nn] resets page numbering for the pr"
0CB4	="eceding printfile to 1 or nn.  Page num-"
0CDC	=CR,LF,`8,"bering is continuous across all"
0CFE	=" files listed unless reset.  The default"
0D26	=CR,LF,`8,"pagelist (after the 1st) is nn*"
0D48	=" (where nn is the next unprinted page). "
0D70	=CR,LF,"/D toggles output between the Display a"
0D99	="nd the Printer.			 "
0DC0	=CR,LF,`7,@ABORT
.P
0DC5 SWITCHES	DO	CALL WHITESPACE
0DC8*			A:"/"
0DCA		*	IF NE,EXIT
0DCC			CALL WHITESPACE
0DCF*			A:"P"			Define $PAGE(4) ?
0DD1			IF EQ,			Num(1),Hd(1),Bdy(1),Ft(1)
0DD3				HL=@PAGE
0DD6				$HL=1		Set the default
0DD9+NUM.LIST:			SI=SI-1
0DDA				DO	CALL DO.NUM.1
0DDD+					HL=HL+1
0DDE*					A:","
0DE0				LOOP WHILE EQ
0DE2		*		LOOP
0DE4*			A:"D"
0DE6			IF EQ,
0DE8*				$DEVICE=$DEVICE XOR 3
0DED		*		LOOP
0DEF			SI=@USAGE
0DF2			GOTO DSPLY
0DF5+		SI=SI-1
0DF6		HL=@P.LIST		SYNTAX = [n | n-m],... [n*]
0DF9		%HL='01FF'		default = 1*  [1] [FF]
0DFD		DO	CALL WHITESPACE 	       ^current $PAGE
0E00+			SI=SI-1
0E01			CALL CK.DIGIT
0E04		*	IF CY,EXIT
0E06			CALL DO.NUM	      n-m --> [n] [m]
0E09+			HL=HL+1 		n --> [n] [0]
0E0A			$HL=0		      n=0 --> End-of-List
0E0D*			A:"-"
0E0F			IF EQ,CALL DO.NUM.1
0E14+			HL=HL+1
0E15+			SI=SI+1
0E16			%HL='0000'
0E1A*			A:","
0E1C		*	IF EQ,LOOP
0E1E*			A:"*"
0E20			IF EQ,
0E22+				SI=SI+1
0E23				$(HL-1)=-1
0E27+			SI=SI-1
0E28		A=$PAGE
0E2B*		A:$P.LIST
0E2F		IF GT,
0E31			$P.LIST=A
0E34		RETURN
.PAD=10
0E40 MOV.N.BMP	DO	A=$SI+		Move bytes until CR encountered
0E41			$DI+=A		Return with DI = @CR+1
0E42*			DI:BC
0E44		*	IF GE,EXIT
0E46*			A:CR
0E48		LOOP UNTIL EQ
0E4A+		SI=SI+1 		Skip the LF (SI = @CR+2)
0E4B BMP.SRC.P0 PUSH DI 		Update the Source Pointer
0E4C		CALL MIN.SI
0E4F		PUSH DS
0E50		DS=CS
0E52		POP AA
0E53		%FILE.PTR=SI
0E57		%FILE.PTR+2=AA
0E5A		DI,ES=%FILE.EOF
0E5E		CALL PTR.DIFF+2
0E61		ES=CS
0E63*		BC:0			globally, BC = # Bytes to EOF
0E65		POP DI
0E66		RETURN
0E67 EMIT.HEAD	PUSH BC
0E68		A=$(BP+1)		FF Flags [Snn] Prefix Size
0E6B+		DO	A=A-1
0E6D		*	IF NEG,EXIT
0E6F			PUSH AA
0E70			A=" "
0E72			CALL PRINT.A
0E75			POP AA
0E76		LOOP
0E78		SI=@H.DEF
0E7B		C=1			Whereas BC = #bytes to EOF globally,
0E7D		DO	A=$SI+		locally C = Column #
0E7E*			A:0
0E80		*	IF EQ,EXIT
0E82*			A:$DEFS
0E86			IF EQ,
0E88				A=$SI+
0E89				CALL H.SPECIAL
0E8C*				A:" "
0E8E		*		IF LT,LOOP
0E90			CALL PRINT.BMP
0E93		LOOP
0E95		POP BC
0E96 CRLF	A=CR
0E98		CALL PRINT.A
0E9B		A=LF
0E9D PRINT.A	E=A
0E9F+		A=A+1
0EA1		IF NZ,			NEVER print a 0FF character !
0EA3			CS:	A=$PAGE
0EA7*			CS:	A:$P.LIST
0EAC			IF EQ,				ONLY print when
0EAE				CS:	A'=$DEVICE	$PAGE = $P.LIST
0EB3				INT 021
0EB5			A=0
0EB7		RETURN
0EB8*PRINT.DEC	A=A OR "0"
0EBA+PRINT.BMP	C=C+1
0EBC		GOTO PRINT.A
.P
0EBE*H.SPECIAL	A=A OR 020
0EC0*		A:"p"
0EC2		IF EQ,
0EC4			A=$PAGE
0EC7*			AAM		A' = num/10, A = 3rd digit
0EC9			PUSH AA
0ECA			A=A'
0ECC*			AAM		A' = num/100, A = 2nd digit
0ECE*			A':0
0ED0			IF NE,
0ED2				PUSH AA 	If 1st digit > 0, Emit it
0ED3				A=A'
0ED5				CALL PRINT.DEC
0ED8				POP AA
0ED9*			A'=A' OR A	If either 1st or 2nd digits > 0,
0EDB			IF NZ,
0EDD P.POP:			CALL PRINT.DEC		Emit the 2nd digit.
0EE0			POP AA
0EE1			GOTO PRINT.DEC	In any case, emit the 3rd digit.
0EE3*		A:"t"
0EE5		IF EQ,
0EE7			A=$TIME+1
0EEA*			LSR A,3 	Strip Hours Field out of TIME
0EED			CALL PRINT.TWO	Emit with leading 0
0EF0			A=":"
0EF2			CALL PRINT.BMP
0EF5			AA=%TIME	Do the same with Minutes Field
0EF8*			A'=A' AND 00000111
0EFB*TOP.NUM		ASL AA,3
0EFE			A=A'
0F00*PRINT.TWO		AAM		A' = A / 10,  A = remainder
0F02			PUSH AA
0F03			A=A'
0F05			GOTO P.POP
0F07*		A:"y"
0F09		IF EQ,
0F0B			A=$DATE+1
0F0E*			LSR A
0F10*			A=A+80			Strip Year out of DATE
0F12*			A:100			and bias it for 1980.
0F14			IF GE,
0F16*				A=A-100 	Make sure it's less than 100
0F18			GOTO PRINT.TWO
0F1A*		A:"m"
0F1C		IF EQ,
0F1E			AA=%DATE
0F21*			A'=A' AND 1		Strip Month out of DATE
0F24			GOTO TOP.NUM
0F26*		A:"d"
0F28		IF EQ,
0F2A			AA=%DATE
0F2D*			A=A AND 00011111	Strip Day out of DATE
0F2F			GOTO PRINT.TWO
0E31 :		continued.
.P
0F31*		A:"f"
0F33		IF EQ,
0F35			PUSH SI
0F36			SI=@FILE
0F39			DO	A=$SI+
0F3A				CALL PRINT.BMP
0F3D*				$SI:0
0F40			LOOP UNTIL EQ
0F42			POP SI
0F43			RETURN
0F44*		A:"0"
0F46		IF GE,
0F48*			A:"?"
0F4A		*	IF LE,EXIT
0F4C+		ELSE	SI=SI-1
0F4D			A=$DEFS
0F50			RETURN
0F51*		A=A AND 0F
0F53		B=A
0F55		DO	A=" "
0F57			CALL PRINT.BMP
0F5A			A=C
0F5C*			A=A AND 0F
0F5E*			A=A XOR B
0F60		LOOP UNTIL ZR
0F62		RETURN
0F63 DSP.PAGE	A=$PAGE
0F66*		A:$P.LIST
0F6A		IF EQ,
0F6C			CALL DSP.4	Display 4 x Spaces
0F6F			A=$PAGE 	Now, Display Right-to-Left
0F72			CALL RL.2	4 digits (with lead 0's = Blank)
0F75 RL.2		CALL RL.1
0F78*RL.1		AAM		A'=A/10, A=remainder
0F7A			PUSH AA
0F7B*			A=A OR "0"	All these calls go into the bit
0F7D*			AA:"0"		bucket if DEVICE .NE. <printer>
0F80			IF EQ,
0F82				A=" "
0F84			CALL DSP.1
0F87			A=8
0F89			CALL DSP.1
0F8C			CALL DSP.1
0F8F			POP AA
0F90			A=A'
0F92		RETURN
0F93 PREP.FILE	CALL FIX.EXT		DI=@End of filepath
0F96		HL=01000
0F99		CALL LOAD.FILE		HL=TargetParagraph
0F9C		AA=05700
0F9F		INT 021 		Get File's Date-Time
0FA1		%DATE=DE
0FA5		%TIME=BC
0FA9		SI=@FIX.1
0FAC		GOTO FIX.TEXT
.PAD=10
0FB0*DSPLX	$DEVICE:5		5 = <printer>
0FB5		IF EQ,GOTO DSPLY	(emit to DSPLY if DEVICE = printer)
0FB9		RETURN
0FBA DSP.4	A=" "
0FBC		CALL DSP.2
0FBF DSP.2	CALL DSP.1
0FC2*DSP.1	$DEVICE:5		5 = <printer>
0FC7		IF EQ,GOTO DSP.A	(no DSPLY if "printing" to DSPLY)
0FCB		RETURN
0FCC DSP.CRLF	A=CR
0FCE		CALL DSP.1
0FD1		A=LF
0FD3 DSP.X	GOTO DSP.1
0FD5 CK.CMD	CS:	SI,DS=%FILE.PTR
0FDA		L=$(BP+1)		FF Flags [Snn] Prefix Size
0FDD		H=0
0FDF SI.CMD	AA=%(HL+SI)
0FE1*		A'=A' OR 020
0FE4*		CS:	A:$DEFS+1
0FE9		IF EQ,
0FEB*			A':"p"
0FEE		*	IF EQ,EXIT
0FF0*			A':"h"
0FF3		RETURN
0FF4 DO.CMD	SI=(HL+SI+2)		Only called right after CK.CMD
0FF7*		A':"h"
0FFA		IF EQ,
0FFC			DI=(SI+1)
0FFF			CALL WHITESPACE
1002*			SI:DI
1004			DI=@H.DEF
1007			IF NE,
1009				CS:	DI=%H.PTR
100E			PUSH FF
100F+			SI=SI-1
1010			BC=@H.DEF+80
1013			CALL MOV.N.BMP
1016+			DI=DI-1
1017			$DI=0
101A*			POP FF
101B			IF EQ,
101D				%H.PTR=DI
1021			RETURN
1022		DI=5D
1025		BC=080
1028		CALL MOV.N.BMP		Stash the .P<string> for processing
102B		SI=5D
102E		HL=@PAGE
1031		DO	CALL CK.DIGIT	Process it (if any) into $PAGE(4)
1034		*	IF CY,EXIT
1036			CALL DO.NUM
1039+			HL=HL+1
103A+			SI=SI+1
103B*			A:","
103D		LOOP WHILE EQ
103F		RETURN
.PAD=10
1050		DO	CALL DO.CMD
1053 DO.HEAD		CALL CK.CMD
1056		LOOP WHILE EQ
1058		DS=CS
105A		A=$HEAD
105D*		A:2
105F		IF GE,
1061			CALL EMIT.HEAD
1064			A=$HEAD
1067+			AA=AA-1
1068+A.CRLFS	DO	A=A-1
106A		*	IF NEG,EXIT
106C			PUSH AA
106D			CALL CRLF
1070			POP AA
1071		LOOP
1073		RETURN
1074 DO.FOOT	A=$BODY 		Be sure that BODY is
1077*		A=A-$LINE		filled out with CRLFs.
107B		CALL A.CRLFS		(this only emits if EOF or .CMD)
107E		A=$FOOT
1081*		A:2
1083		IF LT,GOTO A.CRLFS	Emit FOOT if it's small or null
1085*		$HEAD:2
108A		IF LT,
108C+			AA=AA-1 	Large FOOT & small HEAD
108D			CALL A.CRLFS		so, emit FOOT with
1090			GOTO EMIT.HEAD		HEAD at the bottom.
1093		IF BC=0,GOTO A.CRLFS	EOF, so just emit the final FOOT
1095		PUSH AA
1096		CALL CK.CMD
1099		IF NE,
109B			DO	DO	A=$SI+
109C*					A:LF
109E					BC=BC-1
				LOOP NE (BC>0)
10A0				POP AA
10A1+				A=A-1
10A3				PUSH AA
10A4		*		IF ZR,EXIT
10A6			*	IF BC=0,EXIT
10A8				CALL SI.CMD
10AB			LOOP UNTIL EQ
10AD			CS:	$LINE=0
10B3			CALL MORE.BODY
10B6			POP AA
10B7			GOTO A.CRLFS
10B9		POP AA
10BA		DS=CS
10BC		A=$FOOT
10BF		GOTO A.CRLFS
10C1		NEXT		0FE8 = Begin Data Area
.
0980 FIX.A2	099A GET.FILE	09C8 CR 	09D4 DSPLY
0A4A WHITESPACE 0AAF FILE.PTR	0AB9 LF 	0AD3 COPYRIGHT
0DC0 ABORT	0E4C MIN.SI	0E5A FILE.EOF	0E5E PTR.DIFF
0EE7 TIME	0F0B DATE	0F99 LOAD.FILE	0FAC FIX.TEXT
0FC7 DSP.A