diff options
27 files changed, 197 insertions, 114 deletions
diff --git a/c_fl_group.cpp b/c_fl_group.cpp index 58cb6f3..8adc9dd 100644 --- a/c_fl_group.cpp +++ b/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/c_fl_group.h b/c_fl_group.h index ccd00e7..3c7a8fb 100644 --- a/c_fl_group.h +++ b/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/c_fl_widget.cpp b/c_fl_widget.cpp index 9acc52f..a503dc1 100644 --- a/c_fl_widget.cpp +++ b/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/c_fl_widget.h b/c_fl_widget.h index bfca2a1..8f99d26 100644 --- a/c_fl_widget.h +++ b/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/fltk-widgets-boxes.adb b/fltk-widgets-boxes.adb index 17f8975..7b70f01 100644 --- a/fltk-widgets-boxes.adb +++ b/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/fltk-widgets-buttons-enter.adb b/fltk-widgets-buttons-enter.adb index 196cae1..bbef830 100644 --- a/fltk-widgets-buttons-enter.adb +++ b/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/fltk-widgets-buttons-light-check.adb b/fltk-widgets-buttons-light-check.adb index e73bca0..7f16c9d 100644 --- a/fltk-widgets-buttons-light-check.adb +++ b/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/fltk-widgets-buttons-light-radio.adb b/fltk-widgets-buttons-light-radio.adb index 1c1e0da..1a741b9 100644 --- a/fltk-widgets-buttons-light-radio.adb +++ b/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/fltk-widgets-buttons-light-round-radio.adb b/fltk-widgets-buttons-light-round-radio.adb index 299c350..c61430f 100644 --- a/fltk-widgets-buttons-light-round-radio.adb +++ b/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/fltk-widgets-buttons-light-round.adb b/fltk-widgets-buttons-light-round.adb index 553814b..8be6a4e 100644 --- a/fltk-widgets-buttons-light-round.adb +++ b/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/fltk-widgets-buttons-light.adb b/fltk-widgets-buttons-light.adb index 29f9968..cefc9ef 100644 --- a/fltk-widgets-buttons-light.adb +++ b/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/fltk-widgets-buttons-radio.adb b/fltk-widgets-buttons-radio.adb index 8ca6f44..d3fd405 100644 --- a/fltk-widgets-buttons-radio.adb +++ b/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/fltk-widgets-buttons-repeat.adb b/fltk-widgets-buttons-repeat.adb index 2f2c195..8e81a8e 100644 --- a/fltk-widgets-buttons-repeat.adb +++ b/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/fltk-widgets-buttons-toggle.adb b/fltk-widgets-buttons-toggle.adb index 995f8bf..9b8ce83 100644 --- a/fltk-widgets-buttons-toggle.adb +++ b/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/fltk-widgets-buttons.adb b/fltk-widgets-buttons.adb index 2f2f938..bc79b9c 100644 --- a/fltk-widgets-buttons.adb +++ b/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/fltk-widgets-groups-text_displays-text_editors.adb b/fltk-widgets-groups-text_displays-text_editors.adb index f5eead6..447da2c 100644 --- a/fltk-widgets-groups-text_displays-text_editors.adb +++ b/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/fltk-widgets-groups-text_displays.adb b/fltk-widgets-groups-text_displays.adb index 46d1026..0151536 100644 --- a/fltk-widgets-groups-text_displays.adb +++ b/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/fltk-widgets-groups-windows-double.adb b/fltk-widgets-groups-windows-double.adb index 66cf625..a6a8a83 100644 --- a/fltk-widgets-groups-windows-double.adb +++ b/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/fltk-widgets-groups-windows-single-menu.adb b/fltk-widgets-groups-windows-single-menu.adb index 26fd5ab..2936504 100644 --- a/fltk-widgets-groups-windows-single-menu.adb +++ b/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/fltk-widgets-groups-windows-single.adb b/fltk-widgets-groups-windows-single.adb index 7a9cd32..16c5f44 100644 --- a/fltk-widgets-groups-windows-single.adb +++ b/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/fltk-widgets-groups-windows.adb b/fltk-widgets-groups-windows.adb index c9d01f3..1c29f9b 100644 --- a/fltk-widgets-groups-windows.adb +++ b/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/fltk-widgets-groups.adb b/fltk-widgets-groups.adb index 2f38541..32753ea 100644 --- a/fltk-widgets-groups.adb +++ b/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/fltk-widgets-groups.ads b/fltk-widgets-groups.ads index aa52083..7d6e59b 100644 --- a/fltk-widgets-groups.ads +++ b/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/fltk-widgets-inputs.adb b/fltk-widgets-inputs.adb index 37d99e7..17ab621 100644 --- a/fltk-widgets-inputs.adb +++ b/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/fltk-widgets-menus-menu_bars.adb b/fltk-widgets-menus-menu_bars.adb index 8217f79..19d44e0 100644 --- a/fltk-widgets-menus-menu_bars.adb +++ b/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/fltk-widgets.adb b/fltk-widgets.adb index cffd3f7..0f67ddb 100644 --- a/fltk-widgets.adb +++ b/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/fltk-widgets.ads b/fltk-widgets.ads index 8108a5d..3f02302 100644 --- a/fltk-widgets.ads +++ b/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; |