with Kernel;            use Kernel;
with Interfaces.C;      use Interfaces.C;
with System;            use System;
with Ada.Strings.Fixed;

with RASCAL.OS;         use RASCAL.OS;
with RASCAL.Utility;    use RASCAL.Utility;
with RASCAL.Memory;     use RASCAL.Memory;



package body RASCAL.Template is

   Wimp_OpenTemplate   : constant := 16#400D9#;
   Wimp_LoadTemplate   : constant := 16#400DB#;
   Wimp_CloseTemplate  : constant := 16#400DA#;
   Wimp_CreateIcon     : constant := 16#400C2#;
   Wimp_CreateWindow   : constant := 16#400C1#;

   -- Pointer fuer Speicher auf indirected icons bei LoadTemplate (wird immer
   -- mitgefuehrt bei LoadTemplate)
   currentptr : int;
   -- Pointer fuer Speicher auf indirected icons
   indirecticonmemory : int;
   -- Groesse dieses Speicherbereichs in Bytes
   indirecticonssize  : int;
   -- Pointer fuer Template-Buffer-Speicherbereich
   templatebuffer : Address;

   --
   
   procedure Open (Filename : in String) is

      Filename_0 : String := Filename & ASCII.NUL;
 
      Register : aliased Kernel.swi_regs;
      Error    : Kernel.oserror_access;

      tplbuffersize  : Integer := 0;
      indbuffersize  : Integer := 0;
      searchposition : Integer := 0;
      dummyfilename  : String(1..12) :="*" & 11 * ASCII.NUL;
   begin
      Register.R(1) := Adr_To_Int(Filename_0'Address);
      Error := Kernel.swi (Wimp_OpenTemplate, register'Access, register'Access);

      if Error /= null then
         pragma Debug(Report("Templates.Open1: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;

      -- now, iterate through all templates and add buffers
      loop
        Register.R(1) := 0;
        Register.R(5) := Adr_To_Int(dummyfilename'Address);
        Register.R(6) := int(searchposition);
        Error := Kernel.SWI (Wimp_LoadTemplate, register'Access, register'Access);

        if Error /= null then
           pragma Debug(Report("Templates.Open2: " & To_Ada(Error.ErrMess)));
           OS.Raise_Error(Error);
        end if;

        searchposition := Integer(Register.R(6));
        if Integer(Register.R(1)) > tplbuffersize then
           tplbuffersize := Integer(Register.R(1));
        end if;
        indbuffersize := indbuffersize + Integer(Register.R(2));
        exit when searchposition = 0;
      end loop;

      templatebuffer     := AllocateFixed(tplbuffersize+2000);
      indbuffersize      := indbuffersize + 2000;
      indirecticonssize  := int(indbuffersize);
      indirecticonmemory := Adr_To_Int(AllocateFixed(indbuffersize));
      currentptr         := indirecticonmemory;

   end Open;

   --

   function Load (Window     : in String;
                  SpriteArea : in System_Sprite_Pointer;
                  FontArray  : in Font_Array_Type) return Wimp_Handle_Type is
   
      -- Buffer for Window, must be 12 bytes word-aligned!
      RealWindow : array(0..2) of Integer;
      Error    : Kernel.oserror_access;
      Register : aliased Kernel.swi_regs;
   begin
      Memory.StringToMemory(Window,realWindow'Address,0,12);

      Register.R(1) := Adr_To_Int(templatebuffer);
      Register.R(2) := currentptr;
      Register.R(3) := indirecticonmemory + indirecticonssize;
      Register.R(4) := Adr_To_Int(fontarray'Address);
      Register.R(5) := Adr_To_Int(RealWindow'Address);
      Register.R(6) := 0;
      Error := Kernel.swi (Wimp_LoadTemplate, register'Access, register'Access);

      if Error /= null then
         pragma Debug(Report("Templates.Load1: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;

      currentptr := Register.R(2);
      Memory.PutWord(Adr_To_Integer(Address(spritearea)),templatebuffer,64);

      Register.R(1) := Adr_To_Int(templatebuffer);
      Error := Kernel.swi (Wimp_CreateWindow, register'Access, register'Access);

      if Error /= null then
         pragma Debug(Report("Templates.Load2: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;

      return Wimp_Handle_Type(Register.R(0));

   end Load;

   --

   function Load (Window     : in String;
                  SpriteArea : in System_Sprite_Pointer) return Wimp_Handle_Type is
   
      -- Buffer for Window, must be 12 bytes word-aligned!
      RealWindow : array(0..2) of Integer;
      Error    : Kernel.oserror_access;
      Register : aliased Kernel.swi_regs;
   begin
      Memory.StringToMemory(Window,realWindow'Address,0,12);

      Register.R(1) := Adr_To_Int(templatebuffer);
      Register.R(2) := currentptr;
      Register.R(3) := indirecticonmemory + indirecticonssize;
      Register.R(4) := -1;
      Register.R(5) := Adr_To_Int(RealWindow'Address);
      Register.R(6) := 0;
      Error := Kernel.swi (Wimp_LoadTemplate, register'Access, register'Access);

      if Error /= null then
         pragma Debug(Report("Templates.Load1: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;

      currentptr := Register.R(2);
      Memory.PutWord(Adr_To_Integer(Address(spritearea)),templatebuffer,64);

      Register.R(1) := Adr_To_Int(templatebuffer);
      Error := Kernel.swi (Wimp_CreateWindow, register'Access, register'Access);

      if Error /= null then
         pragma Debug(Report("Templates.Load2: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;

      return Wimp_Handle_Type(Register.R(0));

   end Load;

   --

   procedure Close is

      Error    : Kernel.oserror_access;
      Register : aliased Kernel.swi_regs;
   begin
      Error := Kernel.SWI (Wimp_CloseTemplate, register'Access, register'Access);
      if Error /= null then
         pragma Debug(Report("Templates.Close: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
   end Close;

   --

end RASCAL.Template;