Menu callbacks working, also some quick testing code that'll probably get deleted later because wynaut

1 files changed, 56 insertions, 0 deletions

diff --git a/src/callback_test.adb b/src/callback_test.adb
new file mode 100644
index 0000000..9abd734
--- /dev/null
+++ b/src/callback_test.adb
@@ -0,0 +1,56 @@
+
+
+with FLTK.Widgets;
+use FLTK.Widgets;
+with FLTK.Widgets.Buttons;
+use FLTK.Widgets.Buttons;
+with FLTK.Widgets.Groups.Windows;
+use FLTK.Widgets.Groups.Windows;
+with Ada.Text_IO;
+with Ada.Strings.Unbounded;
+use Ada.Strings.Unbounded;
+
+
+function Callback_Test return Integer is
+
+
+    Main_View : Window := Create (0, 0, 300, 300, "Tester");
+    Pusher : Button := Create (75, 75, 150, 150, "Push me");
+
+
+    type My_Callback is new Widget_Callback with
+        record
+            Msg : Unbounded_String;
+        end record;
+
+    SC : aliased My_Callback := (Msg => To_Unbounded_String ("Hello!"));
+    OC : aliased My_Callback := (Msg => To_Unbounded_String ("And again!"));
+
+    overriding procedure Call
+           (This : in     My_Callback;
+            Item : in out Widget'Class) is
+    begin
+        Ada.Text_IO.Put_Line ("Pushed a button :O");
+        Ada.Text_IO.Put_Line (To_String (This.Msg));
+        if This.Msg = "Hello!" then
+            Item.Set_Callback (OC'Access);
+            Item.Set_Label ("Push me again!");
+        else
+            Item.Set_Callback (SC'Access);
+            Item.Set_Label ("Push me");
+        end if;
+    end Call;
+
+
+begin
+
+
+    Main_View.Add (Pusher);
+    Pusher.Set_Callback (SC'Access);
+    Main_View.Show;
+
+    return FLTK.Run;
+
+
+end Callback_Test;
+