🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.postscript
Article #1398

The One Page Processor, a PostScript word processor.

#1398
From: Bruno Pape
Date: Wed, 29 Nov 1989 13:10
661 lines
17651 bytes
Have at it.  If your running UNIX here is a shell script you could use.

#
#	This is pps.  The command "pps filename printer", will print the
#	One Page Processor input file filename.ps on the PostScript device
#	printer.  eg. "pps doc lw"
#
cat processor.ps $1.ps trailer.ps | lpr -P$2 -h


This is processor.ps, the document is doc.ps, and the trailer is trailer.ps. 

%!PS-Adobe-1.0
%%Creator:	micky:bruno (gerard bruno pape)
%%Title:	The One Page Processor
%%CreationDate:	July 1989
%%EndComments
%%Pages: 1
%%EndProlog
%%Page: 1 1

%
%	Author:	  G. Bruno Pape, Computer Consultant, B.S. Computer Engineering
%
%	Address:  P.O. Box 368, Thomaston, Connecticut, 06787, USA.
%	
%	Copyright (c) G. Bruno Pape 1989.
%	All rights reserved.
%
%	Permission is granted to anyone to use this software for any purpose on
%	any computer system, and to alter it and redistribute it freely, subject
%	to the following restrictions:
%	
%	1. The author is not responsible for the consequences of use or
%	redistribution of this software, no matter how awful.
%	
%	2. The origin of this software must not be misrepresented, either by
%	explicit claim or by omission.
%	
%	3. Altered versions must be plainly marked as such, and must not be
%	misrepresented as being the original software. 
%	
%	4. This notice may not be removed or altered.
%
%	5. This program makes extensive use of programming examples from
%	the PostScript Language Tutorial and Cookbook, Adobe Systems Inc.,
%	Addison-Wesley Publishing Company.  I hope it is within the spirit
%	of the publication not to restrict distribution of programs that
%	make use of examples contained therein.
%	

%
%	First distribution, November 30, 1989.
%
%	This software was developed while on holiday in Switzerland which
%	is why some things are in centimeters, pages are A4, and we have
%	all the funny characters.
%
%	I also do "C" programming, systems programming in BSD and System V
%	UNIX environments, network and network application development,
%	X-Windows application development, 3D graphic and graphic animation
%	program development, computational fluid dynamics, expert systems,
%	and almost anything else you might want done with a computer.
%	My favorite computer is a MAC, but I only do development work on Suns,
%	Silicon Graphics, DECs, Crays, and of course IBM mainframes. 
%

%
%	This routine, ReEncodeSmall, was taken from the PostScript
%	Language Tutorial and Cookbook, Adobe Systems. It is Program 18 /
%	Making Small Changes to Encoding Vectors on page 211, where it is
%	fully documented.
%

/reencsmalldict 12 dict def
/ReEncodeSmall {
	reencsmalldict begin
	/newcodesandnames exch def
	/newfontname exch def
	/basefontname exch def

	/basefontdict basefontname findfont def
	/newfont basefontdict maxlength dict def
	
	basefontdict {
		exch dup /FID ne {
			dup /Encoding eq {
				exch dup length array copy newfont 3 1 roll put
			} {
				exch newfont 3 1 roll put
			} ifelse
		} {
			pop pop
		} ifelse
	} forall

	newfont /FontName newfontname put
	newcodesandnames aload pop

	newcodesandnames length 2 idiv {
		newfont /Encoding get 3 1 roll put
	} repeat

	newfontname newfont definefont pop
	end
} def

%
%	Roll the strings and associated info off the stack and print
%	them using widthshow to do the right justification.
%

/printline {
	/delta_space line_length curwidth sub spaces div def
	gsave count counttomark idiv
	{
		count counttomark neg roll
		setcmykcolor setfont
		{ draw_under_line } if
		delta_space 0 8#40 4 -1 roll widthshow pop
	} repeat
	grestore 1 newline
	/line_length right_margin currentpoint pop sub def
	/spaces 0 def
} def

%
%	Pushes a mark, a string, the current underlining mode, the current
%	font, and the current color on the stack.  Truncate any trailing
%	blanks.  If the string is null toss it away, and truncate any
%	trailing blanks from the last string pushed on the stack.
%

/pushline {
	mark
	textstring startchar lastwordbreak startchar sub getinterval
	dup length 0 gt
	{
		trailingblanks 
		under_line currentfont currentcmykcolor
	}{
		cleartomark currentfont counttomark -3 roll
		dup setfont /breakwidth wordbreak stringwidth pop def
		counttomark 2 roll trailingblanks counttomark 1 roll
		setfont /breakwidth wordbreak stringwidth pop def
	} ifelse
} def

%
%	Pushes a mark, a string, the current underlining mode, the current
%	font, and the current color on the stack.  If the string is null
%	toss it away.
%

/pushrestofline {
	mark
	textstring startchar textstring length startchar sub getinterval
	dup length 0 gt
	{
		under_line currentfont currentcmykcolor
	}{
		cleartomark
	} ifelse
} def

%
%	Draws an underline for a string that is somewhere on the stack.
%

/draw_under_line {
	currentpoint currentfont
	0 1 index /FontInfo get /UnderlineThickness get
	2 index /FontMatrix get transform setlinewidth pop
	2 index 2 index 
	0 3 index /FontInfo get /UnderlinePosition get
	5 -1 roll /FontMatrix get transform exch pop add
	newpath moveto
	currentpoint exch 4 index stringwidth pop add
	4 index { 8#40 eq { delta_space add } if } forall
	exch lineto closepath stroke moveto
} def

%
%	Truncates any trailing blanks that would appear at the end of the line.
%

/trailingblanks {
	mark
	1 index dup dup
	length 1 sub -1 0
	{
		get 8#40 eq
		{
			/curwidth curwidth breakwidth sub def
			/spaces spaces 1 sub def
			dup
		}{
			exit
		} ifelse
	} for
	cleartomark
} def

%
%	Skips past spaces that would appear at the beginning of the line.
%

/skip_spaces {
	{
		nextword () ne { exit } if
		/lastwordbreak lastwordbreak 1 add def
		restoftext wordbreak search
		{
			/nextword exch def pop
			/restoftext exch def
		} {
			/nextword exch def
			/curwidth breakwidth neg def
			exit
		} ifelse
	} loop 
} def

/beginblock {
	/curwidth 0 def
	/line_length right_margin currentpoint pop sub def
	/spaces 0 def
} def

%
%	This routine, block, is an extensively extended version of the
%	BreakIntoLines routine described in the PostScript Language Tutorial
%	and Cookbook, Adobe Systems. It is based on Program 12 / A Simple
%	Line Breaking Algorithm on page 179, where the original version 
%	is fully documented.  The extensions include right justification
%	which is implemented in printline, underlining, colors, and multiple
%	fonts.
%

/block	{
	/textstring exch def
	/startchar 0 def
	/lastwordbreak 0 def
	/restoftext textstring def
	/breakwidth wordbreak stringwidth pop def

	{
		restoftext wordbreak search
		{
			/nextword exch def pop
			/restoftext exch def
			/wordwidth nextword stringwidth pop def

			exceeds_line_length
			{
				pushline printline skip_spaces
				/wordwidth nextword stringwidth pop def
				/startchar lastwordbreak def
				/spaces spaces 1 add def
				/curwidth wordwidth breakwidth add def
			} {
				/spaces spaces 1 add def
				/curwidth curwidth wordwidth add
					breakwidth add def
			} ifelse
			/lastwordbreak lastwordbreak
				nextword length add 1 add def
		} {
			/nextword exch def
			/wordwidth nextword stringwidth pop def
			exceeds_line_length
			{
				pushline printline
				/startchar lastwordbreak def
				/curwidth wordwidth def
			} {
				/curwidth wordwidth curwidth add def
			} ifelse
			exit
		} ifelse
	} loop
	pushrestofline
} def

/endblock {
	count 0 gt
	{
		/delta_space 0 def
		count counttomark idiv
		{
			count counttomark neg roll
			setcmykcolor setfont
			{ draw_under_line } if show pop
		} repeat
	} if
} def

/exceeds_line_length {
	curwidth wordwidth add breakwidth add line_length gt
	nextword (.) ne and nextword (,) ne and nextword (;) ne and
	nextword (") ne and nextword (?) ne and nextword (') ne and
	nextword (:) ne and nextword (\)) ne and
} def

%
%	Font control functions.
%

/font {
	dup /current_font exch def
	findfont font_size scalefont setfont
} def

/point {
	dup /font_size exch def
	2 add linespace
	current_font font
} def

/underline {
	/under_line true def
} def

/no_underline {
	/under_line false def
} def

%
%	Format control functions
%

/indent {
	leftmargin
} def

/leftmargin {
	72 mul dup /left_margin exch def
	currentline moveto
} def

/rightmargin {
	72 mul /right_margin exch def
} def

/linespace {
	/line_space exch def
} def

/newline {
	line_space mul currentline exch sub /currentline exch def
	left_margin currentline moveto
} def

%
%	Text display functions.
%

/sshow {
	/delta_space 0 def
	under_line { draw_under_line } if show
} def

/line	{
	sshow 1 newline
} def

/centered {
	dup pagewidth exch stringwidth pop sub 2 div currentline moveto
	sshow
} def

/column {
	dup right_margin exch stringwidth pop sub currentline moveto
	sshow
} def

%
%	The envelope formating routines.
%

/envelope_rotate {
	0 840 translate -90 rotate 12 rightmargin 12 point normal font
} def

/envelope_23x16cm {
	envelope_rotate 26 newline .6 indent 4 8
} def

/envelope_23x11cm {
	envelope_rotate 30 newline .4 indent 4 4
} def

/addressee {
	newline indent
} def

%
%	Give them all the funny characters.
%	BUG:  carriage return is mapped to i grave `.
%	FIX:  make sure all strings are continued to the next line with a "\".
%

/all_vec [
	8#000 /adieresis	% a umlaut
	8#001 /edieresis	% e umlaut
	8#002 /idieresis	% i umlaut
	8#003 /odieresis	% o umlaut
	8#004 /udieresis	% u umlaut
	8#005 /ydieresis	% y umlaut

	8#200 /Adieresis	% A umlaut
	8#201 /Edieresis	% E umlaut
	8#202 /Idieresis	% I umlaut
	8#203 /Odieresis	% O umlaut
	8#204 /Udieresis	% U umlaut
	8#205 /Ydieresis	% Y umlaut

	8#010 /agrave		% a grave `
	8#011 /egrave		% e grave `
	8#012 /igrave		% i grave `
	8#013 /ograve		% o grave `
	8#014 /ugrave		% u grave `

	8#210 /Agrave		% A grave `
	8#211 /Egrave		% E grave `
	8#212 /Igrave		% I grave `
	8#213 /Ograve		% O grave `
	8#214 /Ugrave		% U grave `

	8#015 /atilde		% a tilde ~
	8#016 /ntilde		% n tilde ~
	8#017 /otilde		% o tilde ~

	8#215 /Atilde		% A tilde ~
	8#216 /Ntilde		% N tilde ~
	8#217 /Otilde		% O tilde ~

	8#020 /aacute		% a acute '
	8#021 /eacute		% e acute '
	8#022 /iacute		% i acute '
	8#023 /oacute		% o acute '
	8#024 /uacute		% u acute '

	8#220 /Aacute		% A acute '
	8#221 /Eacute		% E acute '
	8#222 /Iacute		% I acute '
	8#223 /Oacute		% O acute '
	8#224 /Uacute		% U acute '
 
	8#025 /ccedilla		% c cedilla 
	8#026 /aring		% a ring 

	8#225 /Ccedilla		% C cedilla 
	8#226 /Aring		% A ring 

	8#030 /acircumflex	% a circumflex ^
	8#031 /ecircumflex	% e circumflex ^
	8#032 /icircumflex	% i circumflex ^
	8#033 /ocircumflex	% o circumflex ^
	8#034 /ucircumflex	% u circumflex ^

	8#230 /Acircumflex	% A circumflex ^
	8#231 /Ecircumflex	% E circumflex ^
	8#232 /Icircumflex	% I circumflex ^
	8#233 /Ocircumflex	% O circumflex ^
	8#234 /Ucircumflex	% U circumflex ^

	8#035 /scaron		% s caron 
	8#036 /zcaron		% z caron 

	8#235 /Scaron		% S caron 
	8#236 /Zcaron		% Z caron 
] def

/def_colors {
 	/red	 { 1 0 0 setrgbcolor } def
 	/green	 { 0 1 0 setrgbcolor } def
 	/blue	 { 0 0 1 setrgbcolor } def
 	/cyan	 { 1 0 0 0 setcmykcolor } def
 	/magenta { 0 1 0 0 setcmykcolor } def
 	/yellow	 { 0 0 1 0 setcmykcolor } def
 	/black	 { 0 0 0 1 setcmykcolor } def
} def

/no_colors {
	/setcmykcolor		{} def
	/currentcmykcolor	{} def
	/red			{} def
	/green			{} def
	/blue			{} def
	/cyan			{} def
	/magenta		{} def
	/yellow			{} def
	/black			{} def
} def

%
%	Checks to see if on a color PostScript device.
%	A real lousy test.  A product name with Color, color, or
%	COLOR in it means a color device?  I hope.
%

statusdict begin product end
(Color) search
{
	pop pop pop def_colors
}{
	(color) search
	{
		pop pop pop def_colors
	}{
		(COLOR) search
		{
			pop pop pop def_colors
		}{
			pop no_colors
		} ifelse
	} ifelse
} ifelse

%
%	Reencode and define the available fonts.
%

/Times-Roman		/Normal		all_vec		ReEncodeSmall
/Times-Bold		/Bold		all_vec		ReEncodeSmall
/Times-Italic		/Italic		all_vec		ReEncodeSmall
/Times-BoldItalic	/BoldItalic	all_vec		ReEncodeSmall

/normal			/Normal		def
/bold			/Bold		def
/italic			/Italic		def
/bolditalic		/BoldItalic	def

%
%	Page layout info.  For A4 paper.
%

/pagetop	11.7 72 mul			def
/pagewidth	 8.3 72 mul			def
/font_size	12				def
/line_space	14				def
/currentline	pagetop				def
/left_margin	0				def
/right_margin	pagewidth			def
/wordbreak	( )				def
/under_line	false				def
/current_font	normal				def
/line_length	right_margin left_margin sub	def

%
%	User defined procedures.
%

/Home_address {
	(G. Bruno Pape)		line
	(P.O. Box 368)		line
	(Thomaston, CT  06787)	line
} def


%
%	Sample document, the documentation, this is doc.ps.
%

.5 leftmargin 7.0 rightmargin 6 newline 18 point
bolditalic font (The One Page Processor) centered

2 newline 12 point bold font (Font Control:) line

1 newline 1.0 indent italic font (style) sshow bold font ( font) sshow
2.5 indent beginblock
normal font (Sets the current font to ) block italic font (style) block
normal font (.  Where) block italic font ( style) block
normal font ( is one of the following, normal,) block bold font ( bold,) block
italic font ( italic,) block normal font ( or) block bolditalic font
( bolditalic.) block endblock 2 newline

1.0 indent italic font (size) sshow bold font ( point) sshow
2.5 indent beginblock normal font (Sets the current character size to ) block
italic font (size) block normal font (.  Where ) block italic font (size) block
normal font ( is an integer or real number specifying the vertical \
height of the font in points.) block endblock 2 newline

1.0 indent bold font (underline) sshow
2.5 indent normal font (Initiates ) sshow underline (underlining) sshow
no_underline ( mode.) line

1 newline 1.0 indent bold font (no_underline) sshow
2.5 indent normal font (Terminates ) sshow underline (underlining) sshow
no_underline ( mode.) line

1 newline 1.0 indent italic font (color) sshow
2.5 indent beginblock normal font (Sets the current color,) block
italic font ( color ) block normal font (is one of the following, ) block
bold font red (red, ) block green (green, ) block blue (blue, ) block
yellow (yellow, ) block cyan (cyan, ) block magenta (magenta, ) block
black normal font (or ) block bold font (black.) block endblock

2 newline 12 point bold font .5 indent (Format Control:) line 1 newline
1.0 indent italic font (inches) sshow bold font ( rightmargin) sshow
2.5 indent normal font (Sets the right margin in inches.) line
1 newline
1.0 indent italic font (inches) sshow bold font ( indent) sshow
2.5 indent normal font (Sets the left margin in inches.) line
1.0 indent italic font (inches) sshow bold font ( leftmargin) line
1 newline
1.0 indent bold font (envelope_23x16cm) sshow
2.5 indent normal font
(Sets up return address formating for the two sizes of envelopes.) line
1.0 indent bold font (envelope_23x11cm) line
1 newline
1.0 indent bold font (addressee) sshow
2.5 indent normal font (Sets up addressee formating for either envelope.) line
1 newline
1.0 indent italic font (n) sshow bold font ( newline) sshow
2.5 indent normal font (Skips ) sshow italic font (n) sshow 
normal font ( lines, where ) sshow italic font (n) sshow 
normal font ( is an integer or real number.) line

2 newline 12 point bold font .5 indent (Text Display:) line
1 newline
1.0 indent italic font ((text)) sshow bold font ( line) sshow
2.5 indent beginblock normal font (Displays ) block italic font (text) block
normal font
( using the current font, size, color, and underline mode causes a newline.)
block endblock 2 newline

1.0 indent italic font ((text)) sshow bold font ( sshow) sshow
2.5 indent beginblock normal font (Displays ) block italic font (text) block
normal font ( using the current font, size, color, \
and underline mode does not cause a newline.) block endblock 2 newline

1.0 indent italic font ((text)) sshow bold font ( centered) sshow
2.5 indent beginblock
normal font (Centers ) block italic font (text) block
normal font ( on the page using the current font, character size, \
color, and underline mode does not cause a newline.) block endblock 2 newline

1.0 indent bold font (beginblock) sshow
2.5 indent beginblock normal font
(Begin block mode.  All subsequent text will be right justified.) block
endblock 2 newline

1.0 indent italic font ((text)) sshow bold font ( block) sshow
2.5 indent beginblock
normal font (Inserts text into the block using the current font, \
character size, color, and underlining mode.) block
endblock 2 newline

1.0 indent bold font (endblock) sshow
2.5 indent beginblock
normal font (End block mode.  Prints out any text remaining in the block.) block
endblock 2 newline

%
%	This is trailer.ps
%

showpage
%%Trailer
Technical Details
Message-ID: <1989Nov29.131039.22368@sgzh.uucp>
Path: arc1-ca.pugleaf.net!utzoo!attcan!utgpu!jarvis.csri.toronto.edu!mailrus!cs.utexas.edu!uunet!mcsun!cernvax!ethz!chx400!sgzh!root

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!attcan!utgpu!jarvis.csri.toronto.edu!mailrus!cs.utexas.edu!uunet!mcsun!cernvax!ethz!chx400!sgzh!root
From: root@sgzh.uucp (Bruno Pape)
Newsgroups: comp.lang.postscript
Subject: The One Page Processor, a PostScript word processor.
Keywords: PostScript, word processor, good software, free
Message-ID: <1989Nov29.131039.22368@sgzh.uucp>
Date: 29 Nov 89 13:10:39 GMT
Reply-To: Bruno Pape, P.O. Box 368, Thomaston CT, 06787, USA
Organization: None.
Lines: 661