----------------------------------------------------------------------- -- GtkAda - Ada95 binding for the Gimp Toolkit -- -- -- -- Copyright (C) 1998-1999 -- -- Emmanuel Briot, Joel Brobecker and Arnaud Charlet -- -- -- -- 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. -- -- -- -- As a special exception, if other files instantiate generics from -- -- this unit, or you link this unit with other files to produce an -- -- executable, this unit does not by itself cause the resulting -- -- executable to be covered by the GNU General Public License. This -- -- exception does not however invalidate any other reasons why the -- -- executable file might be covered by the GNU Public License. -- ----------------------------------------------------------------------- with Glib; use Glib; with Gdk.Bitmap; use Gdk.Bitmap; with Gdk.Pixmap; use Gdk.Pixmap; with Gdk.Window; use Gdk.Window; with Gtk.Box; use Gtk.Box; with Gtk.Button; use Gtk.Button; with Gtk.Container; use Gtk.Container; with Gtk.Enums; use Gtk.Enums; with Gtk.Fixed; use Gtk.Fixed; with Gtk.Separator; use Gtk.Separator; with Gtk.Signal; use Gtk.Signal; with Gtk.Object; use Gtk.Object; with Gtk.Table; use Gtk.Table; with Gtk.Vbox; use Gtk.Vbox; with Gtk.Widget; use Gtk.Widget; with Gtk.Window; use Gtk.Window; with Gtk; use Gtk; with Common; use Common; package body Create_Shapes is package Win_Cb is new Signal.Two_Callback (Gtk_Window, Gint, Gdk_Event_Button); package Win_Cb2 is new Signal.Void_Callback (Gtk_Window); package Win_Cb3 is new Signal.Two_Callback (Gtk_Window, Gint, Gdk_Event_Motion); Modeller : aliased Gtk_Window; Sheets : aliased Gtk_Window; Rings : aliased Gtk_Window; Root_Win : aliased Gdk_Window; type Cursor_Offset is record X : Gint; Y : Gint; end record; type Cursor_Access is access all Cursor_Offset; Global_Cursor : Cursor_Offset; package User is new User_Data (Cursor_Access); procedure Shape_Pressed (Window : in out Gtk_Window'Class; Event : in out Gdk_Event_Button; Dummy : in out Gint) is Cursor : Cursor_Access; begin -- ignore double and triple click if (Get_Type (Event) /= Button_Press) then return; end if; Cursor := User.Get (Window); Cursor.X := Get_X (Event); Cursor.Y := Get_Y (Event); Grab_Add (Window); Pointer_Grab (Get_Window (Window), True, Button_Release_Mask + Button_Motion_Mask + Pointer_Motion_Hint_Mask, null, null, 0); end Shape_Pressed; procedure Shape_Released (Window : in out Gtk_Window'Class) is begin Grab_Remove (Widget); Pointer_Ungrab (0); end Shape_Released; procedure Shape_Motion (Window : in out Gtk_Window'Class; Event : in out Gdk_Event_Motion) is Cursor : Cursor_Access; Xp, Yp : Gint; Mask : Gdk_Modifier_Type; begin Cursor := User.Get (Window); -- We can't use Event->x and Event->Y since we need absolute -- coordinates Get_Pointer (Root_Win, Xp, Yp, Mask); Set_Uposition (Window, Xp - Cursor.X, Yp - Cursor.Y); end Shape_Motion; function Shape_Create_Icon (Xpm_File : in String; X : in Gint; Y : in Gint; Px : in Gint; Py : in Gint; Window_Type : in Gtk_Window_Type) return Gtk_Window is Window : Gtk_Window; Style : Gtk_Style; GC : Gdk_GC; Fixed : Gtk_Fixed; GdkPixmap : Gdk_Pixmap; Pixmap : Gtk_Pixmap; Mask : Gdk_Bitmap; begin Style := Get_Default_Style; GC := Get_Black_GC (Style); Gtk_New (Window, Window_Type); Gtk_New (Fixed); Set_Usize (Fixed, 100, 100); Add (Window, Fixed); Show (Fixed); Set_Events (Window, Get_Events (Window) + Button_Motion_Mask + Pointer_Motion_Hint_Mask + Button_Press_Mask); Realize (Window); Create_From_Xpm (GdkPixmap, Get_Window (Window), Mask, Get_Bg (Style, State_Normal), Xpm_File); Gtk_New (Pixmap, GdkPixmap, Mask); Put (Fixed, Pixmap, Px, Py); Show (Pixmap); Shape_Combine_Mask (Window, Mask, Px, Py); Id := Win_Cb.Connect (Window, "button_press_event", Shape_Pressed'Access); Id := Win_Cb2.Connect (Window, "button_release_event", Shape_Released'Access); Id := Win_Cb3.Connect (Window, "motion_notify_event", Shape_Motion'Access); User.Set (Window, Global_Cursor'Access); Set_Uposition (Window, X, Y); Show (Window); return Window; end Shape_Create_Icon; procedure Run (Widget : in out Gtk.Button.Gtk_Button) is Id : Guint; begin if not Is_Created (Modeller) then Modeller := Shape_Create_Icon ("Modeller.xpm", 440, 140, 0, 0, Popup); Id := Widget2_Cb.Connect (Modeller, "destroy", Destroyed'Access, Modeller'Access); else Destroy (Modeller); end if; if not Is_Created (Sheets) then Modeller := Shape_Create_Icon ("FilesQueue.xpm", 440, 140, 0, 0, Popup); Id := Widget2_Cb.Connect (Sheets, "destroy", Destroyed'Access, Sheets'Access); else Destroy (Sheets); end if; if not Is_Created (Rings) then Rings := Shape_Create_Icon ("3DRings.xpm", 440, 140, 0, 0, Popup); Id := Widget2_Cb.Connect (Rings, "destroy", Destroyed'Access, Rings'Access); else Destroy (Rings); end if; end Run; end Create_Shapes;