--------------------------------------------------------------------------------
--                                                                            --
-- 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.Utility;    use RASCAL.Utility;

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


package body RASCAL.ToolboxScrollbar is

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

   -- Reason codes
   Scrollbar_GetState         : constant := 16#401B#;
   Scrollbar_SetState         : constant := 16#401C#;
   Scrollbar_SetBounds        : constant := 16#401D#;
   Scrollbar_SetLowerBound    : constant := 16#1#;
   Scrollbar_SetUpperBound    : constant := 16#2#;
   Scrollbar_SetVisibleLength : constant := 16#4#;
   Scrollbar_GetBounds        : constant := 16#401E#;
   Scrollbar_GetLowerBound    : constant := 16#1#;
   Scrollbar_GetUpperBound    : constant := 16#2#;
   Scrollbar_GetVisibleLength : constant := 16#4#;
   Scrollbar_SetValue         : constant := 16#401F#;
   Scrollbar_GetValue         : constant := 16#4020#;
   Scrollbar_SetIncrements    : constant := 16#4021#;
   Scrollbar_SetLineIncrement : constant := 16#1#;
   Scrollbar_SetPageIncrement : constant := 16#2#;
   Scrollbar_GetIncrements    : constant := 16#4022#;
   Scrollbar_GetLineIncrement : constant := 16#1#;
   Scrollbar_GetPageIncrement : constant := 16#2#;
   Scrollbar_SetEvent         : constant := 16#4023#;
   Scrollbar_GetEvent         : constant := 16#4024#;

   --

   function Get_State(Window    : in Object_ID;
                      Component : in Component_ID;
                      Flags     : in System.Unsigned_Types.Unsigned := 0) return System.Unsigned_Types.Unsigned 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) := Scrollbar_GetState;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_State: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Int_To_Unsigned(Integer(Register.R(0)));
   end Get_State;

   --

   procedure Set_State(Window    : in Object_ID;
                       Component : in Component_ID;
                       State     : 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) := Scrollbar_SetState;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   procedure Set_Bounds(Window         : in Object_ID;
                        Component      : in Component_ID;
                        Lower_Bound    : in Integer;
                        Upper_Bound    : in Integer;
                        Visible_Length : in Integer;
                        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) := Scrollbar_SetBounds;
      Register.R(3) := Int(Component);
      Register.R(4) := Int(Lower_Bound);
      Register.R(5) := Int(Upper_Bound);
      Register.R(6) := Int(Visible_Length);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   procedure Set_LowerBound(Window      : in Object_ID;
                            Component   : in Component_ID;
                            Lower_Bound : in Integer) is

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

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

   --

   procedure Set_UpperBound(Window      : in Object_ID;
                            Component   : in Component_ID;
                            Upper_Bound : in Integer) is

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

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

   --

   procedure Set_VisibleLength(Window         : in Object_ID;
                               Component      : in Component_ID;
                               Visible_Length : in Integer) is

      Register : aliased Kernel.swi_regs;
      Error    : oserror_access;
   begin
      Register.R(0) := 4;
      Register.R(1) := Int(Window);
      Register.R(2) := Scrollbar_SetBounds;
      Register.R(3) := Int(Component);
      Register.R(6) := Int(Visible_Length);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   procedure Get_Bounds(Window           : in Object_ID;
                        Component        : in Component_ID;
                        Lower_Bound      : out Integer;
                        Upper_Bound      : out Integer;
                        Visible_Length   : out Integer;
                        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) := Scrollbar_GetBounds;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_Bounds: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      Lower_Bound    := Integer(Register.R(0));
      Upper_Bound    := Integer(Register.R(1));
      Visible_Length := Integer(Register.R(2));
   end Get_Bounds;

   --

   function Get_LowerBound(Window      : in Object_ID;
                           Component   : in Component_ID) return Integer is

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

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

   --

   function Get_UpperBound(Window      : in Object_ID;
                           Component   : in Component_ID) return Integer is

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

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_UpperBound: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Integer(Register.R(1));
   end Get_UpperBound;

   --

   function Get_VisibleLength(Window      : in Object_ID;
                              Component   : in Component_ID) return Integer is

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

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_VisibleLength: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Integer(Register.R(2));
   end Get_VisibleLength;

   --

   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;
   begin
      Register.R(0) := int(Unsigned_to_Int(Flags));
      Register.R(1) := Int(Window);
      Register.R(2) := Scrollbar_SetValue;
      Register.R(3) := Int(Component);
      Register.R(3) := Int(Value);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   function Get_Value(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) := Scrollbar_GetValue;
      Register.R(3) := Int(Component);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   procedure Set_Increments(Window    : in Object_ID;
                            Component : in Component_ID;
                            Line      : in Integer;
                            Page      : in Integer;
                            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) := Scrollbar_SetIncrements;
      Register.R(3) := Int(Component);
      Register.R(4) := Int(Line);
      Register.R(5) := Int(Page);
      Error := Kernel.swi(Toolbox_ObjectMiscOp,register'Access,register'Access);

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

   --

   procedure Set_LineIncrement(Window    : in Object_ID;
                               Component : in Component_ID;
                               Line      : in Integer) is

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

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

   --

   procedure Set_PageIncrement(Window    : in Object_ID;
                               Component : in Component_ID;
                               Page      : in Integer) is

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

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

   --

   procedure Get_Increments(Window    : in Object_ID;
                            Component : in Component_ID;
                            Line      : out Integer;
                            Page      : out Integer;
                            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) := Scrollbar_GetIncrements;
      Register.R(3) := Int(Component);

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

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_Increments: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      Line := Integer(REgister.R(0));
      Page := Integer(REgister.R(1));
   end Get_Increments;

   --

   function Get_LineIncrement(Window    : in Object_ID;
                              Component : in Component_ID) return Integer is

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

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_LineIncrement: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Integer(REgister.R(0));
   end Get_LineIncrement;

   --

   function Get_PageIncrement(Window    : in Object_ID;
                              Component : in Component_ID) return Integer is

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

      if Error /= null then
         pragma Debug(Report("ToolboxScrollbar.Get_PageIncrement: " & To_Ada(Error.ErrMess)));
         OS.Raise_Error(Error);
      end if;
      return Integer(REgister.R(1));
   end Get_PageIncrement;

   --

   procedure Set_Event(Window    : in Object_ID;
                       Component : in Component_ID;
                       Event     : in Integer;
                       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) := Scrollbar_SetEvent;
      Register.R(3) := Int(Component);
      Register.R(4) := Int(Event);

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

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

   --

   function Get_Event(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) := Scrollbar_GetEvent;
      Register.R(3) := Int(Component);

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

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

   --

end RASCAL.ToolboxScrollbar;