Initial commit

1 files changed, 746 insertions, 0 deletions

diff --git a/src/libao.adb b/src/libao.adb
new file mode 100644
index 0000000..c1491c2
--- /dev/null
+++ b/src/libao.adb
@@ -0,0 +1,746 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+with
+
+    Interfaces.C.Strings,
+    System;
+
+use type
+
+    Interfaces.C.int,
+    Interfaces.C.Strings.chars_ptr,
+    System.Address;
+
+
+package body Libao is
+
+
+    procedure ao_initialize;
+    pragma Import (C, ao_initialize, "ao_initialize");
+    pragma Inline (ao_initialize);
+
+    procedure ao_shutdown;
+    pragma Import (C, ao_shutdown, "ao_shutdown");
+    pragma Inline (ao_shutdown);
+
+
+
+
+    function ao_append_option
+           (Options : in out System.Address;
+            Key     : in     Interfaces.C.char_array;
+            Value   : in     Interfaces.C.char_array)
+        return Interfaces.C.int;
+    pragma Import (C, ao_append_option, "ao_append_option");
+    pragma Inline (ao_append_option);
+
+    function ao_append_global_option
+           (Key   : in Interfaces.C.char_array;
+            Value : in Interfaces.C.char_array)
+        return Interfaces.C.int;
+    pragma Import (C, ao_append_global_option, "ao_append_global_option");
+    pragma Inline (ao_append_global_option);
+
+    procedure ao_free_options
+           (Options : in System.Address);
+    pragma Import (C, ao_free_options, "ao_free_options");
+    pragma Inline (ao_free_options);
+
+    function ao_open_live
+           (Driver_ID : in Interfaces.C.int;
+            Format    : in System.Address;
+            Options   : in System.Address)
+        return System.Address;
+    pragma Import (C, ao_open_live, "ao_open_live");
+    pragma Inline (ao_open_live);
+
+    function ao_open_file
+           (Driver_ID : in Interfaces.C.int;
+            Filename  : in Interfaces.C.char_array;
+            Overwrite : in Interfaces.C.int;
+            Format    : in System.Address;
+            Options   : in System.Address)
+        return System.Address;
+    pragma Import (C, ao_open_file, "ao_open_file");
+    pragma Inline (ao_open_file);
+
+    function ao_play
+           (Output_Device : in System.Address;
+            Samples       : in Interfaces.C.char_array;
+            Num_Bytes     : in Interfaces.Unsigned_32)
+        return Interfaces.C.int;
+    pragma Import (C, ao_play, "ao_play");
+    pragma Inline (ao_play);
+
+    function ao_close
+           (Output_Device : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, ao_close, "ao_close");
+    pragma Inline (ao_close);
+
+
+
+
+    function ao_driver_id
+           (Short_Name : in Interfaces.C.char_array)
+        return Interfaces.C.int;
+    pragma Import (C, ao_driver_id, "ao_driver_id");
+    pragma Inline (ao_driver_id);
+
+    function ao_default_driver_id
+        return Interfaces.C.int;
+    pragma Import (C, ao_default_driver_id, "ao_default_driver_id");
+    pragma Inline (ao_default_driver_id);
+
+    function ao_driver_info
+           (Ident : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, ao_driver_info, "ao_driver_info");
+    pragma Inline (ao_driver_info);
+
+    function ao_driver_info_list
+           (Count : out Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, ao_driver_info_list, "ao_driver_info_list");
+    pragma Inline (ao_driver_info_list);
+
+    function ao_file_extension
+           (Ident : in Interfaces.C.int)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, ao_file_extension, "ao_file_extension");
+    pragma Inline (ao_file_extension);
+
+
+
+
+    function ao_is_big_endian
+        return Interfaces.C.int;
+    pragma Import (C, ao_is_big_endian, "ao_is_big_endian");
+    pragma Inline (ao_is_big_endian);
+
+
+
+
+    function type_live
+        return Interfaces.C.int;
+    pragma Import (C, type_live, "type_live");
+    pragma Inline (type_live);
+
+    function type_file
+        return Interfaces.C.int;
+    pragma Import (C, type_file, "type_file");
+    pragma Inline (type_file);
+
+
+
+
+    function sample_little_endian
+        return Interfaces.C.int;
+    pragma Import (C, sample_little_endian, "sample_little_endian");
+    pragma Inline (sample_little_endian);
+
+    function sample_big_endian
+        return Interfaces.C.int;
+    pragma Import (C, sample_big_endian, "sample_big_endian");
+    pragma Inline (sample_big_endian);
+
+    function sample_native_endian
+        return Interfaces.C.int;
+    pragma Import (C, sample_native_endian, "sample_native_endian");
+    pragma Inline (sample_native_endian);
+
+
+
+
+    function error_no_driver
+        return Interfaces.C.int;
+    pragma Import (C, error_no_driver, "error_no_driver");
+    pragma Inline (error_no_driver);
+
+    function error_not_file
+        return Interfaces.C.int;
+    pragma Import (C, error_not_file, "error_not_file");
+    pragma Inline (error_not_file);
+
+    function error_not_live
+        return Interfaces.C.int;
+    pragma Import (C, error_not_live, "error_not_live");
+    pragma Inline (error_not_live);
+
+    function error_bad_option
+        return Interfaces.C.int;
+    pragma Import (C, error_bad_option, "error_bad_option");
+    pragma Inline (error_bad_option);
+
+    function error_open_device
+        return Interfaces.C.int;
+    pragma Import (C, error_open_device, "error_open_device");
+    pragma Inline (error_open_device);
+
+    function error_open_file
+        return Interfaces.C.int;
+    pragma Import (C, error_open_file, "error_open_file");
+    pragma Inline (error_open_file);
+
+    function error_file_exists
+        return Interfaces.C.int;
+    pragma Import (C, error_file_exists, "error_file_exists");
+    pragma Inline (error_file_exists);
+
+    function error_bad_format
+        return Interfaces.C.int;
+    pragma Import (C, error_bad_format, "error_bad_format");
+    pragma Inline (error_bad_format);
+
+    function error_fail
+        return Interfaces.C.int;
+    pragma Import (C, error_fail, "error_fail");
+    pragma Inline (error_fail);
+
+
+
+
+    function info_item_get
+           (Infos : in System.Address;
+            Index : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, info_item_get, "info_item_get");
+    pragma Inline (info_item_get);
+
+
+
+
+    function info_kind_get
+           (Item : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, info_kind_get, "info_kind_get");
+    pragma Inline (info_kind_get);
+
+    function info_name_get
+           (Item : in System.Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, info_name_get, "info_name_get");
+    pragma Inline (info_name_get);
+
+    function info_short_name_get
+           (Item : in System.Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, info_short_name_get, "info_short_name_get");
+    pragma Inline (info_short_name_get);
+
+    function info_preferred_byte_format_get
+           (Item : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, info_preferred_byte_format_get, "info_preferred_byte_format_get");
+    pragma Inline (info_preferred_byte_format_get);
+
+    function info_priority_get
+           (Item : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, info_priority_get, "info_priority_get");
+    pragma Inline (info_priority_get);
+
+    function info_comment_get
+           (Item : in System.Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, info_comment_get, "info_comment_get");
+    pragma Inline (info_comment_get);
+
+    function info_option_count_get
+           (Item : in System.Address)
+        return Interfaces.C.int;
+    pragma Import (C, info_option_count_get, "info_option_count_get");
+    pragma Inline (info_option_count_get);
+
+    function info_option_key_get
+           (Item  : in System.Address;
+            Index : in Interfaces.C.int)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, info_option_key_get, "info_option_key_get");
+    pragma Inline (info_option_key_get);
+
+
+
+
+    function get_errno
+        return Interfaces.C.int;
+    pragma Import (C, get_errno, "get_errno");
+    pragma Inline (get_errno);
+
+
+
+
+    function option_key
+           (Item : in System.Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, option_key, "option_key");
+    pragma Inline (option_key);
+
+    function option_value
+           (Item : in System.Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, option_value, "option_value");
+    pragma Inline (option_value);
+
+    function option_next
+           (Item : in System.Address)
+        return System.Address;
+    pragma Import (C, option_next, "option_next");
+    pragma Inline (option_next);
+
+
+
+
+    procedure Adjust
+           (This : in out Option_List)
+    is
+        Old : System.Address := This.Ptr;
+    begin
+        This.Ptr := System.Null_Address;
+        while Old /= System.Null_Address loop
+            Do_Append
+               (This.Ptr,
+                Interfaces.C.Strings.Value (option_key (This.Ptr)),
+                Interfaces.C.Strings.Value (option_value (This.Ptr)));
+            Old := option_next (Old);
+        end loop;
+    end Adjust;
+
+    procedure Finalize
+           (This : in out Option_List) is
+    begin
+        ao_free_options (This.Ptr);
+    end Finalize;
+
+    procedure Adjust
+           (This : in out Sample_Format) is
+    begin
+        This.C_Struct.Matrix := Interfaces.C.Strings.New_String
+            (Interfaces.C.Strings.Value (This.C_Struct.Matrix));
+    end Adjust;
+
+    procedure Finalize
+           (This : in out Sample_Format) is
+    begin
+        Interfaces.C.Strings.Free (This.C_Struct.Matrix);
+    end Finalize;
+
+
+
+
+    function Kind
+           (Attributes : in Info)
+        return Output_Kind
+    is
+        Value : Interfaces.C.int := info_kind_get (Attributes.Ptr);
+    begin
+        if Value = type_live then
+            return Live_Output;
+        elsif Value = type_file then
+            return File_Output;
+        else
+            raise Program_Error;
+        end if;
+    end Kind;
+
+    function Name
+           (Attributes : in Info)
+        return String is
+    begin
+        return Interfaces.C.Strings.Value (info_name_get (Attributes.Ptr));
+    end Name;
+
+    function Short_Name
+           (Attributes : in Info)
+        return String is
+    begin
+        return Interfaces.C.Strings.Value (info_short_name_get (Attributes.Ptr));
+    end Short_Name;
+
+    function Preferred_Byte_Format
+           (Attributes : in Info)
+        return Endianness
+    is
+        Value : Interfaces.C.int := info_preferred_byte_format_get (Attributes.Ptr);
+    begin
+        if Value = sample_little_endian then
+            return Little_Endian;
+        elsif Value = sample_big_endian then
+            return Big_Endian;
+        elsif Value = sample_native_endian then
+            return Machine_Native;
+        else
+            raise Program_Error; --  libao would be doing weird shit to get here
+        end if;
+    end Preferred_Byte_Format;
+
+    function Priority_Level
+           (Attributes : in Info)
+        return Positive is
+    begin
+        return Positive (info_priority_get (Attributes.Ptr));
+    end Priority_Level;
+
+    function Comment
+           (Attributes : in Info)
+        return String is
+    begin
+        return Interfaces.C.Strings.Value (info_comment_get (Attributes.Ptr));
+    end Comment;
+
+    function Option_Count
+           (Attributes : in Info)
+        return Natural is
+    begin
+        return Natural (info_option_count_get (Attributes.Ptr));
+    end Option_Count;
+
+    function Option_Key
+           (Attributes : in Info;
+            Index      : in Positive)
+        return String is
+    begin
+        return Interfaces.C.Strings.Value
+            (info_option_key_get (Attributes.Ptr, Interfaces.C.int (Index)));
+    end Option_Key;
+
+
+
+
+    function Image_Length
+           (Channel : in Channel_Mnemonic)
+        return Positive is
+    begin
+        case Channel is
+            when L | R | C | M | X =>
+                return 1;
+            when CL | CR | BL | BR | BC | SL | SR | A1 | A2 | A3 | A4 =>
+                return 2;
+            when LFE =>
+                return 3;
+        end case;
+    end Image_Length;
+
+    function Image_Length
+           (Channel_Matrix : in Mnemonic_Array)
+        return Natural
+    is
+        Result : Integer := Channel_Matrix'Length - 1;
+    begin
+        if Channel_Matrix'Length = 0 then
+            return 0;
+        end if;
+        for Channel of Channel_Matrix loop
+            Result := Result + Image_Length (Channel);
+        end loop;
+        return Result;
+    end Image_Length;
+
+    function Image
+           (Channel_Matrix : in Mnemonic_Array)
+        return String
+    is
+        Result : String (1 .. Image_Length (Channel_Matrix));
+        Position : Integer := 1;
+    begin
+        for Index in Integer range Channel_Matrix'First .. Channel_Matrix'Last - 1 loop
+            Result (Position .. Position + Image_Length (Channel_Matrix (Index))) :=
+                Channel_Matrix (Index)'Image & ",";
+            Position := Position + Image_Length (Channel_Matrix (Index)) + 1;
+        end loop;
+        Result (Position .. Result'Last) := Channel_Matrix (Channel_Matrix'Last)'Image;
+        return Result;
+    end Image;
+
+    function Create
+           (Bits, Rate, Channels : in Positive;
+            Byte_Format          : in Endianness;
+            Channel_Matrix       : in Mnemonic_Array)
+        return Sample_Format is
+    begin
+        return This : Sample_Format := (Ada.Finalization.Controlled with
+            C_Struct =>
+               (Bits        => Interfaces.C.int (Bits),
+                Rate        => Interfaces.C.int (Rate),
+                Channels    => Interfaces.C.int (Channels),
+                Byte_Format => (case Byte_Format is
+                    when Little_Endian  => sample_little_endian,
+                    when Big_Endian     => sample_big_endian,
+                    when Machine_Native => sample_native_endian),
+                Matrix      => Interfaces.C.Strings.New_String (Image (Channel_Matrix))));
+    end Create;
+
+
+
+
+    function Is_Alive
+        return Boolean is
+    begin
+        return Alive_Status;
+    end Is_Alive;
+
+    procedure Startup is
+    begin
+        ao_initialize;
+        Device_List.Clear;
+        Alive_Status := True;
+    end Startup;
+
+    procedure Shutdown is
+    begin
+        for Addy of Device_List loop
+            Do_Close (Addy);
+        end loop;
+        ao_shutdown;
+        Alive_Status := False;
+    end Shutdown;
+
+
+
+
+    procedure Do_Append
+           (Ptr   : in out System.Address;
+            Key   : in     Interfaces.C.char_array;
+            Value : in     Interfaces.C.char_array)
+    is
+        Result : Interfaces.C.int;
+    begin
+        Result := ao_append_option (Ptr, Key, Value);
+        if Result = 0 then
+            raise Storage_Error;
+        elsif Result /= 1 then
+            raise Program_Error;
+        end if;
+    end Do_Append;
+
+    procedure Append
+           (This  : in out Option_List;
+            Key   : in     String;
+            Value : in     String) is
+    begin
+        Do_Append (This.Ptr, Interfaces.C.To_C (Key), Interfaces.C.To_C (Value));
+    end Append;
+
+    procedure Append_Global_Option
+           (Key   : in String;
+            Value : in String)
+    is
+        Result : Interfaces.C.int;
+    begin
+        Result := ao_append_global_option
+           (Interfaces.C.To_C (Key),
+            Interfaces.C.To_C (Value));
+        if Result = 0 then
+            raise Storage_Error;
+        elsif Result /= 1 then
+            raise Program_Error;
+        end if;
+    end Append_Global_Option;
+
+    function Open_Live
+           (Driver_ID : in Driver_ID_Number;
+            Format    : in Sample_Format;
+            Options   : in Option_List'Class)
+        return Device
+    is
+        Result : System.Address := ao_open_live
+           (Driver_ID => Interfaces.C.int (Driver_ID),
+            Format    => Format.C_Struct'Address,
+            Options   => Options.Ptr);
+        My_Errno : Interfaces.C.int;
+    begin
+        if Result = System.Null_Address then
+            My_Errno := get_errno;
+            if My_Errno = error_no_driver then
+                raise No_Driver_Error;
+            elsif My_Errno = error_not_live then
+                raise Not_Live_Error;
+            elsif My_Errno = error_bad_option then
+                raise Bad_Option_Error;
+            elsif My_Errno = error_open_device then
+                raise Open_Device_Error;
+            elsif My_Errno = error_bad_format then
+                raise Bad_Format_Error;
+            elsif My_Errno = error_fail then
+                raise General_Failure;
+            else
+                raise Program_Error;
+            end if;
+        else
+            Device_List.Append (Result);
+            return (Ptr => Result);
+        end if;
+    end Open_Live;
+
+    function Open_File
+           (Driver_ID : in Driver_ID_Number;
+            Filename  : in String;
+            Format    : in Sample_Format;
+            Options   : in Option_List'Class;
+            Overwrite : in Boolean := False)
+        return Device
+    is
+        Result : System.Address := ao_open_file
+           (Driver_ID => Interfaces.C.int (Driver_ID),
+            Filename  => Interfaces.C.To_C (Filename),
+            Overwrite => Boolean'Pos (Overwrite),
+            Format    => Format.C_Struct'Address,
+            Options   => Options.Ptr);
+        My_Errno : Interfaces.C.int;
+    begin
+        if Result = System.Null_Address then
+            My_Errno := get_errno;
+            if My_Errno = error_no_driver then
+                raise No_Driver_Error;
+            elsif My_Errno = error_not_file then
+                raise Not_File_Error;
+            elsif My_Errno = error_bad_option then
+                raise Bad_Option_Error;
+            elsif My_Errno = error_open_file then
+                raise Open_File_Error;
+            elsif My_Errno = error_file_exists then
+                raise File_Exists_Error;
+            elsif My_Errno = error_bad_format then
+                raise Bad_Format_Error;
+            elsif My_Errno = error_fail then
+                raise General_Failure;
+            else
+                raise Program_Error;
+            end if;
+        else
+            Device_List.Append (Result);
+            return (Ptr => Result);
+        end if;
+    end Open_File;
+
+    procedure Play
+           (Output_Device : in Device;
+            Samples       : in Data_Buffer)
+    is
+        Result : Interfaces.C.int := ao_play
+           (Output_Device => Output_Device.Ptr,
+            Samples       => Interfaces.C.To_C (Item => String (Samples), Append_Nul => False),
+            Num_Bytes     => Interfaces.Unsigned_32 (Samples'Length));
+    begin
+        if Result = 0 then
+            raise General_Failure;
+        end if;
+    end Play;
+
+    procedure Do_Close
+           (Ptr : in System.Address)
+    is
+        Result : Interfaces.C.int := ao_close (Ptr);
+    begin
+        if Result = 0 then
+            raise Close_Device_Error;
+        elsif Result /= 1 then
+            raise Program_Error;
+        end if;
+    end Do_Close;
+
+    procedure Close
+           (Output_Device : in out Device) is
+    begin
+        for Index in reverse Integer range Device_List.First_Index .. Device_List.Last_Index loop
+            if Device_List.Element (Index) = Output_Device.Ptr then
+                Device_List.Delete (Index);
+            end if;
+        end loop;
+        Do_Close (Output_Device.Ptr);
+    end Close;
+
+
+
+
+    function Driver_ID
+           (Short_Name : in String)
+        return Driver_ID_Number
+    is
+        Result : Interfaces.C.int;
+    begin
+        Result := ao_driver_id (Interfaces.C.To_C (Short_Name));
+        if Result = -1 then
+            raise No_Driver_Error;
+        elsif Result < 0 then
+            raise Program_Error;
+        end if;
+        return Driver_ID_Number (Result);
+    end Driver_ID;
+
+    function Default_Driver_ID
+        return Driver_ID_Number
+    is
+        Result : Interfaces.C.int;
+    begin
+        Result := ao_default_driver_id;
+        if Result = -1 then
+            raise No_Device_Error;
+        elsif Result < 0 then
+            raise Program_Error;
+        end if;
+        return Driver_ID_Number (Result);
+    end Default_Driver_ID;
+
+    function Driver_Info
+           (Ident : in Driver_ID_Number)
+        return Info
+    is
+        Result : System.Address;
+    begin
+        Result := ao_driver_info (Interfaces.C.int (Ident));
+        if Result = System.Null_Address then
+            raise No_Driver_Error;
+        else
+            return (Ptr => Result);
+        end if;
+    end Driver_Info;
+
+    function Driver_Info_List
+        return Info_Array
+    is
+        Count : Interfaces.C.int;
+        Carr  : System.Address;
+    begin
+        Carr := ao_driver_info_list (Count);
+        return Actual : Info_Array (1 .. Positive (Count)) do
+            for N in Integer range Actual'First .. Actual'Last loop
+                Actual (N) := (Ptr => info_item_get (Carr, Interfaces.C.int (N)));
+            end loop;
+        end return;
+    end Driver_Info_List;
+
+    function File_Extension
+           (Ident : in Driver_ID_Number)
+        return String
+    is
+        Result : Interfaces.C.Strings.chars_ptr := ao_file_extension (Interfaces.C.int (Ident));
+    begin
+        if Result = Interfaces.C.Strings.Null_Ptr then
+            return "";
+        else
+            return Interfaces.C.Strings.Value (Result);
+        end if;
+    end File_Extension;
+
+
+
+
+    function Is_Big_Endian
+        return Boolean is
+    begin
+        case ao_is_big_endian is
+            when 1 => return True;
+            when 0 => return False;
+            when others => raise Program_Error;
+        end case;
+    end Is_Big_Endian;
+
+
+end Libao;
+
+