From 508e2ca78bc531ace4e383b8ca501cc9997d4073 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Fri, 24 Jan 2025 13:58:34 +1300 Subject: Fixed framerate bug in animated test, used Ada2022 aggregates in animated/arc tests, other slight test improvements --- fltkada.gpr | 10 ++++++---- proj/common.gpr | 14 ++++++++++++++ test/animated.adb | 25 ++++++++++++------------- test/arc.adb | 51 +++++++++++++++++++-------------------------------- test/ask.adb | 9 ++++----- test/bitmap.adb | 5 +++-- tests.gpr | 11 +++-------- tests_2022.gpr | 32 ++++++++++++++++++++++++++++++++ tools.gpr | 9 ++++++--- 9 files changed, 99 insertions(+), 67 deletions(-) create mode 100644 proj/common.gpr create mode 100644 tests_2022.gpr diff --git a/fltkada.gpr b/fltkada.gpr index d174937..d09f775 100644 --- a/fltkada.gpr +++ b/fltkada.gpr @@ -1,5 +1,10 @@ +with + + "proj/common"; + + library project FLTKAda is @@ -11,10 +16,7 @@ library project FLTKAda is for Library_Name use "fltkada"; for Library_Kind use "dynamic"; - package Compiler is - for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt"); - for Default_Switches("C++") use ("-Wall","-Wextra","-std=c++11"); - end Compiler; + package Compiler renames Common.Compiler; end FLTKAda; diff --git a/proj/common.gpr b/proj/common.gpr new file mode 100644 index 0000000..64c4dc1 --- /dev/null +++ b/proj/common.gpr @@ -0,0 +1,14 @@ + + +abstract project Common is + + + package Compiler is + for Default_Switches ("Ada") use ("-gnaty4aAbcefhiklM100nprt"); + for Default_Switches("C++") use ("-Wall","-Wextra","-std=c++11"); + end Compiler; + + +end Common; + + diff --git a/test/animated.adb b/test/animated.adb index b512284..42d2a49 100644 --- a/test/animated.adb +++ b/test/animated.adb @@ -7,6 +7,9 @@ -- Alpha rendering benchmark test program functionality duplicated in Ada +pragma Ada_2022; + + with FLTK.Draw, @@ -34,9 +37,6 @@ is subtype Image_Data is FLTK.Color_Component_Array (1 .. Dimension ** 2 * Channels); type Image_Data_Array is array (Positive range <>) of Image_Data; - type RGB_Image_Access is access RGB.RGB_Image; - type RGB_Image_Access_Array is array (Positive range <>) of RGB_Image_Access; - procedure Black_Box_Corner (Store : in out Image_Data) is @@ -114,7 +114,7 @@ is end Moving_Blob; - function Make_Images + function Make_Image_Data return Image_Data_Array is begin return Pict_Data : Image_Data_Array (1 .. Frames) := (others => (others => 0)) do @@ -124,11 +124,15 @@ is Moving_Blob (Pict_Data (Index), Index); end loop; end return; - end Make_Images; + end Make_Image_Data; - Frame_Image_Data : Image_Data_Array := Make_Images; - Frame_Images : RGB_Image_Access_Array (1 .. Frames); + Frame_Image_Data : constant Image_Data_Array := Make_Image_Data; + + -- This syntax requires Ada 2022, but it allows all overt heap usage to be avoided + Frame_Images : array (Positive range <>) of RGB.RGB_Image := + (for Index in Frame_Image_Data'Range => + RGB.Forge.Create (Frame_Image_Data (Index), Dimension, Dimension, Channels)); Current_Frame : Integer range 1 .. Frames := 1; @@ -154,18 +158,13 @@ is begin The_Window.Redraw; Stc.Repeat_Timeout (1.0 / 24.0, Frame_Update'Unrestricted_Access); - Current_Frame := (Current_Frame + 1) mod Frames + 1; + Current_Frame := Current_Frame mod Frames + 1; end Frame_Update; begin - for Index in Frame_Images'Range loop - Frame_Images (Index) := new RGB.RGB_Image'(RGB.Forge.Create - (Frame_Image_Data (Index), Dimension, Dimension, Channels)); - end loop; - The_Window.Set_Background_Color (FLTK.RGB_Color (142, 0, 0)); The_Window.Show_With_Args; diff --git a/test/arc.adb b/test/arc.adb index 88d2214..327b13f 100644 --- a/test/arc.adb +++ b/test/arc.adb @@ -7,6 +7,9 @@ -- Arc drawing test program functionality duplicated in Ada +pragma Ada_2022; + + with FLTK.Draw, @@ -74,39 +77,23 @@ is Index : Integer range Arg_Values'Range; end record; + X_Str : aliased constant String := "X"; + Y_Str : aliased constant String := "Y"; + R_Str : aliased constant String := "R"; + Start_Str : aliased constant String := "start"; + End_Str : aliased constant String := "end"; + Rotate_Str : aliased constant String := "rotate"; - -- Trying out some stack allocation for this one - - Slider_One : aliased My_Slider := - (HV.Forge.Create (The_Window, 50, 300, 240, 25, "X") - with Index => 1); - - Slider_Two : aliased My_Slider := - (HV.Forge.Create (The_Window, 50, 325, 240, 25, "Y") - with Index => 2); - - Slider_Three : aliased My_Slider := - (HV.Forge.Create (The_Window, 50, 350, 240, 25, "R") - with Index => 3); - - Slider_Four : aliased My_Slider := - (HV.Forge.Create (The_Window, 50, 375, 240, 25, "start") - with Index => 4); - - Slider_Five : aliased My_Slider := - (HV.Forge.Create (The_Window, 50, 400, 240, 25, "end") - with Index => 5); - - Slider_Six : aliased My_Slider := - (HV.Forge.Create (The_Window, 50, 425, 240, 25, "rotate") - with Index => 6); - - - type Slider_Access is access all My_Slider; + -- A straight up array of strings is not possible because of the different lengths + Slider_Labels : constant array (Positive range <>) of access constant String := + (X_Str'Access, Y_Str'Access, R_Str'Access, + Start_Str'Access, End_Str'Access, Rotate_Str'Access); - Sliders : array (Positive range <>) of Slider_Access := - (Slider_One'Access, Slider_Two'Access, Slider_Three'Access, - Slider_Four'Access, Slider_Five'Access, Slider_Six'Access); + -- This syntax requires Ada 2022, but it allows all overt heap usage to be avoided + Sliders : array (Positive range <>) of My_Slider := + (for Place in Slider_Labels'Range => + (HV.Forge.Create (The_Window, 50, 275 + Place * 25, 240, 25, Slider_Labels (Place).all) + with Index => Place)); procedure Slider_Callback @@ -122,7 +109,7 @@ is begin - for Place in Integer range 1 .. 6 loop + for Place in Sliders'Range loop if Place <= 3 then Sliders (Place).Set_Minimum (0.0); Sliders (Place).Set_Maximum (300.0); diff --git a/test/ask.adb b/test/ask.adb index 201d245..cb12fff 100644 --- a/test/ask.adb +++ b/test/ask.adb @@ -91,21 +91,20 @@ is Stop : Boolean := False; procedure Timer_Callback is - Change : Long_Float := 5.0; Message_Icon : BX.Box_Reference := AK.Get_Message_Icon; - My_Color : FLTK.Color; + My_Color : FLTK.Color; begin - Stc.Repeat_Timeout (Change, Timer_Callback'Unrestricted_Access); - if Stop then Message_Icon.Set_Background_Color (FLTK.White_Color); return; end if; + Stc.Repeat_Timeout (5.0, Timer_Callback'Unrestricted_Access); + My_Color := Message_Icon.Get_Background_Color; My_Color := (My_Color + 1) mod 32; if My_Color = Message_Icon.Get_Label_Color then - My_Color := My_Color + 1; + My_Color := (My_Color + 1) mod 32; end if; Message_Icon.Set_Background_Color (My_Color); diff --git a/test/bitmap.adb b/test/bitmap.adb index af8ddfa..e6d5094 100644 --- a/test/bitmap.adb +++ b/test/bitmap.adb @@ -16,8 +16,7 @@ with use type - FLTK.Alignment, - FLTK.Widgets.Buttons.State; + FLTK.Alignment; function Bitmap @@ -35,6 +34,8 @@ is Sorceress_Height : constant Integer := 75; + -- It would be slightly more concise to write these numbers in base 10 here + -- but it is vastly easier to use copy/replace on the 0x syntax Sorceress_Bits : constant FLTK.Color_Component_Array := (16#fc#, 16#7e#, 16#40#, 16#20#, 16#90#, 16#00#, 16#07#, 16#80#, 16#23#, 16#00#, 16#00#, 16#c6#, 16#c1#, 16#41#, 16#98#, 16#b8#, 16#01#, 16#07#, 16#66#, 16#00#, 16#15#, 16#9f#, 16#03#, 16#47#, diff --git a/tests.gpr b/tests.gpr index 4670aa0..6137d80 100644 --- a/tests.gpr +++ b/tests.gpr @@ -2,7 +2,8 @@ with - "fltkada"; + "fltkada", + "proj/common"; project Tests is @@ -16,8 +17,6 @@ project Tests is for Main use ("adjuster.adb", - "animated.adb", - "arc.adb", "ask.adb", "bitmap.adb", "compare.adb", @@ -26,8 +25,6 @@ project Tests is package Builder is for Executable ("adjuster.adb") use "adjuster"; - for Executable ("animated.adb") use "animated"; - for Executable ("arc.adb") use "arc"; for Executable ("ask.adb") use "ask"; for Executable ("bitmap.adb") use "bitmap"; for Executable ("compare.adb") use "compare"; @@ -35,9 +32,7 @@ project Tests is for Executable ("page_formats.adb") use "page_formats"; end Builder; - package Compiler is - for Default_Switches ("Ada") use ("-gnaty4aAbcefhiklM100nprt"); - end Compiler; + package Compiler renames Common.Compiler; end Tests; diff --git a/tests_2022.gpr b/tests_2022.gpr new file mode 100644 index 0000000..4217c08 --- /dev/null +++ b/tests_2022.gpr @@ -0,0 +1,32 @@ + + +with + + "fltkada", + "proj/common"; + + +project Tests_2022 is + + + for Languages use ("Ada"); + + for Source_Dirs use ("test"); + for Object_Dir use "obj"; + for Exec_Dir use "bin"; + + for Main use + ("animated.adb", + "arc.adb"); + + package Builder is + for Executable ("animated.adb") use "animated"; + for Executable ("arc.adb") use "arc"; + end Builder; + + package Compiler renames Common.Compiler; + + +end Tests_2022; + + diff --git a/tools.gpr b/tools.gpr index 361664b..6374b2a 100644 --- a/tools.gpr +++ b/tools.gpr @@ -1,5 +1,10 @@ +with + + "proj/common"; + + project Tools is @@ -15,9 +20,7 @@ project Tools is for Executable ("template.adb") use "template"; end Builder; - package Compiler is - for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt"); - end Compiler; + package Compiler renames Common.Compiler; end Tools; -- cgit