From 5f4595813d3ab42bad6e86e6509d0cbedc972926 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 21 Jan 2025 11:21:22 +1300 Subject: Adjusted project files --- test/adjuster.adb | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++ test/adjuster_test.adb | 79 -------------------------------------------------- 2 files changed, 79 insertions(+), 79 deletions(-) create mode 100644 test/adjuster.adb delete mode 100644 test/adjuster_test.adb (limited to 'test') diff --git a/test/adjuster.adb b/test/adjuster.adb new file mode 100644 index 0000000..ef2bdfb --- /dev/null +++ b/test/adjuster.adb @@ -0,0 +1,79 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +-- Adjuster test program functionality duplicated in Ada + + +with + + Ada.Command_Line, + FLTK.Widgets.Boxes, + FLTK.Widgets.Groups.Windows.Double, + FLTK.Widgets.Valuators.Adjusters; + + +function Adjuster + return Integer +is + + + package ACom renames Ada.Command_Line; + package BX renames FLTK.Widgets.Boxes; + package DW renames FLTK.Widgets.Groups.Windows.Double; + package AD renames FLTK.Widgets.Valuators.Adjusters; + + + type My_Adjuster is new AD.Adjuster with record + Rect : access BX.Box; + end record; + + + procedure Adjust_Callback + (This : in out FLTK.Widgets.Widget'Class) + is + Just : My_Adjuster renames My_Adjuster (This); + begin + Just.Rect.Set_Label (Just.Format); + Just.Rect.Redraw; + end Adjust_Callback; + + + The_Window : DW.Double_Window := + DW.Forge.Create (320, 100, ACom.Command_Name); + + Box_One : aliased BX.Box := + BX.Forge.Create (The_Window, FLTK.Down_Box, 20, 30, 80, 25); + Just_One : My_Adjuster := + (AD.Forge.Create (The_Window, 20 + 80, 30, 3 * 25, 25) + with Rect => Box_One'Access); + + Box_Two : aliased BX.Box := + BX.Forge.Create (The_Window, FLTK.Down_Box, 20 + 80 + 4 * 25, 30, 80, 25); + Just_Two : My_Adjuster := + (AD.Forge.Create (The_Window, Box_Two.Get_X + Box_Two.Get_W, 10, 25, 3 * 25) + with Rect => Box_Two'Access); + + +begin + + + Box_One.Set_Background_Color (FLTK.White_Color); + Just_One.Set_Callback (Adjust_Callback'Unrestricted_Access); + Just_One.Do_Callback; + + Box_Two.Set_Background_Color (FLTK.White_Color); + Just_Two.Set_Callback (Adjust_Callback'Unrestricted_Access); + Just_Two.Do_Callback; + + The_Window.Set_Resizable (The_Window); + The_Window.Show_With_Args; + + return FLTK.Run; + + +end Adjuster; + + diff --git a/test/adjuster_test.adb b/test/adjuster_test.adb deleted file mode 100644 index 6b05b96..0000000 --- a/test/adjuster_test.adb +++ /dev/null @@ -1,79 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - --- Adjuster test program functionality duplicated in Ada - - -with - - Ada.Command_Line, - FLTK.Widgets.Boxes, - FLTK.Widgets.Groups.Windows.Double, - FLTK.Widgets.Valuators.Adjusters; - - -function Adjuster_Test - return Integer -is - - - package ACom renames Ada.Command_Line; - package BX renames FLTK.Widgets.Boxes; - package DW renames FLTK.Widgets.Groups.Windows.Double; - package AD renames FLTK.Widgets.Valuators.Adjusters; - - - type My_Adjuster is new AD.Adjuster with record - Rect : access BX.Box; - end record; - - - procedure Adjust_Callback - (This : in out FLTK.Widgets.Widget'Class) - is - Just : My_Adjuster renames My_Adjuster (This); - begin - Just.Rect.Set_Label (Just.Format); - Just.Rect.Redraw; - end Adjust_Callback; - - - The_Window : DW.Double_Window := - DW.Forge.Create (320, 100, ACom.Command_Name); - - Box_One : aliased BX.Box := - BX.Forge.Create (The_Window, FLTK.Down_Box, 20, 30, 80, 25); - Just_One : My_Adjuster := - (AD.Forge.Create (The_Window, 20 + 80, 30, 3 * 25, 25) - with Rect => Box_One'Access); - - Box_Two : aliased BX.Box := - BX.Forge.Create (The_Window, FLTK.Down_Box, 20 + 80 + 4 * 25, 30, 80, 25); - Just_Two : My_Adjuster := - (AD.Forge.Create (The_Window, Box_Two.Get_X + Box_Two.Get_W, 10, 25, 3 * 25) - with Rect => Box_Two'Access); - - -begin - - - Box_One.Set_Background_Color (FLTK.White_Color); - Just_One.Set_Callback (Adjust_Callback'Unrestricted_Access); - Just_One.Do_Callback; - - Box_Two.Set_Background_Color (FLTK.White_Color); - Just_Two.Set_Callback (Adjust_Callback'Unrestricted_Access); - Just_Two.Do_Callback; - - The_Window.Set_Resizable (The_Window); - The_Window.Show_With_Args; - - return FLTK.Run; - - -end Adjuster_Test; - - -- cgit