From 74af58587359206ef92249d18e4830c40cac0bc5 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 19 Jun 2023 22:15:44 +1200 Subject: Initial commit --- aao.gpr | 24 ++ bin/.gitignore | 4 + example.gpr | 32 +++ example/aao_example.adb | 101 +++++++ example/ao_example.c | 87 ++++++ lib/.gitignore | 4 + obj/.gitignore | 4 + readme.txt | 54 ++++ src/c_aao.c | 136 +++++++++ src/c_aao.h | 50 ++++ src/libao.adb | 746 ++++++++++++++++++++++++++++++++++++++++++++++++ src/libao.ads | 319 +++++++++++++++++++++ unlicense.txt | 24 ++ 13 files changed, 1585 insertions(+) create mode 100644 aao.gpr create mode 100644 bin/.gitignore create mode 100644 example.gpr create mode 100644 example/aao_example.adb create mode 100644 example/ao_example.c create mode 100644 lib/.gitignore create mode 100644 obj/.gitignore create mode 100644 readme.txt create mode 100644 src/c_aao.c create mode 100644 src/c_aao.h create mode 100644 src/libao.adb create mode 100644 src/libao.ads create mode 100644 unlicense.txt diff --git a/aao.gpr b/aao.gpr new file mode 100644 index 0000000..07588ad --- /dev/null +++ b/aao.gpr @@ -0,0 +1,24 @@ + + +library project AAO is + + + for Languages use ("Ada", "C"); + + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; + for Library_Name use "aao"; + for Library_Kind use "dynamic"; + + + package Compiler is + for Default_Switches ("Ada") use ("-gnaty4aAbcefhiklM100nprt"); + for Default_Switches ("C") use ("-Wall", "-Wextra"); + end Compiler; + + +end AAO; + + diff --git a/bin/.gitignore b/bin/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/bin/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/example.gpr b/example.gpr new file mode 100644 index 0000000..7637830 --- /dev/null +++ b/example.gpr @@ -0,0 +1,32 @@ + + +with "aao"; + + +project Example is + + + for languages use ("Ada", "C"); + + + for Source_Dirs use ("example"); + for Object_Dir use "obj"; + for Exec_Dir use "bin"; + for Main use ("aao_example.adb", "ao_example.c"); + + + package Builder is + for Executable("aao_example.adb") use "ada_example"; + for Executable("ao_example.c") use "c_example"; + end Builder; + + + package Compiler is + for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt"); + for Default_Switches("C") use ("-Wall", "-Wextra"); + end Compiler; + + +end Example; + + diff --git a/example/aao_example.adb b/example/aao_example.adb new file mode 100644 index 0000000..7d12b56 --- /dev/null +++ b/example/aao_example.adb @@ -0,0 +1,101 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + +-- This program opens the default libao driver and plays a 440 Hz tone for one second + + +with + + Ada.Command_Line, + Ada.Numerics.Elementary_Functions, + Ada.Text_IO, + Libao; + + +procedure AAO_Example is + + package ACom renames Ada.Command_Line; + package Math renames Ada.Numerics.Elementary_Functions; + package TIO renames Ada.Text_IO; + + My_Device : Libao.Device; + My_Format : Libao.Sample_Format; + + Default_Driver : Libao.Driver_ID_Number; + +begin + + -- Initialize + + TIO.Put_Line ("libao example program"); + + Libao.Startup; + + + -- Setup for default driver + + Default_Driver := Libao.Default_Driver_ID; + + My_Format := Libao.Create + (Bits => 16, + Rate => 44100, + Channels => 2, + Byte_Format => Libao.Little_Endian, + Channel_Matrix => Libao.Stereo); + + + -- Open driver + + begin + My_Device := Libao.Open_Live + (Driver_ID => Default_Driver, + Format => My_Format, + Options => Libao.Empty_Options); + exception + when Libao.Open_Device_Error | Libao.General_Failure => + TIO.Put_Line ("Error opening device."); + ACom.Set_Exit_Status (ACom.Failure); + return; + end; + + + -- Play some stuff + + -- This sine wave generation was directly translated from the C example, + -- but it ends up being a little messy playing fast and loose like this. + + declare + Buffer : Libao.Data_Buffer (1 .. 16 / 8 * 2 * 44100); + + type Wraparound is mod 65536; + Sample : Wraparound; + begin + for I in Integer range 0 .. 44100 - 1 loop + Sample := Wraparound (Integer (0.75 * 32768.0 * + Math.Sin (2.0 * Ada.Numerics.Pi * 440.0 * Float (I) / 44100.0)) mod 65536); + + -- Put the same stuff in left and right channel + Buffer (4 * I + 1) := Character'Val (Sample and 16#FF#); + Buffer (4 * I + 2) := Character'Val ((Sample / 256) and 16#FF#); + Buffer (4 * I + 3) := Character'Val (Sample and 16#FF#); + Buffer (4 * I + 4) := Character'Val ((Sample / 256) and 16#FF#); + end loop; + + Libao.Play (My_Device, Buffer); + end; + + + -- Close and shutdown + + -- Technically the binding will take care of closing open devices at shutdown, + -- but it is always good practice to close them anyway. + + Libao.Close (My_Device); + + Libao.Shutdown; + +end AAO_Example; + + diff --git a/example/ao_example.c b/example/ao_example.c new file mode 100644 index 0000000..a5642a0 --- /dev/null +++ b/example/ao_example.c @@ -0,0 +1,87 @@ +/* + * + * ao_example.c + * + * Written by Stan Seibert - July 2001 + * + * Legal Terms: + * + * This source file is released into the public domain. It is + * distributed without any warranty; without even the implied + * warranty * of merchantability or fitness for a particular + * purpose. + * + * Function: + * + * This program opens the default driver and plays a 440 Hz tone for + * one second. + * + * Compilation command line (for Linux systems): + * + * gcc -o ao_example ao_example.c -lao -ldl -lm + * + */ + +#include +#include +#include +#include + +#define BUF_SIZE 4096 + +int main() +{ + ao_device *device; + ao_sample_format format; + int default_driver; + char *buffer; + int buf_size; + int sample; + float freq = 440.0; + int i; + + /* -- Initialize -- */ + + fprintf(stderr, "libao example program\n"); + + ao_initialize(); + + /* -- Setup for default driver -- */ + + default_driver = ao_default_driver_id(); + + memset(&format, 0, sizeof(format)); + format.bits = 16; + format.channels = 2; + format.rate = 44100; + format.byte_format = AO_FMT_LITTLE; + + /* -- Open driver -- */ + device = ao_open_live(default_driver, &format, NULL /* no options */); + if (device == NULL) { + fprintf(stderr, "Error opening device.\n"); + return 1; + } + + /* -- Play some stuff -- */ + buf_size = format.bits/8 * format.channels * format.rate; + buffer = calloc(buf_size, + sizeof(char)); + + for (i = 0; i < format.rate; i++) { + sample = (int)(0.75 * 32768.0 * + sin(2 * M_PI * freq * ((float) i/format.rate))); + + /* Put the same stuff in left and right channel */ + buffer[4*i] = buffer[4*i+2] = sample & 0xff; + buffer[4*i+1] = buffer[4*i+3] = (sample >> 8) & 0xff; + } + ao_play(device, buffer, buf_size); + + /* -- Close and shutdown -- */ + ao_close(device); + + ao_shutdown(); + + return (0); +} diff --git a/lib/.gitignore b/lib/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/lib/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/obj/.gitignore b/obj/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/obj/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/readme.txt b/readme.txt new file mode 100644 index 0000000..a0a3233 --- /dev/null +++ b/readme.txt @@ -0,0 +1,54 @@ + + +libao Binding for the Ada Programming Language +============================================== + + +Overview +-------- + +This a thick binding, so the rough edges of C have all been filed off. In +particular ao_option/Option_List objects are automatically deallocated when +they go out of scope, and any remaining open ao_device/Device objects are +automatically closed when libao is shut down. + + +Dependencies +------------ + +GNAT (build) +gprbuild (build) +libao (run) + + +Build Instructions +------------------ + +Ensure that all dependencies are installed, including any developer or header +packages for libao. Then the following commands will build and install the +binding: + + gprbuild aao.gpr + gprinstall -p -m aao.gpr + +The other gpr file, example.gpr, can be used to build the short example +programs provided. + + +Further Information +------------------- + +API of libao: +https://xiph.org/ao/doc/libao-api.html + + +Credits and Legal +----------------- + +This binding and the short Ada example were written by Jedidiah Barber. + +The short C example program was written by Stan Seibert. + +All code is released into the public domain. + + diff --git a/src/c_aao.c b/src/c_aao.c new file mode 100644 index 0000000..731792d --- /dev/null +++ b/src/c_aao.c @@ -0,0 +1,136 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include "c_aao.h" + + + +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; +} + + + +ao_info * info_item_get(ao_info ** items, int n) { + return items[n]; +} + + + +int info_kind_get(ao_info * item) { + return item->type; +} + +char * info_name_get(ao_info * item) { + return item->name; +} + +char * info_short_name_get(ao_info * item) { + return item->short_name; +} + +int info_preferred_byte_format_get(ao_info * item) { + return item->preferred_byte_format; +} + +int info_priority_get(ao_info * item) { + return item->priority; +} + +char * info_comment_get(ao_info * item) { + return item->comment; +} + +int info_option_count_get(ao_info * item) { + return item->option_count; +} + +char * info_option_key_get(ao_info * item, int n) { + return item->options[n]; +} + + + +int get_errno() { + return errno; +} + + + +char * option_key(ao_option * item) { + return item->key; +} + +char * option_value(ao_option * item) { + return item->value; +} + +ao_option * option_next(ao_option * item) { + if (item == NULL) { + return NULL; + } else { + return item->next; + } +} + + diff --git a/src/c_aao.h b/src/c_aao.h new file mode 100644 index 0000000..d0a23a4 --- /dev/null +++ b/src/c_aao.h @@ -0,0 +1,50 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef AAO_GUARD +#define AAO_GUARD + +#include + + +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(); + +ao_info * info_item_get(ao_info ** items, int n); + +int info_kind_get(ao_info * item); +char * info_name_get(ao_info * item); +char * info_short_name_get(ao_info * item); +int info_preferred_byte_format_get(ao_info * item); +int info_priority_get(ao_info * item); +char * info_comment_get(ao_info * item); +int info_option_count_get(ao_info * item); +char * info_option_key_get(ao_info * item, int n); + +int get_errno(); + +char * option_key(ao_option * item); +char * option_value(ao_option * item); +ao_option * option_next(ao_option * item); + + +#endif + + diff --git a/src/libao.adb b/src/libao.adb new file mode 100644 index 0000000..c1491c2 --- /dev/null +++ b/src/libao.adb @@ -0,0 +1,746 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings, + System; + +use type + + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, + System.Address; + + +package body Libao is + + + 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 + (Options : in out System.Address; + Key : in Interfaces.C.char_array; + 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; + Format : in System.Address; + 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; + Filename : in Interfaces.C.char_array; + Overwrite : in Interfaces.C.int; + Format : in System.Address; + 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; + Samples : in Interfaces.C.char_array; + 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 + (Infos : in System.Address; + Index : in Interfaces.C.int) + return System.Address; + pragma Import (C, info_item_get, "info_item_get"); + pragma Inline (info_item_get); + + + + + function info_kind_get + (Item : in System.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) + 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) + 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) + 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) + 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) + 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) + 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; + Index : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, info_option_key_get, "info_option_key_get"); + 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; + pragma Import (C, option_key, "option_key"); + pragma Inline (option_key); + + function option_value + (Item : in System.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; + pragma Import (C, option_next, "option_next"); + pragma Inline (option_next); + + + + + procedure Adjust + (This : in out Option_List) + is + Old : System.Address := This.Ptr; + begin + This.Ptr := System.Null_Address; + while Old /= System.Null_Address loop + Do_Append + (This.Ptr, + Interfaces.C.Strings.Value (option_key (This.Ptr)), + Interfaces.C.Strings.Value (option_value (This.Ptr))); + Old := option_next (Old); + end loop; + end Adjust; + + procedure Finalize + (This : in out Option_List) is + begin + ao_free_options (This.Ptr); + end Finalize; + + procedure Adjust + (This : in out Sample_Format) is + begin + This.C_Struct.Matrix := Interfaces.C.Strings.New_String + (Interfaces.C.Strings.Value (This.C_Struct.Matrix)); + end Adjust; + + procedure Finalize + (This : in out Sample_Format) is + begin + Interfaces.C.Strings.Free (This.C_Struct.Matrix); + end Finalize; + + + + + function Kind + (Attributes : in Info) + return Output_Kind + is + Value : Interfaces.C.int := info_kind_get (Attributes.Ptr); + begin + if Value = type_live then + return Live_Output; + elsif Value = type_file then + return File_Output; + else + raise Program_Error; + end if; + end Kind; + + function Name + (Attributes : in Info) + return String is + begin + return Interfaces.C.Strings.Value (info_name_get (Attributes.Ptr)); + end Name; + + function Short_Name + (Attributes : in Info) + return String is + begin + return Interfaces.C.Strings.Value (info_short_name_get (Attributes.Ptr)); + end Short_Name; + + function Preferred_Byte_Format + (Attributes : in Info) + return Endianness + is + Value : Interfaces.C.int := info_preferred_byte_format_get (Attributes.Ptr); + begin + if Value = sample_little_endian then + return Little_Endian; + elsif Value = sample_big_endian then + return Big_Endian; + elsif Value = sample_native_endian then + return Machine_Native; + else + raise Program_Error; -- libao would be doing weird shit to get here + end if; + end Preferred_Byte_Format; + + function Priority_Level + (Attributes : in Info) + return Positive is + begin + return Positive (info_priority_get (Attributes.Ptr)); + end Priority_Level; + + function Comment + (Attributes : in Info) + return String is + begin + return Interfaces.C.Strings.Value (info_comment_get (Attributes.Ptr)); + end Comment; + + function Option_Count + (Attributes : in Info) + return Natural is + begin + return Natural (info_option_count_get (Attributes.Ptr)); + end Option_Count; + + function Option_Key + (Attributes : in Info; + Index : in Positive) + return String is + begin + return Interfaces.C.Strings.Value + (info_option_key_get (Attributes.Ptr, Interfaces.C.int (Index))); + end Option_Key; + + + + + function Image_Length + (Channel : in Channel_Mnemonic) + return Positive is + begin + case Channel is + when L | R | C | M | X => + return 1; + when CL | CR | BL | BR | BC | SL | SR | A1 | A2 | A3 | A4 => + return 2; + when LFE => + return 3; + end case; + end Image_Length; + + function Image_Length + (Channel_Matrix : in Mnemonic_Array) + return Natural + is + Result : Integer := Channel_Matrix'Length - 1; + begin + if Channel_Matrix'Length = 0 then + return 0; + end if; + for Channel of Channel_Matrix loop + Result := Result + Image_Length (Channel); + end loop; + return Result; + end Image_Length; + + function Image + (Channel_Matrix : in Mnemonic_Array) + return String + is + Result : String (1 .. Image_Length (Channel_Matrix)); + Position : Integer := 1; + 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; + end loop; + Result (Position .. Result'Last) := Channel_Matrix (Channel_Matrix'Last)'Image; + return Result; + end Image; + + function Create + (Bits, Rate, Channels : in Positive; + Byte_Format : in Endianness; + Channel_Matrix : in Mnemonic_Array) + return Sample_Format is + begin + return This : Sample_Format := (Ada.Finalization.Controlled with + C_Struct => + (Bits => Interfaces.C.int (Bits), + Rate => Interfaces.C.int (Rate), + Channels => Interfaces.C.int (Channels), + Byte_Format => (case Byte_Format is + when Little_Endian => sample_little_endian, + when Big_Endian => sample_big_endian, + when Machine_Native => sample_native_endian), + Matrix => Interfaces.C.Strings.New_String (Image (Channel_Matrix)))); + end Create; + + + + + function Is_Alive + return Boolean is + begin + return Alive_Status; + end Is_Alive; + + procedure Startup is + begin + ao_initialize; + Device_List.Clear; + Alive_Status := True; + end Startup; + + procedure Shutdown is + begin + for Addy of Device_List loop + Do_Close (Addy); + end loop; + ao_shutdown; + Alive_Status := False; + end Shutdown; + + + + + 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; + Value : in String) is + begin + Do_Append (This.Ptr, Interfaces.C.To_C (Key), Interfaces.C.To_C (Value)); + end Append; + + procedure Append_Global_Option + (Key : in String; + Value : in String) + is + Result : Interfaces.C.int; + begin + Result := ao_append_global_option + (Interfaces.C.To_C (Key), + Interfaces.C.To_C (Value)); + if Result = 0 then + raise Storage_Error; + elsif Result /= 1 then + raise Program_Error; + 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 + is + Result : System.Address := ao_open_live + (Driver_ID => Interfaces.C.int (Driver_ID), + Format => Format.C_Struct'Address, + Options => Options.Ptr); + My_Errno : Interfaces.C.int; + begin + if Result = System.Null_Address then + My_Errno := get_errno; + if My_Errno = error_no_driver then + raise No_Driver_Error; + elsif My_Errno = error_not_live then + raise Not_Live_Error; + elsif My_Errno = error_bad_option then + raise Bad_Option_Error; + elsif My_Errno = error_open_device then + raise Open_Device_Error; + elsif My_Errno = error_bad_format then + raise Bad_Format_Error; + elsif My_Errno = error_fail then + raise General_Failure; + else + raise Program_Error; + end if; + else + Device_List.Append (Result); + return (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 + is + Result : System.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); + My_Errno : Interfaces.C.int; + begin + if Result = System.Null_Address then + My_Errno := get_errno; + if My_Errno = error_no_driver then + raise No_Driver_Error; + elsif My_Errno = error_not_file then + raise Not_File_Error; + elsif My_Errno = error_bad_option then + raise Bad_Option_Error; + elsif My_Errno = error_open_file then + raise Open_File_Error; + elsif My_Errno = error_file_exists then + raise File_Exists_Error; + elsif My_Errno = error_bad_format then + raise Bad_Format_Error; + elsif My_Errno = error_fail then + raise General_Failure; + else + raise Program_Error; + end if; + else + Device_List.Append (Result); + return (Ptr => Result); + end if; + end Open_File; + + procedure Play + (Output_Device : in Device; + Samples : in Data_Buffer) + is + Result : Interfaces.C.int := ao_play + (Output_Device => Output_Device.Ptr, + Samples => Interfaces.C.To_C (Item => String (Samples), Append_Nul => False), + Num_Bytes => Interfaces.Unsigned_32 (Samples'Length)); + begin + if Result = 0 then + raise General_Failure; + 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 + 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 + Device_List.Delete (Index); + end if; + end loop; + Do_Close (Output_Device.Ptr); + end Close; + + + + + function Driver_ID + (Short_Name : in String) + return Driver_ID_Number + is + Result : Interfaces.C.int; + begin + Result := ao_driver_id (Interfaces.C.To_C (Short_Name)); + if Result = -1 then + raise No_Driver_Error; + elsif Result < 0 then + raise Program_Error; + end if; + return Driver_ID_Number (Result); + end Driver_ID; + + function Default_Driver_ID + return Driver_ID_Number + is + Result : Interfaces.C.int; + begin + Result := ao_default_driver_id; + if Result = -1 then + raise No_Device_Error; + elsif Result < 0 then + raise Program_Error; + end if; + return Driver_ID_Number (Result); + end Default_Driver_ID; + + function Driver_Info + (Ident : in Driver_ID_Number) + return Info + is + Result : System.Address; + begin + Result := ao_driver_info (Interfaces.C.int (Ident)); + if Result = System.Null_Address then + raise No_Driver_Error; + else + return (Ptr => Result); + end if; + end Driver_Info; + + function Driver_Info_List + return Info_Array + is + Count : Interfaces.C.int; + Carr : System.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))); + end loop; + end return; + end Driver_Info_List; + + function File_Extension + (Ident : in Driver_ID_Number) + return String + is + Result : Interfaces.C.Strings.chars_ptr := ao_file_extension (Interfaces.C.int (Ident)); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end File_Extension; + + + + + function Is_Big_Endian + return Boolean is + begin + case ao_is_big_endian is + when 1 => return True; + when 0 => return False; + when others => raise Program_Error; + end case; + end Is_Big_Endian; + + +end Libao; + + diff --git a/src/libao.ads b/src/libao.ads new file mode 100644 index 0000000..1bdb142 --- /dev/null +++ b/src/libao.ads @@ -0,0 +1,319 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +private with + + Ada.Finalization, + Ada.Containers.Vectors, + Interfaces.C.Strings, + System; + + +package Libao is + + + ----------------------- + -- Data Structures -- + ----------------------- + + type Driver_ID_Number is new Natural; + + + type Data_Buffer is new String; + + + type Device is private; + + + type Info is tagged private; + type Info_Array is array (Positive range <>) of Info; + type Output_Kind is (Live_Output, File_Output); + type Endianness is (Little_Endian, Big_Endian, Machine_Native); + + function Kind + (Attributes : in Info) + return Output_Kind + with Pre => Is_Alive; + + function Name + (Attributes : in Info) + return String + with Pre => Is_Alive; + + function Short_Name + (Attributes : in Info) + return String + with Pre => Is_Alive; + + function Preferred_Byte_Format + (Attributes : in Info) + return Endianness + with Pre => Is_Alive; + + function Priority_Level + (Attributes : in Info) + return Positive + with Pre => Is_Alive; + + function Comment + (Attributes : in Info) + return String + with Pre => Is_Alive; + + function Option_Count + (Attributes : in Info) + return Natural + with Pre => Is_Alive; + + function Option_Key + (Attributes : in Info; + Index : in Positive) + return String + with Pre => Is_Alive; + + + type Option_List is tagged private; + + Empty_Options : constant Option_List; + + + type Sample_Format is 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; + + function Create + (Bits, Rate, Channels : in Positive; + Byte_Format : in Endianness; + Channel_Matrix : in Mnemonic_Array) + return Sample_Format; + + Stereo : constant Mnemonic_Array := (L, R); + Quadraphonic : constant Mnemonic_Array := (L, R, BL, BR); + + + + + ------------------ + -- Exceptions -- + ------------------ + + -- May be raised by Open_Live, Open_File, Driver_ID, Driver_Info + No_Driver_Error : exception; + + -- May be raised by Open_File + Not_File_Error : exception; + + -- May be raised by Open_Live + Not_Live_Error : exception; + + -- May be raised by Open_Live, Open_File + Bad_Option_Error : exception; + + -- May be raised by Open_Live + Open_Device_Error : exception; + + -- May be raised by Shutdown, Close + Close_Device_Error : exception; + + -- May be raised by Default_Driver_ID + No_Device_Error : exception; + + -- May be raised by Open_File + Open_File_Error : exception; + + -- May be raised by Open_File + File_Exists_Error : exception; + + -- Documentation lacking, but presumably may be raised by Open_Live, Open_File + Bad_Format_Error : exception; + + -- May be raised by Open_Live, Open_File, Play + General_Failure : exception; + + -- Storage_Error may be raised by Append, Append_Global_Option + -- Program_Error may be raised if libao in general does something out of spec + + + + + ------------------------------ + -- Library Setup/Teardown -- + ------------------------------ + + function Is_Alive + return Boolean; + + procedure Startup + with Pre => not Is_Alive, + Post => Is_Alive; + + procedure Shutdown + with Pre => Is_Alive, + Post => not Is_Alive; + + + + + -------------------------------------- + -- Device Setup/Playback/Teardown -- + -------------------------------------- + + procedure Append + (This : in out Option_List; + Key : in String; + Value : in String) + with Pre => Is_Alive; + + procedure Append_Global_Option + (Key : in String; + Value : in String) + with Pre => Is_Alive; + + function Open_Live + (Driver_ID : in Driver_ID_Number; + Format : in Sample_Format; + Options : in Option_List'Class) + return Device + with Pre => Is_Alive; + + 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 + with Pre => Is_Alive; + + procedure Play + (Output_Device : in Device; + Samples : in Data_Buffer) + with Pre => Is_Alive; + + procedure Close + (Output_Device : in out Device) + with Pre => Is_Alive; + + + + + -------------------------- + -- Driver Information -- + -------------------------- + + function Driver_ID + (Short_Name : in String) + return Driver_ID_Number + with Pre => Is_Alive; + + function Default_Driver_ID + return Driver_ID_Number + with Pre => Is_Alive; + + function Driver_Info + (Ident : in Driver_ID_Number) + return Info + with Pre => Is_Alive; + + function Driver_Info_List + return Info_Array + with Pre => Is_Alive; + + function File_Extension + (Ident : in Driver_ID_Number) + return String + with Pre => Is_Alive; + + + + + --------------------- + -- Miscellaneous -- + --------------------- + + function Is_Big_Endian + return Boolean + with Pre => Is_Alive; + + +private + + + pragma Linker_Options ("-lao"); + pragma Inline (Is_Alive); + + + + + procedure Do_Append + (Ptr : in out System.Address; + Key : in Interfaces.C.char_array; + Value : in Interfaces.C.char_array); + + procedure Do_Close + (Ptr : in System.Address); + + + + + type Device is record + Ptr : System.Address; + end record; + + + type Info is tagged record + Ptr : System.Address; + end record; + + + type Option_List is new Ada.Finalization.Controlled with record + Ptr : System.Address := System.Null_Address; + end record; + + overriding procedure Adjust + (This : in out Option_List); + + overriding procedure Finalize + (This : in out Option_List); + + Empty_Options : constant Option_List := + (Ada.Finalization.Controlled with Ptr => System.Null_Address); + + + type C_Sample_Format is record + Bits : Interfaces.C.int; + Rate : Interfaces.C.int; + Channels : Interfaces.C.int; + Byte_Format : Interfaces.C.int; + Matrix : Interfaces.C.Strings.chars_ptr; + end record with Convention => C; + + type Sample_Format is new Ada.Finalization.Controlled with record + C_Struct : C_Sample_Format; + end record; + + overriding procedure Adjust + (This : in out Sample_Format); + + overriding procedure Finalize + (This : in out Sample_Format); + + + + + Alive_Status : Boolean := False; + + 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; + + +end Libao; + + diff --git a/unlicense.txt b/unlicense.txt new file mode 100644 index 0000000..68a49da --- /dev/null +++ b/unlicense.txt @@ -0,0 +1,24 @@ +This is free and unencumbered software released into the public domain. + +Anyone is free to copy, modify, publish, use, compile, sell, or +distribute this software, either in source code form or as a compiled +binary, for any purpose, commercial or non-commercial, and by any +means. + +In jurisdictions that recognize copyright laws, the author or authors +of this software dedicate any and all copyright interest in the +software to the public domain. We make this dedication for the benefit +of the public at large and to the detriment of our heirs and +successors. We intend this dedication to be an overt act of +relinquishment in perpetuity of all present and future rights to this +software under copyright law. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. + +For more information, please refer to -- cgit