From 249933f4573a7b812334a24c734cf2630a9bf9fc Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 11 Sep 2016 01:40:45 +1000 Subject: WIDGET CALLBACKS!!! --- fltk-widgets.adb | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) (limited to 'fltk-widgets.adb') diff --git a/fltk-widgets.adb b/fltk-widgets.adb index 0f67ddb..3e27cb7 100644 --- a/fltk-widgets.adb +++ b/fltk-widgets.adb @@ -71,6 +71,10 @@ package body FLTK.Widgets is return System.Address; pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); + procedure fl_widget_set_callback + (W, C : in System.Address); + pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback"); + @@ -190,5 +194,34 @@ package body FLTK.Widgets is end Set_Label_Type; + + + -- this is the part called by FLTK callbacks + -- note that the user data portion is a reference back to the Ada binding + procedure Callback_Hook (W, U : in System.Address); + pragma Convention (C, Callback_Hook); + + procedure Callback_Hook + (W, U : in System.Address) is + + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (U); + + begin + Ada_Widget.Callback.Call (Ada_Widget.all); + end Callback_Hook; + + + + + procedure Set_Callback + (This : in out Widget; + Func : not null access Widget_Callback'Class) is + begin + This.Callback := Func; + fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address); + end Set_Callback; + + end FLTK.Widgets; -- cgit