home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / flowchrt / atk18ibm.zip / GEDPSOEM.PS < prev    next >
Text File  |  1993-12-30  |  11KB  |  428 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. %%%%% Until the next set of 5 percents, this is procedure support for OEM chars
  66. % This procedure will reencode standard Adobe-encoded fonts to match
  67. % reasonably closely to the standard VGA font.
  68. % This procedure is intended to be easily user-extensible:
  69. % Simply add or change more codes, as desired.
  70. % NB: This is a temporary solution, while a more comprehensive solution
  71. %     (e.g. UNICODE) is being examined.  Requiring users to be Postscript
  72. %     mavins was not part of the plan.... ;-)
  73. %     In addition, a complete re-encoding to match the full IBM OEM
  74. %     character set is also being considered--but it is considerably 
  75. %     less user-maintainable.
  76.  
  77. /OEMvec
  78. [
  79.   16#80    /Ccedilla
  80.   16#81    /udieresis
  81.   16#82    /eacute
  82.   16#83    /acircumflex
  83.   16#84    /adieresis
  84.   16#85    /agrave
  85.   16#86    /aring
  86.   16#87    /ccedilla
  87.   16#88    /ecircumflex
  88.   16#89    /edieresis
  89.   16#8a    /egrave
  90.   16#8b    /idieresis
  91.   16#8c    /icircumflex
  92.   16#8d    /igrave
  93.   16#8e    /Adieresis
  94.   16#8f    /Aring
  95.   16#90    /Eacute
  96.   16#91    /ae
  97.   16#92    /AE
  98.   16#93    /ocircumflex
  99.   16#94    /odieresis
  100.   16#95    /ograve
  101.   16#96    /ucircumflex
  102.   16#97    /ugrave
  103.   16#98    /ydieresis
  104.   16#99    /Odieresis
  105.   16#9a    /Udieresis
  106.   16#9b    /cent
  107.   16#9c    /sterling
  108.   16#9d    /yen
  109.   16#9f    /florin
  110.   16#a0    /aacute
  111.   16#a1    /iacute
  112.   16#a2    /oacute
  113.   16#a3    /uacute
  114.   16#a4    /ntilde
  115.   16#a5    /Ntilde
  116.   16#a6    /ordfeminine
  117.   16#a7    /ordmasculine
  118.   16#a8    /questiondown
  119.   16#ae    /guillemotleft
  120.   16#af    /guillemotright
  121.   16#e1 /germandbls
  122.   16#ed    /oslash
  123.   16#f8    /bullet
  124.   16#f9    /periodcentered
  125.   16#04    /currency
  126. ] def
  127.  
  128. % This procedure is based on Program 18 in the Adobe Tutorial and Cookbook
  129. % Usage:  baseFontName newFontName codeArray ReEncodeSmall
  130. /reencsmalldict 12 dict def
  131. /ReEncodeSmall
  132. {
  133.   reencsmalldict begin
  134.   /newcodesandnames exch def
  135.   /newfontname      exch def
  136.   /basefontname     exch def
  137.  
  138.   /basefontdict basefontname findfont def
  139.   /newfont basefontdict maxlength dict def
  140.  
  141.   basefontdict
  142.   {
  143.     exch dup /FID ne
  144.     {
  145.       dup /Encoding eq
  146.       {
  147.         exch dup length array copy newfont 3 1 roll put
  148.       }
  149.       {
  150.           exch newfont 3 1 roll put
  151.       }
  152.       ifelse
  153.     }
  154.     {
  155.       pop pop
  156.     }
  157.     ifelse
  158.   }
  159.   forall
  160.  
  161. newfont /FontName newfontname put
  162. newcodesandnames aload pop
  163.  
  164. newcodesandnames length 2 idiv
  165. {
  166.   newfont /Encoding get 3 1 roll put
  167. }
  168. repeat
  169.  
  170. newfontname newfont definefont pop
  171. end
  172. } def
  173.  
  174. %%%%% End of OEM Char procedure support
  175.  
  176. % Now we wish to reencode the font to support some international characters
  177. % The resulting font will be called ATKfont.
  178. myfont /ATKfont OEMvec ReEncodeSmall
  179. /myfont /ATKfont def    % redefine myfont
  180.  
  181. myfont findfont myscale scalefont setfont    % 80 chars across page (now:x10)
  182.  
  183. % The x coordinate is the same as in DFDs, the Y coordinate is negative
  184. /doProcess    % Gets Pno Ptext Rad Xc Yc
  185. {
  186.   /Yc exch def
  187.   /Xc exch def
  188.   /Rad exch def
  189.   /Ptext exch def
  190.  
  191.   [ exch ] Xc Yc neg Rad add myscale 0.75 mul sub placetext % Pno is still on the stack
  192.   Ptext Xc Yc neg placetext
  193.   Xc Yc neg Rad 0 360 arc stroke
  194. } def
  195.  
  196. /doExternal    % Gets: Etext Xc Yc Xdis Ydis
  197. {
  198.   /Ydis exch def
  199.   /Xdis exch def
  200.   /Yc   exch def
  201.   /Xc   exch def
  202.  
  203.   Xc Yc neg placetext    % Etext is still on the stack
  204.   Xc Yc neg Xdis Ydis box
  205. } def
  206.  
  207. /doFile        % Gets: Ftext Xc Yc Xdis Ydis SingDoub
  208. {
  209.   /SingDoub exch def
  210.   /Ydis    exch def
  211.   /Xdis exch def
  212.   /Yc exch def
  213.   /Xc exch def
  214.  
  215.   Xc Yc neg placetext    % Ftext is already on the stack
  216.  
  217.   SingDoub 1 and 1 eq
  218.   {
  219.     Xc Xdis add Yc neg Ydis add moveto
  220.     Xdis neg Xdis neg add 0 rlineto
  221.     stroke newpath
  222.   } if
  223.   SingDoub 2 and 2 eq
  224.   {
  225.     Xc Xdis add Yc neg Ydis neg add moveto
  226.     Xdis neg Xdis neg add 0 rlineto
  227.     stroke newpath
  228.   } if
  229. } def
  230.  
  231. /doControlFlow  % Gets: [[X1 Y1] ... [Xm Ym]] Xn Yn Name Arrows?
  232. {
  233.   [100 100] 50 setdash      % 1/10 inch dashes, start with 1/20 inch dash
  234.   doFlow                    % now handle regular dash...
  235.   [] 0 setdash              % return to solid line stroking
  236. } def
  237.  
  238. /doFlow        % Gets: [[X1 Y1] ... [Xm Ym]] Xn Yn Name Arrows?
  239. {
  240.   /Doub exch def        % Single or double headed: 
  241.   /Ftext exch def
  242.   /Yn exch def
  243.   /Xn exch def
  244.   /RouteArray exch def
  245.   RouteArray PolyLine % Draw the path, Sans arrowheads and Text
  246.   
  247.   RouteArray 0 get aload pop /Ys exch def /Xs exch def
  248.  
  249.   Doub 2 and 2 eq           % Arrowhead at beginning! (case 2 or 3)
  250.   {
  251.     RouteArray 1 get aload pop /Ytmp exch def /Xtmp exch def
  252.     Xs Ys neg moveto
  253.     Xs Xtmp sub Ys Ytmp sub atan arrowhead
  254.     gsave stroke grestore
  255.     newpath
  256.   }
  257.   if 
  258.  
  259.   Doub 1 and 1 eq           % Arrowhead at end! (cases 1 and 3)
  260.   {
  261.     /tmpCount RouteArray length def
  262.     RouteArray tmpCount 1 sub get aload pop /Ye exch def /Xe exch def
  263.     RouteArray tmpCount 2 sub get aload pop /Ytmp exch def /Xtmp exch def
  264.     Xe Ye neg moveto
  265.     Xe Xtmp sub Ye Ytmp sub atan arrowhead
  266.     gsave stroke grestore
  267.     newpath
  268.   }
  269.   if
  270.  
  271.   Xn Yn neg moveto
  272.   
  273.   Ftext 
  274.   dup BlankUnder
  275.   Xn Yn neg                     % Text still on stack
  276.   placetext
  277. } def
  278.  
  279. /doDescription            % Gets Dtext Xl Yl
  280. {
  281.   neg myscale 2 div add moveto    % Up 1/2 line for descriptions
  282.   0 get                         % Only use the first element of the array
  283.   gsave
  284.     dup stringwidth pop 2 div 0 rmoveto
  285.     dup [ exch ] BlankUnder
  286.   grestore
  287.   0 myscale 2 div neg rmoveto    % Move back 1/2 line.
  288.   show
  289. } def
  290.  
  291. %
  292. %% Other functions
  293. %
  294. /placetext         % stack: text xcenter ycenter
  295. { 
  296.   /Ypc exch def /Xpc exch def
  297.   /Array exch def  
  298.   /ArrayLen Array length def
  299.   /Ypc ArrayLen 2 div myscale mul neg Ypc add def
  300.  
  301.   Xpc Ypc moveto    % Absolute move to center top of new text
  302.   Array aload pop    % Push all the strings on the stack
  303.   0 1 ArrayLen 1 sub
  304.   {
  305.     myscale mul Ypc add    % Calculate the new Y center
  306.     Xpc exch moveto    % Move to the new text center
  307.     dup stringwidth pop    % puts x width on stack after copy of string
  308.     2 div neg         % puts -1/2 x on stack 
  309.     0            % puts 0 y-char height on stack
  310.     rmoveto        % move halfway
  311.     show        % Only string was on stack now
  312.   }
  313.   for
  314.   newpath        % Clear any current path from the moveto
  315. } def
  316.  
  317. /placeDate % Gets dateString x y
  318. {
  319.   gsave % just to save the font
  320.     moveto % leaves dateString on the stack
  321.     myfont findfont
  322.     myscale 2 div       % Half the regular font size
  323.       dup 18 Pts gt 
  324.       { pop 18 Pts } if % But never greater than 18 Pts
  325.       dup 5 Pts lt
  326.       { pop 5 Pts  } if % And never less than 5 Pts
  327.     scalefont
  328.     setfont
  329.     show
  330.   grestore
  331. } def
  332.  
  333. /box    % items on stack: xcenter ycenter xdis ydis: For externals
  334. {  /ydis exch def
  335.    /xdis exch def
  336.    /ycenter exch def
  337.    /xcenter exch def
  338.  
  339.    newpath
  340.    xcenter xdis add ycenter ydis add moveto
  341.    0 ydis neg ydis neg add rlineto
  342.    xdis neg xdis neg add 0 rlineto
  343.    0 ydis ydis add rlineto
  344.    closepath stroke
  345. } def
  346.  
  347. /average         % Gets: Two numbers to average
  348. {
  349.   add 2 div 
  350. } def
  351.  
  352. /arrowhead        % Gets: angle as input
  353. {
  354.   gsave            % Save current origin & rotation
  355.     currentpoint        % Get the current position
  356.     translate        % Make it the origin
  357.     rotate        % Use the angle argument
  358.     triangle        % Draw the triangle
  359.   grestore        % Restore origin and rotation
  360. } def
  361.  
  362. /triangle        % Draws a dull, black triangle at the origin
  363. {
  364.   gsave            % Preserve our dullness (gray scale)
  365.     0 setgray
  366.     0 0 moveto
  367.       50 100 lineto
  368.     -100   0 rlineto
  369.     closepath
  370.     fill
  371.   grestore        % Restore our dullness
  372. } def
  373.  
  374. /PolyLine % Array of 2-int arrays on stack
  375. {
  376.   /Array exch def
  377.   Array 0 get aload pop /Ys exch def /Xs exch def
  378.   Xs Ys neg moveto
  379.   1 1 Array length 1 sub
  380.   {
  381.     Array exch get aload pop /Ye exch def /Xe exch def
  382.     Xe Ye neg lineto
  383.     /Xs Xe def
  384.     /Ys Ye def
  385.   }
  386.   for
  387.   gsave stroke grestore
  388.   newpath
  389. } def
  390.  
  391. % Note: This is font specific.  For Helvetica, the Font Box
  392. % descends 22% below point size and extends above 94% point size
  393. /BlankUnder     % text-item array
  394. {
  395.   aload length /ArrayLen exch def
  396.   currentpoint /Ytmp exch def /Xtmp exch def
  397.   Xtmp Ytmp ArrayLen 2 div myscale mul neg add 
  398.   moveto
  399.   currentpoint /Ytmp exch def /Xtmp exch def
  400.   0 1 ArrayLen 1 sub
  401.   {
  402.     myscale mul Ytmp add Xtmp exch moveto
  403.     stringwidth pop    % How wide is it
  404.     dup 0 gt
  405.     {            % If width is > 0
  406.       dup 2 div neg         % Half of the string width wide
  407.       myscale rmoveto        % Move to -1/2 stringwidth, myscale
  408.       dup 0 rlineto        % Move to 1/2 stringwidth, myscale
  409.       0 myscale 1.25 mul neg rlineto    % Move to 1/2 stringwidth, -.25 myscale
  410.       neg 0 rlineto        % Move to -1/2 stringwidth, -.25 myscale
  411.       %myscale 1.2 mul rmoveto    % And 1.2 char height high
  412.       %dup 0 rlineto 0 myscale 1.2 mul 1.2 mul neg rlineto
  413.       %neg 0 rlineto
  414.       closepath
  415.       gsave            % Save current gray level
  416.       1 setgray fill
  417.       grestore newpath        % Reset the gray level
  418.     }
  419.     {            % width is 0
  420.       pop        % pop off extra stringwidth
  421.     }
  422.     ifelse
  423.   } for
  424. } def
  425. end % End of ATK1Dict: Do begin when needed.
  426. %%EndResource
  427. %%EndProlog
  428.