File: main.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 (78 lines) | stat: -rw-r--r-- 2,019 bytes parent folder | download | duplicates (6)
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
with Gtk.Box;          use Gtk.Box;
with Gtk.Enums;        use Gtk.Enums;
with Gtk.Label;        use Gtk.Label;
with Gtk.Main;         use Gtk.Main;
with Gtk.Handlers;     use Gtk.Handlers;
with Gtk.Window;       use Gtk.Window;

with My_Widget; use My_Widget;
with Text_IO;

procedure Main is

   package Target_Cb is new Gtk.Handlers.User_Callback
     (Target_Widget_Record, String);

   package Window_Cb is new Gtk.Handlers.Return_Callback
     (Gtk_Window_Record, Boolean);

   function On_Main_Window_Delete_Event
     (Object : access Gtk_Window_Record'Class) return Boolean;
   --  Callback for delete_event.

   function On_Main_Window_Delete_Event
     (Object : access Gtk_Window_Record'Class) return Boolean
   is
      pragma Unreferenced (Object);
   begin
      Gtk.Main.Gtk_Exit (0);
      return True;
   end On_Main_Window_Delete_Event;

   procedure Won
     (Widget  : access Target_Widget_Record'Class;
      Message : in     String);
   procedure Won
     (Widget  : access Target_Widget_Record'Class;
      Message : in     String)
   is
      pragma Unreferenced (Widget);
   begin
      Text_IO.Put_Line (Message);
   end Won;

   Main_W : Gtk_Window;
   Ok     : Target_Widget;
   Box    : Gtk_Box;
   Label  : Gtk_Label;

begin
   Gtk.Main.Set_Locale;
   Gtk.Main.Init;

   Gtk_New (Main_W, Window_Toplevel);

   Gtk_New_Vbox (Box, False, 0);
   Add (Main_W, Box);

   Gtk_New (Label, "The widget below was created in Ada");
   Pack_Start (Box, Label);
   Gtk_New (Label, "Try clicking in the middle or on the sides");
   Pack_Start (Box, Label);

   Gtk_New (Ok);
   Pack_Start (Box, Ok, True, True);
   Target_Cb.Connect (Ok, "bullseye",
                      Target_Cb.To_Marshaller (Won'Access), "I won");
   Target_Cb.Connect (Ok, "missed",
                      Target_Cb.To_Marshaller (Won'Access), "I lost");

   Window_Cb.Connect
     (Main_W, "delete_event",
      Window_Cb.To_Marshaller (On_Main_Window_Delete_Event'Access));

   Show_All (Main_W);

   Gtk.Main.Main;
end Main;