Program  make_toolbox_include_file;

(* Mit Hilfe dieses Programms, wird anhand des Listing-Files vom Assembler
   (Macro-80), welches die Endung .PRN besitzt, eine INCLUDE-Datei erzeugt,
   die sie in Ihren Pascal-Programmen einf}gen k|nnen                       *)

Type   Strng136 = String(.136.);
       Strng12  = String(. 12.);
       Strng5   = String(.  5.);

Var    PRN_file, INCLUDE_file : Text;
       Module_ok              : Array (.1..5.) of Boolean;
       z_in, z_out            : Strng136;
       s_adr, datum           : Strng5;
       s_code                 : Strng12;
       pc, adr, i, j          : Integer;

Function  Adresse (st : Strng5) : Integer;
Var       num, err : Integer;
Begin
  err := 1;
  If (Length(st) >= 4) or (st(.1.) <> ' ')
   then  Val(Concat('$', Copy(st, 1, 4)), num, err);
  If err = 0
   then  Adresse := num   else  Adresse := -1
End;

Procedure  Read_Datum (Var st : Strng12; Var datum : Strng5);
Begin
  datum := '';
  If st(.1.) <> ' '
   then If (Length(st) >= 5) and (st(.5.) = Chr(39))
         then Begin  datum := Copy(st, 1, 5);  st := ''  End
         else If (Length(st) >=4) and (st(.3.) <> ' ')
               then Begin  datum := Copy(st, 1, 4);  st := ''  End
               else Begin  datum := Copy(st, 1, 2);
                           st    := Copy(st, 4, 9)
                    End
End;

Procedure  Test_Output;
Begin
  If Length(z_out) > 90
   then Begin  Writeln(INCLUDE_file, z_out);  z_out := '         '  End
End;

Procedure  INLINE_Byte (Var pc : Integer; code : Strng5);
Begin
  z_out := z_out + '   $' + code + '/';  pc := Succ(pc);  Test_Output
End;

Procedure  INLINE_Integer (Var pc : Integer; code : Strng5);
Begin
  If (code(.1.) > '0') or (code(.2.) > '0')
   then z_out := z_out + ' $' + Copy(code, 1, 4) + '/'
   else z_out := z_out + ' $' + Copy(code, 3, 2) + '/0/';
  pc := Succ(succ(pc));
  Test_Output
End;

Procedure  INLINE_Adresse (Var pc : Integer; code : Strng5);
Var        off : Integer;
Begin
  off := Adresse(code) - pc;  Str(Abs(off):4, code);
  If off < 0
   then  z_out := z_out + '*-' + code + '/'
   else  z_out := z_out + '*+' + code + '/';
  pc := Succ(Succ(pc));
  Test_Output
End;

Begin
  Assign(PRN_file, 'B:HRGTOOL.PRN'); Reset(PRN_file);
  Assign(INCLUDE_file, 'A:HRG/TOOL.800'); Rewrite(INCLUDE_file);

  (* Include-Datei initialisieren : *)
  Writeln(INCLUDE_file, '(*************************************************************************)');
  Writeln(INCLUDE_file, '(***                                                                   ***)');
  Writeln(INCLUDE_file, '(***   INCLUDE-Datei zum Einbinden des HRG/Tools in Pascal-Programme   ***)');
  Writeln(INCLUDE_file, '(***                                                                   ***)');
  Writeln(INCLUDE_file, '(*************************************************************************)');
  Writeln(INCLUDE_file);
  Writeln(INCLUDE_file);
  Writeln(INCLUDE_file, 'Procedure  HRG_INCLUDE_INLINE;');
  Writeln(INCLUDE_file, 'Begin');
  z_out := '  Inline(';
  pc := 0;  i := 0;

  Repeat  Readln(PRN_file, z_in);
          s_adr  := Copy(z_in,  3,  5);  adr := Adresse(s_adr);
          s_code := Copy(z_in, 11, 12);

          If Copy(s_code, 1, 2) = 'C3'
           then Begin  i := Succ(i);
                       Case i of 1 : Module_ok(.1.) := (z_in(.1.) = ' ');
                                 7 : Module_ok(.2.) := (z_in(.1.) = ' ');
                                 9 : Module_ok(.3.) := (z_in(.1.) = ' ');
                                10 : Module_ok(.4.) := (z_in(.1.) = ' ');
                                13 : Module_ok(.5.) := (z_in(.1.) = ' ')
                        End;
                       INLINE_Byte(pc, 'C3');
                       INLINE_Adresse(pc, Copy(s_code, 4, 5))
                End
  Until i = 13;

  While not eof(PRN_file) and Module_ok(.1.) do
   Begin
          Readln(PRN_file, z_in);
          s_adr  := Copy(z_in,  3,  5);  adr := Adresse(s_adr);
          s_code := Copy(z_in, 11, 12);

          If (adr > -1) and (s_adr(.5.) = Chr(39))
           then Begin  Module_ok(.1.) := (z_in(.1.) = ' ');
                       While pc < adr do INLINE_Byte(pc, '00');
                       If (s_code(.1.) <> ' ') and (pc = adr)
                        then  Repeat  Read_Datum(s_code, datum);
                                      Case Length(datum) of
                                         0 : ;
                                         2 : INLINE_Byte(pc, datum);
                                         4 : INLINE_Integer(pc, datum);
                                         5 : INLINE_Adresse(pc, datum)
                                        else Writeln('*** FEHLER ***')
                                       End (* of Case *)
                              Until Length(datum) = 0
                        else If pc <> adr
                              then  Writeln('***  Fehler aufgetreten !  ***')
                End
   End;

   Writeln(INCLUDE_file, z_out, '   $C9 );');  Writeln(INCLUDE_file, 'End;');
   Writeln(INCLUDE_file);
   Writeln(INCLUDE_file, 'Procedure  GrfIni                                        ; external $E005;');
   Writeln(INCLUDE_file, 'Procedure  Clear  ( Palette : Byte                      ); external $E00D;');
   Writeln(INCLUDE_file, 'Procedure  Pal    ( Palette, FarbCode : Byte            ); external $E015;');
   Writeln(INCLUDE_file, 'Procedure  SetPkt ( x, y : Integer; Palette : Byte      ); external $E01D;');
   Writeln(INCLUDE_file, 'Function   Point  ( x, y : Integer               ) : Byte; external $E025;');
   Writeln(INCLUDE_file, 'Procedure  Line   ( x1, y1, x2, y2 : Integer; pal : Byte); external $E02D;');
   If Module_ok(.2.)
    then Begin  Writeln(INCLUDE_file, 'Procedure  Box    ( x1, y2, x2, y2 : Integer; pal : Byte); external $E035;');
                Writeln(INCLUDE_file, 'Procedure  FillBox( x1, y1, x2, y2 : Integer; pal : Byte); external $E03D;')
         End;
   If Module_ok(.3.)
    then  Writeln(INCLUDE_file, 'Procedure  ScrLst                                        ; external $E045;');
   If Module_ok(.4.)
    then Begin  Writeln(INCLUDE_file, 'Procedure  SaveHRG   ( Drive, Kennung : Byte            ); external $E04D;');
                Writeln(INCLUDE_file, 'Procedure  LoadHRG   ( Drive, Kennung : Byte            ); external $E055;');
                Writeln(INCLUDE_file, 'Procedure  DeleteHRG ( Drive, Kennung : Byte            ); external $E05D;')
         End;
   If Module_ok(.5.)
    then  Writeln(INCLUDE_file, 'Function   Joy                                     : Byte; external $E065;');
   Writeln(INCLUDE_file);
   Writeln(INCLUDE_file, 'Procedure  HRG_Tool_Init;');
   Writeln(INCLUDE_file, '  Const    Z80_jp : Byte = $C3;');
   Writeln(INCLUDE_file, '  Var      adr    : Integer;');
   Writeln(INCLUDE_file, '  Begin');
   Writeln(INCLUDE_file, '    adr := Addr(HRG_INCLUDE_INLINE);');
   Writeln(INCLUDE_file, '    Mem(.$E005.) := Z80_jp;  Mem(.$E006.) := Lo(adr   );  Mem(.$E007.) := Hi(adr   );');
   Writeln(INCLUDE_file, '    Mem(.$E00D.) := Z80_jp;  Mem(.$E00E.) := Lo(adr+ 3);  Mem(.$E00F.) := Hi(adr+ 3);');
   Writeln(INCLUDE_file, '    Mem(.$E015.) := Z80_jp;  Mem(.$E016.) := Lo(adr+ 6);  Mem(.$E017.) := Hi(adr+ 6);');
   Writeln(INCLUDE_file, '    Mem(.$E01D.) := Z80_jp;  Mem(.$E01E.) := Lo(adr+ 9);  Mem(.$E01F.) := Hi(adr+ 9);');
   Writeln(INCLUDE_file, '    Mem(.$E025.) := Z80_jp;  Mem(.$E026.) := Lo(adr+12);  Mem(.$E027.) := Hi(adr+12);');
   Writeln(INCLUDE_file, '    Mem(.$E02D.) := Z80_jp;  Mem(.$E02E.) := Lo(adr+15);  Mem(.$E02F.) := Hi(adr+15);');
   Writeln(INCLUDE_file, '    Mem(.$E035.) := Z80_jp;  Mem(.$E036.) := Lo(adr+18);  Mem(.$E037.) := Hi(adr+18);');
   Writeln(INCLUDE_file, '    Mem(.$E03D.) := Z80_jp;  Mem(.$E03E.) := Lo(adr+21);  Mem(.$E03F.) := Hi(adr+21);');
   Writeln(INCLUDE_file, '    Mem(.$E045.) := Z80_jp;  Mem(.$E046.) := Lo(adr+24);  Mem(.$E047.) := Hi(adr+24);');
   Writeln(INCLUDE_file, '    Mem(.$E04D.) := Z80_jp;  Mem(.$E04E.) := Lo(adr+27);  Mem(.$E04F.) := Hi(adr+27);');
   Writeln(INCLUDE_file, '    Mem(.$E055.) := Z80_jp;  Mem(.$E056.) := Lo(adr+30);  Mem(.$E057.) := Hi(adr+30);');
   Writeln(INCLUDE_file, '    Mem(.$E05D.) := Z80_jp;  Mem(.$E05E.) := Lo(adr+33);  Mem(.$E05F.) := Hi(adr+33);');
   Writeln(INCLUDE_file, '    Mem(.$E065.) := Z80_jp;  Mem(.$E066.) := Lo(adr+36);  Mem(.$E067.) := Hi(adr+36);');
   Writeln(INCLUDE_file, '    GrfIni');
   Writeln(INCLUDE_file, '  End;');
   Writeln(INCLUDE_file);
   Close(PRN_file);  Close(INCLUDE_file);
   If not Module_ok(.1.)
    then Begin Writeln('Schwerwiegender Fehler aufgetreten !');
               Writeln('HRG/TOOL.800 wurde nicht erzeugt');
               Erase(INCLUDE_file)
         End
End.
