diff options
Diffstat (limited to 'src/callback_test.adb')
-rw-r--r-- | src/callback_test.adb | 56 |
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; + |