File: my_widget.adb

package info (click to toggle)
libgtkada2 2.8.1-6lenny3
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 13,496 kB
  • ctags: 3,886
  • sloc: ada: 103,189; ansic: 45,411; perl: 5,500; sh: 2,812; makefile: 1,169; xml: 19
file content (268 lines) | stat: -rw-r--r-- 9,685 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
with Glib;            use Glib;
with Gdk;             use Gdk;
with Gtk;             use Gtk;
with Gdk.Color;       use Gdk.Color;
with Gdk.Drawable;    use Gdk.Drawable;
with Gdk.Event;       use Gdk.Event;
with Gdk.GC;          use Gdk.GC;
with Gtk.Widget;      use Gtk.Widget;
with Gdk.Window;      use Gdk.Window;
with Gtk.Object;      use Gtk.Object;
with Gtk.Handlers;    use Gtk.Handlers;
with Gtkada.Types;    use Gtkada.Types;

package body My_Widget is

   --  Warning: Creating a widget from scratch is a difficult matter.
   --  You should not try that unless you already know quite well how
   --  gtk works. There are a lot of issues to consider for handling
   --  signals, requesting a size, drawing the widget, ...
   --  Please have a look at the tutorial for gtk+ itself to see a
   --  brief summary of all the things to take care of.


   --  This pointer will keep a pointer to the C 'class record' for
   --  gtk. To avoid allocating memory for each widget, this may be done
   --  only once, and reused
   Class_Record : GObject_Class := Uninitialized_Class;

   --  Array of the signals created for this widget
   Signals : Chars_Ptr_Array := "bullseye" + "missed";

   package Internal_Cb is new Handlers.Callback (Target_Widget_Record);
   --  The type of callbacks for the signals above. This is used only to
   --  emit the signals.

   --  Note: To create a real-life widget, you would have to do more
   --  things than are done in this simple example:
   --    * The "expose_event" signal actually passes the Area to
   --      redraw, which can speed things up a lot if used correctly
   --    * You should probably use some double-buffers to avoid the
   --      flickering that is visible in this simple example
   --    * Connect a function to the "destroy" callback to take care of
   --      the finalization of the object.

   package Return_Boolean_Cb is new Handlers.Return_Callback
     (Target_Widget_Record, Boolean);

   --  Define our own marshaller, since this is not one of the
   --  standard one.
   package Size_Cb is new Handlers.Callback (Target_Widget_Record);
   package Requisition_Marshaller is new Size_Cb.Marshallers.Generic_Marshaller
     (Gtk_Requisition_Access, Gtk.Widget.Get_Requisition);

   package Allocation_Cb is new Handlers.Callback (Target_Widget_Record);
   package Allocation_Marshaller is new
     Allocation_Cb.Marshallers.Generic_Marshaller
       (Gtk_Allocation_Access, Gtk.Widget.Get_Allocation);

   -----------------
   -- Draw_Target --
   -----------------

   function Draw_Target
     (Widget  : access Target_Widget_Record'Class)
      return Boolean;

   function Draw_Target
     (Widget  : access Target_Widget_Record'Class)
      return Boolean
      --  This function is called when we need to redraw the widget (for
      --  instance whenever part of it has been cleared
   is
      Width, Height : Gint;
      Win  : Gdk.Window.Gdk_Window := Get_Window (Widget);
   begin
      if Widget.Gc_In = null then
         declare
            Color : Gdk_Color;
         begin
            Color := Gdk.Color.Parse ("Red");
            Gdk.Color.Alloc (Gtk.Widget.Get_Default_Colormap, Color);

            Gdk.GC.Gdk_New (Widget.Gc_In, Win);
            Gdk.GC.Set_Foreground (Widget.Gc_In, Color);

            Color := Gdk.Color.Parse ("Blue");
            Gdk.Color.Alloc (Gtk.Widget.Get_Default_Colormap, Color);

            Gdk.GC.Gdk_New (Widget.Gc_Out, Win);
            Gdk.GC.Set_Foreground (Widget.Gc_Out, Color);
         end;
      end if;

      Gdk.Drawable.Get_Size (Win, Width, Height);
      Gdk.Drawable.Draw_Arc
        (Win, Widget.Gc_Out,
         Filled => True,
         X      => (Width - Widget.Radius) / 2,
         Y      => (Height - Widget.Radius) / 2,
         Width  => Widget.Radius,
         Height => Widget.Radius,
         Angle1 => 0,
         Angle2 => 360*64);
      Gdk.Drawable.Draw_Arc
        (Win, Widget.Gc_In,
         Filled => True,
         X      => (Width - Widget.Radius / 2) / 2,
         Y      => (Height - Widget.Radius / 2) / 2,
         Width  => Widget.Radius / 2,
         Height => Widget.Radius / 2,
         Angle1 => 0,
         Angle2 => 360*64);
      return True;
   end Draw_Target;

   ------------------
   -- Size_Request --
   ------------------

   procedure Size_Request
     (Widget      : access Target_Widget_Record'Class;
      Requisition : in Gtk_Requisition_Access);

   procedure Size_Request
     (Widget      : access Target_Widget_Record'Class;
      Requisition : in Gtk_Requisition_Access)
      --  This function is called by gtk+ when the widget is realized.
      --  It should modify Requisition to ask for a appropriate size
      --  for the widget. Note that the widget will not necessary have
      --  that size, it could be bigger, depending on what it is
      --  contained into. See the signal "size_allocate" too. More
      --  information on the size requisition process can be found in
      --  the book "Gtk+/Gnome Application Development" by Havoc
      --  Pennington.
   is
   begin
      Requisition.Width := Widget.Radius;
      Requisition.Height := Widget.Radius;

      --  Stop the signal from being propagated to the parent's default
      --  size_request function
      Gtk.Handlers.Emit_Stop_By_Name (Widget, "size_request");
   end Size_Request;

   -------------------
   -- Size_Allocate --
   -------------------

   procedure Size_Allocate
     (Widget     : access Target_Widget_Record'Class;
      Allocation : in     Gtk_Allocation_Access);

   procedure Size_Allocate
     (Widget     : access Target_Widget_Record'Class;
      Allocation : in     Gtk_Allocation_Access)
      --  This function is called once gtk has decided what size and
      --  position the widget will actually have, or everytime the
      --  widget is resized. This would be a good time for instance
      --  for resizing the component sub-widgets. Note that we have to
      --  move and resize the widget ourselves, and that for such a
      --  simple case, we could simply rely on the ancestor's
      --  size_allocation function.
   is
   begin
      if Realized_Is_Set (Widget) then
         Widget.Radius :=
           Gint'Min (Allocation.Width, Allocation.Height);
         Gdk.Window.Move_Resize (Get_Window (Widget),
                                 Allocation.X, Allocation.Y,
                                 Gint (Allocation.Width),
                                 Gint (Allocation.Height));
      end if;
      Gtk.Handlers.Emit_Stop_By_Name (Widget, "size_allocate");
   end Size_Allocate;

   -------------
   -- Clicked --
   -------------

   function Clicked
     (Widget : access Target_Widget_Record'Class;
      Event  : in     Gdk_Event)
      return Boolean;
   function Clicked
     (Widget : access Target_Widget_Record'Class;
      Event  : in     Gdk_Event)
      return Boolean
      --  called when the mouse is clicked within the widget
   is
      Tmp_X, Tmp_Y : Gint;
      Width, Height : Gint;
   begin
      Gdk.Drawable.Get_Size (Get_Window (Widget), Width, Height);
      Tmp_X := Gint (Get_X (Event)) - Width / 2;
      Tmp_Y := Gint (Get_Y (Event)) - Height / 2;

      --  The signal emitted depends on where the user has clicked.
      if Tmp_X * Tmp_X + Tmp_Y * Tmp_Y
        <= Widget.Radius * Widget.Radius / 4
      then
         Internal_Cb.Emit_By_Name (Widget, "bullseye");
      else
         Internal_Cb.Emit_By_Name (Widget, "missed");
      end if;
      return True;
   end Clicked;

   -------------
   -- Gtk_New --
   -------------

   procedure Gtk_New (Widget : out Target_Widget) is
      --  Used to create a new widget
   begin
      Widget := new Target_Widget_Record;
      Initialize (Widget);
   end Gtk_New;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Widget : access Target_Widget_Record'Class) is
   begin
      --  We need to call the ancestor's Initialize function to create
      --  the underlying C object.
      Gtk.Drawing_Area.Initialize (Widget);

      --  The following call is required to initialize the class record,
      --  and the new signals created for this widget.
      --  Note that for now you can only create basic signals (whose
      --  callbacks do not have any parameters), and that you just have
      --  to put their name in a table.
      --  Note also that we keep Class_Record, so that the memory allocation
      --  is done only once.
      Gtk.Object.Initialize_Class_Record
        (Widget, Signals, Class_Record, "TestGtkTargetWidget");

      --  Note: We can not create the GC here, since the widget is not
      --  realized yet, and thus has no window available. This could be
      --  done be using the "realize" signal, if we really want to be clean,
      --  here we just do it in the redraw function (a little bit slower).

      Widget.Radius := 60;

      --  We want to get Button_Release events
      Set_Events (Widget, Exposure_Mask or Button_Release_Mask
                  or Button_Press_Mask);

      --  Set up the appropriate callbacks to redraw, ...
      Return_Boolean_Cb.Connect
         (Widget, "expose_event",
          Return_Boolean_Cb.To_Marshaller (Draw_Target'Access), True);

      Size_Cb.Connect
        (Widget, "size_request",
         Requisition_Marshaller.To_Marshaller (Size_Request'Access));

      Return_Boolean_Cb.Connect
        (Widget, "button_release_event",
         Return_Boolean_Cb.To_Marshaller (Clicked'Access));

      Allocation_Cb.Connect
        (Widget, "size_allocate",
         Allocation_Marshaller.To_Marshaller (Size_Allocate'Access));
   end Initialize;

end My_Widget;