/usr/share/ada/adainclude/gtkada/gdk-pixbuf.adb

-----------------------------------------------------------------------
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
--                                                                   --
--                Copyright (C) 2000-2009, AdaCore                   --
--                                                                   --
-- 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 Gdk.Cursor;  use Gdk.Cursor;
with Gdk.Display; use Gdk.Display;
with Glib.Object; use Glib.Object;
with Ada.Unchecked_Deallocation;

package body Gdk.Pixbuf is

   type Proxy_Data is record
      Pixels : Guchar_Array_Access;
      --  Access to the Ada allocated memory used by Gdk_New_From_Data.
      --  Strictly, this is not necessary, as this access could be
      --  built from the Pixels parameter of the destroy callback.
      --  However, it's not possible to easily and portably convert an
      --  Address to an access to unconstrained array.
   end record;
   pragma Convention (C, Proxy_Data);
   --  Closure data attached to a pixbuf created from user data.

   type Proxy_Data_Access is access Proxy_Data;
   pragma Convention (C, Proxy_Data_Access);

   procedure Free is new Ada.Unchecked_Deallocation
     (Object => Proxy_Data, Name => Proxy_Data_Access);

   procedure Destroy_Pixels
     (Pixels : System.Address;
      Data   : Proxy_Data_Access);
   pragma Convention (C, Destroy_Pixels);
   --  Low level, C compatible, callback called when the reference
   --  count of a pixbuf (that was created from user data) reaches 0.

   ---------------
   -- Add_Alpha --
   ---------------

   function Add_Alpha
     (Pixbuf           : Gdk_Pixbuf;
      Substitute_Color : Boolean := False;
      Red              : Guchar := 0;
      Green            : Guchar := 0;
      Blue             : Guchar := 0) return Gdk_Pixbuf
   is
      function Internal
        (Pixbuf           : System.Address;
         Substitute_Color : Gboolean;
         Red              : Guchar;
         Green            : Guchar;
         Blue             : Guchar) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_add_alpha");

   begin
      return Convert
        (Internal
           (Get_Object (Pixbuf),
            Boolean'Pos (Substitute_Color),
            Red,
            Green,
            Blue));
   end Add_Alpha;

   ---------------
   -- Composite --
   ---------------

   procedure Composite
     (Src           : Gdk_Pixbuf;
      Dest          : Gdk_Pixbuf;
      Dest_X        : Gint;
      Dest_Y        : Gint;
      Dest_Width    : Gint;
      Dest_Height   : Gint;
      Offset_X      : Gdouble := 0.0;
      Offset_Y      : Gdouble := 0.0;
      Scale_X       : Gdouble := 1.0;
      Scale_Y       : Gdouble := 1.0;
      Inter_Type    : Gdk_Interp_Type := Interp_Bilinear;
      Overall_Alpha : Alpha_Range := 128)
   is
      procedure Internal
        (Src           : System.Address;
         Dest          : System.Address;
         Dest_X        : Gint;
         Dest_Y        : Gint;
         Dest_Width    : Gint;
         Dest_Height   : Gint;
         Offset_X      : Gdouble := 0.0;
         Offset_Y      : Gdouble := 0.0;
         Scale_X       : Gdouble := 1.0;
         Scale_Y       : Gdouble := 1.0;
         Inter_Type    : Gdk_Interp_Type := Interp_Bilinear;
         Overall_Alpha : Alpha_Range := 128);
      pragma Import (C, Internal, "gdk_pixbuf_composite");

   begin
      Internal
        (Get_Object (Src),
         Get_Object (Dest),
         Dest_X,
         Dest_Y,
         Dest_Width,
         Dest_Height,
         Offset_X,
         Offset_Y,
         Scale_X,
         Scale_Y,
         Inter_Type,
         Overall_Alpha);
   end Composite;

   ---------------------
   -- Composite_Color --
   ---------------------

   procedure Composite_Color
     (Src           : Gdk_Pixbuf;
      Dest          : Gdk_Pixbuf;
      Dest_X        : Gint;
      Dest_Y        : Gint;
      Dest_Width    : Gint;
      Dest_Height   : Gint;
      Offset_X      : Gdouble := 0.0;
      Offset_Y      : Gdouble := 0.0;
      Scale_X       : Gdouble := 1.0;
      Scale_Y       : Gdouble := 1.0;
      Inter_Type    : Gdk_Interp_Type := Interp_Bilinear;
      Overall_Alpha : Alpha_Range := 128;
      Check_X       : Gint := 0;
      Check_Y       : Gint := 0;
      Check_Size    : Gint := 0;
      Color1        : Guint32 := 0;
      Color2        : Guint32 := 0)
   is
      procedure Internal
        (Src           : System.Address;
         Dest          : System.Address;
         Dest_X        : Gint;
         Dest_Y        : Gint;
         Dest_Width    : Gint;
         Dest_Height   : Gint;
         Offset_X      : Gdouble;
         Offset_Y      : Gdouble;
         Scale_X       : Gdouble;
         Scale_Y       : Gdouble;
         Inter_Type    : Gdk_Interp_Type;
         Overall_Alpha : Alpha_Range;
         Check_X       : Gint;
         Check_Y       : Gint;
         Check_Size    : Gint;
         Color1        : Guint32;
         Color2        : Guint32);
      pragma Import (C, Internal, "gdk_pixbuf_composite_color");

   begin
      Internal
        (Get_Object (Src),
         Get_Object (Dest),
         Dest_X,
         Dest_Y,
         Dest_Width,
         Dest_Height,
         Offset_X,
         Offset_Y,
         Scale_X,
         Scale_Y,
         Inter_Type,
         Overall_Alpha,
         Check_X,
         Check_Y,
         Check_Size,
         Color1,
         Color2);
   end Composite_Color;

   ----------------------------
   -- Composite_Color_Simple --
   ----------------------------

   function Composite_Color_Simple
     (Src           : Gdk_Pixbuf;
      Dest_Width    : Gint;
      Dest_Height   : Gint;
      Inter_Type    : Gdk_Interp_Type := Interp_Bilinear;
      Overall_Alpha : Alpha_Range := 128;
      Color1        : Guint32 := 0;
      Color2        : Guint32 := 0) return Gdk_Pixbuf
   is
      function Internal
        (Src           : System.Address;
         Dest_Width    : Gint;
         Dest_Height   : Gint;
         Inter_Type    : Gdk_Interp_Type := Interp_Bilinear;
         Overall_Alpha : Alpha_Range := 128;
         Color1        : Guint32 := 0;
         Color2        : Guint32 := 0) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_composite_color_simple");

   begin
      return Convert
        (Internal
           (Get_Object (Src),
            Dest_Width,
            Dest_Height,
            Inter_Type,
            Overall_Alpha,
            Color1,
            Color2));
   end Composite_Color_Simple;

   -------------
   -- Convert --
   -------------

   function Convert (P : System.Address) return Gdk_Pixbuf is
      use type System.Address;

      Stub : Gdk_Pixbuf_Record;

   begin
      if P = System.Null_Address then
         return null;

      else
         return Gdk_Pixbuf (Get_User_Data (P, Stub));
      end if;
   end Convert;

   ----------
   -- Copy --
   ----------

   function Copy (Pixbuf : Gdk_Pixbuf) return Gdk_Pixbuf is
      function Internal (Pixbuf : System.Address) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_copy");

   begin
      return Convert (Internal (Get_Object (Pixbuf)));
   end Copy;

   ---------------
   -- Copy_Area --
   ---------------

   procedure Copy_Area
     (Src_Pixbuf  : Gdk_Pixbuf;
      Src_X       : Gint;
      Src_Y       : Gint;
      Width       : Gint;
      Height      : Gint;
      Dest_Pixbuf : Gdk_Pixbuf;
      Dest_X      : Gint;
      Dest_Y      : Gint)
   is
      procedure Internal
        (Src_Pixbuf  : System.Address;
         Src_X       : Gint;
         Src_Y       : Gint;
         Width       : Gint;
         Height      : Gint;
         Dest_Pixbuf : System.Address;
         Dest_X      : Gint;
         Dest_Y      : Gint);
      pragma Import (C, Internal, "gdk_pixbuf_copy_area");

   begin
      Internal
        (Get_Object (Src_Pixbuf),
         Src_X,
         Src_Y,
         Width,
         Height,
         Get_Object (Dest_Pixbuf),
         Dest_X,
         Dest_Y);
   end Copy_Area;

   --------------------
   -- Destroy_Pixels --
   --------------------

   procedure Destroy_Pixels
     (Pixels : System.Address;
      Data   : Proxy_Data_Access)
   is
      pragma Unreferenced (Pixels);
      Tmp : Proxy_Data_Access := Data;
   begin
      Free (Data.Pixels);
      Free (Tmp);
   end Destroy_Pixels;

   ----------
   -- Fill --
   ----------

   procedure Fill (Pixbuf : Gdk_Pixbuf; Pixel : Guint32) is
      procedure Internal (Pixbuf : System.Address; Pixel : Guint32);
      pragma Import (C, Internal, "gdk_pixbuf_fill");
   begin
      Internal (Get_Object (Pixbuf), Pixel);
   end Fill;

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

   function Gdk_New
     (Colorspace      : Gdk_Colorspace := Colorspace_RGB;
      Has_Alpha       : Boolean := False;
      Bits_Per_Sample : Gint := 8;
      Width           : Gint;
      Height          : Gint) return Gdk_Pixbuf
   is
      function Internal
        (Colorspace      : Gdk_Colorspace;
         Has_Alpha       : Gboolean;
         Bits_Per_Sample : Gint;
         Width           : Gint;
         Height          : Gint) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_new");

   begin
      return Convert
        (Internal
           (Colorspace,
            Boolean'Pos (Has_Alpha),
            Bits_Per_Sample,
            Width,
            Height));
   end Gdk_New;

   -----------------------
   -- Gdk_New_From_Data --
   -----------------------

   function Gdk_New_From_Data
     (Data              : Guchar_Array_Access;
      Colorspace        : Gdk_Colorspace := Colorspace_RGB;
      Has_Alpha         : Boolean := False;
      Bits_Per_Sample   : Gint := 8;
      Width             : Gint;
      Height            : Gint;
      Rowstride         : Gint;
      Auto_Destroy_Data : Boolean := True) return Gdk_Pixbuf
   is
      function Internal
        (Data            : System.Address;
         Colorspace      : Gdk_Colorspace;
         Has_Alpha       : Gboolean;
         Bits_Per_Sample : Gint;
         Width           : Gint;
         Height          : Gint;
         Row_Stride      : Gint;
         Destroy_Fn      : System.Address;
         Destroy_Fn_Data : Proxy_Data_Access) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_new_from_data");

   begin
      if Auto_Destroy_Data then
         return Convert
           (Internal
              (Data.all'Address,
               Colorspace,
               Boolean'Pos (Has_Alpha),
               Bits_Per_Sample,
               Width,
               Height,
               Rowstride,
               Destroy_Pixels'Address,
               new Proxy_Data'(Pixels => Data)));

      else
         return Convert
           (Internal
              (Data.all'Address,
               Colorspace,
               Boolean'Pos (Has_Alpha),
               Bits_Per_Sample,
               Width,
               Height,
               Rowstride,
               System.Null_Address,
               null));
      end if;
   end Gdk_New_From_Data;

   -----------------------
   -- Gdk_New_From_File --
   -----------------------

   procedure Gdk_New_From_File
     (Pixbuf   : out Gdk_Pixbuf;
      Filename : String;
      Error    : out GError)
   is
      function Internal
        (Filename : String;
         Error    : access GError) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_new_from_file");

      Err : aliased GError;

   begin
      Pixbuf := Convert (Internal (Filename & ASCII.NUL, Err'Access));
      Error := Err;
   end Gdk_New_From_File;

   -----------------------
   -- Gdk_New_From_File --
   -----------------------

   procedure Gdk_New_From_File
     (Animation : out Gdk_Pixbuf_Animation;
      Filename  : String;
      Error     : out GError)
   is
      function Internal
        (Filename : String;
         Error    : access GError) return Gdk_Pixbuf_Animation;
      pragma Import (C, Internal, "gdk_pixbuf_animation_new_from_file");

      Err : aliased GError;

   begin
      Animation := Internal (Filename & ASCII.NUL, Err'Access);
      Error := Err;
   end Gdk_New_From_File;

   ---------------------------
   -- Gdk_New_From_Xpm_Data --
   ---------------------------

   function Gdk_New_From_Xpm_Data
     (Data : Interfaces.C.Strings.chars_ptr_array) return Gdk_Pixbuf
   is
      function Internal
        (Data : Interfaces.C.Strings.chars_ptr_array) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_new_from_xpm_data");

   begin
      return Convert (Internal (Data));
   end Gdk_New_From_Xpm_Data;

   -----------------------
   -- Gdk_New_Subpixbuf --
   -----------------------

   function Gdk_New_Subpixbuf
     (Src_Pixbuf : Gdk_Pixbuf;
      Src_X      : Gint;
      Src_Y      : Gint;
      Width      : Gint;
      Height     : Gint) return Gdk_Pixbuf
   is
      function Internal
        (Src_Pixbuf : System.Address;
         Src_X      : Gint;
         Src_Y      : Gint;
         Width      : Gint;
         Height     : Gint) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_new_subpixbuf");

   begin
      return Convert
        (Internal (Get_Object (Src_Pixbuf), Src_X, Src_Y, Width, Height));
   end Gdk_New_Subpixbuf;

   -------------------------
   -- Get_Bits_Per_Sample --
   -------------------------

   function Get_Bits_Per_Sample (Pixbuf : Gdk_Pixbuf) return Gint is
      function Internal (Pixbuf : System.Address) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_get_bits_per_sample");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_Bits_Per_Sample;

   --------------------
   -- Get_Colorspace --
   --------------------

   function Get_Colorspace (Pixbuf : Gdk_Pixbuf) return Gdk_Colorspace is
      function Internal (Pixbuf : System.Address) return Gdk_Colorspace;
      pragma Import (C, Internal, "gdk_pixbuf_get_colorspace");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_Colorspace;

   -----------------------
   -- Get_From_Drawable --
   -----------------------

   function Get_From_Drawable
     (Dest   : Gdk_Pixbuf;
      Src    : Gdk.Drawable.Gdk_Drawable;
      Cmap   : Gdk.Color.Gdk_Colormap;
      Src_X  : Gint;
      Src_Y  : Gint;
      Dest_X : Gint;
      Dest_Y : Gint;
      Width  : Gint;
      Height : Gint) return Gdk_Pixbuf
   is
      function Internal
        (Dest   : System.Address;
         Src    : Gdk.Drawable.Gdk_Drawable;
         Cmap   : Gdk.Color.Gdk_Colormap;
         Src_X  : Gint;
         Src_Y  : Gint;
         Dest_X : Gint;
         Dest_Y : Gint;
         Width  : Gint;
         Height : Gint) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_get_from_drawable");

   begin
      if Dest = null then
         return Convert
           (Internal
              (System.Null_Address,
               Src,
               Cmap,
               Src_X,
               Src_Y,
               Dest_X,
               Dest_Y,
               Width,
               Height));

      else
         return Convert
           (Internal
              (Get_Object (Dest),
               Src,
               Cmap,
               Src_X,
               Src_Y,
               Dest_X,
               Dest_Y,
               Width,
               Height));
      end if;
   end Get_From_Drawable;

   -------------------
   -- Get_Has_Alpha --
   -------------------

   function Get_Has_Alpha (Pixbuf : Gdk_Pixbuf) return Boolean is
      function Internal (Pixbuf : System.Address) return Gboolean;
      pragma Import (C, Internal, "gdk_pixbuf_get_has_alpha");

   begin
      return Internal (Get_Object (Pixbuf)) /= 0;
   end Get_Has_Alpha;

   ----------------
   -- Get_Height --
   ----------------

   function Get_Height (Pixbuf : Gdk_Pixbuf) return Gint is
      function Internal (Pixbuf : System.Address) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_get_height");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_Height;

   ----------------
   -- Get_Height --
   ----------------

   function Get_Height (Animation : Gdk_Pixbuf_Animation) return Gint is
      function Internal (Animation : Gdk_Pixbuf_Animation) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_animation_get_height");

   begin
      return Internal (Animation);
   end Get_Height;

   ---------------
   -- Get_Image --
   ---------------

   function Get_Image (Cursor : Gdk.Cursor.Gdk_Cursor) return Gdk_Pixbuf is
      function Internal (Cursor : Gdk.Cursor.Gdk_Cursor) return System.Address;
      pragma Import (C, Internal, "gdk_cursor_get_image");

   begin
      return Convert (Internal (Cursor));
   end Get_Image;

   --------------------
   -- Get_N_Channels --
   --------------------

   function Get_N_Channels (Pixbuf : Gdk_Pixbuf) return Gint is
      function Internal (Pixbuf : System.Address) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_get_n_channels");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_N_Channels;

   ----------------
   -- Get_Pixbuf --
   ----------------

   function Get_Pixbuf (Iter : Gdk_Pixbuf_Animation_Iter) return Gdk_Pixbuf is
      function Internal
        (Iter : Gdk_Pixbuf_Animation_Iter) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_animation_iter_get_pixbuf");

   begin
      return Convert (Internal (Iter));
   end Get_Pixbuf;

   ----------------
   -- Get_Pixels --
   ----------------

   function Get_Pixels
     (Pixbuf : Gdk_Pixbuf) return Gdk.Rgb.Rgb_Buffer_Access
   is
      function Internal
        (Pixbuf : System.Address) return Gdk.Rgb.Rgb_Buffer_Access;
      pragma Import (C, Internal, "gdk_pixbuf_get_pixels");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_Pixels;

   -------------------
   -- Get_Rowstride --
   -------------------

   function Get_Rowstride (Pixbuf : Gdk_Pixbuf) return Gint is
      function Internal (Pixbuf : System.Address) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_get_rowstride");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_Rowstride;

   ----------------------
   -- Get_Static_Image --
   ----------------------

   function Get_Static_Image
     (Animation : Gdk_Pixbuf_Animation) return Gdk_Pixbuf
   is
      function Internal
        (Animation : Gdk_Pixbuf_Animation) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_animation_get_static_image");

   begin
      return Convert (Internal (Animation));
   end Get_Static_Image;

   ---------------
   -- Get_Width --
   ---------------

   function Get_Width (Pixbuf : Gdk_Pixbuf) return Gint is
      function Internal (Pixbuf : System.Address) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_get_width");

   begin
      return Internal (Get_Object (Pixbuf));
   end Get_Width;

   ---------------
   -- Get_Width --
   ---------------

   function Get_Width (Animation : Gdk_Pixbuf_Animation) return Gint is
      function Internal (Animation : Gdk_Pixbuf_Animation) return Gint;
      pragma Import (C, Internal, "gdk_pixbuf_animation_get_width");

   begin
      return Internal (Animation);
   end Get_Width;

   ---------
   -- Ref --
   ---------

   procedure Ref (Animation : Gdk_Pixbuf_Animation) is
      procedure Internal (Pixbuf : Gdk_Pixbuf_Animation);
      pragma Import (C, Internal, "gdk_pixbuf_animation_ref");

   begin
      Internal (Animation);
   end Ref;

   procedure Ref (Iter : Gdk_Pixbuf_Animation_Iter) is
      procedure Internal (Iter : Gdk_Pixbuf_Animation_Iter);
      pragma Import (C, Internal, "g_object_ref");

   begin
      Internal (Iter);
   end Ref;

   ----------------------------
   -- Render_Pixmap_And_Mask --
   ----------------------------

   procedure Render_Pixmap_And_Mask
     (Pixbuf          : Gdk_Pixbuf;
      Pixmap          : out Gdk.Pixmap.Gdk_Pixmap;
      Mask            : out Gdk.Bitmap.Gdk_Bitmap;
      Alpha_Threshold : Alpha_Range)
   is
      procedure Internal
        (Pixbuf          : System.Address;
         Pixmap          : out Gdk.Pixmap.Gdk_Pixmap;
         Mask            : out Gdk.Bitmap.Gdk_Bitmap;
         Alpha_Threshold : Alpha_Range);
      pragma Import (C, Internal, "gdk_pixbuf_render_pixmap_and_mask");

   begin
      Internal (Get_Object (Pixbuf), Pixmap, Mask, Alpha_Threshold);
   end Render_Pixmap_And_Mask;

   -----------------------------------------
   -- Render_Pixmap_And_Mask_For_Colormap --
   -----------------------------------------

   procedure Render_Pixmap_And_Mask_For_Colormap
     (Pixbuf          : Gdk_Pixbuf;
      Colormap        : Gdk.Color.Gdk_Colormap;
      Pixmap          : out Gdk.Pixmap.Gdk_Pixmap;
      Mask            : out Gdk.Bitmap.Gdk_Bitmap;
      Alpha_Threshold : Alpha_Range)
   is
      procedure Internal
        (Pixbuf          : System.Address;
         Colormap        : Gdk.Color.Gdk_Colormap;
         Pixmap          : out Gdk.Pixmap.Gdk_Pixmap;
         Mask            : out Gdk.Bitmap.Gdk_Bitmap;
         Alpha_Threshold : Alpha_Range);
      pragma Import
        (C, Internal, "gdk_pixbuf_render_pixmap_and_mask_for_colormap");

   begin
      Internal (Get_Object (Pixbuf), Colormap, Pixmap, Mask, Alpha_Threshold);
   end Render_Pixmap_And_Mask_For_Colormap;

   ----------------------------
   -- Render_Threshold_Alpha --
   ----------------------------

   procedure Render_Threshold_Alpha
     (Pixbuf          : Gdk_Pixbuf;
      Bitmap          : Gdk.Bitmap.Gdk_Bitmap;
      Src_X           : Gint;
      Src_Y           : Gint;
      Dest_X          : Gint;
      Dest_Y          : Gint;
      Width           : Gint;
      Height          : Gint;
      Alpha_Threshold : Alpha_Range)
   is
      procedure Internal
        (Pixbuf          : System.Address;
         Bitmap          : Gdk.Bitmap.Gdk_Bitmap;
         Src_X           : Gint;
         Src_Y           : Gint;
         Dest_X          : Gint;
         Dest_Y          : Gint;
         Width           : Gint;
         Height          : Gint;
         Alpha_Threshold : Alpha_Range);
      pragma Import (C, Internal, "gdk_pixbuf_render_threshold_alpha");

   begin
      Internal
        (Get_Object (Pixbuf),
         Bitmap,
         Src_X,
         Src_Y,
         Dest_X,
         Dest_Y,
         Width,
         Height,
         Alpha_Threshold);
   end Render_Threshold_Alpha;

   ------------------------
   -- Render_To_Drawable --
   ------------------------

   procedure Render_To_Drawable
     (Pixbuf   : Gdk_Pixbuf;
      Drawable : Gdk.Drawable.Gdk_Drawable;
      GC       : Gdk.GC.Gdk_GC;
      Src_X    : Gint;
      Src_Y    : Gint;
      Dest_X   : Gint;
      Dest_Y   : Gint;
      Width    : Gint;
      Height   : Gint;
      Dither   : Gdk.Rgb.Gdk_Rgb_Dither := Gdk.Rgb.Dither_Normal;
      X_Dither : Gint := 0;
      Y_Dither : Gint := 0)
   is
      procedure Internal
        (Pixbuf   : System.Address;
         Drawable : Gdk.Drawable.Gdk_Drawable;
         GC       : Gdk.GC.Gdk_GC;
         Src_X    : Gint;
         Src_Y    : Gint;
         Dest_X   : Gint;
         Dest_Y   : Gint;
         Width    : Gint;
         Height   : Gint;
         Dither   : Gdk.Rgb.Gdk_Rgb_Dither;
         X_Dither : Gint;
         Y_Dither : Gint);
      pragma Import (C, Internal, "gdk_pixbuf_render_to_drawable");

   begin
      Internal
        (Get_Object (Pixbuf),
         Drawable,
         GC,
         Src_X,
         Src_Y,
         Dest_X,
         Dest_Y,
         Width,
         Height,
         Dither,
         X_Dither,
         Y_Dither);
   end Render_To_Drawable;

   ------------------------------
   -- Render_To_Drawable_Alpha --
   ------------------------------

   procedure Render_To_Drawable_Alpha
     (Pixbuf          : Gdk_Pixbuf;
      Drawable        : Gdk.Drawable.Gdk_Drawable;
      Src_X           : Gint;
      Src_Y           : Gint;
      Dest_X          : Gint;
      Dest_Y          : Gint;
      Width           : Gint;
      Height          : Gint;
      Alpha           : Alpha_Mode;
      Alpha_Threshold : Alpha_Range;
      Dither          : Gdk.Rgb.Gdk_Rgb_Dither := Gdk.Rgb.Dither_Normal;
      X_Dither        : Gint := 0;
      Y_Dither        : Gint := 0)
   is
      procedure Internal
        (Pixbuf          : System.Address;
         Drawable        : Gdk.Drawable.Gdk_Drawable;
         Src_X           : Gint;
         Src_Y           : Gint;
         Dest_X          : Gint;
         Dest_Y          : Gint;
         Width           : Gint;
         Height          : Gint;
         Alpha           : Alpha_Mode;
         Alpha_Threshold : Alpha_Range;
         Dither          : Gdk.Rgb.Gdk_Rgb_Dither;
         X_Dither        : Gint;
         Y_Dither        : Gint);
      pragma Import (C, Internal, "gdk_pixbuf_render_to_drawable_alpha");

   begin
      Internal
        (Get_Object (Pixbuf),
         Drawable,
         Src_X,
         Src_Y,
         Dest_X,
         Dest_Y,
         Width,
         Height,
         Alpha,
         Alpha_Threshold,
         Dither,
         X_Dither,
         Y_Dither);
   end Render_To_Drawable_Alpha;

   ---------------------------
   -- Saturate_And_Pixelate --
   ---------------------------

   procedure Saturate_And_Pixelate
     (Src        : Gdk_Pixbuf;
      Dest       : Gdk_Pixbuf;
      Saturation : Gfloat;
      Pixelate   : Boolean := True)
   is
      procedure Internal
        (Src        : System.Address;
         Dest       : System.Address;
         Saturation : Gfloat;
         Pixelate   : Gboolean);
      pragma Import (C, Internal, "gdk_pixbuf_saturate_and_pixelate");

   begin
      Internal
        (Get_Object (Src),
         Get_Object (Dest),
         Saturation,
         Boolean'Pos (Pixelate));
   end Saturate_And_Pixelate;

   ----------
   -- Save --
   ----------

   procedure Save
     (Pixbuf   : Gdk_Pixbuf;
      Filename : String;
      Format   : File_Format;
      Error    : out GError;
      Quality  : Image_Quality := Image_Quality'Last;
      Depth    : Integer := 32)
   is
      procedure Internal
        (Pixbuf   : System.Address;
         Filename : String;
         Format   : String;
         Error    : out GError;
         Term     : System.Address := System.Null_Address);

      procedure Internal
        (Pixbuf   : System.Address;
         Filename : String;
         Format   : String;
         Error    : out GError;
         Key      : String;
         Value    : String);
      pragma Import (C, Internal, "ada_gdk_pixbuf_save");

   begin
      Error := null;

      case Format is
         when JPEG =>
            Internal
              (Get_Object (Pixbuf),
               Filename & ASCII.NUL,
               "jpeg" & ASCII.NUL,
               Error,
               "quality" & ASCII.NUL,
               Image_Quality'Image (Quality) & ASCII.NUL);

         when PNG =>
            Internal
              (Get_Object (Pixbuf),
               Filename & ASCII.NUL,
               "png" & ASCII.NUL,
               Error);

         when ICO =>
            Internal
              (Get_Object (Pixbuf),
               Filename & ASCII.NUL,
               "ico" & ASCII.NUL,
               Error,
               "depth" & ASCII.NUL,
               Integer'Image (Depth));

         when BMP =>
            Internal
              (Get_Object (Pixbuf),
               Filename & ASCII.NUL,
               "bmp" & ASCII.NUL,
               Error);
      end case;
   end Save;

   -----------
   -- Scale --
   -----------

   procedure Scale
     (Src          : Gdk_Pixbuf;
      Dest         : Gdk_Pixbuf;
      Dest_X       : Gint;
      Dest_Y       : Gint;
      Dest_Width   : Gint;
      Dest_Height  : Gint;
      Offset_X     : Gdouble := 0.0;
      Offset_Y     : Gdouble := 0.0;
      Scale_X      : Gdouble := 1.0;
      Scale_Y      : Gdouble := 1.0;
      Inter_Type   : Gdk_Interp_Type := Interp_Bilinear)
   is
      procedure Internal
        (Src          : System.Address;
         Dest         : System.Address;
         Dest_X       : Gint;
         Dest_Y       : Gint;
         Dest_Width   : Gint;
         Dest_Height  : Gint;
         Offset_X     : Gdouble := 0.0;
         Offset_Y     : Gdouble := 0.0;
         Scale_X      : Gdouble := 1.0;
         Scale_Y      : Gdouble := 1.0;
         Inter_Type   : Gdk_Interp_Type);
      pragma Import (C, Internal, "gdk_pixbuf_scale");

   begin
      Internal
        (Get_Object (Src),
         Get_Object (Dest),
         Dest_X,
         Dest_Y,
         Dest_Width,
         Dest_Height,
         Offset_X,
         Offset_Y,
         Scale_X,
         Scale_Y,
         Inter_Type);
   end Scale;

   ------------------
   -- Scale_Simple --
   ------------------

   function Scale_Simple
     (Src           : Gdk_Pixbuf;
      Dest_Width    : Gint;
      Dest_Height   : Gint;
      Inter_Type    : Gdk_Interp_Type := Interp_Bilinear) return Gdk_Pixbuf
   is
      function Internal
        (Src           : System.Address;
         Dest_Width    : Gint;
         Dest_Height   : Gint;
         Inter_Type    : Gdk_Interp_Type) return System.Address;
      pragma Import (C, Internal, "gdk_pixbuf_scale_simple");

   begin
      return Convert
        (Internal (Get_Object (Src), Dest_Width, Dest_Height, Inter_Type));
   end Scale_Simple;

   -----------
   -- Unref --
   -----------

   procedure Unref (Animation : Gdk_Pixbuf_Animation) is
      procedure Internal (Pixbuf : Gdk_Pixbuf_Animation);
      pragma Import (C, Internal, "gdk_pixbuf_animation_unref");

   begin
      Internal (Animation);
   end Unref;

   procedure Unref (Iter : Gdk_Pixbuf_Animation_Iter) is
      procedure Internal (Iter : Gdk_Pixbuf_Animation_Iter);
      pragma Import (C, Internal, "g_object_unref");

   begin
      Internal (Iter);
   end Unref;

   ---------------------
   -- Is_Static_Image --
   ---------------------

   function Is_Static_Image
     (Animation : Gdk_Pixbuf_Animation) return Boolean
   is
      function Internal (Animation : Gdk_Pixbuf_Animation) return Gboolean;
      pragma Import (C, Internal, "gdk_pixbuf_animation_is_static_image");

   begin
      return Internal (Animation) /= 0;
   end Is_Static_Image;

   --------------------------------
   -- On_Currently_Loading_Frame --
   --------------------------------

   function On_Currently_Loading_Frame
     (Iter : Gdk_Pixbuf_Animation_Iter) return Boolean
   is
      function Internal
        (Animation : Gdk_Pixbuf_Animation_Iter) return Gboolean;
      pragma Import
        (C, Internal, "gdk_pixbuf_animation_iter_on_currently_loading_frame");

   begin
      return Internal (Iter) /= 0;
   end On_Currently_Loading_Frame;

   -------------
   -- Advance --
   -------------

   function Advance
     (Iter          : Gdk_Pixbuf_Animation_Iter;
      Current_Timer : GTime_Val_Access := null) return Boolean
   is
      function Internal
        (Iter          : Gdk_Pixbuf_Animation_Iter;
         Current_Timer : GTime_Val_Access) return Gboolean;
      pragma Import (C, Internal, "gdk_pixbuf_animation_iter_advance");

   begin
      return Internal (Iter, Current_Timer) /= 0;
   end Advance;

   -------------------------
   -- Gdk_New_From_Pixbuf --
   -------------------------

   procedure Gdk_New_From_Pixbuf
     (Cursor  : out Gdk.Cursor.Gdk_Cursor;
      Display : Gdk.Display.Gdk_Display := Gdk.Display.Get_Default;
      Pixbuf  : Gdk_Pixbuf;
      X       : Glib.Gint;
      Y       : Glib.Gint)
   is
      function Internal
        (D : System.Address; P : System.Address; X, Y : Gint)
         return Gdk_Cursor;
      pragma Import (C, Internal, "gdk_cursor_new_from_pixbuf");

   begin
      Cursor := Internal (Get_Object (Display), Get_Object (Pixbuf), X, Y);
   end Gdk_New_From_Pixbuf;

end Gdk.Pixbuf;
libgtkada2.24.1-dev 2.24.1-2 / usr / share / ada / adainclude / gtkada / gdk-pixbuf.adb
