----------------------------------------------------------------------- -- GtkAda - Ada95 binding for Gtk+/Gnome -- -- -- -- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- -- Copyright (C) 2000-2001 ACT-Europe -- -- -- -- 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 Gtk.Frame; use Gtk.Frame; with Gtk.Label; use Gtk.Label; with Glib; use Glib; with Glib.Error; use Glib.Error; with Gtk.Box; use Gtk.Box; with Gtk.Drawing_Area; use Gtk.Drawing_Area; with Gdk.Pixbuf; use Gdk.Pixbuf; with Gtk.Handlers; use Gtk.Handlers; with Gtk.Style; use Gtk.Style; with Gtk.Widget; use Gtk.Widget; with Gdk.Rgb; use Gdk.Rgb; package body Libart_Demo is -------------------------- -- The type below is a special drawing area that displays the -- associated image in it automatically, and destroys the image -- when the widget is destroyed. --------------------------- type Image_Drawing_Record is new Gtk.Box.Gtk_Box_Record with record Area : Gtk.Drawing_Area.Gtk_Drawing_Area; Pix : Gdk.Pixbuf.Gdk_Pixbuf; end record; type Image_Drawing is access all Image_Drawing_Record'Class; -- A special type of drawing area that can be associated with -- an image. procedure Gtk_New (Draw : out Image_Drawing; Pixbuf : Gdk.Pixbuf.Gdk_Pixbuf; Title : String); ---------- -- Help -- ---------- function Help return String is begin return "A @bGdk_Pixbuf@B represents an image, normally in RGB or RGBA format." & " Pixbufs are normally used to load files from disk and perform" & " image scaling."; end Help; ------------------------ -- Callbacks packages -- ------------------------ package Expose_Cb is new Gtk.Handlers.Return_Callback (Image_Drawing_Record, Boolean); package Destroy_Cb is new Gtk.Handlers.Callback (Image_Drawing_Record); ------------- -- Destroy -- ------------- procedure Destroy (Draw : access Image_Drawing_Record'Class) is begin -- Destroy the associated image Unref (Draw.Pix); end Destroy; ------------ -- Expose -- ------------ function Expose (Draw : access Image_Drawing_Record'Class) return Boolean is begin Render_To_Drawable (Draw.Pix, Get_Window (Draw.Area), Gtk.Style.Get_Black_GC (Get_Style (Draw.Area)), 0, 0, 0, 0, Get_Width (Draw.Pix), Get_Height (Draw.Pix), Dither_Normal, 0, 0); return False; end Expose; ------------- -- Gtk_New -- ------------- procedure Gtk_New (Draw : out Image_Drawing; Pixbuf : Gdk_Pixbuf; Title : String) is Label : Gtk_Label; begin -- The drawing area MUST be created with Gdk.Rgb colormap, -- otherwise the image can not be rendered correctly. Gtk.Widget.Push_Colormap (Gdk.Rgb.Get_Cmap); Draw := new Image_Drawing_Record; Initialize_Vbox (Draw, Homogeneous => False, Spacing => 0); Gtk_New (Label, Title); Pack_Start (Draw, Label, Expand => False, Fill => False); Draw.Pix := Pixbuf; Set_USize (Draw, Get_Width (Draw.Pix), Get_Height (Draw.Pix) + Gint (Get_Allocation_Height (Label))); Gtk_New (Draw.Area); Pack_Start (Draw, Draw.Area); Expose_Cb.Object_Connect (Draw.Area, "expose_event", Expose_Cb.To_Marshaller (Expose'Access), Slot_Object => Draw); Destroy_Cb.Connect (Draw, "destroy", Destroy_Cb.To_Marshaller (Destroy'Access)); Gtk.Widget.Pop_Colormap; end Gtk_New; --------- -- Run -- --------- procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is VBox : Gtk_Box; Hbox : Gtk_Box; Pix, Pix2, Pix3 : Gdk_Pixbuf; Draw : Image_Drawing; Label : Gtk_Label; Error : Glib.Error.GError; begin Gtk_New_Vbox (VBox, Homogeneous => False, Spacing => 0); Gtk_New_Hbox (Hbox, Homogeneous => False, Spacing => 0); Pack_Start (VBox, Hbox); -- Creating the images. Gdk_New_From_File (Pix, "alps.png", Error); if Pix = Null_Pixbuf then Gtk_New (Label, "Pixmaps not found. Please run testgtk from the" & " testgtk/ directory itself."); Add (Frame, Label); Show_All (Frame); return; end if; Pix2 := Scale_Simple (Pix, Gint (550) - Get_Width (Pix), Get_Height (Pix) / 2); Gdk_New_From_File (Pix3, "lightning.png", Error); if Pix3 = Null_Pixbuf then Gtk_New (Label, "Pixmaps not found. Please run testgtk from the" & " testgtk/ directory itself."); Add (Frame, Label); Show_All (Frame); return; end if; Composite (Src => Pix, Dest => Pix3, Dest_X => 0, Dest_Y => 0, Scale_X => 0.5, Scale_Y => 0.5, Dest_Width => Get_Width (Pix3), Dest_Height => Get_Height (Pix3), Overall_Alpha => 128); -- Creating the canvases Add (Frame, VBox); Gtk_New (Draw, Pix, "Initial Image"); Pack_Start (Hbox, Draw, Expand => False, Fill => True); Gtk_New (Draw, Pix2, "Scaled Image"); Pack_Start (Hbox, Draw, Expand => False, Fill => True); Gtk_New (Draw, Pix3, "Composite Image with Opacity" & ASCII.LF & "This image is the addition of two simpler images"); Pack_Start (VBox, Draw); Show_All (Frame); end Run; end Libart_Demo;