Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/psp.mac
There are no other files named psp.mac in the archive.
;SRC:<5-GALAXY>PSP.MAC.1, 28-Jul-86 11:22:13, Edit by KNIGHT
; Create this from MKL's PSP.MID.  Make it TOPS-20 coding style, and
; bum code
	TITLE  PSP  -- PostScript printer program
	SUBTTL Mark K. Lottor, RMK

	SEARCH MONSYM,MACSYM
	.REQUIRE SYS:MACREL
A==:1
B==:2
C==:3
D==:4
P==:17

PDLLEN==:40
PDL:	BLOCK PDLLEN

TTYJFN:	0			;TTY port JFN
TTYDES:	0			;TTY designator
TTYMOD:	0
PRTDEV:	ASCIZ/TTY55:/
INJFN:	0
PREJFN:	0

GTIN:	GJ%OLD!GJ%CFM!GJ%MSG
	.PRIIN,,.PRIOU
	0			;default structure
	0			;dir
	0
	-1,,[ASCIZ /PS/]	;default extension
	0
	0
	0

;page header stuff

PH1:	ASCIZ	|
/phoon
{
/MD exch def
/Mr exch def
/My exch def
/Mx exch def
/pi 3.1415926535 def
/ANM 2497886484 def
/SP 2551443 def
/temp MD ANM sub def
/IP temp temp SP div truncate SP mul sub def
/AP IP SP div 2 mul pi mul def
/MCAP AP pi div 180 mul cos neg def
Mx Mr sub 10 sub My Mr sub 10 sub moveto Mr 2 mul 20 add dup box 0 setgray fill
AP 0 ge AP pi lt and {RHM} {LHM} ifelse
} def
/RHM
{ Mx My moveto Mx My Mr 270 90 arc 1 setgray fill
MCAP 0 le {0 RE} {1 LE} ifelse
} def
/LHM
{ Mx My moveto Mx My Mr 90 270 arc 1 setgray fill
MCAP 0 le {0 LE} {1 RE} ifelse
} def
/RE
{ Mx My Mr MCAP abs mul Mr 270 90 E setgray fill } def
/LE
{ Mx My Mr MCAP abs mul Mr 90 270 E setgray fill} def

/Edict 8 dict def
Edict /mtrx matrix put
/E
{Edict begin
/endangle exch def
/startangle exch def
/yrad exch def
/xrad exch def
/y exch def
/x exch def
/savematrix mtrx currentmatrix def
x y translate
xrad yrad scale
0 0 1 startangle endangle arc
savematrix setmatrix
end
}def

/box
{currentpoint
newpath
moveto
/y exch def
/x exch def
x 0 rlineto
0 y rlineto
x neg 0 rlineto
closepath
} def

/PF
{pop pop pop pop} def

/inch {72 mul} def

/curvedbox
{/r exch def
/y exch def
/x exch def
currentpoint
/cy exch def
/cx exch def
newpath
cx x 2 div add cy moveto
cx x add cy cx x add cy y add r arcto PF
cx x add cy y add cx cy y add r arcto PF
cx cy y add cx cy r arcto PF
cx cy cx x 2 div add cy r arcto PF
closepath
stroke
} def

/font
{exch
findfont
exch scalefont
setfont
} def

/inversetext
{dup stringwidth
/y exch def
/x exch def
currentpoint
2 copy
newpath
moveto
/y 12 def
x 0 rlineto
0 y rlineto
x neg 0 rlineto
closepath
0 setgray
fill
1 setgray
moveto
show
0 setgray
} def

1 inch 7 inch moveto 6.5 inch 3 inch 25 curvedbox
494 674 16 |

PH1.5:	ASCIZ | phoon

.5 setgray
newpath
.5 inch 1 inch moveto
.5 inch 10 inch lineto
.75 inch 10 inch lineto
.75 inch 1 inch lineto
closepath
fill

newpath
7.75 inch 1 inch moveto
7.75 inch 10 inch lineto
8 inch 10 inch lineto
8 inch 1 inch lineto
closepath
fill

0 setgray

/Helvetica 14 font
1.5 inch 9.5 inch moveto (User:) show 2.2 inch 9.5 inch moveto (|

PH2:	ASCIZ |) inversetext
1.5 inch 9.0 inch moveto (Date:) show 2.2 inch 9.0 inch moveto (|

PH3:	ASCIZ |) show
1.5 inch 8.5 inch moveto (File:) show 2.2 inch 8.5 inch moveto (|

PH4:	ASCIZ | ) show

showpage
|
START:	RESET%
	MOVE P,[IOWD PDLLEN,PDL]	;init stack
	MOVEI A,.FHSLF
	SETOB B,C
	EPCAP%
	HRROI A,PRTDEV
	STDEV%
	 ERJMP DONE
	MOVEM B,TTYDES
	MOVE	A,B
	ASND%			;assign the tty
	IFJER.
	  TMSG <LaserWriter in use by >
	  MOVX A,GJ%SHT!GJ%OLD
	  HRROI	B,PRTDEV
	  GTJFN%
	   ERJMP DONE
	  MOVE D,A
	  DVCHR%
	   ERJMP DONE
	  MOVE A,D
	  RLJFN%
	   ERJMP .+1
	  HLRZ A,C	;get job number
	  HRROI B,B
	  MOVEI C,.JIUNO
	  GETJI%
	   ERJMP DONE
	  MOVEI A,.PRIOU
	  DIRST%
	   ERJMP DONE
	  TMSG <
>
	ENDIF.	
	MOVX A,GJ%SHT
	HRROI B,PRTDEV
	GTJFN%
	 ERJMP DONE
	MOVEM A,TTYJFN
	MOVX B,FLD(7,OF%BSZ)!OF%RD!OF%WR
	OPENF%
	 ERJMP DONE
	RFMOD%			; get current mode for this line
	 ERJMP .+1
	MOVEM B,TTYMOD
	TXZ B,TT%LEN!TT%WID!TT%ECO!TT%DAM
	TXO B,TT%PGM
	SFMOD%
	 ERJMP .+1
	STPAR%
	 ERJMP .+1
	CFOBF%
	CFIBF%
	MOVE A,TTYJFN
	MOVEI B,.MOSPD
	MOVE C,[^D9600,,^D9600]
	MTOPR%
	MOVEI B,.MOSNT
	MOVEI C,.MOSMN
	MTOPR%			;refuse system messages
	MOVE A,TTYJFN
	MOVEI B,4
	BOUT%			;send a control-D to be sure
	DO.
	  TMSG <Name of file to print:  >
	  MOVEI	A,GTIN
	  SETZ B,
	  GTJFN%
	  IFJER.
	    TMSG <
>
	    LOOP.
	  ENDIF.
	ENDDO.
	MOVEM	A,INJFN
	MOVX B,FLD(7,OF%BSZ)!OF%RD
	OPENF%
	 ERJMP DONE
	MOVX A,CR%MAP!CR%CAP!CR%ST+ERRIN
	CFORK%
	 ERJMP DONE
	HRROI A,INBUF
	MOVE B,INJFN
	MOVX C,FLD(.JSAOF,JS%TYP)
	JFNS%
	 ERJMP DONE
	MOVE A,[ASCIZ /PS/]
	CAMN A,INBUF
	IFSKP.			;Not a PostScript file, send preamble
	  TMSG <Assuming text file.
>
	  MOVX A,GJ%SHT!GJ%OLD
	  HRROI B,[ASCIZ/SYSTEM:PREPEND.PS/]
	  GTJFN%
	   ERJMP DONE
	  MOVEM A,PREJFN
	  MOVX B,FLD(7,OF%BSZ)!OF%RD
	  OPENF%
	   ERJMP DONE
	  MOVE A,PREJFN
	  CALL SNDFIL
	ENDIF.
	MOVE A,INJFN
	CALL SNDFIL
	MOVE A,TTYJFN
	MOVEI B,.TICCD
	BOUT%			;send a control-D at end
	MOVEI A,^D<15*1000>	;Wait fifteen seconds
	DISMS%
	CALL DOHDR		;Send the header
	MOVE A,INJFN
	CLOSF%
	 ERJMP .+1
	MOVE A,TTYJFN
	MOVEI B,.TICCD
	BOUT%			;send a control-D at end
;	JRST DONE
;If done, close TTYJFN and deassign clock
DONE:	SKIPE A,TTYJFN
	 CLOSF%
	  TRN
	SKIPE A,TTYDES
	 RELD%
	  TRN
	HALTF%
	JRST .-1
;Subroutine to send a file whose JFN is in A
SNDFIL:	ACVAR <JFN>
	MOVE JFN,A
	DO.
	  HRROI B,INBUF
	  MOVNI C,^D1000*5
	  SIN%
	   ERJMP .+1
	  MOVE D,C
	  MOVE A,TTYJFN
	  HRROI B,INBUF
	  MOVNI C,^D1000*5
	  SUB C,D
	  SOUT%
	  MOVE A,JFN
	  JUMPE D,TOP.
	ENDDO.
	CLOSF%
	 ERJMP .+1
	ENDAV.
	RET
; Create a header page
DOHDR:	MOVE A,TTYJFN
	HRROI B,PH1
	SETZ C,
	SOUT%
	GTAD%
	CALL CVINET
	MOVE A,TTYJFN
	MOVEI C,^D10
	NOUT%
	 ERJMP DONE
	HRROI B,PH1.5
	SETZ C,
	SOUT%
	GJINF%
	MOVE B,A
	MOVE A,TTYJFN
	DIRST%
	 ERJMP .+1
	HRROI B,PH2
	SETZ C,
	SOUT%
	SETOB B,C
	ODTIM%
	 ERJMP DONE
	HRROI B,PH3
	SETZ C,
	SOUT%
	MOVE B,INJFN
	JFNS%
	 ERJMP DONE
	HRROI B,PH4
	SOUT%
	RET
TMBDIF==^D<365*41+55>		;1858 BASE VS 1900 BASE, IN DAYS

CVINET:	MOVEI C,(B)		;TOPS20 FRACTION OF A DAY
	HLRZ B,A		;DAYS SINCE NOV 1858
	SUBI B,TMBDIF		;BRING DOWN TO 1900
	MULI C,^D<24*60*60>	;CONVERT TO SECONDS FROM 1/3 SEC
	DIV C,[1,,0]		; ..
	CAIL D,400000		;ROUND TO NEAREST SECOND
	ADDI C,1		;ROUND UP
	CAIGE C,^D<24*60*60>	;WENT TO WHOLE DAY?
	IFSKP.
	  MOVEI C,0		;YES, COUNT A DAY
	  AOJA B,.+1
	ENDIF.
	IMULI B,^D<24*60*60>	;SECONDS FROM DAYS
	ADDI B,(C)		;SECONDS WITHIN TODAY
	RET			;RETURN RFC738 FORMAT TIME IN B
;Fork to print errors from printer
ERRIN:	MOVE A,TTYJFN
	BIN%
	MOVEI A,.PRIOU
	BOUT%
	JRST ERRIN
INBUF:	BLOCK 2000
	END START