diff options
Diffstat (limited to 'src/libao.adb')
| -rw-r--r-- | src/libao.adb | 262 |
1 files changed, 113 insertions, 149 deletions
diff --git a/src/libao.adb b/src/libao.adb index e10582d..1f37875 100644 --- a/src/libao.adb +++ b/src/libao.adb @@ -20,16 +20,65 @@ package body Libao is ------------------------ + -- Constants From C -- + ------------------------ + + type_live : constant Interfaces.C.int; + pragma Import (C, type_live, "type_live"); + + type_file : constant Interfaces.C.int; + pragma Import (C, type_file, "type_file"); + + + sample_little_endian : constant Interfaces.C.int; + pragma Import (C, sample_little_endian, "sample_little_endian"); + + sample_big_endian : constant Interfaces.C.int; + pragma Import (C, sample_big_endian, "sample_big_endian"); + + sample_native_endian : constant Interfaces.C.int; + pragma Import (C, sample_native_endian, "sample_native_endian"); + + + error_no_driver : constant Interfaces.C.int; + pragma Import (C, error_no_driver, "error_no_driver"); + + error_not_file : constant Interfaces.C.int; + pragma Import (C, error_not_file, "error_not_file"); + + error_not_live : constant Interfaces.C.int; + pragma Import (C, error_not_live, "error_not_live"); + + error_bad_option : constant Interfaces.C.int; + pragma Import (C, error_bad_option, "error_bad_option"); + + error_open_device : constant Interfaces.C.int; + pragma Import (C, error_open_device, "error_open_device"); + + error_open_file : constant Interfaces.C.int; + pragma Import (C, error_open_file, "error_open_file"); + + error_file_exists : constant Interfaces.C.int; + pragma Import (C, error_file_exists, "error_file_exists"); + + error_bad_format : constant Interfaces.C.int; + pragma Import (C, error_bad_format, "error_bad_format"); + + error_fail : constant Interfaces.C.int; + pragma Import (C, error_fail, "error_fail"); + + + + + ------------------------ -- Functions From C -- ------------------------ 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 @@ -38,19 +87,16 @@ package body Libao is 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; @@ -58,7 +104,6 @@ package body Libao is 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; @@ -68,7 +113,6 @@ package body Libao is 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; @@ -76,130 +120,41 @@ package body Libao is 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 @@ -210,8 +165,6 @@ package body Libao is pragma Inline (info_item_get); - - function info_kind_get (Item : in System.Address) return Interfaces.C.int; @@ -262,16 +215,12 @@ package body Libao is 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; @@ -293,6 +242,40 @@ package body Libao is + ------------------------ + -- Internal Utility -- + ------------------------ + + 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 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; + + + + ----------------------------------- -- Controlled Type Subprograms -- ----------------------------------- @@ -494,21 +477,6 @@ package body Libao is -- Device Setup/Playback/Teardown -- -------------------------------------- - 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; @@ -533,11 +501,11 @@ package body Libao is 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 + procedure Open_Live + (Output : in out Device; + Driver_ID : in Driver_ID_Number; + Format : in Sample_Format'Class; + Options : in Option_List'Class) is Result : System.Address := ao_open_live (Driver_ID => Interfaces.C.int (Driver_ID), @@ -563,18 +531,19 @@ package body Libao is raise Program_Error; end if; else + Output.Close; Device_List.Append (Result); - return (Ptr => Result); + Output.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 + procedure Open_File + (Output : in out Device; + Driver_ID : in Driver_ID_Number; + Filename : in String; + Format : in Sample_Format'Class; + Options : in Option_List'Class; + Overwrite : in Boolean := False) is Result : System.Address := ao_open_file (Driver_ID => Interfaces.C.int (Driver_ID), @@ -604,17 +573,18 @@ package body Libao is raise Program_Error; end if; else + Output.Close; Device_List.Append (Result); - return (Ptr => Result); + Output.Ptr := Result; end if; end Open_File; procedure Play - (Output_Device : in Device; - Samples : in Data_Buffer) + (Output : in Device; + Samples : in Data_Buffer) is Result : Interfaces.C.int := ao_play - (Output_Device => Output_Device.Ptr, + (Output_Device => Output.Ptr, Samples => Interfaces.C.To_C (Item => String (Samples), Append_Nul => False), Num_Bytes => Interfaces.Unsigned_32 (Samples'Length)); begin @@ -623,27 +593,21 @@ package body Libao is 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 + (Output : in out Device) + is + Found : Boolean := False; 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 + if Device_List.Element (Index) = Output.Ptr then Device_List.Delete (Index); + Found := True; end if; end loop; - Do_Close (Output_Device.Ptr); + if Found then + Do_Close (Output.Ptr); + end if; + Output.Ptr := System.Null_Address; end Close; |