home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / flowchrt / atk18ibm.zip / GEDPS.PS < prev    next >
Text File  |  1993-10-02  |  8KB  |  312 lines
  1. %%BeginResource: procset ATK1Dict 1 7
  2. /ATK1Dict 100 dict def                % Should cut closer to Truth
  3. ATK1Dict begin
  4. % This is a prologue for DFD files sent to the laser printer
  5. % NOTE: A rotation is normally done for LANDSCAPE style printing.
  6. % If this rotation is not desired, orientation is defined to PORTRAIT.
  7. % THE ORIENTATION CAN BE CHANGED BY CHANGING THE DEFINITION OF ORIENTATION
  8. % AND BY FIXING THE BoundingBox COMMENT (FOR EPS COMPATIBILITY)
  9. % For LANDSCAPE, %%BoundingBox: 0 0 612 796, is proper
  10. % For PORTRAIT,  %%BoundingBox: 0 0 612 492, is proper.
  11. /PORTRAIT  1 def
  12. /LANDSCAPE 0 def     % Definitions
  13.  
  14. % orientation should be defined before the prologue; it defaults to LANDSCAPE
  15. /orientation where
  16. {
  17.   pop % pop the dictionary off of the stack
  18. }
  19. {
  20.   /orientation LANDSCAPE def
  21. }
  22. ifelse
  23.  
  24. orientation LANDSCAPE eq {      % Set up based on orientation definition
  25. 90 rotate 36 -36 translate    % landscape - origin in UL corner
  26. 10.0 72 mul 11000 div dup scale    % scale to 11000 for 10 inches across page
  27. 20 setlinewidth            % Same as 1 pixel on screen
  28. }
  29. {
  30. 36 440 translate                % portrait - origin in UL corner of DFD
  31. 7.5 72 mul 11000 div dup scale  % scale to 11000 for 7.5 inches across page
  32. 16 setlinewidth                 % Same as 1 pixel on screen
  33. }
  34. ifelse                          % Set up for LANDSCAPE or PORTRAIT
  35.  
  36. /Pts { 72 div 1100 mul } def    % Multiplier for points to internal units
  37.  
  38. % myscale is defined before this prologue; it defaults to 11 Points
  39. /myscale where
  40. {
  41.   pop % pop the dictionary off of the stack
  42. }
  43. {
  44.   /myscale { 11 Pts } def
  45. }
  46. ifelse
  47.  
  48. myscale 2 mul 27 Pts gt     % if the font will run off the page bottom
  49. {
  50.   1 8000 27 Pts add 8000 myscale 2 mul add div scale
  51.   % Scale so font above page bottom. (Scales in y direction only)
  52. }
  53. if
  54.  
  55. % myfont is defined before this prologue; it defaults to /Helvetica
  56. /myfont where
  57. {
  58.   pop
  59. }
  60. {
  61.   /myfont /Helvetica def
  62. }
  63. ifelse
  64.  
  65. myfont findfont myscale scalefont setfont    % 80 chars across page (now:x10)
  66.  
  67. % The x coordinate is the same as in DFDs, the Y coordinate is negative
  68. /doProcess    % Gets Pno Ptext Rad Xc Yc
  69. {
  70.   /Yc exch def
  71.   /Xc exch def
  72.   /Rad exch def
  73.   /Ptext exch def
  74.  
  75.   [ exch ] Xc Yc neg Rad add myscale 0.75 mul sub placetext % Pno is still on the stack
  76.   Ptext Xc Yc neg placetext
  77.   Xc Yc neg Rad 0 360 arc stroke
  78. } def
  79.  
  80. /doExternal    % Gets: Etext Xc Yc Xdis Ydis
  81. {
  82.   /Ydis exch def
  83.   /Xdis exch def
  84.   /Yc   exch def
  85.   /Xc   exch def
  86.  
  87.   Xc Yc neg placetext    % Etext is still on the stack
  88.   Xc Yc neg Xdis Ydis box
  89. } def
  90.  
  91. /doFile        % Gets: Ftext Xc Yc Xdis Ydis SingDoub
  92. {
  93.   /SingDoub exch def
  94.   /Ydis    exch def
  95.   /Xdis exch def
  96.   /Yc exch def
  97.   /Xc exch def
  98.  
  99.   Xc Yc neg placetext    % Ftext is already on the stack
  100.  
  101.   SingDoub 1 and 1 eq
  102.   {
  103.     Xc Xdis add Yc neg Ydis add moveto
  104.     Xdis neg Xdis neg add 0 rlineto
  105.     stroke newpath
  106.   } if
  107.   SingDoub 2 and 2 eq
  108.   {
  109.     Xc Xdis add Yc neg Ydis neg add moveto
  110.     Xdis neg Xdis neg add 0 rlineto
  111.     stroke newpath
  112.   } if
  113. } def
  114.  
  115. /doControlFlow  % Gets: [[X1 Y1] ... [Xm Ym]] Xn Yn Name Arrows?
  116. {
  117.   [100 100] 50 setdash      % 1/10 inch dashes, start with 1/20 inch dash
  118.   doFlow                    % now handle regular dash...
  119.   [] 0 setdash              % return to solid line stroking
  120. } def
  121.  
  122. /doFlow        % Gets: [[X1 Y1] ... [Xm Ym]] Xn Yn Name Arrows?
  123. {
  124.   /Doub exch def        % Single or double headed: 
  125.   /Ftext exch def
  126.   /Yn exch def
  127.   /Xn exch def
  128.   /RouteArray exch def
  129.   RouteArray PolyLine % Draw the path, Sans arrowheads and Text
  130.   
  131.   RouteArray 0 get aload pop /Ys exch def /Xs exch def
  132.  
  133.   Doub 2 and 2 eq           % Arrowhead at beginning! (case 2 or 3)
  134.   {
  135.     RouteArray 1 get aload pop /Ytmp exch def /Xtmp exch def
  136.     Xs Ys neg moveto
  137.     Xs Xtmp sub Ys Ytmp sub atan arrowhead
  138.     gsave stroke grestore
  139.     newpath
  140.   }
  141.   if 
  142.  
  143.   Doub 1 and 1 eq           % Arrowhead at end! (cases 1 and 3)
  144.   {
  145.     /tmpCount RouteArray length def
  146.     RouteArray tmpCount 1 sub get aload pop /Ye exch def /Xe exch def
  147.     RouteArray tmpCount 2 sub get aload pop /Ytmp exch def /Xtmp exch def
  148.     Xe Ye neg moveto
  149.     Xe Xtmp sub Ye Ytmp sub atan arrowhead
  150.     gsave stroke grestore
  151.     newpath
  152.   }
  153.   if
  154.  
  155.   Xn Yn neg moveto
  156.   
  157.   Ftext 
  158.   dup BlankUnder
  159.   Xn Yn neg                     % Text still on stack
  160.   placetext
  161. } def
  162.  
  163. /doDescription            % Gets Dtext Xl Yl
  164. {
  165.   neg myscale 2 div add moveto    % Up 1/2 line for descriptions
  166.   0 get                         % Only use the first element of the array
  167.   gsave
  168.     dup stringwidth pop 2 div 0 rmoveto
  169.     dup [ exch ] BlankUnder
  170.   grestore
  171.   0 myscale 2 div neg rmoveto    % Move back 1/2 line.
  172.   show
  173. } def
  174.  
  175. %
  176. %% Other functions
  177. %
  178. /placetext         % stack: text xcenter ycenter
  179. { 
  180.   /Ypc exch def /Xpc exch def
  181.   /Array exch def  
  182.   /ArrayLen Array length def
  183.   /Ypc ArrayLen 2 div myscale mul neg Ypc add def
  184.  
  185.   Xpc Ypc moveto    % Absolute move to center top of new text
  186.   Array aload pop    % Push all the strings on the stack
  187.   0 1 ArrayLen 1 sub
  188.   {
  189.     myscale mul Ypc add    % Calculate the new Y center
  190.     Xpc exch moveto    % Move to the new text center
  191.     dup stringwidth pop    % puts x width on stack after copy of string
  192.     2 div neg         % puts -1/2 x on stack 
  193.     0            % puts 0 y-char height on stack
  194.     rmoveto        % move halfway
  195.     show        % Only string was on stack now
  196.   }
  197.   for
  198.   newpath        % Clear any current path from the moveto
  199. } def
  200.  
  201. /placeDate % Gets dateString x y
  202. {
  203.   gsave % just to save the font
  204.     moveto % leaves dateString on the stack
  205.     myfont findfont
  206.     myscale 2 div       % Half the regular font size
  207.       dup 18 Pts gt 
  208.       { pop 18 Pts } if % But never greater than 18 Pts
  209.       dup 5 Pts lt
  210.       { pop 5 Pts  } if % And never less than 5 Pts
  211.     scalefont
  212.     setfont
  213.     show
  214.   grestore
  215. } def
  216.  
  217. /box    % items on stack: xcenter ycenter xdis ydis: For externals
  218. {  /ydis exch def
  219.    /xdis exch def
  220.    /ycenter exch def
  221.    /xcenter exch def
  222.  
  223.    newpath
  224.    xcenter xdis add ycenter ydis add moveto
  225.    0 ydis neg ydis neg add rlineto
  226.    xdis neg xdis neg add 0 rlineto
  227.    0 ydis ydis add rlineto
  228.    closepath stroke
  229. } def
  230.  
  231. /average         % Gets: Two numbers to average
  232. {
  233.   add 2 div 
  234. } def
  235.  
  236. /arrowhead        % Gets: angle as input
  237. {
  238.   gsave            % Save current origin & rotation
  239.     currentpoint        % Get the current position
  240.     translate        % Make it the origin
  241.     rotate        % Use the angle argument
  242.     triangle        % Draw the triangle
  243.   grestore        % Restore origin and rotation
  244. } def
  245.  
  246. /triangle        % Draws a dull, black triangle at the origin
  247. {
  248.   gsave            % Preserve our dullness (gray scale)
  249.     0 setgray
  250.     0 0 moveto
  251.       50 100 lineto
  252.     -100   0 rlineto
  253.     closepath
  254.     fill
  255.   grestore        % Restore our dullness
  256. } def
  257.  
  258. /PolyLine % Array of 2-int arrays on stack
  259. {
  260.   /Array exch def
  261.   Array 0 get aload pop /Ys exch def /Xs exch def
  262.   Xs Ys neg moveto
  263.   1 1 Array length 1 sub
  264.   {
  265.     Array exch get aload pop /Ye exch def /Xe exch def
  266.     Xe Ye neg lineto
  267.     /Xs Xe def
  268.     /Ys Ye def
  269.   }
  270.   for
  271.   gsave stroke grestore
  272.   newpath
  273. } def
  274.  
  275. % Note: This is font specific.  For Helvetica, the Font Box
  276. % descends 22% below point size and extends above 94% point size
  277. /BlankUnder     % text-item array
  278. {
  279.   aload length /ArrayLen exch def
  280.   currentpoint /Ytmp exch def /Xtmp exch def
  281.   Xtmp Ytmp ArrayLen 2 div myscale mul neg add 
  282.   moveto
  283.   currentpoint /Ytmp exch def /Xtmp exch def
  284.   0 1 ArrayLen 1 sub
  285.   {
  286.     myscale mul Ytmp add Xtmp exch moveto
  287.     stringwidth pop    % How wide is it
  288.     dup 0 gt
  289.     {            % If width is > 0
  290.       dup 2 div neg         % Half of the string width wide
  291.       myscale rmoveto        % Move to -1/2 stringwidth, myscale
  292.       dup 0 rlineto        % Move to 1/2 stringwidth, myscale
  293.       0 myscale 1.25 mul neg rlineto    % Move to 1/2 stringwidth, -.25 myscale
  294.       neg 0 rlineto        % Move to -1/2 stringwidth, -.25 myscale
  295.       %myscale 1.2 mul rmoveto    % And 1.2 char height high
  296.       %dup 0 rlineto 0 myscale 1.2 mul 1.2 mul neg rlineto
  297.       %neg 0 rlineto
  298.       closepath
  299.       gsave            % Save current gray level
  300.       1 setgray fill
  301.       grestore newpath        % Reset the gray level
  302.     }
  303.     {            % width is 0
  304.       pop        % pop off extra stringwidth
  305.     }
  306.     ifelse
  307.   } for
  308. } def
  309. end % End of ATK1Dict: Do begin when needed.
  310. %%EndResource
  311. %%EndProlog
  312.