Starting to sketch the outline of menu widgets and callbacks

13 files changed, 295 insertions, 0 deletions

diff --git a/src/adapad.adb b/src/adapad.adb
index 340403e..5b22266 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -5,6 +5,7 @@ with Editors;
 use Editors;
 with FLTK.Text_Buffers;
 use FLTK.Text_Buffers;
+with FLTK.Widgets.Menus.Menu_Bars;
 
 
 function AdaPad return Integer is
diff --git a/src/fltk_binding/c_fl_menu.cpp b/src/fltk_binding/c_fl_menu.cpp
new file mode 100644
index 0000000..457d4f1
--- /dev/null
+++ b/src/fltk_binding/c_fl_menu.cpp
@@ -0,0 +1,8 @@
+
+
+#include <FL/Fl_Menu_.H>
+#include "c_fl_menu.h"
+
+
+// wheeee, placeholders
+
diff --git a/src/fltk_binding/c_fl_menu.h b/src/fltk_binding/c_fl_menu.h
new file mode 100644
index 0000000..691277e
--- /dev/null
+++ b/src/fltk_binding/c_fl_menu.h
@@ -0,0 +1,11 @@
+
+
+#ifndef FL_MENU_GUARD
+#define FL_MENU_GUARD
+
+
+typedef void* MENU;
+
+
+#endif
+
diff --git a/src/fltk_binding/c_fl_menu_bar.cpp b/src/fltk_binding/c_fl_menu_bar.cpp
new file mode 100644
index 0000000..3349008
--- /dev/null
+++ b/src/fltk_binding/c_fl_menu_bar.cpp
@@ -0,0 +1,16 @@
+
+
+#include <FL/Fl_Menu_Bar.H>
+#include "c_fl_menu_bar.h"
+
+
+MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label) {
+    Fl_Menu_Bar *m = new Fl_Menu_Bar(x, y, w, h, label);
+    return m;
+}
+
+
+void free_fl_menu_bar(MENUBAR m) {
+    delete reinterpret_cast<Fl_Menu_Bar*>(m);
+}
+
diff --git a/src/fltk_binding/c_fl_menu_bar.h b/src/fltk_binding/c_fl_menu_bar.h
new file mode 100644
index 0000000..a09d22b
--- /dev/null
+++ b/src/fltk_binding/c_fl_menu_bar.h
@@ -0,0 +1,15 @@
+
+
+#ifndef FL_MENU_BAR_GUARD
+#define FL_MENU_BAR_GUARD
+
+
+typedef void* MENUBAR;
+
+
+extern "C" MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_menu_bar(MENUBAR m);
+
+
+#endif
+
diff --git a/src/fltk_binding/fltk-callbacks.adb b/src/fltk_binding/fltk-callbacks.adb
new file mode 100644
index 0000000..717888d
--- /dev/null
+++ b/src/fltk_binding/fltk-callbacks.adb
@@ -0,0 +1,15 @@
+
+
+package body FLTK.Callbacks is
+
+
+    function Create
+           (Call : in access procedure)
+        return Callback is
+    begin
+        return null record;
+    end Create;
+
+
+end FLTK.Callbacks;
+
diff --git a/src/fltk_binding/fltk-callbacks.ads b/src/fltk_binding/fltk-callbacks.ads
new file mode 100644
index 0000000..cc035ce
--- /dev/null
+++ b/src/fltk_binding/fltk-callbacks.ads
@@ -0,0 +1,21 @@
+
+
+package FLTK.Callbacks is
+
+
+    type Callback is private;
+
+
+    function Create
+           (Call : in 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
new file mode 100644
index 0000000..6620a64
--- /dev/null
+++ b/src/fltk_binding/fltk-menu_items.adb
@@ -0,0 +1,34 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Menu_Items is
+
+
+    procedure Finalize
+           (This : in out Menu_Item) is
+    begin
+        null;
+    end Finalize;
+
+
+
+
+    function Create
+           (Text : in String;
+            Shortcut : in Shortcut_Key;
+            Action : in FLTK.Callbacks.Callback;
+            Flags : Menu_Flag)
+        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
new file mode 100644
index 0000000..51554b0
--- /dev/null
+++ b/src/fltk_binding/fltk-menu_items.ads
@@ -0,0 +1,35 @@
+
+
+with FLTK.Callbacks;
+
+
+package FLTK.Menu_Items is
+
+
+    type Menu_Item is new Wrapper with private;
+
+
+    type Shortcut_Key is Integer;
+    type Menu_Flag is Integer;
+
+
+    function Create
+           (Text : in String;
+            Shortcut : in Shortcut_Key;
+            Action : in FLTK.Callbacks.Callback;
+            Flags : in Menu_Flag)
+        return Menu_Item;
+
+
+private
+
+
+    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-menu_bars.adb b/src/fltk_binding/fltk-widgets-menus-menu_bars.adb
new file mode 100644
index 0000000..8217f79
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-menus-menu_bars.adb
@@ -0,0 +1,55 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Widgets.Menus.Menu_Bars is
+
+
+    function new_fl_menu_bar
+           (X, Y, W, H : in Interfaces.C.int;
+            Text       : in Interfaces.C.char_array)
+        return System.Address;
+    pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar");
+
+    procedure free_fl_menu_bar
+           (M : in System.Address);
+    pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar");
+
+
+
+
+    procedure Finalize
+           (This : in out Menu_Bar) is
+    begin
+        Finalize (Menu (This));
+        if This.Void_Ptr /= System.Null_Address then
+            if This in Menu_Bar then
+                free_fl_menu_bar (This.Void_Ptr);
+            end if;
+        end if;
+    end Finalize;
+
+
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Text       : in String)
+        return Menu_Bar is
+    begin
+        return This : Menu_Bar do
+            This.Void_Ptr := new_fl_menu_bar
+                   (Interfaces.C.int (X),
+                    Interfaces.C.int (Y),
+                    Interfaces.C.int (W),
+                    Interfaces.C.int (H),
+                    Interfaces.C.To_C (Text));
+        end return;
+    end Create;
+
+
+end FLTK.Widgets.Menus.Menu_Bars;
+
diff --git a/src/fltk_binding/fltk-widgets-menus-menu_bars.ads b/src/fltk_binding/fltk-widgets-menus-menu_bars.ads
new file mode 100644
index 0000000..0f975b3
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-menus-menu_bars.ads
@@ -0,0 +1,26 @@
+
+
+package FLTK.Widgets.Menus.Menu_Bars is
+
+
+    type Menu_Bar is new Menu with private;
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Text       : in String)
+        return Menu_Bar;
+
+
+private
+
+
+    type Menu_Bar is new Menu with null record;
+
+
+    overriding procedure Finalize
+           (This : in out Menu_Bar);
+
+
+end FLTK.Widgets.Menus.Menu_Bars;
+
diff --git a/src/fltk_binding/fltk-widgets-menus.adb b/src/fltk_binding/fltk-widgets-menus.adb
new file mode 100644
index 0000000..d102e41
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-menus.adb
@@ -0,0 +1,20 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Widgets.Menus is
+
+
+    procedure Initialize
+           (This : in out Menu) is
+    begin
+        Initialize (Widget (This));
+        This.Menu_Item_List := Menu_Vectors.Empty_Vector;
+    end Initialize;
+
+
+end FLTK.Widgets.Menus;
+
diff --git a/src/fltk_binding/fltk-widgets-menus.ads b/src/fltk_binding/fltk-widgets-menus.ads
new file mode 100644
index 0000000..7a08de4
--- /dev/null
+++ b/src/fltk_binding/fltk-widgets-menus.ads
@@ -0,0 +1,38 @@
+
+
+private with Ada.Containers.Vectors;
+private with FLTK.Menu_Items;
+
+
+package FLTK.Widgets.Menus is
+
+
+    type Menu is abstract new Widget with private;
+    type Index is new Positive;
+
+
+    function Create
+           (X, Y, W, H : in Integer;
+            Text       : in String)
+        return Menu is abstract;
+
+
+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
+        record
+            Menu_Item_List : Menu_Vectors.Vector;
+        end record;
+
+
+    overriding procedure Initialize
+           (This : in out Menu);
+
+
+end FLTK.Widgets.Menus;
+