patwood@unirot.UUCP.UUCP (04/04/87)
The following shar contains the programs listed in the Premier Issue of
The PostScript Language Journal.
Pat Wood
Editor
--------------------------------cut here------------------------------
# To recover, type "sh archive"
echo restoring fonts
sed 's/^X//' > fonts <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Copyright (C) 1987 by Pipeline Associates, Inc.
X% Permission is granted to copy and distribute this file if
X% this message is left intact and nothing is charged for it.
X% list all available fonts
X
X/Helvetica findfont 10 scalefont setfont
X72 720 translate
X/name 80 string def
XFontDirectory
X{
X pop
X 0 0 moveto
X name cvs show
X 0 -10 translate
X} forall
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring fountain
sed 's/^X//' > fountain <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Copyright (C) 1987 by Pipeline Associates, Inc.
X% Permission is granted to copy and distribute this file if
X% this message is left intact and nothing is charged for it.
X% fountain
X
X/pica { 12 mul } def
X/inch { 72 mul } def
X
X% bitmap string for fountain
X/fstr 256 string def
X
X% fill with numbers from 0 to 255
X0 1 255 {fstr exch dup 1 add 257 div sqrt 255 mul cvi put}for
X
X% fountain procedure -- draw shaded area using fstr for grayscale
X% use: llx lly urx ury fountain
X/fountain {
X /ury exch def /urx exch def /lly exch def /llx exch def
X
X gsave
X % translate to lower-left corner
X llx lly translate
X
X % scale so that fountain is 1 unit on a side
X urx llx sub ury lly sub scale
X
X % use image operator to draw the fountain
X 256 1 8 [256 0 0 -1 0 1] { fstr } image
X
X grestore
X} def
X
X% box procedure -- draw box
X% use: llx lly urx ury box
X/box {
X gsave
X 1 setlinewidth
X /ury exch def /urx exch def /lly exch def /llx exch def
X
X llx lly moveto
X urx lly lineto
X urx ury lineto
X llx ury lineto
X closepath
X stroke
X grestore
X} def
X
X% center box and fountain on page
X8.5 inch % width of page
X45 pica sub % minus the width of the box
X2 div % divided in two
X57.5 pica translate
X
X% draw fountain and box, same coordinates
X0 0 45 pica 5 pica fountain
X0 0 45 pica 5 pica box
X
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring oneletter
sed 's/^X//' > oneletter <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Copyright (C) 1987 by Pipeline Associates, Inc.
X% Permission is granted to copy and distribute this file if
X% this message is left intact and nothing is charged for it.
X% Oneletter font
X
X/BuildCharDict 7 dict def
X
X% definitions of local commands
XBuildCharDict begin
X /xsize { % compute x width of font
X fontdict /FontMatrix get 0 get 1000 mul
X } def
X /ysize { % compute Y height of font
X fontdict /FontMatrix get 3 get 1000 mul
X } def
Xend
X
X/Myfont 7 dict def
X
X% new font's dictionary
XMyfont begin
X /FontType 3 def
X /FontMatrix [.001 0 0 .001 0 0] def
X /FontBBox [0 0 1000 1000] def
X /Encoding 256 array def
X
X % character encodings--default undefined
X 0 1 255 {Encoding exch /.notdef put} for
X
X % encoding for "a"--associate ascii value
X % of "a" with /a and Encoding dict
X Encoding (a) 0 get /a put
X
X % same for "b"
X Encoding (b) 0 get /b put
X
X /CharacterDefs 3 dict def
X
X % .notdef (default) character
X CharacterDefs /.notdef {} put
X
X % definition for letter "a"
X CharacterDefs /a {
X newpath
X
X % draw a rectangle--llh corner at (0,0)
X 0 0 moveto
X % horizontal lines scaled nonlinearly
X 500 xsize 10 mul 100 sub add 0 rlineto
X % vertical lines 500 units long
X 0 500 rlineto
X -500 xsize 10 mul 100 sub sub 0 rlineto
X 0 -500 rlineto
X
X closepath stroke
X } put
X
X
X % definition for letter "b"
X CharacterDefs /b {
X newpath
X
X % graphics to produce outline of "b"
X 35 -4 moveto
X -29 -5 -2 30 3 46 rcurveto
X
X % save current transform matrix
X /CTM [0 0 0 0 0 0] currentmatrix def
X
X % scale coordinate system
X ysize log sqrt dup scale
X
X % ascender drawing code
X 224 624 lineto
X 7 25 3 46 -8 70 rcurveto
X -14 30 -66 32 -65 39 rcurveto
X 1 10 44 10 114 37 rcurveto
X 51 19 84 25 129 51 rcurveto
X 11 6 20 11 8 -26 rcurveto
X
X % reset current transformation matrix
X % nullifies scaling above
X CTM setmatrix
X
X 281 432 lineto
X 0 -1 65 118 177 105 rcurveto
X 117 -14 190 -173 141 -307 rcurveto
X -49 -135 -146 -236 -277 -239 rcurveto
X -104 -3 -153 99 -160 95 rcurveto
X -13 7 -121 -89 -127 -90 rcurveto
X 257 38 rmoveto
X 134 -26 294 436 134 454 rcurveto
X -99 11 -155 -81 -160 -100 rcurveto
X -80 -254 rlineto
X -4 -15 0 -79 106 -100 rcurveto
X
X % fill character shape
X fill
X } put
X
X % routine that executes character procs
X /BuildChar {
X BuildCharDict begin % use local dict
X % current font dict and char on stack
X /char exch def
X /fontdict exch def
X
X % get character's name (i.e., /a)
X /charname fontdict /Encoding get
X char get def
X
X % get character's proc
X /charproc fontdict /CharacterDefs get
X charname get def
X 1000 0 setcharwidth
X
X % execute character's proc
X gsave charproc grestore
X end
X } def
Xend
X
X% register font with PostScript
X/Oneletter Myfont definefont pop
X
X/Oneletter findfont 10 scalefont setfont
X72 720 moveto
X(ab) show
X
X72 600 moveto
X/Oneletter findfont 20 scalefont setfont
X(ab) show
X
X72 480 moveto
X/Oneletter findfont 40 scalefont setfont
X(ab) show
X
X72 360 moveto
X/Oneletter findfont 60 scalefont setfont
X(ab) show
X
X72 240 moveto
X/Oneletter findfont 80 scalefont setfont
X(ab) show
X
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring print
sed 's/^X//' > print <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Copyright (C) 1987 by Pipeline Associates, Inc.
X% Permission is granted to copy and distribute this file if
X% this message is left intact and nothing is charged for it.
X% print input on PostScript printer
X
X/line 256 string def
X/Times-Roman findfont 12 scalefont setfont
X72 720 translate
X{
X 0 0 moveto
X currentfile line readline
X not { showpage exit } if
X show
X currentfont /FontBBox get dup 3 get
X exch 1 get sub
X currentfont /FontMatrix get 3 get mul
X neg 0 exch translate
X} loop
Xthis is a test
Xof a printing program
Xyou can put any text here
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring readme
sed 's/^X//' > readme <<\XxXxXxXxXx-EOF-XxXxXxXxXx
XThe following programs are from the first issue (1Q87) of the PostScript
XLanguage Journal. The first is from the Cover Art column; it produces
Xspiral text like that on the cover of the Journal. There are several
Xlines that can be commented out (with %); by commenting these lines you
Xcan produce circular text and normal spiral text. Note that this program
Xwill take about five minutes to run since rotated characters usually are
Xnot in the font cache and must be calculated separately.
X
XThe second file consists of the programs used to produce the starbursts on
Xthe sample pages in the Typesetting column. Note that because of the size
Xof the TARGA image (over 100K), we couldn't include it here. The third file
Xis the program used to produce the "fountain" or graduated gray bar at the
Xtop of the sample pages.
X
XThe fourth file is the font listing program from the Tips and Tricks
Xcolumn. The fifth file is the printing program from that column. The
Xsixth file is the definition of the "Oneletter" font from the last section
Xof the Tips and Tricks column. It has two characters defined: "a" and "b",
Xeach of which is described in the article.
X
XThere really isn't anything else in the Journal to post here, since the
Xprogram fragments used in the Tutorial aren't long enough to bother with.
X
XPat Wood
XEditor, The PostScript Language Journal
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring spiral
sed 's/^X//' > spiral <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Copyright (C) 1987 by Pipeline Associates, Inc.
X% Permission is granted to copy and distribute this file if
X% this message is left intact and nothing is charged for it.
X% spiral text
X
X/pi 3.1415923 def
X/str1 ( ) def
X
X/spiral {
X gsave
X /rad exch def % radius
X /ptsize exch def % point size
X /str exch def % string to show
X
X % use xrad for width computations...
X % fudged by adding 1/4 point size to
X % real radius; done to tighten up
X % intercharacter spacing
X /xrad rad ptsize 4 div add def
X
X % start spiral at lhs of page
X 180 rotate
X
X str {
X % ASCII value of char
X /charcode exch def
X
X % convert to string
X str1 0 charcode put
X
X % show string
X str1 angshow
X
X % comment out next line to produce circular text
X .995 .995 scale
X } forall
X grestore
X} def
X
X/angshow {
X /char exch def
X
X % angular "width" of character
X /angle char stringang def
X
X gsave
X
X % rotate through 1/2 char's width
X angle 2 div neg rotate
X
X % show character at end of radius
X rad 0 translate
X
X % char is perpendicular to radius
X -90 rotate
X
X % center character and show
X char stringwidth pop 2 div neg 0 moveto
X char show
X grestore
X
X % rotate through char's "width" to set
X % up next char
X angle neg rotate
X} def
X
X/stringang {
X stringwidth pop % x width of string
X 2 xrad mul pi mul % diameter of circle
X div 360 mul % convert to degrees
X} def
X
X120 120 translate
X/Times-Roman findfont 15 scalefont setfont
X
X% comment out the next line to get a normal spiral
X1 .3 scale
X
X(The PostScript Language Journal
X The PostScript Language Journal
X The PostScript Language Journal
X The PostScript Language Journal
X The PostScript Language Journal
X The PostScript Language Journal)
X 15 60 spiral
X
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring star
sed 's/^X//' > star <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Copyright (C) 1987 by Pipeline Associates, Inc.
X% Permission is granted to copy and distribute this file if
X% this message is left intact and nothing is charged for it.
X% star burst letters
X
X/inch { 72 mul } def
X.2 setlinewidth
X/Times-Bold findfont 100 scalefont setfont
X
Xgsave
X .25 inch 8 inch translate
X
X % get outline of string "ABC" and use as clipping path
X newpath 0 0 moveto (ABC) false charpath clip
X
X % fill characters with black
X 0 setgray fill
X
X % draw lines from bottom center of "ABC"
X (ABC) stringwidth pop 2 div 0 translate
X
X % now draw white lines
X 1 setgray
X 90 {
X 0 0 moveto
X 2 inch 0 rlineto stroke
X 2 rotate
X } repeat
Xgrestore
X
Xgsave
X .25 inch 6.75 inch translate
X /Helvetica-Bold findfont 100 scalefont setfont
X
X % get outline of string (ABC), stroke it AND use as clipping path
X newpath 0 0 moveto (ABC) false charpath clip stroke newpath
X
X % now draw black lines
X 90 {
X 0 0 moveto
X 4 inch 0 rlineto stroke
X 1 rotate
X } repeat
Xgrestore
X
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx