-----------------------------------------------------------------------
--          GtkAda - Ada95 binding for the Gimp Toolkit              --
--                                                                   --
--                     Copyright (C) 1998-1999                       --
--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
--                     Copyright (C) 2003-2006 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 Glib;             use Glib;
with Glib.Error;       use Glib.Error;
with Glib.Main;        use Glib.Main;
with Gdk.Event;        use Gdk.Event;
with Gdk.Rectangle;    use Gdk.Rectangle;
with Gdk.Pixbuf;       use Gdk.Pixbuf;
with Gdk.Rgb;          use Gdk.Rgb;
with Gtk.Drawing_Area; use Gtk.Drawing_Area;
with Gtk.Frame;        use Gtk.Frame;
with Gtk.Image;        use Gtk.Image;
with Gtk.Label;        use Gtk.Label;
with Gtk.Style;        use Gtk.Style;
with Gtk.Widget;       use Gtk.Widget;
with Gtkada.Handlers;  use Gtkada.Handlers;

with Ada.Numerics.Generic_Elementary_Functions;

package body Create_Pixbuf is

   package Gdouble_Functions is new
     Ada.Numerics.Generic_Elementary_Functions (Gdouble);
   use Gdouble_Functions;

   type String_Access is access String;
   type String_Array is array (Positive range <>) of String_Access;

   type Pixbuf_Array is array (Positive range <>) of Gdk_Pixbuf;

   Image_Names : constant String_Array :=
     (1 => new String'("apple-red.png"),
      2 => new String'("gnome-applets.png"),
      3 => new String'("gnome-calendar.png"),
      4 => new String'("gnome-foot.png"),
      5 => new String'("gnome-gmush.png"),
      6 => new String'("gnome-gimp.png"),
      7 => new String'("gnome-gsame.png"),
      8 => new String'("gnu-keys.png"));

   Background_Name : constant String := "background.jpg";
   Gif_Image       : constant String := "dancing-penguin.gif";

   Frame_Delay : constant Guint := 40;
   Cycle_Len   : constant := 40;

   Frame : Gdk_Pixbuf;
   Frame_Num : Gint;
   --  The current frame

   Background : Gdk_Pixbuf;
   Back_Width, Back_Height : Gint;
   --  The background image and its size

   Da : Gtk_Drawing_Area;

   Timeout_Id : G_Source_Id := 0;

   Images : Pixbuf_Array (Image_Names'Range);

   function Load_Pixbufs return Boolean;
   --  Load the images for the demo.
   --  Return False if one of the pixmaps could not be loaded

   function Expose_Cb
     (Widget : access Gtk_Widget_Record'Class;
      Event  : Gdk_Event) return Boolean;
   --  Expose callback for the drawing area

   function Timeout_Handler return Boolean;
   --  Timeout handler to regenerate the frame

   procedure Destroy_Cb (Widget : access Gtk_Widget_Record'Class);
   --  Callback when the widget is destroyed

   ------------------
   -- Load_Pixbufs --
   ------------------

   function Load_Pixbufs return Boolean is
      Error : Glib.Error.GError;
   begin
      Gdk_New_From_File (Background, Background_Name, Error);

      if Background = null then
         return False;
      end if;

      Back_Width  := Get_Width (Background);
      Back_Height := Get_Height (Background);

      for J in Images'Range loop
         Gdk_New_From_File (Images (J), Image_Names (J).all, Error);
         if Images (J) = null then
            return False;
         end if;
      end loop;
      return True;
   end Load_Pixbufs;

   ---------------
   -- Expose_Cb --
   ---------------

   function Expose_Cb
     (Widget : access Gtk_Widget_Record'Class;
      Event  : Gdk_Event) return Boolean
   is
      --  Num_Bytes_Per_Pixel : constant := 3;
      --  Number of bytes for each pixel (Red, Green, Blue)

      Rowstride : constant Gint := Get_Rowstride (Frame);
      Pixels    : constant Rgb_Buffer_Access := Get_Pixels (Frame);
      X         : constant Gint := Get_Area (Event).X;
      Y         : constant Gint := Get_Area (Event).Y;
      W         : Gint := Gint (Get_Area (Event).Width);
      H         : Gint := Gint (Get_Area (Event).Height);

   begin
      --  The following tests handle the cases where we try to redraw the area
      --  outside of the background image.
      if X + W > Back_Width then
         W := Back_Width - X;
      end if;

      if Y + H > Back_Height then
         H := Back_Height - Y;
      end if;

      if W <= 0 or else H <= 0 then
         return True;
      end if;

      Draw_Rgb_Image_Dithalign
        (Drawable  => Get_Window (Widget),
         GC        => Get_Black_GC (Get_Style (Widget)),
         X         => X,
         Y         => Y,
         Width     => W,
         Height    => H,
         Dith      => Dither_Normal,
         Rgb_Buf   => Pixels.all,
         Rowstride => Rowstride,
         Xdith     => X,
         Ydith     => Y);
      return True;
   end Expose_Cb;

   ---------------------
   -- Timeout_Handler --
   ---------------------

   function Timeout_Handler return Boolean is
      Pi : constant Gdouble := 3.1415926535;
      F, Xmid, Ymid, Radius : Gdouble;
      Ang, Iw, Ih, R, K, C, S : Gdouble;
      Xpos, Ypos : Gdouble;
      R1, R2, Dest : Gdk_Rectangle;
      Inter : Boolean;
      Alpha : Gint;
   begin
      --  Restore the background
      Copy_Area
        (Src_Pixbuf  => Background,
         Src_X       => 0,
         Src_Y       => 0,
         Width       => Back_Width,
         Height      => Back_Height,
         Dest_Pixbuf => Frame,
         Dest_X      => 0,
         Dest_Y      => 0);

      R2 := (X      => 0,
             Y      => 0,
             Width  => Back_Width,
             Height => Back_Height);

      F      := Gdouble (Frame_Num mod Cycle_Len) / Gdouble (Cycle_Len);
      Xmid   := Gdouble (Back_Width) * 0.5;
      Ymid   := Gdouble (Back_Height) * 0.5;
      Radius := Gdouble'Min (Xmid, Ymid) * 0.5;
      S      := Sin (F * 2.0 * Pi);
      C      := Cos (F * 2.0 * Pi);
      R      := Radius + Radius / 3.0 * S;

      --  Then draw each of the images

      for J in Images'Range loop
         Ang  := 2.0 * Pi * (Gdouble (J) / Gdouble (Images'Length) - F);
         Iw   := Gdouble (Get_Width (Images (J)));
         Ih   := Gdouble (Get_Height (Images (J)));
         Xpos := Xmid + R * Cos (Ang) - Iw * 0.5 + 0.5;
         Ypos := Ymid + R * Sin (Ang) - Ih * 0.5 + 0.5;

         if J mod 2 = 1 then
            K := S;
         else
            K := C;
         end if;
         K := Gdouble'Max (0.25, 2.0 * K * K);

         R1 := (X      => Gint (Xpos),
                Y      => Gint (Ypos),
                Width  => Gint (Iw * K),
                Height => Gint (Ih * K));

         Intersect (R1, R2, Dest, Inter);
         if Inter then
            --  Play with the transparency, so that the animation is smoother
            if J mod 2 = 1 then
               Alpha := Gint'Max (50, abs (Gint (255.0 * S)));
            else
               Alpha := Gint'Max (50, abs (Gint (255.0 * C)));
            end if;

            Composite
              (Src           => Images (J),
               Dest          => Frame,
               Dest_X        => Dest.X,
               Dest_Y        => Dest.Y,
               Dest_Width    => Dest.Width,
               Dest_Height   => Dest.Height,
               Offset_X      => Xpos,
               Offset_Y      => Ypos,
               Scale_X       => K,
               Scale_Y       => K,
               Inter_Type    => Interp_Nearest,
               Overall_Alpha => Alpha_Range (Alpha));
         end if;
      end loop;

      Queue_Draw (Da);

      Frame_Num := Frame_Num + 1;
      return True;
   end Timeout_Handler;

   ----------------
   -- Destroy_Cb --
   ----------------

   procedure Destroy_Cb (Widget : access Gtk_Widget_Record'Class) is
      pragma Warnings (Off, Widget);
   begin
      Remove (Timeout_Id);
      Timeout_Id := 0;
   end Destroy_Cb;

   ---------
   -- Run --
   ---------

   procedure Run (F : access Gtk_Frame_Record'Class) is
      Label : Gtk_Label;
   begin
      if not Load_Pixbufs then
         Gtk_New (Label, "Images not found");
         Add (F, Label);
         return;
      end if;

      Gtk_New (Da);
      Add (F, Da);

      Frame := Gdk.Pixbuf.Gdk_New
        (Colorspace      => Colorspace_RGB,
         Has_Alpha       => False,
         Bits_Per_Sample => 8,
         Width           => Back_Width,
         Height          => Back_Height);

      Widget_Callback.Connect
        (Da, "destroy", Widget_Callback.To_Marshaller (Destroy_Cb'Access));
      Return_Callback.Connect
        (Da, "expose_event", Return_Callback.To_Marshaller (Expose_Cb'Access));

      Timeout_Id := Timeout_Add (Frame_Delay, Timeout_Handler'Access);

      Show_All (F);
   end Run;

   ----------
   -- Help --
   ----------

   function Help return String is
   begin
      return "This demo shows how one can animate several images on the"
        & " screen. All the images are loaded from the disk (and thus you"
        & " should start testgtk from the directory that contains the images."
        & ASCII.LF
        & "Note that nothing is precomputed in this demo, and all the drawing,"
        & " scaling and transparency is done in real-time."
        & ASCII.LF
        & "This demo uses some timeout callback to do the animation. It is"
        & " on several @bGdk_Pixbuf@B images.";
   end Help;

   ---------
   -- Run --
   ---------

   procedure Run_Gif (F : access Gtk_Frame_Record'Class) is
      Image : Gtk_Image;
   begin
      Gtk_New (Image, Filename => Gif_Image);
      Add (F, Image);
      Show_All (F);
   end Run_Gif;

   --------------
   -- Help_Gif --
   --------------

   function Help_Gif return String is
   begin
      return "This file show how a @bGtk_Image@B can be used to display"
        & " an animated GIF image. The whole code for this demo is only"
        & " three lines in Ada!"
        & ASCII.LF
        & "This demo must be run from the testgtk directory itself so that"
        & " the image can be loaded from the disk.";
   end Help_Gif;

end Create_Pixbuf;
