Program PKtoSFP;

uses OpCrt,
     Clock,
     Files,
     MoreDos,
     MoreSys,
     Strings,
     OpString,
     Tp_Msgs,
     Sps_Cpyr,
     PkDcl,
     TexDcl,
     TfmDcl;

const
  Vers          = '0.2';
  BannerStr     = 'This is PKbbox vers '+Vers;
  ProgName      = 'PKbbox';

var
  DesignSize  : Real;
  DesignRatio : Real;

type
  CharRec = Record
              CC              : Byte;
              llx,lly,urx,ury : Integer;
            end;

var
  RC          : Integer;
  PkFont      : PkFontObj;
  PkChar      : PkCharObj;
  PkFn        : FileSpecStr;
  AfmFn       : FileSpecStr;
  Count       : Word;
  WorkReal    : Real;
  WorkString  : String;
  Chars       : Array[0..255] of CharRec;
  T           : Text;
  StdErr      : Text;
  Line,s      : String;
  I,err       : Integer;

  lc_Width    : Real;
  lc_Count    : Word;

  MaxDescender: LongInt;
  MaxAscender : LongInt;

  CharName    : String[12];
  HorizDpi    : Integer;
  VertDpi     : Integer;
  ScaleAdj    : Real;
  RemapSuccess: Boolean;
  Multiplier  : Real;
  llx,lly,urx,ury : Integer;

begin
  AssignCrt(StdErr);
  Rewrite(StdErr);

  Assign(Output,'');
  Rewrite(Output);

  If ParamCount < 2 then
    begin
      Writeln(StdErr,'Usage: PKBBOX pkfile afmfile > newafmfile');
      Halt(0);
    end;

  Writeln(StdErr,BannerStr);

  PkFn := ParamStr(1);
  AfmFn := ParamStr(2);

  PkFont.Init;
  PkFont.OpenPkFile(RC,PkFn);
  If RC <> 0 then
    begin
      Write(StdErr,ProgName,': cannot read PK file: ');
      If RC > 0 then
        Write(StdErr,TpErrMsg(RC))
      Else
        Write(StdErr,PkErrMsg(RC));
      Halt(1);
    end;

  DesignSize  := 1.0*PkFont.DesignSize/1048576.0;
  DesignRatio := 300.0/72.27*DesignSize;

  HorizDpi := Round(1.0*PkFont.Hppp/65536.0*72.27);
  VertDpi  := Round(1.0*PkFont.Vppp/65536.0*72.27);
  ScaleAdj := 1.0*HorizDpi/300.0;

  Multiplier := 1000.0 / DesignRatio;

  FillChar(Chars,SizeOf(Chars),$00);

  MaxAscender  := 0;
  MaxDescender := 0;
  lc_Width := 0.0;
  lc_Count := 0;
  PkChar.Init;
  PkChar.ReadPkChar(RC,PkFont);
  While RC = 0 do
    begin
      CharName := Pad(TexChar(Char(PkChar.CharacterCode)),6);

      MaxAscender  := Max(MaxAscender,PkChar.VOff);
      MaxDescender := Max(MaxDescender,PkChar.Height-PkChar.VOff);

      llx := 0;
      lly := Trunc((PkChar.Voff-PkChar.Height)*Multiplier);
      urx := Trunc(PkChar.Width*Multiplier);
      ury := Trunc(PkChar.Height*Multiplier) + lly;

      Chars[PkChar.CharacterCode].llx := llx;
      Chars[PkChar.CharacterCode].lly := lly;
      Chars[PkChar.CharacterCode].urx := urx;
      Chars[PkChar.CharacterCode].ury := ury;

      PkChar.Done;
      PkChar.Init;
      PkChar.ReadPkChar(RC,PkFont);
    end;

  If RC <> Err_PkNoMore then
    begin
      Write(StdErr,ProgName,': Error scanning PK file: ');
      If RC > 0 then
        Write(StdErr,TpErrMsg(RC))
      Else
        Write(StdErr,PkErrMsg(RC));
      Halt(1);
    end;

  PkFont.Done;

  Assign(T,ParamStr(2));
  {$I-} Reset(T); {$I+}
  RC := IoResult;

  If RC <> 0 then
    begin
      Write(StdErr,ProgName,': cannot read AFM file: ',TpErrMsg(RC));
      Halt(1);
    end;

  While Not Eof(T) do
    begin
      Readln(T,Line);
      S := WordN(Line,2,' ');
      Val(S,I,err);
      If (WordN(Line,1,' ') = 'C') and (err = 0) and (I >= -1) and (I <= 255) then
        begin
          If I = -1 then
            Writeln(Line,' B 0 0 0 0 ;')
          Else
            Writeln(Line,' B ',Chars[I].llx,' ',Chars[I].lly,' ',Chars[I].urx,' ',Chars[I].ury,' ;');
        end
      Else
        Writeln(Line);
    end;

  Close(T);

  Writeln('Done.');
end.