------------------------------------------------------------------------------
--                                                                          --
--                        XVIEW ADA LIBRARY COMPONENTS                      --
--                                                                          --
--                              XV_ICON_PACKAGE                             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (c) 1995 Andreas Almroth, All Rights Reserved         --
--                                                                          --
-- The  XVIEW ADA  library is free software; you can redistribute it and/or --
-- modify  it  under terms of the  GNU  Library General  Public  License as --
-- published by the Free Software Foundation; either version 2, or (at your --
-- option) any later version. The XVIEW ADA 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 Library General Public License for more details.             --
-- You should have  received  a  copy of the  GNU  Library  General  Public --
-- License along with the XVIEW ADA library; see the file  COPYING.LIB.  If --
-- not, write to the Free  Software  Foundation, 675  Mass  Ave, Cambridge, --
-- MA 02139, USA.                                                           --
--                                                                          --
------------------------------------------------------------------------------

-- Lots of bindings to XView C functions needs the Interfaces.C package.

with Interfaces.C;

package body Xv_Icon_Package is

  FRAME_ICON : constant := 1379338753;
  ICON_IMAGE : constant := 1392839041;
  ICON_LABEL : constant := 1078397281;
  ICON_TRANSPARENT_LABEL : constant := 1394477409;
  ICON_TRANSPARENT       : constant := 1393821953;

-----------------------------------------------------------------------------

  function Xv_Set (Owner : Xv_opaque; Cmd : Integer; 
                   Data : Icon; Term : Integer) return Xv_Object;
  pragma Import (C,Xv_Set,"xv_set");

  function xv_set (Owner : Xv_Opaque; Cmd : Integer;
		   Data : Interfaces.C.Char_Array; Term : Integer) 
		   return Xv_Object;
  pragma import (C,Xv_Set,"xv_set");

-----------------------------------------------------------------------------

  procedure Set_Title (V : in Xv_Icon; Txt : String) is
     Xv_Rc : Xv_Object;
  begin
     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),ICON_TRANSPARENT_LABEL,
		     Interfaces.C.To_C(Txt,True),0);
  end Set_Title;

-----------------------------------------------------------------------------

  function Get_Icon (V : in Xv_Icon) return Icon is
  begin
    return V.base;
  end Get_Icon;

-----------------------------------------------------------------------------

  procedure Initialize (V : in out Xv_icon) is
     function Xv_Create (Owner : Xv_Opaque; Pkg   : Xv_Pkg_Ptr;
			 Cmd2  : Integer;   Data2 : Integer;
                         Cmd   : Integer;   Data  : Server_image;
                         Term  : Integer) return Icon;
     pragma Import (C,Xv_Create,"xv_create");

     Xv_Icon_Pkg : Xv_Pkg_Ptr;
     pragma Import (C,Xv_Icon_Pkg,"my_xv_icon_pkg");

    Xv_Rc : Xv_Object;
  begin
     V.Base := Xv_Create(0,Xv_Icon_Pkg,ICON_TRANSPARENT,1,
			 ICON_IMAGE,V.The_Image,0);
     
     if V.Base = 0 then 
	raise NO_OBJECT_CREATED;
     end if;
     
     Xv_Rc := Xv_Set(Xv_opaque(V.Parent),FRAME_ICON,V.Base,0);
  end Initialize;

-----------------------------------------------------------------------------

  procedure Finalize (V : in out Xv_Icon) is
     procedure Xv_Destroy (Object : Xv_Opaque);
     pragma Import (C,Xv_Destroy,"xv_destroy");
  begin
     Xv_Destroy(Xv_Opaque(V.Base));
  end Finalize;
end Xv_Icon_Package;