diff options
Diffstat (limited to 'src/libao.adb')
| -rw-r--r-- | src/libao.adb | 247 |
1 files changed, 183 insertions, 64 deletions
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; |