home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.0 / stk-3 / blt-for-STk-3.0 / blt-1.9 / library / bltGraph.pro next >
Encoding:
Text File  |  1995-07-01  |  8.9 KB  |  323 lines
  1. %
  2. % PostScript prolog file of the graph widget for Tk.
  3. %
  4. % Copyright 1989-1992 Regents of the University of California.
  5. % Permission to use, copy, modify, and distribute this
  6. % software and its documentation for any purpose and without
  7. % fee is hereby granted, provided that the above copyright
  8. % notice appear in all copies.  The University of California
  9. % makes no representations about the suitability of this
  10. % software for any purpose.  It is provided "as is" without
  11. % express or implied warranty.
  12. %
  13. % Copyright 1991-1994 by AT&T Bell Laboratories.
  14. % Permission to use, copy, modify, and distribute this software
  15. % and its documentation for any purpose and without fee is hereby
  16. % granted, provided that the above copyright notice appear in all
  17. % copies and that both that the copyright notice and warranty
  18. % disclaimer appear in supporting documentation, and that the
  19. % names of AT&T Bell Laboratories any of their entities not be used
  20. % in advertising or publicity pertaining to distribution of the
  21. % software without specific, written prior permission.
  22. %
  23. % AT&T disclaims all warranties with regard to this software, including
  24. % all implied warranties of merchantability and fitness.  In no event
  25. % shall AT&T be liable for any special, indirect or consequential
  26. % damages or any damages whatsoever resulting from loss of use, data
  27. % or profits, whether in an action of contract, negligence or other
  28. % tortuous action, arising out of or in connection with the use or
  29. % performance of this software.
  30. %
  31.  
  32. 200 dict begin
  33.  
  34. /BgColorProc 0 def    % Background color procedure (for symbols)
  35. /BorderProc 0 def    % Border outline procedure (for symbols)
  36. /StippleProc 0 def    % Stipple procedure (for bar segments)
  37. /DashesProc 0 def    % Dashes procedure (for line segments)
  38.  
  39. /encoding {ISOLatin1Encoding} def
  40. systemdict /encodefont known {
  41.     /realsetfont /setfont load def
  42.     /setfont { encoding encodefont realsetfont } def
  43. } if
  44.  
  45. /Stroke { gsave stroke grestore } def
  46.  
  47. /Fill { gsave fill grestore } def
  48.  
  49. /SetFont {     % Stack: pointSize fontName
  50.     findfont exch scalefont setfont
  51. } def
  52.  
  53. /SetDashes {        % Stack: numDashes
  54.     dup 0 eq { pop [] 0 setdash } { 1 array astore 0 setdash } ifelse
  55. } def
  56.  
  57. /Box {            % Stack: x y width height
  58.     newpath
  59.         exch 4 2 roll moveto
  60.         dup 0 rlineto
  61.         exch 0 exch rlineto
  62.         neg 0 rlineto
  63.     closepath
  64. } def
  65.  
  66. /SetFgColor {        % Stack: red green blue
  67.     CL 0 eq { pop pop pop 0 0 0 } if
  68.     setrgbcolor
  69.     CL 1 eq { currentgray setgray } if
  70. } def
  71.  
  72. /SetBgColor {        % Stack: red green blue
  73.     CL 0 eq { pop pop pop 1 1 1 } if
  74.     setrgbcolor
  75.     CL 1 eq { currentgray setgray } if
  76. } def
  77.  
  78. % The next two definitions are taken from "$tk_library/prolog.ps"
  79.  
  80. % desiredSize EvenPixels closestSize
  81. %
  82. % The procedure below is used for stippling.  Given the optimal size
  83. % of a dot in a stipple pattern in the current user coordinate system,
  84. % compute the closest size that is an exact multiple of the device's
  85. % pixel size.  This allows stipple patterns to be displayed without
  86. % aliasing effects.
  87.  
  88. /EvenPixels {
  89.     % Compute exact number of device pixels per stipple dot.
  90.     dup 0 matrix currentmatrix dtransform
  91.     dup mul exch dup mul add sqrt
  92.  
  93.     % Round to an integer, make sure the number is at least 1, and compute
  94.     % user coord distance corresponding to this.
  95.     dup round dup 1 lt {pop 1} if
  96.     exch div mul
  97. } bind def
  98.  
  99. % width height string filled StippleFill --
  100. %
  101. % Given a path and other graphics information already set up, this
  102. % procedure will fill the current path in a stippled fashion.  "String"
  103. % contains a proper image description of the stipple pattern and
  104. % "width" and "height" give its dimensions.  If "filled" is true then
  105. % it means that the area to be stippled is gotten by filling the
  106. % current path (e.g. the interior of a polygon); if it's false, the
  107. % area is gotten by stroking the current path (e.g. a wide line).
  108. % Each stipple dot is assumed to be about one unit across in the
  109. % current user coordinate system.
  110.  
  111. /StippleFill {
  112.     % Turn the path into a clip region that we can then cover with
  113.     % lots of images corresponding to the stipple pattern.  Warning:
  114.     % some Postscript interpreters get errors during strokepath for
  115.     % dashed lines.  If this happens, turn off dashes and try again.
  116.  
  117.     gsave
  118.     {eoclip}
  119.     {{strokepath} stopped {grestore gsave [] 0 setdash strokepath} if clip}
  120.     ifelse
  121.  
  122.     % Change the scaling so that one user unit in user coordinates
  123.     % corresponds to the size of one stipple dot.
  124.     1 EvenPixels dup scale
  125.  
  126.     % Compute the bounding box occupied by the path (which is now
  127.     % the clipping region), and round the lower coordinates down
  128.     % to the nearest starting point for the stipple pattern.
  129.  
  130.     pathbbox
  131.     4 2 roll
  132.     5 index div cvi 5 index mul 4 1 roll
  133.     6 index div cvi 6 index mul 3 2 roll
  134.  
  135.     % Stack now: width height string y1 y2 x1 x2
  136.     % Below is a doubly-nested for loop to iterate across this area
  137.     % in units of the stipple pattern size, going up columns then
  138.     % across rows, blasting out a stipple-pattern-sized rectangle at
  139.     % each position
  140.  
  141.     6 index exch {
  142.     2 index 5 index 3 index {
  143.         % Stack now: width height string y1 y2 x y
  144.  
  145.         gsave
  146.         1 index exch translate
  147.         5 index 5 index true matrix {3 index} imagemask
  148.         grestore
  149.     } for
  150.     pop
  151.     } for
  152.     pop pop pop pop pop
  153.     grestore
  154.     newpath
  155. } bind def
  156.  
  157. /DrawSegment {    % Stack: x1 y1 x2 y2
  158.     newpath 4 2 roll moveto lineto stroke
  159. } def
  160.  
  161. /DrawText {        % Stack: ?bgColorProc? boolean centerX centerY
  162.             %      strWidth strHeight baseline theta str
  163.     gsave
  164.     7 -2 roll translate    % Translate to center of bounding box
  165.     exch neg rotate        % Rotate by theta
  166.     exch 4 2 roll
  167.     2 copy 2 copy 2 copy
  168.  
  169.     % If needed, draw the background area, setting the bg color
  170.  
  171.     -0.5 mul exch -0.5 mul exch 4 -2 roll Box
  172.         7 -1 roll { gsave 7 -1 roll exec fill grestore } if
  173.  
  174.     % Move to the text string starting position
  175.  
  176.     -.5  mul 5 -1 roll add exch -.5 mul exch moveto
  177.     pop exch dup dup 4 2 roll
  178.  
  179.         % Adjust character widths to get desired overall string width
  180.         % adjust X = (desired width - real width) / #chars
  181.  
  182.      stringwidth pop sub exch length div 0 3 -1 roll
  183.  
  184.     % Flip back the scale so that the string is not drawn in reverse
  185.  
  186.     1 -1 scale
  187.     ashow
  188.     grestore
  189. } def
  190.  
  191. /DrawBitmap {        % Stack: ?bgColorProc? boolean centerX centerY
  192.             %     width height theta imageStr
  193.     gsave
  194.     6 -2 roll translate    % Translate to center of bounding box
  195.     4 1 roll neg rotate    % Rotate by theta
  196.  
  197.     % Find upperleft corner of bounding box
  198.  
  199.     2 copy -.5 mul exch -.5 mul exch translate
  200.     2 copy scale        % Make pixel unit scale
  201.         newpath
  202.             0 0 moveto 0 1 lineto 1 1 lineto 1 0 lineto
  203.         closepath
  204.  
  205.     % Fill rectangle with background color
  206.  
  207.     4 -1 roll { gsave 4 -1 roll exec fill grestore } if
  208.  
  209.     % Paint the image string into the unit rectangle
  210.  
  211.     2 copy true 3 -1 roll 0 0 5 -1 roll 0 0 6 array astore 5 -1 roll
  212.         imagemask
  213.     grestore
  214. }def
  215.  
  216. % Symbols:
  217.  
  218. % Skinny-cross
  219. /Sc {            % Stack: x y symbolSize
  220.     gsave
  221.     3 -2 roll translate 45 rotate
  222.     0 0 3 -1 roll Sp
  223.     grestore
  224. } def
  225.  
  226. % Skinny-plus
  227. /Sp {            % Stack: x y symbolSize
  228.     gsave
  229.     3 -2 roll translate
  230.     2 idiv      % Stack: radius
  231.     dup 2 copy    % Stack: radius radius radius radius
  232.     newpath neg 0 moveto 0 lineto
  233.     gsave BgColorProc fill grestore stroke
  234.     newpath neg 0 exch moveto 0 exch lineto
  235.     gsave BgColorProc fill grestore stroke
  236.     grestore
  237. } def
  238.  
  239. % Cross
  240. /Cr {            % Stack: x y symbolSize
  241.     gsave
  242.     3 -2 roll translate 45 rotate
  243.     0 0 3 -1 roll Pl
  244.     grestore
  245. } def
  246.  
  247. % Plus
  248. /Pl {            % Stack: x y symbolSize
  249.     gsave
  250.     3 -2 roll translate
  251.     dup 2 idiv      % Stack: size radius
  252.     exch 6 idiv     % Stack: radius delta
  253.  
  254.     %
  255.     %          2   3    The plus/cross symbol is a
  256.     %            closed polygon of 12 points.
  257.     %      0   1   4    5    The diagram to the left
  258.     %           x,y        represents the positions of
  259.     %     11  10   7    6    the points which are computed
  260.     %            below.
  261.     %          9   8
  262.     %
  263.  
  264.     newpath
  265.         2 copy exch neg exch neg moveto dup neg dup lineto
  266.         2 copy neg exch neg lineto 2 copy exch neg lineto
  267.         dup dup neg lineto 2 copy neg lineto 2 copy lineto
  268.         dup dup lineto 2 copy exch lineto 2 copy neg exch lineto
  269.         dup dup neg exch lineto exch neg exch lineto
  270.     closepath
  271.     Fill BorderProc
  272.     grestore
  273. } def
  274.  
  275. % Circle
  276. /Ci {            % Stack: x y symbolSize
  277.     3 copy pop
  278.     moveto newpath
  279.         2 div 0 360 arc
  280.     closepath Fill BorderProc
  281. } def
  282.  
  283. % Square
  284. /Sq {            % Stack: x y symbolSize
  285.     dup dup 2 div dup
  286.     6 -1 roll exch sub exch
  287.     5 -1 roll exch sub 4 -2 roll Box
  288.     Fill BorderProc
  289. } def
  290.  
  291. % Line
  292. /Li {            % Stack: x y symbolSize
  293.     3 1 roll exch 3 -1 roll 2 div 3 copy
  294.     newpath
  295.         sub exch moveto add exch lineto
  296.     stroke
  297. } def
  298.  
  299. % Diamond
  300. /Di {            % Stack: x y symbolSize
  301.     gsave
  302.     3 1 roll translate 45 rotate 0 0 3 -1 roll Sq
  303.     grestore
  304. } def
  305.  
  306.  
  307. %%BeginSetup
  308. gsave            % Save the graphics state
  309.  
  310. % Default line style parameters
  311.  
  312. 1 setlinewidth        % width
  313. 1 setlinejoin        % join
  314. 0 setlinecap        % cap
  315. 0 SetDashes        % dashes
  316.  
  317. % Adjust coordinate system to use X11 coordinates
  318.  
  319. 0 792 translate
  320. 1 -1 scale
  321.  
  322. % User defined page layout
  323.