home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / APPS / lout2.lzh / LOUT2 / LIB / include / fig_prepend < prev    next >
Text File  |  1994-02-26  |  22KB  |  770 lines
  1. %%BeginResource: procset LoutFigPrependGraphic
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3. %                                                                    %
  4. %  PostScript @SysPrependGraphic file for @Fig  Jeffrey H. Kingston  %
  5. %  Version 2.0 (includes CIRCUM label)                 January 1992  %
  6. %                                                                    %
  7. %  To assist in avoiding name clashes, the names of all symbols      %
  8. %  defined here begin with "lfig".  However, this is not feasible    %
  9. %  with user-defined labels and some labels used by users.           %
  10. %                                                                    %
  11. %  <point>      is two numbers, a point.                             %
  12. %  <length>     is one number, a length                              %
  13. %  <angle>      is one number, an angle in degrees                   %
  14. %  <dashlength> is one number, the preferred length of a dash        %
  15. %                                                                    %
  16. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  17.  
  18. errordict begin
  19.    /handleerror
  20.    {
  21.       {  /Times-Roman findfont 8 pt scalefont setfont
  22.      0 setgray 4 pt 4 pt moveto
  23.      $error /errorname get
  24.      dup lfigdict exch known
  25.      { lfigdict exch get }
  26.      { 30 string cvs } ifelse
  27.      show
  28.      (  Command: ) show
  29.      $error /command get 30 string cvs show
  30.       } stopped {} if
  31.       showpage stop
  32.    } def
  33. end
  34.  
  35. % concat strings: <string> <string> lfigconcat <string>
  36. % must be defined outside lfigdict since used in lfigpromotelabels
  37. /lfigconcat
  38. { 2 copy length exch length add string
  39.   dup 0 4 index putinterval
  40.   dup 3 index length 3 index putinterval
  41.   3 1 roll pop pop
  42. } def
  43.  
  44. % <string> lfigdebugprint -
  45. % must be defined outside lfigdict since used in arbitrary places
  46. % /lfigdebugprint
  47. % { print
  48. %   (;  operand stack:\n) print
  49. %   count copy
  50. %   count 2 idiv
  51. %   { ==
  52. %     (\n) print
  53. %   } repeat
  54. %   (\n) print
  55. % } def
  56.  
  57. /lfigdict 120 dict def
  58. lfigdict begin
  59.  
  60. % error messages
  61. /dictfull (dictfull error:  too many labels?) def
  62. /dictstackoverflow (dictstackoverflow error:  labels nested too deeply?) def
  63. /execstackoverflow (execstackoverflow error:  figure nested too deeply?) def
  64. /limitcheck (limitcheck error:  figure nested too deeply or too large?) def
  65. /syntaxerror (syntaxerror error:  syntax error in text of figure?) def
  66. /typecheck (typecheck error:  syntax error in text of figure?) def
  67. /undefined (undefined error:  unknown or misspelt label?) def
  68. /VMError (VMError error:  run out of memory?) def
  69.  
  70. % push pi onto stack:  - lfigpi <num>
  71. /lfigpi 3.14159 def
  72.  
  73. % arc directions
  74. /clockwise     false def
  75. /anticlockwise true  def
  76.  
  77. % maximum of two numbers:  <num> <num> lfigmax <num>
  78. /lfigmax { 2 copy gt { pop } { exch pop } ifelse } def
  79.  
  80. % minimum of two numbers:  <num> <num> lfigmin <num>
  81. /lfigmin { 2 copy lt { pop } { exch pop } ifelse } def
  82.  
  83. % add two points:  <point> <point> lfigpadd <point>
  84. /lfigpadd { exch 3 1 roll add 3 1 roll add exch } def
  85.  
  86. % subtract first point from second:  <point> <point> lfigpsub <point>
  87. /lfigpsub { 3 2 roll sub 3 1 roll exch sub exch } def
  88.  
  89. % max two points:  <point> <point> lfigpmax <point>
  90. /lfigpmax { exch 3 1 roll lfigmax 3 1 roll lfigmax exch } def
  91.  
  92. % min two points:  <point> <point> lfigpmin <point>
  93. /lfigpmin { exch 3 1 roll lfigmin 3 1 roll lfigmin exch } def
  94.  
  95. % scalar multiplication: <point> <num> lfigpmul <point>
  96. /lfigpmul { dup 3 1 roll mul 3 1 roll mul exch } def
  97.  
  98. % point at angle and distance:  <point> <length> <angle> lfigatangle <point>
  99. /lfigatangle { 2 copy cos mul 3 1 roll sin mul lfigpadd } def
  100.  
  101. % angle from one point to another:  <point> <point> lfigangle <angle>
  102. /lfigangle { lfigpsub 2 copy 0 eq exch 0 eq and {pop} {exch atan} ifelse } def
  103.  
  104. % distance between two points:  <point> <point> lfigdistance <length>
  105. /lfigdistance { lfigpsub dup mul exch dup mul add sqrt } def
  106.  
  107. % difference in x coords: <point> <point> lfigxdistance <length>
  108. /lfigxdistance { pop 3 1 roll pop sub } def
  109.  
  110. %difference in y coords: <point> <point> lfigydistance <length>
  111. /lfigydistance { 3 1 roll pop sub exch pop } def
  112.  
  113. % stroke a solid line:  <length> <dashlength> lfigsolid -
  114. /lfigsolid
  115. {  pop pop [] 0 setdash stroke
  116. } def
  117.  
  118. % stroke a lfigdashed line:   <length> <dashlength> lfigdashed -
  119. /lfigdashed
  120. {  2 copy div 2 le 1 index 0 le or
  121.    {  exch pop 1 pt lfigmax [ exch dup ] 0 setdash }
  122.    {  dup [ exch 4 2 roll 2 copy div
  123.       1 sub 2 div ceiling dup 4 1 roll
  124.       1 add mul sub exch div ] 0 setdash
  125.    } ifelse stroke
  126. } def
  127.  
  128. % stroke a lfigcdashed line:  <length> <dashlength> lfigcdashed -
  129. /lfigcdashed
  130. {  2 copy le 1 index 0 le or
  131.    {  exch pop 1 pt lfigmax [ exch dup ] copy 0 get 2 div setdash }
  132.    { dup [ 4 2 roll exch 2 copy exch div
  133.      2 div ceiling div 1 index sub
  134.      ] exch 2 div setdash
  135.    } ifelse stroke
  136. } def
  137.  
  138. % stroke a dotted line:  <length> <dashlength> lfigdotted -
  139. /lfigdotted
  140. {  dup 0 le
  141.    {  exch pop 1 pt lfigmax [ exch 0 exch ] 0 setdash }
  142.    { 1 index exch div ceiling div
  143.      [ 0 3 2 roll ] 0 setdash
  144.    } ifelse stroke
  145. } def
  146.  
  147. % stroke a noline line:  <length> <dashlength> lfignoline -
  148. /lfignoline
  149. { pop pop
  150. } def
  151.  
  152. % painting (i.e. filling): - lfigwhite - (etc.)
  153. /lfigwhite   { 1.0  setgray fill } def
  154. /lfiglight   { 0.95 setgray fill } def
  155. /lfiggrey    { 0.9  setgray fill } def
  156. /lfiggray    { 0.9  setgray fill } def
  157. /lfigdark    { 0.7  setgray fill } def
  158. /lfigblack   { 0.0  setgray fill } def
  159. /lfignopaint {                   } def
  160.  
  161. % line caps (and joins, not currently used)
  162. /lfigbutt       0 def
  163. /lfiground      1 def
  164. /lfigprojecting 2 def
  165. /lfigmiter      0 def
  166. /lfigbevel      2 def
  167.  
  168. % shape and labels of the @Box symbol
  169. /lfigbox
  170. {
  171.    0     0     /SW  lfigpointdef
  172.    xsize 0     /SE  lfigpointdef
  173.    xsize ysize /NE  lfigpointdef
  174.    0     ysize /NW  lfigpointdef
  175.    SE 0.5 lfigpmul /S   lfigpointdef
  176.    NW 0.5 lfigpmul /W   lfigpointdef
  177.    W SE lfigpadd   /E   lfigpointdef
  178.    S NW lfigpadd   /N   lfigpointdef
  179.    NE 0.5 lfigpmul /CTR lfigpointdef
  180.    [ CTR NE lfigpsub /lfigboxcircum cvx ] lfigcircumdef
  181.    SW SE NE NW SW
  182. } def
  183.  
  184. % shape and labels of the @Square symbol
  185. /lfigsquare
  186. {
  187.    xsize ysize 0.5 lfigpmul /CTR lfigpointdef
  188.    CTR xsize xsize ysize ysize lfigpmax 0.5 lfigpmul lfigpadd /NE lfigpointdef
  189.    CTR 0 0 CTR NE lfigdistance 135 lfigatangle lfigpadd /NW lfigpointdef
  190.    CTR 0 0 CTR NE lfigdistance 225 lfigatangle lfigpadd /SW lfigpointdef
  191.    CTR 0 0 CTR NE lfigdistance 315 lfigatangle lfigpadd /SE lfigpointdef
  192.    SW 0.5 lfigpmul SE 0.5 lfigpmul lfigpadd /S lfigpointdef
  193.    NW 0.5 lfigpmul NE 0.5 lfigpmul lfigpadd /N lfigpointdef
  194.    SW 0.5 lfigpmul NW 0.5 lfigpmul lfigpadd /W lfigpointdef
  195.    SE 0.5 lfigpmul NE 0.5 lfigpmul lfigpadd /E lfigpointdef
  196.    [ CTR NE lfigpsub /lfigboxcircum cvx ] lfigcircumdef
  197.    SW SE NE NW SW
  198. } def
  199.  
  200. % shape and labels of the @Diamond symbol
  201. /lfigdiamond
  202. {
  203.    xsize 0 0.5 lfigpmul /S   lfigpointdef
  204.    0 ysize 0.5 lfigpmul /W   lfigpointdef
  205.    S W         lfigpadd /CTR lfigpointdef
  206.    CTR W       lfigpadd /N   lfigpointdef
  207.    CTR S       lfigpadd /E   lfigpointdef
  208.    [ xsize ysize 0.5 lfigpmul /lfigdiamondcircum cvx ] lfigcircumdef
  209.    S E N W S
  210. } def
  211.  
  212. % shape and labels of the @Ellipse symbol
  213. /lfigellipse
  214. {
  215.    xsize 0 0.5 lfigpmul /S   lfigpointdef
  216.    0 ysize 0.5 lfigpmul /W   lfigpointdef
  217.    S W         lfigpadd /CTR lfigpointdef
  218.    CTR W       lfigpadd /N   lfigpointdef
  219.    CTR S       lfigpadd /E   lfigpointdef
  220.    CTR xsize 0 0.3536 lfigpmul lfigpadd 0 ysize 0.3536 lfigpmul lfigpadd /NE lfigpointdef
  221.    0 ysize 0.3536 lfigpmul CTR xsize 0 0.3536 lfigpmul lfigpadd lfigpsub /SE lfigpointdef
  222.    xsize 0 0.3536 lfigpmul CTR lfigpsub 0 ysize 0.3536 lfigpmul lfigpadd /NW lfigpointdef
  223.    0 ysize 0.3536 lfigpmul xsize 0 0.3536 lfigpmul CTR lfigpsub lfigpsub /SW lfigpointdef
  224.    [ xsize ysize 0.5 lfigpmul /lfigellipsecircum cvx ] lfigcircumdef
  225.    S [ CTR ] E [ CTR ] N [ CTR ] W [ CTR ] S
  226. } def
  227.  
  228. % shape and labels of the @Circle symbol
  229. /lfigcircle
  230. {
  231.    xsize ysize 0.5 lfigpmul /CTR lfigpointdef
  232.    CTR xsize 0 ysize 0 lfigpmax 0.5 lfigpmul lfigpadd /E lfigpointdef
  233.    CTR 0 0 CTR E lfigdistance 45 lfigatangle lfigpadd /NE lfigpointdef
  234.    CTR 0 0 CTR E lfigdistance 90 lfigatangle lfigpadd /N lfigpointdef
  235.    CTR 0 0 CTR E lfigdistance 135 lfigatangle lfigpadd /NW lfigpointdef
  236.    CTR 0 0 CTR E lfigdistance 180 lfigatangle lfigpadd /W lfigpointdef
  237.    CTR 0 0 CTR E lfigdistance 225 lfigatangle lfigpadd /SW lfigpointdef
  238.    CTR 0 0 CTR E lfigdistance 270 lfigatangle lfigpadd /S lfigpointdef
  239.    CTR 0 0 CTR E lfigdistance 315 lfigatangle lfigpadd /SE lfigpointdef
  240.    [ S E lfigpsub /lfigellipsecircum cvx ] lfigcircumdef
  241.    S [ CTR ] E [ CTR ] N [ CTR ] W [ CTR ] S
  242. } def
  243.  
  244. % shape and labels of the @HLine and @HArrow symbols
  245. /lfighline
  246. {
  247.    0 ymark lfigprevious /FROM lfigpointdef
  248.    xsize ymark lfigprevious /TO lfigpointdef
  249. } def
  250.  
  251. % shape and labels of the @VLine and @VArrow symbols
  252. /lfigvline
  253. {
  254.    xmark ysize lfigprevious /FROM lfigpointdef
  255.    xmark 0 lfigprevious /TO lfigpointdef
  256. } def
  257.  
  258. % points of a polygon around base with given no of sides, vert init angle:
  259. % <sides> <angle> figpolygon <point> ... <point>
  260. /lfigpolygon
  261. {  xsize ysize 0.5 lfigpmul /CTR lfigpointdef
  262.    90 sub CTR 2 copy lfigmax 5 3 roll
  263.    [ 4 copy pop /lfigpolycircum cvx ] lfigcircumdef
  264.    exch dup 360 exch div exch
  265.    1 1  3 2 roll
  266.    {  4 string cvs (P) exch lfigconcat cvn
  267.       6 copy pop pop lfigatangle 2 copy 10 2 roll
  268.       3 2 roll lfigpointdef
  269.       dup 3 1 roll add exch
  270.    }  for
  271.    pop lfigatangle
  272. } def
  273.  
  274. % next array element:  <array> <index> lfiggetnext <array> <index> <any> true
  275. %                                               or <array> <index> false
  276. /lfiggetnext
  277. {  2 copy exch length ge
  278.    { false }
  279.    { 2 copy get exch 1 add exch true } ifelse
  280. } def
  281.  
  282. % check whether thing is number:  <any> lfigisnumbertype <any> <bool>
  283. /lfigisnumbertype
  284. {  dup type dup
  285.    /integertype eq exch /realtype eq or
  286. } def
  287.  
  288. % check whether thing is an array:  <any> lfigisarraytype <any> <bool>
  289. /lfigisarraytype { dup type /arraytype eq } def
  290.  
  291. % get next item:  <array> <index> lfiggetnextitem <array> <index> 0
  292. %                                              or <array> <index> <array> 1
  293. %                                              or <array> <index> <point> 2
  294. /lfiggetnextitem
  295. {   lfiggetnext
  296.     {    lfigisarraytype
  297.     {   1
  298.     }
  299.     {   lfigisnumbertype
  300.         {    3 1 roll
  301.         lfiggetnext
  302.         {   lfigisnumbertype
  303.             {    4 3 roll exch  2
  304.             }
  305.             {    pop 3 2 roll pop  0
  306.             } ifelse
  307.         }
  308.         {   3 2 roll pop  0
  309.         } ifelse
  310.         }
  311.         {    pop 0
  312.         } ifelse
  313.     } ifelse
  314.     }
  315.     {    0
  316.     } ifelse
  317. } def
  318.  
  319. % set arc path:  bool x1 y1  x2 y2  x0 y0  lfigsetarc  <angle> <angle> <dist>
  320. % the path goes from x1 y1 to x2 y2 about centre x0 y0,
  321. % anticlockwise if bool is true else clockwise.
  322. % The orientations of backwards pointing and forwards pointing
  323. % arrowheads are returned in the two angles, and
  324. % the length of the arc is returned in <dist>.
  325. /lfigsetarc
  326. {
  327.   20 dict begin
  328.      matrix currentmatrix 8 1 roll
  329.      2 copy translate 2 copy 8 2 roll
  330.      4 2 roll lfigpsub 6 2 roll lfigpsub
  331.      dup /y1 exch def dup mul /y1s exch def
  332.      dup /x1 exch def dup mul /x1s exch def
  333.      dup /y2 exch def dup mul /y2s exch def
  334.      dup /x2 exch def dup mul /x2s exch def
  335.  
  336.      y1s y2s eq
  337.      {    -1
  338.      }
  339.      {    y1s x2s mul y2s x1s mul sub y1s y2s sub div
  340.      } ifelse
  341.      /da exch def
  342.  
  343.      x1s x2s eq
  344.      {    -1
  345.      }
  346.      {    x1s y2s mul x2s y1s mul sub x1s x2s sub div
  347.      } ifelse
  348.      /db exch def
  349.  
  350.      da 0 gt db 0 gt and
  351.      {    /LMax da sqrt db sqrt lfigmax def
  352.     /scalex da sqrt LMax div def
  353.     /scaley db sqrt LMax div def
  354.     scalex scaley scale
  355.     0 0 LMax
  356.     0 0 x1 scalex mul y1 scaley mul lfigangle
  357.     0 0 x2 scalex mul y2 scaley mul lfigangle
  358.     2 copy eq { 360 add } if
  359.     2 copy 8 2 roll
  360.     5 index { arc } { arcn } ifelse
  361.     2 index 1 index
  362.     { 90 sub } { 90 add } ifelse
  363.     dup sin scaley mul exch cos scalex mul atan
  364.     2 index 2 index
  365.     { 90 add } { 90 sub } ifelse
  366.     dup sin scaley mul exch cos scalex mul atan
  367.     5 2 roll  % res1 res2 ang1 ang2 anticlockwise
  368.     { exch sub } { sub } ifelse
  369.     dup 0 le { 360 add } if  lfigpi mul LMax mul 180 div
  370.      }
  371.      {    0 0 x1 y1 lfigdistance 0 0 x2 y2 lfigdistance eq
  372.     0 0 x1 y1 lfigdistance 0 gt and
  373.     {    0 0
  374.         0 0 x1 y1 lfigdistance
  375.         0 0 x1 y1 lfigangle
  376.         0 0 x2 y2 lfigangle
  377.         2 copy eq { 360 add } if
  378.         2 copy 8 2 roll
  379.         5 index { arc } { arcn } ifelse
  380.         2 index 1 index
  381.         { 90 sub } { 90 add } ifelse
  382.         2 index 2 index
  383.         { 90 add } { 90 sub } ifelse
  384.         5 2 roll % res1 res2 ang1 ang2 clockwise
  385.         { exch sub } { sub } ifelse
  386.         dup 0 le { 360 add } if lfigpi mul 0 0 x1 y1 lfigdistance mul 180 div
  387.     }
  388.     {    x2 y2 lineto pop
  389.         x2 y2 x1 y1 lfigangle
  390.         x1 y1 x2 y2 lfigangle
  391.         x1 y1 x2 y2 lfigdistance
  392.     } ifelse
  393.      } ifelse
  394.      4 -1 roll setmatrix
  395.    end
  396. } def
  397.  
  398. % lfigsetcurve: set up a Bezier curve from x0 y0 to x3 y3
  399. % and return arrowhead angles and length of curve (actually 0)
  400. % x0 y0 x1 y1 x2 y2 x3 y3 lfigsetcurve <angle> <angle> <length>
  401. /lfigsetcurve
  402. { 8 copy curveto pop pop
  403.   lfigangle
  404.   5 1 roll
  405.   4 2 roll lfigangle
  406.   exch
  407.   0
  408. } def
  409.  
  410. % lfigpaintpath: paint a path of the given shape
  411. % /paint [ shape ] lfigpaintpath -
  412. /lfigpaintpath
  413. {
  414.   10 dict begin
  415.     0 newpath
  416.     /prevseen false def
  417.     /curveseen false def
  418.     { lfiggetnextitem
  419.       dup 0 eq { pop exit }
  420.       { 1 eq
  421.         { /curveseen true def
  422.       /curve exch def
  423.       curve length 0 eq { /curveseen false def } if
  424.         }
  425.         { /ycurr exch def
  426.       /xcurr exch def
  427.       prevseen
  428.       { curveseen
  429.         { curve length 4 eq
  430.           { xprev yprev
  431.         curve 0 get curve 1 get
  432.         curve 2 get curve 3 get
  433.         xcurr ycurr
  434.         lfigsetcurve pop pop pop
  435.           }
  436.           { xprev yprev xcurr ycurr
  437.             curve length 1 ge { curve 0 get } { 0 } ifelse
  438.             curve length 2 ge { curve 1 get } { 0 } ifelse
  439.             curve length 3 ge { curve 2 get } { true } ifelse
  440.             7 1 roll
  441.             lfigsetarc pop pop pop
  442.           } ifelse
  443.         }
  444.         { xcurr ycurr lineto
  445.         } ifelse
  446.       }
  447.       { xcurr ycurr moveto
  448.       } ifelse
  449.       /xprev xcurr def
  450.       /yprev ycurr def
  451.       /prevseen true def
  452.       /curveseen false def
  453.         } ifelse
  454.       } ifelse
  455.     } loop pop pop cvx exec
  456.   end
  457. } def
  458.  
  459. % stroke a path of the given shape in the given linestyle and dash length.
  460. % Return the origin and angle of the backward and forward arrow heads.
  461. % dashlength /linestyle [shape] lfigdopath  [<point> <angle>] [<point> <angle>] 
  462. /lfigdopath
  463. {
  464.   10 dict begin
  465.     0
  466.     /prevseen  false def
  467.     /curveseen false def
  468.     /backarrow []    def
  469.     /fwdarrow  []    def
  470.     {
  471.     lfiggetnextitem
  472.     dup 0 eq { pop exit }
  473.     {
  474.         1 eq
  475.         {    /curveseen true def
  476.         /curve exch def
  477.         curve length 0 eq { /prevseen false def } if
  478.         }
  479.         {    /ycurr exch def
  480.         /xcurr exch def
  481.         prevseen
  482.         {   newpath xprev yprev moveto
  483.             curveseen
  484.             {    curve length 4 eq
  485.             {   xprev yprev
  486.                 curve 0 get curve 1 get
  487.                 curve 2 get curve 3 get
  488.                 xcurr ycurr lfigsetcurve
  489.             }
  490.             {   xprev yprev xcurr ycurr
  491.                 curve length 1 ge { curve 0 get } { 0 } ifelse
  492.                 curve length 2 ge { curve 1 get } { 0 } ifelse
  493.                 curve length 3 ge { curve 2 get } { true } ifelse
  494.                 7 1 roll
  495.                 lfigsetarc
  496.             } ifelse
  497.             }
  498.             {    xcurr ycurr lineto
  499.             xcurr ycurr xprev yprev lfigangle dup 180 sub
  500.             xprev yprev xcurr ycurr lfigdistance
  501.             } ifelse
  502.             6 index 6 index cvx exec
  503.             [ xprev yprev 5 -1 roll ]
  504.             backarrow length 0 eq
  505.             { /backarrow exch def }
  506.             { pop } ifelse
  507.             [ xcurr ycurr 4 -1 roll ] /fwdarrow exch def
  508.         } if
  509.         /xprev xcurr def
  510.         /yprev ycurr def
  511.         /prevseen true def
  512.         /curveseen false def
  513.         } ifelse
  514.     } ifelse
  515.     } loop
  516.     pop pop pop pop
  517.     backarrow length 0 eq { [ 0 0 0 ] } { backarrow } ifelse
  518.     fwdarrow  length 0 eq { [ 0 0 0 ] } { fwdarrow  } ifelse
  519.   end
  520. } def
  521.  
  522. % lfigdoarrow: draw an arrow head of given form
  523. % dashlength /lstyle /pstyle hfrac height width [ <point> <angle> ] lfigdoarrow -
  524. /lfigdoarrow
  525. {  matrix currentmatrix 8 1 roll
  526.    dup 0 get 1 index 1 get translate
  527.    2 get rotate
  528.    [ 2 index neg 2 index 0 0
  529.      3 index 3 index neg
  530.      1 index 10 index mul 0
  531.      7 index 7 index ]
  532.    4 1 roll pop pop pop
  533.    dup 3 1 roll
  534.    gsave lfigpaintpath grestore lfigdopath pop pop
  535.    setmatrix
  536. } def
  537.  
  538. % arrow head styles
  539. /lfigopen     0.0 def
  540. /lfighalfopen 0.5 def
  541. /lfigclosed   1.0 def
  542.  
  543. % stroke no arrows, forward, back, and both
  544. /lfignoarrow { pop pop pop pop pop pop pop pop                        } def
  545. /lfigforward { 7 -1 roll lfigdoarrow pop                              } def
  546. /lfigback    { 8 -2 roll pop lfigdoarrow                              } def
  547. /lfigboth    { 8 -1 roll 7 copy lfigdoarrow pop 7 -1 roll lfigdoarrow } def
  548.  
  549. % lfigprevious: return previous point on path
  550. /lfigprevious
  551. { lfigisnumbertype
  552.   { 2 copy }
  553.   { lfigisarraytype
  554.     { 2 index 2 index }
  555.     { 0 0 }
  556.     ifelse
  557.   } ifelse
  558. } def
  559.  
  560. % label a point in 2nd top dictionary:  <point> /name lfigpointdef -
  561. /lfigpointdef
  562. {
  563.   % (Entering lfigpointdef) lfigdebugprint
  564.   [ 4 2 roll transform
  565.     /itransform cvx ] cvx
  566.     currentdict end
  567.     3 1 roll
  568.     % currentdict length currentdict maxlength lt
  569.     % { def }
  570.     % { exec moveto (too many labels) show stop }
  571.     % ifelse
  572.     def
  573.     begin
  574.   % (Leaving lfigpointdef) lfigdebugprint
  575. } def
  576.  
  577. % promote labels from second top to third top dictionary
  578. % <string> lfigpromotelabels -
  579. /lfigpromotelabels
  580. {
  581.   % (Entering lfigpromotelabels) lfigdebugprint
  582.   currentdict end exch currentdict end
  583.   { exch 20 string cvs 2 index
  584.     (@) lfigconcat exch lfigconcat cvn exch def
  585.   } forall pop begin
  586.   % (Leaving lfigpromotelabels) lfigdebugprint
  587. } def
  588.  
  589. % show labels (except CIRCUM): - lfigshowlabels -
  590. /lfigshowlabels
  591. {
  592.   % (Entering lfigshowlabels) lfigdebugprint
  593.   currentdict end
  594.     currentdict
  595.     { 1 index 20 string cvs (CIRCUM) search % if CIRCUM in key
  596.       { pop pop pop pop pop }
  597.       { pop cvx exec 2 copy
  598.         newpath 1.5 pt 0 360 arc
  599.         0 setgray fill
  600.         /Times-Roman findfont 8 pt scalefont setfont
  601.         moveto 0.2 cm 0.1 cm rmoveto 20 string cvs show
  602.       }
  603.       ifelse
  604.     } forall
  605.   begin
  606.   % (Leaving lfigshowlabels) lfigdebugprint
  607. } def
  608.  
  609. % fix an angle to between 0 and 360 degrees:  <angle> lfigfixangle <angle>
  610. /lfigfixangle
  611. {
  612.   % (Entering lfigfixangle) lfigdebugprint
  613.   { dup 0 ge { exit } if
  614.     360 add
  615.   } loop
  616.   { dup 360 lt { exit } if
  617.     360 sub
  618.   } loop
  619.   % (Leaving lfigfixangle) lfigdebugprint
  620. } def
  621.  
  622. % find point on circumference of box:  alpha a b lfigboxcircum x y
  623. /lfigboxcircum
  624. {
  625.   % (Entering lfigboxcircum) lfigdebugprint
  626.   4 dict begin
  627.     /b exch def
  628.     /a exch def
  629.     lfigfixangle /alpha exch def
  630.     0 0 a b lfigangle /theta exch def
  631.  
  632.     % if alpha <= theta, return (a, a*tan(alpha))
  633.     alpha theta le
  634.     { a  a alpha sin mul alpha cos div }
  635.     {
  636.       % else if alpha <= 180 - theta, return (b*cot(alpha), b)
  637.       alpha 180 theta sub le
  638.       { b alpha cos mul alpha sin div  b }
  639.       {
  640.         % else if alpha <= 180 + theta, return (-a, -a*tan(alpha))
  641.         alpha 180 theta add le
  642.         { a neg  a neg alpha sin mul alpha cos div }
  643.         {
  644.       % else if alpha <= 360 - theta, return (-b*cot(alpha), -b)
  645.       alpha 360 theta sub le
  646.           { b neg alpha cos mul alpha sin div  b neg }
  647.       {
  648.         % else 360 - theta <= alpha, return (a, a*tan(alpha))
  649.         a  a alpha sin mul alpha cos div
  650.       } ifelse
  651.         } ifelse
  652.       } ifelse
  653.     } ifelse
  654.   end
  655.   % (Leaving lfigboxcircum) lfigdebugprint
  656. } def
  657.  
  658. % find point on circumference of diamond:  alpha a b lfigdiamondcircum x y
  659. /lfigdiamondcircum
  660. {
  661.   % (Entering lfigdiamondcircum) lfigdebugprint
  662.   4 dict begin
  663.     /b exch def
  664.     /a exch def
  665.     lfigfixangle /alpha exch def
  666.     b alpha cos abs mul  a alpha sin abs mul  add  /denom exch def
  667.     a b mul alpha cos mul denom div
  668.     a b mul alpha sin mul denom div
  669.   end
  670.   % (Leaving lfigdiamondcircum) lfigdebugprint
  671. } def
  672.  
  673. % find point on circumference of ellipse:  alpha a b lfigellipsecircum x y
  674. /lfigellipsecircum
  675. {
  676.   % (Entering lfigellipsecircum) lfigdebugprint
  677.   4 dict begin
  678.     /b exch def
  679.     /a exch def
  680.     lfigfixangle /alpha exch def
  681.     b alpha cos mul dup mul  a alpha sin mul dup mul  add sqrt /denom exch def
  682.     a b mul alpha cos mul denom div
  683.     a b mul alpha sin mul denom div
  684.   end
  685.   % (Leaving lfigellipsecircum) lfigdebugprint
  686. } def
  687.  
  688. % find point of intersection of two lines each defined by two points
  689. % x1 y1 x2 y2  x3 y3 x4 y4  lfiglineintersect x y
  690. /lfiglineintersect
  691. {
  692.   % (Entering lfiglineintersect) lfigdebugprint
  693.   13 dict begin
  694.     /y4 exch def
  695.     /x4 exch def
  696.     /y3 exch def
  697.     /x3 exch def
  698.     /y2 exch def
  699.     /x2 exch def
  700.     /y1 exch def
  701.     /x1 exch def
  702.     x2 x1 sub /x21 exch def
  703.     x4 x3 sub /x43 exch def
  704.     y2 y1 sub /y21 exch def
  705.     y4 y3 sub /y43 exch def
  706.     y21 x43 mul y43 x21 mul sub /det exch def
  707.   
  708.     % calculate x 
  709.     y21 x43 mul x1 mul
  710.     y43 x21 mul x3 mul sub
  711.     y3 y1 sub x21 mul x43 mul add
  712.     det div
  713.  
  714.     % calculate y
  715.     x21 y43 mul y1 mul
  716.     x43 y21 mul y3 mul sub
  717.     x3 x1 sub y21 mul y43 mul add
  718.     det neg div
  719.  
  720.   end
  721.   % (Leaving lfiglineintersect) lfigdebugprint
  722. } def
  723.  
  724. % find point on circumference of polygon
  725. % alpha radius num theta lfigpolycircum x y
  726. /lfigpolycircum
  727. {
  728.   % (Entering lfigpolycircum) lfigdebugprint
  729.   13 dict begin
  730.     /theta exch def
  731.     /num exch def
  732.     /radius exch def
  733.     /alpha exch def
  734.  
  735.     % calculate delta, the angle from theta to alpha
  736.     alpha theta sub lfigfixangle
  737.  
  738.     % calculate the angle which is the multiple of 360/num closest to delta
  739.     360 num div div truncate 360 num div mul theta add /anglea exch def
  740.  
  741.     % calculate the next multiple of 360/num after anglea
  742.     anglea 360 num div add /angleb exch def
  743.  
  744.     % intersect the line through these two points with the alpha line
  745.     anglea cos anglea sin  angleb cos angleb sin
  746.     0 0  alpha cos 2 mul alpha sin 2 mul
  747.     lfiglineintersect radius lfigpmul
  748.  
  749.   end
  750.   % (Leaving lfigpolycircum) lfigdebugprint
  751. } def
  752.  
  753. % add CIRCUM operator with this body:  <array> lfigcircumdef -
  754. /lfigcircumdef
  755. {   % (Entering lfigcircumdef) lfigdebugprint
  756.     /CIRCUM exch cvx
  757.     currentdict end
  758.     3 1 roll
  759.     % currentdict length currentdict maxlength lt
  760.     % { def }
  761.     % { exec moveto (too many labels) show stop }
  762.     % ifelse
  763.     def
  764.     begin
  765.     % (Leaving lfigcircumdef) lfigdebugprint
  766. } def
  767.  
  768. end
  769. %%EndResource
  770.