Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | %%BeginProlog |
2 | 50 dict begin | |
3 | ||
4 | % This is a standard prolog for Postscript generated by Tk's canvas | |
5 | % widget. | |
6 | % RCS: @(#) $Id: prolog.ps,v 1.2 1999/04/16 01:51:09 stanton Exp $ | |
7 | ||
8 | % The definitions below just define all of the variables used in | |
9 | % any of the procedures here. This is needed for obscure reasons | |
10 | % explained on p. 716 of the Postscript manual (Section H.2.7, | |
11 | % "Initializing Variables," in the section on Encapsulated Postscript). | |
12 | ||
13 | /baseline 0 def | |
14 | /stipimage 0 def | |
15 | /height 0 def | |
16 | /justify 0 def | |
17 | /lineLength 0 def | |
18 | /spacing 0 def | |
19 | /stipple 0 def | |
20 | /strings 0 def | |
21 | /xoffset 0 def | |
22 | /yoffset 0 def | |
23 | /tmpstip null def | |
24 | ||
25 | % Define the array ISOLatin1Encoding (which specifies how characters are | |
26 | % encoded for ISO-8859-1 fonts), if it isn't already present (Postscript | |
27 | % level 2 is supposed to define it, but level 1 doesn't). | |
28 | ||
29 | systemdict /ISOLatin1Encoding known not { | |
30 | /ISOLatin1Encoding [ | |
31 | /space /space /space /space /space /space /space /space | |
32 | /space /space /space /space /space /space /space /space | |
33 | /space /space /space /space /space /space /space /space | |
34 | /space /space /space /space /space /space /space /space | |
35 | /space /exclam /quotedbl /numbersign /dollar /percent /ampersand | |
36 | /quoteright | |
37 | /parenleft /parenright /asterisk /plus /comma /minus /period /slash | |
38 | /zero /one /two /three /four /five /six /seven | |
39 | /eight /nine /colon /semicolon /less /equal /greater /question | |
40 | /at /A /B /C /D /E /F /G | |
41 | /H /I /J /K /L /M /N /O | |
42 | /P /Q /R /S /T /U /V /W | |
43 | /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore | |
44 | /quoteleft /a /b /c /d /e /f /g | |
45 | /h /i /j /k /l /m /n /o | |
46 | /p /q /r /s /t /u /v /w | |
47 | /x /y /z /braceleft /bar /braceright /asciitilde /space | |
48 | /space /space /space /space /space /space /space /space | |
49 | /space /space /space /space /space /space /space /space | |
50 | /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent | |
51 | /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron | |
52 | /space /exclamdown /cent /sterling /currency /yen /brokenbar /section | |
53 | /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen | |
54 | /registered /macron | |
55 | /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph | |
56 | /periodcentered | |
57 | /cedillar /onesuperior /ordmasculine /guillemotright /onequarter | |
58 | /onehalf /threequarters /questiondown | |
59 | /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla | |
60 | /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex | |
61 | /Idieresis | |
62 | /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply | |
63 | /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn | |
64 | /germandbls | |
65 | /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla | |
66 | /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex | |
67 | /idieresis | |
68 | /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide | |
69 | /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn | |
70 | /ydieresis | |
71 | ] def | |
72 | } if | |
73 | ||
74 | % font ISOEncode font | |
75 | % This procedure changes the encoding of a font from the default | |
76 | % Postscript encoding to ISOLatin1. It's typically invoked just | |
77 | % before invoking "setfont". The body of this procedure comes from | |
78 | % Section 5.6.1 of the Postscript book. | |
79 | ||
80 | /ISOEncode { | |
81 | dup length dict begin | |
82 | {1 index /FID ne {def} {pop pop} ifelse} forall | |
83 | /Encoding ISOLatin1Encoding def | |
84 | currentdict | |
85 | end | |
86 | ||
87 | % I'm not sure why it's necessary to use "definefont" on this new | |
88 | % font, but it seems to be important; just use the name "Temporary" | |
89 | % for the font. | |
90 | ||
91 | /Temporary exch definefont | |
92 | } bind def | |
93 | ||
94 | % StrokeClip | |
95 | % | |
96 | % This procedure converts the current path into a clip area under | |
97 | % the assumption of stroking. It's a bit tricky because some Postscript | |
98 | % interpreters get errors during strokepath for dashed lines. If | |
99 | % this happens then turn off dashes and try again. | |
100 | ||
101 | /StrokeClip { | |
102 | {strokepath} stopped { | |
103 | (This Postscript printer gets limitcheck overflows when) = | |
104 | (stippling dashed lines; lines will be printed solid instead.) = | |
105 | [] 0 setdash strokepath} if | |
106 | clip | |
107 | } bind def | |
108 | ||
109 | % desiredSize EvenPixels closestSize | |
110 | % | |
111 | % The procedure below is used for stippling. Given the optimal size | |
112 | % of a dot in a stipple pattern in the current user coordinate system, | |
113 | % compute the closest size that is an exact multiple of the device's | |
114 | % pixel size. This allows stipple patterns to be displayed without | |
115 | % aliasing effects. | |
116 | ||
117 | /EvenPixels { | |
118 | % Compute exact number of device pixels per stipple dot. | |
119 | dup 0 matrix currentmatrix dtransform | |
120 | dup mul exch dup mul add sqrt | |
121 | ||
122 | % Round to an integer, make sure the number is at least 1, and compute | |
123 | % user coord distance corresponding to this. | |
124 | dup round dup 1 lt {pop 1} if | |
125 | exch div mul | |
126 | } bind def | |
127 | ||
128 | % width height string StippleFill -- | |
129 | % | |
130 | % Given a path already set up and a clipping region generated from | |
131 | % it, this procedure will fill the clipping region with a stipple | |
132 | % pattern. "String" contains a proper image description of the | |
133 | % stipple pattern and "width" and "height" give its dimensions. Each | |
134 | % stipple dot is assumed to be about one unit across in the current | |
135 | % user coordinate system. This procedure trashes the graphics state. | |
136 | ||
137 | /StippleFill { | |
138 | % The following code is needed to work around a NeWSprint bug. | |
139 | ||
140 | /tmpstip 1 index def | |
141 | ||
142 | % Change the scaling so that one user unit in user coordinates | |
143 | % corresponds to the size of one stipple dot. | |
144 | 1 EvenPixels dup scale | |
145 | ||
146 | % Compute the bounding box occupied by the path (which is now | |
147 | % the clipping region), and round the lower coordinates down | |
148 | % to the nearest starting point for the stipple pattern. Be | |
149 | % careful about negative numbers, since the rounding works | |
150 | % differently on them. | |
151 | ||
152 | pathbbox | |
153 | 4 2 roll | |
154 | 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll | |
155 | 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll | |
156 | ||
157 | % Stack now: width height string y1 y2 x1 x2 | |
158 | % Below is a doubly-nested for loop to iterate across this area | |
159 | % in units of the stipple pattern size, going up columns then | |
160 | % across rows, blasting out a stipple-pattern-sized rectangle at | |
161 | % each position | |
162 | ||
163 | 6 index exch { | |
164 | 2 index 5 index 3 index { | |
165 | % Stack now: width height string y1 y2 x y | |
166 | ||
167 | gsave | |
168 | 1 index exch translate | |
169 | 5 index 5 index true matrix tmpstip imagemask | |
170 | grestore | |
171 | } for | |
172 | pop | |
173 | } for | |
174 | pop pop pop pop pop | |
175 | } bind def | |
176 | ||
177 | % -- AdjustColor -- | |
178 | % Given a color value already set for output by the caller, adjusts | |
179 | % that value to a grayscale or mono value if requested by the CL | |
180 | % variable. | |
181 | ||
182 | /AdjustColor { | |
183 | CL 2 lt { | |
184 | currentgray | |
185 | CL 0 eq { | |
186 | .5 lt {0} {1} ifelse | |
187 | } if | |
188 | setgray | |
189 | } if | |
190 | } bind def | |
191 | ||
192 | % x y strings spacing xoffset yoffset justify stipple DrawText -- | |
193 | % This procedure does all of the real work of drawing text. The | |
194 | % color and font must already have been set by the caller, and the | |
195 | % following arguments must be on the stack: | |
196 | % | |
197 | % x, y - Coordinates at which to draw text. | |
198 | % strings - An array of strings, one for each line of the text item, | |
199 | % in order from top to bottom. | |
200 | % spacing - Spacing between lines. | |
201 | % xoffset - Horizontal offset for text bbox relative to x and y: 0 for | |
202 | % nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. | |
203 | % yoffset - Vertical offset for text bbox relative to x and y: 0 for | |
204 | % nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. | |
205 | % justify - 0 for left justification, 0.5 for center, 1 for right justify. | |
206 | % stipple - Boolean value indicating whether or not text is to be | |
207 | % drawn in stippled fashion. If text is stippled, | |
208 | % procedure StippleText must have been defined to call | |
209 | % StippleFill in the right way. | |
210 | % | |
211 | % Also, when this procedure is invoked, the color and font must already | |
212 | % have been set for the text. | |
213 | ||
214 | /DrawText { | |
215 | /stipple exch def | |
216 | /justify exch def | |
217 | /yoffset exch def | |
218 | /xoffset exch def | |
219 | /spacing exch def | |
220 | /strings exch def | |
221 | ||
222 | % First scan through all of the text to find the widest line. | |
223 | ||
224 | /lineLength 0 def | |
225 | strings { | |
226 | stringwidth pop | |
227 | dup lineLength gt {/lineLength exch def} {pop} ifelse | |
228 | newpath | |
229 | } forall | |
230 | ||
231 | % Compute the baseline offset and the actual font height. | |
232 | ||
233 | 0 0 moveto (TXygqPZ) false charpath | |
234 | pathbbox dup /baseline exch def | |
235 | exch pop exch sub /height exch def pop | |
236 | newpath | |
237 | ||
238 | % Translate coordinates first so that the origin is at the upper-left | |
239 | % corner of the text's bounding box. Remember that x and y for | |
240 | % positioning are still on the stack. | |
241 | ||
242 | translate | |
243 | lineLength xoffset mul | |
244 | strings length 1 sub spacing mul height add yoffset mul translate | |
245 | ||
246 | % Now use the baseline and justification information to translate so | |
247 | % that the origin is at the baseline and positioning point for the | |
248 | % first line of text. | |
249 | ||
250 | justify lineLength mul baseline neg translate | |
251 | ||
252 | % Iterate over each of the lines to output it. For each line, | |
253 | % compute its width again so it can be properly justified, then | |
254 | % display it. | |
255 | ||
256 | strings { | |
257 | dup stringwidth pop | |
258 | justify neg mul 0 moveto | |
259 | stipple { | |
260 | ||
261 | % The text is stippled, so turn it into a path and print | |
262 | % by calling StippledText, which in turn calls StippleFill. | |
263 | % Unfortunately, many Postscript interpreters will get | |
264 | % overflow errors if we try to do the whole string at | |
265 | % once, so do it a character at a time. | |
266 | ||
267 | gsave | |
268 | /char (X) def | |
269 | { | |
270 | char 0 3 -1 roll put | |
271 | currentpoint | |
272 | gsave | |
273 | char true charpath clip StippleText | |
274 | grestore | |
275 | char stringwidth translate | |
276 | moveto | |
277 | } forall | |
278 | grestore | |
279 | } {show} ifelse | |
280 | 0 spacing neg translate | |
281 | } forall | |
282 | } bind def | |
283 | ||
284 | %%EndProlog |