--------------------------------------------------------------------------------
--                                                                            --
-- 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.WimpIcon;       use RASCAL.WimpIcon;
with RASCAL.Sprite;         use RASCAL.Sprite;
with RASCAL.Wimp;           use RASCAL.Wimp;
with RASCAL.Memory;         use RASCAL.Memory;
with RASCAL.Utility;        use RASCAL.Utility;

with kernel;                use kernel;
with Interfaces.C;          use Interfaces.C;

package body RASCAL.WimpIconbar is

   --     

   function Create_Icon (Sprite_Name : in String;
                         Sprite_Area : in spriteareatyp := 1)
                                       return iconbarhandletyp is

      Register        : aliased Kernel.swi_regs;
      Error           : Kernel.oserror_access;
      Sprite_Name_Adr : mem_adr_type;
      Blk : iconarray_type;
   begin
      Blk(0) := -1;
      Blk(1) := 0;
      Blk(2) := 0;
      Blk(3) := 68;
      Blk(4) := 72;
      if Sprite_Name'Length <= 11 then
         Blk(5) := 16#2002#;
         StringToMemory(Sprite_Name,Blk(6)'Address,0,12);
      else
        Sprite_Name_Adr := AllocateFixed(Sprite_Name'Length+1);
        StringToMemory(Sprite_Name,Sprite_Name_Adr);
        Blk(5) := 16#2102#;
        Blk(6) := Adr_To_Integer(Sprite_Name_Adr);
        Blk(7) := Integer(Sprite_Area);
        Blk(8) := Sprite_Name'length + 1;

      end if;
      Register.R(0) := 0;
      Register.R(1) := Adr_To_Int(Blk'Address);
      Error := Kernel.SWI (Wimp_CreateIcon, Register'Access, Register'Access);

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

end RASCAL.WimpIconbar;
