--------------------------------------------------------------------------------
--                                                                            --
-- Copyright (C) 2004, RISC OS Ada Library (RASCAL) developers.               --
--                                                                            --
-- This library is free software; you can redistribute it and/or              --
-- modify it under the terms of the GNU Lesser General Public                 --
-- License as published by the Free Software Foundation; either               --
-- version 2.1 of the License, or (at your option) any later version.         --
--                                                                            --
-- This library is distributed in the hope that it will be useful,            --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of             --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU           --
-- Lesser General Public License for more details.                            --
--                                                                            --
-- You should have received a copy of the GNU Lesser General Public           --
-- License along with this library; if not, write to the Free Software        --
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA    --
--                                                                            --
--------------------------------------------------------------------------------

-- $Author$
-- $Date$
-- $Revision$

with Kernel;                          use Kernel;
with Interfaces.C;                    use Interfaces.C;
with Ada.Strings.Unbounded;

with RASCAL.ToolboxWindow;            use RASCAL.ToolboxWindow;
with RASCAL.Memory;                   use RASCAL.Memory;
with RASCAL.WimpWindow;               use RASCAL.WimpWindow;
with RASCAL.Font;                     use RASCAL.Font;



package body RASCAL.ToolboxGadget is

   -- SWIs
   Toolbox_ObjectMiscOp                : constant := 16#44EC6#;

   Window_PlotGadget                   : constant := 16#828BF#;
   Window_GadgetGetIconList            : constant := 16#8288B#;

   --

   function Get_BufferSize (Object    : in Object_ID;
                            Component : in Component_ID) return Integer is

      Icon       : Icon_Handle_Type;
      Window     : Wimp_Handle_Type;
      Buffer_Size: Integer;
      Index      : Integer := 1;
   begin
      case Get_Type (Object,Component) is
      when WritableField_Base => Index := 1;
      when DisplayField_Base  => Index := 1;
      when ActionButton_Base  => Index := 1;
      when OptionButton_Base  => Index := 1;
      when LabelledBox_Base   => Index := 1;
      when Label_Base         => Index := 1;
      when RadioButton_Base   => Index := 2;
      when others             => Index := -1;
      end case;
      if Index = -1 then
         return -1;
      end if;
      Icon        := Get_IconList(Object,Component)(Index);
      Window      := ToolboxWindow.Get_WimpHandle (Object);
      Buffer_Size := Memory.GetWord(WimpWindow.Get_WindowInfo(Window).Icon_Block(Integer(Icon)).Icon_Data'Address,8-4);
      return Buffer_Size;
   end Get_BufferSize;

   --

   function Get_Value (Object    : in Object_ID;
                       Component : in Component_ID;
                       Flags     : in System.Unsigned_Types.Unsigned := 0) return String is

      Register   : aliased Kernel.swi_regs;
      Error      : oserror_access;

      Method     : Integer;
      BufferSize : Int;
   begin
      case Get_Type (Object,Component) is
      when WritableField_Base => Method := 513;
      when DisplayField_Base  => Method := 449;
      when ActionButton_Base  => Method := 129;
      when OptionButton_Base  => Method := 193;
      when RadioButton_Base   => Method := 385;
      when others             => Method := -1;
      end case;

      if Method /= -1 then
         Register.R(0) := Int (Unsigned_to_Int(Flags));
         Register.R(1) := Int (Object);
         Register.R(2) := Int (Method);
         Register.R(3) := Int (Component);
         Register.R(4) := 0;
         Register.R(5) := 0;
         Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);
         
         if Error /= null then
            pragma Debug(Report("ToolboxGadget.Get_Value(I): " & To_Ada(Error.ErrMess)));
            OS.Raise_Error(Error);
         end if;

         BufferSize := Register.R(5);
         declare
            Buffer : Char_Array (1..size_t(BufferSize));
         begin
            Register.R(0) := Int (Unsigned_to_Int(Flags));
            Register.R(1) := Int (Object);
            Register.R(2) := Int (Method);
            Register.R(3) := Int (Component);
            Register.R(4) := Adr_To_Int(Buffer'Address);
            Register.R(5) := Int(BufferSize);
            Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);
   
            if Error /= null then
               pragma Debug(Report("ToolboxGadget.Get_Value(II): " & To_Ada(Error.ErrMess)));
               OS.Raise_Error(Error);
            end if;
            return To_Ada(Buffer);
         end;
      end if;

   end Get_Value;

   --

   function Get_Value (Object    : in Object_ID;
                       Component : in Component_ID;
                       Flags     : in System.Unsigned_Types.Unsigned := 0) return Integer is

      Register   : aliased Kernel.swi_regs;
      Error      : oserror_access;
      Method     : Integer;
   begin
      case Get_Type (Object,Component) is
      when NumberRange_Base => Method := 833;
      when Slider_Base      => Method := 577;
      when others           => Method := -1;
      end case;

      if Method /= -1 then
         Register.R(0) := Int (Unsigned_to_Int(Flags));
         Register.R(1) := Int (Object);
         Register.R(2) := Int (Method);
         Register.R(3) := Int (Component);
         Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);
         
         if Error /= null then
            pragma Debug(Report("ToolboxGadget.Get_Value(III): " & To_Ada(Error.ErrMess)));
            OS.Raise_Error(Error);
         end if;
         return Integer(Register.R(0)); 
      end if;
   end Get_Value;

   --

   procedure Set_Value (Window    : in Object_ID;
                        Component : in Component_ID;
                        Value     : in String;
                        Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Register    : aliased Kernel.swi_regs;
      Error       : oserror_access;
      Value_0     : UString := U(Value & ASCII.NUL);
      Buffer_Size : Integer := (Get_BufferSize(Window,Component))-1;
      Method      : Integer;
   begin
      if Buffer_Size > -1 then
         if Value'Length > Buffer_Size then
            Value_0 := Ada.Strings.Unbounded.Head(Value_0,Buffer_Size);
            Ada.Strings.Unbounded.Append(Value_0,ASCII.NUL);
         end if;

         case Get_Type (Window,Component) is
         when WritableField_Base => Method := 512;
         when DisplayField_Base  => Method := 448;
         when ActionButton_Base  => Method := 80;
         when OptionButton_Base  => Method := 192;
         when RadioButton_Base   => Method := 384;
         when others             => Method := -1;
         end case;

         if Method /= -1 then
            Register.R(0) := Int (Unsigned_to_Int(Flags));
            Register.R(1) := Int (Window);
            Register.R(2) := Int (Method);
            Register.R(3) := Int (Component);
            Register.R(4) := Adr_To_Int (S(Value_0)'Address);            
            Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);
            
            if Error /= null then
               pragma Debug(Report("ToolboxWindow.Set_Value(I): " & To_Ada(Error.ErrMess)));
               OS.Raise_Error(Error);
            end if;
         end if;
      else
         raise Gadget_Type_Incompatible_With_Set_Value;   
      end if;
   end Set_Value;

   --

   procedure Set_Value (Window    : in Object_ID;
                        Component : in Component_ID;
                        Value     : in Integer;
                        Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Register    : aliased Kernel.swi_regs;
      Error       : oserror_access;
      Method      : Integer;
   begin
      case Get_Type (Window,Component) is
      when NumberRange_Base => Method := 832;
      when Slider_Base      => Method := 576;
      when others           => Method := -1;
      end case;

      if Method /= -1 then
         Register.R(0) := Int (Unsigned_to_Int(Flags));
         Register.R(1) := Int (Window);
         Register.R(2) := Int (Method);
         Register.R(3) := Int (Component);
         Register.R(4) := Int (Value);
         Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);
         
         if Error /= null then
            pragma Debug(Report("ToolboxWindow.Set_Value(II): " & To_Ada(Error.ErrMess)));
            OS.Raise_Error(Error);
         end if;
      end if;
   end Set_Value;

   --

   procedure Set_TruncatedValue (Window    : in Object_ID;
                                 Component : in Component_ID;
                                 New_Value : in String;
                                 Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Buffer_Size : Integer := Get_BufferSize(Window,Component)-1;
      BBox        : Toolbox_BBox_Type := Get_BBox (Window,Component);
      Truncated   : String := Font.Truncate(New_Value,BBox.xmax-BBox.xmin,BBox.ymax-BBox.ymin,Buffer_Size,true);
   begin
      Set_Value (Window,Component,Truncated,Flags);
   end Set_TruncatedValue;

   --

   function Get_BBox (Window    : in Object_ID;
                      Component : in Component_ID;
                      Flags     : in System.Unsigned_Types.Unsigned := 0) return Toolbox_BBox_Type is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
      Buffer   : Toolbox_BBox_Type;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Window);
      Register.R(2) := 72;
      Register.R(3) := int(Component);
      Register.R(4) := Adr_To_Int(Buffer'Address);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

      if Error /= null then
         pragma Debug(Report("ToolboxWindow.Get_BBox: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Buffer;
   end Get_BBox;

   --

   function Get_Flags (Window    : in Object_ID;
                       Component : in Component_ID;
                       Flags     : in System.Unsigned_Types.Unsigned := 0) return integer is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 64;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

      if Error /= null then
         pragma Debug(Report("ToolboxWindow.Get_Flags: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return integer(Register.R(0));
   end Get_Flags;

   --

   procedure Set_Flags (Window    : in Object_ID;
                        Component : in Component_ID;
                        New_Flags : in System.Unsigned_Types.Unsigned;
                        Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 65;
      Register.R(3) := Int(Component);
      Register.R(4) := Int(Utility.Unsigned_To_Int(New_Flags));
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   function Get_Type (Window    : in Object_ID;
                      Component : in Component_ID;
                      Flags     : in System.Unsigned_Types.Unsigned := 0) return Gadget_Base_Type is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 70;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

      if Error /= null then
         pragma Debug(Report("ToolboxWindow.Get_Type: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Gadget_Base_Type(Register.R(0));
   end Get_Type;

   --

   function Get_Help (Window    : in Object_ID;
                      Component : in Component_ID;
                      Flags     : in System.Unsigned_Types.Unsigned := 0) return String is

      Register    : aliased Kernel.swi_regs;
      Buffer_Size : integer := 0;
      Error       : oserror_access;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 67;
      Register.R(3) := Int(Component);
      Error := Kernel.Swi (Toolbox_ObjectMiscOp, Register'Access, Register'Access);

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

      Buffer_Size := Integer(Register.R(5));

      declare
         Buffer : String(1..Buffer_Size);
      begin
         Register.R(0) := Int(Unsigned_to_Int(Flags));
         Register.R(1) := Int(Window);
         Register.R(2) := 67;
         Register.R(3) := Int(Component);
         Register.R(4) := Adr_To_Int(Buffer'Address);
         Register.R(5) := Int(Buffer_Size);
         Error := Kernel.Swi (Toolbox_ObjectMiscOp, Register'Access, Register'Access);

         if Error /= null then
            pragma Debug(Report("ToolboxWindow.Get_Help: " & To_Ada(Error.ErrMess)));
            OS.Raise_Error(Error);
         end if;
         return MemoryToString(Buffer'Address);
      end;
   end Get_Help;

   --

   procedure Set_Help  (Window    : in Object_ID;
                        Component : in Component_ID;
                        Help      : in String;
                        Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Register  : aliased Kernel.swi_regs;
      Error     : oserror_access;
      Help_0    : String := Help & ASCII.NUL;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 66;
      Register.R(3) := Int(Component);
      Register.R(4) := Adr_To_Int(Help_0'Address);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --
   
   function Get_IconList (Window    : in Object_ID;
                          Component : in Component_ID;
                          Flags     : in System.Unsigned_Types.Unsigned := 0) return Icon_List_Type is

      Register    : aliased Kernel.swi_regs;
      Buffer_Size : integer := 0;
      Error       : oserror_access;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 68;
      Register.R(3) := Int(Component);
      Register.R(4) := 0;
      Register.R(5) := 0;
      Error := Kernel.Swi (Toolbox_ObjectMiscOp, Register'Access, Register'Access);

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

      Buffer_Size := integer(Register.R(5));
      if Buffer_Size mod 4 > 0 then
         Buffer_Size := Buffer_Size / 4 + 1;
      else
         Buffer_Size := Buffer_Size / 4;
      end if;

      declare
         Buffer : Icon_List_Type(1..Buffer_Size);
      begin
         Register.R(0) := Int(Unsigned_to_Int(Flags));
         Register.R(1) := Int(Window);
         Register.R(2) := 68;
         Register.R(3) := Int(Component);
         Register.R(4) := Adr_To_Int(Buffer'Address);
         Register.R(5) := Int(Buffer_Size);
         Error := Kernel.Swi (Toolbox_ObjectMiscOp, Register'Access, Register'Access);

         if Error /= null then
            pragma Debug(Report("ToolboxWindow.Get_IconList: " & To_Ada(Error.ErrMess)));
            OS.Raise_Error(Error);
         end if;
         if integer(Register.R(4)) = -1 then
            raise No_Toolbox_Window;
         end if;
         return Buffer;
      end;
   end Get_IconList;

   --

   procedure Fade (Window    : in Object_ID;
                   Component : in Component_ID;
                   Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Flag : System.Unsigned_Types.Unsigned := 16#80000000#;
   begin
      Set_Flags(Window,Component,Flag);
   end Fade;

   --

   procedure UnFade (Window    : in Object_ID;
                     Component : in Component_ID;
                     Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Flag : System.Unsigned_Types.Unsigned := 16#0#;
   begin
      Set_Flags(Window,Component,Flag);
   end UnFade;

   --

   procedure Set_Focus (Window    : in Object_ID;
                        Component : in Component_ID;
                        Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 68;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   procedure Move (Window    : in Object_ID;
                   Component : in Component_ID;
                   BBox      : in Toolbox_BBox_Type;
                   Flags     : in System.Unsigned_Types.Unsigned := 0) is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
   begin
      Register.R(0) := Int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := 71;
      Register.R(3) := Int(Component);
      Register.R(4) := Adr_To_Int(BBox'Address);

      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

end RASCAL.ToolboxGadget;