home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / txtutl / pgprint.lbr / PPG.PZS / PPG.PAS
Pascal/Delphi Source File  |  1988-05-09  |  4KB  |  148 lines
  1. program PPG2;
  2.  
  3. {PagePrinterII text pagination program (c) 1988 by Sam Bellotto Jr.}
  4.  
  5. { ------------------------- Printer Control Codes --------------------------- }
  6.  
  7. const PEDoff    =#27#56;                         {disable paper end detector}
  8.       LeftMar1  =#27#108#1;                      {set left margin at 1}
  9.       LeftMar10 =#27#108#10;                     {set left margin at 10}
  10.       Elite     =#27#77;                         {set printer to 12 cpi mode}
  11.       ClrLst    =#27#64;                         {reset printer}
  12.  
  13. { ------------------------- for Epson compatibles --------------------------- }
  14.  
  15. type texst      =string[80];
  16.  
  17. var page,lines  :integer;
  18.     letter,rev  :char;
  19.     tag         :string[60];
  20.     fname       :string[14];
  21.     fmt         :string[3];
  22.     filvar      :text;
  23.     prompt      :string[30] absolute $80;        {mem addr of comline suffix}
  24.  
  25. procedure SyntaxError;
  26. begin
  27.    writeln;
  28.    writeln(^G,'++ Syntax Error ++');             {^G is bell}
  29.    writeln;
  30.    writeln('PPG2 d:FILENAME.EXT');
  31.    halt
  32.    end;
  33.  
  34. procedure OpenFile;
  35. begin
  36.    if length(prompt)=0 then SyntaxError
  37.    else begin
  38.       fname:=copy(prompt,2,length(prompt)-1);
  39.       assign(filvar,fname);
  40.       {$I-} reset(filvar); {$I+}
  41.       if ioresult<>0 then
  42.       begin
  43.          writeln;
  44.          writeln(^G,'++ File Does Not Exist ++');
  45.          halt
  46.          end
  47.       end;
  48.    if copy(fname,2,1)=':' then delete(fname,1,2)
  49.    end;
  50.  
  51. procedure Display(mess:texst);
  52. begin
  53.    delline;
  54.    write(mess)
  55.    end;
  56.  
  57. procedure SignOn;
  58. begin
  59.    page:=1;lines:=0;
  60.    writeln('PagePrinterII   version 1.0');
  61.    writeln('(c)1988 by Sam Bellotto Jr.');
  62.    writeln('---------------------------');
  63.    writeln;
  64.    Display('        Heading? ');
  65.    read(tag);
  66.    Display('  Starting page? ');
  67.    read(page);
  68.    Display('Reverse margins? ');
  69.    read(kbd,rev);
  70.    Display('  Starting line? ');
  71.    read(lines);
  72.    Display('    printing ... ');
  73.    write(lst,PEDoff,Elite);
  74.    if lines>0 then lines:=lines+3
  75.    end;
  76.  
  77. procedure DoPage;
  78. var title:string[80];
  79. var st:string[3];
  80. begin
  81.    str(page,st);
  82.    if fmt='evn' then begin
  83.       title:=concat('Page ',st,'/ ',fname,'   ',tag);
  84.       write(lst,LeftMar1);
  85.       write(lst,title)
  86.    end else begin
  87.       title:=concat(fname,'   ',tag,'/ ','Page ',st);
  88.       write(lst,LeftMar10);
  89.       write(lst,title:79)
  90.       end;
  91.    writeln(lst);writeln(lst)
  92.    end;
  93.  
  94. procedure SetUpPage;
  95. begin
  96.    fmt:='odd';
  97.    if upcase(rev)='Y' then begin
  98.       if lines>0 then fmt:='evn'
  99.       else if odd(page) then fmt:='evn'
  100.    end else begin
  101.       if not odd(page) then fmt:='evn'
  102.       end;
  103.    DoPage 
  104.    end;
  105.  
  106. procedure PrintOnePage;
  107. begin
  108.    repeat
  109.       read(filvar,letter);
  110.       write(lst,letter);
  111.       if letter=chr(13) then lines:=lines+1      {0DH is CR or EOL}
  112.       until (lines=50) or (eof(filvar));
  113.    if not eof(filvar) then write(lst,#12)        {form feed}
  114.    end;
  115.  
  116. procedure Wait;
  117. Begin
  118.    page:=page+1;lines:=0;
  119.    delline;
  120.    Write(^G,'Ready to print page ',page,'? ');
  121.    repeat
  122.       delay(100)
  123.       until keypressed;
  124.    Display('    printing ... ')
  125.    end;
  126.  
  127. procedure SignOff;
  128. begin
  129.    close(filvar);
  130.    writeln(lst,#10,ClrLst);                      {line feed}
  131.    write(^G);
  132.    Display('++ COMPLETED ++');
  133.    writeln;
  134.    writeln('++ ON PAGE ',page);
  135.    writeln('++ ON LINE ',lines)
  136.    end;
  137.  
  138. begin                                            {main}
  139.    OpenFile;
  140.    SignOn;
  141.    while not eof(filvar) do begin
  142.       SetUpPage;
  143.       PrintOnePage;
  144.       if not eof(filvar) then Wait
  145.       end;
  146.    SignOff
  147.    end.                                          {of PagePrinterII}
  148.