4 files changed, 297 insertions, 0 deletions
diff --git a/src/cmd/postscript/hardcopy/README b/src/cmd/postscript/hardcopy/README
new file mode 100644
index 00000000..2ad29065
--- /dev/null
+++ b/src/cmd/postscript/hardcopy/README
@@ -0,0 +1,11 @@
+Redirect output of the print operator to paper. Particularly useful if
+you're trying to extract information from a printer, but you don't have
+access to the data the printer returns to the host.
+
+For example,
+
+	FontDirectory {pop ==} forall
+
+names all the fonts registered in the FontDirectory dictionary. Simple,
+but only if you can read the data returned to the host by the printer.
+
diff --git a/src/cmd/postscript/hardcopy/hardcopy.ps b/src/cmd/postscript/hardcopy/hardcopy.ps
new file mode 100644
index 00000000..65eb24df
--- /dev/null
+++ b/src/cmd/postscript/hardcopy/hardcopy.ps
@@ -0,0 +1,196 @@
+%
+% Redefiniton of the PostScript file output operators so results go to paper.
+% Complicated and slow, but the implementation doesn't place many demands on
+% included PostScript. About all that's required is gentle treatment of the
+% graphics state between write calls.
+%
+
+/#copies 1 store
+/aspectratio 1 def
+/font /Courier def
+/formsperpage 1 def
+/landscape false def
+/magnification 1 def
+/orientation 0 def
+/pointsize 10 def
+/rotation 1 def
+/xoffset .1 def
+/yoffset .1 def
+
+/roundpage true def
+/useclippath true def
+/pagebbox [0 0 612 792] def
+
+/inch {72 mul} def
+/min {2 copy gt {exch} if pop} def
+
+/HardcopySetup {
+	landscape {/orientation 90 orientation add def} if
+	font findfont 1 1.1 div scalefont setfont
+
+	pagedimensions
+	xcenter ycenter translate
+	orientation rotation mul rotate
+	width 2 div neg height 2 div translate
+	xoffset inch yoffset inch neg translate
+	pointsize 1.1 mul dup scale
+	magnification dup aspectratio mul scale
+	height width div 1 min dup scale
+	0 -1 translate
+	0 0 moveto
+} def
+
+/pagedimensions {
+	useclippath {
+		/pagebbox [clippath pathbbox newpath] def
+		roundpage currentdict /roundpagebbox known and {roundpagebbox} if
+	} if
+	pagebbox aload pop
+	4 -1 roll exch 4 1 roll 4 copy
+	landscape {4 2 roll} if
+	sub /width exch def
+	sub /height exch def
+	add 2 div /xcenter exch def
+	add 2 div /ycenter exch def
+} def
+
+%
+% Unbind the operators in an executable array or packedarray. Leaves the
+% unbound array or the original object on the stack.
+%
+
+/Unbind {
+	0 index xcheck
+	1 index type /arraytype eq
+	2 index type /packedarraytype eq or and {
+		dup length array copy cvx
+		dup 0 exch {
+			dup type /operatortype eq {
+				(                          ) cvs cvn cvx
+			} if
+
+			dup type /dicttype eq {
+				dup maxlength dict exch {
+					Unbind
+					3 copy put pop pop
+				} forall
+			} if
+
+			0 index xcheck
+			1 index type /arraytype eq
+			2 index type /packedarraytype eq or and {
+				Unbind
+			} if
+
+			3 copy put pop
+			1 add
+		} forall
+		pop
+	} if
+} def
+
+%
+% New write operator - don't bind the definition! Expands tabs and backspaces,
+% wraps long lines, and starts a new page whenever necessary. The code that
+% handles newlines assumes lines are separated by one vertical unit.
+%
+
+/write {
+	true exch
+
+      %%case '\b':
+	dup 8#10 eq {
+		( ) stringwidth pop neg 0 rmoveto
+		currentpoint pop 0 lt {
+			currentpoint exch pop 0 exch moveto
+		} if
+		exch pop false exch
+	} if
+
+      %%case '\t':
+	dup 8#11 eq {
+		currentpoint pop ( ) stringwidth pop div round cvi
+		8 mod 8 exch sub {
+			2 index 8#40 write
+		} repeat
+		exch pop false exch
+	} if
+
+      %%case '\n':
+	dup 8#12 eq {
+		currentpoint 0 exch 1 sub moveto pop
+
+		gsave clippath pathbbox pop pop exch pop grestore
+		currentpoint exch pop 1 sub ge {
+			2 index 8#14 write
+		} if
+		exch pop false exch
+	} if
+
+      %%case '\f':
+	dup 8#14 eq {
+		gsave showpage grestore
+		0 0 moveto
+		exch pop false exch
+	} if
+
+      %%case '\r':
+	dup 8#15 eq {
+		currentpoint 0 exch moveto pop
+		exch pop false exch
+	} if
+
+      %%case EOF:
+	dup -1 eq {
+		currentpoint 0 ne exch 0 ne or {
+			2 index 8#14 write
+		} if
+		exch pop false exch
+	} if
+
+      %%default:
+	exch {
+		dup
+		gsave clippath pathbbox pop 3 1 roll pop pop grestore 
+		( ) stringwidth pop currentpoint pop add le {
+			2 index 8#12 write
+		} if
+		( ) dup 0 4 -1 roll put show
+	} if
+
+	pop		% the character
+	pop		% and file object
+} def
+
+%
+% All the other file output operators call our redefined write operator.
+%
+
+/print {
+	(%stdout) (w) file exch {1 index exch write} forall
+	pop
+} def
+
+/writestring {
+	{1 index exch write} forall
+	pop
+} def
+
+/writehexstring {
+	(0123456789ABCDEF) 3 1 roll {
+		dup
+		3 index exch -4 bitshift 16#F and get 2 index exch write
+		2 index exch 16#F and get 1 index exch write
+	} forall
+	pop pop
+} def
+
+%
+% Unbind and redefine the remaining file output procedures.
+%
+
+/= dup load Unbind def
+/== dup load Unbind def
+/stack dup load Unbind def
+/pstack dup load Unbind def
+
diff --git a/src/cmd/postscript/hardcopy/hardcopy.rc b/src/cmd/postscript/hardcopy/hardcopy.rc
new file mode 100644
index 00000000..0077aa71
--- /dev/null
+++ b/src/cmd/postscript/hardcopy/hardcopy.rc
@@ -0,0 +1,70 @@
+#!/bin/rc
+# Generate paper output from the data that a PostScript program normally
+# sends back to a host computer using file output operators.
+#
+
+POSTLIB=/sys/lib/postscript/prologues
+PROLOGUE=$POSTLIB/hardcopy.ps
+
+OPTIONS=
+MODE=portrait
+
+NONCONFORMING='%!PS'
+ENDPROLOG='%%EndProlog'
+BEGINSETUP='%%BeginSetup'
+ENDSETUP='%%EndSetup'
+TRAILER='%%Trailer'
+
+SETUP=HardcopySetup
+DONE='(%stdout)(w) file -1 write'
+
+while (! ~ $#* 0 && ~ $1 -*) {
+	switch ($1) {
+	case -c;  shift; OPTIONS=$OPTIONS' /#copies '$1' store'
+	case -c*; OPTIONS=$OPTIONS' /#copies `{echo $1 | sed s/-c//}' store'
+
+	case -f;  shift; OPTIONS=$OPTIONS' /font '/$1' def'
+	case -f*; OPTIONS=$OPTIONS' /font '/`{echo $1 | sed s/-f//}' def'
+
+	case -p;  shift; MODE=$1
+	case -p*; MODE=`{echo $1 | sed s/-p//}
+
+	case -m;  shift; OPTIONS=$OPTIONS' /magnification '$1' def'
+	case -m*; OPTIONS=$OPTIONS' /magnification '`{echo $1 | sed s/-m//}' def'
+
+	case -s;  shift; OPTIONS=$OPTIONS' /pointsize '$1' def'
+	case -s*; OPTIONS=$OPTIONS' /pointsize '`{echo $1 | sed s/-s//}' def'
+
+	case -x;  shift; OPTIONS=$OPTIONS' /xoffset '$1' def'
+	case -x*; OPTIONS=$OPTIONS' /xoffset '`{echo $1 | sed s/-x//}' def'
+
+	case -y;  shift; OPTIONS=$OPTIONS' /yoffset '$1' def'
+	case -y*; OPTIONS=$OPTIONS' /yoffset '`{echo $1 | sed s/-y//}' def'
+
+	case -L;  shift; PROLOGUE=$1
+	case -L*; PROLOGUE=`{echo $1 | sed s/-L//}
+
+	case --;
+
+	case -*;  echo '$0: illegal option $1' >&2; exit 1
+	}
+	shift
+}
+
+switch ($MODE) {
+	case l*; OPTIONS=$OPTIONS' /landscape true def'
+	case *;  OPTIONS=$OPTIONS' /landscape false def'
+}
+
+echo $NONCONFORMING
+cat $PROLOGUE
+echo $ENDPROLOG
+echo $BEGINSETUP
+echo $OPTIONS
+echo $SETUP
+echo $ENDSETUP
+
+cat $*
+
+echo $TRAILER
+echo $DONE
diff --git a/src/cmd/postscript/hardcopy/mkfile b/src/cmd/postscript/hardcopy/mkfile
new file mode 100644
index 00000000..c6131dba
--- /dev/null
+++ b/src/cmd/postscript/hardcopy/mkfile
@@ -0,0 +1,20 @@
+</$objtype/mkfile
+
+<../config
+
+all:V:	hardcopy
+
+installall install:V:	$POSTBIN/hardcopy $POSTLIB/hardcopy.ps
+
+$POSTBIN/hardcopy:	hardcopy
+	cp $prereq $target
+
+$POSTLIB/hardcopy.ps:	hardcopy.ps
+	cp $prereq $target
+
+hardcopy:	hardcopy.rc
+	sed 's?^POSTLIB=.*?POSTLIB='$POSTLIB'?' hardcopy.rc >hardcopy
+	chmod 775 hardcopy
+
+clean nuke:V:
+	rm -f hardcopy