Article View: comp.lang.postscript
Article #1398The One Page Processor, a PostScript word processor.
From: Bruno Pape
Date: Wed, 29 Nov 1989 13:10
Date: Wed, 29 Nov 1989 13:10
661 lines
17651 bytes
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!rootShow 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