with RASCAL.Utility;         use RASCAL.Utility;
with RASCAL.ToolboxWindow;   use RASCAL.ToolboxWindow;
with RASCAL.ToolboxGadget;   use RASCAL.ToolboxGadget;
with RASCAL.Caret;

with Ada.Exceptions;         use Ada.Exceptions;
with Interfaces.C;           use Interfaces.C;
with Unchecked_Deallocation;

package body RASCAL.Suggestions is

   ListGadget_HelpText : constant string := "List of suggestions." & ASCII.NUL;
   
   --
   
   procedure Free_SuggestionList is new Unchecked_Deallocation
                                        (SuggestionList, SuggestionList_Pointer);

   procedure Free_SuggestionsList is new Unchecked_Deallocation
                                        (SuggestionsList, SuggestionsList_Pointer);

   --
   
   procedure Initialise (TB_Task : in ToolBox_Task_Pointer) is
   begin
      if Get_Task_Handle(TB_Task) = 0 then
         ID := TB_Task;
         Suggestions := new SuggestionsList (1..Start_PointerArraySize);
         Add_Listener (ID,new TEL_Suggestion);
      else
         Raise_Exception (Task_Is_Initialised'Identity,
                          "Task is already initialised. " &
                          "RASCAL.Suggestions must be initialised before the task.");
      end if;
   end Initialise;

   --

   procedure Add_Gadget (Object : in Object_ID;
                         Gadget : in Component_ID) is

      New_Array : SuggestionsList_Pointer;
   begin
      if Current_PointerArrayIndex > Suggestions'Last then
         New_Array := new SuggestionsList(1..(2*Current_PointerArrayIndex));
         for x in Suggestions.all'range loop
            New_Array.all(x) := Suggestions.all(x);
         end loop;
         Free_SuggestionsList(Suggestions);
         Suggestions := New_Array;
      end if;

      Suggestions.all(Current_PointerArrayIndex)        := new Suggestion;
      Suggestions.all(Current_PointerArrayIndex).Object := Object;
      Suggestions.all(Current_PointerArrayIndex).Gadget := Gadget;
      Current_PointerArrayIndex := Current_PointerArrayIndex + 1;

   end Add_Gadget;

   --

   procedure Add_Suggestion (Object     : in Object_ID;
                             Gadget     : in Component_ID;
                             Suggestion : in String_Pointer) is

      New_Array : SuggestionList_Pointer;                             
   begin
      for i in 1..(Current_PointerArrayIndex-1) loop
         if (Suggestions.all(i).Object = Object) and
            (Suggestions.all(i).Gadget = Gadget) then

            -- Array is full.
            if Suggestions.all(i).Current_Index >
               Suggestions.all(i).SuggestionArray.all'last then

               New_Array := new SuggestionList(1..(2*Suggestions.all(i).Current_Index));

               for x in Suggestions.all(i).SuggestionArray.all'range loop
                  New_Array.all(x) := Suggestions.all(i).SuggestionArray.all(x);
               end loop;
               Free_SuggestionList(Suggestions.all(i).SuggestionArray);
               Suggestions.all(i).SuggestionArray := New_Array;
            end if;

            Suggestions.all(i).SuggestionArray.all(Suggestions.all(i).Current_Index) := Suggestion;
            Suggestions.all(i).Current_Index := Suggestions.all(i).Current_Index + 1;
            exit;
         end if;
      end loop;
   end Add_Suggestion;

   --

   function Get_Suggestions (Object : in Object_ID;
                             Gadget : in Component_ID) return SuggestionList_Pointer is
   begin
      for i in 1..(Current_PointerArrayIndex-1) loop
         if (Suggestions.all(i).Object = Object) and
            (Suggestions.all(i).Gadget = Gadget) then

            return Suggestions.all(i).SuggestionArray;
         end if;
      end loop;
      Raise_Exception (Gadget_not_recognised'Identity,
                       "Gadget not recognised - has it been added?");
   end Get_Suggestions;

   --

   procedure Display (Suggestions : in Suggestion_Pointer;
                      Content     : in String;
                      Window      : in Wimp_Handle_Type;
                      Icon        : in Icon_Handle_Type) is

      BBox,BB: Toolbox_BBox_Type;
      X,Y    : Integer;
      Height : Integer;
   begin
   pragma Debug(Report ("Object: " & intstr(integer(Suggestions.all.Object))));

--      if Suggestions.all.Current_Index > 1 then
         if not SuggestionGadget_Created then
            Suggestion_Gadget.Gadget_Id := Get_UnusedGadget (Suggestions.all.Object);
            Suggestion_Gadget.Help      := Adr_To_Integer(ListGadget_HelpText'Address);
            Suggestion_Gadget.Max_Help  := ListGadget_HelpText'Length;
            
            Add_Gadget (Flags  => 0,
                        Window => Suggestions.all.Object,
                        Gadget => Suggestion_Gadget'Address);

            SuggestionGadget_Created := true;

         end if;

         BBox := Get_BBox(Suggestions.all.Object,Suggestions.all.Gadget);

 pragma Debug(Report ("Ymin: " & intstr(BBox.ymin)));
 pragma Debug(Report ("Xmin: " & intstr(BBox.xmin)));
 pragma Debug(Report ("Ymax: " & intstr(BBox.ymax)));
 pragma Debug(Report ("Xmax: " & intstr(BBox.xmax)));

         Height    := BBox.YMax - BBox.YMin;
         --BBox.YMax := BBox.YMax - Height;
         Height := Height * 8;
         BBox.YMin := BBox.YMin - Height;

 pragma Debug(Report ("Ymin: " & intstr(BBox.ymin)));
 pragma Debug(Report ("Xmin: " & intstr(BBox.xmin)));
 pragma Debug(Report ("Ymax: " & intstr(BBox.ymax)));
 pragma Debug(Report ("Xmax: " & intstr(BBox.xmax)));

pragma Debug(Report ("Suggestion_GadgetId: " & intstr(integer(Suggestion_Gadget.Gadget_Id))));
         ToolboxGadget.Move (Suggestions.all.Object,Suggestion_Gadget.Gadget_Id,BBox);
       pragma Debug(Report ("Help: " &
       RASCAL.ToolboxGadget.Get_Help(Suggestions.all.Object,Suggestions.all.Gadget)));
       BB := RASCAL.ToolboxGadget.Get_BBox (Suggestions.all.Object,Suggestions.all.Gadget);
 pragma Debug(Report ("BB.Ymin: " & intstr(BB.ymin)));
 pragma Debug(Report ("BB.Xmin: " & intstr(BB.xmin)));
 pragma Debug(Report ("BB.Ymax: " & intstr(BB.ymax)));
 pragma Debug(Report ("BB.Xmax: " & intstr(BB.xmax)));
pragma Debug(Report ("BaseType: " & intstr(integer(RASCAL.ToolboxGadget.Get_Type(Suggestions.all.Object,Suggestions.all.Gadget)))));

--      end if;
   end Display;

   --

   procedure Handle (The : in TEL_Suggestion) is

      Gadget  : Component_ID;
      Content : String_Pointer := new String'(To_Ada(The.Event.all.Content));
      X,Y,F,I : integer;
      Window  : Wimp_Handle_Type;
      Icon    : Icon_Handle_Type;
      O       : Object_ID;
      G       : Component_ID;
   begin
      RASCAL.Caret.Get_Position(Window,Icon,X,Y,F,I);
      Wimp_To_Toolbox(Window,Icon,O,G);

      if ID /= null then
         Gadget := Get_Self_Component(ID);         
      else
         Raise_Exception (Not_Initialised'Identity,
                          "RASCAL.Suggestions has not been initialised.");
      end if;
      
      for i in Suggestions.all'range loop
         if Suggestions.all(i).all.Gadget = Gadget then
            if G /= Gadget then
               Add_Suggestion(Get_Self_Id(ID),Gadget,Content);
            end if;
            Display (Suggestions.all(i),Content.all,Window,Icon);
            exit;
         end if;
      end loop;
   end Handle;

   --

end RASCAL.Suggestions;