From e9add081b396a0cbfdf59df9d340afe44d9b9544 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 7 Sep 2016 02:15:57 +1000 Subject: Now using widget user data to refer back to Ada side of things, will enable easy implementation of callbacks --- fltk-widgets.adb | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) (limited to 'fltk-widgets.adb') 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; -- cgit