🚀 go-pugleaf

This is a really simple, but useful printing utility I wrote last summer,
and find myself using so much that I thought I'd send it out to anybody
interested. In its current form it is only useful on an HP Laserjet printer.
It prints in compressed type, with a wide enough margin to hole punch,
and writes the file na, version number (optional) and the page number
at the top of each page. It should be easy to adapt to another printer
by changing the printer codes, etc.

Cheers!

J.A. MacDonald
Geosense Consulting
Reno, NV
jay-m@equinox.unr.edu

============================================================================
Program FPrint;
 
{******************************************************************************
 
  Fine print a text file with a label at the top of each page showing
file name along with the page number. Set up for LaserJet 3 to use
compressed print on letter sized paper with a margin of ten characters on
left side.
 
Programing History:
 
Ver    Date        Comments
~~~    ~~~~        ~~~~~~~~
0.00   07-10-92    Original code (J.A. MacDonald)
 
******************************************************************************}
 
Uses
  Crt, Dos, Printer;
 
Const
  ver = '0.00';
 
  ffeed = Chr(12);
 
  esc   = Chr(27);
 
  res = esc + 'E';
 
  mar10 = esc + '&a10L';
 
  letcompo =  esc + '&l2A' + esc + '&l0O' + esc + '&l6C' + esc + '(s16.66H';
 
Var
  page    : array [1..70] of string;
 
  on_page,
  on_line,
  i,j,k,l : integer;
 
  ifil    : text;
 
  f_ver,
  ifname  : string;
 
  dir     : DirStr;
  rootn   : NameStr;
  ext     : ExtStr;
 
Procedure Get_Info;
begin
  Writeln;
  Writeln ('FPrint ver ', ver, ' : Fine print a file to HP Laserjet.');
  Writeln;
  if ParamCount < 1 then begin
    Write ('Enter file name : ');
    Readln (ifname);
    Write ('Enter version number for page label (enter for none) : ');
    Readln (f_ver);
    Writeln;
  end
  else begin
    ifname := ParamStr(1);
    f_ver := ParamStr(2);
  end;
  if NOT (f_ver = '') then
    f_ver := ' v.' + f_ver;
  ifname := FExpand(ifname);
  FSplit (ifname, dir, rootn, ext);
  Assign (ifil, ifname);
  {$I-}
  Reset (ifil);
  {$I+}
  if IOResult <> 0 then begin
    Writeln;
    Writeln ('Error opening ', ifname, '.');
    Writeln;
    Halt;
  end;
end;
 
Procedure Print_File;
var
  on_pg,
  p_label : string;
 
begin
  Write ('Printing ', ifname, '...   sending page: ');
  on_page := 0;
  Writeln (lst, ffeed, letcompo, mar10);
  repeat
    inc(on_page);
    GotoXY (30 + Length(ifname), WhereY);
    Write (on_page);
    on_line := 0;
    repeat
      inc(on_line);
      Readln (ifil, page[on_line])
    until (on_line = 70) OR (EOF(ifil));
    Str (on_page, on_pg);
    p_label := rootn + ext + f_ver + '     Pg ' + on_pg;
    Writeln (lst, p_label:120);
    for i := 1 to 3 do
      Writeln (lst);
    for i := 1 to on_line do
      Writeln (lst, page[i]);
    Writeln (lst, ffeed);
  until EOF(ifil);
  Close (ifil);
  Writeln (lst, ffeed, res);
  Writeln;
  Writeln;
end;
 
Begin
  Get_Info;
  Print_File;
End.