From 21c86679217e38ecbd0ec933e006e508a1a42be1 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 19 Jul 2016 22:40:37 +1000 Subject: Starting to sketch the outline of menu widgets and callbacks --- src/adapad.adb | 1 + src/fltk_binding/c_fl_menu.cpp | 8 ++++ src/fltk_binding/c_fl_menu.h | 11 +++++ src/fltk_binding/c_fl_menu_bar.cpp | 16 +++++++ src/fltk_binding/c_fl_menu_bar.h | 15 +++++++ src/fltk_binding/fltk-callbacks.adb | 15 +++++++ src/fltk_binding/fltk-callbacks.ads | 21 +++++++++ src/fltk_binding/fltk-menu_items.adb | 34 ++++++++++++++ src/fltk_binding/fltk-menu_items.ads | 35 +++++++++++++++ src/fltk_binding/fltk-widgets-menus-menu_bars.adb | 55 +++++++++++++++++++++++ src/fltk_binding/fltk-widgets-menus-menu_bars.ads | 26 +++++++++++ src/fltk_binding/fltk-widgets-menus.adb | 20 +++++++++ src/fltk_binding/fltk-widgets-menus.ads | 38 ++++++++++++++++ 13 files changed, 295 insertions(+) create mode 100644 src/fltk_binding/c_fl_menu.cpp create mode 100644 src/fltk_binding/c_fl_menu.h create mode 100644 src/fltk_binding/c_fl_menu_bar.cpp create mode 100644 src/fltk_binding/c_fl_menu_bar.h create mode 100644 src/fltk_binding/fltk-callbacks.adb create mode 100644 src/fltk_binding/fltk-callbacks.ads create mode 100644 src/fltk_binding/fltk-menu_items.adb create mode 100644 src/fltk_binding/fltk-menu_items.ads create mode 100644 src/fltk_binding/fltk-widgets-menus-menu_bars.adb create mode 100644 src/fltk_binding/fltk-widgets-menus-menu_bars.ads create mode 100644 src/fltk_binding/fltk-widgets-menus.adb create mode 100644 src/fltk_binding/fltk-widgets-menus.ads 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 +#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 +#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(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; + -- cgit