summaryrefslogtreecommitdiff
path: root/src/fltk_binding/fltk-widgets-menus.adb
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2016-09-15 03:41:54 +1000
committerJed Barber <jjbarber@y7mail.com>2016-09-15 03:41:54 +1000
commitbfcc3811a3ce55cafa6f7809d0d92c87238ea032 (patch)
tree6727c02fc76f00580ce7a238ea9cb5f2656e7918 /src/fltk_binding/fltk-widgets-menus.adb
parent6c61d634be9aa3cd30c1bf0254eee5d36a37eeb5 (diff)
Menu callbacks working, also some quick testing code that'll probably get deleted later because wynaut
Diffstat (limited to 'src/fltk_binding/fltk-widgets-menus.adb')
-rw-r--r--src/fltk_binding/fltk-widgets-menus.adb136
1 files changed, 131 insertions, 5 deletions
diff --git a/src/fltk_binding/fltk-widgets-menus.adb b/src/fltk_binding/fltk-widgets-menus.adb
index d102e41..be5b7c3 100644
--- a/src/fltk_binding/fltk-widgets-menus.adb
+++ b/src/fltk_binding/fltk-widgets-menus.adb
@@ -3,17 +3,143 @@
with Interfaces.C;
with System;
use type System.Address;
+use type Interfaces.C.int;
+use type Interfaces.C.unsigned_long;
package body FLTK.Widgets.Menus is
- procedure Initialize
- (This : in out Menu) is
+ function Shortcut
+ (Key : Pressable_Key)
+ return Shortcut_Key is
begin
- Initialize (Widget (This));
- This.Menu_Item_List := Menu_Vectors.Empty_Vector;
- end Initialize;
+ return This : Shortcut_Key do
+ This.Modifier := Mod_None;
+ This.Keypress := Key;
+ end return;
+ end Shortcut;
+
+
+
+
+ function Key_To_C
+ (Key : Shortcut_Key)
+ return Interfaces.C.unsigned_long is
+ begin
+ return Interfaces.C.unsigned_long (Key.Modifier) *
+ 65536 + Character'Pos (Key.Keypress);
+ end Key_To_C;
+
+
+
+
+ function "+"
+ (Left, Right : in Modifier_Key)
+ return Modifier_Key is
+ begin
+ return Left or Right;
+ end "+";
+
+
+
+
+ function "+"
+ (Left : in Modifier_Key;
+ Right : in Pressable_Key)
+ return Shortcut_Key is
+ begin
+ return This : Shortcut_Key do
+ This.Modifier := Left;
+ This.Keypress := Right;
+ end return;
+ end "+";
+
+
+
+
+ function "+"
+ (Left : in Modifier_Key;
+ Right : in Shortcut_Key)
+ return Shortcut_Key is
+ begin
+ return This : Shortcut_Key do
+ This.Modifier := Left or Right.Modifier;
+ This.Keypress := Right.Keypress;
+ end return;
+ end "+";
+
+
+
+
+ function "+"
+ (Left, Right : in Menu_Flag)
+ return Menu_Flag is
+ begin
+ return Left or Right;
+ end "+";
+
+
+
+
+ function fl_menu_add
+ (M : in System.Address;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.unsigned_long;
+ C, U : in System.Address;
+ F : in Interfaces.C.unsigned_long)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_add, "fl_menu_add");
+
+
+
+
+ procedure Item_Hook (M, U : in System.Address);
+ pragma Convention (C, Item_Hook);
+
+ procedure Item_Hook
+ (M, U : in System.Address) is
+
+ Ada_Widget : access Widget'Class :=
+ Widget_Convert.To_Pointer (fl_widget_get_user_data (M));
+
+ Action : access Widget_Callback'Class :=
+ Callback_Convert.To_Pointer (U);
+
+ begin
+ Action.Call (Ada_Widget.all);
+ end Item_Hook;
+
+
+
+
+ procedure Add
+ (This : in out Menu;
+ Text : in String;
+ Action : access Widget_Callback'Class := null;
+ Shortcut : in Shortcut_Key := No_Key;
+ Flags : in Menu_Flag := Flag_Normal) is
+
+ Place : Interfaces.C.int;
+ Callback, User_Data : System.Address;
+
+ begin
+ if Action = null then
+ Callback := System.Null_Address;
+ User_Data := System.Null_Address;
+ else
+ Callback := Item_Hook'Address;
+ User_Data := Callback_Convert.To_Address (Action);
+ end if;
+
+ Place := fl_menu_add
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Key_To_C (Shortcut),
+ Callback,
+ User_Data,
+ Interfaces.C.unsigned_long (Flags));
+ end Add;
end FLTK.Widgets.Menus;