diff options
| -rw-r--r-- | src/fltk_binding/c_fl_menu_item.cpp | 17 | ||||
| -rw-r--r-- | src/fltk_binding/c_fl_menu_item.h | 15 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-callbacks.adb | 4 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-callbacks.ads | 2 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-menu_items.adb | 35 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-menu_items.ads | 31 |
6 files changed, 79 insertions, 25 deletions
diff --git a/src/fltk_binding/c_fl_menu_item.cpp b/src/fltk_binding/c_fl_menu_item.cpp new file mode 100644 index 0000000..7c2a38c --- /dev/null +++ b/src/fltk_binding/c_fl_menu_item.cpp @@ -0,0 +1,17 @@ + + +#include <FL/Fl_Menu_Item.H> +#include "c_fl_menu_item.h" + + +MENUITEM new_fl_menu_item(char* label, void* c, unsigned long k, unsigned short f) { + Fl_Menu_Item *m = new Fl_Menu_Item; + m->add(label, k, reinterpret_cast<void (*)(Fl_Widget*,void*)>(c), 0, f); + return m; +} + + +void free_fl_menu_item(MENUITEM m) { + delete reinterpret_cast<Fl_Menu_Item*>(m); +} + diff --git a/src/fltk_binding/c_fl_menu_item.h b/src/fltk_binding/c_fl_menu_item.h new file mode 100644 index 0000000..94e5903 --- /dev/null +++ b/src/fltk_binding/c_fl_menu_item.h @@ -0,0 +1,15 @@ + + +#ifndef FL_MENU_ITEM_GUARD +#define FL_MENU_ITEM_GUARD + + +typedef void* MENUITEM; + + +extern "C" MENUITEM new_fl_menu_item(char* label, void* c, unsigned long k, unsigned short f); +extern "C" void free_fl_menu_item(MENUITEM m); + + +#endif + diff --git a/src/fltk_binding/fltk-callbacks.adb b/src/fltk_binding/fltk-callbacks.adb index 717888d..193509b 100644 --- a/src/fltk_binding/fltk-callbacks.adb +++ b/src/fltk_binding/fltk-callbacks.adb @@ -4,10 +4,10 @@ package body FLTK.Callbacks is function Create - (Call : in access procedure) + (Call : access procedure) return Callback is begin - return null record; + return This : Callback; end Create; diff --git a/src/fltk_binding/fltk-callbacks.ads b/src/fltk_binding/fltk-callbacks.ads index cc035ce..4428c44 100644 --- a/src/fltk_binding/fltk-callbacks.ads +++ b/src/fltk_binding/fltk-callbacks.ads @@ -7,7 +7,7 @@ package FLTK.Callbacks is function Create - (Call : in access procedure) + (Call : access procedure) return Callback; diff --git a/src/fltk_binding/fltk-menu_items.adb b/src/fltk_binding/fltk-menu_items.adb index b72d8c3..254de5f 100644 --- a/src/fltk_binding/fltk-menu_items.adb +++ b/src/fltk_binding/fltk-menu_items.adb @@ -8,19 +8,19 @@ use type System.Address; package body FLTK.Menu_Items is - function Create + function Shortcut (Key : Pressable_Key) return Shortcut_Key is begin return This : Shortcut_Key do - This.Modifiers := Mod_None; + This.Modifier := Mod_None; This.Keypress := Key; end return; - end Create; + end Shortcut; function "+" - (Left, Right : in Modifer_Key) + (Left, Right : in Modifier_Key) return Modifier_Key is begin return Left or Right; @@ -33,19 +33,19 @@ package body FLTK.Menu_Items is return Shortcut_Key is begin return This : Shortcut_Key do - This.Modifiers := Left; + This.Modifier := Left; This.Keypress := Right; end return; end "+"; function "+" - (Left : in Modifer_Key; + (Left : in Modifier_Key; Right : in Shortcut_Key) return Shortcut_Key is begin return This : Shortcut_Key do - This.Modifiers := Left or Right.Modifiers; + This.Modifier := Left or Right.Modifier; This.Keypress := Right.Keypress; end return; end "+"; @@ -63,10 +63,29 @@ package body FLTK.Menu_Items is + function new_fl_menu_item + (Text : in Interfaces.C.char_array; + CBack : in System.Address; + -- Data : in System.Address; + Key : in Interfaces.C.unsigned_long; + Flags : in Interfaces.C.unsigned_short) + return System.Address; + pragma Import (C, new_fl_menu_item, "new_fl_menu_item"); + + procedure free_fl_menu_item + (M : in System.Address); + pragma Import (C, free_fl_menu_item, "free_fl_menu_item"); + + + + procedure Finalize (This : in out Menu_Item) is begin - null; + Finalize (Wrapper (This)); + if This in Menu_Item then + free_fl_menu_item (This.Void_Ptr); + end if; end Finalize; diff --git a/src/fltk_binding/fltk-menu_items.ads b/src/fltk_binding/fltk-menu_items.ads index 8cade15..5e0751f 100644 --- a/src/fltk_binding/fltk-menu_items.ads +++ b/src/fltk_binding/fltk-menu_items.ads @@ -11,8 +11,8 @@ package FLTK.Menu_Items is type Shortcut_Key is private; - subtype Pressable_Key is range Character'Val(32) .. Character'Val(126); - function Create (Key : Pressable_Key) return Shortcut_Key; + subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); + function Shortcut (Key : Pressable_Key) return Shortcut_Key; No_Key : constant Shortcut_Key; @@ -20,9 +20,10 @@ package FLTK.Menu_Items is 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; + Mod_None : constant Modifier_Key; + Mod_Shift : constant Modifier_Key; + Mod_Ctrl : constant Modifier_Key; + Mod_Alt : constant Modifier_Key; type Menu_Flag is private; @@ -48,29 +49,31 @@ package FLTK.Menu_Items is private + -- these values designed to align with FLTK enumeration types + type Modifier_Key is new Interfaces.Unsigned_8; + Mod_None : constant Modifier_Key := 2#0000#; + Mod_Shift : constant Modifier_Key := 2#0001#; + Mod_Ctrl : constant Modifier_Key := 2#0100#; + Mod_Alt : constant Modifier_Key := 2#1000#; + + 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#; + (Modifier => Mod_None, Keypress => Character'Val (0)); - type Menu_Flag is Interfaces.Unsigned_8; + type Menu_Flag is new 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_Pointer is currently unused Flag_Submenu : constant Menu_Flag := 2#01000000#; Flag_Divider : constant Menu_Flag := 2#10000000#; |