diff options
| -rw-r--r-- | src/c_fl_group.cpp | 62 | ||||
| -rw-r--r-- | src/c_fl_group.h | 3 | ||||
| -rw-r--r-- | src/c_fl_menu.cpp | 59 | ||||
| -rw-r--r-- | src/c_fl_menu.h | 8 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.adb | 33 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.ads | 7 | ||||
| -rw-r--r-- | src/fltk-widgets-menus.adb | 78 | ||||
| -rw-r--r-- | src/fltk-widgets-menus.ads | 22 |
8 files changed, 255 insertions, 17 deletions
diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp index 9ea2764..4546be0 100644 --- a/src/c_fl_group.cpp +++ b/src/c_fl_group.cpp @@ -6,64 +6,104 @@ #include "c_fl_widget.h" +typedef void (hook)(void*); +typedef hook* hook_p; + + + + +class My_Group : public Fl_Group { + public: + using Fl_Group::Fl_Group; + friend void group_set_draw_hook(GROUP g, void * d); + friend void fl_group_draw(GROUP g); + protected: + void draw(); + void real_draw(); + hook_p draw_hook; +}; + + +void My_Group::draw() { + (*draw_hook)(this->user_data()); +} + + +void My_Group::real_draw() { + Fl_Group::draw(); +} + + +void group_set_draw_hook(GROUP g, void * d) { + reinterpret_cast<My_Group*>(g)->draw_hook = reinterpret_cast<hook_p>(d); +} + + +void fl_group_draw(GROUP g) { + reinterpret_cast<My_Group*>(g)->real_draw(); +} + + + + GROUP new_fl_group(int x, int y, int w, int h, char* label) { - Fl_Group *g = new Fl_Group(x, y, w, h, label); + My_Group *g = new My_Group(x, y, w, h, label); return g; } void free_fl_group(GROUP g) { - delete reinterpret_cast<Fl_Group*>(g); + delete reinterpret_cast<My_Group*>(g); } void fl_group_end(GROUP g) { - reinterpret_cast<Fl_Group*>(g)->end(); + reinterpret_cast<My_Group*>(g)->end(); } void fl_group_add(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item)); + reinterpret_cast<My_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item)); } int fl_group_find(GROUP g, WIDGET item) { - return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); + return reinterpret_cast<My_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); } void fl_group_insert(GROUP g, WIDGET item, int place) { - reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); + reinterpret_cast<My_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); } void fl_group_remove(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->remove(reinterpret_cast<Fl_Widget*>(item)); + reinterpret_cast<My_Group*>(g)->remove(reinterpret_cast<Fl_Widget*>(item)); } void fl_group_remove2(GROUP g, int place) { - reinterpret_cast<Fl_Group*>(g)->remove(place); + reinterpret_cast<My_Group*>(g)->remove(place); } void fl_group_resizable(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->resizable(reinterpret_cast<Fl_Widget*>(item)); + reinterpret_cast<My_Group*>(g)->resizable(reinterpret_cast<Fl_Widget*>(item)); } int fl_group_children(GROUP g) { - return reinterpret_cast<Fl_Group*>(g)->children(); + return reinterpret_cast<My_Group*>(g)->children(); } void * fl_group_child(GROUP g, int place) { - return reinterpret_cast<Fl_Group*>(g)->child(place); + return reinterpret_cast<My_Group*>(g)->child(place); } diff --git a/src/c_fl_group.h b/src/c_fl_group.h index 9b58f8c..b2db787 100644 --- a/src/c_fl_group.h +++ b/src/c_fl_group.h @@ -9,6 +9,9 @@ typedef void* GROUP; +extern "C" void group_set_draw_hook(GROUP g, void * d); +extern "C" void fl_group_draw(GROUP g); + extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); extern "C" void free_fl_group(GROUP g); diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp index f8c7b9e..630e63f 100644 --- a/src/c_fl_menu.cpp +++ b/src/c_fl_menu.cpp @@ -5,18 +5,71 @@ #include "c_fl_menu.h" +typedef void (hook)(void*); +typedef hook* hook_p; + + + + +class My_Menu : public Fl_Menu_ { + public: + using Fl_Menu_::Fl_Menu_; + friend void menu_set_draw_hook(MENU m, void * d); + friend void fl_menu_draw(MENU m); + protected: + void draw(); + void real_draw(); + hook_p draw_hook; +}; + + +void My_Menu::draw() { + (*draw_hook)(this->user_data()); +} + + +void My_Menu::real_draw() { + Fl_Menu_::draw(); +} + + +void menu_set_draw_hook(MENU m, void * d) { + reinterpret_cast<My_Menu*>(m)->draw_hook = reinterpret_cast<hook_p>(d); +} + + +void fl_menu_draw(MENU m) { + reinterpret_cast<My_Menu*>(m)->real_draw(); +} + + + + +MENU new_fl_menu(int x, int y, int w, int h, char* label) { + My_Menu *m = new My_Menu(x, y, w, h, label); + return m; +} + + +void free_fl_menu(MENU m) { + delete reinterpret_cast<My_Menu*>(m); +} + + + + 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); + return reinterpret_cast<My_Menu*>(m)->add(t, s, reinterpret_cast<Fl_Callback_p>(c), u, f); } const void * fl_menu_find_item(MENU m, const char * t) { - return reinterpret_cast<Fl_Menu_*>(m)->find_item(t); + return reinterpret_cast<My_Menu*>(m)->find_item(t); } const void * fl_menu_mvalue(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->mvalue(); + return reinterpret_cast<My_Menu*>(m)->mvalue(); } diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h index 2b9aa68..9276ccb 100644 --- a/src/c_fl_menu.h +++ b/src/c_fl_menu.h @@ -8,6 +8,14 @@ typedef void* MENU; // typedef void* MENUITEM; +extern "C" void menu_set_draw_hook(MENU m, void * d); +extern "C" void fl_menu_draw(MENU m); + + +extern "C" MENU new_fl_menu(int x, int y, int w, int h, char* label); +extern "C" void free_fl_menu(MENU m); + + extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f); extern "C" const void * fl_menu_find_item(MENU m, const char * t); extern "C" const void * fl_menu_mvalue(MENU m); diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 067407d..9bcb78f 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -8,6 +8,14 @@ use type System.Address; package body FLTK.Widgets.Groups is + procedure group_set_draw_hook + (W, D : in System.Address); + pragma Import (C, group_set_draw_hook, "group_set_draw_hook"); + + procedure fl_group_draw + (W : in System.Address); + pragma Import (C, fl_group_draw, "fl_group_draw"); + function new_fl_group (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -59,6 +67,30 @@ package body FLTK.Widgets.Groups is + procedure Draw_Hook (U : in System.Address); + pragma Convention (C, Draw_Hook); + + procedure Draw_Hook + (U : in System.Address) + is + Ada_Group : access Group'Class := + Group_Convert.To_Pointer (U); + begin + Ada_Group.Draw; + end Draw_Hook; + + + + + procedure Draw + (This : in out Group) is + begin + fl_group_draw (This.Void_Ptr); + end Draw; + + + + procedure Finalize (This : in out Group) is begin @@ -90,6 +122,7 @@ package body FLTK.Widgets.Groups is fl_widget_set_user_data (This.Void_Ptr, Widget_Convert.To_Address (This'Unchecked_Access)); + group_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); end return; end Create; diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index 57faf87..a9453cb 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -66,6 +66,10 @@ package FLTK.Widgets.Groups is private + procedure Draw + (This : in out Group); + + type Group is new Widget with null record; @@ -73,6 +77,9 @@ private (This : in out Group); + package Group_Convert is new System.Address_To_Access_Conversions (Group'Class); + + procedure fl_group_end (G : in System.Address); pragma Import (C, fl_group_end, "fl_group_end"); diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index b92f0a1..afb007c 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -21,6 +21,24 @@ package body FLTK.Widgets.Menus is + procedure menu_set_draw_hook + (W, D : in System.Address); + pragma Import (C, menu_set_draw_hook, "menu_set_draw_hook"); + + procedure fl_menu_draw + (W : in System.Address); + pragma Import (C, fl_menu_draw, "fl_menu_draw"); + + function new_fl_menu + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu, "new_fl_menu"); + + procedure free_fl_menu + (F : in System.Address); + pragma Import (C, free_fl_menu, "free_fl_menu"); + function fl_menu_add (M : in System.Address; T : in Interfaces.C.char_array; @@ -57,6 +75,66 @@ package body FLTK.Widgets.Menus is + procedure Draw_Hook (U : in System.Address); + pragma Convention (C, Draw_Hook); + + procedure Draw_Hook + (U : in System.Address) + is + Ada_Menu : access Menu'Class := + Menu_Convert.To_Pointer (U); + begin + Ada_Menu.Draw; + end Draw_Hook; + + + + + procedure Draw + (This : in out Menu) is + begin + fl_menu_draw (This.Void_Ptr); + end Draw; + + + + + procedure Finalize + (This : in out Menu) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu then + free_fl_menu (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu is + begin + return This : Menu do + This.Void_Ptr := new_fl_menu + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + menu_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); + end return; + end Create; + + + + procedure Item_Hook (M, U : in System.Address); pragma Convention (C, Item_Hook); diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index d01f02e..c745273 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -8,7 +8,11 @@ private with System; package FLTK.Widgets.Menus is - type Menu is abstract new Widget with private; + -- still abstract, really, because if the Draw procedure isn't + -- overridden it'll call the abstract C++ method + type Menu is new Widget with private; + + type Menu_Cursor (Data : access Menu'Class) is limited null record with Implicit_Dereference => Data; @@ -34,7 +38,7 @@ package FLTK.Widgets.Menus is function Create (X, Y, W, H : in Integer; Text : in String) - return Menu is abstract; + return Menu; procedure Add @@ -72,7 +76,16 @@ package FLTK.Widgets.Menus is private - type Menu is abstract new Widget with null record; + -- must be overridden in any derived types + procedure Draw + (This : in out Menu); + + + type Menu is new Widget with null record; + + + overriding procedure Finalize + (This : in out Menu); type Menu_Item is tagged limited @@ -93,5 +106,8 @@ private Flag_Divider : constant Menu_Flag := 2#10000000#; + package Menu_Convert is new System.Address_To_Access_Conversions (Menu'Class); + + end FLTK.Widgets.Menus; |