Program IBM2HPj;
{program to translate graphics output intended for an IBM Graphics Printer}
{  so it can be sent to HP Laserjet printer}

{written by Sally Sheridan & Mark Lewis, June, 1986}
var
  InFileName : string [20];
  InFile : File of byte;
  SaveBuff : String[120];
  nullstr : String[120];
  savebufx : array [0..120] of byte absolute savebuff;
  Saveflg : Boolean;
  Out : text;
  InBuff : byte;
  EndFile : boolean;
  keep : boolean;
  Dens : integer;
  pix  : Integer;
  pixflg,cflag : Boolean;
  Scans,j : Integer;

Procedure ResetHP(xray:boolean);
var ist : string[3];
begin
   Write(out,^['E'); {ESC E  flushes buffer and resets to defaults}
   if xray then
   begin
    str(dens,ist);
    write(out,^['*t'+ist+'R');
    scans:=0;
    pix:=pix+1;
    pixflg:=true;
   end;
end;

Procedure InitFiles;
var parambuf  : string[16];
    parampt,j : Integer;
  begin
     keep:=false;  {set defaults}
     dens:=100;
     cflag:=false;
     If paramCount>0 then
     begin
       for parampt := 1 to paramcount do
       begin
          parambuf:=paramstr(parampt);
          if (parambuf[1]='-') then
          begin
           for j:=2 to length(parambuf) do
           begin
             if ((parambuf[j]='k') or (parambuf[j]='K')) then keep:=true;
             if (parambuf[j]='1') then dens:=75;
             if (parambuf[j]='2') then dens:=100;
             if (parambuf[j]='3') then dens:=150;
             if (parambuf[j]='4') then dens:=300;
             if ( (parambuf[j]='c') or (parambuf[j]='C')) then cflag:=true;
           end;
          end else Infilename:=parambuf;
        end;
        Assign(InFile,InfileName);
        {$I-}
        Reset(InFile);
        {$I+}
        if (IOresult <> 0) then
        begin
           Writeln('Unable to open ',infilename);
           halt;
        end;
        if cflag then Assign(Out,'AUX:')
        else assign(Out,'LST:');
        reset(out);
        EndFile:=False;
        if not dens in [75, 100, 150,300] then dens := 75;
        resethp(true);
     end else
     begin
        writeln;
        Writeln('IBM2HPJ: Print IBM Graphics Printer File on HP Laserjet');
        writeln('   by Sally Sheridan and Mark Lewis');
        writeln('   Version 1.01  June, 1986');
        Writeln;
        writeln('usage:IBM2HPJ [-k1234] filename');
        writeln('      -k     Keep the file (default is to delete when done');
        writeln('      -1     Use 75 DPI density');
        writeln('      -2     Use 100 DPI density (Default)');
        writeln('      -3     Use 150 DPI density');
        writeln('      -4     Use 300 DPI density');
        writeln('      -c     Output to COM1 (default is PRN)');
        writeln;
        halt;
     end;
  end;

Procedure GrafMod480;  {have read in ESC K}
  VAR
    OutBuff : Array [1..8] of string[120];
    outbufx : array [1..8,0..120] of byte absolute outbuff;
    Maxoutbyte : Byte;
    MAxInByte : integer;
    BytePtr, LinePtr : Integer;
    N1, N2 : Integer;
    ist : String[3];
    Temp : Byte;

Procedure Scanout;
var j : Integer;
begin
    OutBufx[Lineptr][0]:=MaxOutByte;
    if (scans mod 6 <> 0) then
    begin
        If saveflg then
        begin
           for j:=1 to length(savebuff) do
             outbufx[lineptr][j]:=outbufx[lineptr][j] or savebufx[j];
           if length(savebuff) > length(outbuff[lineptr]) then
             Outbufx[Lineptr][0]:=length(savebuff);
           saveflg:=false;
           savebuff:='';
        end;
        Str(maxoutbyte,ist);
        Write(out,^['*b'+ist+'W'); {ESC*b # W transfer a line}
        Write(out,OutBuff[LinePtr]);
     end else
     begin
         savebuff := outbuff[lineptr];
         saveflg := true;
     end;
end;


  begin
  { compute number of bytes to read in and write out}
    Read(InFile,InBuff);
    N1:=InBuff;
    Read(InFile,InBuff);
    N2:=InBuff;
    MaxInByte:= n1 + (256*N2);

  { clear OutBuff array}
    MaxOutByte:= MaxInByte div 8;
    if (Maxinbyte mod 8)<>0 then maxoutbyte:=Maxoutbyte +1;
    for n1 := 1 to 8 do
        Outbuff[n1]:=nullstr;
    BytePtr := 1;

  { fill OutBuff array }
    N2:=0;
    FOR N1 := 1 to MaxInByte DO
      Begin
        Read(InFile,InBuff);
        For LinePtr := 8 downto 1 do
          begin
            Temp:=OutBufx[LinePtr][BytePtr];
            Temp:= Temp shl 1;
            If odd(InBuff) Then
              Temp:=Temp+1;
            OutBufx[LinePtr][BytePtr]:= Temp;
            InBuff:= InBuff shr 1;
          end;
        N2:=N2+1;
        If (N2=8) then
          Begin
            BytePtr:= BytePtr +1;
            N2:=0;
          End;
      End;
    { Case of incomplete output byte}
    If n2 <> 0 then
    begin
      n2:=8 - n2;
      for lineptr := 1 to 8 do
      begin
         Temp:=outbufx[lineptr][byteptr];
         temp := temp shl n2;
         outbufx[lineptr][byteptr]:=temp;
      end;
    end;
    { write OutBuff lines }
{$U+}
    write(out,^['&a5C');
    write(out,^['*r1A');
    for LinePtr := 1 to 8 do
      begin
        scans:=scans+1;
        scanout;
      end;
    write(out,^['*rB'); {ESC*rB end raster graphics}
{$U-}
  end; {proc GrafMod480}


Procedure Parse;
begin
   case inbuff of
   12 : begin {FF}
         resethp(true);
        end;
   26: begin {^Z EOF}
         endfile:=true;
       end;
   27 : Begin
         Read(InFile,InBuff);
         If (InBuff=75) Then
         begin
            If pixflg then
            begin
              writeln('Printing picture ',pix);
              pixflg:=false;
            end;
            GrafMod480;
         end;
        end;
   end;
END; {parse proc}

Begin
  pix:=0;
  saveflg:=false;
  savebuff:='';
  nullstr:='';
  for j:=1 to 120 do nullstr:=Nullstr + char(0);
  InitFiles;
  repeat
    Read(InFile,InBuff);
    Parse;
  until Endfile;
  resethp(false);
  Close(Infile);
  if not keep then erase(infile);
  close(out);
End.