----------------------------------------------------------------------- -- GtkAda - Ada95 binding for the Gimp Toolkit -- -- -- -- Copyright (C) 2007 AdaCore -- -- -- -- This program 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 program 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. -- -- -- ----------------------------------------------------------------------- -- This example displays a toplevel window with a PNG image loaded from -- the disk. The user can then use the mouse to select a rectangular -- area, as often done in drawing tools. -- This example shows how to load and draw an image efficiently, redrawing -- only the minimal amount every time, and how to connect to mouse events -- to create an interactive rectangular selection. with Glib; use Glib; with Glib.Error; use Glib.Error; with Gdk.Color; use Gdk.Color; with Gdk.Drawable; use Gdk, Gdk.Drawable; with Gdk.Event; use Gdk.Event; with Gdk.GC; use Gdk.GC; with Gdk.Pixbuf; use Gdk.Pixbuf; with Gdk.Pixmap; use Gdk.Pixmap; with Gdk.Rectangle; use Gdk.Rectangle; with Gtk.Drawing_Area; use Gtk.Drawing_Area; with Gtk.Enums; use Gtk.Enums; with Gtk.Main; use Gtk.Main; with Gtk.Widget; use Gtk.Widget; with Gtk.Window; use Gtk.Window; with Gtkada.Handlers; use Gtkada.Handlers; with Cairo.Region; procedure Rect is ---------------------- -- Global variables -- ---------------------- -- In general, real applications should not use global variables. -- Among other things, this makes it much harder to have several -- toplevel windows displaying different things for instance. -- Since this example concentrates more on the handling of signals, -- we kept the code simpler through the use of global variables. -- The better implementation would be to use your own window type -- as in: -- type My_Window_Image_Record is new Gtk_Window_Record with record -- Pix : Gdk_Pixbuf; -- Start_X, Start_Y : Gint; -- Prev_X, Prev_Y : Gint; -- GC : Gdk_GC; -- end record; Win : Gtk_Window; Pix : Gdk_Pixbuf; Error : GError; GC : Gdk.Gdk_GC; Draw : Gtk_Drawing_Area; -- A drawing area is a widget that users can use to draw their own -- contents. It doesn't memorize its contents, though, and it is the -- responsability of the user to redraw it every time there is a need -- for this (the "expose" event). -- See also the example doublebuffer which shows another possible -- implementation. Start_X, Start_Y : Gint; Prev_X, Prev_Y : Gint; -- The variables memorize the initial position of the mouse when the -- user clicked on the button, and the last position when we drew the -- rectangle, so that we can delete it later on. -------------- -- Draw_Pix -- -------------- -- This function draws whole or part of the image onto the drawing -- area. It includes a number of tests to make sure we only draw -- a valid area of the image (in case the image is shorter than the -- drawing area, or we are trying to draw outside of the drawing area -- for instance). procedure Draw_Pix (D : access Gtk_Widget_Record'Class; Area : Gdk_Rectangle := Full_Area) is A : Gdk_Rectangle := Area; use type Cairo.Region.Cairo_Rectangle_Int; begin -- If the caller wants to redraw the full image... if A = Full_Area then A := (0, 0, Get_Width (Pix), Get_Height (Pix)); end if; -- Create the graphic context required to draw both the image and -- the rectange. This cannot be created before starting the main -- gtk+ loop, since we need to have access to the physical properties -- of the window (its color depth among others), which are only -- available when windows have been mapped -- we could also do that -- in a "mapped" signal handler if GC = null then Gdk_New (GC, Get_Window (D)); Set_Foreground (GC, White (Get_Default_Colormap)); end if; -- Make sure we draw a valid part of the image. Otherwise, we get -- gtk+ warnings if A.X < 0 then A.Width := Gint'Min (Get_Width (Pix), A.Width + A.X); A.X := 0; end if; if A.Y < 0 then A.Height := Gint'Min (Get_Height (Pix), A.Height + A.Y); A.Y := 0; end if; -- In case the image is smaller than the drawing area, make sure -- we pass the proper width and height if A.Width > Get_Width (Pix) - A.X then A.Width := Gint'Min (A.Width, Get_Width (Pix) - A.X); A.Width := Gint'Max (0, A.Width); end if; if A.Height > Get_Height (Pix) - A.Y then A.Height := Gint'Min (A.Height, Get_Height (Pix) - A.Y); A.Height := Gint'Max (0, A.Height); end if; if A.Width > 0 and then A.Height > 0 then Render_To_Drawable (Pix, Drawable => Get_Window (D), Gc => GC, Src_X => A.X, Src_Y => A.Y, Dest_X => A.X, Dest_Y => A.Y, Width => A.Width, Height => A.Height); end if; end Draw_Pix; ---------------- -- On_Release -- ---------------- -- This callback is called when the user releases the mouse button. -- A drawing software would likely keep the rectangle visible to -- show the current selection. In this example, we simply hide the -- rectangle by redrawing the whole picture. function On_Release (D : access Gtk_Widget_Record'Class; Event : Gdk_Event) return Boolean is begin Draw_Pix (D); return True; end On_Release; -------------- -- On_Press -- -------------- -- This callback reacts to the initial click by the user. It stores -- the current mouse location, so that we can draw the interactive -- selection rectangle later on. function On_Press (D : access Gtk_Widget_Record'Class; Event : Gdk_Event) return Boolean is begin Start_X := Gint (Get_X (Event)); Start_Y := Gint (Get_Y (Event)); Prev_X := Start_X; Prev_Y := Prev_Y; return True; end On_Press; ------------- -- On_Move -- ------------- -- This callback is called when the user moves the mouse while -- pressing the button. It is used to update the selection -- rectangle. For this, we need to first delete the old one, then -- draw the new one. For efficiency reasons, we also need to do the -- minimal amount of redrawing, since this callback might be called -- often when the mouse is moved. function On_Move (D : access Gtk_Widget_Record'Class; Event : Gdk_Event) return Boolean is A : Gdk_Rectangle; begin -- Delete previous rectangle, redrawing as little as possible, -- ie just the borders of the rectangle. One limitation in this -- small example is when the image is smaller than the drawing -- area, the part of the rectangle that is off the image is not -- properly deleted. We could either scale the image to fit the -- window, or simply clear the area of the drawing area that is -- outside of the window. A := (Gint'Min (Prev_X, Start_X), Gint'Min (Prev_Y, Start_Y), abs (Prev_X - Start_X), abs (Prev_Y - Start_Y)); if A.Width > 0 and then A.Height > 0 then Draw_Pix (D, (A.X, A.Y, A.Width, 1)); Draw_Pix (D, (A.X, A.Y, 1, A.Height)); Draw_Pix (D, (A.X, A.Y + A.Height - 1, A.Width, 1)); Draw_Pix (D, (A.X + A.Width - 1, A.Y, 1, A.Height)); end if; -- Draw the new rectangle, and memorize its position so that -- we can delete it later on. Prev_X := Gint (Get_X (Event)); Prev_Y := Gint (Get_Y (Event)); A := (Gint'Min (Prev_X, Start_X), Gint'Min (Prev_Y, Start_Y), abs (Prev_X - Start_X) - 1, abs (Prev_Y - Start_Y) - 1); if A.Width > 0 and then A.Height > 0 then Draw_Rectangle (Get_Window (D), GC, Filled => False, X => A.X, Y => A.Y, Width => A.Width, Height => A.Height); end if; return True; end On_Move; --------------- -- On_Expose -- --------------- -- This callback is called every time a part of the window has been -- obscured (for instance when a new window was temporarily moved on -- top of it), and the system things it needs redrawing. -- Some systems will provide caching for you, and will transparently -- redraw the window without calling On_Expose. Others will call it -- every time any part of the window needs refreshing. In all cases, -- your application needs to react to this signal, or the window will -- simply appear gray. function On_Expose (D : access Gtk_Widget_Record'Class; Event : Gdk_Event) return Boolean is begin -- For efficiency, only redraw relevant area that was damaged. The -- rest of the window is still up-to-date. Draw_Pix (D, Get_Area (Event)); return True; end On_Expose; begin Init; Gtk_New (Win, Window_Toplevel); Gtk_New (Draw); Add (Win, Draw); -- We need to indicate that the drawing area needs to react to mouse -- events. Without this call, these signals would not result in calls -- to On_Press, On_Release,... Add_Events (Draw, Button_Press_Mask or Button_Release_Mask or Button_Motion_Mask); -- Load the image from the disk. A real application should test the -- error code of course, and provide fallbacks. -- Note that at this point the image has not been drawn to the screen Gdk_New_From_File (Pix, "../../testgtk/alps.png", Error); -- Connect to the relevant signals Return_Callback.Connect (Draw, "expose_event", Return_Callback.To_Marshaller (On_Expose'Unrestricted_Access)); Return_Callback.Connect (Draw, "button_press_event", Return_Callback.To_Marshaller (On_Press'Unrestricted_Access)); Return_Callback.Connect (Draw, "button_release_event", Return_Callback.To_Marshaller (On_Release'Unrestricted_Access)); Return_Callback.Connect (Draw, "motion_notify_event", Return_Callback.To_Marshaller (On_Move'Unrestricted_Access)); Show_All (Win); -- Start the main loop Main; end Rect;