summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2016-09-06 00:12:05 +1000
committerJed Barber <jjbarber@y7mail.com>2016-09-06 00:12:05 +1000
commitdac7e747e5c61d78deffdccc986d202e9f0d63bb (patch)
treed0c55473ab3feab222b3990c7e8657ebd99f1475
parent501151d99cc8ec71eae7a3770ee3ba71c34cab18 (diff)
Getting things back into a compilable order
-rw-r--r--c_fl_menu_item.cpp17
-rw-r--r--c_fl_menu_item.h15
-rw-r--r--fltk-callbacks.adb4
-rw-r--r--fltk-callbacks.ads2
-rw-r--r--fltk-menu_items.adb35
-rw-r--r--fltk-menu_items.ads31
6 files changed, 79 insertions, 25 deletions
diff --git a/c_fl_menu_item.cpp b/c_fl_menu_item.cpp
new file mode 100644
index 0000000..7c2a38c
--- /dev/null
+++ b/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/c_fl_menu_item.h b/c_fl_menu_item.h
new file mode 100644
index 0000000..94e5903
--- /dev/null
+++ b/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/fltk-callbacks.adb b/fltk-callbacks.adb
index 717888d..193509b 100644
--- a/fltk-callbacks.adb
+++ b/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/fltk-callbacks.ads b/fltk-callbacks.ads
index cc035ce..4428c44 100644
--- a/fltk-callbacks.ads
+++ b/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/fltk-menu_items.adb b/fltk-menu_items.adb
index b72d8c3..254de5f 100644
--- a/fltk-menu_items.adb
+++ b/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/fltk-menu_items.ads b/fltk-menu_items.ads
index 8cade15..5e0751f 100644
--- a/fltk-menu_items.ads
+++ b/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#;