home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / DLST12.ZIP / DLST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-23  |  4.8 KB  |  190 lines
  1. { DLST 1.1 - David L. Peterson, 220 9th St So. Waite Park, Mn 56387 }
  2. Uses Dos;
  3. type str255 = string[255];
  4. const
  5.   sptab : array[0..9] of string[8] =
  6.    (' ',' ','  ','   ','    ','     ','      ','       ','        ',' ');
  7. var
  8.   inf,outf     :  text;
  9.   inbuf,outbuf : array[1..10240] of char;
  10.   fnm,infname  :  string[60];
  11.   wln  :  string[255];
  12.   lnr  :  integer;
  13.   pgnr :  integer;
  14.   blanknr:integer;
  15.   colnr:  integer;
  16.  
  17.   r    :  real;          { following used in setting lines per page }
  18.   rss  :  string[5];
  19.   err  :  integer;
  20.   mxln :  integer;
  21.  
  22. {------------------------------------------}
  23. function intss(n,l:integer):str255;
  24. var ss : str255;
  25. begin
  26.   str(n:l, ss);
  27.   intss := ss;
  28. end;
  29.  
  30. {------------------------------------------}
  31. { readln version of getline
  32.    expands tabs, delete ff
  33.    note: readln interprets a single CR as an end of line
  34.          readln does not do anything special with a FF  }
  35. procedure getline;
  36. var i,j  : integer;
  37. begin
  38.   readln(inf,wln);
  39.  
  40.   i := pos(#12,wln);
  41.   while i <> 0 do begin
  42.      delete(wln, i, 1);
  43.      i := pos(#12,wln);
  44.   end;
  45.  
  46.   i := pos(#9,wln);
  47.   while i <> 0 do begin
  48.      j := 9 - (i mod 8);
  49.      delete(wln, i, 1);
  50.      insert(sptab[j], wln, i);
  51.      i := pos(#9,wln);
  52.   end;
  53. end;
  54.  
  55. {------------------------------------------}
  56. procedure prthdg;
  57. begin
  58.     writeln(outf,
  59.             #13#27'&dD',infname,      { CR, Underline, File Name }
  60.             #27'&a70C',               { Pos to col 70 }
  61.             'Page',intss(pgnr,4),     { Page number }
  62.             #27,'&d@');               { Underline off }
  63.     lnr := 2;
  64.     writeln('Printing Page ', pgnr);
  65. end;
  66.  
  67. {------------------------------------------}
  68. procedure endcol;
  69. begin
  70.   if colnr = 1 then begin
  71.              { Draw a rule between the two columns
  72.                 then position to line 0 }
  73.      write(outf,#27'*p1230x0Y'#27'*c3a3150b0P'#27'&a0R');
  74.              { Set font to internal 10 cpi font so we can set
  75.                  the left margin based on 1/10 in. }
  76.              { 0p    fixed spacing
  77.                10h   10 cpi
  78.                10u   symbol set
  79.                3t    Courier    }
  80.              { set left margin to 4.2 in., set to font id #1 }
  81.      write(outf,#27'(s0p10h10u3T'#27'&a42L');
  82.      write(outf,#27'(1X');
  83.      colnr := 2;
  84.      lnr := 1;
  85.   end
  86.   else begin
  87.           { output a FF
  88.              set to 10cpi font, set left margin to .4 in.
  89.              set font id # 1, pos to line 0 }
  90.      write(outf,#12);
  91.      write(outf,#27'(s0p10h10u3T'#27'&a4L');
  92.      write(outf,#27'(1X'#27'&a0R');
  93.      colnr := 1;
  94.      pgnr := pgnr + 1;
  95.      prthdg;
  96.   end;
  97. end;
  98.  
  99. {------------------------------------------}
  100. procedure putline;
  101. var wlen : integer;
  102. begin
  103.  
  104.   wlen := length(wln);
  105.   if wlen > 90 then lnr := lnr + 2
  106.   else              lnr := lnr + 1;
  107.  
  108.   if lnr >= mxln then
  109.     endcol;
  110.  
  111.   if wlen > 90 then begin
  112.     writeln(outf,#13#10,copy(wln,1,90));
  113.     write  (outf,'    ....',copy(wln,91,80));
  114.   end
  115.   else
  116.     write(outf,#13#10,wln);
  117. end;
  118.  
  119. {------------------------------------------}
  120. begin
  121.   writeln('DLST 1.1');
  122.   pgnr := 1;
  123.   colnr := 1;
  124.  
  125.   if paramcount < 2 then begin
  126.      writeln('Usage:  dlst <infile> <outfile> [# lines]');
  127.      halt;
  128.   end;
  129.  
  130.   { --- get lines per page & calc x/48 spacing --- }
  131.   { ---   default to 168 & 3.0/48 in. spacing  --- }
  132.   err := 1;
  133.   if paramcount > 2 then
  134.      val (paramstr(3), mxln, err);
  135.   if err <> 0 then mxln := 168;
  136.   r := trunc(5040/mxln)/10;         { 504 is 10.5 in times 48 }
  137.   str(r:3:1,rss);
  138.  
  139.   fnm := paramstr(1);
  140.   assign(inf,fnm);
  141.   SetTextBuf(inf,inbuf);
  142.   {$I-} reset(inf); {$I+}
  143.   if ioresult <> 0 then begin
  144.     writeln(fnm, ' not found');
  145.     halt;
  146.   end;
  147.   infname := fnm;
  148.  
  149.   fnm := paramstr(2);
  150.   assign(outf,fnm);
  151.   SetTextBuf(outf,outbuf);
  152.   {$I-} rewrite(outf); {$I+}
  153.   if ioresult <> 0 then begin
  154.     writeln(fnm, ' cannot open');
  155.     halt;
  156.   end;
  157.  
  158.   { ---------- Send Esc Seqs to Printer ------------ }
  159.   write(outf,#27'E',                 { reset }
  160.              #27'&l8d2e84f6d',       { set top & bottom margin to give
  161.                                        10.5 in of printable area }
  162.              #27'(s0p10h10u3T'#27'&a4L',{ set to 10 cpi font,
  163.                                         set left margin .4 in }
  164.              #27'(1X',               { set to font id # 1 }
  165.              #27'&l',rss,'C',        { set line spacing to rss/48 in. }
  166.              #27'&a0R');             { position to line 0 }
  167.  
  168.   prthdg;
  169.  
  170.   { ---- Read & Print File ---- }
  171.   blanknr := 0;
  172.   while not eof(inf) do begin
  173.     getline;
  174.     if length(wln) = 0 then
  175.       blanknr := blanknr + 1
  176.     else
  177.       blanknr := 0;
  178.     if blanknr < 3 then
  179.       putline;
  180.   end;
  181.  
  182.   if lnr > 1 then
  183.     write(outf,#12);    { output FF }
  184.  
  185.   write(outf,#27'E');    { output Reset }
  186.  
  187.   close(inf);
  188.   close(outf);
  189. end.
  190.