diff options
author | Jed Barber <jjbarber@y7mail.com> | 2016-09-07 02:15:57 +1000 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2016-09-07 02:15:57 +1000 |
commit | 6e16a790b13ec50390c3b019598c1fa649f32c98 (patch) | |
tree | 2ce6f1b773b90c51e6b4dfc2974da6464b1bb29c /src | |
parent | 48f31d9f71523aa9cc027c16e5c8cd48ff1e792a (diff) |
Now using widget user data to refer back to Ada side of things, will enable easy implementation of callbacks
Diffstat (limited to 'src')
28 files changed, 198 insertions, 115 deletions
diff --git a/src/adapad.adb b/src/adapad.adb index 5b22266..7aab4af 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -5,7 +5,7 @@ with Editors; use Editors; with FLTK.Text_Buffers; use FLTK.Text_Buffers; -with FLTK.Widgets.Menus.Menu_Bars; +-- with FLTK.Widgets.Menus.Menu_Bars; function AdaPad return Integer is diff --git a/src/fltk_binding/c_fl_group.cpp b/src/fltk_binding/c_fl_group.cpp index 58cb6f3..8adc9dd 100644 --- a/src/fltk_binding/c_fl_group.cpp +++ b/src/fltk_binding/c_fl_group.cpp @@ -31,8 +31,8 @@ void fl_group_add(GROUP g, WIDGET item) { } -void fl_group_clear(GROUP g) { - reinterpret_cast<Fl_Group*>(g)->clear(); +int fl_group_find(GROUP g, WIDGET item) { + return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); } @@ -50,3 +50,15 @@ void fl_group_remove2(GROUP g, int place) { reinterpret_cast<Fl_Group*>(g)->remove(place); } + + + +int fl_group_children(GROUP g) { + return reinterpret_cast<Fl_Group*>(g)->children(); +} + + +void * fl_group_child(GROUP g, int place) { + return reinterpret_cast<Fl_Group*>(g)->child(place); +} + diff --git a/src/fltk_binding/c_fl_group.h b/src/fltk_binding/c_fl_group.h index ccd00e7..3c7a8fb 100644 --- a/src/fltk_binding/c_fl_group.h +++ b/src/fltk_binding/c_fl_group.h @@ -15,11 +15,14 @@ extern "C" void free_fl_group(GROUP g); extern "C" void fl_group_end(GROUP g); extern "C" void fl_group_add(GROUP g, WIDGET item); -extern "C" void fl_group_clear(GROUP g); +extern "C" int fl_group_find(GROUP g, WIDGET item); extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); extern "C" void fl_group_remove(GROUP g, WIDGET item); extern "C" void fl_group_remove2(GROUP g, int place); +extern "C" int fl_group_children(GROUP g); +extern "C" void * fl_group_child(GROUP g, int place); + #endif diff --git a/src/fltk_binding/c_fl_widget.cpp b/src/fltk_binding/c_fl_widget.cpp index 9acc52f..a503dc1 100644 --- a/src/fltk_binding/c_fl_widget.cpp +++ b/src/fltk_binding/c_fl_widget.cpp @@ -4,6 +4,20 @@ #include "c_fl_widget.h" + + +void * fl_widget_get_user_data(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->user_data(); +} + + +void fl_widget_set_user_data(WIDGET w, void * d) { + reinterpret_cast<Fl_Widget*>(w)->user_data(d); +} + + + + int fl_widget_get_box(WIDGET w) { return reinterpret_cast<Fl_Widget*>(w)->box(); } @@ -53,3 +67,8 @@ void fl_widget_set_label_type(WIDGET w, int l) { reinterpret_cast<Fl_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l)); } + +void * fl_widget_get_parent(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->parent(); +} + diff --git a/src/fltk_binding/c_fl_widget.h b/src/fltk_binding/c_fl_widget.h index bfca2a1..8f99d26 100644 --- a/src/fltk_binding/c_fl_widget.h +++ b/src/fltk_binding/c_fl_widget.h @@ -7,6 +7,10 @@ typedef void* WIDGET; +extern "C" void * fl_widget_get_user_data(WIDGET w); +extern "C" void fl_widget_set_user_data(WIDGET w, void * d); + + extern "C" int fl_widget_get_box(WIDGET w); extern "C" void fl_widget_set_box(WIDGET w, int b); extern "C" const char* fl_widget_get_label(WIDGET w); @@ -17,6 +21,7 @@ extern "C" int fl_widget_get_label_size(WIDGET w); extern "C" void fl_widget_set_label_size(WIDGET w, int s); extern "C" int fl_widget_get_label_type(WIDGET w); extern "C" void fl_widget_set_label_type(WIDGET w, int l); +extern "C" void * fl_widget_get_parent(WIDGET w); #endif diff --git a/src/fltk_binding/fltk-widgets-boxes.adb b/src/fltk_binding/fltk-widgets-boxes.adb index 17f8975..7b70f01 100644 --- a/src/fltk_binding/fltk-widgets-boxes.adb +++ b/src/fltk_binding/fltk-widgets-boxes.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Boxes is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-enter.adb b/src/fltk_binding/fltk-widgets-buttons-enter.adb index 196cae1..bbef830 100644 --- a/src/fltk_binding/fltk-widgets-buttons-enter.adb +++ b/src/fltk_binding/fltk-widgets-buttons-enter.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Enter is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-light-check.adb b/src/fltk_binding/fltk-widgets-buttons-light-check.adb index e73bca0..7f16c9d 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-check.adb +++ b/src/fltk_binding/fltk-widgets-buttons-light-check.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Light.Check is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-light-radio.adb b/src/fltk_binding/fltk-widgets-buttons-light-radio.adb index 1c1e0da..1a741b9 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-radio.adb +++ b/src/fltk_binding/fltk-widgets-buttons-light-radio.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Light.Radio is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb index 299c350..c61430f 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb +++ b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round.adb b/src/fltk_binding/fltk-widgets-buttons-light-round.adb index 553814b..8be6a4e 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light-round.adb +++ b/src/fltk_binding/fltk-widgets-buttons-light-round.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Light.Round is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-light.adb b/src/fltk_binding/fltk-widgets-buttons-light.adb index 29f9968..cefc9ef 100644 --- a/src/fltk_binding/fltk-widgets-buttons-light.adb +++ b/src/fltk_binding/fltk-widgets-buttons-light.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Light is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-radio.adb b/src/fltk_binding/fltk-widgets-buttons-radio.adb index 8ca6f44..d3fd405 100644 --- a/src/fltk_binding/fltk-widgets-buttons-radio.adb +++ b/src/fltk_binding/fltk-widgets-buttons-radio.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Radio is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-repeat.adb b/src/fltk_binding/fltk-widgets-buttons-repeat.adb index 2f2c195..8e81a8e 100644 --- a/src/fltk_binding/fltk-widgets-buttons-repeat.adb +++ b/src/fltk_binding/fltk-widgets-buttons-repeat.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Repeat is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons-toggle.adb b/src/fltk_binding/fltk-widgets-buttons-toggle.adb index 995f8bf..9b8ce83 100644 --- a/src/fltk_binding/fltk-widgets-buttons-toggle.adb +++ b/src/fltk_binding/fltk-widgets-buttons-toggle.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Buttons.Toggle is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-buttons.adb b/src/fltk_binding/fltk-widgets-buttons.adb index 2f2f938..bc79b9c 100644 --- a/src/fltk_binding/fltk-widgets-buttons.adb +++ b/src/fltk_binding/fltk-widgets-buttons.adb @@ -61,6 +61,9 @@ package body FLTK.Widgets.Buttons is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb index f5eead6..447da2c 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb @@ -21,13 +21,6 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - procedure fl_group_end - (TE : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - procedure Finalize (This : in out Text_Editor) is begin @@ -55,6 +48,9 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.adb b/src/fltk_binding/fltk-widgets-groups-text_displays.adb index 46d1026..0151536 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays.adb +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.adb @@ -60,13 +60,6 @@ package body FLTK.Widgets.Groups.Text_Displays is - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - procedure Finalize (This : in out Text_Display) is begin @@ -94,6 +87,9 @@ package body FLTK.Widgets.Groups.Text_Displays is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups-windows-double.adb b/src/fltk_binding/fltk-widgets-groups-windows-double.adb index 66cf625..a6a8a83 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-double.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows-double.adb @@ -30,13 +30,6 @@ package body FLTK.Widgets.Groups.Windows.Double is - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - procedure Finalize (This : in out Double_Window) is begin @@ -64,6 +57,9 @@ package body FLTK.Widgets.Groups.Windows.Double is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; @@ -79,6 +75,9 @@ package body FLTK.Widgets.Groups.Windows.Double is (Interfaces.C.int (W), Interfaces.C.int (H)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb index 26fd5ab..2936504 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb @@ -52,13 +52,6 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - procedure Finalize (This : in out Menu_Window) is begin @@ -86,6 +79,9 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; @@ -101,6 +97,9 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is (Interfaces.C.int (W), Interfaces.C.int (H)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single.adb b/src/fltk_binding/fltk-widgets-groups-windows-single.adb index 7a9cd32..16c5f44 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-single.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows-single.adb @@ -34,13 +34,6 @@ package body FLTK.Widgets.Groups.Windows.Single is - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - procedure Finalize (This : in out Single_Window) is begin @@ -68,6 +61,9 @@ package body FLTK.Widgets.Groups.Windows.Single is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; @@ -83,6 +79,9 @@ package body FLTK.Widgets.Groups.Windows.Single is (Interfaces.C.int (W), Interfaces.C.int (H)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups-windows.adb b/src/fltk_binding/fltk-widgets-groups-windows.adb index c9d01f3..1c29f9b 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows.adb @@ -30,13 +30,6 @@ package body FLTK.Widgets.Groups.Windows is - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - procedure Finalize (This : in out Window) is begin @@ -64,6 +57,9 @@ package body FLTK.Widgets.Groups.Windows is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; @@ -79,6 +75,9 @@ package body FLTK.Widgets.Groups.Windows is (Interfaces.C.int (W), Interfaces.C.int (H)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-groups.adb b/src/fltk_binding/fltk-widgets-groups.adb index 2f38541..32753ea 100644 --- a/src/fltk_binding/fltk-widgets-groups.adb +++ b/src/fltk_binding/fltk-widgets-groups.adb @@ -3,8 +3,6 @@ with Interfaces.C; with System; use type System.Address; -with Ada.Containers.Vectors; -use type Ada.Containers.Count_Type; package body FLTK.Widgets.Groups is @@ -20,17 +18,14 @@ package body FLTK.Widgets.Groups is (G : in System.Address); pragma Import (C, free_fl_group, "free_fl_group"); - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - procedure fl_group_add (G, W : in System.Address); pragma Import (C, fl_group_add, "fl_group_add"); - procedure fl_group_clear - (G : in System.Address); - pragma Import (C, fl_group_clear, "fl_group_clear"); + function fl_group_find + (G, W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_find, "fl_group_find"); procedure fl_group_insert (G, W : in System.Address; @@ -46,15 +41,16 @@ package body FLTK.Widgets.Groups is P : in Interfaces.C.int); pragma Import (C, fl_group_remove2, "fl_group_remove2"); + function fl_group_children + (G : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_children, "fl_group_children"); - - - procedure Initialize - (This : in out Group) is - begin - Initialize (Widget (This)); - This.Widget_List := Widget_Vectors.Empty_Vector; - end Initialize; + function fl_group_child + (G : in System.Address; + I : in Interfaces.C.int) + return System.Address; + pragma Import (C, fl_group_child, "fl_group_child"); @@ -64,9 +60,7 @@ package body FLTK.Widgets.Groups is begin Finalize (Widget (This)); if This.Void_Ptr /= System.Null_Address then - while This.Widget_List.Length > 0 loop - This.Remove (This.Widget_List.Last_Index); - end loop; + This.Clear; if This in Group then free_fl_group (This.Void_Ptr); end if; @@ -89,6 +83,9 @@ package body FLTK.Widgets.Groups is Interfaces.C.int (H), Interfaces.C.To_C (Text)); fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); end return; end Create; @@ -99,11 +96,6 @@ package body FLTK.Widgets.Groups is (This : in out Group; Item : in out Widget'Class) is begin - if Item.Parent /= null then - Item.Parent.Remove (Item); - end if; - This.Widget_List.Append (Item'Unchecked_Access); - Item.Parent := This'Unchecked_Access; fl_group_add (This.Void_Ptr, Item.Void_Ptr); end Add; @@ -114,20 +106,36 @@ package body FLTK.Widgets.Groups is (This : in Group; Place : in Index) return Widget_Cursor is + + Widget_Ptr : System.Address := + fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); + + Actual_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + begin - return Ref : Widget_Cursor (This.Widget_List.Element (Place)); + return Ref : Widget_Cursor (Data => Actual_Widget); end Child; + function Number_Of_Children + (This : in Group) + return Natural is + begin + return Natural (fl_group_children (This.Void_Ptr)); + end Number_Of_Children; + + + + procedure Clear (This : in out Group) is begin - while This.Widget_List.Length > 0 loop - This.Remove (This.Widget_List.Last_Index); + for I in reverse 1 .. This.Number_Of_Children loop + This.Remove (Index (I)); end loop; - fl_group_clear (This.Void_Ptr); end Clear; @@ -138,7 +146,8 @@ package body FLTK.Widgets.Groups is Item : in out Widget'Class) return Index is begin - return This.Widget_List.Find_Index (Item'Unchecked_Access); + -- should set this up to throw an exception if not found + return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); end Find; @@ -149,11 +158,6 @@ package body FLTK.Widgets.Groups is Item : in out Widget'Class; Place : in Index) is begin - if Item.Parent /= null then - Item.Parent.Remove (Item); - end if; - This.Widget_List.Insert (Place, Item'Unchecked_Access); - Item.Parent := This'Unchecked_Access; fl_group_insert (This.Void_Ptr, Item.Void_Ptr, @@ -167,8 +171,6 @@ package body FLTK.Widgets.Groups is (This : in out Group; Item : in out Widget'Class) is begin - Item.Parent := null; - This.Widget_List.Delete (This.Find (Item)); fl_group_remove (This.Void_Ptr, Item.Void_Ptr); end Remove; @@ -179,8 +181,6 @@ package body FLTK.Widgets.Groups is (This : in out Group; Place : in Index) is begin - This.Widget_List.Element (Place).Parent := null; - This.Widget_List.Delete (Place); fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place)); end Remove; diff --git a/src/fltk_binding/fltk-widgets-groups.ads b/src/fltk_binding/fltk-widgets-groups.ads index aa52083..7d6e59b 100644 --- a/src/fltk_binding/fltk-widgets-groups.ads +++ b/src/fltk_binding/fltk-widgets-groups.ads @@ -1,6 +1,6 @@ -private with Ada.Containers.Vectors; +private with System; package FLTK.Widgets.Groups is @@ -27,6 +27,11 @@ package FLTK.Widgets.Groups is return Widget_Cursor; + function Number_Of_Children + (This : in Group) + return Natural; + + procedure Clear (This : in out Group); @@ -56,22 +61,16 @@ package FLTK.Widgets.Groups is private - type Widget_Access is access all Widget'Class; - package Widget_Vectors is new Ada.Containers.Vectors (Index, Widget_Access); - - - type Group is new Widget with - record - Widget_List : Widget_Vectors.Vector; - end record; + type Group is new Widget with null record; - overriding procedure Initialize + overriding procedure Finalize (This : in out Group); - overriding procedure Finalize - (This : in out Group); + procedure fl_group_end + (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); end FLTK.Widgets.Groups; diff --git a/src/fltk_binding/fltk-widgets-inputs.adb b/src/fltk_binding/fltk-widgets-inputs.adb index 37d99e7..17ab621 100644 --- a/src/fltk_binding/fltk-widgets-inputs.adb +++ b/src/fltk_binding/fltk-widgets-inputs.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Inputs is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets-menus-menu_bars.adb b/src/fltk_binding/fltk-widgets-menus-menu_bars.adb index 8217f79..19d44e0 100644 --- a/src/fltk_binding/fltk-widgets-menus-menu_bars.adb +++ b/src/fltk_binding/fltk-widgets-menus-menu_bars.adb @@ -47,6 +47,9 @@ package body FLTK.Widgets.Menus.Menu_Bars is 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)); end return; end Create; diff --git a/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb index cffd3f7..0f67ddb 100644 --- a/src/fltk_binding/fltk-widgets.adb +++ b/src/fltk_binding/fltk-widgets.adb @@ -3,12 +3,19 @@ with Interfaces.C; with Interfaces.C.Strings; with System; -with FLTK.Widgets.Groups; +with System.Address_To_Access_Conversions; +with FLTK.Widgets.Groups; use FLTK.Widgets.Groups; +use type System.Address; package body FLTK.Widgets is + package Group_Convert is new System.Address_To_Access_Conversions (Group'Class); + + + + function fl_widget_get_box (W : in System.Address) return Interfaces.C.int; @@ -59,16 +66,10 @@ package body FLTK.Widgets is L : in Interfaces.C.int); pragma Import (C, fl_widget_set_label_type, "fl_widget_set_label_type"); - - - - procedure Finalize - (This : in out Widget) is - begin - if This.Parent /= null then - This.Parent.Remove (This); - end if; - end Finalize; + function fl_widget_get_parent + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); @@ -76,8 +77,16 @@ package body FLTK.Widgets is function Parent (This : in Widget) return Group_Cursor is + + Parent_Ptr : System.Address; + Actual_Parent : access Group'Class; + begin - return Ref : Group_Cursor (Data => This.Parent); + Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); + if Parent_Ptr /= System.Null_Address then + Actual_Parent := Group_Convert.To_Pointer (fl_widget_get_user_data (Parent_Ptr)); + end if; + return Ref : Group_Cursor (Data => Actual_Parent); end Parent; diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads index 8108a5d..3f02302 100644 --- a/src/fltk_binding/fltk-widgets.ads +++ b/src/fltk_binding/fltk-widgets.ads @@ -2,6 +2,8 @@ with FLTK.Enums; use FLTK.Enums; limited with FLTK.Widgets.Groups; +private with System; +private with System.Address_To_Access_Conversions; package FLTK.Widgets is @@ -86,14 +88,21 @@ package FLTK.Widgets is private - type Widget is abstract new Wrapper with - record - Parent : access FLTK.Widgets.Groups.Group; - end record; + type Widget is abstract new Wrapper with null record; - overriding procedure Finalize - (This : in out Widget); + package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); + + + function fl_widget_get_user_data + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); + + + procedure fl_widget_set_user_data + (W, D : in System.Address); + pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); end FLTK.Widgets; |