summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--fltkada.gpr10
-rw-r--r--proj/common.gpr14
-rw-r--r--test/animated.adb25
-rw-r--r--test/arc.adb51
-rw-r--r--test/ask.adb9
-rw-r--r--test/bitmap.adb5
-rw-r--r--tests.gpr11
-rw-r--r--tests_2022.gpr32
-rw-r--r--tools.gpr9
9 files changed, 99 insertions, 67 deletions
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;
generated by cgit (git 2.30.0) at 2025-01-31 02:48:31 +0000