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