--------------------------------------------------------------------------------
--                                                                            --
-- 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 RASCAL.OS;
with RASCAL.Memory;     use RASCAL.Memory;

with Interfaces.C;      use Interfaces.C;
with Kernel;            use Kernel;


package body RASCAL.ToolboxIconbar is

   -- SWIs
   Toolbox_ObjectMiscOp : constant Interfaces.C.unsigned :=16#44EC6#;

   Iconbar_ClassSWI        : constant := 16#82900#;
   Iconbar_PostFilter      : constant := 16#82901#;
   Iconbar_PreFilter       : constant := 16#82902#;

   -- Reason codes
   Iconbar_GetIconHandle   : constant := 16#0#;
   Iconbar_SetMenu         : constant := 16#1#;
   Iconbar_GetMenu         : constant := 16#2#;
   Iconbar_SetAction       : constant := 16#3#;
   Iconbar_GetAction       : constant := 16#4#;
   Iconbar_SetShow         : constant := 16#5#;
   Iconbar_GetShow         : constant := 16#6#;
   Iconbar_SetHelpMessage  : constant := 16#7#;
   Iconbar_GetHelpMessage  : constant := 16#8#;
   Iconbar_SetText         : constant := 16#9#;
   Iconbar_GetText         : constant := 16#A#;
   Iconbar_SetSprite       : constant := 16#B#;
   Iconbar_GetSprite       : constant := 16#C#;
   
   --

   function Get_Event (Iconbar : in Object_ID;
                       Button  : in Iconbar_Button_Type) return Toolbox_Event_Code_Type is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Flag           : integer;
   begin
      case Button is
      when Select_Button => Flag := 1;
      when Adjust_Button => Flag := 2;
      end case;

      Register.R(0) := int(Flag);
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetAction;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

      case Button is
      when Select_Button => return Toolbox_Event_Code_Type(Register.R(0));
      when Adjust_Button => return Toolbox_Event_Code_Type(Register.R(1));
      end case;
   end Get_Event;

   --
   
   function Get_Help_Message (Iconbar : in Object_ID;
                              Flags   : in System.Unsigned_Types.Unsigned := 0) return String is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Buffer_Size    : integer;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetHelpMessage;
      Register.R(3) := 0;
      Register.R(4) := 0;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

      Buffer_Size := integer(Register.R(4)) + 1;

      declare
         Buffer : String(1..Buffer_Size);
      begin
         Register.R(0) := int(Unsigned_to_Int(Flags));
         Register.R(1) := int(Iconbar);
         Register.R(2) := Iconbar_GetHelpMessage;
         Register.R(3) := Adr_To_Int(Buffer'Address);
         Register.R(4) := int(Buffer_Size);
         Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   function Get_IconHandle (Iconbar : in Object_ID;
                            Flags   : in System.Unsigned_Types.Unsigned := 0) return Component_ID is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetIconHandle;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   function Get_Menu (Iconbar : in Object_ID;
                      Flags   : in System.Unsigned_Types.Unsigned := 0) return Object_ID is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetMenu;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   function Get_Show (Iconbar : in Object_ID;
                      Button  : in Iconbar_Button_Type;
                      Flags   : in System.Unsigned_Types.Unsigned := 0) return Object_ID is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Flag           : integer;
   begin
      case Button is
      when Select_Button => Flag := 1;
      when Adjust_Button => Flag := 2;
      end case;

      Register.R(0) := int(Flag);
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetShow;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

      if Error /= null then
         pragma Debug(Report("ToolboxIconbar.Get_Show: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      case Button is
      when Select_Button => return Object_ID(Register.R(0));
      when Adjust_Button => return Object_ID(Register.R(1));
      end case;
   end Get_Show;

   --

   function Get_Sprite (Iconbar : in Object_ID;
                        Flags   : in System.Unsigned_Types.Unsigned := 0) return String is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Buffer_Size    : integer;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetSprite;
      Register.R(3) := 0;
      Register.R(4) := 0;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

      Buffer_Size := integer(Register.R(4)) + 1;

      declare
         Buffer : String(1..Buffer_Size);
      begin
         Register.R(0) := int(Unsigned_to_Int(Flags));
         Register.R(1) := int(Iconbar);
         Register.R(2) := Iconbar_GetSprite;
         Register.R(3) := Adr_To_Int(Buffer'Address);
         Register.R(4) := int(Buffer_Size);
         Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   function Get_Text (Iconbar : in Object_ID;
                      Flags   : in System.Unsigned_Types.Unsigned := 0) return String is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Buffer_Size    : integer;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_GetText;
      Register.R(3) := 0;
      Register.R(4) := 0;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

      Buffer_Size := integer(Register.R(4)) + 1;

      declare
         Buffer : String(1..Buffer_Size);
      begin
         Register.R(0) := int(Unsigned_to_Int(Flags));
         Register.R(1) := int(Iconbar);
         Register.R(2) := Iconbar_GetText;
         Register.R(3) := Adr_To_Int(Buffer'Address);
         Register.R(4) := int(Buffer_Size);
         Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   procedure Set_Event (Iconbar : in Object_ID;
                        Button  : in Iconbar_Button_Type;
                        Event   : in Toolbox_Event_Code_Type;
                        Flags   : in System.Unsigned_Types.Unsigned := 0) is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Flag           : integer;
   begin
      case Button is
      when Select_Button => Flag := 1;
                            Register.R(3) := int(Event);
                            Register.R(4) := 0;
      when Adjust_Button => Flag := 2;
                            Register.R(4) := int(Event);
                            Register.R(3) := 0;
      end case;

      Register.R(0) := int(Flag);
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_SetAction;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   procedure Set_HelpMessage (Iconbar : in Object_ID;
                              Message : in string;
                              Flags   : in System.Unsigned_Types.Unsigned := 0) is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Message_0   : string := Message & ASCII.NUL;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_SetHelpMessage;
      Register.R(3) := Adr_To_Int(Message_0'Address);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   procedure Set_Menu (Iconbar : in Object_ID;
                       Menu    : in Object_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(Iconbar);
      Register.R(2) := Iconbar_SetMenu;
      Register.R(3) := int(Menu);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   procedure Set_Show  (Iconbar : in Object_ID;
                        Button  : in Iconbar_Button_Type;
                        Object  : in Object_ID;
                        Flags   : in System.Unsigned_Types.Unsigned := 0) is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Flag           : integer;
   begin
      case Button is
      when Select_Button => Flag := 1;
                            Register.R(3) := int(Object);
                            Register.R(4) := 0;
      when Adjust_Button => Flag := 2;
                            Register.R(4) := int(Object);
                            Register.R(3) := 0;
      end case;
      Register.R(0) := int(Flag);
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_SetShow;
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   procedure Set_Sprite (Iconbar : in Object_ID;
                         Sprite  : in string;
                         Flags   : in System.Unsigned_Types.Unsigned := 0) is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Sprite_0       : string := Sprite & ASCII.NUL;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_SetSprite;
      Register.R(3) := Adr_To_Int(Sprite_0'Address);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

   procedure Set_Text (Iconbar : in Object_ID;
                       Text    : in string;
                       Flags   : in System.Unsigned_Types.Unsigned := 0) is

      Register       : aliased Kernel.swi_regs;
      Error          : oserror_access;
      Text_0         : string := Text & ASCII.NUL;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := int(Iconbar);
      Register.R(2) := Iconbar_SetText;
      Register.R(3) := Adr_To_Int(Text_0'Address);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,Register'Access,Register'Access);

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

   --

end RASCAL.ToolboxIconbar;
