------------------------------------------------------------------------------
--                                                                          --
--                        XVIEW ADA LIBRARY COMPONENTS                      --
--                                                                          --
--                            XVIEW_FONT_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,Interfaces.C.Strings;

package body Xv_Font_Package is

  FONT_NAME    : constant := 1125714273;
  FONTY_FAMILY : constant := 1125386593;
  FONTY_STYLE  : constant := 1128008033;
  FONT_SIZE    : constant := 1127024641;

  type String_ptr is access all String;

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

  procedure Initialize (V : in out Xv_Font) is
     function Xv_Find (Owner : Frame; Pkg : Xv_Pkg_Ptr;
		       Cmd1  : Integer; Data1 : Interfaces.C.Char_Array;
                       Term  : Integer) return Font;
     pragma import (C,Xv_Find,"xv_find");

     Xv_Font_Pkg : Xv_Pkg_Ptr;
     pragma import (C,Xv_Font_Pkg,"my_xv_font_pkg");
  begin
     V.Base := xv_find(V.Parent,Xv_Font_Pkg,
		       FONT_NAME,Interfaces.C.To_C(V.Font_Name.all,True),0);
  end Initialize;

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

  function Get_Font (V : in Xv_Font) return Font is
  begin
     return V.Base;
  end Get_Font;

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

  procedure Set_Size ( V : in out Xv_Font; Fnt_Size : Positive := 10) is
     function Xv_Set (Owner : Xv_Opaque; Cmd : Integer; 
		      Data  : Integer; Term  : Integer) return Xv_Object;
     pragma import (C,Xv_Set,"xv_set");

     Xv_Rc : Xv_Object;
  begin
     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),FONT_SIZE,Fnt_Size,0);
  end Set_Size;

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

  procedure Set_Style ( V : in out Xv_Font; Style : Font_Style) is
     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");

     Xv_Rc : Xv_Object;
     Chr_Style : String_Ptr;
  begin
     case Style is
	when DEFAULT      =>
	   Chr_Style := new String'("FONT_STYLE_DEFAULT");
	when NORMAL       =>
	   Chr_Style := new String'("FONT_STYLE_NORMAL");
	when BOLD         =>
	   Chr_Style := new String'("FONT_STYLE_BOLD");
	when ITALIC       =>
	   Chr_Style := new String'("FONT_STYLE_ITALIC");
	when OBLIQUE      =>
	   Chr_Style := new String'("FONT_STYLE_OBLIQUE");
	when BOLD_ITALIC  =>
	   Chr_Style := new String'("FONT_STYLE_BOLD_ITALIC");
	when BOLD_OBLIQUE =>
	   Chr_Style := new String'("FONT_STYLE_BOLD_OBLIQUE");
     end case;

     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),FONTY_STYLE,
		     Interfaces.C.To_C(Chr_Style.all,True),0);
  end Set_Style;

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

  procedure Finalize (V : in out Xv_Font) is
     procedure Xv_Destroy_Safe (Object : Xv_Opaque);
     pragma import (C,Xv_Destroy_Safe,"xv_destroy");
  begin
     Xv_Destroy_Safe(Xv_Opaque(V.Base));
  end Finalize;
end Xv_Font_Package;