diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_aao.c | 75 | ||||
| -rw-r--r-- | src/c_aao.h | 33 | ||||
| -rw-r--r-- | src/libao.adb | 262 | ||||
| -rw-r--r-- | src/libao.ads | 46 |
4 files changed, 171 insertions, 245 deletions
diff --git a/src/c_aao.c b/src/c_aao.c index 731792d..7c6fe8d 100644 --- a/src/c_aao.c +++ b/src/c_aao.c @@ -9,65 +9,22 @@ -int type_live() { - return AO_TYPE_LIVE; -} - -int type_file() { - return AO_TYPE_FILE; -} - - - -int sample_little_endian() { - return AO_FMT_LITTLE; -} - -int sample_big_endian() { - return AO_FMT_BIG; -} - -int sample_native_endian() { - return AO_FMT_NATIVE; -} - - - -int error_no_driver() { - return AO_ENODRIVER; -} - -int error_not_file() { - return AO_ENOTFILE; -} - -int error_not_live() { - return AO_ENOTLIVE; -} - -int error_bad_option() { - return AO_EBADOPTION; -} - -int error_open_device() { - return AO_EOPENDEVICE; -} - -int error_open_file() { - return AO_EOPENFILE; -} - -int error_file_exists() { - return AO_EFILEEXISTS; -} - -int error_bad_format() { - return AO_EBADFORMAT; -} - -int error_fail() { - return AO_EFAIL; -} +const int type_live = AO_TYPE_LIVE; +const int type_file = AO_TYPE_FILE; + +const int sample_little_endian = AO_FMT_LITTLE; +const int sample_big_endian = AO_FMT_BIG; +const int sample_native_endian = AO_FMT_NATIVE; + +const int error_no_driver = AO_ENODRIVER; +const int error_not_file = AO_ENOTFILE; +const int error_not_live = AO_ENOTLIVE; +const int error_bad_option = AO_EBADOPTION; +const int error_open_device = AO_EOPENDEVICE; +const int error_open_file = AO_EOPENFILE; +const int error_file_exists = AO_EFILEEXISTS; +const int error_bad_format = AO_EBADFORMAT; +const int error_fail = AO_EFAIL; diff --git a/src/c_aao.h b/src/c_aao.h index d0a23a4..81f61ff 100644 --- a/src/c_aao.h +++ b/src/c_aao.h @@ -10,22 +10,23 @@ #include <ao/ao.h> -int type_live(); -int type_file(); - -int sample_little_endian(); -int sample_big_endian(); -int sample_native_endian(); - -int error_no_driver(); -int error_not_file(); -int error_not_live(); -int error_bad_option(); -int error_open_device(); -int error_open_file(); -int error_file_exists(); -int error_bad_format(); -int error_fail(); +extern const int type_live; +extern const int type_file; + +extern const int sample_little_endian; +extern const int sample_big_endian; +extern const int sample_native_endian; + +extern const int error_no_driver; +extern const int error_not_file; +extern const int error_not_live; +extern const int error_bad_option; +extern const int error_open_device; +extern const int error_open_file; +extern const int error_file_exists; +extern const int error_bad_format; +extern const int error_fail; + ao_info * info_item_get(ao_info ** items, int n); 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; diff --git a/src/libao.ads b/src/libao.ads index 9e1cde1..33ec49c 100644 --- a/src/libao.ads +++ b/src/libao.ads @@ -4,6 +4,10 @@ -- Released into the public domain +with + + Interfaces; + private with Ada.Finalization, @@ -25,7 +29,7 @@ package Libao is type Data_Buffer is new String; - type Device is private; + type Device is tagged private; type Info is tagged private; @@ -72,7 +76,7 @@ package Libao is Empty_Options : constant Option_List; - type Sample_Format is private; + type Sample_Format is tagged private; type Channel_Mnemonic is (L, R, C, M, CL, CR, BL, BR, BC, SL, SR, LFE, A1, A2, A3, A4, X); type Mnemonic_Array is array (Positive range <>) of Channel_Mnemonic; @@ -144,26 +148,26 @@ package Libao is (Key : in String; Value : in String); - 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); - 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); procedure Play - (Output_Device : in Device; - Samples : in Data_Buffer); + (Output : in Device; + Samples : in Data_Buffer); procedure Close - (Output_Device : in out Device); + (Output : in out Device); @@ -216,13 +220,13 @@ private (Ptr : in System.Address); - type Device is record - Ptr : System.Address; + type Device is tagged record + Ptr : System.Address := System.Null_Address; end record; type Info is tagged record - Ptr : System.Address; + Ptr : System.Address := System.Null_Address; end record; @@ -259,7 +263,7 @@ private (This : in out Sample_Format); - -- Keep track of + -- Keep track of open devices package Address_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => System.Address, |