[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [25] trunk

[<bec...@us...>]

Revision: 25
          http://svn.sourceforge.net/gtkada-wrapper/?rev=25&view=rev
Author:   bechir_zalila
Date:     2006-12-01 11:43:10 -0800 (Fri, 01 Dec 2006)

Log Message:
-----------
	* Implemented image insertion and added an example to test it

Modified Paths:
--------------
    trunk/TODO
    trunk/configure.ac
    trunk/examples/Makefile.am
    trunk/src/gtkada_wrapper.adb
    trunk/src/gtkada_wrapper.ads

Added Paths:
-----------
    trunk/examples/image/
    trunk/examples/image/Kubuntu-edgy.png
    trunk/examples/image/Makefile.am
    trunk/examples/image/image.adb
    trunk/examples/image/image.gpr

Modified: trunk/TODO
===================================================================
--- trunk/TODO	2006-11-30 20:53:52 UTC (rev 24)
+++ trunk/TODO	2006-12-01 19:43:10 UTC (rev 25)
@@ -1,5 +1,4 @@
 /src:
-	* Implement image insertion
 	* Implement Text area
 
 /doc:

Modified: trunk/configure.ac
===================================================================
--- trunk/configure.ac	2006-11-30 20:53:52 UTC (rev 24)
+++ trunk/configure.ac	2006-12-01 19:43:10 UTC (rev 25)
@@ -89,6 +89,7 @@
 	examples/empty_window/Makefile
 	examples/basic_drawings/Makefile
 	examples/fractal/Makefile
+	examples/image/Makefile
 	src/Makefile
 ])
 

Modified: trunk/examples/Makefile.am
===================================================================
--- trunk/examples/Makefile.am	2006-11-30 20:53:52 UTC (rev 24)
+++ trunk/examples/Makefile.am	2006-12-01 19:43:10 UTC (rev 25)
@@ -1 +1 @@
-SUBDIRS = empty_window basic_drawings fractal
+SUBDIRS = empty_window basic_drawings fractal image

Added: trunk/examples/image/Kubuntu-edgy.png
===================================================================
(Binary files differ)


Property changes on: trunk/examples/image/Kubuntu-edgy.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: trunk/examples/image/Makefile.am
===================================================================
--- trunk/examples/image/Makefile.am	                        (rev 0)
+++ trunk/examples/image/Makefile.am	2006-12-01 19:43:10 UTC (rev 25)
@@ -0,0 +1,5 @@
+include ../Makefile.common
+
+PROJECT_FILE = $(srcdir)/image.gpr
+SOURCES = $(srcdir)/image.adb
+

Added: trunk/examples/image/image.adb
===================================================================
--- trunk/examples/image/image.adb	                        (rev 0)
+++ trunk/examples/image/image.adb	2006-12-01 19:43:10 UTC (rev 25)
@@ -0,0 +1,39 @@
+--  $Id$
+--  Copyright (C) 2006 Bechir Zalila <bec...@en...>
+--  See COPYING file for license
+
+--  This example, creates an empty default main window then exits
+
+with Gtkada_Wrapper; use Gtkada_Wrapper;
+
+with Ada.Text_IO;
+
+procedure Image is
+   X      : Float;
+   Y      : Float;
+   Button : Natural;
+begin
+   Create_Main_Window (600.0, 600.0);
+
+   --  Insert a non scaled image
+
+   Jump (25.0, 500.0);
+   Insert_Image ("Kubuntu-edgy.png", 1.0, Left, Top);
+
+   --  Insert an increased image
+
+   Jump (25.0, 350.0);
+   Insert_Image ("Kubuntu-edgy.png", 1.2, Left, Top);
+
+   --  Insert a reduced image
+
+   Jump (25.0, 200.0);
+   Insert_Image ("Kubuntu-edgy.png", 0.75, Left, Top);
+
+   Get_Mouse_Pointer (X, Y, Button);
+   Ada.Text_IO.Put_Line ("Got Click:");
+   Ada.Text_IO.Put_Line ("   X      = " & X'Img);
+   Ada.Text_IO.Put_Line ("   Y      = " & Y'Img);
+   Ada.Text_IO.Put_Line ("   Button = " & Button'Img);
+   Destroy_Main_Window;
+end Image;


Property changes on: trunk/examples/image/image.adb
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/examples/image/image.gpr
===================================================================
--- trunk/examples/image/image.gpr	                        (rev 0)
+++ trunk/examples/image/image.gpr	2006-12-01 19:43:10 UTC (rev 25)
@@ -0,0 +1,10 @@
+with "../../src/gtkada_wrapper.gpr";
+
+project Image is
+   for main use ("image.adb");
+
+   Build : GTKAda_Wrapper.Build_Type := External ("BUILD", "debug");
+
+   package Compiler renames GTKAda_Wrapper.Compiler;
+   package Binder renames GTKAda_Wrapper.Binder;
+end Image;


Property changes on: trunk/examples/image/image.gpr
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Modified: trunk/src/gtkada_wrapper.adb
===================================================================
--- trunk/src/gtkada_wrapper.adb	2006-11-30 20:53:52 UTC (rev 24)
+++ trunk/src/gtkada_wrapper.adb	2006-12-01 19:43:10 UTC (rev 25)
@@ -9,14 +9,17 @@
 with GNAT.Table;
 
 with Glib;             use Glib;
+with Glib.Error;       use Glib.Error;
 
 with Gdk.Color;        use Gdk.Color;
 with Gdk.Types;        use Gdk.Types;
 with Gdk.Event;        use Gdk.Event;
 with Gdk.Font;         use Gdk.Font;
+with Gdk.Rgb;          use Gdk.Rgb;
 with Gdk.Pixmap;       use Gdk.Pixmap;
 with Gdk.Window;       use Gdk.Window;
 with Gdk.Drawable;     use Gdk.Drawable;
+with Gdk.Pixbuf;       use Gdk.Pixbuf;
 with Gdk.Rectangle;    use Gdk.Rectangle;
 with Gdk.GC;           use Gdk.GC;
 
@@ -32,7 +35,7 @@
 
 with Protected_Queue;
 
-pragma Debug_Policy (Ignore);
+pragma Debug_Policy (Check);
 --  To control the debug message display: 'Ignore' Or 'Check'
 
 package body Gtkada_Wrapper is
@@ -1293,10 +1296,139 @@
    --------------
 
    procedure Do_Image (Cmd : in out Command) is
-      pragma Unreferenced (Cmd);
+
+      procedure Read_Image (Pixbuf : in out Gdk_Pixbuf);
+      --  Loads an imge from the command file and allocate a
+      --  Gdk_Pixbuf.
+
+      function Scale (Dimension : Gint) return Gint;
+      --  Returns Dimension * Cmd.Scale
+
+      ----------------
+      -- Read_Image --
+      ----------------
+
+      procedure Read_Image (Pixbuf : in out Gdk_Pixbuf) is
+         Error : GError;
+      begin
+         pragma Debug (O ("Loading image " & Cmd.File_Name.all));
+
+         Gdk_New_From_File (Pixbuf, Cmd.File_Name.all, Error);
+
+         if Error /= null then
+            declare
+               Msg : constant String := Get_Message (Error);
+            begin
+               Error_Free (Error);
+               Unref (Pixbuf);
+
+               raise  Program_Error with "Error in loading image: " & Msg;
+            end;
+         end if;
+
+         pragma Debug (O ("Loading image " & Cmd.File_Name.all & ": done"));
+      end Read_Image;
+
+      -----------
+      -- Scale --
+      -----------
+
+      function Scale (Dimension : Gint) return Gint is
+      begin
+         return Gint (Float (Dimension) * Cmd.Scale);
+      end Scale;
+
+      Scaled_Image_Pixbuf   : Gdk_Pixbuf;
+      Original_Image_Pixbuf : Gdk_Pixbuf;
+      X_Pix                 : Gint;
+      Y_Pix                 : Gint;
    begin
       pragma Debug (O ("Do_Image: begin"));
-      null; --  FIXME
+
+      --  Load the image and scale it if necessary
+
+      if Cmd.Scale = 1.0 then
+         Read_Image (Scaled_Image_Pixbuf);
+      else
+         Read_Image (Original_Image_Pixbuf);
+
+         --  Apply scale
+
+         Scaled_Image_Pixbuf := Scale_Simple
+           (Original_Image_Pixbuf,
+            Scale (Get_Width (Original_Image_Pixbuf)),
+            Scale (Get_Height (Original_Image_Pixbuf)));
+
+         --  Deallocate the original buffer
+
+         Unref (Original_Image_Pixbuf);
+      end if;
+
+      --  Handle justification
+
+      case Cmd.X_Justify is
+         when Left =>
+            X_Pix := Gint (Brush_X);
+
+         when Center =>
+            X_Pix := Gint (Brush_X) - Get_Width (Scaled_Image_Pixbuf) / 2;
+
+         when Right =>
+            X_Pix := Gint (Brush_X) - Get_Width (Scaled_Image_Pixbuf);
+      end case;
+
+      case Cmd.Y_Justify is
+         when Top =>
+            Y_Pix := Height - Gint (Brush_Y);
+
+         when Center =>
+            Y_Pix := Height -
+              Gint (Brush_Y) -
+              Get_Height (Scaled_Image_Pixbuf) / 2;
+
+         when Bottom =>
+            Y_Pix := Height -
+              Gint (Brush_Y) -
+              Get_Height (Scaled_Image_Pixbuf);
+      end case;
+
+      --  Drawing the image
+
+      Render_To_Drawable
+        (Scaled_Image_Pixbuf,
+         Get_Window (Drawing_Area),
+         Graphic_Context,
+         0,
+         0,
+         X_Pix,
+         Y_Pix,
+         Get_Width (Scaled_Image_Pixbuf),
+         Get_Height (Scaled_Image_Pixbuf),
+         Dither_Normal,
+         0,
+         0);
+
+      --  Backup
+
+      Render_To_Drawable
+        (Scaled_Image_Pixbuf,
+         Pixmap,
+         Graphic_Context,
+         0,
+         0,
+         X_Pix,
+         Y_Pix,
+         Get_Width (Scaled_Image_Pixbuf),
+         Get_Height (Scaled_Image_Pixbuf),
+         Dither_Normal,
+         0,
+         0);
+
+      --  Deallocate the scaled buffer and the file name
+
+      Unref (Scaled_Image_Pixbuf);
+      Free (Cmd.File_Name);
+
       pragma Debug (O ("Do_Image: done"));
    end Do_Image;
 

Modified: trunk/src/gtkada_wrapper.ads
===================================================================
--- trunk/src/gtkada_wrapper.ads	2006-11-30 20:53:52 UTC (rev 24)
+++ trunk/src/gtkada_wrapper.ads	2006-12-01 19:43:10 UTC (rev 25)
@@ -160,6 +160,9 @@
    --  location. This will draw any graphic that Gtk understands,
    --  including JPEG, GIF, BMP, PNG, PBM, TIFF, and perhaps some
    --  others.
+   --  IMPORTANT NOTE: If the given path to the image is a relative
+   --  path, the image location is calculated relatively to the
+   --  working directory.
 
    procedure Insert_Text
      (Text            : String;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.