home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / MISC / POSTOGRF.ZIP / POSTHD3 < prev    next >
Encoding:
Text File  |  1990-05-25  |  3.7 KB  |  97 lines
  1. procedure posthd2;
  2. begin
  3. write(PrtFile,
  4. '%!PS-Adobe-2.0', CR, LF,
  5. '%%Creator: Thomas B. Passin', CR, LF,
  6. '%%Title:   POSTOGRF graph', CR, LF,
  7. '%%BoundingBox: ');
  8.  
  9. with Layout.BoundingBox do writeln(PrtFile,
  10.    LLx, '  ', LLy, '  ', URx, '  ', URy);
  11.  
  12. writeln(PrtFile,
  13. '%%Pages: 1', CR, LF,
  14. '%%EndComments', CR, LF,
  15. '% This printout is from ', ver, ', written by Thomas B. Passin.', CR, LF,
  16. '% POSTogrf operates on the output of J. R. VanZandt''s GRAPHLI or GRAPHPS ',
  17. CR, LF, '% program.  The output file drives a Postscript printer.', CR, LF,
  18. '% ------------------------ Prologue  -------------------------------', CR, LF,
  19. 'save', CR, LF,
  20. '%Abbreviations', CR, LF,
  21. '/cpt /currentpoint    load   def', CR, LF,
  22. '/l    /lineto         load   def' ,CR, LF,
  23. '/m    /moveto         load   def' ,CR, LF,
  24. '/sd   /setdash        load   def' ,CR, LF,
  25. '/sf   /setfont        load   def' ,CR, LF,
  26. '/sg   /setgray        load   def' ,CR, LF,
  27. '/st   /stroke         load   def' ,CR, LF,
  28. '/inch { 72 mul } def', CR, LF,
  29. '/linethick 10 def     %default line thickness', CR, LF,
  30. '/barxl -1000 def', CR, LF,
  31. '/barxr 9500 def');
  32.  
  33. writeln(PrtFile,
  34. '/bary ', {5100} Layout.origin.x - 1750, ' def');
  35.  
  36. with Layout.origin do Writeln(PrtFile,
  37. '/setorigin { ', x/1000:6:3, ' inch ', y/1000:6:3, ' inch translate');
  38.  
  39. if Layout.landscape then writeln(PrtFile,
  40. '             90 rotate');
  41.  
  42. writeln(PrtFile,
  43. '             0 0 m } def');
  44.  
  45. writeln(PrtFile,
  46. '/dobar { 28 setlinewidth barxl bary m', CR, LF,
  47. '          barxr bary l st } def', CR, LF,
  48. '/ss1 1 string def',                                      CR, LF,
  49. '/x1 0 def /x2 0 def /y1 0 def /y2 0 def',                CR, LF,
  50. '/charbox {           % find largest char. height',       CR, LF,
  51. '           { ss1 0 3 2 roll put ss1 false charpath',     CR, LF,
  52. '             pathbbox cpt newpath m',                    CR, LF,
  53. '             dup y2 gt { /y2 exch def } { pop } ifelse', CR, LF,
  54. '             pop',                                       CR, LF,
  55. '             dup y1 lt { /y1 exch def } { pop } ifelse', CR, LF,
  56. '             pop',                                       CR, LF,
  57. '           } forall',                                    CR, LF,
  58. '        } bind def',                                     CR, LF,
  59. '/fillbox {',                            CR, LF,
  60. '        dup gsave',                     CR, LF,
  61. '        cpt newpath m',                 CR, LF,
  62. '        cpt /y1 exch def /x1 exch def', CR, LF,
  63. '        cpt /y2 exch def pop',          CR, LF,
  64. '        charbox',                       CR, LF,
  65. '        /x2 cpt pop def',               CR, LF,
  66. '        /dely y2 y1 sub 9 div def',     CR, LF,
  67. '        /x1 x1 dely sub def',           CR, LF,
  68. '        /x2 x2 dely add def',           CR, LF,
  69. '        /y1 y1 dely sub def',           CR, LF,
  70. '        /y2 y2 dely add def',           CR, LF,
  71. '        x1 y1 moveto',                  CR, LF,
  72. '        x2 y1 lineto',                  CR, LF,
  73. '        x2 y2 lineto',                  CR, LF,
  74. '        x1 y2 lineto',                  CR, LF,
  75. '        closepath',                     CR, LF,
  76. '        1 sg fill',                     CR, LF,
  77. '        grestore',                      CR, LF,
  78. '    } bind def',                        CR, LF,
  79. '/s { fillbox show } bind def',          CR, LF,
  80. '/rs { 90 rotate s -90 rotate } bind def', CR, LF,
  81. '/rsho { 90 rotate show -90 rotate } bind def');
  82. end;
  83.  
  84. procedure PSSetUp;
  85. begin
  86.      writeln(PrtFile,
  87. '%%BeginSetup', CR, LF,
  88. 'gsave', CR, LF,
  89. 'statusdict dup', CR, LF,
  90. '/waittimeout 10 put', CR, LF,
  91. '/jobname (POSTOGRF) put', CR, LF,
  92. 'newpath', CR, LF,
  93. 'setorigin', CR, LF,
  94. '0.072 0.072 scale                % set scale to 1/1000''s inch', CR, LF,
  95. 'linethick setlinewidth', CR, LF,
  96. '%%EndSetup');
  97. end;