diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/animated.adb | 25 | ||||
| -rw-r--r-- | test/arc.adb | 51 | ||||
| -rw-r--r-- | test/ask.adb | 9 | ||||
| -rw-r--r-- | test/bitmap.adb | 5 |
4 files changed, 38 insertions, 52 deletions
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#, |