summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--c_fl_menu.cpp8
-rw-r--r--c_fl_menu.h11
-rw-r--r--c_fl_menu_bar.cpp16
-rw-r--r--c_fl_menu_bar.h15
-rw-r--r--fltk-callbacks.adb15
-rw-r--r--fltk-callbacks.ads21
-rw-r--r--fltk-menu_items.adb34
-rw-r--r--fltk-menu_items.ads35
-rw-r--r--fltk-widgets-menus-menu_bars.adb55
-rw-r--r--fltk-widgets-menus-menu_bars.ads26
-rw-r--r--fltk-widgets-menus.adb20
-rw-r--r--fltk-widgets-menus.ads38
12 files changed, 294 insertions, 0 deletions
diff --git a/c_fl_menu.cpp b/c_fl_menu.cpp
new file mode 100644
index 0000000..457d4f1
--- /dev/null
+++ b/c_fl_menu.cpp
@@ -0,0 +1,8 @@
+
+
+#include <FL/Fl_Menu_.H>
+#include "c_fl_menu.h"
+
+
+// wheeee, placeholders
+
diff --git a/c_fl_menu.h b/c_fl_menu.h
new file mode 100644
index 0000000..691277e
--- /dev/null
+++ b/c_fl_menu.h
@@ -0,0 +1,11 @@
+
+
+#ifndef FL_MENU_GUARD
+#define FL_MENU_GUARD
+
+
+typedef void* MENU;
+
+
+#endif
+
diff --git a/c_fl_menu_bar.cpp b/c_fl_menu_bar.cpp
new file mode 100644
index 0000000..3349008
--- /dev/null
+++ b/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/c_fl_menu_bar.h b/c_fl_menu_bar.h
new file mode 100644
index 0000000..a09d22b
--- /dev/null
+++ b/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/fltk-callbacks.adb b/fltk-callbacks.adb
new file mode 100644
index 0000000..717888d
--- /dev/null
+++ b/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/fltk-callbacks.ads b/fltk-callbacks.ads
new file mode 100644
index 0000000..cc035ce
--- /dev/null
+++ b/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/fltk-menu_items.adb b/fltk-menu_items.adb
new file mode 100644
index 0000000..6620a64
--- /dev/null
+++ b/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/fltk-menu_items.ads b/fltk-menu_items.ads
new file mode 100644
index 0000000..51554b0
--- /dev/null
+++ b/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/fltk-widgets-menus-menu_bars.adb b/fltk-widgets-menus-menu_bars.adb
new file mode 100644
index 0000000..8217f79
--- /dev/null
+++ b/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/fltk-widgets-menus-menu_bars.ads b/fltk-widgets-menus-menu_bars.ads
new file mode 100644
index 0000000..0f975b3
--- /dev/null
+++ b/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/fltk-widgets-menus.adb b/fltk-widgets-menus.adb
new file mode 100644
index 0000000..d102e41
--- /dev/null
+++ b/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/fltk-widgets-menus.ads b/fltk-widgets-menus.ads
new file mode 100644
index 0000000..7a08de4
--- /dev/null
+++ b/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;
+
generated by cgit (git 2.30.0) at 2024-12-23 04:53:39 +0000