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
|
type Main_Application is new Limited_Controlled with
record
Main_Window : Gtk_Window;
.../...
end record;
package Factory_Data is new Data_Item (Main_application);
use Factory_Data;
procedure Main_quit_Cb
(Callback_Data : Data_Type_Access;
Callback_Action : Guint;
Widget : Limited_Widget)
is
pragma Warnings (Off, Callback_Data);
pragma Warnings (Off, Callback_Action);
Dialog : Gtk.Dialog.Gtk_Dialog;
Yes : Gtk.Widget.Gtk_Widget;
No : Gtk.Widget.Gtk_Widget;
Help : Gtk.Widget.Gtk_Widget;
begin
loop
Gtk.Dialog.Gtk_New(Dialog, "Quit ?", Callback_Data.Main_window, Gtk.dialog.modal);
Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes);
No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No);
Help := Gtk.Dialog.Add_Button(Dialog, "Help", Gtk.Dialog.Gtk_Response_Help);
case Gtk.Dialog.Run(Dialog) is
when Gtk.Dialog.Gtk_Response_Yes =>
Gtk.Dialog.Destroy(Dialog);
Gtk.Main.Main_Quit;
exit;
when Gtk.Dialog.Gtk_Response_No =>
Gtk.Dialog.Destroy(Dialog);
exit;
when Gtk.Dialog.Gtk_Response_Help =>
Gtk.Dialog.Destroy(Dialog);
when others =>
Gtk.Dialog.Destroy(Dialog);
end case;
end loop;
end Main_quit_Cb;
procedure Init(Heaven : out Heaven_Application) is
Max_Geometry : Gdk_Geometry := (1, 1, 1600, 1200,
1600, 1200, 1, 1, 1.0, 1.0,
Gravity_Center);
Min_Geometry : Gdk_Geometry := (1, 1, 100, 150,
100, 150, 1, 1, 1.0, 1.0,
Gravity_Center);
Menu_Items : Gtk_Item_Factory_Entry_Array(1..8) :=
(Gtk_New ("/_Game", Item_Type => Branch),
Gtk_New ("/Game/_New", "<control>N", Ifactory_Cb'Access),
Gtk_New ("/Game/_Quit", "<control>Q", Main_Quit_cb'Access),
Gtk_New ("/_Missiles", Item_Type => Branch),
Gtk_New ("/Missiles/Launch _One", "<control>O", Ifactory_Cb'Access),
Gtk_New ("/Missiles/Launch _All", "<control>A", Ifactory_Cb'Access),
Gtk_New ("/Missiles/Creatre _Missile", "<control>M", Ifactory_Cb'Access),
Gtk_New ("/Missiles/Create _Group", "<control>G", Ifactory_Cb'Access));
begin
Heaven := new Main_Application;
Gtk_New (Heaven.Accel_Group);
Gtk_New (Heaven.Item_Factory, Gtk.Menu_Bar.Get_Type, "<main>", Heaven.Accel_Group);
Create_Items (Heaven.Item_Factory, Menu_Items, Heaven.all'access); |