home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PSCRIPT / PPS213.ZIP / PPS213.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-02-08  |  31.1 KB  |  968 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N+,E+}    {numeric coprocessor - or emulation}
  6. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  7.  
  8. PROGRAM Postscript;
  9.  
  10.  
  11. {ASCII menu driven listing program that generates PostScript
  12. commands to the Apple LaserWriter.  Allows selction of
  13. bold and normal fonts, font size and line spacing.  Output
  14. can go to a disk file (output.ps) or directly to the printer.
  15.  
  16. Limitations: Handling tabs is limited to move to an absolute location
  17. on the line.  Program is not smart about the actual widths of
  18. characters in different fonts... it just uses an average width per
  19. character of fontsize/2.  Epson font change escapes ESC G for bold
  20. and ESC H for normal are used.  Spacing for a tab is based on an
  21. average of 8 nominal characters... as a result the tab spacing after
  22. some text with capital letters may not be wide enough and the text
  23. starting after the tab may overlap with previous text.  (On the other
  24. hand, the worst case width of 8 widest characters is too large for
  25. normal use).
  26.  
  27. Can be invoked with filename as a parameter: nlist filename
  28.  
  29. Free for non-commercial use only.
  30.  
  31. (C) Copywrite Nate Liskov 27 Jan 1986}
  32.  
  33. { Version 1.0 - Original Version 
  34. Version 1.1 - Fonts for LaserWriter Plus Added 
  35. Version 1.2 - Landscape Format Option Added - Apr 1987 
  36. version 1.21 - command line paramters -n= and -b= added to
  37.                  preset normal and bold fonts
  38.                - no headers, no lineffed and output to file are defaults
  39.                  if command line file has .mem extension
  40. version 1.22 - mar 1988
  41.                - option for number of lines added
  42.                - fix display of pages printed when page feed off
  43.                - capability to print multiple files per invocation added
  44.                - apr 88... fix spelling of avantgarde
  45. version 1.23  - apr 1988
  46.                - zeroize output.ps option added
  47. version 2.00  - converted to turbo 4.0
  48. version 2.02  - july 1988
  49.             - minor bugs corrected
  50. version 2.03  - 9 sept 1988
  51.            - correct bug in bold that inserted 2 spaces
  52. version 2.04  - 22 sept 1988
  53.            - leave leading blanks in each line vs removing them
  54.                thus correcting spacing problems with courier font
  55.            - reduce min left hand margin  from 45/72 to 36/72 inch
  56.            - appears to handle mix of tabs, bold, normal on one line
  57.            - tab spacing is 8 times a number character width
  58.                     note: for all fonts except courier number width =
  59.                            twice space width
  60. version 2.05  - change spacing for automatic centering
  61. version 2.06  - cleanup of 2.05, display of pitch
  62. version 2.07  - redirect output code changed, change mto to m
  63.            - conform to encapsulated postscript
  64. version 2.08  - converted to turbo 5.0, uses turbo3 dropped
  65. version 2.09  - account for actual space widths in breaking up long
  66.            - line into several lines
  67.            - 28 nov 1988 corrected bug with blank input lines
  68. version 2.10  - 12 dec 1988
  69.            - help function added with ? or help command line parameters
  70.            - 6 dec 1989
  71.            - debugged encapsulated postscript input to wordperfect 5.0
  72. version 2.11  - 24 dec 1988
  73.            - add helvetica-condensed fonts
  74.              (ti-omnilaser equivalent to helvetica narrow)
  75.            - 7 dec 1989
  76.            - debugged encapsulated postscript input to wordperfect
  77. version 2.12   - better file handling if input file does not exist
  78. }
  79.  
  80. Uses
  81.   Crt,
  82.   Dos,
  83.   Printer;
  84.  
  85. TYPE 
  86.   DateTimeStr = STRING[26];
  87.   OnorOff     = ARRAY[1..2] OF STRING[3];
  88.   pageform    = ARRAY[1..2] OF STRING[9];
  89.   fonttype    = ARRAY[1..37] OF STRING[28];
  90.   outfile     = ARRAY[1..2] OF STRING[21];
  91.   msg         = STRING[127];
  92.   maxspaces   = STRING[255];
  93.  
  94. VAR
  95.     numberofcopies, linecount, n, m, page, linelength, entryline : integer;
  96.     topspaces, bottomspaces, leftmargin, rightmargin, lm, rm : integer;
  97.     option   : char;
  98.     pagestr  : STRING[3];
  99.     filename : STRING[45];
  100.     temp, lineout     : STRING[255];
  101.     right, left : maxspaces;
  102.     source, sink   : text;
  103.     linesize, header, automatic, maxline : integer;
  104.     x,strng        : msg;
  105.     hellfreezesover,autoexit: boolean;
  106.     datetimestamp: datetimestr;
  107.     yposition,linesperpage,linespacing,nfont,bfont,currentfont,
  108.         nout,pagefeed,fontsize,pagetype : integer;
  109.     fontsused:array[1..37]of boolean;
  110.     formatsused:array[1..2]of boolean;
  111.  
  112.   CONST 
  113.     onoff: onoroff = ('On ','Off');
  114.     pageformat: pageform = ('Portrait ','Landscape');
  115.     font: fonttype = ('Helvetica','Times-Roman','Courier',
  116.                       'Helvetica-Oblique','Times-Italic','Courier-Oblique',
  117.                       'Helvetica-Bold','Times-Bold','Courier-Bold',
  118.                       'Helvetica-BoldOblique','Times-BoldItalic',
  119.               'Courier-BoldOblique','AvantGarde-Book',
  120.               'AvantGarde-BookOblique','AvantGarde-Demi',
  121.               'AvantGarde-DemiOblique','Bookman-Demi',
  122.               'Bookman-DemiItalic','Bookman-Light',
  123.               'Bookman-LightItalic','Helvetica-Narrow',
  124.               'Helvetica-Narrow-Bold',
  125.               'Helvetica-Narrow-Oblique',
  126.               'Helvetica-Narrow-BoldOblique',
  127.               'NewCenturySchlbk-Roman',
  128.               'NewCenturySchlbk-Bold','NewCenturySchlbk-Italic',
  129.               'NewCenturySchlbk-BoldItalic','Palatino-Roman',
  130.               'Palatino-Bold','Palatino-Italic','Palatino-BoldItalic',
  131.               'ZapfChancery-MediumItalic','Helvetica-Condensed',
  132.               'Helvetica-Condensed-Bold',
  133.               'Helvetica-Condensed-Oblique',
  134.               'Helvetica-Condensed-BoldObl');
  135.     spacewidth: ARRAY [1..37] of real = (0.556,0.5,0.6,0.556,0.5,0.6,
  136.                        0.556,0.5,0.6,0.556,0.5,0.6,
  137.                0.554,0.554,0.554,0.554,0.660,0.660,0.660,0.66,
  138.                0.456,0.456,0.456,0.456,0.556,0.556,0.556,0.556,
  139.                0.5,0.5,0.5,0.5,0.44,0.456,0.456,0.456,0.456);
  140.                {spacewidth is width of space for courier, else
  141.                 spacewidth is twice width of space which is 
  142.             same as the width of a number character}
  143.     output: outfile = ('Printer','Disk File: Output.ps');
  144.  
  145. function upword(wrd:msg):msg;
  146. var n:integer;
  147. begin
  148.   for n :=1 to length(wrd) do
  149.   wrd[n]:=upcase(wrd[n]);
  150.   upword := wrd;
  151. end;
  152.  
  153. FUNCTION spaces(n:integer): maxspaces;
  154.  
  155.   VAR 
  156.     tmp: STRING[255];
  157.     m: integer;
  158.   BEGIN
  159.     tmp := '';
  160.     FOR m :=1 TO n DO
  161.       tmp := tmp + ' ';
  162.     spaces := tmp;
  163.   END;
  164.  
  165. procedure setlinesize;
  166. begin
  167.     IF pagetype = 1 THEN linesize := round(594/(fontsize*spacewidth[nfont]))
  168.     ELSE linesize := round(774/(fontsize*spacewidth[nfont]));
  169.     if nfont in [3,6,9,12] then 
  170.           linesize:=linesize else
  171.           linesize:=round(linesize*1.04);    {fudge factor}
  172. end;
  173.  
  174. Procedure help;
  175. var foo :char;
  176. begin
  177.   clrscr;
  178.   writeln('                       PPS HELP');
  179.   writeln;
  180.   writeln('  Command Line Parameters');
  181.   writeln;
  182.   writeln('     ?, help       help on command line parameters');
  183.   writeln('     -0=10         sets fontsize to 10');
  184.   writeln('     -1=13         sets line spacing to 13');
  185.   writeln('     -2            pagefeed commands are in input file (default for .mem file)');
  186.   writeln('     -3=25         normal font is font 25');
  187.   writeln('     -4=13         bold font is font 13');
  188.   writeln('     -5=2          suppress header line (default for .mem file)');
  189.   writeln('     -6            output to printer vs output.ps');
  190.   writeln('     -7=5          topspaces = 5');
  191.   writeln('     -8=7          bottomspaces = 7');
  192.   writeln('     -9            automatic margins');
  193.   writeln('     -G            go, then exit program');
  194.   writeln('     -L=12         left margin is 12');
  195.   writeln('     -N=7          normal font is font 7');
  196.   writeln('     -P            landscape page format');
  197.   writeln('     -R=12         right margin is 12');
  198.   writeln('     -foobar       input file is foobar');
  199.   halt;
  200. end;
  201.  
  202. PROCEDURE Alarm;
  203. BEGIN
  204.   sound(1000);
  205.   delay(500);
  206.   nosound;
  207. END;
  208.  
  209. PROCEDURE Testfile(filename:msg);
  210. var
  211. fileok:boolean;
  212. BEGIN
  213.   {$I-}
  214.   Reset(source) {$I+};
  215.   fileok := (IOResult=0);
  216.   IF NOT fileok
  217.     THEN BEGIN
  218.            HighVideo;
  219.            alarm;
  220.            WriteLn('   -- Error! --   file ',filename,' not found');
  221.        HALT;
  222.       END;
  223. END;
  224.  
  225. PROCEDURE parameters;
  226.  
  227. VAR n,err : INTEGER;
  228. BEGIN
  229.   filename := '';
  230.   for n := 1 to paramcount do begin
  231.     strng := upword(paramstr(n));
  232.     if (strng = '?') or (strng = 'HELP') then help;
  233.     if pos('-0=',strng) <> 0 then begin
  234.        delete(strng,1,3);
  235.        val(strng,fontsize,err)
  236.     end;
  237.     if pos('-1=',strng) =1 then begin
  238.        delete(strng,1,3);
  239.        val(strng,linespacing,err)
  240.     end;
  241.     if pos('-3=',strng)=1 then begin
  242.        delete(strng,1,3);
  243.        val(strng,nfont,err)
  244.     end;
  245.     if pos('-4=',strng)=1 then begin
  246.        delete(strng,1,3);
  247.        val(strng,bfont,err)
  248.     end;
  249.     if pos('-7=',strng)=1 then begin
  250.        delete(strng,1,3);
  251.        val(strng,topspaces,err)
  252.     end;
  253.     if pos('-8=',strng)=1 then begin
  254.        delete(strng,1,3);
  255.        val(strng,bottomspaces,err)
  256.     end;
  257.     if pos('-L=',strng)=1 then begin
  258.        delete(strng,1,3);
  259.        val(strng,leftmargin,err);
  260. {       if err=0 then left := spaces(leftmargin);}
  261.     end;
  262.     if pos('-R=',strng)=1 then begin
  263.        delete(strng,1,3);
  264.        val(strng,rightmargin,err);
  265.        if err=0 then right := spaces(rightmargin);
  266.     end;
  267.     if pos('-N=',strng)=1 then begin
  268.        delete(strng,1,3);
  269.        val(strng,nfont,err)
  270.     end;
  271.     if strng='-2' then pagefeed:=2;
  272.     if strng='-5' then header:=2;
  273.     if strng='-6' then nout:=1;
  274.     if strng='-9' then automatic:=1;
  275.     if strng='-P' then pagetype:=2;
  276.     if strng='-G' then autoexit:=true;
  277.   end;
  278.   for n := 1 to paramcount do begin
  279.      strng := upword(paramstr(n));
  280.     if pos('-',strng)=1 then strng:=strng else
  281.        filename := paramstr(n);
  282.   end;
  283.   assign(source,filename);
  284.   strng := upword(filename);
  285.   if pos('.MEM',strng)<>0 then begin 
  286.     nout :=2;
  287.     pagefeed := 2;
  288.     header := 2;
  289.   end;
  290.   setlinesize;
  291.     IF pagetype = 1 THEN linesperpage := 792 DIV linespacing
  292.     ELSE linesperpage := 612 DIV linespacing;
  293. END;
  294.  
  295. function datetime:datetimestr;
  296. TYPE
  297.   monthname = ARRAY[1..12] OF STRING[3];
  298.   daynames = ARRAY[1..7] OF STRING[3];
  299. CONST
  300.   mon: monthname = ('Jan','Feb','Mar','Apr','May','Jun',
  301.                             'Jul','Aug','Sep','Oct','Nov','Dec');
  302.   days: daynames = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  303. VAR
  304.   year,month,day,dayofweek,hour,min,sec,sec100:word;
  305.   str1:string[1];
  306.   daystr,hourstr,minstr,secstr:string[2];
  307.   yearstr:string[4];
  308. begin
  309.     getdate(year,month,day,dayofweek);
  310.     gettime(hour,min,sec,sec100);
  311.     if day>9 then str(day,daystr) else begin
  312.        str(day,str1); daystr:=' '+str1;end;
  313.     if hour>9 then str(hour,hourstr) else begin
  314.        str(hour,str1); hourstr:='0'+str1;end;
  315.     if min>9 then str(min,minstr) else begin
  316.        str(min,str1);minstr:='0'+str1;end;
  317.     if sec>9 then str(sec,secstr) else begin
  318.        str(sec,str1);secstr:='0'+str1;end;
  319.     str(year,yearstr);
  320.     datetime := days[1+dayofweek]+' '+daystr+' '+mon[month]+' '+yearstr
  321.           +'   '+hourstr+':'+minstr+':'+secstr;
  322. end;
  323.  
  324. PROCEDURE init;
  325.   BEGIN
  326.     autoexit:=false;
  327.     nfont := 1 ;              {default normal font is helvetica}
  328.     bfont := 7;               {default bold font is helvetica-bold}
  329.     nout := 2;                {default output is to file}
  330.     pagefeed := 1;            {default is to do page feed}
  331.     pagetype := 1;            {default is portrait page format}
  332.     fontsize := 12;
  333.     linespacing := 12;
  334.     setlinesize;
  335.     linesperpage := 792 DIV linespacing;
  336.     header   := 1;           {default is header line on}
  337.     automatic := 2;          {default is zero margins}
  338.     topspaces := 2;
  339.     bottomspaces := 0;
  340.     leftmargin := 0;
  341.     rightmargin := 0;
  342.     numberofcopies := 1;
  343.     right := '';
  344.     left := '';
  345.     entryline := 23;
  346.     filename := '';
  347.     IF paramcount<>0 then parameters;
  348.     for n:=1 to 34 do fontsused[n]:=false;
  349.     for n:=1 to 2 do formatsused[n]:=false;
  350.     if nout=2 then assign(sink,'output.ps') else assign(sink,'lpt1');
  351.     rewrite(sink);
  352.     hellfreezesover := false;
  353.     writeln(sink,'%!PS-Adobe-2.0 EPSF-1.2');
  354.     writeln(sink,'%%BeginDocument: PPS ASCII-to-Postscript Conversion');
  355.     writeln(sink,'%%Title: PPS generated file');
  356.     writeln(sink,'%%Creator: PPS version 2.13');
  357.     writeln(sink,'%%BoundingBox: (atend)');
  358.     writeln(sink,'%%DocumentFonts: (atend)');
  359.     writeln(sink,'%%CreationDate: ',datetime);
  360.     writeln(sink,'%%Pages: ',numberofcopies);
  361.     writeln(sink,'%%EndComments');
  362.     writeln(sink,'%%EndProlog');
  363.    writeln(sink,'%Copywrite 1988 (C) by Nathan Liskov.  All Rights Reserved');
  364.   END;
  365.  
  366. PROCEDURE optionline;
  367.   BEGIN
  368.     gotoxy(1,entryline);
  369.     normvideo;
  370. {! 5^. The effects of HighVideo,LowVideo,NormVideo are different in Turbo 4.0.}
  371.     writeln('   Enter Option Choice                                                ');
  372.     gotoxy(36,entryline);
  373.   END;
  374.  
  375. PROCEDURE menu;  {gives main menu options}
  376.   BEGIN
  377.     clrscr;
  378.     lowvideo;
  379. {! 6^. The effects of HighVideo,LowVideo,NormVideo are different in Turbo 4.0.}
  380.     writeln('Postscript File Listing Utility for Apple LaserWriter - Version 2.13');
  381.     writeln('   ____________(C) 1986 Nathan Liskov_____________');
  382.     writeln;
  383.     writeln('   0 := Font Size                : ',fontsize,'   (pitch = ',72/(fontsize*spacewidth[nfont]):5:1,')    ');
  384.     writeln('   1 := Line Spacing             : ',linespacing,'   (',linesperpage,
  385.             ' lines per page)');
  386.     writeln('   2 := Page Feed                : ',onoff[pagefeed]);
  387.     writeln('   3 := Normal Font              : ',font[nfont]);
  388.     writeln('   4 := Bold Font                : ',font[bfont]);
  389.     writeln('   5 := Header Line              : ',onoff[header]);
  390.     writeln('   6 := Output Goes To           : ',output[nout]);
  391.     writeln('   7 := Extra Top Blank Lines    : ',topspaces);
  392.     writeln('   8 := Extra Bottom Blank Lines : ',bottomspaces);
  393.     writeln('   9 := Automatic L/R Margins    : ',onoff[automatic]);
  394.     writeln('   L := Extra Left Margin        : ',leftmargin);
  395.     writeln('   R := Extra Right Margin       : ',rightmargin);
  396.     writeln('   P := Page Format              : ',pageformat[pagetype]);
  397.     writeln('   N := Number of Copies         : ',numberofcopies);
  398.     writeln;
  399.     normvideo;
  400. {! 7^. The effects of HighVideo,LowVideo,NormVideo are different in Turbo 4.0.}
  401.     writeln('   F := File Name                : ',filename);
  402.     writeln;
  403.     writeln('   G := GO       ESC,Q := QUIT       Z := Zeroize Output.ps');
  404.     writeln;
  405.     optionline;
  406.     page := 0;
  407.   END;
  408.  
  409. PROCEDURE get_file;
  410.   BEGIN
  411.     gotoxy(1,entryline);
  412.     write('   Enter name of file to list: ');
  413.     readln(filename);
  414.     assign(source,filename);
  415.     gotoxy(36,19);
  416.     write(filename,'                                           ');
  417.     optionline;
  418.   END;
  419.  
  420. PROCEDURE settopmargin;
  421.   BEGIN
  422.     gotoxy(1,entryline);
  423.     write('   Enter number of extra top spaces: ');
  424.     readln(topspaces);
  425.     gotoxy(36,11);
  426.     write(topspaces,'            ');
  427.     optionline;
  428.   END;
  429.  
  430. PROCEDURE setbottommargin;
  431.   BEGIN
  432.     gotoxy(1,entryline);
  433.     write('   Enter number of extra bottom spaces: ');
  434.     readln(bottomspaces);
  435.     gotoxy(36,12);
  436.     write(bottomspaces,'            ');
  437.     optionline;
  438.   END;
  439.  
  440. PROCEDURE setleftmargin;
  441.   BEGIN
  442.     gotoxy(1,entryline);
  443.     write('   Enter number of extra left margin spaces: ');
  444.     readln(leftmargin);
  445. {    left := spaces(leftmargin);}
  446.     gotoxy(36,14);
  447.     write(leftmargin,'             ');
  448.     optionline;
  449.   END;
  450.  
  451. PROCEDURE setnumberofcopies;
  452.   BEGIN
  453.     gotoxy(1,entryline);
  454.     write('   Enter number of copies: ');
  455.     readln(numberofcopies);
  456.     gotoxy(36,17);
  457.     write(numberofcopies,'             ');
  458.     optionline;
  459. END;
  460.  
  461. PROCEDURE setfontsize;
  462.   BEGIN
  463.     gotoxy(1,entryline);
  464.     write('   Enter new fontsize: ');
  465.     readln(fontsize);
  466.     setlinesize;
  467.     gotoxy(36,4);
  468.    write(fontsize,'   (pitch = ',72/(fontsize*spacewidth[nfont]):5:1,')    ');
  469. {    write(fontsize,'             ');}
  470.     optionline;
  471.   END;
  472.  
  473. PROCEDURE setlinespacing;
  474.   BEGIN
  475.     gotoxy(1,entryline);
  476.     write('   Enter new linespacing: ');
  477.     readln(linespacing);
  478.     IF pagetype = 1 THEN linesperpage := 792 DIV linespacing
  479.     ELSE linesperpage := 612 DIV linespacing;
  480.     gotoxy(36,5);
  481.     write(linespacing,'   (',linesperpage,' lines per page)    ');
  482.     optionline;
  483.   END;
  484.  
  485.  
  486. PROCEDURE setrightmargin;
  487.   BEGIN
  488.     gotoxy(1,entryline);
  489.     write('   Enter number of extra right margin spaces: ');
  490.     readln(rightmargin);
  491.     right := spaces(rightmargin);
  492.     gotoxy(36,15);
  493.     write(rightmargin,'             ');
  494.     optionline;
  495.   END;
  496.  
  497. PROCEDURE setpageformat;
  498.   BEGIN
  499.     IF pagetype = 1
  500.     THEN pagetype := 2
  501.     ELSE pagetype := 1;
  502.     gotoxy(36,16);
  503.     write(pageformat[pagetype],'           ');
  504.     setlinesize;
  505.     IF pagetype = 1 THEN linesperpage := 792 DIV linespacing
  506.     ELSE linesperpage := 612 DIV linespacing;
  507.     gotoxy(36,5);
  508.     write(linespacing,'   (',linesperpage,' lines per page)    ');
  509.     optionline;
  510.   END;
  511.  
  512.  
  513. PROCEDURE setfont(n:integer);
  514.  
  515.   BEGIN
  516.     IF n=nfont then writeln(sink,'normalfont')
  517.     ELSE writeln(sink,'boldfont');
  518.     setlinesize;
  519. {    gotoxy(36,4);
  520.    write(fontsize,'   (pitch = ',72/(fontsize*spacewidth[nfont]):5:1,')    ');}
  521.   END;
  522.  
  523. PROCEDURE page_feed;
  524.   BEGIN
  525.     writeln(sink,' showpage');
  526.     writeln(sink,'saveobj2 restore');
  527.     writeln(sink,'/saveobj2 save def');
  528.     setfont(nfont);
  529.     linecount := 1;
  530.     page := page + 1;
  531.   END;
  532.  
  533. PROCEDURE countlb(strng:msg;var leadingblanks:integer);
  534. BEGIN
  535.     leadingblanks := 0;
  536.     WHILE pos(' ',strng) = 1 DO
  537.       BEGIN
  538.         leadingblanks := leadingblanks+1;
  539.         strng := copy(strng,2,length(strng)-1);
  540.       END;
  541. END;
  542.  
  543. PROCEDURE output_line;
  544.  
  545.   TYPE 
  546.       txt = STRING [255];
  547.  
  548.   VAR 
  549.        restofline,textpiece : txt;
  550.        ypos : STRING[4];
  551.        xpos:real;
  552.         startofpiece,leadingblanks : integer;
  553.        locatetext: boolean;
  554.  
  555. PROCEDURE escape(ch :char ; VAR txtline : txt);
  556.     {adds \ escape for postscript}
  557.  
  558.   VAR 
  559.        lineout,restofline,remainder : txt;
  560.        m : integer;
  561.   BEGIN
  562.     restofline := txtline;
  563.     lineout := '';
  564.     remainder := '';
  565.     IF pos(ch,txtline) = 0
  566.       THEN lineout := txtline;
  567.     WHILE pos(ch,restofline) > 0 DO
  568.       BEGIN
  569.         m := pos(ch,restofline);
  570.         lineout := lineout + copy(restofline,1,m-1) + '\' + ch;
  571.         restofline := copy(restofline,m+1,length(restofline)-m);
  572.         remainder := restofline;
  573.       END;
  574.       txtline := lineout + remainder;
  575.   END;
  576.  
  577.  
  578. PROCEDURE dosubpiece(VAR txtpiece : txt);
  579.                 {process text piece without tabs or font escapes}
  580.   BEGIN
  581.     escape('\',txtpiece);
  582.     escape(')',txtpiece);
  583.     escape('(',txtpiece);
  584.     if locatetext then write(sink,xpos:5:1,' ',ypos,' m ');
  585. writeln(sink,'('+txtpiece+')' + ' s ');
  586. {if leadingblanks<length(txtpiece) then writeln(sink,'('+txtpiece+')' + ' s ')
  587.     else writeln(sink,'');}
  588.     locatetext:=false;
  589.   END;
  590.  
  591. PROCEDURE dotextpiece(VAR textpiece : txt);  {process text that may have tabs}
  592.  
  593.   VAR 
  594.       m,xposition,ofset : integer;
  595.       txtpiece : txt;
  596.  
  597.   BEGIN
  598.     ofset:= 18;
  599.     IF pagetype = 1 THEN yposition := 792-linespacing*linecount
  600.     ELSE yposition := 612-linespacing*linecount;
  601.     str(yposition,ypos);
  602. {    str((leadingblanks+startofpiece-1)*fontsize div 2  + ofset,xpos);
  603.     str(round((startofpiece-1)*fontsize*0.6)  + ofset,xpos);}
  604.     xpos:=(startofpiece-1)*fontsize*spacewidth[nfont] + ofset;
  605. {    xpos:=xpos+leftmargin*fontsize*2*spacewidth[nfont];
  606. if nfont in [3,6,9,12] then}
  607.     xpos:=xpos+leftmargin*fontsize*spacewidth[nfont];
  608.         if automatic=1 then xpos:=xpos-ofset;
  609.     WHILE pos(chr(9),textpiece)>0 DO
  610.       BEGIN                      {tab processing}
  611.         m := pos(chr(9),textpiece);
  612.         txtpiece := copy(textpiece,1,m-1);
  613.     if length(txtpiece)>0 then dosubpiece(txtpiece);{output piece before tab}
  614.         locatetext:=true;
  615.         xposition := startofpiece + m-1;
  616.         xposition := ((xposition-1) DIV 8 + 1)*8;
  617.         startofpiece := xposition+1;
  618.         xpos := (xposition)*fontsize*spacewidth[nfont] + ofset;
  619.         if automatic=1 then xpos:=xpos-ofset;
  620. {this spaces a tab exactly equal to 8 spaces in courier font}
  621. {        str(xposition,xpos);}
  622.         textpiece := copy(textpiece,m+1,length(textpiece)-m);
  623.         if nfont in [3,6,9,12] then nfont:=nfont else begin
  624.       countlb(textpiece,leadingblanks);
  625.           xpos:=xpos+leadingblanks*fontsize*spacewidth[nfont]/2;
  626.         end; 
  627. {         xpos:=xpos+leftmargin*fontsize*2*spacewidth[nfont];
  628.          if nfont in [3,6,9,12] then}
  629.      xpos:=xpos+leftmargin*fontsize*spacewidth[nfont];
  630.       END;
  631.     IF length(textpiece)>0 then dosubpiece(textpiece);
  632. END;
  633.  
  634.   BEGIN     {output_line}
  635.     IF pos(chr(12),temp)>0   {assume form feed is only character on a line}
  636.       THEN BEGIN
  637.              page_feed;
  638. gotoxy(1,entryline+2);
  639.                    clreol;
  640.              write('Page ',page,' ');         {status info to screen}
  641.              exit;
  642.          END;
  643. {compute number of leading blanks}
  644.     locatetext := true;
  645.     countlb(temp,leadingblanks);
  646. {look for enable or disable bold}
  647.     restofline := temp;
  648.    WHILE (pos(chr(27)+'G',restofline)>0) OR (pos(chr(27)+'H',restofline)>0) DO
  649.       BEGIN
  650.         IF pos(chr(27)+'G',restofline)>0   {esc G enables bold}
  651.           THEN BEGIN
  652.                  m := pos(chr(27)+'G',restofline);
  653.          textpiece := copy(restofline,1,m-1);
  654.                  startofpiece := length(temp)-length(restofline)+1;
  655.                  restofline := copy(restofline,m+2,length(restofline));
  656. {                 IF length(textpiece) <> 0
  657.                    THEN} dotextpiece(textpiece);
  658.                  delete(temp,m,2);
  659.                  setfont(bfont);
  660.                  currentfont := bfont;
  661.             END;
  662.         IF pos(chr(27)+'H',restofline)>0   {esc H disables bold}
  663.           THEN BEGIN
  664.                  m := pos(chr(27)+'H',restofline);
  665.                  textpiece := copy(restofline,1,m-1);
  666.                  startofpiece := length(temp)-length(restofline)+1;
  667.                  restofline := copy(restofline,m+2,length(restofline));
  668. {                 IF length(textpiece) <> 0
  669.                    THEN} dotextpiece(textpiece);
  670.                  setfont(nfont);
  671.                  currentfont := nfont;
  672.             END;
  673.       END;
  674. {    IF length(restofline)>0
  675.       THEN} BEGIN
  676.              startofpiece := length(temp)-length(restofline)+1;
  677.              dotextpiece(restofline);
  678.         END;
  679.    locatetext:=false;
  680. END;
  681.  
  682. PROCEDURE insertblankline;
  683.   BEGIN
  684.     temp := '';
  685.     output_line;
  686.     write('.');
  687.     linecount := linecount + 1;
  688.   END;
  689.  
  690. PROCEDURE inserttoplines;
  691.   BEGIN
  692.     FOR n := 1 TO topspaces DO
  693.       insertblankline;
  694.   END;
  695.  
  696. PROCEDURE title; {prints filename, datetime, and page number on each page}
  697.  
  698.   VAR 
  699.       nspaces : integer;
  700.   BEGIN
  701.     nspaces := (linesize - 36- length(filename)) DIV 2;
  702.     IF nfont IN [3,6,9,12]   {test for courier font}
  703.       THEN     nspaces := (linesize - 36- length(filename)) DIV 4;
  704.     temp := 'File: '+ filename + spaces(nspaces);
  705.     temp := temp + datetimestamp + spaces(nspaces) + 'Page ';
  706.     str(page:3,pagestr);
  707.     temp := temp + pagestr;
  708.     output_line;
  709.     write('.');
  710.     linecount := 2;
  711.   END;
  712.  
  713. PROCEDURE automaticmargins;
  714. VAR
  715.   templine: string[255];
  716. {sets margins so longest line in file is centered}
  717.   BEGIN
  718.     testfile(filename);
  719.     reset(source);
  720.     lm := leftmargin;
  721.     rm := rightmargin;
  722.     maxline := 0;
  723.     REPEAT
  724.       readln(source,temp);
  725.       m := length(temp);
  726.       IF m > maxline then maxline:=m;
  727. {        THEN BEGIN
  728.           maxline := m;
  729.       templine:=temp;
  730.       while pos(chr(9),templine)=1 do delete(templine,1,1);
  731.       while pos(chr(9),templine)<>0 do begin
  732.         if nfont in [3,6,9,12] then m:=m+7 else m:= m+15;
  733.         delete(templine,pos(chr(9),templine),1);
  734.         end;
  735.         END;}
  736.     UNTIL EOF(source);
  737.     close(source);
  738. (*    IF nfont IN [3,6,9,12]   {test for courier font}
  739.       THEN leftmargin := (linesize-maxline) div 2
  740.       ELSE     leftmargin := (linesize-maxline) div 4;*)
  741.     leftmargin := (linesize-maxline) div 2;
  742.     IF leftmargin < 0
  743.       THEN leftmargin := 0;
  744.       rightmargin := 0;
  745.     right := spaces(rightmargin);
  746. {    left := spaces(leftmargin);writeln(leftmargin);}
  747. {writeln(linesize,' ',leftmargin);}
  748.     END;
  749.  
  750. procedure doaline;
  751. begin
  752.           output_line;
  753.           linecount := linecount + 1;
  754.           write('.');
  755.           IF (linecount > (9*linesperpage DIV 10) - bottomspaces) AND (pagefeed =1)
  756.             THEN page_feed;
  757.           IF linecount =1
  758.             THEN BEGIN {do after page break}
  759. gotoxy(1,entryline+2);
  760.                    clreol;
  761.                    write('Page ',page,' ');         {status info to screen}
  762.                    IF (header = 1) and (pagefeed=1)
  763.                      THEN title;
  764.                    IF (topspaces >0) and (pagefeed=1)
  765.                      THEN inserttoplines;
  766.               END;
  767. end;
  768.  
  769. PROCEDURE printfile;
  770.  
  771.   VAR 
  772.        n,len,leadingblanks : integer;
  773.        ypos : STRING[4];
  774.        siz : STRING [3];
  775.        templine:msg;
  776.  
  777.   BEGIN
  778.     datetimestamp := datetime;
  779.     IF automatic = 1
  780.       THEN automaticmargins;
  781.     testfile(filename);
  782.     reset(source);
  783.     str(fontsize,siz);
  784.     writeln(sink,'save mark');
  785.     writeln(sink,'/m {moveto} def');
  786.     writeln(sink,'/s {show} def');
  787.     formatsused[pagetype]:=true;
  788.     fontsused[nfont]:=true;
  789.     fontsused[bfont]:=true;
  790.     writeln(sink,'/normalfont {/'+font[nfont]+' findfont '+siz+' '+ ' scalefont setfont} def');
  791.     writeln(sink,'/boldfont {/'+font[bfont]+' findfont '+siz+' '+ ' scalefont setfont} def');
  792.     writeln(sink,'/#copies ',numberofcopies,' def');
  793.     writeln(sink,'clippath pathbbox');
  794.     writeln(sink,'0.98 0.98 scale');
  795.     IF pagetype = 2 THEN writeln(sink,'612 0 translate 90 rotate');
  796.     writeln(sink,'/saveobj2 save def');
  797.     setfont(nfont);
  798.     page := 1;
  799.     linecount := 1;
  800.     linelength := linesize -rightmargin-leftmargin;
  801.     IF linelength <= 0
  802.       THEN BEGIN
  803.              clrscr;
  804.              writeln('ERROR...Illegal margin size');
  805.              halt;
  806.         END;
  807.     writeln;
  808.     REPEAT     {for every line in file}
  809.       IF linecount =1
  810.         THEN BEGIN
  811. gotoxy(1,entryline+2);
  812.                write('Page ',page,' ');              {status info to screen}
  813.                IF (header = 1) and (pagefeed=1)
  814.                   THEN  title;
  815.                IF (topspaces >0) and (pagefeed=1)
  816.                  THEN inserttoplines;
  817.              END;
  818.       readln(source,temp);                   {read in one line}
  819.       templine:=temp;
  820.       if temp='' then doaline else
  821.       while length(templine)>0 do 
  822.         BEGIN  {process piece of full line}
  823.       countlb(templine,leadingblanks);
  824.           if nfont in [3,6,9,12] then 
  825.       begin
  826.          len:=linesize-leftmargin-rightmargin;
  827.          temp:=left+copy(templine,1,len)+right;
  828.          templine:=copy(templine,len+1,length(templine));
  829.       end else begin
  830.          len:=linesize-trunc((leadingblanks+leftmargin+rightmargin)*spacewidth[nfont]);
  831.          temp:=left+spaces(leadingblanks)+
  832.               copy(templine,leadingblanks+1,len)+right;
  833.          templine:=copy(templine,leadingblanks+len+1,length(templine));
  834.       end;
  835.       doaline;
  836.         END;  {processing pieces of long line}
  837.     UNTIL eof(source);     {done all lines}
  838.             {final page feed to eject last page}
  839.     writeln(sink,' showpage');
  840.     writeln(sink,'saveobj2 restore');
  841.     writeln(sink,1/0.98,' ',1/0.98,' scale');
  842.     writeln(sink,'cleartomark restore');
  843.     IF automatic = 1      {restore margin values}
  844.       THEN BEGIN
  845.              leftmargin := lm;
  846.              left := spaces(leftmargin);
  847.              rightmargin := rm;
  848.              right := spaces(rightmargin);
  849.         END;
  850.     menu;
  851.   END;
  852.  
  853. PROCEDURE quit;       {restores default conditions on printer}
  854.   BEGIN
  855.     writeln(sink,'%%Trailer');
  856.     if formatsused[1] and formatsused[2] then
  857.        writeln(sink,'%%BoundingBox: 0 0 792 792') else
  858.     if pagetype = 1 then writeln(sink,'%%BoundingBox: 0 0 612 792')
  859.        else writeln(sink,'%%BoundingBox:0 0 792 612');
  860.     writeln(sink,'%%DocumentFonts:');
  861.     for n:=1 to 34 do if fontsused[n] then writeln(sink,'%%+ ',font[n]);
  862.     writeln(sink,'%%EOF');
  863.     writeln(sink,'%%EndDocument');
  864.     writeln(sink,chr(4));
  865.     close(sink);
  866.     lowvideo;
  867.     clrscr;
  868.     halt;
  869.   END;
  870.  
  871. PROCEDURE zeroize;
  872.   BEGIN
  873.     close(sink);
  874.     if nout=2 then assign(sink,'output.ps') else assign(sink,'lpt1');
  875.     rewrite(sink);
  876.   END;
  877.  
  878. PROCEDURE action;
  879.   BEGIN
  880.     CASE option OF
  881.       '0': begin setfontsize;setlinesize;end;
  882.       '1': setlinespacing;
  883.       '2': BEGIN
  884.              IF pagefeed = 1
  885.                THEN pagefeed := 2
  886.                ELSE pagefeed := 1;
  887.              gotoxy(36,6);
  888.              write(onoff[pagefeed],'      ');
  889.              optionline;
  890.            END;
  891.       '3': BEGIN
  892.              nfont := (nfont MOD 37 + 1) MOD 38;
  893.              setlinesize;
  894.              gotoxy(36,7);
  895.              write(font[nfont],'                   ');
  896.     gotoxy(36,4);
  897.    write(fontsize,'   (pitch = ',72/(fontsize*spacewidth[nfont]):5:1,')    ');
  898.              optionline;
  899.            END;
  900.       '4': BEGIN
  901.              bfont := (bfont MOD 37 + 1) MOD 38;
  902.              gotoxy(36,8);
  903.              write(font[bfont],'                   ');
  904.              optionline;
  905.            END;
  906.       '5': BEGIN
  907.              IF header=1
  908.                THEN header := 2
  909.                ELSE header := 1;
  910.              gotoxy(36,9);
  911.              write(onoff[header],'      ');
  912.              optionline;
  913.            END;
  914.       '6': BEGIN
  915.              IF nout=1
  916.                THEN nout := 2
  917.                ELSE nout := 1;
  918.              close(sink);
  919.          if nout=2 then assign(sink,'output.ps') else assign(sink,'lpt1');
  920.          rewrite(sink);
  921.              gotoxy(36,10);
  922.              write(output[nout],'                  ');
  923.              optionline;
  924.            END;
  925.       '7': settopmargin;
  926.       '8': setbottommargin;
  927.       '9': BEGIN
  928.              IF automatic=1
  929.                THEN automatic := 2
  930.                ELSE automatic := 1;
  931.              gotoxy(36,13);
  932.              write(onoff[automatic],'    ');
  933.              optionline;
  934.            END;
  935.       'L': setleftmargin;
  936.       'R': setrightmargin;
  937.       'F': get_file;
  938.       'G': IF filename <> ''
  939.              THEN printfile;
  940.       'Q': quit;
  941.       #27: quit;
  942.       'P': setpageformat;
  943.       'N': setnumberofcopies;
  944.       'Z': zeroize;
  945.     END;
  946. END;
  947.  
  948. BEGIN
  949.   init;
  950.   menu;
  951.   if autoexit and (filename<>'')then begin
  952.     printfile;
  953.     quit;
  954.     halt;
  955.   end;
  956.   REPEAT
  957.     gotoxy (35,entryline);
  958.     REPEAT
  959.       option := readkey;
  960. {! 8. USE TU^RBO3 unit for access to KBD, or instead USE CRT and ReadKey.}
  961.       option := upcase(option)
  962.     UNTIL option
  963.                IN ['0','1','2','3','4','5','6','g','G','q','Q','7','8','F',
  964.                     'R','L','9','P','N','Z',#27];
  965.     action;
  966.   UNTIL hellfreezesover = true;
  967. END.
  968.