Split public API and private implementation files into different directories

1 files changed, 0 insertions, 659 deletions

diff --git a/src/fltk-asks.adb b/src/fltk-asks.adb
deleted file mode 100644
index bd09fac..0000000
--- a/src/fltk-asks.adb
+++ /dev/null
@@ -1,659 +0,0 @@
-
-
---  Programmed by Jedidiah Barber
---  Released into the public domain
-
-
-with
-
-    Ada.Assertions,
-    Interfaces.C.Strings;
-
-use type
-
-    Interfaces.C.int,
-    Interfaces.C.Strings.chars_ptr;
-
-
-package body FLTK.Asks is
-
-
-    package Chk renames Ada.Assertions;
-
-
-
-
-    ------------------------
-    --  Functions From C  --
-    ------------------------
-
-    function fl_ask_get_cancel
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_get_cancel, "fl_ask_get_cancel");
-    pragma Inline (fl_ask_get_cancel);
-
-    procedure fl_ask_set_cancel
-           (V : in Interfaces.C.Strings.chars_ptr);
-    pragma Import (C, fl_ask_set_cancel, "fl_ask_set_cancel");
-    pragma Inline (fl_ask_set_cancel);
-
-    function fl_ask_get_close
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_get_close, "fl_ask_get_close");
-    pragma Inline (fl_ask_get_close);
-
-    procedure fl_ask_set_close
-           (V : in Interfaces.C.Strings.chars_ptr);
-    pragma Import (C, fl_ask_set_close, "fl_ask_set_close");
-    pragma Inline (fl_ask_set_close);
-
-    function fl_ask_get_no
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_get_no, "fl_ask_get_no");
-    pragma Inline (fl_ask_get_no);
-
-    procedure fl_ask_set_no
-           (V : in Interfaces.C.Strings.chars_ptr);
-    pragma Import (C, fl_ask_set_no, "fl_ask_set_no");
-    pragma Inline (fl_ask_set_no);
-
-    function fl_ask_get_ok
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_get_ok, "fl_ask_get_ok");
-    pragma Inline (fl_ask_get_ok);
-
-    procedure fl_ask_set_ok
-           (V : in Interfaces.C.Strings.chars_ptr);
-    pragma Import (C, fl_ask_set_ok, "fl_ask_set_ok");
-    pragma Inline (fl_ask_set_ok);
-
-    function fl_ask_get_yes
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_get_yes, "fl_ask_get_yes");
-    pragma Inline (fl_ask_get_yes);
-
-    procedure fl_ask_set_yes
-           (V : in Interfaces.C.Strings.chars_ptr);
-    pragma Import (C, fl_ask_set_yes, "fl_ask_set_yes");
-    pragma Inline (fl_ask_set_yes);
-
-
-
-
-    procedure fl_ask_alert
-           (M : in Interfaces.C.char_array);
-    pragma Import (C, fl_ask_alert, "fl_ask_alert");
-    pragma Inline (fl_ask_alert);
-
-    procedure fl_ask_beep
-           (B : in Interfaces.C.int);
-    pragma Import (C, fl_ask_beep, "fl_ask_beep");
-    pragma Inline (fl_ask_beep);
-
-    function fl_ask_choice
-           (M, A : in Interfaces.C.char_array;
-            B, C : in Interfaces.C.Strings.chars_ptr)
-        return Interfaces.C.int;
-    pragma Import (C, fl_ask_choice, "fl_ask_choice");
-    pragma Inline (fl_ask_choice);
-
-    function fl_ask_choice_n
-           (M, A : in Interfaces.C.char_array;
-            B, C : in Interfaces.C.Strings.chars_ptr)
-        return Interfaces.C.int;
-    pragma Import (C, fl_ask_choice_n, "fl_ask_choice_n");
-    pragma Inline (fl_ask_choice_n);
-
-    function fl_ask_input
-           (M, D : in Interfaces.C.char_array)
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_input, "fl_ask_input");
-    pragma Inline (fl_ask_input);
-
-    procedure fl_ask_message
-           (M : in Interfaces.C.char_array);
-    pragma Import (C, fl_ask_message, "fl_ask_message");
-    pragma Inline (fl_ask_message);
-
-    function fl_ask_password
-           (M, D : in Interfaces.C.char_array)
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_password, "fl_ask_password");
-    pragma Inline (fl_ask_password);
-
-
-
-
-    function fl_ask_color_chooser
-           (N       : in     Interfaces.C.char_array;
-            R, G, B : in out Interfaces.C.double;
-            M       : in     Interfaces.C.int)
-        return Interfaces.C.int;
-    pragma Import (C, fl_ask_color_chooser, "fl_ask_color_chooser");
-    pragma Inline (fl_ask_color_chooser);
-
-    function fl_ask_color_chooser2
-           (N       : in     Interfaces.C.char_array;
-            R, G, B : in out Interfaces.C.unsigned_char;
-            M       : in     Interfaces.C.int)
-        return Interfaces.C.int;
-    pragma Import (C, fl_ask_color_chooser2, "fl_ask_color_chooser2");
-    pragma Inline (fl_ask_color_chooser2);
-
-    function fl_ask_dir_chooser
-           (M, D : in Interfaces.C.char_array;
-            R    : in Interfaces.C.int)
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_dir_chooser, "fl_ask_dir_chooser");
-    pragma Inline (fl_ask_dir_chooser);
-
-    function fl_ask_file_chooser
-           (M, P, D : in Interfaces.C.char_array;
-            R       : in Interfaces.C.int)
-        return Interfaces.C.Strings.chars_ptr;
-    pragma Import (C, fl_ask_file_chooser, "fl_ask_file_chooser");
-    pragma Inline (fl_ask_file_chooser);
-
-    procedure fl_ask_file_chooser_callback
-           (CB : in Storage.Integer_Address);
-    pragma Import (C, fl_ask_file_chooser_callback, "fl_ask_file_chooser_callback");
-    pragma Inline (fl_ask_file_chooser_callback);
-
-    procedure fl_ask_file_chooser_ok_label
-           (L : in Interfaces.C.Strings.chars_ptr);
-    pragma Import (C, fl_ask_file_chooser_ok_label, "fl_ask_file_chooser_ok_label");
-    pragma Inline (fl_ask_file_chooser_ok_label);
-
-
-
-
-    function fl_ask_get_message_hotspot
-        return Interfaces.C.int;
-    pragma Import (C, fl_ask_get_message_hotspot, "fl_ask_get_message_hotspot");
-    pragma Inline (fl_ask_get_message_hotspot);
-
-    procedure fl_ask_set_message_hotspot
-           (V : in Interfaces.C.int);
-    pragma Import (C, fl_ask_set_message_hotspot, "fl_ask_set_message_hotspot");
-    pragma Inline (fl_ask_set_message_hotspot);
-
-    procedure fl_ask_message_font
-           (F, S : in Interfaces.C.int);
-    pragma Import (C, fl_ask_message_font, "fl_ask_message_font");
-    pragma Inline (fl_ask_message_font);
-
-    function fl_ask_message_icon
-        return Storage.Integer_Address;
-    pragma Import (C, fl_ask_message_icon, "fl_ask_message_icon");
-    pragma Inline (fl_ask_message_icon);
-
-    procedure fl_ask_message_title
-           (T : in Interfaces.C.char_array);
-    pragma Import (C, fl_ask_message_title, "fl_ask_message_title");
-    pragma Inline (fl_ask_message_title);
-
-    procedure fl_ask_message_title_default
-           (T : in Interfaces.C.char_array);
-    pragma Import (C, fl_ask_message_title_default, "fl_ask_message_title_default");
-    pragma Inline (fl_ask_message_title_default);
-
-
-
-
-    ---------------------
-    --  Callback Hook  --
-    ---------------------
-
-    procedure File_Chooser_Callback_Hook
-           (C_Str : in Interfaces.C.Strings.chars_ptr);
-
-    pragma Convention (C, File_Chooser_Callback_Hook);
-
-    procedure File_Chooser_Callback_Hook
-           (C_Str : in Interfaces.C.Strings.chars_ptr) is
-    begin
-        if Chooser_Func /= null then
-            Chooser_Func (Interfaces.C.Strings.Value (C_Str));
-        end if;
-    end File_Chooser_Callback_Hook;
-
-
-
-
-    ---------------
-    --  Cleanup  --
-    ---------------
-
-    procedure Finalize
-           (This : in out Dialog_String_Final_Controller)
-    is
-        use Interfaces.C.Strings;
-    begin
-        Free (Cancel_Str);
-        Free (Close_Str);
-        Free (No_Str);
-        Free (OK_Str);
-        Free (Yes_Str);
-        Free (Chooser_OK_Str);
-    end Finalize;
-
-
-
-
-    ------------------
-    --  Attributes  --
-    ------------------
-
-    function Get_Cancel_String
-        return String is
-    begin
-        return Interfaces.C.Strings.Value (fl_ask_get_cancel);
-    end Get_Cancel_String;
-
-
-    procedure Set_Cancel_String
-           (Value : in String) is
-    begin
-        Interfaces.C.Strings.Free (Cancel_Str);
-        Cancel_Str := Interfaces.C.Strings.New_String (Value);
-        fl_ask_set_cancel (Cancel_Str);
-    end Set_Cancel_String;
-
-
-    function Get_Close_String
-        return String is
-    begin
-        return Interfaces.C.Strings.Value (fl_ask_get_close);
-    end Get_Close_String;
-
-
-    procedure Set_Close_String
-           (Value : in String) is
-    begin
-        Interfaces.C.Strings.Free (Close_Str);
-        Close_Str := Interfaces.C.Strings.New_String (Value);
-        fl_ask_set_close (Close_Str);
-    end Set_Close_String;
-
-
-    function Get_No_String
-        return String is
-    begin
-        return Interfaces.C.Strings.Value (fl_ask_get_no);
-    end Get_No_String;
-
-
-    procedure Set_No_String
-           (Value : in String) is
-    begin
-        Interfaces.C.Strings.Free (No_Str);
-        No_Str := Interfaces.C.Strings.New_String (Value);
-        fl_ask_set_no (No_Str);
-    end Set_No_String;
-
-
-    function Get_OK_String
-        return String is
-    begin
-        return Interfaces.C.Strings.Value (fl_ask_get_ok);
-    end Get_OK_String;
-
-
-    procedure Set_OK_String
-           (Value : in String) is
-    begin
-        Interfaces.C.Strings.Free (OK_Str);
-        OK_Str := Interfaces.C.Strings.New_String (Value);
-        fl_ask_set_ok (OK_Str);
-    end Set_OK_String;
-
-
-    function Get_Yes_String
-        return String is
-    begin
-        return Interfaces.C.Strings.Value (fl_ask_get_yes);
-    end Get_Yes_String;
-
-
-    procedure Set_Yes_String
-           (Value : in String) is
-    begin
-        Interfaces.C.Strings.Free (Yes_Str);
-        Yes_Str := Interfaces.C.Strings.New_String (Value);
-        fl_ask_set_yes (Yes_Str);
-    end Set_Yes_String;
-
-
-
-
-    ----------------------
-    --  Common Dialogs  --
-    ----------------------
-
-    procedure Alert
-           (Message : String) is
-    begin
-        fl_ask_alert (Interfaces.C.To_C (Message));
-    end Alert;
-
-
-    procedure Beep
-           (Kind : in Beep_Kind := Default_Beep) is
-    begin
-        fl_ask_beep (Beep_Kind'Pos (Kind));
-    end Beep;
-
-
-    function Choice
-           (Message, Button1 : in String)
-        return Choice_Result
-    is
-        Result : Interfaces.C.int := fl_ask_choice
-           (Interfaces.C.To_C (Message),
-            Interfaces.C.To_C (Button1),
-            Interfaces.C.Strings.Null_Ptr,
-            Interfaces.C.Strings.Null_Ptr);
-    begin
-        return Choice_Result'Val (Result);
-    end Choice;
-
-
-    function Choice
-           (Message, Button1, Button2 : in String)
-        return Choice_Result
-    is
-        Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
-        Result : Interfaces.C.int := fl_ask_choice
-           (Interfaces.C.To_C (Message),
-            Interfaces.C.To_C (Button1),
-            Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
-            Interfaces.C.Strings.Null_Ptr);
-    begin
-        return Choice_Result'Val (Result);
-    end Choice;
-
-
-    function Choice
-           (Message, Button1, Button2, Button3 : in String)
-        return Choice_Result
-    is
-        Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
-        Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3);
-        Result : Interfaces.C.int := fl_ask_choice
-           (Interfaces.C.To_C (Message),
-            Interfaces.C.To_C (Button1),
-            Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
-            Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access));
-    begin
-        return Choice_Result'Val (Result);
-    end Choice;
-
-
-    function Extended_Choice
-           (Message, Button1 : in String)
-        return Extended_Choice_Result
-    is
-        Result : Interfaces.C.int := fl_ask_choice_n
-           (Interfaces.C.To_C (Message),
-            Interfaces.C.To_C (Button1),
-            Interfaces.C.Strings.Null_Ptr,
-            Interfaces.C.Strings.Null_Ptr);
-    begin
-        pragma Assert (Result in -3 .. 2);
-        return Extended_Choice_Result'Val (Result mod 6);
-    exception
-    when Chk.Assertion_Error => raise Internal_FLTK_Error;
-    end Extended_Choice;
-
-
-    function Extended_Choice
-           (Message, Button1, Button2 : in String)
-        return Extended_Choice_Result
-    is
-        Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
-        Result : Interfaces.C.int := fl_ask_choice_n
-           (Interfaces.C.To_C (Message),
-            Interfaces.C.To_C (Button1),
-            Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
-            Interfaces.C.Strings.Null_Ptr);
-    begin
-        pragma Assert (Result in -3 .. 2);
-        return Extended_Choice_Result'Val (Result mod 6);
-    exception
-    when Chk.Assertion_Error => raise Internal_FLTK_Error;
-    end Extended_Choice;
-
-
-    function Extended_Choice
-           (Message, Button1, Button2, Button3 : in String)
-        return Extended_Choice_Result
-    is
-        Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
-        Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3);
-        Result : Interfaces.C.int := fl_ask_choice_n
-           (Interfaces.C.To_C (Message),
-            Interfaces.C.To_C (Button1),
-            Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
-            Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access));
-    begin
-        pragma Assert (Result in -3 .. 2);
-        return Extended_Choice_Result'Val (Result mod 6);
-    exception
-    when Chk.Assertion_Error => raise Internal_FLTK_Error;
-    end Extended_Choice;
-
-
-    function Text_Input
-           (Message : in String;
-            Default : in String := "")
-        return String
-    is
-        Result : Interfaces.C.Strings.chars_ptr := fl_ask_input
-               (Interfaces.C.To_C (Message),
-                Interfaces.C.To_C (Default));
-    begin
-        --  Result does not need dealloc
-        if Result = Interfaces.C.Strings.Null_Ptr then
-            return "";
-        else
-            return Interfaces.C.Strings.Value (Result);
-        end if;
-    end Text_Input;
-
-
-    procedure Message_Box
-           (Message : in String) is
-    begin
-        fl_ask_message (Interfaces.C.To_C (Message));
-    end Message_Box;
-
-
-    function Password
-           (Message : in String;
-            Default : in String := "")
-        return String
-    is
-        Result : Interfaces.C.Strings.chars_ptr := fl_ask_password
-               (Interfaces.C.To_C (Message),
-                Interfaces.C.To_C (Default));
-    begin
-        --  Result does not need dealloc
-        if Result = Interfaces.C.Strings.Null_Ptr then
-            return "";
-        else
-            return Interfaces.C.Strings.Value (Result);
-        end if;
-    end Password;
-
-
-
-
-    function Color_Chooser
-           (Title   : in     String;
-            R, G, B : in out RGB_Float;
-            Mode    : in     FLTK.Widgets.Groups.Color_Choosers.Color_Mode :=
-                FLTK.Widgets.Groups.Color_Choosers.RGB)
-        return Confirm_Result
-    is
-        C_R : Interfaces.C.double := Interfaces.C.double (R);
-        C_G : Interfaces.C.double := Interfaces.C.double (G);
-        C_B : Interfaces.C.double := Interfaces.C.double (B);
-        M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode);
-        Result : Interfaces.C.int := fl_ask_color_chooser
-            (Interfaces.C.To_C (Title), C_R, C_G, C_B, M);
-    begin
-        if Result = 1 then
-            R := RGB_Float (C_R);
-            G := RGB_Float (C_G);
-            B := RGB_Float (C_B);
-            return Confirm;
-        else
-            pragma Assert (Result = 0);
-            return Cancel;
-        end if;
-    exception
-    when Chk.Assertion_Error => raise Internal_FLTK_Error;
-    end Color_Chooser;
-
-
-    function Color_Chooser
-           (Title   : in     String;
-            R, G, B : in out RGB_Int;
-            Mode    : in     FLTK.Widgets.Groups.Color_Choosers.Color_Mode :=
-                FLTK.Widgets.Groups.Color_Choosers.RGB)
-        return Confirm_Result
-    is
-        C_R : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (R);
-        C_G : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (G);
-        C_B : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (B);
-        M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode);
-        Result : Interfaces.C.int := fl_ask_color_chooser2
-               (Interfaces.C.To_C (Title), C_R, C_G, C_B, M);
-    begin
-        if Result = 1 then
-            R := RGB_Int (C_R);
-            G := RGB_Int (C_G);
-            B := RGB_Int (C_B);
-            return Confirm;
-        else
-            pragma Assert (Result = 0);
-            return Cancel;
-        end if;
-    exception
-    when Chk.Assertion_Error => raise Internal_FLTK_Error;
-    end Color_Chooser;
-
-
-    function Dir_Chooser
-           (Message, Default : in String;
-            Relative         : in Boolean := False)
-        return String
-    is
-        Result : Interfaces.C.Strings.chars_ptr := fl_ask_dir_chooser
-               (Interfaces.C.To_C (Message),
-                Interfaces.C.To_C (Default),
-                Boolean'Pos (Relative));
-    begin
-        --  Result does not need dealloc
-        if Result = Interfaces.C.Strings.Null_Ptr then
-            return "";
-        else
-            return Interfaces.C.Strings.Value (Result);
-        end if;
-    end Dir_Chooser;
-
-
-    function File_Chooser
-           (Message, Filter_Pattern, Default : in String;
-            Relative                         : in Boolean := False)
-        return String
-    is
-        Result : Interfaces.C.Strings.chars_ptr := fl_ask_file_chooser
-               (Interfaces.C.To_C (Message),
-                Interfaces.C.To_C (Filter_Pattern),
-                Interfaces.C.To_C (Default),
-                Boolean'Pos (Relative));
-    begin
-        --  Result does not need dealloc
-        if Result = Interfaces.C.Strings.Null_Ptr then
-            return "";
-        else
-            return Interfaces.C.Strings.Value (Result);
-        end if;
-    end File_Chooser;
-
-
-    procedure Set_File_Chooser_Callback
-           (Func : in File_Chooser_Callback) is
-    begin
-        Chooser_Func := Func;
-    end Set_File_Chooser_Callback;
-
-
-    procedure Set_File_Chooser_OK_String
-           (Value : in String) is
-    begin
-        Interfaces.C.Strings.Free (Chooser_OK_Str);
-        Chooser_OK_Str := Interfaces.C.Strings.New_String (Value);
-        fl_ask_file_chooser_ok_label (Chooser_OK_Str);
-    end Set_File_Chooser_OK_String;
-
-
-
-
-    function Get_Message_Hotspot
-        return Boolean is
-    begin
-        return fl_ask_get_message_hotspot /= 0;
-    end Get_Message_Hotspot;
-
-
-    procedure Set_Message_Hotspot
-           (To : in Boolean) is
-    begin
-        fl_ask_set_message_hotspot (Boolean'Pos (To));
-    end Set_Message_Hotspot;
-
-
-    procedure Set_Message_Font
-           (Font : in Font_Kind;
-            Size : in Font_Size) is
-    begin
-        fl_ask_message_font (Font_Kind'Pos (Font), Interfaces.C.int (Size));
-    end Set_Message_Font;
-
-
-    function Get_Message_Icon
-        return FLTK.Widgets.Boxes.Box_Reference is
-    begin
-        return (Data => Icon_Box'Access);
-    end Get_Message_Icon;
-
-
-    procedure Set_Message_Title
-           (To : in String) is
-    begin
-        fl_ask_message_title (Interfaces.C.To_C (To));
-    end Set_Message_Title;
-
-
-    procedure Set_Message_Title_Default
-           (To : in String) is
-    begin
-        fl_ask_message_title_default (Interfaces.C.To_C (To));
-    end Set_Message_Title_Default;
-
-
-
-
-begin
-
-
-    Wrapper (Icon_Box).Void_Ptr := fl_ask_message_icon;
-    Wrapper (Icon_Box).Needs_Dealloc := False;
-
-    fl_ask_file_chooser_callback (Storage.To_Integer (File_Chooser_Callback_Hook'Address));
-
-
-end FLTK.Asks;
-