diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_aao.c | 6 | ||||
| -rw-r--r-- | src/c_aao.h | 3 | ||||
| -rw-r--r-- | src/libao.adb | 247 | ||||
| -rw-r--r-- | src/libao.ads | 94 |
4 files changed, 268 insertions, 82 deletions
diff --git a/src/c_aao.c b/src/c_aao.c index 7c6fe8d..3a18047 100644 --- a/src/c_aao.c +++ b/src/c_aao.c @@ -28,6 +28,12 @@ const int error_fail = AO_EFAIL; +size_t c_pointer_size() { + return sizeof(void*); +} + + + ao_info * info_item_get(ao_info ** items, int n) { return items[n]; } diff --git a/src/c_aao.h b/src/c_aao.h index 81f61ff..9e24cbc 100644 --- a/src/c_aao.h +++ b/src/c_aao.h @@ -28,6 +28,9 @@ extern const int error_bad_format; extern const int error_fail; +size_t c_pointer_size(); + + ao_info * info_item_get(ao_info ** items, int n); int info_kind_get(ao_info * item); diff --git a/src/libao.adb b/src/libao.adb index 48a0ac1..0d7f7ba 100644 --- a/src/libao.adb +++ b/src/libao.adb @@ -9,11 +9,15 @@ pragma Ada_2012; with + Ada.Containers, + Ada.Strings.Fixed, + Ada.Strings.Maps, Interfaces.C.Strings, - System; + System.Storage_Elements; use type + Ada.Containers.Count_Type, Interfaces.C.int, Interfaces.C.Strings.chars_ptr, System.Address; @@ -22,6 +26,13 @@ use type package body Libao is + package Str renames Ada.Strings; + package SFix renames Ada.Strings.Fixed; + package SMap renames Ada.Strings.Maps; + + + + ------------------------ -- Constants From C -- ------------------------ @@ -85,7 +96,7 @@ package body Libao is function ao_append_option - (Options : in out System.Address; + (Options : in out Storage.Integer_Address; Key : in Interfaces.C.char_array; Value : in Interfaces.C.char_array) return Interfaces.C.int; @@ -98,34 +109,34 @@ package body Libao is pragma Import (C, ao_append_global_option, "ao_append_global_option"); procedure ao_free_options - (Options : in System.Address); + (Options : in Storage.Integer_Address); pragma Import (C, ao_free_options, "ao_free_options"); function ao_open_live (Driver_ID : in Interfaces.C.int; - Format : in System.Address; - Options : in System.Address) - return System.Address; + Format : in Storage.Integer_Address; + Options : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, ao_open_live, "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; + Format : in Storage.Integer_Address; + Options : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, ao_open_file, "ao_open_file"); function ao_play - (Output_Device : in System.Address; - Samples : in System.Address; + (Output_Device : in Storage.Integer_Address; + Samples : in Storage.Integer_Address; Num_Bytes : in Interfaces.Unsigned_32) return Interfaces.C.int; pragma Import (C, ao_play, "ao_play"); function ao_close - (Output_Device : in System.Address) + (Output_Device : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, ao_close, "ao_close"); @@ -141,12 +152,12 @@ package body Libao is function ao_driver_info (Ident : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, ao_driver_info, "ao_driver_info"); function ao_driver_info_list (Count : out Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, ao_driver_info_list, "ao_driver_info_list"); function ao_file_extension @@ -161,57 +172,57 @@ package body Libao is function info_item_get - (Infos : in System.Address; + (Infos : in Storage.Integer_Address; Index : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, info_item_get, "info_item_get"); pragma Inline (info_item_get); function info_kind_get - (Item : in System.Address) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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; + (Item : in Storage.Integer_Address; Index : in Interfaces.C.int) return Interfaces.C.Strings.chars_ptr; pragma Import (C, info_option_key_get, "info_option_key_get"); @@ -225,20 +236,20 @@ package body Libao is function option_key - (Item : in System.Address) + (Item : in Storage.Integer_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) + (Item : in Storage.Integer_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; + (Item : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, option_next, "option_next"); pragma Inline (option_next); @@ -250,22 +261,29 @@ package body Libao is ------------------------ procedure Do_Append - (Ptr : in out System.Address; - Key : in Interfaces.C.char_array; - Value : in Interfaces.C.char_array) + (Ptr_List : in out Address_Vectors.Vector; + Key : in Interfaces.C.char_array; + Value : in Interfaces.C.char_array) is Result : Interfaces.C.int; + Head : Storage.Integer_Address := Head_Pointer (Ptr_List); begin - Result := ao_append_option (Ptr, Key, Value); + Result := ao_append_option (Head, Key, Value); if Result = 0 then raise Storage_Error; elsif Result /= 1 then raise Program_Error; + else + if Ptr_List.Length = 0 then + Ptr_List.Append (Head); + else + Ptr_List.Append (option_next (Ptr_List.Last_Element)); + end if; end if; end Do_Append; procedure Do_Close - (Ptr : in System.Address) + (Ptr : in Storage.Integer_Address) is Result : Interfaces.C.int := ao_close (Ptr); begin @@ -276,6 +294,17 @@ package body Libao is end if; end Do_Close; + function Head_Pointer + (This : in Address_Vectors.Vector) + return Storage.Integer_Address is + begin + if This.Length = 0 then + return Null_Pointer; + else + return This.First_Element; + end if; + end Head_Pointer; + @@ -286,14 +315,14 @@ package body Libao is procedure Adjust (This : in out Option_List) is - Old : System.Address := This.Ptr; + Old : Storage.Integer_Address := Head_Pointer (This.Ptr_List); begin - This.Ptr := System.Null_Address; - while Old /= System.Null_Address loop + This.Ptr_List := Address_Vectors.Empty_Vector; + while Old /= Null_Pointer loop Do_Append - (This.Ptr, - Interfaces.C.Strings.Value (option_key (This.Ptr)), - Interfaces.C.Strings.Value (option_value (This.Ptr))); + (This.Ptr_List, + Interfaces.C.Strings.Value (option_key (Old)), + Interfaces.C.Strings.Value (option_value (Old))); Old := option_next (Old); end loop; end Adjust; @@ -301,7 +330,7 @@ package body Libao is procedure Finalize (This : in out Option_List) is begin - ao_free_options (This.Ptr); + ao_free_options (Head_Pointer (This.Ptr_List)); end Finalize; procedure Adjust @@ -381,9 +410,9 @@ package body Libao is function Priority_Level (Attributes : in Info) - return Positive is + return Natural is begin - return Positive (info_priority_get (Attributes.Ptr)); + return Natural (info_priority_get (Attributes.Ptr)); end Priority_Level; function Comment @@ -406,10 +435,34 @@ package body Libao is return String is begin return Interfaces.C.Strings.Value - (info_option_key_get (Attributes.Ptr, Interfaces.C.int (Index))); + (info_option_key_get (Attributes.Ptr, Interfaces.C.int (Index) - 1)); end Option_Key; + function Length + (Options : in Option_List) + return Natural is + begin + return Natural (Options.Ptr_List.Length); + end Length; + + function Key + (Options : in Option_List; + Index : in Positive) + return String is + begin + return Interfaces.C.Strings.Value (option_key (Options.Ptr_List.Element (Index))); + end Key; + + function Value + (Options : in Option_List; + Index : in Positive) + return String is + begin + return Interfaces.C.Strings.Value (option_value (Options.Ptr_List.Element (Index))); + end Value; + + function Image_Length (Channel : in Channel_Mnemonic) return Positive is @@ -428,6 +481,7 @@ package body Libao is (Channel_Matrix : in Mnemonic_Array) return Natural is + -- Start by counting all the commas Result : Integer := Channel_Matrix'Length - 1; begin if Channel_Matrix'Length = 0 then @@ -443,13 +497,14 @@ package body Libao is (Channel_Matrix : in Mnemonic_Array) return String is - Result : String (1 .. Image_Length (Channel_Matrix)); - Position : Integer := 1; + Result : String (1 .. Image_Length (Channel_Matrix)); + Position : Integer := 1; + Token_End : Positive; 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; + Token_End := Position + Image_Length (Channel_Matrix (Index)); + Result (Position .. Token_End) := Channel_Matrix (Index)'Image & ","; + Position := Token_End + 1; end loop; Result (Position .. Result'Last) := Channel_Matrix (Channel_Matrix'Last)'Image; return Result; @@ -473,6 +528,71 @@ package body Libao is Matrix => Interfaces.C.Strings.New_String (Image (Channel_Matrix)))); end Create; + function Bits + (Format : in Sample_Format) + return Positive is + begin + return Positive (Format.C_Struct.Bits); + end Bits; + + function Rate + (Format : in Sample_Format) + return Positive is + begin + return Positive (Format.C_Struct.Rate); + end Rate; + + function Channels + (Format : in Sample_Format) + return Positive is + begin + return Positive (Format.C_Struct.Channels); + end Channels; + + function Byte_Format + (Format : in Sample_Format) + return Endianness is + begin + if Format.C_Struct.Byte_Format = sample_little_endian then + return Little_Endian; + elsif Format.C_Struct.Byte_Format = sample_big_endian then + return Big_Endian; + elsif Format.C_Struct.Byte_Format = sample_native_endian then + return Machine_Native; + else + raise Constraint_Error; + end if; + end Byte_Format; + + function Channel_Matrix + (Format : in Sample_Format) + return Mnemonic_Array + is + Input : String := Interfaces.C.Strings.Value (Format.C_Struct.Matrix); + Result : Mnemonic_Array (1 .. SFix.Count (Input, SMap.To_Set (',')) + 1); + First : Positive := 1; + Last : Natural; + Place : Positive := 1; + begin + if Input'Length = 0 then + return Empty : Mnemonic_Array (1 .. 0); + end if; + while First <= Input'Last loop + SFix.Find_Token + (Source => Input, + Set => SMap.To_Set (','), + From => First, + Test => Str.Outside, + First => First, + Last => Last); + exit when Last = 0; + Result (Place) := Channel_Mnemonic'Value (Input (First .. Last)); + Place := Place + 1; + First := Last + 1; + end loop; + return Result; + end Channel_Matrix; + @@ -485,7 +605,7 @@ package body Libao is Key : in String; Value : in String) is begin - Do_Append (This.Ptr, Interfaces.C.To_C (Key), Interfaces.C.To_C (Value)); + Do_Append (This.Ptr_List, Interfaces.C.To_C (Key), Interfaces.C.To_C (Value)); end Append; procedure Append_Global_Option @@ -510,13 +630,13 @@ package body Libao is Format : in Sample_Format'Class; Options : in Option_List'Class) is - Result : System.Address := ao_open_live + Result : Storage.Integer_Address := ao_open_live (Driver_ID => Interfaces.C.int (Driver_ID), - Format => Format.C_Struct'Address, - Options => Options.Ptr); + Format => Storage.To_Integer (Format.C_Struct'Address), + Options => Head_Pointer (Options.Ptr_List)); My_Errno : Interfaces.C.int; begin - if Result = System.Null_Address then + if Result = Null_Pointer then My_Errno := get_errno; if My_Errno = error_no_driver then raise No_Driver_Error; @@ -548,15 +668,15 @@ package body Libao is Options : in Option_List'Class; Overwrite : in Boolean := False) is - Result : System.Address := ao_open_file + Result : Storage.Integer_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); + Format => Storage.To_Integer (Format.C_Struct'Address), + Options => Head_Pointer (Options.Ptr_List)); My_Errno : Interfaces.C.int; begin - if Result = System.Null_Address then + if Result = Null_Pointer then My_Errno := get_errno; if My_Errno = error_no_driver then raise No_Driver_Error; @@ -588,8 +708,7 @@ package body Libao is is Result : Interfaces.C.int := ao_play (Output_Device => Output.Ptr, - Samples => Samples'Address, - --Samples => Interfaces.C.To_C (Item => String (Samples), Append_Nul => False), + Samples => Storage.To_Integer (Samples'Address), Num_Bytes => Interfaces.Unsigned_32 (Samples'Length)); begin if Result = 0 then @@ -611,7 +730,7 @@ package body Libao is if Found then Do_Close (Output.Ptr); end if; - Output.Ptr := System.Null_Address; + Output.Ptr := Null_Pointer; end Close; @@ -654,10 +773,10 @@ package body Libao is (Ident : in Driver_ID_Number) return Info is - Result : System.Address; + Result : Storage.Integer_Address; begin Result := ao_driver_info (Interfaces.C.int (Ident)); - if Result = System.Null_Address then + if Result = Null_Pointer then raise No_Driver_Error; else return (Ptr => Result); @@ -668,12 +787,12 @@ package body Libao is return Info_Array is Count : Interfaces.C.int; - Carr : System.Address; + Carr : Storage.Integer_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))); + Actual (N) := (Ptr => info_item_get (Carr, Interfaces.C.int (N - 1))); end loop; end return; end Driver_Info_List; diff --git a/src/libao.ads b/src/libao.ads index db5f7ce..c2013c5 100644 --- a/src/libao.ads +++ b/src/libao.ads @@ -16,7 +16,7 @@ private with Ada.Finalization, Ada.Containers.Vectors, Interfaces.C.Strings, - System; + System.Storage_Elements; package Libao is @@ -58,7 +58,7 @@ package Libao is function Priority_Level (Attributes : in Info) - return Positive; + return Natural; function Comment (Attributes : in Info) @@ -78,19 +78,54 @@ package Libao is Empty_Options : constant Option_List; + function Length + (Options : in Option_List) + return Natural; + + function Key + (Options : in Option_List; + Index : in Positive) + return String; + + function Value + (Options : in Option_List; + Index : in Positive) + return String; + 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; + Stereo : constant Mnemonic_Array := (L, R); + Quadraphonic : constant Mnemonic_Array := (L, R, BL, BR); + function Create (Bits, Rate, Channels : in Positive; Byte_Format : in Endianness; Channel_Matrix : in Mnemonic_Array) - return Sample_Format; + return Sample_Format + with Pre => Channel_Matrix'Length = Channels; - Stereo : constant Mnemonic_Array := (L, R); - Quadraphonic : constant Mnemonic_Array := (L, R, BL, BR); + function Bits + (Format : in Sample_Format) + return Positive; + + function Rate + (Format : in Sample_Format) + return Positive; + + function Channels + (Format : in Sample_Format) + return Positive; + + function Byte_Format + (Format : in Sample_Format) + return Endianness; + + function Channel_Matrix + (Format : in Sample_Format) + return Mnemonic_Array; @@ -211,33 +246,61 @@ package Libao is private + package Storage renames System.Storage_Elements; + use type Interfaces.C.size_t, Storage.Integer_Address; + + + Null_Pointer : constant Storage.Integer_Address := Storage.To_Integer (System.Null_Address); + + pragma Linker_Options ("-lao"); + function c_pointer_size + return Interfaces.C.size_t; + pragma Import (C, c_pointer_size, "c_pointer_size"); + + -- If this fails then we are on an architecture that for whatever reason + -- has significant problems interfacing between C and Ada + pragma Assert + (c_pointer_size * Interfaces.C.CHAR_BIT = Storage.Integer_Address'Size, + "Size of C void pointers and size of Ada address values do not match"); + + for Data_Buffer'Component_Size use Interfaces.C.CHAR_BIT; + package Address_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Storage.Integer_Address, + "=" => Storage."="); + + procedure Do_Append - (Ptr : in out System.Address; - Key : in Interfaces.C.char_array; - Value : in Interfaces.C.char_array); + (Ptr_List : in out Address_Vectors.Vector; + Key : in Interfaces.C.char_array; + Value : in Interfaces.C.char_array); procedure Do_Close - (Ptr : in System.Address); + (Ptr : in Storage.Integer_Address); + + function Head_Pointer + (This : in Address_Vectors.Vector) + return Storage.Integer_Address; type Device is tagged record - Ptr : System.Address := System.Null_Address; + Ptr : Storage.Integer_Address := Null_Pointer; end record; type Info is tagged record - Ptr : System.Address := System.Null_Address; + Ptr : Storage.Integer_Address := Null_Pointer; end record; type Option_List is new Ada.Finalization.Controlled with record - Ptr : System.Address := System.Null_Address; + Ptr_List : Address_Vectors.Vector := Address_Vectors.Empty_Vector; end record; overriding procedure Adjust @@ -247,7 +310,7 @@ private (This : in out Option_List); Empty_Options : constant Option_List := - (Ada.Finalization.Controlled with Ptr => System.Null_Address); + (Ada.Finalization.Controlled with Ptr_List => Address_Vectors.Empty_Vector); type C_Sample_Format is record @@ -270,11 +333,6 @@ private -- Keep track of open devices - package Address_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => System.Address, - "=" => System."="); - Device_List : Address_Vectors.Vector := Address_Vectors.Empty_Vector; |