summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2024-09-16 12:25:41 +1200
committerJedidiah Barber <contact@jedbarber.id.au>2024-09-16 12:25:41 +1200
commit87e42e46a5d898698ad5cbcd71b3877d2c319084 (patch)
tree5416594999b269e4890e0cb8a0d1c66a4f48a383
parenta9a297e8f7282bcc9b3ffb14862160bb1abad511 (diff)
Off-by-one bugs fixed, more testing programs, change to Integer_AddressHEADmaster
-rw-r--r--example.gpr4
-rw-r--r--example/format_options.adb77
-rw-r--r--example/info_list.adb74
-rw-r--r--src/c_aao.c6
-rw-r--r--src/c_aao.h3
-rw-r--r--src/libao.adb247
-rw-r--r--src/libao.ads94
7 files changed, 422 insertions, 83 deletions
diff --git a/example.gpr b/example.gpr
index 7637830..c702ae7 100644
--- a/example.gpr
+++ b/example.gpr
@@ -12,12 +12,14 @@ project Example is
for Source_Dirs use ("example");
for Object_Dir use "obj";
for Exec_Dir use "bin";
- for Main use ("aao_example.adb", "ao_example.c");
+ for Main use ("aao_example.adb", "ao_example.c", "info_list.adb", "format_options.adb");
package Builder is
for Executable("aao_example.adb") use "ada_example";
for Executable("ao_example.c") use "c_example";
+ for Executable("info_list.adb") use "info_list";
+ for Executable("format_options.adb") use "format_options";
end Builder;
diff --git a/example/format_options.adb b/example/format_options.adb
new file mode 100644
index 0000000..352d3d5
--- /dev/null
+++ b/example/format_options.adb
@@ -0,0 +1,77 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+-- This program tests out the Option_List and Sample_Format datatypes
+
+
+with
+
+ Ada.Characters.Latin_1,
+ Ada.Text_IO,
+ Libao;
+
+
+procedure Format_Options is
+
+ package Latin renames Ada.Characters.Latin_1;
+ package TIO renames Ada.Text_IO;
+
+ My_Options : Libao.Option_List;
+
+ My_Format : Libao.Sample_Format := Libao.Create
+ (Bits => 16,
+ Rate => 44100,
+ Channels => 4,
+ Byte_Format => Libao.Big_Endian,
+ Channel_Matrix => Libao.Quadraphonic);
+
+begin
+
+
+ TIO.Put_Line ("libao datatype testing");
+ TIO.New_Line;
+
+
+ declare
+ Temp : Libao.Option_List := Libao.Empty_Options;
+ begin
+ Temp.Append ("one", "two");
+ Temp.Append ("three", "four");
+ Temp.Append ("five", "six");
+
+ TIO.Put_Line ("Temporary options created with");
+ for Index in Integer range 1 .. Temp.Length loop
+ TIO.Put_Line (Latin.HT & Temp.Key (Index) & " -> " & Temp.Value (Index));
+ end loop;
+ TIO.New_Line;
+
+ My_Options := Temp;
+ Temp.Append ("should not", "be seen");
+ end;
+
+
+ My_Options.Append ("added", "thing");
+ TIO.Put_Line ("The main testing options now are");
+ for Index in Integer range 1 .. My_Options.Length loop
+ TIO.Put_Line (Latin.HT & My_Options.Key (Index) & " -> " & My_Options.Value (Index));
+ end loop;
+ TIO.New_Line;
+
+
+ TIO.Put_Line ("The created sample format is");
+ TIO.Put_Line (Latin.HT & "Bits =" & Integer'Image (My_Format.Bits));
+ TIO.Put_Line (Latin.HT & "Rate =" & Integer'Image (My_Format.Rate));
+ TIO.Put_Line (Latin.HT & "Channels =" & Integer'Image (My_Format.Channels));
+ TIO.Put_Line (Latin.HT & "Byte Format = " & Libao.Endianness'Image (My_Format.Byte_Format));
+ TIO.Put (Latin.HT & "Channel Matrix = ");
+ for Mnemonic of My_Format.Channel_Matrix loop
+ TIO.Put (Libao.Channel_Mnemonic'Image (Mnemonic) & " ");
+ end loop;
+ TIO.New_Line;
+
+
+end Format_Options;
+
+
diff --git a/example/info_list.adb b/example/info_list.adb
new file mode 100644
index 0000000..5dcdcf0
--- /dev/null
+++ b/example/info_list.adb
@@ -0,0 +1,74 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+-- This program displays information about all available libao drivers
+
+
+with
+
+ Ada.Characters.Latin_1,
+ Ada.Strings.Fixed,
+ Ada.Text_IO,
+ Libao;
+
+use type
+
+ Libao.Output_Kind;
+
+
+procedure Info_List is
+
+ package Latin renames Ada.Characters.Latin_1;
+ package Str renames Ada.Strings;
+ package TIO renames Ada.Text_IO;
+
+ function "*"
+ (Left : in Natural;
+ Right : in Character)
+ return String
+ renames Ada.Strings.Fixed."*";
+
+ My_Information : Libao.Info_Array := Libao.Driver_Info_List;
+
+begin
+
+ TIO.Put_Line ("libao driver information");
+ TIO.New_Line;
+
+ TIO.Put_Line ("Is big endian: " & Boolean'Image (Libao.Is_Big_Endian));
+ TIO.Put_Line ("Number of drivers:" & Integer'Image (My_Information'Length));
+ TIO.Put_Line ("Default driver:" & Libao.Driver_ID_Number'Image (Libao.Default_Driver_ID));
+ TIO.New_Line;
+
+ for Item of My_Information loop
+ TIO.Put_Line (36 * '-' & " Driver ID #" & Str.Fixed.Trim
+ (Libao.Driver_ID_Number'Image (Libao.Driver_ID (Item.Short_Name)), Str.Left));
+
+ TIO.Put_Line ("Kind: " & Libao.Output_Kind'Image (Item.Kind));
+ TIO.Put_Line ("Name: " & Item.Name);
+ TIO.Put_Line ("Short name: " & Item.Short_Name);
+ TIO.Put_Line ("Preferred byte format: " &
+ Libao.Endianness'Image (Item.Preferred_Byte_Format));
+ TIO.Put_Line ("Priority Level:" & Positive'Image (Item.Priority_Level));
+ TIO.Put_Line ("Comment: " & Item.Comment);
+
+ if Item.Kind = Libao.File_Output then
+ TIO.Put_Line ("File extension: " & Libao.File_Extension
+ (Libao.Driver_ID (Item.Short_Name)));
+ end if;
+
+ TIO.Put_Line ("Option count:" & Integer'Image (Item.Option_Count));
+ for Index in Integer range 1 .. Item.Option_Count loop
+ TIO.Put_Line (Latin.HT & "#" & Str.Fixed.Trim (Integer'Image (Index), Str.Left) &
+ " " & Item.Option_Key (Index));
+ end loop;
+
+ TIO.Put_Line (46 * '-');
+ TIO.New_Line;
+ end loop;
+
+end Info_List;
+
+
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;