summaryrefslogtreecommitdiff
path: root/src/fltk_binding
diff options
context:
space:
mode:
Diffstat (limited to 'src/fltk_binding')
-rw-r--r--src/fltk_binding/c_fl_menu.cpp4
-rw-r--r--src/fltk_binding/c_fl_menu.h3
-rw-r--r--src/fltk_binding/c_fl_menu_item.cpp17
-rw-r--r--src/fltk_binding/c_fl_menu_item.h15
-rw-r--r--src/fltk_binding/fltk-callbacks.adb15
-rw-r--r--src/fltk_binding/fltk-callbacks.ads21
-rw-r--r--src/fltk_binding/fltk-menu_items.adb108
-rw-r--r--src/fltk_binding/fltk-menu_items.ads89
-rw-r--r--src/fltk_binding/fltk-widgets-menus.adb136
-rw-r--r--src/fltk_binding/fltk-widgets-menus.ads86
-rw-r--r--src/fltk_binding/fltk-widgets.ads1
11 files changed, 214 insertions, 281 deletions
diff --git a/src/fltk_binding/c_fl_menu.cpp b/src/fltk_binding/c_fl_menu.cpp
index 457d4f1..e8cbe58 100644
--- a/src/fltk_binding/c_fl_menu.cpp
+++ b/src/fltk_binding/c_fl_menu.cpp
@@ -4,5 +4,7 @@
#include "c_fl_menu.h"
-// wheeee, placeholders
+int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f) {
+ return reinterpret_cast<Fl_Menu_*>(m)->add(t, s, reinterpret_cast<Fl_Callback_p>(c), u, f);
+}
diff --git a/src/fltk_binding/c_fl_menu.h b/src/fltk_binding/c_fl_menu.h
index 691277e..d8e8b90 100644
--- a/src/fltk_binding/c_fl_menu.h
+++ b/src/fltk_binding/c_fl_menu.h
@@ -7,5 +7,8 @@
typedef void* MENU;
+extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f);
+
+
#endif
diff --git a/src/fltk_binding/c_fl_menu_item.cpp b/src/fltk_binding/c_fl_menu_item.cpp
deleted file mode 100644
index 7c2a38c..0000000
--- a/src/fltk_binding/c_fl_menu_item.cpp
+++ /dev/null
@@ -1,17 +0,0 @@
-
-
-#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
deleted file mode 100644
index 94e5903..0000000
--- a/src/fltk_binding/c_fl_menu_item.h
+++ /dev/null
@@ -1,15 +0,0 @@
-
-
-#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
deleted file mode 100644
index 193509b..0000000
--- a/src/fltk_binding/fltk-callbacks.adb
+++ /dev/null
@@ -1,15 +0,0 @@
-
-
-package body FLTK.Callbacks is
-
-
- function Create
- (Call : access procedure)
- return Callback is
- begin
- return This : Callback;
- end Create;
-
-
-end FLTK.Callbacks;
-
diff --git a/src/fltk_binding/fltk-callbacks.ads b/src/fltk_binding/fltk-callbacks.ads
deleted file mode 100644
index 4428c44..0000000
--- a/src/fltk_binding/fltk-callbacks.ads
+++ /dev/null
@@ -1,21 +0,0 @@
-
-
-package FLTK.Callbacks is
-
-
- type Callback is private;
-
-
- function Create
- (Call : access procedure)
- return Callback;
-
-
-private
-
-
- type Callback is null record;
-
-
-end FLTK.Callbacks;
-
diff --git a/src/fltk_binding/fltk-menu_items.adb b/src/fltk_binding/fltk-menu_items.adb
deleted file mode 100644
index 254de5f..0000000
--- a/src/fltk_binding/fltk-menu_items.adb
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-with Interfaces.C;
-with System;
-use type System.Address;
-
-
-package body FLTK.Menu_Items is
-
-
- function Shortcut
- (Key : Pressable_Key)
- return Shortcut_Key is
- begin
- return This : Shortcut_Key do
- This.Modifier := Mod_None;
- This.Keypress := Key;
- end return;
- end Shortcut;
-
-
- 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 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
- Finalize (Wrapper (This));
- if This in Menu_Item then
- free_fl_menu_item (This.Void_Ptr);
- end if;
- end Finalize;
-
-
-
-
- function Create
- (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
- null;
- end return;
- end Create;
-
-
-end FLTK.Menu_Items;
-
diff --git a/src/fltk_binding/fltk-menu_items.ads b/src/fltk_binding/fltk-menu_items.ads
deleted file mode 100644
index 5e0751f..0000000
--- a/src/fltk_binding/fltk-menu_items.ads
+++ /dev/null
@@ -1,89 +0,0 @@
-
-
-with FLTK.Callbacks;
-private with Interfaces;
-
-
-package FLTK.Menu_Items is
-
-
- type Menu_Item is new Wrapper with private;
-
-
- type Shortcut_Key is private;
- 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;
-
-
- 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_Shift : 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;
- Action : in FLTK.Callbacks.Callback;
- Shortcut : in Shortcut_Key := No_Key;
- Flags : in Menu_Flag := Flag_Normal)
- return Menu_Item;
-
-
-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 :=
- (Modifier => Mod_None, Keypress => Character'Val (0));
-
-
- 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 : constant Menu_Flag := 2#01000000#;
- Flag_Divider : constant Menu_Flag := 2#10000000#;
-
-
- type Menu_Item is new Wrapper with null record;
-
-
- overriding procedure Finalize
- (This : in out Menu_Item);
-
-
-end FLTK.Menu_Items;
-
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;
diff --git a/src/fltk_binding/fltk-widgets-menus.ads b/src/fltk_binding/fltk-widgets-menus.ads
index 7a08de4..acb59bd 100644
--- a/src/fltk_binding/fltk-widgets-menus.ads
+++ b/src/fltk_binding/fltk-widgets-menus.ads
@@ -1,37 +1,103 @@
-private with Ada.Containers.Vectors;
-private with FLTK.Menu_Items;
+private with Interfaces;
+private with System;
package FLTK.Widgets.Menus is
type Menu is abstract new Widget with private;
+ type Menu_Cursor (Data : access Menu'Class) is limited null record
+ with Implicit_Dereference => Data;
+
+
+ type Menu_Item is private;
+ type Menu_Item_Cursor (Data : access Menu_Item) is limited null record
+ with Implicit_Dereference => Data;
+
+
type Index is new Positive;
+ type Shortcut_Key is private;
+ 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;
+
+
+ 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_Shift : 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
(X, Y, W, H : in Integer;
Text : in String)
return Menu is abstract;
+ 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);
+
+
private
- type Menu_Item_Access is access all FLTK.Menu_Items.Menu_Item;
- package Menu_Vectors is new Ada.Containers.Vectors (Index, Menu_Item_Access);
+ type Menu is abstract new Widget with null record;
- type Menu is abstract new Widget with
- record
- Menu_Item_List : Menu_Vectors.Vector;
- end record;
+ type Menu_Item is new System.Address;
- overriding procedure Initialize
- (This : in out Menu);
+ -- these values designed to align with FLTK enumeration types
+ type Modifier_Key is new Interfaces.Unsigned_8;
+ Mod_None : constant Modifier_Key := 2#00000000#;
+ Mod_Shift : constant Modifier_Key := 2#00000001#;
+ Mod_Ctrl : constant Modifier_Key := 2#00000100#;
+ Mod_Alt : constant Modifier_Key := 2#00001000#;
+
+
+ type Shortcut_Key is
+ record
+ Modifier : Modifier_Key;
+ Keypress : Character;
+ end record;
+ No_Key : constant Shortcut_Key :=
+ (Modifier => Mod_None, Keypress => Character'Val (0));
+
+
+ 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 unlikely to be used
+ Flag_Submenu : constant Menu_Flag := 2#01000000#;
+ Flag_Divider : constant Menu_Flag := 2#10000000#;
end FLTK.Widgets.Menus;
diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads
index 1c21ca4..0a123bf 100644
--- a/src/fltk_binding/fltk-widgets.ads
+++ b/src/fltk_binding/fltk-widgets.ads
@@ -106,6 +106,7 @@ private
package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class);
+ package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback'Class);
function fl_widget_get_user_data
generated by cgit (git 2.30.0) at 2024-12-23 07:22:54 +0000