[comp.text.desktop] Postscript programs from the Postscript Language Journal

news@sun.uucp (news) (08/10/87)

# To recover, type "sh archive"
echo restoring readme
sed 's/^X//' > readme <<\XxXxXxXxXx-EOF-XxXxXxXxXx
XThe following programs are from the second issue (2Q87) of the PostScript
XLanguage Journal.
X
XProgram fragments from the Tutorial were too short or simple to list here,
Xand in general, any piece of PostScript code less than 8 lines long wasn't
Xincluded.
X
XPat Wood
XEditor, The PostScript Language Journal
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring CART.PS
sed 's/^X//' > CART.PS <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% cover art fountain #1 (P. 13)
X72 72 translate		% translate origin
X
X/fountstring 256 string def
X0 1 255 { fountstring exch dup put } for
X
X432 60 scale
X256 1 8 [256 0 0 1 0 0]
X{ fountstring } image
Xshowpage
X%-----------------------------cut here--------------------------
X%!
X% cover art fountain #2 (P. 14)
X72 72 translate		% translate origin
X/fountstring 256 string def
X
X0 1 255 {
X	fountstring exch
X	dup 255 div
X	sqrt 255 mul
X	cvi put
X} for
X
X432 60 scale
X256 1 8 [256 0 0 1 0 0]
X{ fountstring } image
Xshowpage
X%-----------------------------cut here--------------------------
X%!
X% cover art fountain #3 (P. 14)
X18 18 translate		% translate origin
X
X/pica { 12 mul } def
X/fountstring 256 string def
X0 1 255 {
X	fountstring exch
X	dup 255 div sqrt 255 mul
X	cvi put
X} for
X
X
X% print fountain
Xgsave
X	0 30 pica translate
X	-90 rotate
X	23 pica 51 pica scale
X	256 1 8 [256 0 0 1 0 0]
X	{ fountstring } image
Xgrestore
X
X/Helvetica findfont 40 scalefont setfont
X
X% do shadow letters
X.5 setgray
X50 160 moveto
Xgsave
X	[1 .5 2.5 -.1 0 0] concat
X	(THE) show
Xgrestore
X150 160 moveto
Xgsave
X	[1 .5 2.5 -.1 0 0] concat
X	(POSTSCRIPT) show
Xgrestore
X250 160 moveto
Xgsave
X	[1 .5 2.5 -.1 0 0] concat
X	(LANGUAGE) show
Xgrestore
X350 160 moveto
Xgsave
X	[1 .5 2.5 -.1 0 0] concat
X	(JOURNAL) show
Xgrestore
X
X% now do black text
X0 setgray
X50 160 moveto
Xgsave
X	[1 .5 0 1 0 0] concat
X	(THE) show
Xgrestore
X150 160 moveto
Xgsave
X	[1 .5 0 1 0 0] concat
X	(POSTSCRIPT) show
Xgrestore
X250 160 moveto
Xgsave
X	[1 .5 0 1 0 0] concat
X	(LANGUAGE) show
Xgrestore
X350 160 moveto
Xgsave
X	[1 .5 0 1 0 0] concat
X	(JOURNAL) show
Xgrestore
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring DESIGN.PS
sed 's/^X//' > DESIGN.PS <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Paul Beyer's graphics (P. 35)
X
X/R { /Times-Roman  findfont 160 scalefont setfont   
X        0 0  moveto (R) true charpath .2 setlinewidth stroke } def
X
X/Rwhite { /Times-Roman  findfont 160 scalefont setfont   
X 0 0  moveto (R) true charpath gsave 1 setgray fill grestore .2 setlinewidth stroke } def
X
X/Rzz {1 -.01 0 { .968 .968 scale 3 sub 1.5 translate -5 rotate R  } for } def
X
X/Rzipp { gsave  0 0 translate Rzz grestore } def
X
X/Recur { gsave 120 330 translate Rzipp Rwhite grestore } def
X
X
X/At {/Times-Roman findfont [320 0 0 300 0 0] makefont setfont
X 0 0 moveto (T) true charpath .255 setlinewidth stroke} def
X
X/Tip {1 -.01 0 { .965 .955 scale .555 sub 1.2 translate  At  } for } def
X
X/Tzip { gsave 70 50 translate Tip  grestore } def
X
X
X%%Column 2 
X
X
X/Postr {/Times-Bold findfont [24 0 0 26 0 0] makefont setfont 
X  gsave 270 615 translate 	
X            0 0 moveto 12 0 ( OST CRIPT) ashow  
X   gsave 1.295 1.295 scale -7 0 moveto (P) show
X         75.2  0 moveto (S) show grestore 
X      /Times-Bold findfont [24 0 0 12 0 0] makefont setfont 
X           -26 -40 moveto 14 0 (Perspectives)  ashow } def
X 
X/HL { newpath 0 0 moveto 300 0 rlineto .3 setlinewidth stroke 0 5.5 translate } def
X
X/VL {newpath 0 0 moveto 0 400 rlineto .3 setlinewidth stroke 5.5 0 translate } def
X
X/HLines {gsave   410 {HL} repeat grestore } def
X
X/VLines { gsave  380 {VL} repeat grestore } def
X
X/Grid { gsave 0 0 translate HLines VLines grestore } def
X
X/Xit
X { /Helvetica-Bold findfont [420 0 0 385 0 0] makefont setfont
X    gsave 250 460 translate
X   0 0  moveto (X) true charpath  clip HLines gsave .25 setlinewidth stroke grestore
Xgrestore } def
X
X/Yit
X { /Helvetica-Bold findfont [452.5 0 0 310 0 0] makefont setfont
X    gsave 237 460 translate
X   0 0  moveto (Y) true charpath gsave .25 setlinewidth stroke grestore
X clip VLines 
Xgrestore } def
X
X
X/fountainstring 256 string def	
X 0 1 255
X {fountainstring exch dup			    
X   255 div 180 mul cos neg 2 div 	
X   .5 add 255 mul cvi				     
X   put } for
X  
X/fountain 				               	
X { /ury exch def  /urx exch def			
X   /lly exch def  /llx exch def			
X   gsave
X       llx lly translate
X       urx llx sub ury lly sub scale					                   	
X       1 255 8  [1 0 0 -256 0 256]	{fountainstring} image grestore} def
X
X/Linefountain {gsave   8 0 moveto  
X  0 0 150 20 fountain grestore } def
X
X
X/Rad { gsave  84 68 translate  0 45 360 { gsave rotate 0 0 moveto 
XLinefountain grestore} for grestore } def
X
X/Graphic {/Helvetica-Bold findfont [230 0 0 240 0 0] makefont setfont
X  0 0 moveto  (A) true charpath 
Xgsave .4 setlinewidth stroke  grestore  } def
X
X/Graphic2 {/Helvetica-Bold findfont [230 0 0 240 0 0] makefont setfont
X  0 0 moveto  (A) true charpath 
Xgsave .4 setlinewidth stroke  grestore  } def
X
X
X/nova {0 0 moveto 0 0 100 0 360 arc fill } def
X
X/Star {gsave .999 -.00375 .05 {setgray .993 .993 scale 0 0 moveto nova
X0 0 translate } for grestore } def
X
X/Dez {/Helvetica-Bold findfont [30 0 0 65 0 0] makefont setfont
X  -83 -22 moveto  (DESIGNING) true charpath gsave 1 setgray fill grestore
Xgsave .4 setlinewidth stroke  grestore
X
X/Helvetica-Bold findfont [13 0 0 20 0 0] makefont setfont
X -16 -62 moveto  (with) true charpath gsave 1 setgray fill grestore
X gsave .4 setlinewidth stroke  grestore
X
X/Helvetica-Bold findfont [30 0 0 30 0 0] makefont setfont
X -83 -105 moveto 1.45 0 (PostScript) ashow } def
X
X/Zero { gsave 450 140 translate Star Dez grestore } def
X
X/BigA {gsave 370 282 translate Graphic clip Rad Graphic2 grestore } def
X
X/XYScreen { save 220 235 translate  .59 .59 scale Xit Yit Postr restore } def
X
XRecur 
XTzip
XXYScreen
XBigA
XZero
X
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring G2ED.PS
sed 's/^X//' > G2ED.PS <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Graphic to the editor (P. 48)
X/onechar 1 string def
X
X/halfwidth {                               % 1/2 width of string
X    stringwidth pop 2 div
X} def
X
X/pshow {                                   % font point-size pivot-height string pshow
X    /strg exch def                         % string to show
X    /pheight exch def
X    /fontsize exch def
X    /font exch def
X    fontsize pheight abs gt                % make sure abs (pheight) > fontsize
X    {
X        pheight dup abs div fontsize mul   % replace pheight with fontsize
X    } if
X    font findfont fontsize scalefont setfont
X    currentpoint pop /midx exch def        % middle of string
X    /halfw strg halfwidth def              % 1/2 string width
X    halfw neg 0 rmoveto                    % start of string
X    onechar 0 strg 0 get put               % put first char of string in onechar
X    halfw onechar halfwidth sub            % dist from ctr of string to ctr of char
X    pheight div fontsize mul               % tangent of angle from char to pivot
X    /tang exch def                         % point and horizontal
X    font findfont [ fontsize 0 tang fontsize 0 0 ] makefont setfont
X    {                                      % stack starts with char1 char2
X        currentpoint pop exch              % char1 x char2
X        onechar exch 0 exch put            % put char2 in onechar
X        onechar halfwidth add              % add current x and 1/2 width of char2
X        midx exch sub                      % subtract from midx (dx from middle of str)
X        pheight div fontsize mul           % this char's tangent
X        /tang exch def
X        pop                                % don't need char1
X        font findfont [ fontsize 0 tang fontsize 0 0 ] makefont setfont
X    } strg kshow
X} def
X
X% print out address
X306 612 moveto /Times-Roman 24 108 (Editor) pshow
X306 576 moveto /Times-Roman 24 144 (The PostScript Language Journal) pshow
X306 540 moveto /Times-Roman 24 180 (P.O. Box 5763) pshow
X306 504 moveto /Times-Roman 24 216 (Parsippany, NJ  07054) pshow
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring GRAYS.PS
sed 's/^X//' > GRAYS.PS <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% grayscale transfer array--map LW grays for better contrast (P. 17)
X
X/transferarray
X    [ 0  0  0  1  2  3  4  5  6  7
X      8  9 10 11 12 13 14 15 16 17
X     18 20 22 24 26 28 31 34 37 40
X     42 44 46 48 49 51 52 54 55 57
X     59 60 62 63 65 66 68 69 71 72
X     72 73 74 75 76 77 78 78 79 80
X     81 82 83 83 84 85 85 86 87 87
X     88 88 89 89 90 90 91 91 92 92
X     93 93 94 94 95 95 96 96 97 97
X     97 97 98 98 98 98 99 99 100 100 100
X    ] def
X{
X	100 mul round cvi 100 div
X	/transferarray exch get
X} settransfer
X%-----------------------------cut here--------------------------
X%! grayscale tranfer program--map Lino grays to LW (P. 19)
X
X{
X    60 mul 15 add 100 div
X
X    % "clamp" everything below .15001 to 0
X    dup .15001 lt
X    { pop 0 } if
X
X    % "clamp" everything above .74999 to 1
X    dup .74999 gt
X    { pop 1 } if
X} settransfer
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring IPRESS.PS
sed 's/^X//' > IPRESS.PS <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Interpress Figure 2. (listing on P. 35)
X
X/Times-Bold findfont 50 scalefont setfont
X/rotatetext
X{
X    dup 1 exch sub setgray
X    -20 rotate
X    0 47 moveto
X    (Interpress) show
X    0.035 add
X    dup
X    0.910 exch gt
X    { dup }
X    { exit }
X    ifelse
X} def
X
X320 410 translate
X0.305 /rotatetext load loop
Xshowpage
X%-----------------------------cut here--------------------------
X%!
X% Interpress Figure 3. (listing on P. 36)
X
X/Helvetica findfont 10 scalefont setfont
X10 10 scale
Xgsave
X    0.5 setgray
X    10 50 moveto
X    [ 1 0 2 -1 0 0 ] concat
X    (Shadow) show
Xgrestore
X10 50 moveto
X(Shadow) show
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring TIPS.PS
sed 's/^X//' > TIPS.PS <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%!
X% Tips & tricks setscreen #1 (P. 21)
X72 72 translate
X
X/inch { 72 mul } def
X/box {
X	0 1 inch rlineto
X	1 inch 0 rlineto
X	0 -1 inch rlineto
X	closepath
X} def
X
X.5 setgray
X15 0 { dup mul exch dup mul add 1 exch sub }
X	setscreen
X.5 inch .5 inch moveto box fill
X15 0 { dup mul exch dup mul add 1 sub }
X	setscreen
X2 inch .5 inch moveto box fill
Xshowpage
X%--------------------------------cut here--------------------------
X%!
X% Tips & tricks setscreen #2 (P. 22)
X72 72 translate
X
X/inch { 72 mul } def
X/box {
X	0 1 inch rlineto
X	1 inch 0 rlineto
X	0 -1 inch rlineto
X	closepath
X} def
X
X.5 setgray
X15 0 { exch pop } setscreen
X1.25 inch .5 inch moveto box fill
Xshowpage
X%--------------------------------cut here--------------------------
X%!
X% Tips & tricks setscreen #3 (P. 22)
X/inch { 72 mul } def
X
X30 0 { exch pop } setscreen
X
X.7 setgray
X0 0 moveto
X8.5 inch 0 rlineto
X0 .5 inch rlineto
X-8.5 inch 0 rlineto fill
X
X.2 setgray
X/Times-Bold findfont 36 scalefont setfont
X3.5 inch 6 moveto
X(TIPS AND TRICKS) show
Xshowpage
X%--------------------------------cut here--------------------------
X%!
X% Tips & tricks inset (P. 23)
X/screen {  	%  freq ang str screen
X	/str exch def
X	/ang exch def
X	/freq exch def
X	gsave
X		1 setlinewidth
X		gsave str true charpath stroke grestore
X		freq ang { exch pop } setscreen
X		.5 setgray str show currentpoint
X	grestore
X	moveto
X} def
X
X/Times-Italic findfont 75 scalefont setfont
X36 36 moveto
X25 0  (A) screen
X10 45 (B) screen
Xshowpage
XxXxXxXxXx-EOF-XxXxXxXxXx
----------------------------------------
Submissions to:   desktop%plaid@sun.com -OR- sun!plaid!desktop
Administrivia to: desktop-request%plaid@sun.com -OR- sun!plaid!desktop-request
Paths:  {ihnp4,decwrl,hplabs,seismo,ucbvax}!sun
Chuq Von Rospach	chuq@sun.COM		Delphi: CHUQ

We live and learn, but not the wiser grow -- John Pomfret (1667-1703)