[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [25] trunk
Brought to you by:
bechir_zalila
Menu
▾
▴
[Gtkada-wrapper-devel] SF.net SVN: gtkada-wrapper: [25] trunk
|
From: <bec...@us...> - 2006-12-01 19:43:11
|
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.
|
