-----------------------------------------------------------------------
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
--                                                                   --
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
--                Copyright (C) 2000-2001 ACT-Europe                 --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 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 --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU 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.                                       --
--                                                                   --
-----------------------------------------------------------------------

with System;

package body Gdk.GC is

   -------------
   -- Gdk_New --
   -------------

   procedure Gdk_New
     (GC       : out Gdk_GC;
      Drawable : Gdk.Gdk_Drawable)
   is
      function Internal (Drawable : Gdk.Gdk_Drawable) return Gdk_GC;
      pragma Import (C, Internal, "gdk_gc_new");

   begin
      GC := Internal (Drawable);
   end Gdk_New;

   -------------
   -- Gdk_New --
   -------------

   procedure Gdk_New
     (GC          : out Gdk_GC;
      Drawable    : Gdk.Gdk_Drawable;
      Values      : Gdk_GC_Values;
      Values_Mask : Gdk_GC_Values_Mask)
   is
      function Internal
        (Drawable    : Gdk.Gdk_Drawable;
         Values      : Gdk_GC_Values;
         Values_Mask : Gdk_GC_Values_Mask) return Gdk_GC;
      pragma Import (C, Internal, "gdk_gc_new_with_values");

   begin
      GC := Internal (Drawable, Values, Values_Mask);
   end Gdk_New;

   -------------
   -- Gdk_New --
   -------------

   function Gdk_New return Gdk_GC_Values is
      function Internal return Gdk_GC_Values;
      pragma Import (C, Internal, "ada_gdk_gc_new_values");

   begin
      return Internal;
   end Gdk_New;

   --------------------
   -- Set_Background --
   --------------------

   procedure Set_Background
     (GC    : Gdk_GC;
      Color : Gdk.Color.Gdk_Color)
   is
      procedure Internal
        (Gc    : Gdk_GC;
         Color : System.Address);
      pragma Import (C, Internal, "gdk_gc_set_background");
      use type Gdk.Color.Gdk_Color;

      Col : aliased Gdk.Color.Gdk_Color := Color;
      --  Need to use a local variable to avoid problems with 'Address if
      --  the parameter is passed in a register for instance.

   begin
      if Color = Gdk.Color.Null_Color then
         Internal (GC, System.Null_Address);
      else
         Internal (GC, Col'Address);
      end if;
   end Set_Background;

   --------------------
   -- Set_Background --
   --------------------

   procedure Set_Background
     (Values : Gdk_GC_Values;
      Color  : Gdk.Color.Gdk_Color)
   is
      procedure Internal
        (GC    : Gdk_GC_Values;
         Color : System.Address);
      pragma Import (C, Internal, "ada_gdk_gc_set_background");
      use type Gdk.Color.Gdk_Color;

      Col : aliased Gdk.Color.Gdk_Color := Color;
      --  Need to use a local variable to avoid problems with 'Address if
      --  the parameter is passed in a register for instance.

   begin
      if Color = Gdk.Color.Null_Color then
         Internal (Values, System.Null_Address);
      else
         Internal (Values, Col'Address);
      end if;
   end Set_Background;

   ----------------
   -- Set_Dashes --
   ----------------

   procedure Set_Dashes
     (Gc          : Gdk_GC;
      Dash_Offset : Gint;
      Dash_List   : Guchar_Array)
   is
      procedure Internal
        (Gc          : Gdk_GC;
         Dash_Offset : Gint;
         Dash_List   : System.Address;
         N           : Gint);
      pragma Import (C, Internal, "gdk_gc_set_dashes");

   begin
      Internal (Gc, Dash_Offset, Dash_List'Address, Dash_List'Length);
   end Set_Dashes;

   -------------------
   -- Set_Exposures --
   -------------------

   procedure Set_Exposures
     (GC        : Gdk_GC;
      Exposures : Boolean)
   is
      procedure Internal (GC : Gdk_GC; Exposures : Gint);
      pragma Import (C, Internal, "gdk_gc_set_exposures");

   begin
      Internal (GC, Boolean'Pos (Exposures));
   end Set_Exposures;

   procedure Set_Exposures
     (Values    : Gdk_GC_Values;
      Exposures : Boolean)
   is
      procedure Internal (GC : Gdk_GC_Values; Exposures : Gint);
      pragma Import (C, Internal, "ada_gdk_gc_set_exposures");

   begin
      Internal (Values, Boolean'Pos (Exposures));
   end Set_Exposures;

   --------------
   -- Set_Font --
   --------------

   procedure Set_Font
     (GC   : Gdk_GC;
      Font : Gdk.Font.Gdk_Font)
   is
      procedure Internal (Gc : Gdk_GC; Font : Gdk.Font.Gdk_Font);
      pragma Import (C, Internal, "gdk_gc_set_font");

   begin
      Internal (GC, Font);
   end Set_Font;

   procedure Set_Font
     (Values : Gdk_GC_Values;
      Font   : Gdk.Font.Gdk_Font)
   is
      procedure Internal (Gc : Gdk_GC_Values; Font : Gdk.Font.Gdk_Font);
      pragma Import (C, Internal, "ada_gdk_gc_set_font");

   begin
      Internal (Values, Font);
   end Set_Font;

   --------------------
   -- Set_Foreground --
   --------------------

   procedure Set_Foreground
     (GC    : Gdk_GC;
      Color : Gdk.Color.Gdk_Color)
   is
      procedure Internal (Gc : Gdk_GC; Color : System.Address);
      pragma Import (C, Internal, "gdk_gc_set_foreground");
      use type Gdk.Color.Gdk_Color;

      Col : aliased Gdk.Color.Gdk_Color := Color;
      --  Need to use a local variable to avoid problems with 'Address if
      --  the parameter is passed in a register for instance.

   begin
      if Color = Gdk.Color.Null_Color then
         Internal (GC, System.Null_Address);
      else
         Internal (GC, Col'Address);
      end if;
   end Set_Foreground;

   procedure Set_Foreground
     (Values : Gdk_GC_Values;
      Color  : Gdk.Color.Gdk_Color)
   is
      procedure Internal (Gc : Gdk_GC_Values; Color : System.Address);
      pragma Import (C, Internal, "ada_gdk_gc_set_foreground");
      use type Gdk.Color.Gdk_Color;

      Col : aliased Gdk.Color.Gdk_Color := Color;
      --  Need to use a local variable to avoid problems with 'Address if
      --  the parameter is passed in a register for instance.

   begin
      if Color = Gdk.Color.Null_Color then
         Internal (Values, System.Null_Address);
      else
         Internal (Values, Col'Address);
      end if;
   end Set_Foreground;

   ------------------
   -- Set_Function --
   ------------------

   procedure Set_Function (GC : Gdk_GC; Func : Gdk_Function) is
      procedure Internal (GC : Gdk_GC; Func : Gdk_Function);
      pragma Import (C, Internal, "gdk_gc_set_function");

   begin
      Internal (GC, Func);
   end Set_Function;

   procedure Set_Function (Values : Gdk_GC_Values; Func : Gdk_Function) is
      procedure Internal (GC : Gdk_GC_Values; Func : Gdk_Function);
      pragma Import (C, Internal, "ada_gdk_gc_set_function");

   begin
      Internal (Values, Func);
   end Set_Function;

   --------------
   -- Set_Fill --
   --------------

   procedure Set_Fill (Values : Gdk_GC_Values; Fill : Gdk_Fill) is
      procedure Internal (Values : Gdk_GC_Values; Fill : Gdk_Fill);
      pragma Import (C, Internal, "ada_gdk_gc_set_fill");

   begin
      Internal (Values, Fill);
   end Set_Fill;

   procedure Set_Fill (GC : Gdk_GC; Fill : Gdk_Fill) is
      procedure Internal (GC : Gdk_GC; Fill : Gdk_Fill);
      pragma Import (C, Internal, "gdk_gc_set_fill");

   begin
      Internal (GC, Fill);
   end Set_Fill;

   ---------------------
   -- Set_Clip_Origin --
   ---------------------

   procedure Set_Clip_Origin (GC : Gdk_GC; X, Y : Gint) is
      procedure Internal (Gc : Gdk_GC; X, Y : Gint);
      pragma Import (C, Internal, "gdk_gc_set_clip_origin");

   begin
      Internal (GC, X, Y);
   end Set_Clip_Origin;

   procedure Set_Clip_Origin (Values : Gdk_GC_Values; X, Y : Gint) is
      procedure Internal (Values : Gdk_GC_Values; X, Y : Gint);
      pragma Import (C, Internal, "gdk_gc_set_clip_origin");

   begin
      Internal (Values, X, Y);
   end Set_Clip_Origin;

   -------------------------
   -- Set_Line_Attributes --
   -------------------------

   procedure Set_Line_Attributes
     (GC         : Gdk_GC;
      Line_Width : Gint;
      Line_Style : Gdk_Line_Style;
      Cap_Style  : Gdk_Cap_Style;
      Join_Style : Gdk_Join_Style)
   is
      procedure Internal
        (Gc         : Gdk_GC;
         Line_Width : Gint;
         Line_Style : Gdk_Line_Style;
         Cap_Style  : Gdk_Cap_Style;
         Join_Style : Gdk_Join_Style);
      pragma Import (C, Internal, "gdk_gc_set_line_attributes");

   begin
      Internal (GC, Line_Width, Line_Style, Cap_Style, Join_Style);
   end Set_Line_Attributes;

   -------------------------
   -- Set_Line_Attributes --
   -------------------------

   procedure Set_Line_Attributes
     (Values     : Gdk_GC_Values;
      Line_Width : Gint;
      Line_Style : Gdk_Line_Style;
      Cap_Style  : Gdk_Cap_Style;
      Join_Style : Gdk_Join_Style)
   is
      procedure Internal
        (Gc         : Gdk_GC_Values;
         Line_Width : Gint;
         Line_Style : Gdk_Line_Style;
         Cap_Style  : Gdk_Cap_Style;
         Join_Style : Gdk_Join_Style);
      pragma Import (C, Internal, "ada_gdk_gc_set_line_attributes");

   begin
      Internal (Values, Line_Width, Line_Style, Cap_Style, Join_Style);
   end Set_Line_Attributes;

   -------------------
   -- Set_Subwindow --
   -------------------

   procedure Set_Subwindow (GC : Gdk_GC; Mode : Gdk_Subwindow_Mode) is
      procedure Internal (GC : Gdk_GC; Mode : Gdk_Subwindow_Mode);
      pragma Import (C, Internal, "gdk_gc_set_subwindow");

   begin
      Internal (GC, Mode);
   end Set_Subwindow;

   -------------------
   -- Set_Subwindow --
   -------------------

   procedure Set_Subwindow
     (Values : Gdk_GC_Values;
      Mode   : Gdk_Subwindow_Mode)
   is
      procedure Internal (GC : Gdk_GC_Values; Mode : Gdk_Subwindow_Mode);
      pragma Import (C, Internal, "ada_gdk_gc_set_subwindow");

   begin
      Internal (Values, Mode);
   end Set_Subwindow;

   -------------------
   -- Set_Ts_Origin --
   -------------------

   procedure Set_Ts_Origin (GC : Gdk_GC; X, Y : Gint) is
      procedure Internal (GC : Gdk_GC; X, Y : Gint);
      pragma Import (C, Internal, "gdk_gc_set_ts_origin");

   begin
      Internal (GC, X, Y);
   end Set_Ts_Origin;

   procedure Set_Ts_Origin (Values : Gdk_GC_Values; X, Y : Gint) is
      procedure Internal (GC : Gdk_GC_Values; X, Y : Gint);
      pragma Import (C, Internal, "ada_gdk_gc_set_ts_origin");

   begin
      Internal (Values, X, Y);
   end Set_Ts_Origin;

end Gdk.GC;
