From 7b43c1dc40b498e884cb2de96d5d7436c577a510 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 20 Jul 2016 15:45:15 +1000 Subject: Menu shortcut keys and flags --- src/fltk_binding/fltk-menu_items.adb | 63 +++++++++++++++++++++++++++++++++--- src/fltk_binding/fltk-menu_items.ads | 63 ++++++++++++++++++++++++++++++++---- 2 files changed, 116 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/fltk_binding/fltk-menu_items.adb b/src/fltk_binding/fltk-menu_items.adb index 6620a64..b72d8c3 100644 --- a/src/fltk_binding/fltk-menu_items.adb +++ b/src/fltk_binding/fltk-menu_items.adb @@ -8,6 +8,61 @@ use type System.Address; package body FLTK.Menu_Items is + function Create + (Key : Pressable_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifiers := Mod_None; + This.Keypress := Key; + end return; + end Create; + + + function "+" + (Left, Right : in Modifer_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.Modifiers := Left; + This.Keypress := Right; + end return; + end "+"; + + + function "+" + (Left : in Modifer_Key; + Right : in Shortcut_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifiers := Left or Right.Modifiers; + This.Keypress := Right.Keypress; + end return; + end "+"; + + + + + function "+" + (Left, Right : in Menu_Flag) + return Menu_Flag is + begin + return Left or Right; + end "+"; + + + + procedure Finalize (This : in out Menu_Item) is begin @@ -18,10 +73,10 @@ package body FLTK.Menu_Items is function Create - (Text : in String; - Shortcut : in Shortcut_Key; - Action : in FLTK.Callbacks.Callback; - Flags : Menu_Flag) + (Text : in String; + Action : in FLTK.Callbacks.Callback; + Shortcut : in Shortcut_Key := No_Key; + Flags : in Menu_Flag := Flag_Normal) return Menu_Item is begin return This : Menu_Item do diff --git a/src/fltk_binding/fltk-menu_items.ads b/src/fltk_binding/fltk-menu_items.ads index 51554b0..8cade15 100644 --- a/src/fltk_binding/fltk-menu_items.ads +++ b/src/fltk_binding/fltk-menu_items.ads @@ -1,6 +1,7 @@ with FLTK.Callbacks; +private with Interfaces; package FLTK.Menu_Items is @@ -9,21 +10,71 @@ package FLTK.Menu_Items is type Menu_Item is new Wrapper with private; - type Shortcut_Key is Integer; - type Menu_Flag is Integer; + type Shortcut_Key is private; + subtype Pressable_Key is range Character'Val(32) .. Character'Val(126); + function Create (Key : Pressable_Key) return Shortcut_Key; + No_Key : constant Shortcut_Key; + + + type Modifier_Key is private; + function "+" (Left, Right : in Modifier_Key) return Modifier_Key; + function "+" (Left : in Modifier_Key; Right : in Pressable_Key) return Shortcut_Key; + function "+" (Left : in Modifier_Key; Right : in Shortcut_Key) return Shortcut_Key; + Mod_None : constant Modifier_Key; + Mod_Ctrl : constant Modifier_Key; + Mod_Alt : constant Modifier_Key; + + + type Menu_Flag is private; + function "+" (Left, Right : in Menu_Flag) return Menu_Flag; + Flag_Normal : constant Menu_Flag; + Flag_Inactive : constant Menu_Flag; + Flag_Toggle : constant Menu_Flag; + Flag_Value : constant Menu_Flag; + Flag_Radio : constant Menu_Flag; + Flag_Invisible : constant Menu_Flag; + Flag_Submenu : constant Menu_Flag; + Flag_Divider : constant Menu_Flag; function Create - (Text : in String; - Shortcut : in Shortcut_Key; - Action : in FLTK.Callbacks.Callback; - Flags : in Menu_Flag) + (Text : in String; + Action : in FLTK.Callbacks.Callback; + Shortcut : in Shortcut_Key := No_Key; + Flags : in Menu_Flag := Flag_Normal) return Menu_Item; private + type Shortcut_Key is + record + Modifier : Modifier_Key; + Keypress : Character; + end record; + No_Key : constant Shortcut_Key := + (Modifer => Mod_None, Keypress => Character'Val(0)); + + + type Modifier_Key is Interfaces.Unsigned_2; + Mod_None : constant Modifier_Key := 2#00#; + Mod_Ctrl : constant Modifier_Key := 2#01#; + Mod_Alt : constant Modifier_Key := 2#10#; + + + type Menu_Flag is Interfaces.Unsigned_8; + Flag_Normal : constant Menu_Flag := 2#00000000#; + Flag_Inactive : constant Menu_Flag := 2#00000001#; + Flag_Toggle : constant Menu_Flag := 2#00000010#; + Flag_Value : constant Menu_Flag := 2#00000100#; + Flag_Radio : constant Menu_Flag := 2#00001000#; + Flag_Invisible : constant Menu_Flag := 2#00010000#; + -- Flag_Submenu_Pointer is currently unused + Flag_Submenu : constant Menu_Flag := 2#01000000#; + Flag_Divider : constant Menu_Flag := 2#10000000#; + + type Menu_Item is new Wrapper with null record; -- cgit