prolog.ps
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:9k
源码类别:

通讯编程

开发平台:

Visual C++

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