lib/tk8.4/prolog.ps

   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