diff options
Diffstat (limited to 'src/libao.adb')
| -rw-r--r-- | src/libao.adb | 746 |
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; + + |