WIDGET CALLBACKS!!!

1 files changed, 33 insertions, 0 deletions

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;