More test programs added: button, buttons, clock, color_chooser, cursor, curve, hello

18 files changed, 767 insertions, 16 deletions

diff --git a/body/c_fl.cpp b/body/c_fl.cpp
index ec5f7e5..a9e6d16 100644
--- a/body/c_fl.cpp
+++ b/body/c_fl.cpp
@@ -55,6 +55,10 @@ unsigned int fl_enum_rgb_color(unsigned char r, unsigned char g, unsigned char b
     return fl_rgb_color(r, g, b);
 }
 
+unsigned int fl_enum_contrast(unsigned int f, unsigned int b) {
+    return fl_contrast(f, b);
+}
+
 
 
 
diff --git a/body/c_fl.h b/body/c_fl.h
index 9f79979..51dbedb 100644
--- a/body/c_fl.h
+++ b/body/c_fl.h
@@ -41,6 +41,7 @@ extern "C" size_t c_pointer_size();
 
 
 extern "C" unsigned int fl_enum_rgb_color(unsigned char r, unsigned char g, unsigned char b);
+extern "C" unsigned int fl_enum_contrast(unsigned int f, unsigned int b);
 
 
 extern "C" int fl_abi_check(int v);
diff --git a/body/c_fl_ask.cpp b/body/c_fl_ask.cpp
index 20af2e3..30dd480 100644
--- a/body/c_fl_ask.cpp
+++ b/body/c_fl_ask.cpp
@@ -5,6 +5,7 @@
 
 
 #include <FL/fl_ask.H>
+#include <FL/fl_show_colormap.H>
 #include <FL/Fl_File_Chooser.H>
 #include <FL/Fl_Color_Chooser.H>
 #include "c_fl_ask.h"
@@ -90,10 +91,16 @@ int fl_ask_color_chooser(const char * n, double & r, double & g, double & b, int
     return fl_color_chooser(n, r, g, b, m);
 }
 
-int fl_ask_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m) {
+int fl_ask_color_chooser2(const char * n,
+    unsigned char & r, unsigned char & g, unsigned char & b, int m)
+{
     return fl_color_chooser(n, r, g, b, m);
 }
 
+unsigned int fl_ask_show_colormap(unsigned int h) {
+    return static_cast<unsigned int>(fl_show_colormap(static_cast<Fl_Color>(h)));
+}
+
 char * fl_ask_dir_chooser(const char * m, const char * d, int r) {
     return fl_dir_chooser(m, d, r);
 }
diff --git a/body/c_fl_ask.h b/body/c_fl_ask.h
index f68bc85..4c18391 100644
--- a/body/c_fl_ask.h
+++ b/body/c_fl_ask.h
@@ -30,7 +30,9 @@ extern "C" const char * fl_ask_password(const char * m, const char * d);
 
 
 extern "C" int fl_ask_color_chooser(const char * n, double & r, double & g, double & b, int m);
-extern "C" int fl_ask_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m);
+extern "C" int fl_ask_color_chooser2(const char * n,
+    unsigned char & r, unsigned char & g, unsigned char & b, int m);
+extern "C" unsigned int fl_ask_show_colormap(unsigned int h);
 extern "C" char * fl_ask_dir_chooser(const char * m, const char * d, int r);
 extern "C" char * fl_ask_file_chooser(const char * m, const char * p, const char * d, int r);
 extern "C" void fl_ask_file_chooser_callback(void(*cb)(const char *));
diff --git a/body/fltk-asks.adb b/body/fltk-asks.adb
index d6eb8ee..2b27940 100644
--- a/body/fltk-asks.adb
+++ b/body/fltk-asks.adb
@@ -140,6 +140,12 @@ package body FLTK.Asks is
     pragma Import (C, fl_ask_color_chooser2, "fl_ask_color_chooser2");
     pragma Inline (fl_ask_color_chooser2);
 
+    function fl_ask_show_colormap
+           (H : in Interfaces.C.unsigned)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_ask_show_colormap, "fl_ask_show_colormap");
+    pragma Inline (fl_ask_show_colormap);
+
     function fl_ask_dir_chooser
            (M, D : in Interfaces.C.char_array;
             R    : in Interfaces.C.int)
@@ -554,6 +560,14 @@ package body FLTK.Asks is
     end Color_Chooser;
 
 
+    function Show_Colormap
+           (Old_Hue : in Color)
+        return Color is
+    begin
+        return Color (fl_ask_show_colormap (Interfaces.C.unsigned (Old_Hue)));
+    end Show_Colormap;
+
+
     function Dir_Chooser
            (Message, Default : in String;
             Relative         : in Boolean := False)
diff --git a/body/fltk.adb b/body/fltk.adb
index d729364..0e391e3 100644
--- a/body/fltk.adb
+++ b/body/fltk.adb
@@ -23,6 +23,12 @@ package body FLTK is
     pragma Import (C, fl_enum_rgb_color, "fl_enum_rgb_color");
     pragma Inline (fl_enum_rgb_color);
 
+    function fl_enum_contrast
+           (F, B : in Interfaces.C.unsigned)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_contrast, "fl_enum_contrast");
+    pragma Inline (fl_enum_contrast);
+
 
 
 
@@ -120,6 +126,16 @@ package body FLTK is
     end RGB_Color;
 
 
+    function Contrast
+           (Fore, Back : in Color)
+        return Color is
+    begin
+        return Color (fl_enum_contrast
+           (Interfaces.C.unsigned (Fore),
+            Interfaces.C.unsigned (Back)));
+    end Contrast;
+
+
 
 
     function "+"
diff --git a/doc/fl_ask.html b/doc/fl_ask.html
index 6d72892..146c17b 100644
--- a/doc/fl_ask.html
+++ b/doc/fl_ask.html
@@ -24,6 +24,11 @@
     <td>FLTK.Asks</td>
   </tr>
 
+  <tr>
+    <td>fl_show_colormap</td>
+    <td>&nbsp;</td>
+  </tr>
+
 </table>
 
 
@@ -383,6 +388,17 @@ function Password
 </pre></td>
   </tr>
 
+  <tr>
+<td><pre>
+Fl_Color fl_show_colormap(Fl_Color oldcol);
+</pre></td>
+<td><pre>
+function Show_Colormap
+       (Old_Hue : in Color)
+    return Color;
+</pre></td>
+  </tr>
+
 </table>
 
 
diff --git a/spec/fltk-asks.ads b/spec/fltk-asks.ads
index fc6e150..f0d58f8 100644
--- a/spec/fltk-asks.ads
+++ b/spec/fltk-asks.ads
@@ -30,7 +30,7 @@ package FLTK.Asks is
 
     type RGB_Float is new Long_Float range 0.0 .. 1.0;
 
-    type RGB_Int is mod 256;
+    subtype RGB_Int is Color_Component;
 
     type File_Chooser_Callback is access procedure
            (Item : in String);
@@ -131,6 +131,10 @@ package FLTK.Asks is
                 FLTK.Widgets.Groups.Color_Choosers.RGB)
         return Confirm_Result;
 
+    function Show_Colormap
+           (Old_Hue : in Color)
+        return Color;
+
     function Dir_Chooser
            (Message, Default : in String;
             Relative         : in Boolean := False)
@@ -195,6 +199,7 @@ private
     pragma Inline (Password);
 
     pragma Inline (Color_Chooser);
+    pragma Inline (Show_Colormap);
     pragma Inline (Dir_Chooser);
     pragma Inline (File_Chooser);
     pragma Inline (Set_File_Chooser_Callback);
diff --git a/spec/fltk.ads b/spec/fltk.ads
index 6e5ef0f..f341ac2 100644
--- a/spec/fltk.ads
+++ b/spec/fltk.ads
@@ -48,6 +48,10 @@ package FLTK is
            (R, G, B : in Color_Component)
         return Color;
 
+    function Contrast
+           (Fore, Back : in Color)
+        return Color;
+
     --  Examples of RGB colors without the above function
     --  The lowest byte has to be 00 for the color to be RGB
     RGB_Red_Color   : constant Color := 16#ff000000#;
@@ -61,6 +65,9 @@ package FLTK is
     Inactive_Color    : constant Color := 8;
     Selection_Color   : constant Color := 15;
 
+    --  X allocation area
+    Free_Color : constant Color := 16;
+
     --  Standard boxtype colors
     Grey0_Color      : constant Color := 32;
     Dark3_Color      : constant Color := 39;
@@ -145,7 +152,8 @@ package FLTK is
         SW_Mouse,
         W_Mouse,
         NW_Mouse,
-        None_Mouse);
+        None_Mouse)
+    with Default_Value => Default_Mouse;
 
 
 
@@ -620,23 +628,23 @@ private
 
 
 
+    pragma Inline (RGB_Color);
+    pragma Inline (Contrast);
+
     pragma Inline (ABI_Check);
     pragma Inline (ABI_Version);
     pragma Inline (API_Version);
     pragma Inline (Version);
 
-
     pragma Inline (Awake);
     pragma Inline (Lock);
     pragma Inline (Unlock);
 
-
     pragma Inline (Is_Damaged);
     pragma Inline (Set_Damaged);
     pragma Inline (Flush);
     pragma Inline (Redraw);
 
-
     pragma Inline (Check);
     pragma Inline (Ready);
     pragma Inline (Wait);
@@ -645,3 +653,4 @@ private
 
 end FLTK;
 
+
diff --git a/test/button.adb b/test/button.adb
new file mode 100644
index 0000000..9ca6102
--- /dev/null
+++ b/test/button.adb
@@ -0,0 +1,67 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Button/callback test program functionality reproduced in Ada
+
+
+with
+
+    Ada.Command_Line,
+    FLTK.Asks,
+    FLTK.Widgets.Buttons,
+    FLTK.Widgets.Groups.Windows;
+
+
+function Button
+    return Integer
+is
+
+
+    package ACom renames Ada.Command_Line;
+
+    package Ask renames FLTK.Asks;
+    package Wdg renames FLTK.Widgets;
+    package Btn renames FLTK.Widgets.Buttons;
+    package Win renames FLTK.Widgets.Groups.Windows;
+
+
+    procedure Beep_Callback
+           (This : in out Wdg.Widget'Class) is
+    begin
+        Ask.Beep;
+    end Beep_Callback;
+
+
+    The_Window : Win.Window := Win.Forge.Create (320, 65);
+
+
+    procedure Exit_Callback
+           (This : in out Wdg.Widget'Class) is
+    begin
+        ACom.Set_Exit_Status (ACom.Success);
+        The_Window.Hide;
+    end Exit_Callback;
+
+
+    Button_One   : Btn.Button := Btn.Forge.Create (The_Window,  20, 20, 80, 25, "&Beep");
+    Button_Two   : Btn.Button := Btn.Forge.Create (The_Window, 120, 20, 80, 25, "&No Op");
+    Button_Three : Btn.Button := Btn.Forge.Create (The_Window, 220, 20, 80, 25, "E&xit");
+
+
+begin
+
+
+    Button_One.Set_Callback   (Beep_Callback'Unrestricted_Access);
+    Button_Three.Set_Callback (Exit_Callback'Unrestricted_Access);
+
+    The_Window.Show_With_Args;
+
+    return FLTK.Run;
+
+
+end Button;
+
+
diff --git a/test/buttons.adb b/test/buttons.adb
new file mode 100644
index 0000000..e93da8e
--- /dev/null
+++ b/test/buttons.adb
@@ -0,0 +1,59 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Another button test program functionality reproduced in Ada
+
+
+with
+
+    FLTK.Tooltips,
+    FLTK.Widgets.Buttons.Enter,
+    FLTK.Widgets.Buttons.Light.Check,
+    FLTK.Widgets.Buttons.Light.Round,
+    FLTK.Widgets.Buttons.Repeat,
+    FLTK.Widgets.Groups.Windows;
+
+
+function Buttons
+    return Integer
+is
+
+
+    package Btn renames FLTK.Widgets.Buttons;
+    package Ent renames FLTK.Widgets.Buttons.Enter;
+    package Lit renames FLTK.Widgets.Buttons.Light;
+    package Chk renames FLTK.Widgets.Buttons.Light.Check;
+    package Ond renames FLTK.Widgets.Buttons.Light.Round;
+    package Rpt renames FLTK.Widgets.Buttons.Repeat;
+    package Win renames FLTK.Widgets.Groups.Windows;
+
+
+    The_Win : Win.Window := Win.Forge.Create (320, 130);
+
+
+    Base : Btn.Button := Btn.Forge.Create (The_Win, 10, 10, 130, 30, "Fl_Button");
+
+
+    Enter  : Ent.Enter_Button  := Ent.Forge.Create (The_Win, 150, 10, 160, 30, "Fl_Return_Button");
+    Repeat : Rpt.Repeat_Button := Rpt.Forge.Create (The_Win,  10, 50, 130, 30, "Fl_Repeat_Button");
+    Light  : Lit.Light_Button  := Lit.Forge.Create (The_Win,  10, 90, 130, 30, "Fl_Light_Button");
+    Round  : Ond.Round_Button  := Ond.Forge.Create (The_Win, 150, 50, 160, 30, "Fl_Round_Button");
+    Check  : Chk.Check_Button  := Chk.Forge.Create (The_Win, 150, 90, 160, 30, "Fl_Check_Button");
+
+
+begin
+
+
+    Base.Set_Tooltip ("This is a Tooltip.");
+
+    The_Win.Show_With_Args;
+
+    return FLTK.Run;
+
+
+end Buttons;
+
+
diff --git a/test/clock.adb b/test/clock.adb
new file mode 100644
index 0000000..b4d8f40
--- /dev/null
+++ b/test/clock.adb
@@ -0,0 +1,50 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Clock test program functionality reproduced in Ada
+
+
+with
+
+    FLTK.Widgets.Clocks.Updated.Round,
+    FLTK.Widgets.Groups.Windows.Double;
+
+
+function Clock
+    return Integer
+is
+
+
+    package CL renames FLTK.Widgets.Clocks.Updated;
+    package CR renames FLTK.Widgets.Clocks.Updated.Round;
+    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_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);
+
+
+begin
+
+
+    Window_One.Set_Resizable (Clock_One);
+    Window_Two.Set_Resizable (Clock_Two);
+
+    Window_One.Set_X_Class ("Fl_Clock");
+    Window_Two.Set_X_Class ("Fl_Clock");
+
+    Window_One.Show_With_Args;
+    Window_Two.Show;
+
+    return FLTK.Run;
+
+
+end Clock;
+
+
diff --git a/test/color_chooser.adb b/test/color_chooser.adb
new file mode 100644
index 0000000..09003b9
--- /dev/null
+++ b/test/color_chooser.adb
@@ -0,0 +1,162 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Color chooser test program functionality reproduced in Ada
+
+
+with
+
+    FLTK.Asks,
+    FLTK.Draw,
+    FLTK.Images.RGB,
+    FLTK.Static,
+    FLTK.Widgets.Boxes,
+    FLTK.Widgets.Buttons,
+    FLTK.Widgets.Groups.Color_Choosers,
+    FLTK.Widgets.Groups.Windows;
+
+use type
+
+    FLTK.Color,
+    FLTK.Asks.Confirm_Result;
+
+
+function Color_Chooser
+    return Integer
+is
+
+
+    package Ask renames FLTK.Asks;
+    package FD  renames FLTK.Draw;
+    package Img renames FLTK.Images.RGB;
+    package Stc renames FLTK.Static;
+    package Bx  renames FLTK.Widgets.Boxes;
+    package Btn renames FLTK.Widgets.Buttons;
+    package CC  renames FLTK.Widgets.Groups.Color_Choosers;
+    package Win renames FLTK.Widgets.Groups.Windows;
+
+
+    function Make_Image_Data
+           (W, H : in Positive)
+        return FLTK.Color_Component_Array
+    is
+        X_Frac, Y_Frac : Long_Float;
+        Offset : Integer;
+    begin
+        return Data : FLTK.Color_Component_Array (1 .. 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);
+                    Data (Offset + 1) :=
+                        FLTK.Color_Component (255.0 * (1.0 - X_Frac) * (1.0 - Y_Frac));
+                    Data (Offset + 2) :=
+                        FLTK.Color_Component (255.0 * (1.0 - X_Frac) * Y_Frac);
+                    Data (Offset + 3) :=
+                        FLTK.Color_Component (255.0 * X_Frac * Y_Frac);
+                end loop;
+            end loop;
+        end return;
+    end Make_Image_Data;
+
+
+    Image_Width, Image_Height : constant Natural := 100;
+
+    The_Image_Data : FLTK.Color_Component_Array := Make_Image_Data (Image_Width, Image_Height);
+
+
+    type Pens is new Bx.Box with null record;
+
+    procedure Draw
+           (This : in out Pens) is
+    begin
+        for Offset in 0 .. 3 * 8 - 1 loop
+            FD.Set_Color (FLTK.Grey0_Color + FLTK.Color (Offset));
+            FD.Line
+               (This.Get_X + Offset, This.Get_Y,
+                This.Get_X + Offset, This.Get_Y + This.Get_H);
+        end loop;
+    end Draw;
+
+
+    The_Window : Win.Window := Win.Forge.Create (400, 400);
+
+    The_Box  : Bx.Box := Bx.Forge.Create
+        (The_Window, 30, 30, 340, 340);
+    Hint_Box : Bx.Box := Bx.Forge.Create
+        (The_Window, 40, 40, 320,  30, "Pick background color with buttons:");
+
+    Button_One : Btn.Button := Btn.Forge.Create
+        (The_Window, 120,  80, 180, 30, "fl_show_colormap()");
+    Button_Two : Btn.Button := Btn.Forge.Create
+        (The_Window, 120, 120, 180, 30, "fl_color_chooser()");
+
+    Image_Box : Bx.Box := Bx.Forge.Create (The_Window, 160, 190, Image_Width, Image_Height);
+    The_Image : Img.RGB_Image := Img.Forge.Create (The_Image_Data, Image_Width, Image_Height);
+
+    Box_B : Bx.Box := Bx.Forge.Create (The_Window, 160, 310, 120, 30, "Example of fl_draw_image()");
+
+    My_Pens : Pens :=
+       (Bx.Forge.Create (The_Window, 60, 180, 3 * 8, 120, "lines")
+        with null record);
+
+    My_Color : FLTK.Color := FLTK.Background_Color;
+
+
+    procedure Callback_One
+           (This : in out FLTK.Widgets.Widget'Class) is
+    begin
+        My_Color := Ask.Show_Colormap (My_Color);
+        The_Box.Set_Background_Color (My_Color);
+        Hint_Box.Set_Label_Color (FLTK.Contrast (FLTK.Black_Color, My_Color));
+        The_Box.Parent.Redraw;
+    end Callback_One;
+
+
+    procedure Callback_Two
+           (This : in out FLTK.Widgets.Widget'Class)
+    is
+        R, G, B : FLTK.Color_Component;
+    begin
+        Stc.Get_Color (My_Color, R, G, B);
+        if Ask.Color_Chooser ("New color:", R, G, B, CC.HSV) = Ask.Cancel then
+            return;
+        end if;
+        My_Color := FLTK.Free_Color;
+        Stc.Set_Color (FLTK.Free_Color, R, G, B);
+        The_Box.Set_Background_Color (FLTK.Free_Color);
+        Hint_Box.Set_Label_Color (FLTK.Contrast (FLTK.Black_Color, FLTK.Free_Color));
+        The_Box.Parent.Redraw;
+    end Callback_Two;
+
+
+begin
+
+
+    Stc.Set_Color (FLTK.Free_Color, 145, 159, 170);
+    My_Color := FLTK.Free_Color;
+
+    The_Box.Set_Box (FLTK.Thin_Down_Box);
+    The_Box.Set_Background_Color (My_Color);
+
+    Hint_Box.Set_Alignment (FLTK.Align_Inside);
+
+    Button_One.Set_Callback (Callback_One'Unrestricted_Access);
+    Button_Two.Set_Callback (Callback_Two'Unrestricted_Access);
+
+    Image_Box.Set_Image (The_Image);
+
+    My_Pens.Set_Alignment (FLTK.Align_Top);
+
+    The_Window.Show_With_Args;
+
+    return FLTK.Run;
+
+
+end Color_Chooser;
+
+
diff --git a/test/cursor.adb b/test/cursor.adb
new file mode 100644
index 0000000..e968b6f
--- /dev/null
+++ b/test/cursor.adb
@@ -0,0 +1,116 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Cursor test program functionality reproduced in Ada
+
+
+with
+
+    FLTK.Draw,
+    FLTK.Widgets.Groups.Windows.Double,
+    FLTK.Widgets.Menus.Choices,
+    FLTK.Widgets.Valuators.Sliders.Value.Horizontal;
+
+use type
+
+    FLTK.Widgets.Callback_Flag;
+
+
+function Cursor
+    return Integer
+is
+
+
+    package FD renames FLTK.Draw;
+    package WD renames FLTK.Widgets.Groups.Windows.Double;
+    package MC renames FLTK.Widgets.Menus.Choices;
+    package HV renames FLTK.Widgets.Valuators.Sliders.Value.Horizontal;
+
+
+    The_Cursor : FLTK.Mouse_Cursor_Kind := FLTK.Default_Mouse;
+
+    Cursor_Index_Low : constant Long_Float :=
+        Long_Float (FLTK.Mouse_Cursor_Kind'Pos (FLTK.Mouse_Cursor_Kind'First));
+    Cursor_Index_High : constant Long_Float :=
+        Long_Float (FLTK.Mouse_Cursor_Kind'Pos (FLTK.Mouse_Cursor_Kind'Last));
+
+
+    The_Window : WD.Double_Window := WD.Forge.Create (400, 300);
+
+    The_Choices : MC.Choice := MC.Forge.Create
+        (The_Window, 80, 100, 200, 25, "Cursor:");
+
+    The_Slider : HV.Horizontal_Value_Slider := HV.Forge.Create
+        (The_Window, 80, 180, 310, 30, "Cursor:");
+
+
+    procedure Choice_Callback
+           (This : in out FLTK.Widgets.Widget'Class)
+    is
+        My_Choice : MC.Choice renames MC.Choice (This);
+    begin
+        The_Cursor := FLTK.Mouse_Cursor_Kind'Val (My_Choice.Chosen_Index - 1);
+        The_Slider.Set_Value (Long_Float (FLTK.Mouse_Cursor_Kind'Pos (The_Cursor)));
+        FD.Set_Cursor (The_Cursor);
+    end Choice_Callback;
+
+
+    procedure Slider_Callback
+           (This : in out FLTK.Widgets.Widget'Class)
+    is
+        My_Slider : HV.Horizontal_Value_Slider renames HV.Horizontal_Value_Slider (This);
+    begin
+        The_Cursor := FLTK.Mouse_Cursor_Kind'Val (Integer (My_Slider.Get_Value));
+        The_Choices.Set_Chosen (FLTK.Mouse_Cursor_Kind'Pos (The_Cursor) + 1);
+        FD.Set_Cursor (The_Cursor);
+    end Slider_Callback;
+
+
+begin
+
+
+    The_Choices.Add ("FL_CURSOR_DEFAULT", Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_ARROW",   Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_CROSS",   Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_WAIT",    Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_INSERT",  Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_HAND",    Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_HELP",    Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_MOVE",    Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_NS",      Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_WE",      Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_NWSE",    Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_NESW",    Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_N",       Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_NE",      Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_E",       Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_SE",      Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_S",       Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_SW",      Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_W",       Choice_Callback'Unrestricted_Access);
+    The_Choices.Add ("FL_CURSOR_NW",      Choice_Callback'Unrestricted_Access);
+    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_Chosen (1);
+
+    The_Slider.Set_Alignment (FLTK.Align_Left);
+    The_Slider.Set_Step_Bottom (1);
+    The_Slider.Set_Precision (0);
+    The_Slider.Set_Bounds (Cursor_Index_Low, Cursor_Index_High);
+    The_Slider.Set_Value (Cursor_Index_Low);
+    The_Slider.Set_Callback (Slider_Callback'Unrestricted_Access);
+
+    The_Window.Set_Resizable (The_Window);
+    The_Window.Show_With_Args;
+
+    return FLTK.Run;
+
+
+end Cursor;
+
+
diff --git a/test/curve.adb b/test/curve.adb
new file mode 100644
index 0000000..45269e8
--- /dev/null
+++ b/test/curve.adb
@@ -0,0 +1,164 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Curve drawing test program functionality duplicated in Ada
+
+
+pragma Ada_2022;
+
+
+with
+
+    FLTK.Draw,
+    FLTK.Widgets.Buttons.Toggle,
+    FLTK.Widgets.Groups.Windows.Double,
+    FLTK.Widgets.Valuators.Sliders.Value.Horizontal;
+
+
+function Curve
+    return Integer
+is
+
+
+    package FDR renames FLTK.Draw;
+    package Tog renames FLTK.Widgets.Buttons.Toggle;
+    package WD  renames FLTK.Widgets.Groups.Windows.Double;
+    package HV  renames FLTK.Widgets.Valuators.Sliders.Value.Horizontal;
+
+
+    --  More convenient to have these all as floats instead of integers
+    Arg_Values : array (Positive range <>) of aliased Long_Float :=
+        (20.0, 20.0,   50.0, 200.0,   100.0, 20.0,   200.0, 200.0,   0.0);
+
+    Points : Boolean := False;
+
+
+    type Drawing_Widget is new FLTK.Widgets.Widget with null record;
+
+    procedure Draw
+           (This : in out Drawing_Widget) is
+    begin
+        FDR.Push_Clip (This.Get_X, This.Get_Y, This.Get_W, This.Get_H);
+        FDR.Set_Color (FLTK.Dark3_Color);
+        FDR.Rect_Fill (This.Get_X, This.Get_Y, This.Get_W, This.Get_H);
+        FDR.Push_Matrix;
+        if Arg_Values (9) > 0.001 then
+            FDR.Translate
+               (Long_Float (This.Get_X) + Long_Float (This.Get_W) / 2.0,
+                Long_Float (This.Get_Y) + Long_Float (This.Get_H) / 2.0);
+            FDR.Rotate (Arg_Values (9));
+            FDR.Translate
+               (-1.0 * (Long_Float (This.Get_X) + Long_Float (This.Get_W) / 2.0),
+                -1.0 * (Long_Float (This.Get_Y) + Long_Float (This.Get_H) / 2.0));
+        end if;
+        FDR.Translate (Long_Float (This.Get_X), Long_Float (This.Get_Y));
+        if not Points then
+            FDR.Set_Color (FLTK.White_Color);
+            FDR.Begin_Complex_Polygon;
+            FDR.Curve
+               (Arg_Values (1), Arg_Values (2), Arg_Values (3), Arg_Values (4),
+                Arg_Values (5), Arg_Values (6), Arg_Values (7), Arg_Values (8));
+            FDR.End_Complex_Polygon;
+        end if;
+        FDR.Set_Color (FLTK.Black_Color);
+        FDR.Begin_Line;
+        FDR.Vertex (Arg_Values (1), Arg_Values (2));
+        FDR.Vertex (Arg_Values (3), Arg_Values (4));
+        FDR.Vertex (Arg_Values (5), Arg_Values (6));
+        FDR.Vertex (Arg_Values (7), Arg_Values (8));
+        FDR.End_Line;
+        FDR.Set_Color ((if Points then FLTK.White_Color else FLTK.Red_Color));
+        if Points then FDR.Begin_Points; else FDR.Begin_Line; end if;
+        FDR.Curve
+           (Arg_Values (1), Arg_Values (2), Arg_Values (3), Arg_Values (4),
+            Arg_Values (5), Arg_Values (6), Arg_Values (7), Arg_Values (8));
+        if Points then FDR.End_Points; else FDR.End_Line; end if;
+        FDR.Pop_Matrix;
+        FDR.Pop_Clip;
+    end Draw;
+
+
+    The_Window : WD.Double_Window := WD.Forge.Create (300, 555, "Curve Testing");
+
+    The_Drawing : Drawing_Widget :=
+       (FLTK.Widgets.Forge.Create (The_Window, 10, 10, 280, 280)
+        with null record);
+
+    The_Toggle : Tog.Toggle_Button := Tog.Forge.Create (The_Window, 50, 525, 50, 25, "points");
+
+
+    type My_Slider is new HV.Horizontal_Value_Slider with record
+        Index : Integer range Arg_Values'Range;
+    end record;
+
+    X0_Str     : aliased constant String := "X0";
+    Y0_Str     : aliased constant String := "Y0";
+    X1_Str     : aliased constant String := "X1";
+    Y1_Str     : aliased constant String := "Y1";
+    X2_Str     : aliased constant String := "X2";
+    Y2_Str     : aliased constant String := "Y2";
+    X3_Str     : aliased constant String := "X3";
+    Y3_Str     : aliased constant String := "Y3";
+    Rotate_Str : aliased constant String := "rotate";
+
+    --  A straight up array of strings is not possible because of the different lengths
+    Slider_Labels : constant array (Positive range <>) of access constant String :=
+        (X0_Str'Access, Y0_Str'Access,   X1_Str'Access, Y1_Str'Access,
+         X2_Str'Access, Y2_Str'Access,   X3_Str'Access, Y3_Str'Access,   Rotate_Str'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
+           (Item : in out FLTK.Widgets.Widget'Class)
+    is
+        Slide : My_Slider renames My_Slider (Item);
+    begin
+        Arg_Values (Slide.Index) := Slide.Get_Value;
+        The_Drawing.Redraw;
+    end Slider_Callback;
+
+
+    procedure Points_Callback
+           (Item : in out FLTK.Widgets.Widget'Class)
+    is
+        Toggle : Tog.Toggle_Button renames Tog.Toggle_Button (Item);
+    begin
+        Points := Toggle.Is_On;
+        The_Drawing.Redraw;
+    end Points_Callback;
+
+
+begin
+
+
+    for Place in Sliders'Range loop
+        Sliders (Place).Set_Minimum (0.0);
+        if Place = 9 then
+            Sliders (Place).Set_Maximum (360.0);
+        else
+            Sliders (Place).Set_Maximum (280.0);
+        end if;
+        Sliders (Place).Set_Step_Bottom (1);
+        Sliders (Place).Set_Value (Arg_Values (Place));
+        Sliders (Place).Set_Alignment (FLTK.Align_Left);
+        Sliders (Place).Set_Callback (Slider_Callback'Unrestricted_Access);
+    end loop;
+
+    The_Toggle.Set_Callback (Points_Callback'Unrestricted_Access);
+
+    The_Window.Show_With_Args;
+
+    return FLTK.Run;
+
+
+end Curve;
+
+
diff --git a/test/hello.adb b/test/hello.adb
new file mode 100644
index 0000000..1fcdf9d
--- /dev/null
+++ b/test/hello.adb
@@ -0,0 +1,45 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+--  Hello, World! program functionality reproduced in Ada
+
+
+with
+
+    FLTK.Widgets.Boxes,
+    FLTK.Widgets.Groups.Windows;
+
+
+function Hello
+    return Integer
+is
+
+
+    package Bx  renames FLTK.Widgets.Boxes;
+    package Win renames FLTK.Widgets.Groups.Windows;
+
+
+    The_Window : Win.Window := Win.Forge.Create (340, 180);
+
+    The_Box : Bx.Box := Bx.Forge.Create (The_Window, 20, 40, 300, 100, "Hello, World!");
+
+
+begin
+
+
+    The_Box.Set_Box (FLTK.Up_Box);
+    The_Box.Set_Label_Font (FLTK.Helvetica_Bold_Italic);
+    The_Box.Set_Label_Size (36);
+    The_Box.Set_Label_Kind (FLTK.Shadow_Label);
+
+    The_Window.Show_With_Args;
+
+    return FLTK.Run;
+
+
+end Hello;
+
+
diff --git a/tests.gpr b/tests.gpr
index 04c0c76..54165fb 100644
--- a/tests.gpr
+++ b/tests.gpr
@@ -19,19 +19,31 @@ project Tests is
        ("adjuster.adb",
         "ask.adb",
         "bitmap.adb",
+        "button.adb",
+        "buttons.adb",
         "compare.adb",
+        "clock.adb",
+        "color_chooser.adb",
+        "cursor.adb",
         "dirlist.adb",
+        "hello.adb",
         "page_formats.adb",
         "pixmap.adb");
 
     package Builder is
-        for Executable ("adjuster.adb")     use "adjuster";
-        for Executable ("ask.adb")          use "ask";
-        for Executable ("bitmap.adb")       use "bitmap";
-        for Executable ("compare.adb")      use "compare";
-        for Executable ("dirlist.adb")      use "dirlist";
-        for Executable ("page_formats.adb") use "page_formats";
-        for Executable ("pixmap.adb")       use "pixmap";
+        for Executable ("adjuster.adb")      use "adjuster";
+        for Executable ("ask.adb")           use "ask";
+        for Executable ("bitmap.adb")        use "bitmap";
+        for Executable ("button.adb")        use "button";
+        for Executable ("buttons.adb")       use "buttons";
+        for Executable ("compare.adb")       use "compare";
+        for Executable ("clock.adb")         use "clock";
+        for Executable ("color_chooser.adb") use "color_chooser";
+        for Executable ("cursor.adb")        use "cursor";
+        for Executable ("dirlist.adb")       use "dirlist";
+        for Executable ("hello.adb")         use "hello";
+        for Executable ("page_formats.adb")  use "page_formats";
+        for Executable ("pixmap.adb")        use "pixmap";
     end Builder;
 
     package Compiler renames Common.Compiler;
diff --git a/tests_2022.gpr b/tests_2022.gpr
index 4217c08..84ed425 100644
--- a/tests_2022.gpr
+++ b/tests_2022.gpr
@@ -17,11 +17,13 @@ project Tests_2022 is
 
     for Main use
        ("animated.adb",
-        "arc.adb");
+        "arc.adb",
+        "curve.adb");
 
     package Builder is
         for Executable ("animated.adb") use "animated";
-        for Executable ("arc.adb") use "arc";
+        for Executable ("arc.adb")      use "arc";
+        for Executable ("curve.adb")    use "curve";
     end Builder;
 
     package Compiler renames Common.Compiler;