%%BeginProlog 50 dict begin % This is a standard prolog for Postscript generated by Tk's canvas % widget. % @(#) prolog.ps 1.2 94/12/09 10:53:18 % The definitions below just define all of the variables used in % any of the procedures here. This is needed for obscure reasons % explained on p. 716 of the Postscript manual (Section H.2.7, % "Initializing Variables," in the section on Encapsulated Postscript). /baseline 0 def /stipimage 0 def /height 0 def /justify 0 def /lineLength 0 def /spacing 0 def /stipple 0 def /strings 0 def /xoffset 0 def /yoffset 0 def /tmpstip null def % Define the array ISOLatin1Encoding (which specifies how characters are % encoded for ISO-8859-1 fonts), if it isn't already present (Postscript % level 2 is supposed to define it, but level 1 doesn't). systemdict /ISOLatin1Encoding known not { /ISOLatin1Encoding [ /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /exclam /quotedbl /numbersign /dollar /percent /ampersand /quoteright /parenleft /parenright /asterisk /plus /comma /minus /period /slash /zero /one /two /three /four /five /six /seven /eight /nine /colon /semicolon /less /equal /greater /question /at /A /B /C /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /space /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedillar /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ] def } if % Override the setfont procedure with a new procedure that re-encodes % the font to use the ISO Latin-1 style. The body of this procedure % comes from Section 5.6.1 of the Postscript book. /realsetfont /setfont load def /setfont { dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding ISOLatin1Encoding def currentdict end % I'm not sure why it's necessary to use "definefont" on this new % font, but it seems to be important; just use the name "Temporary" % for the font. /Temporary exch definefont realsetfont } bind def % StrokeClip % % This procedure converts the current path into a clip area under % the assumption of stroking. It's a bit tricky because some Postscript % interpreters get errors during strokepath for dashed lines. If % this happens then turn off dashes and try again. /StrokeClip { {strokepath} stopped { (This Postscript printer gets limitcheck overflows when) = (stippling dashed lines; lines will be printed solid instead.) = [] 0 setdash strokepath} if clip } bind def % desiredSize EvenPixels closestSize % % The procedure below is used for stippling. Given the optimal size % of a dot in a stipple pattern in the current user coordinate system, % compute the closest size that is an exact multiple of the device's % pixel size. This allows stipple patterns to be displayed without % aliasing effects. /EvenPixels { % Compute exact number of device pixels per stipple dot. dup 0 matrix currentmatrix dtransform dup mul exch dup mul add sqrt % Round to an integer, make sure the number is at least 1, and compute % user coord distance corresponding to this. dup round dup 1 lt {pop 1} if exch div mul } bind def % width height string StippleFill -- % % Given a path already set up and a clipping region generated from % it, this procedure will fill the clipping region with a stipple % pattern. "String" contains a proper image description of the % stipple pattern and "width" and "height" give its dimensions. Each % stipple dot is assumed to be about one unit across in the current % user coordinate system. This procedure trashes the graphics state. /StippleFill { % The following code is needed to work around a NeWSprint bug. /tmpstip 1 index def % Change the scaling so that one user unit in user coordinates % corresponds to the size of one stipple dot. 1 EvenPixels dup scale % Compute the bounding box occupied by the path (which is now % the clipping region), and round the lower coordinates down % to the nearest starting point for the stipple pattern. Be % careful about negative numbers, since the rounding works % differently on them. pathbbox 4 2 roll 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll % Stack now: width height string y1 y2 x1 x2 % Below is a doubly-nested for loop to iterate across this area % in units of the stipple pattern size, going up columns then % across rows, blasting out a stipple-pattern-sized rectangle at % each position 6 index exch { 2 index 5 index 3 index { % Stack now: width height string y1 y2 x y gsave 1 index exch translate 5 index 5 index true matrix tmpstip imagemask grestore } for pop } for pop pop pop pop pop } bind def % -- AdjustColor -- % Given a color value already set for output by the caller, adjusts % that value to a grayscale or mono value if requested by the CL % variable. /AdjustColor { CL 2 lt { currentgray CL 0 eq { .5 lt {0} {1} ifelse } if setgray } if } bind def % x y strings lineLength spacing xoffset yoffset justify stipple DrawText -- % This procedure does all of the real work of drawing text. The % color and font must already have been set by the caller, and the % following arguments must be on the stack: % % x, y - Coordinates at which to draw text. % strings - An array of strings, one for each line of the text item, % in order from top to bottom. % lineLength - Minimum line length: needed to justify text properly. % spacing - Spacing between lines. % xoffset - Horizontal offset for text bbox relative to x and y: 0 for % nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. % yoffset - Vertical offset for text bbox relative to x and y: 0 for % nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. % justify - 0 for left justification, 0.5 for center, 1 for right justify. % stipple - Boolean value indicating whether or not text is to be % drawn in stippled fashion. If text is stippled, % procedure StippleText must have been defined to call % StippleFill in the right way. % % Also, when this procedure is invoked, the color and font must already % have been set for the text. /DrawText { /stipple exch def /justify exch def /yoffset exch def /xoffset exch def /spacing exch def /lineLength exch def /strings exch def % First scan through all of the text to find the widest line (if it's % longer than the "lineLength" argument). strings { stringwidth pop dup lineLength gt {/lineLength exch def} {pop} ifelse newpath } forall % Compute the baseline offset and the actual font height. 0 0 moveto (TXygqPZ) false charpath pathbbox dup /baseline exch def exch pop exch sub /height exch def pop newpath % Translate coordinates first so that the origin is at the upper-left % corner of the text's bounding box. Remember that x and y for % positioning are still on the stack. translate lineLength xoffset mul strings length 1 sub spacing mul height add yoffset mul translate % Now use the baseline and justification information to translate so % that the origin is at the baseline and positioning point for the % first line of text. justify lineLength mul baseline neg translate % Iterate over each of the lines to output it. For each line, % compute its width again so it can be properly justified, then % display it. strings { dup stringwidth pop justify neg mul 0 moveto stipple { % The text is stippled, so turn it into a path and print % by calling StippledText, which in turn calls StippleFill. % Unfortunately, many Postscript interpreters will get % overflow errors if we try to do the whole string at % once, so do it a character at a time. gsave /char (X) def { char 0 3 -1 roll put currentpoint gsave char true charpath clip StippleText grestore char stringwidth translate moveto } forall grestore } {show} ifelse 0 spacing neg translate } forall } bind def %%EndProlog