aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/animated.adb21
-rw-r--r--test/ask.adb10
-rw-r--r--test/bitmap.adb2
-rw-r--r--test/button.adb4
-rw-r--r--test/buttons.adb1
-rw-r--r--test/clock.adb8
-rw-r--r--test/color_chooser.adb14
-rw-r--r--test/compare.adb10
-rw-r--r--test/cursor.adb4
-rw-r--r--test/dirlist.adb11
-rw-r--r--test/filename.adb40
-rw-r--r--test/pixmap.adb8
12 files changed, 88 insertions, 45 deletions
diff --git a/test/animated.adb b/test/animated.adb
index 42d2a49..4f6f590 100644
--- a/test/animated.adb
+++ b/test/animated.adb
@@ -34,7 +34,8 @@ is
Dimension : constant Integer := 256;
- subtype Image_Data is FLTK.Color_Component_Array (1 .. Dimension ** 2 * Channels);
+ subtype Image_Data is FLTK.Color_Component_Array
+ (1 .. FLTK.Size_Type (Dimension ** 2 * Channels));
type Image_Data_Array is array (Positive range <>) of Image_Data;
@@ -43,7 +44,7 @@ is
begin
for X in Integer range 0 .. 9 loop
for Y in Integer range 0 .. 9 loop
- Store (Y * Dimension * Channels + X * Channels + 4) := 255;
+ Store (FLTK.Size_Type (Channels * (Y * Dimension + X) + 4)) := 255;
end loop;
end loop;
end Black_Box_Corner;
@@ -82,10 +83,10 @@ is
My_Alpha := FLTK.Color_Component (Float (My_Alpha) * (1.0 - Fill) * 10.0);
end if;
- Store (Y * Dimension * Channels + X * Channels + 1) := Grey;
- Store (Y * Dimension * Channels + X * Channels + 2) := Grey;
- Store (Y * Dimension * Channels + X * Channels + 3) := Grey;
- Store (Y * Dimension * Channels + X * Channels + 4) := My_Alpha;
+ Store (FLTK.Size_Type (Channels * (Y * Dimension + X) + 1)) := Grey;
+ Store (FLTK.Size_Type (Channels * (Y * Dimension + X) + 2)) := Grey;
+ Store (FLTK.Size_Type (Channels * (Y * Dimension + X) + 3)) := Grey;
+ Store (FLTK.Size_Type (Channels * (Y * Dimension + X) + 4)) := My_Alpha;
end if;
end loop;
end loop;
@@ -106,8 +107,10 @@ is
if (X + X_Offset >= 0) and (X + X_Offset < Dimension) then
for Y in Integer range Y_Offset - W .. Y_Offset + W - 1 loop
Grey := FLTK.Color_Component (abs (Y - Y_Offset));
- Store (Y * Dimension * Channels + (X + X_Offset) * Channels + 3) := Grey;
- Store (Y * Dimension * Channels + (X + X_Offset) * Channels + 4) := 127;
+ Store (FLTK.Size_Type
+ (Channels * (Y * Dimension + (X + X_Offset)) + 3)) := Grey;
+ Store (FLTK.Size_Type
+ (Channels * (Y * Dimension + (X + X_Offset)) + 4)) := 127;
end loop;
end if;
end loop;
@@ -130,7 +133,7 @@ is
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 :=
+ Frame_Images : constant array (Positive range <>) of RGB.RGB_Image :=
(for Index in Frame_Image_Data'Range =>
RGB.Forge.Create (Frame_Image_Data (Index), Dimension, Dimension, Channels));
diff --git a/test/ask.adb b/test/ask.adb
index cb12fff..81ab104 100644
--- a/test/ask.adb
+++ b/test/ask.adb
@@ -16,7 +16,6 @@ with
FLTK.Widgets.Boxes,
FLTK.Widgets.Buttons,
FLTK.Widgets.Buttons.Enter,
- FLTK.Widgets.Inputs.Text,
FLTK.Widgets.Groups.Windows.Double;
use type
@@ -38,7 +37,6 @@ is
package BX renames FLTK.Widgets.Boxes;
package BTN renames FLTK.Widgets.Buttons;
package ENT renames FLTK.Widgets.Buttons.Enter;
- package INP renames FLTK.Widgets.Inputs.Text;
package WD renames FLTK.Widgets.Groups.Windows.Double;
@@ -54,7 +52,7 @@ is
procedure Rename_Me
(Item : in out FLTK.Widgets.Widget'Class)
is
- Input : String := AK.Text_Input ("Input:", Item.Get_Label);
+ Input : constant String := AK.Text_Input ("Input:", Item.Get_Label);
begin
Update_Input_Text (Item, Input);
end Rename_Me;
@@ -63,7 +61,7 @@ is
procedure Rename_Me_Pwd
(Item : in out FLTK.Widgets.Widget'Class)
is
- Input : String := AK.Password ("Input PWD:", Item.Get_Label);
+ Input : constant String := AK.Password ("Input PWD:", Item.Get_Label);
begin
Update_Input_Text (Item, Input);
end Rename_Me_Pwd;
@@ -72,7 +70,7 @@ is
procedure Window_Callback
(Item : in out FLTK.Widgets.Widget'Class)
is
- Hotspot : Boolean := AK.Get_Message_Hotspot;
+ Hotspot : constant Boolean := AK.Get_Message_Hotspot;
Reply : AK.Choice_Result;
begin
AK.Set_Message_Hotspot (False);
@@ -91,7 +89,7 @@ is
Stop : Boolean := False;
procedure Timer_Callback is
- Message_Icon : BX.Box_Reference := AK.Get_Message_Icon;
+ Message_Icon : constant BX.Box_Reference := AK.Get_Message_Icon;
My_Color : FLTK.Color;
begin
if Stop then
diff --git a/test/bitmap.adb b/test/bitmap.adb
index 86c1406..04f4793 100644
--- a/test/bitmap.adb
+++ b/test/bitmap.adb
@@ -117,7 +117,7 @@ is
procedure Button_Callback
- (Item : in out FLTK.Widgets.Widget'Class)
+ (Ignore : in out FLTK.Widgets.Widget'Class)
is
New_Align : FLTK.Alignment;
begin
diff --git a/test/button.adb b/test/button.adb
index 9ca6102..1cd6557 100644
--- a/test/button.adb
+++ b/test/button.adb
@@ -29,7 +29,7 @@ is
procedure Beep_Callback
- (This : in out Wdg.Widget'Class) is
+ (Ignore : in out Wdg.Widget'Class) is
begin
Ask.Beep;
end Beep_Callback;
@@ -39,7 +39,7 @@ is
procedure Exit_Callback
- (This : in out Wdg.Widget'Class) is
+ (Ignore : in out Wdg.Widget'Class) is
begin
ACom.Set_Exit_Status (ACom.Success);
The_Window.Hide;
diff --git a/test/buttons.adb b/test/buttons.adb
index e93da8e..a502f44 100644
--- a/test/buttons.adb
+++ b/test/buttons.adb
@@ -9,7 +9,6 @@
with
- FLTK.Tooltips,
FLTK.Widgets.Buttons.Enter,
FLTK.Widgets.Buttons.Light.Check,
FLTK.Widgets.Buttons.Light.Round,
diff --git a/test/clock.adb b/test/clock.adb
index b4d8f40..e550941 100644
--- a/test/clock.adb
+++ b/test/clock.adb
@@ -23,11 +23,11 @@ is
package WD renames FLTK.Widgets.Groups.Windows.Double;
- Window_One : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Clock");
- Clock_One : CL.Updated_Clock := CL.Forge.Create (Window_One, 0, 0, 220, 220);
+ Window_One : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Clock");
+ Clock_One : constant CL.Updated_Clock := CL.Forge.Create (Window_One, 0, 0, 220, 220);
- Window_Two : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Round_Clock");
- Clock_Two : CR.Round_Clock := CR.Forge.Create (Window_Two, 0, 0, 220, 220);
+ Window_Two : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Round_Clock");
+ Clock_Two : constant CR.Round_Clock := CR.Forge.Create (Window_Two, 0, 0, 220, 220);
begin
diff --git a/test/color_chooser.adb b/test/color_chooser.adb
index 09003b9..1c7537c 100644
--- a/test/color_chooser.adb
+++ b/test/color_chooser.adb
@@ -21,6 +21,7 @@ with
use type
FLTK.Color,
+ FLTK.Size_Type,
FLTK.Asks.Confirm_Result;
@@ -44,14 +45,14 @@ is
return FLTK.Color_Component_Array
is
X_Frac, Y_Frac : Long_Float;
- Offset : Integer;
+ Offset : FLTK.Size_Type;
begin
- return Data : FLTK.Color_Component_Array (1 .. W * H * 3) do
+ return Data : FLTK.Color_Component_Array (1 .. FLTK.Size_Type (W * H * 3)) do
for Y in 0 .. H - 1 loop
Y_Frac := Long_Float (Y) / Long_Float (H - 1);
for X in 0 .. W - 1 loop
X_Frac := Long_Float (X) / Long_Float (W - 1);
- Offset := 3 * (Y * W + X);
+ Offset := 3 * FLTK.Size_Type (Y * W + X);
Data (Offset + 1) :=
FLTK.Color_Component (255.0 * (1.0 - X_Frac) * (1.0 - Y_Frac));
Data (Offset + 2) :=
@@ -66,7 +67,8 @@ is
Image_Width, Image_Height : constant Natural := 100;
- The_Image_Data : FLTK.Color_Component_Array := Make_Image_Data (Image_Width, Image_Height);
+ The_Image_Data : constant FLTK.Color_Component_Array :=
+ Make_Image_Data (Image_Width, Image_Height);
type Pens is new Bx.Box with null record;
@@ -108,7 +110,7 @@ is
procedure Callback_One
- (This : in out FLTK.Widgets.Widget'Class) is
+ (Ignore : in out FLTK.Widgets.Widget'Class) is
begin
My_Color := Ask.Show_Colormap (My_Color);
The_Box.Set_Background_Color (My_Color);
@@ -118,7 +120,7 @@ is
procedure Callback_Two
- (This : in out FLTK.Widgets.Widget'Class)
+ (Ignore : in out FLTK.Widgets.Widget'Class)
is
R, G, B : FLTK.Color_Component;
begin
diff --git a/test/compare.adb b/test/compare.adb
index 2273414..a631416 100644
--- a/test/compare.adb
+++ b/test/compare.adb
@@ -15,11 +15,11 @@ procedure Compare is
package TIO renames Ada.Text_IO;
package FFN renames FLTK.Filenames;
- Aardvark : String := "aardvark";
- Zebra : String := "Zebra";
- Two : String := "item_2";
- Ten : String := "item_10";
- Cap_Ten : String := "Item_10";
+ Aardvark : constant String := "aardvark";
+ Zebra : constant String := "Zebra";
+ Two : constant String := "item_2";
+ Ten : constant String := "item_10";
+ Cap_Ten : constant String := "Item_10";
begin
diff --git a/test/cursor.adb b/test/cursor.adb
index e968b6f..93d3f2b 100644
--- a/test/cursor.adb
+++ b/test/cursor.adb
@@ -16,7 +16,7 @@ with
use type
- FLTK.Widgets.Callback_Flag;
+ FLTK.Callback_Flag;
function Cursor
@@ -95,7 +95,7 @@ begin
The_Choices.Add ("FL_CURSOR_NONE", Choice_Callback'Unrestricted_Access);
The_Choices.Set_Callback (Choice_Callback'Unrestricted_Access);
- The_Choices.Set_When (FLTK.Widgets.When_Release + FLTK.Widgets.When_Interact);
+ The_Choices.Set_When (FLTK.When_Release + FLTK.When_Interact);
The_Choices.Set_Chosen (1);
The_Slider.Set_Alignment (FLTK.Align_Left);
diff --git a/test/dirlist.adb b/test/dirlist.adb
index 1a07515..a7c159a 100644
--- a/test/dirlist.adb
+++ b/test/dirlist.adb
@@ -39,7 +39,7 @@ begin
end if;
declare
- Name : Fil.Path_String := Fil.Expand (ACom.Argument (1));
+ Name : constant Fil.Path_String := Fil.Expand (ACom.Argument (1));
begin
if not Fil.Is_Directory (Name) then
TIO.Put_Line ("Error: " & Name & " is not a valid directory.");
@@ -48,7 +48,7 @@ begin
end if;
declare
- The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Alpha_Sort'Access);
+ The_List : constant Fil.File_List := Fil.Get_Listing (Name, Fil.Alpha_Sort'Access);
begin
TIO.Put_Line ("Alphabetical Sort:");
for Index in 1 .. The_List.Length loop
@@ -58,7 +58,7 @@ begin
end;
declare
- The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Case_Alpha_Sort'Access);
+ The_List : constant Fil.File_List := Fil.Get_Listing (Name, Fil.Case_Alpha_Sort'Access);
begin
TIO.Put_Line ("Case Insensitive Alphabetical Sort:");
for Index in 1 .. The_List.Length loop
@@ -68,7 +68,7 @@ begin
end;
declare
- The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Numeric_Sort'Access);
+ The_List : constant Fil.File_List := Fil.Get_Listing (Name, Fil.Numeric_Sort'Access);
begin
TIO.Put_Line ("Numeric Sort:");
for Index in 1 .. The_List.Length loop
@@ -78,7 +78,8 @@ begin
end;
declare
- The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Case_Numeric_Sort'Access);
+ The_List : constant Fil.File_List :=
+ Fil.Get_Listing (Name, Fil.Case_Numeric_Sort'Access);
begin
TIO.Put_Line ("Case Insensitive Numeric Sort:");
for Index in 1 .. The_List.Length loop
diff --git a/test/filename.adb b/test/filename.adb
new file mode 100644
index 0000000..937fba4
--- /dev/null
+++ b/test/filename.adb
@@ -0,0 +1,40 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Command_Line,
+ Ada.Text_IO,
+ FLTK.Filenames;
+
+
+procedure Filename is
+
+ package ACom renames Ada.Command_Line;
+ package TIO renames Ada.Text_IO;
+ package Fil renames FLTK.Filenames;
+
+begin
+
+ TIO.Put_Line ("Test program for FLTK filename absolute and expand functions.");
+ TIO.New_Line;
+ TIO.Put ("Input: ");
+
+ if ACom.Argument_Count /= 1 then
+ TIO.Put_Line ("Error: Need exactly one filename argument.");
+ ACom.Set_Exit_Status (ACom.Failure);
+ return;
+ end if;
+
+ TIO.Put_Line (ACom.Argument (1));
+ TIO.New_Line;
+
+ TIO.Put_Line ("Absolute: " & Fil.Absolute (ACom.Argument (1)));
+ TIO.Put_Line ("Expanded: " & Fil.Expand (ACom.Argument (1)));
+
+end Filename;
+
+
diff --git a/test/pixmap.adb b/test/pixmap.adb
index 0ca3982..a9cf6b7 100644
--- a/test/pixmap.adb
+++ b/test/pixmap.adb
@@ -34,15 +34,15 @@ is
package WD renames FLTK.Widgets.Groups.Windows.Double;
- Porsche_Header : Pix.Header := (64, 64, 4, 1);
+ Porsche_Header : constant Pix.Header := (64, 64, 4, 1);
- Porsche_Colors : Pix.Color_Definition_Array :=
+ Porsche_Colors : constant Pix.Color_Definition_Array :=
((Name => +" ", Kind => Pix.Colorful, Value => +"#background"),
(Name => +".", Kind => Pix.Colorful, Value => +"#000000000000"),
(Name => +"X", Kind => Pix.Colorful, Value => +"#ffd100"),
(Name => +"o", Kind => Pix.Colorful, Value => +"#FFFF00000000"));
- Porsche_Data : Pix.Pixmap_Data :=
+ Porsche_Data : constant Pix.Pixmap_Data :=
(" ",
" .......................... ",
" ..................................... ",
@@ -126,7 +126,7 @@ is
procedure Button_Callback
- (Item : in out FLTK.Widgets.Widget'Class)
+ (Ignore : in out FLTK.Widgets.Widget'Class)
is
New_Align : FLTK.Alignment;
begin
generated by cgit (git 2.30.0) at 2025-07-01 08:06:38 +0000