diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_portadao.c | 125 | ||||
| -rw-r--r-- | src/c_portadao.h | 94 | ||||
| -rw-r--r-- | src/portaudio.adb | 2038 | ||||
| -rw-r--r-- | src/portaudio.ads | 933 |
4 files changed, 3190 insertions, 0 deletions
diff --git a/src/c_portadao.c b/src/c_portadao.c new file mode 100644 index 0000000..fc2e3b0 --- /dev/null +++ b/src/c_portadao.c @@ -0,0 +1,125 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <stdio.h> +#include <unistd.h> +#include <portaudio.h> +#include "c_portadao.h" + + + +const int pa_no_error = paNoError; +const int pa_not_initialized = paNotInitialized; +const int pa_unanticipated_host_error = paUnanticipatedHostError; +const int pa_invalid_channel_count = paInvalidChannelCount; +const int pa_invalid_sample_rate = paInvalidSampleRate; +const int pa_invalid_device = paInvalidDevice; +const int pa_invalid_flag = paInvalidFlag; +const int pa_sample_format_not_supported = paSampleFormatNotSupported; +const int pa_bad_io_device_combination = paBadIODeviceCombination; +const int pa_insufficient_memory = paInsufficientMemory; +const int pa_buffer_too_big = paBufferTooBig; +const int pa_buffer_too_small = paBufferTooSmall; +const int pa_null_callback = paNullCallback; +const int pa_bad_stream_ptr = paBadStreamPtr; +const int pa_timed_out = paTimedOut; +const int pa_internal_error = paInternalError; +const int pa_device_unavailable = paDeviceUnavailable; +const int pa_incompatible_host_api_specific_stream_info = paIncompatibleHostApiSpecificStreamInfo; +const int pa_stream_is_stopped = paStreamIsStopped; +const int pa_stream_is_not_stopped = paStreamIsNotStopped; +const int pa_input_overflowed = paInputOverflowed; +const int pa_output_underflowed = paOutputUnderflowed; +const int pa_host_api_not_found = paHostApiNotFound; +const int pa_invalid_host_api = paInvalidHostApi; +const int pa_cannot_read_from_a_callback_stream = paCanNotReadFromACallbackStream; +const int pa_cannot_write_to_a_callback_stream = paCanNotWriteToACallbackStream; +const int pa_cannot_read_from_an_output_only_stream = paCanNotReadFromAnOutputOnlyStream; +const int pa_cannot_write_to_an_input_only_stream = paCanNotWriteToAnInputOnlyStream; +const int pa_incompatible_stream_host_api = paIncompatibleStreamHostApi; +const int pa_bad_buffer_ptr = paBadBufferPtr; + +const int pa_in_development = paInDevelopment; +const int pa_direct_sound = paDirectSound; +const int pa_mme = paMME; +const int pa_asio = paASIO; +const int pa_sound_manager = paSoundManager; +const int pa_core_audio = paCoreAudio; +const int pa_oss = paOSS; +const int pa_alsa = paALSA; +const int pa_al = paAL; +const int pa_beos = paBeOS; +const int pa_wdmks = paWDMKS; +const int pa_jack = paJACK; +const int pa_wasapi = paWASAPI; +const int pa_audio_science_hpi = paAudioScienceHPI; +const int pa_sndio = paSndio; + +const int pa_no_device = paNoDevice; + +const unsigned long pa_float_32 = paFloat32; +const unsigned long pa_int_32 = paInt32; +const unsigned long pa_int_24 = paInt24; +const unsigned long pa_int_16 = paInt16; +const unsigned long pa_int_8 = paInt8; +const unsigned long pa_uint_8 = paUInt8; + +const int pa_format_is_supported = paFormatIsSupported; + +const unsigned long pa_no_flag = paNoFlag; +const unsigned long pa_clip_off = paClipOff; +const unsigned long pa_dither_off = paDitherOff; +const unsigned long pa_never_drop_input = paNeverDropInput; +const unsigned long pa_prime_output_buffers_using_stream_callback = + paPrimeOutputBuffersUsingStreamCallback; + +const int pa_continue = paContinue; +const int pa_complete = paComplete; +const int pa_abort = paAbort; + +const unsigned long pa_input_underflow = paInputUnderflow; +const unsigned long pa_input_overflow = paInputOverflow; +const unsigned long pa_output_underflow = paOutputUnderflow; +const unsigned long pa_output_overflow = paOutputOverflow; +const unsigned long pa_priming_output = paPrimingOutput; + + + +int fd_backup; +int suppressed = 0; + +void suppress_stderr() { + fflush(stderr); + fd_backup = dup(STDERR_FILENO); + //if (freopen("/dev/null", "w", stderr) == NULL) { + // freopen("nul", "w", stderr); + //} + close(STDERR_FILENO); + suppressed = 1; +} + +void restore_stderr() { + fflush(stderr); + dup2(fd_backup, fileno(stderr)); + close(fd_backup); + suppressed = 0; +} + +int apa_init(int stop_msg) { + if (stop_msg) { + suppress_stderr(); + } + return Pa_Initialize(); +} + +int apa_term() { + if (suppressed) { + restore_stderr(); + } + return Pa_Terminate(); +} + + diff --git a/src/c_portadao.h b/src/c_portadao.h new file mode 100644 index 0000000..9bcd3be --- /dev/null +++ b/src/c_portadao.h @@ -0,0 +1,94 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef PORTADAO_GUARD +#define PORTADAO_GUARD + +#include <portaudio.h> + + +extern const int pa_no_error; +extern const int pa_not_initialized; +extern const int pa_unanticipated_host_error; +extern const int pa_invalid_channel_count; +extern const int pa_invalid_sample_rate; +extern const int pa_invalid_device; +extern const int pa_invalid_flag; +extern const int pa_sample_format_not_supported; +extern const int pa_bad_io_device_combination; +extern const int pa_insufficient_memory; +extern const int pa_buffer_too_big; +extern const int pa_buffer_too_small; +extern const int pa_null_callback; +extern const int pa_bad_stream_ptr; +extern const int pa_timed_out; +extern const int pa_internal_error; +extern const int pa_device_unavailable; +extern const int pa_incompatible_host_api_specific_stream_info; +extern const int pa_stream_is_stopped; +extern const int pa_stream_is_not_stopped; +extern const int pa_input_overflowed; +extern const int pa_output_underflowed; +extern const int pa_host_api_not_found; +extern const int pa_invalid_host_api; +extern const int pa_cannot_read_from_a_callback_stream; +extern const int pa_cannot_write_to_a_callback_stream; +extern const int pa_cannot_read_from_an_output_only_stream; +extern const int pa_cannot_write_to_an_input_only_stream; +extern const int pa_incompatible_stream_host_api; +extern const int pa_bad_buffer_ptr; + +extern const int pa_in_development; +extern const int pa_direct_sound; +extern const int pa_mme; +extern const int pa_asio; +extern const int pa_sound_manager; +extern const int pa_core_audio; +extern const int pa_oss; +extern const int pa_alsa; +extern const int pa_al; +extern const int pa_beos; +extern const int pa_wdmks; +extern const int pa_jack; +extern const int pa_wasapi; +extern const int pa_audio_science_hpi; +extern const int pa_sndio; + +extern const int pa_no_device; + +extern const unsigned long pa_float_32; +extern const unsigned long pa_int_32; +extern const unsigned long pa_int_24; +extern const unsigned long pa_int_16; +extern const unsigned long pa_int_8; +extern const unsigned long pa_uint_8; + +extern const int pa_format_is_supported; + +extern const unsigned long pa_no_flag; +extern const unsigned long pa_clip_off; +extern const unsigned long pa_dither_off; +extern const unsigned long pa_never_drop_input; +extern const unsigned long pa_prime_output_buffers_using_stream_callback; + +extern const int pa_continue; +extern const int pa_complete; +extern const int pa_abort; + +extern const unsigned long pa_input_underflow; +extern const unsigned long pa_input_overflow; +extern const unsigned long pa_output_underflow; +extern const unsigned long pa_output_overflow; +extern const unsigned long pa_priming_output; + + +int apa_init(int msg); +int apa_term(); + + +#endif + + diff --git a/src/portaudio.adb b/src/portaudio.adb new file mode 100644 index 0000000..5b75a97 --- /dev/null +++ b/src/portaudio.adb @@ -0,0 +1,2038 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Strings.Fixed, + Interfaces.C.Strings, + System.Address_To_Access_Conversions; + +use type + + Interfaces.C.double, + Interfaces.C.int, + Interfaces.C.long, + Interfaces.C.unsigned_long, + Interfaces.Unsigned_32, + System.Address; + + +package body Portaudio is + + + ------------------------ + -- Constants From C -- + ------------------------ + + pa_no_error : constant Interfaces.C.int; + pragma Import (C, pa_no_error, "pa_no_error"); + + pa_not_initialized : constant Interfaces.C.int; + pragma Import (C, pa_not_initialized, "pa_not_initialized"); + + pa_unanticipated_host_error : constant Interfaces.C.int; + pragma Import (C, pa_unanticipated_host_error, "pa_unanticipated_host_error"); + + pa_invalid_channel_count : constant Interfaces.C.int; + pragma Import (C, pa_invalid_channel_count, "pa_invalid_channel_count"); + + pa_invalid_sample_rate : constant Interfaces.C.int; + pragma Import (C, pa_invalid_sample_rate, "pa_invalid_sample_rate"); + + pa_invalid_device : constant Interfaces.C.int; + pragma Import (C, pa_invalid_device, "pa_invalid_device"); + + pa_invalid_flag : constant Interfaces.C.int; + pragma Import (C, pa_invalid_flag, "pa_invalid_flag"); + + pa_sample_format_not_supported : constant Interfaces.C.int; + pragma Import (C, pa_sample_format_not_supported, "pa_sample_format_not_supported"); + + pa_bad_io_device_combination : constant Interfaces.C.int; + pragma Import (C, pa_bad_io_device_combination, "pa_bad_io_device_combination"); + + pa_insufficient_memory : constant Interfaces.C.int; + pragma Import (C, pa_insufficient_memory, "pa_insufficient_memory"); + + pa_buffer_too_big : constant Interfaces.C.int; + pragma Import (C, pa_buffer_too_big, "pa_buffer_too_big"); + + pa_buffer_too_small : constant Interfaces.C.int; + pragma Import (C, pa_buffer_too_small, "pa_buffer_too_small"); + + pa_null_callback : constant Interfaces.C.int; + pragma Import (C, pa_null_callback, "pa_null_callback"); + + pa_bad_stream_ptr : constant Interfaces.C.int; + pragma Import (C, pa_bad_stream_ptr, "pa_bad_stream_ptr"); + + pa_timed_out : constant Interfaces.C.int; + pragma Import (C, pa_timed_out, "pa_timed_out"); + + pa_internal_error : constant Interfaces.C.int; + pragma Import (C, pa_internal_error, "pa_internal_error"); + + pa_device_unavailable : constant Interfaces.C.int; + pragma Import (C, pa_device_unavailable, "pa_device_unavailable"); + + pa_incompatible_host_api_specific_stream_info : constant Interfaces.C.int; + pragma Import (C, pa_incompatible_host_api_specific_stream_info, + "pa_incompatible_host_api_specific_stream_info"); + + pa_stream_is_stopped : constant Interfaces.C.int; + pragma Import (C, pa_stream_is_stopped, "pa_stream_is_stopped"); + + pa_stream_is_not_stopped : constant Interfaces.C.int; + pragma Import (C, pa_stream_is_not_stopped, "pa_stream_is_not_stopped"); + + pa_input_overflowed : constant Interfaces.C.int; + pragma Import (C, pa_input_overflowed, "pa_input_overflowed"); + + pa_output_underflowed : constant Interfaces.C.int; + pragma Import (C, pa_output_underflowed, "pa_output_underflowed"); + + pa_host_api_not_found : constant Interfaces.C.int; + pragma Import (C, pa_host_api_not_found, "pa_host_api_not_found"); + + pa_invalid_host_api : constant Interfaces.C.int; + pragma Import (C, pa_invalid_host_api, "pa_invalid_host_api"); + + pa_cannot_read_from_a_callback_stream : constant Interfaces.C.int; + pragma Import (C, pa_cannot_read_from_a_callback_stream, + "pa_cannot_read_from_a_callback_stream"); + + pa_cannot_write_to_a_callback_stream : constant Interfaces.C.int; + pragma Import (C, pa_cannot_write_to_a_callback_stream, + "pa_cannot_write_to_a_callback_stream"); + + pa_cannot_read_from_an_output_only_stream : constant Interfaces.C.int; + pragma Import (C, pa_cannot_read_from_an_output_only_stream, + "pa_cannot_read_from_an_output_only_stream"); + + pa_cannot_write_to_an_input_only_stream : constant Interfaces.C.int; + pragma Import (C, pa_cannot_write_to_an_input_only_stream, + "pa_cannot_write_to_an_input_only_stream"); + + pa_incompatible_stream_host_api : constant Interfaces.C.int; + pragma Import (C, pa_incompatible_stream_host_api, "pa_incompatible_stream_host_api"); + + pa_bad_buffer_ptr : constant Interfaces.C.int; + pragma Import (C, pa_bad_buffer_ptr, "pa_bad_buffer_ptr"); + + + pa_in_development : constant Interfaces.C.int; + pragma Import (C, pa_in_development, "pa_in_development"); + + pa_direct_sound : constant Interfaces.C.int; + pragma Import (C, pa_direct_sound, "pa_direct_sound"); + + pa_mme : constant Interfaces.C.int; + pragma Import (C, pa_mme, "pa_mme"); + + pa_asio : constant Interfaces.C.int; + pragma Import (C, pa_asio, "pa_asio"); + + pa_sound_manager : constant Interfaces.C.int; + pragma Import (C, pa_sound_manager, "pa_sound_manager"); + + pa_core_audio : constant Interfaces.C.int; + pragma Import (C, pa_core_audio, "pa_core_audio"); + + pa_oss : constant Interfaces.C.int; + pragma Import (C, pa_oss, "pa_oss"); + + pa_alsa : constant Interfaces.C.int; + pragma Import (C, pa_alsa, "pa_alsa"); + + pa_al : constant Interfaces.C.int; + pragma Import (C, pa_al, "pa_al"); + + pa_beos : constant Interfaces.C.int; + pragma Import (C, pa_beos, "pa_beos"); + + pa_wdmks : constant Interfaces.C.int; + pragma Import (C, pa_wdmks, "pa_wdmks"); + + pa_jack : constant Interfaces.C.int; + pragma Import (C, pa_jack, "pa_jack"); + + pa_wasapi : constant Interfaces.C.int; + pragma Import (C, pa_wasapi, "pa_wasapi"); + + pa_audio_science_hpi : constant Interfaces.C.int; + pragma Import (C, pa_audio_science_hpi, "pa_audio_science_hpi"); + + pa_sndio : constant Interfaces.C.int; + pragma Import (C, pa_sndio, "pa_sndio"); + + + pa_no_device : constant Interfaces.C.int; + pragma Import (C, pa_no_device, "pa_no_device"); + + + pa_float_32 : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_float_32, "pa_float_32"); + + pa_int_32 : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_int_32, "pa_int_32"); + + pa_int_24 : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_int_24, "pa_int_24"); + + pa_int_16 : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_int_16, "pa_int_16"); + + pa_int_8 : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_int_8, "pa_int_8"); + + pa_uint_8 : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_uint_8, "pa_uint_8"); + + + pa_format_is_supported : constant Interfaces.C.int; + pragma Import (C, pa_format_is_supported, "pa_format_is_supported"); + + + pa_continue : constant Interfaces.C.int; + pragma Import (C, pa_continue, "pa_continue"); + + pa_complete : constant Interfaces.C.int; + pragma Import (C, pa_complete, "pa_complete"); + + pa_abort : constant Interfaces.C.int; + pragma Import (C, pa_abort, "pa_abort"); + + + pa_input_underflow : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_input_underflow, "pa_input_underflow"); + + pa_input_overflow : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_input_overflow, "pa_input_overflow"); + + pa_output_underflow : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_output_underflow, "pa_output_underflow"); + + pa_output_overflow : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_output_overflow, "pa_output_overflow"); + + pa_priming_output : constant Interfaces.C.unsigned_long; + pragma Import (C, pa_priming_output, "pa_priming_output"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function pa_get_version + return Interfaces.C.int; + pragma Import (C, pa_get_version, "Pa_GetVersion"); + + function pa_get_version_info + return System.Address; + pragma Import (C, pa_get_version_info, "Pa_GetVersionInfo"); + + function pa_get_error_text + (Code : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, pa_get_error_text, "Pa_GetErrorText"); + + function pa_initialize + (Sup : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, pa_initialize, "apa_init"); + + function pa_terminate + return Interfaces.C.int; + pragma Import (C, pa_terminate, "apa_term"); + + function pa_get_host_api_count + return Interfaces.C.int; + pragma Import (C, pa_get_host_api_count, "Pa_GetHostApiCount"); + + function pa_get_default_host_api + return Interfaces.C.int; + pragma Import (C, pa_get_default_host_api, "Pa_GetDefaultHostApi"); + + function pa_get_host_api_info + (Index : in Interfaces.C.int) + return System.Address; + pragma Import (C, pa_get_host_api_info, "Pa_GetHostApiInfo"); + + function pa_host_api_type_id_to_host_api_index + (Kind : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, pa_host_api_type_id_to_host_api_index, "Pa_HostApiTypeIdToHostApiIndex"); + + function pa_host_api_device_index_to_device_index + (Host : in Interfaces.C.int; + Dev : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, pa_host_api_device_index_to_device_index, + "Pa_HostApiDeviceIndexToDeviceIndex"); + + function pa_get_last_host_error_info + return System.Address; + pragma Import (C, pa_get_last_host_error_info, "Pa_GetLastHostErrorInfo"); + + function pa_get_device_count + return Interfaces.C.int; + pragma Import (C, pa_get_device_count, "Pa_GetDeviceCount"); + + function pa_get_default_input_device + return Interfaces.C.int; + pragma Import (C, pa_get_default_input_device, "Pa_GetDefaultInputDevice"); + + function pa_get_default_output_device + return Interfaces.C.int; + pragma Import (C, pa_get_default_output_device, "Pa_GetDefaultOutputDevice"); + + function pa_get_device_info + (Index : in Interfaces.C.int) + return System.Address; + pragma Import (C, pa_get_device_info, "Pa_GetDeviceInfo"); + + function pa_is_format_supported + (Input : in System.Address; + Output : in System.Address; + Rate : in Interfaces.C.double) + return Interfaces.C.int; + pragma Import (C, pa_is_format_supported, "Pa_IsFormatSupported"); + + function pa_open_stream + (Stream : in out System.Address; + In_Params : in System.Address; + Out_Params : in System.Address; + Rate : in Interfaces.C.double; + Frames : in Interfaces.C.unsigned_long; + Flags : in Interfaces.C.unsigned_long; + Callback : in System.Address; + Userdata : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_open_stream, "Pa_OpenStream"); + + function pa_open_default_stream + (Stream : in out System.Address; + In_Chans : in Interfaces.C.int; + Out_Chans : in Interfaces.C.int; + Format : in Interfaces.C.unsigned_long; + Rate : in Interfaces.C.double; + Frames : in Interfaces.C.unsigned_long; + Callback : in System.Address; + Userdata : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_open_default_stream, "Pa_OpenDefaultStream"); + + function pa_close_stream + (Stream : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_close_stream, "Pa_CloseStream"); + + function pa_set_stream_finished_callback + (Stream : in System.Address; + Callback : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_set_stream_finished_callback, "Pa_SetStreamFinishedCallback"); + + function pa_start_stream + (Stream : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_start_stream, "Pa_StartStream"); + + function pa_stop_stream + (Stream : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_stop_stream, "Pa_StopStream"); + + function pa_abort_stream + (Stream : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_abort_stream, "Pa_AbortStream"); + + function pa_is_stream_stopped + (Stream : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_is_stream_stopped, "Pa_IsStreamStopped"); + + function pa_is_stream_active + (Stream : in System.Address) + return Interfaces.C.int; + pragma Import (C, pa_is_stream_active, "Pa_IsStreamActive"); + + function pa_get_stream_info + (Stream : in System.Address) + return System.Address; + pragma Import (C, pa_get_stream_info, "Pa_GetStreamInfo"); + + function pa_get_stream_time + (Stream : in System.Address) + return Interfaces.C.double; + pragma Import (C, pa_get_stream_time, "Pa_GetStreamTime"); + + function pa_get_stream_cpu_load + (Stream : in System.Address) + return Interfaces.C.double; + pragma Import (C, pa_get_stream_cpu_load, "Pa_GetStreamCpuLoad"); + + function pa_read_stream + (Stream : in System.Address; + Buffer : in System.Address; + Frames : in Interfaces.C.unsigned_long) + return Interfaces.C.int; + pragma Import (C, pa_read_stream, "Pa_ReadStream"); + + function pa_write_stream + (Stream : in System.Address; + Buffer : in System.Address; + Frames : in Interfaces.C.unsigned_long) + return Interfaces.C.int; + pragma Import (C, pa_write_stream, "Pa_WriteStream"); + + function pa_get_stream_read_available + (Stream : in System.Address) + return Interfaces.C.long; + pragma Import (C, pa_get_stream_read_available, "Pa_GetStreamReadAvailable"); + + function pa_get_stream_write_available + (Stream : in System.Address) + return Interfaces.C.long; + pragma Import (C, pa_get_stream_write_available, "Pa_GetStreamWriteAvailable"); + + function pa_get_sample_size + (Form : in Interfaces.C.unsigned_long) + return Interfaces.C.int; + pragma Import (C, pa_get_sample_size, "Pa_GetSampleSize"); + + + + + ------------------------ + -- Internal Utility -- + ------------------------ + + procedure Raise_Error + (Num : in Interfaces.C.int) is + begin + if Num = pa_not_initialized then + raise Not_Initialized_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_unanticipated_host_error then + declare + Info : C_Host_Error_Info; + for Info'Address use pa_get_last_host_error_info; + pragma Import (Ada, Info); + begin + raise Unanticipated_Host_Error with + Host_API_Kind'Image (To_Hat_Kind (Info.My_Host_API_Type)) & " " & + Interfaces.C.Strings.Value (Info.My_Error_Text); + end; + elsif Num = pa_invalid_channel_count then + raise Invalid_Channel_Count_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_invalid_sample_rate then + raise Invalid_Sample_Rate_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_invalid_device then + raise Invalid_Device_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_invalid_flag then + raise Invalid_Flag_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_sample_format_not_supported then + raise Sample_Format_Not_Supported_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_bad_io_device_combination then + raise Bad_IO_Device_Combination_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_insufficient_memory then + raise Storage_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_buffer_too_big then + raise Buffer_Too_Big_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_buffer_too_small then + raise Buffer_Too_Small_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_null_callback then + raise Null_Callback_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_bad_stream_ptr then + raise Bad_Stream_Pointer_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_timed_out then + raise Timed_Out_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_internal_error then + raise Internal_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_device_unavailable then + raise Device_Unavailable_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_incompatible_host_api_specific_stream_info then + raise Incompatible_Host_API_Specific_Stream_Info_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_stream_is_stopped then + raise Stream_Is_Stopped_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_stream_is_not_stopped then + raise Stream_Is_Not_Stopped_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_input_overflowed then + raise Input_Overflowed_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_output_underflowed then + raise Output_Underflowed_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_host_api_not_found then + raise Host_API_Not_Found_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_invalid_host_api then + raise Invalid_Host_API_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_cannot_read_from_a_callback_stream then + raise Can_Not_Read_From_A_Callback_Stream_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_cannot_write_to_a_callback_stream then + raise Can_Not_Write_To_A_Callback_Stream_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_cannot_read_from_an_output_only_stream then + raise Can_Not_Read_From_An_Output_Only_Stream_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_cannot_write_to_an_input_only_stream then + raise Can_Not_Write_To_An_Input_Only_Stream_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_incompatible_stream_host_api then + raise Incompatible_Stream_Host_API_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + elsif Num = pa_bad_buffer_ptr then + raise Bad_Buffer_Pointer_Error with + Interfaces.C.Strings.Value (pa_get_error_text (Num)); + else + raise General_Failure; + end if; + end Raise_Error; + + function To_Hat_Kind + (Num : in Interfaces.C.int) + return Host_API_Kind is + begin + if Num = pa_in_development then + return In_Development; + elsif Num = pa_direct_sound then + return Direct_Sound_Host; + elsif Num = pa_mme then + return MME_Host; + elsif Num = pa_asio then + return ASIO_Host; + elsif Num = pa_sound_manager then + return Sound_Manager_Host; + elsif Num = pa_core_audio then + return Core_Audio_Host; + elsif Num = pa_oss then + return OSS_Host; + elsif Num = pa_alsa then + return ALSA_Host; + elsif Num = pa_al then + return AL_Host; + elsif Num = pa_beos then + return BeOS_Host; + elsif Num = pa_wdmks then + return WDMKS_Host; + elsif Num = pa_jack then + return JACK_Host; + elsif Num = pa_wasapi then + return WASAPI_Host; + elsif Num = pa_audio_science_hpi then + return Audio_Science_HPI_Host; + elsif Num = pa_sndio then + return Sndio_Host; + else + raise Program_Error; + end if; + end To_Hat_Kind; + + function To_Cint + (Ident : in Host_API_Kind) + return Interfaces.C.int is + begin + case Ident is + when In_Development => return pa_in_development; + when Direct_Sound_Host => return pa_direct_sound; + when MME_Host => return pa_mme; + when ASIO_Host => return pa_asio; + when Sound_Manager_Host => return pa_sound_manager; + when Core_Audio_Host => return pa_core_audio; + when OSS_Host => return pa_oss; + when ALSA_Host => return pa_alsa; + when AL_Host => return pa_al; + when BeOS_Host => return pa_beos; + when WDMKS_Host => return pa_wdmks; + when JACK_Host => return pa_jack; + when WASAPI_Host => return pa_wasapi; + when Audio_Science_HPI_Host => return pa_audio_science_hpi; + when Sndio_Host => return pa_sndio; + end case; + end To_Cint; + + function To_For_Sam + (Num : in Interfaces.C.unsigned_long) + return Sample_Format is + begin + if Num = pa_float_32 then + return Float_32_Sample; + elsif Num = pa_int_32 then + return Int_32_Sample; + elsif Num = pa_int_24 then + return Int_24_Sample; + elsif Num = pa_int_16 then + return Int_16_Sample; + elsif Num = pa_int_8 then + return Int_8_Sample; + elsif Num = pa_uint_8 then + return UInt_8_Sample; + else + raise Program_Error; + end if; + end To_For_Sam; + + function To_Cnum + (Form : in Sample_Format) + return Interfaces.C.unsigned_long is + begin + case Form is + when Float_32_Sample => return pa_float_32; + when Int_32_Sample => return pa_int_32; + when Int_24_Sample => return pa_int_24; + when Int_16_Sample => return pa_int_16; + when Int_8_Sample => return pa_int_8; + when UInt_8_Sample => return pa_uint_8; + end case; + end To_Cnum; + + function To_Cint + (Result : in Callback_Result) + return Interfaces.C.int is + begin + case Result is + when Continue => return pa_continue; + when Complete => return pa_complete; + when Finish => return pa_abort; + end case; + end To_Cint; + + + + + ----------------------------------- + -- Controlled Type Subprograms -- + ----------------------------------- + + procedure Finalize + (This : in out Final_Controller) + is + Code : Interfaces.C.int; + begin + Code := pa_terminate; + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end Finalize; + + + + + ---------------------- + -- Callback Hooks -- + ---------------------- + + function Stream_Callback_Hook + (Input_Ptr : in System.Address; + Output_Ptr : in System.Address; + Frame_Count : in Interfaces.C.unsigned_long; + Time_Ptr : in System.Address; + Flag_Mask : in Interfaces.C.unsigned_long; + Userdata : in System.Address) + return Interfaces.C.int + is + Stream_Actual : Audio_Stream; + for Stream_Actual'Address use Userdata; + pragma Import (Ada, Stream_Actual); + + Input_Buffer : Sample_Buffer := + (My_Sam_Code => Stream_Actual.Sin, + My_Channels => Natural (Stream_Actual.Chin), + My_Frames => Frame_Amount (Frame_Count), + My_Array => Input_Ptr); + + Output_Buffer : Sample_Buffer := + (My_Sam_Code => Stream_Actual.Sout, + My_Channels => Natural (Stream_Actual.Chout), + My_Frames => Frame_Amount (Frame_Count), + My_Array => Output_Ptr); + + Result : Callback_Result; + begin + Result := Stream_Actual.Func + (Input_Buffer, + Output_Buffer, + Frame_Amount (Frame_Count), + (Ptr => Time_Ptr), + Callback_Flags (Flag_Mask)); + return To_Cint (Result); + end Stream_Callback_Hook; + + + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + function "<" + (A, B : in Version_Number) + return Boolean is + begin + return (A.Major < B.Major) or else + (A.Major = B.Major and A.Minor < B.Minor) or else + (A.Major = B.Major and A.Minor = B.Minor and A.Subminor < B.Subminor); + end "<"; + + function Image + (Num : in Version_Number) + return String + is + function Img + (Int : in Integer) + return String is + begin + return Ada.Strings.Fixed.Trim (Integer'Image (Int), Ada.Strings.Both); + end Img; + begin + return Img (Num.Major) & "." & Img (Num.Minor) & "." & Img (Num.Subminor); + end Image; + + + function Major + (Version : in Version_Info) + return Natural + is + Internal : C_Version_Info; + for Internal'Address use Version.Ptr; + pragma Import (Ada, Internal); + begin + return Natural (Internal.My_Major); + end Major; + + function Minor + (Version : in Version_Info) + return Natural + is + Internal : C_Version_Info; + for Internal'Address use Version.Ptr; + pragma Import (Ada, Internal); + begin + return Natural (Internal.My_Minor); + end Minor; + + function Subminor + (Version : in Version_Info) + return Natural + is + Internal : C_Version_Info; + for Internal'Address use Version.Ptr; + pragma Import (Ada, Internal); + begin + return Natural (Internal.My_Subminor); + end Subminor; + + function Revision + (Version : in Version_Info) + return String + is + Internal : C_Version_Info; + for Internal'Address use Version.Ptr; + pragma Import (Ada, Internal); + begin + return Interfaces.C.Strings.Value (Internal.My_Revision); + end Revision; + + function Text + (Version : in Version_Info) + return String + is + Internal : C_Version_Info; + for Internal'Address use Version.Ptr; + pragma Import (Ada, Internal); + begin + return Interfaces.C.Strings.Value (Internal.My_Text); + end Text; + + + function Kind + (Info : in Host_API_Info) + return Host_API_Kind + is + Internal : C_Host_API_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return To_Hat_Kind (Internal.My_Host_API_Type); + end Kind; + + function Name + (Info : in Host_API_Info) + return String + is + Internal : C_Host_API_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Interfaces.C.Strings.Value (Internal.My_Name); + end Name; + + function Device_Count + (Info : in Host_API_Info) + return Natural + is + Internal : C_Host_API_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Natural (Internal.My_Device_Count); + end Device_Count; + + function Default_Input_Device + (Info : in Host_API_Info) + return Device_Index + is + Internal : C_Host_API_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + if Internal.My_Default_Input = pa_no_device then + return No_Device; + else + return Device_Index (Internal.My_Default_Input) + 1; + end if; + end Default_Input_Device; + + function Default_Output_Device + (Info : in Host_API_Info) + return Device_Index + is + Internal : C_Host_API_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + if Internal.My_Default_Output = pa_no_device then + return No_Device; + else + return Device_Index (Internal.My_Default_Output) + 1; + end if; + end Default_Output_Device; + + + function Image + (Num : in Time) + return String + is + Test_Out : String := Time'Image (Num); + Mark_Start : Integer := Test_Out'First; + Mark_End : Integer := Test_Out'Last; + begin + if Test_Out (Mark_Start) = ' ' then + Mark_Start := Mark_Start + 1; + end if; + while Test_Out (Mark_End) = '0' loop + Mark_End := Mark_End - 1; + end loop; + if Test_Out (Mark_End) = '.' then + Mark_End := Mark_End - 1; + end if; + return Test_Out (Mark_Start .. Mark_End); + end Image; + + + function Hertz_Image + (Num : in Hertz) + return String + is + type Large_Hack is delta 10.0**(-10) digits 30; + Converted : Large_Hack := Large_Hack (Num); + Prelim : String := Large_Hack'Image (Converted); + Test_Out : String := + (if Prelim (Prelim'Last) /= '9' then Prelim + elsif Prelim (Prelim'First) = '-' then Large_Hack'Image (Large_Hack'Pred (Converted)) + else Large_Hack'Image (Large_Hack'Succ (Converted))); + Mark_Start : Integer := Test_Out'First + 1; + Mark_End : Integer := Test_Out'Last; + begin + while Test_Out (Mark_End) = '0' loop + Mark_End := Mark_End - 1; + end loop; + if Test_Out (Mark_End) = '.' then + Mark_End := Mark_End - 1; + end if; + return Test_Out (Mark_Start .. Mark_End); + end Hertz_Image; + + + function Load_Image + (Num : in Load) + return String + is + type Two_Digit_Hack is delta 10.0**(-2) digits 4; + Test_Out : String := Two_Digit_Hack'Image (Two_Digit_Hack (Num)); + Mark_Start : Integer := Test_Out'First + 1; + Mark_End : Integer := Test_Out'Last; + begin + while Test_Out (Mark_End) = '0' loop + Mark_End := Mark_End - 1; + end loop; + if Test_Out (Mark_End) = '.' then + Mark_End := Mark_End - 1; + end if; + return Test_Out (Mark_Start .. Mark_End); + end Load_Image; + + + function Name + (Info : in Device_Info) + return String + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Interfaces.C.Strings.Value (Internal.My_Name); + end Name; + + function Host_API + (Info : in Device_Info) + return Host_API_Index + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Host_API_Index (Internal.My_Host_API_Index + 1); + end Host_API; + + function Max_Input_Channels + (Info : in Device_Info) + return Natural + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Natural (Internal.My_Input_Channels); + end Max_Input_Channels; + + function Max_Output_Channels + (Info : in Device_Info) + return Natural + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Natural (Internal.My_Output_Channels); + end Max_Output_Channels; + + function Default_Low_Input_Latency + (Info : in Device_Info) + return Time + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Low_Input_Latency); + end Default_Low_Input_Latency; + + function Default_Low_Output_Latency + (Info : in Device_Info) + return Time + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Low_Output_Latency); + end Default_Low_Output_Latency; + + function Default_High_Input_Latency + (Info : in Device_Info) + return Time + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_High_Input_Latency); + end Default_High_Input_Latency; + + function Default_High_Output_Latency + (Info : in Device_Info) + return Time + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_High_Output_Latency); + end Default_High_Output_Latency; + + function Default_Sample_Rate + (Info : in Device_Info) + return Hertz + is + Internal : C_Device_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Hertz (Internal.My_Sample_Rate); + end Default_Sample_Rate; + + + function Kind + (Buffer : in Sample_Buffer) + return Sample_Format is + begin + return To_For_Sam (Buffer.My_Sam_Code); + end Kind; + + function Channels + (Buffer : in Sample_Buffer) + return Natural is + begin + return Buffer.My_Channels; + end Channels; + + function Frames + (Buffer : in Sample_Buffer) + return Frame_Amount is + begin + return Buffer.My_Frames; + end Frames; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Float_32 + is + Actual : Float_32_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel); + end Get; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_32 + is + Actual : Int_32_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel); + end Get; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_24 + is + Actual : Int_24_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel); + end Get; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_16 + is + Actual : Int_16_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel); + end Get; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_8 + is + Actual : Int_8_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel); + end Get; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return UInt_8 + is + Actual : UInt_8_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel); + end Get; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Float_32) + is + Actual : Float_32_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_32) + is + Actual : Int_32_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_24) + is + Actual : Int_24_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_16) + is + Actual : Int_16_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_8) + is + Actual : Int_8_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in UInt_8) + is + Actual : UInt_8_Array (1 .. Buffer.My_Channels * Integer (Buffer.My_Frames)); + for Actual'Address use Buffer.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Buffer.My_Channels + Channel) := Value; + end Put; + + + function Wrap + (Store : access Float_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer is + begin + return + (My_Sam_Code => pa_float_32, + My_Channels => Channels, + My_Frames => Frames, + My_Array => Store.all'Address); + end Wrap; + + function Wrap + (Store : access Int_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer is + begin + return + (My_Sam_Code => pa_int_32, + My_Channels => Channels, + My_Frames => Frames, + My_Array => Store.all'Address); + end Wrap; + + function Wrap + (Store : access Int_24_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer is + begin + return + (My_Sam_Code => pa_int_24, + My_Channels => Channels, + My_Frames => Frames, + My_Array => Store.all'Address); + end Wrap; + + function Wrap + (Store : access Int_16_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer is + begin + return + (My_Sam_Code => pa_int_16, + My_Channels => Channels, + My_Frames => Frames, + My_Array => Store.all'Address); + end Wrap; + + function Wrap + (Store : access Int_8_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer is + begin + return + (My_Sam_Code => pa_int_8, + My_Channels => Channels, + My_Frames => Frames, + My_Array => Store.all'Address); + end Wrap; + + function Wrap + (Store : access UInt_8_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer is + begin + return + (My_Sam_Code => pa_uint_8, + My_Channels => Channels, + My_Frames => Frames, + My_Array => Store.all'Address); + end Wrap; + + + function Create + (Device : in Device_Index; + Channels : in Natural; + Format : in Sample_Format; + Latency : in Time) + return Stream_Parameters is + begin + return + (My_Device => Interfaces.C.int (Device) - 1, + My_Channels => Interfaces.C.int (Channels), + My_Samples => To_Cnum (Format), + My_Latency => Interfaces.C.double (Latency), + My_Specific => System.Null_Address); + end Create; + + + function "+" + (A, B : in Stream_Flags) + return Stream_Flags is + begin + return Stream_Flags (Interfaces.C.unsigned_long (A) or Interfaces.C.unsigned_long (B)); + end "+"; + + + function Input_Latency + (Info : in Stream_Info) + return Time + is + Internal : C_Stream_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Input_Latency); + end Input_Latency; + + function Output_Latency + (Info : in Stream_Info) + return Time + is + Internal : C_Stream_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Output_Latency); + end Output_Latency; + + function Sample_Rate + (Info : in Stream_Info) + return Hertz + is + Internal : C_Stream_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Hertz (Internal.My_Sample_Rate); + end Sample_Rate; + + + function Input_ADC_Time + (Info : in Callback_Time_Info) + return Time + is + Internal : C_Callback_Time_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Input_ADC); + end Input_ADC_Time; + + function Current_Time + (Info : in Callback_Time_Info) + return Time + is + Internal : C_Callback_Time_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Current); + end Current_Time; + + function Output_DAC_Time + (Info : in Callback_Time_Info) + return Time + is + Internal : C_Callback_Time_Info; + for Internal'Address use Info.Ptr; + pragma Import (Ada, Internal); + begin + return Time (Internal.My_Output_DAC); + end Output_DAC_Time; + + + function Has_Input_Underflow + (Flags : in Callback_Flags) + return Boolean is + begin + return (Interfaces.C.unsigned_long (Flags) and pa_input_underflow) /= 0; + end Has_Input_Underflow; + + function Has_Input_Overflow + (Flags : in Callback_Flags) + return Boolean is + begin + return (Interfaces.C.unsigned_long (Flags) and pa_input_overflow) /= 0; + end Has_Input_Overflow; + + function Has_Output_Underflow + (Flags : in Callback_Flags) + return Boolean is + begin + return (Interfaces.C.unsigned_long (Flags) and pa_output_underflow) /= 0; + end Has_Output_Underflow; + + function Has_Output_Overflow + (Flags : in Callback_Flags) + return Boolean is + begin + return (Interfaces.C.unsigned_long (Flags) and pa_output_overflow) /= 0; + end Has_Output_Overflow; + + function Has_Priming_Output + (Flags : in Callback_Flags) + return Boolean is + begin + return (Interfaces.C.unsigned_long (Flags) and pa_priming_output) /= 0; + end Has_Priming_Output; + + + + + --------------- + -- Utility -- + --------------- + + function Is_Open + (Stream : in Audio_Stream) + return Boolean is + begin + return Stream.Open; + end Is_Open; + + + + + ------------------------------- + -- Auxiliary API Interface -- + ------------------------------- + + function Get_Version + return Version_Number + is + Raw : Interfaces.Unsigned_32 := Interfaces.Unsigned_32 (pa_get_version); + Result : Version_Number; + begin + Result.Major := Natural (Interfaces.Shift_Right (Raw, 16) and 16#FF#); + Result.Minor := Natural (Interfaces.Shift_Right (Raw, 8) and 16#FF#); + Result.Subminor := Natural (Raw and 16#FF#); + return Result; + end Get_Version; + + function Get_Version_Info + return Version_Info is + begin + return (Ptr => pa_get_version_info); + end Get_Version_Info; + + function Get_Host_API_Count + return Natural + is + Code : Interfaces.C.int; + begin + Code := pa_get_host_api_count; + if Code < 0 then + Raise_Error (Code); + raise Program_Error; + else + return Natural (Code); + end if; + end Get_Host_API_Count; + + function Get_Default_Host_API + return Host_API_Index + is + Code : Interfaces.C.int; + begin + Code := pa_get_default_host_api; + if Code < 0 then + Raise_Error (Code); + raise Program_Error; + else + return Host_API_Index (Code) + 1; + end if; + end Get_Default_Host_API; + + function Get_Host_API_Info + (Index : in Host_API_Index) + return Host_API_Info + is + Result : System.Address; + begin + Result := pa_get_host_api_info (Interfaces.C.int (Index) - 1); + if Result = System.Null_Address then + raise General_Failure; + else + return (Ptr => Result); + end if; + end Get_Host_API_Info; + + function To_Host_API_Index + (Kind : in Host_API_Kind) + return Host_API_Index + is + Code : Interfaces.C.int; + begin + Code := pa_host_api_type_id_to_host_api_index (To_Cint (Kind)); + if Code < 0 then + Raise_Error (Code); + raise Program_Error; + else + return Host_API_Index (Code) + 1; + end if; + end To_Host_API_Index; + + function To_Device_Index + (Host_API : in Host_API_Index; + Host_Device : in Positive) + return Device_Index + is + Code : Interfaces.C.int; + begin + Code := pa_host_api_device_index_to_device_index + (Interfaces.C.int (Host_API) - 1, + Interfaces.C.int (Host_API) - 1); + if Code < 0 then + Raise_Error (Code); + raise Program_Error; + else + return Device_Index (Code + 1); + end if; + end To_Device_Index; + + function Get_Device_Count + return Natural + is + Code : Interfaces.C.int; + begin + Code := pa_get_device_count; + if Code < 0 then + Raise_Error (Code); + raise Program_Error; + else + return Natural (Code); + end if; + end Get_Device_Count; + + function Get_Default_Input_Device + return Device_Index + is + Code : Interfaces.C.int; + begin + Code := pa_get_default_input_device; + if Code = pa_no_device then + return No_Device; + else + return Device_Index (Code + 1); + end if; + end Get_Default_Input_Device; + + function Get_Default_Output_Device + return Device_Index + is + Code : Interfaces.C.int; + begin + Code := pa_get_default_output_device; + if Code = pa_no_device then + return No_Device; + else + return Device_Index (Code + 1); + end if; + end Get_Default_Output_Device; + + function Get_Device_Info + (Index : in Device_Index) + return Device_Info + is + Result : System.Address; + begin + Result := pa_get_device_info (Interfaces.C.int (Index) - 1); + if Result = System.Null_Address then + raise General_Failure; + else + return (Ptr => Result); + end if; + end Get_Device_Info; + + function Is_Format_Supported + (Input : access Stream_Parameters; + Output : access Stream_Parameters; + Rate : in Hertz) + return Boolean + is + Code : Interfaces.C.int; + package Param_Conversions is new System.Address_To_Access_Conversions (Stream_Parameters); + Input_Address : System.Address := + Param_Conversions.To_Address (Param_Conversions.Object_Pointer (Input)); + Output_Address : System.Address := + Param_Conversions.To_Address (Param_Conversions.Object_Pointer (Output)); + begin + Code := pa_is_format_supported + (Input_Address, + Output_Address, + Interfaces.C.double (Rate)); + return Code = pa_format_is_supported; + end Is_Format_Supported; + + function Get_Sample_Size + (Format : in Sample_Format) + return Positive + is + Code : Interfaces.C.int; + begin + Code := pa_get_sample_size (To_Cnum (Format)); + if Code <= 0 then + Raise_Error (Code); + raise Program_Error; + else + return Positive (Code); + end if; + end Get_Sample_Size; + + + + + ---------------------------- + -- Stream API Interface -- + ---------------------------- + + procedure Open_Input + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags; + Callback : in Callback_Function) + is + Code : Interfaces.C.int; + begin + Code := pa_open_stream + (Stream.Ptr, + Input_Params'Address, + System.Null_Address, + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Interfaces.C.unsigned_long (Flags), + Stream_Callback_Hook'Address, + Stream'Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + Stream.Func := Callback; + Stream.Chin := Input_Params.My_Channels; + Stream.Chout := 0; + Stream.Sin := Input_Params.My_Samples; + Stream.Sout := 0; + end if; + end Open_Input; + + procedure Open_Output + (Stream : in out Audio_Stream; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags; + Callback : in Callback_Function) + is + Code : Interfaces.C.int; + begin + Code := pa_open_stream + (Stream.Ptr, + System.Null_Address, + Output_Params'Address, + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Interfaces.C.unsigned_long (Flags), + Stream_Callback_Hook'Address, + Stream'Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + Stream.Func := Callback; + Stream.Chin := 0; + Stream.Chout := Output_Params.My_Channels; + Stream.Sin := 0; + Stream.Sout := Output_Params.My_Samples; + end if; + end Open_Output; + + procedure Open_Full + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags; + Callback : in Callback_Function) + is + Code : Interfaces.C.int; + begin + Code := pa_open_stream + (Stream.Ptr, + Input_Params'Address, + Output_Params'Address, + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Interfaces.C.unsigned_long (Flags), + Stream_Callback_Hook'Address, + Stream'Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + Stream.Func := Callback; + Stream.Chin := Input_Params.My_Channels; + Stream.Chout := Output_Params.My_Channels; + Stream.Sin := Input_Params.My_Samples; + Stream.Sout := Output_Params.My_Samples; + end if; + end Open_Full; + + procedure Open_Input_Blocking + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags) + is + Code : Interfaces.C.int; + begin + Code := pa_open_stream + (Stream.Ptr, + Input_Params'Address, + System.Null_Address, + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Interfaces.C.unsigned_long (Flags), + System.Null_Address, + System.Null_Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + end if; + end Open_Input_Blocking; + + procedure Open_Output_Blocking + (Stream : in out Audio_Stream; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags) + is + Code : Interfaces.C.int; + begin + Code := pa_open_stream + (Stream.Ptr, + System.Null_Address, + Output_Params'Address, + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Interfaces.C.unsigned_long (Flags), + System.Null_Address, + System.Null_Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + end if; + end Open_Output_Blocking; + + procedure Open_Full_Blocking + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags) + is + Code : Interfaces.C.int; + begin + Code := pa_open_stream + (Stream.Ptr, + Input_Params'Address, + Output_Params'Address, + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Interfaces.C.unsigned_long (Flags), + System.Null_Address, + System.Null_Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + end if; + end Open_Full_Blocking; + + procedure Open_Default + (Stream : in out Audio_Stream; + Input_Channels : in Natural; + Output_Channels : in Natural; + Format : in Sample_Format; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Callback : in Callback_Function) + is + Code : Interfaces.C.int; + begin + Code := pa_open_default_stream + (Stream.Ptr, + Interfaces.C.int (Input_Channels), + Interfaces.C.int (Output_Channels), + To_Cnum (Format), + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + Stream_Callback_Hook'Address, + Stream'Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + Stream.Func := Callback; + Stream.Chin := Interfaces.C.int (Input_Channels); + Stream.Chout := Interfaces.C.int (Output_Channels); + Stream.Sin := To_Cnum (Format); + Stream.Sout := To_Cnum (Format); + end if; + end Open_Default; + + procedure Open_Default_Blocking + (Stream : in out Audio_Stream; + Input_Channels : in Natural; + Output_Channels : in Natural; + Format : in Sample_Format; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount) + is + Code : Interfaces.C.int; + begin + Code := pa_open_default_stream + (Stream.Ptr, + Interfaces.C.int (Input_Channels), + Interfaces.C.int (Output_Channels), + To_Cnum (Format), + Interfaces.C.double (Sample_Rate), + Interfaces.C.unsigned_long (Buffer_Frames), + System.Null_Address, + System.Null_Address); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := True; + end if; + end Open_Default_Blocking; + + procedure Close + (Stream : in out Audio_Stream) + is + Code : Interfaces.C.int; + begin + Code := pa_close_stream (Stream.Ptr); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + else + Stream.Open := False; + Stream.Chin := 0; + Stream.Chout := 0; + Stream.Sin := 0; + Stream.Sout := 0; + end if; + end Close; + + procedure Start + (Stream : in Audio_Stream) + is + Code : Interfaces.C.int; + begin + Code := pa_start_stream (Stream.Ptr); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end Start; + + procedure Stop + (Stream : in Audio_Stream) + is + Code : Interfaces.C.int; + begin + Code := pa_stop_stream (Stream.Ptr); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end Stop; + + procedure Term + (Stream : in Audio_Stream) + is + Code : Interfaces.C.int; + begin + Code := pa_abort_stream (Stream.Ptr); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end Term; + + function Is_Stopped + (Stream : in Audio_Stream) + return Boolean + is + Code : Interfaces.C.int; + begin + Code := pa_is_stream_stopped (Stream.Ptr); + if Code = 1 then + return True; + elsif Code = 0 then + return False; + else + Raise_Error (Code); + raise Program_Error; + end if; + end Is_Stopped; + + function Is_Active + (Stream : in Audio_Stream) + return Boolean + is + Code : Interfaces.C.int; + begin + Code := pa_is_stream_active (Stream.Ptr); + if Code = 1 then + return True; + elsif Code = 0 then + return False; + else + Raise_Error (Code); + raise Program_Error; + end if; + end Is_Active; + + function Get_Info + (Stream : in Audio_Stream) + return Stream_Info'Class + is + Result : System.Address; + begin + Result := pa_get_stream_info (Stream.Ptr); + if Result = System.Null_Address then + raise General_Failure; + else + return Info : Stream_Info := (Ptr => Result); + end if; + end Get_Info; + + function Get_Time + (Stream : in Audio_Stream) + return Time + is + Result : Interfaces.C.double; + begin + Result := pa_get_stream_time (Stream.Ptr); + if Result = 0.0 then + raise General_Failure; + else + return Time (Result); + end if; + end Get_Time; + + function Get_CPU_Load + (Stream : in Audio_Stream) + return Load is + begin + return Load (pa_get_stream_cpu_load (Stream.Ptr)); + end Get_CPU_Load; + + procedure Read_Blocking + (Stream : in Audio_Stream; + Buffer : in Sample_Buffer'Class; + Frames : in Frame_Amount) + is + Code : Interfaces.C.int; + begin + Code := pa_read_stream + (Stream.Ptr, + Buffer.My_Array, + Interfaces.C.unsigned_long (Frames)); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end Read_Blocking; + + procedure Write_Blocking + (Stream : in Audio_Stream; + Buffer : in Sample_Buffer'Class; + Frames : in Frame_Amount) + is + Code : Interfaces.C.int; + begin + Code := pa_write_stream + (Stream.Ptr, + Buffer.My_Array, + Interfaces.C.unsigned_long (Frames)); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end Write_Blocking; + + function Get_Read_Available + (Stream : in Audio_Stream) + return Frame_Amount + is + Code : Interfaces.C.long; + begin + Code := pa_get_stream_read_available (Stream.Ptr); + if Code < 0 then + Raise_Error (Interfaces.C.int (Code)); + raise Program_Error; + else + return Frame_Amount (Code); + end if; + end Get_Read_Available; + + function Get_Write_Available + (Stream : in Audio_Stream) + return Frame_Amount + is + Code : Interfaces.C.long; + begin + Code := pa_get_stream_write_available (Stream.Ptr); + if Code < 0 then + Raise_Error (Interfaces.C.int (Code)); + raise Program_Error; + else + return Frame_Amount (Code); + end if; + end Get_Write_Available; + + + + +begin + + declare + Code : Interfaces.C.int; + begin + Code := pa_initialize (Boolean'Pos (True)); + if Code /= pa_no_error then + Raise_Error (Code); + raise Program_Error; + end if; + end; + +end Portaudio; + + diff --git a/src/portaudio.ads b/src/portaudio.ads new file mode 100644 index 0000000..bc07a44 --- /dev/null +++ b/src/portaudio.ads @@ -0,0 +1,933 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces; + +private with + + Ada.Finalization, + Interfaces.C.Strings, + System; + + +package Portaudio is + + + ----------------------- + -- Data Types and Structures -- + ----------------------- + + type Version_Number is record + Major : Natural; + Minor : Natural; + Subminor : Natural; + end record; + + function "<" + (A, B : in Version_Number) + return Boolean; + + function Image + (Num : in Version_Number) + return String; + + + type Version_Info is tagged private; + + function Major + (Version : in Version_Info) + return Natural; + + function Minor + (Version : in Version_Info) + return Natural; + + function Subminor + (Version : in Version_Info) + return Natural; + + function Revision + (Version : in Version_Info) + return String; + + function Text + (Version : in Version_Info) + return String; + + + type Host_API_Kind is + (In_Development, + Direct_Sound_Host, + MME_Host, + ASIO_Host, + Sound_Manager_Host, + Core_Audio_Host, + OSS_Host, + ALSA_Host, + AL_Host, + BeOS_Host, + WDMKS_Host, + JACK_Host, + WASAPI_Host, + Audio_Science_HPI_Host, + Sndio_Host); + + type Host_API_Index is new Positive; + + + type Device_Index is new Natural; + + No_Device : constant Device_Index; + + + type Host_API_Info is tagged private; + + function Kind + (Info : in Host_API_Info) + return Host_API_Kind; + + function Name + (Info : in Host_API_Info) + return String; + + function Device_Count + (Info : in Host_API_Info) + return Natural; + + function Default_Input_Device + (Info : in Host_API_Info) + return Device_Index; + + function Default_Output_Device + (Info : in Host_API_Info) + return Device_Index; + + + type Time is delta 10.0**(-4) digits 12; + + function Image + (Num : in Time) + return String; + + + subtype Hertz is Long_Float + with Static_Predicate => Hertz >= 0.0; + + function Hertz_Image + (Num : in Hertz) + return String; + + + subtype Load is Long_Float + with Static_Predicate => Load >= 0.0; + + function Load_Image + (Num : in Load) + return String; + + + type Device_Info is tagged private; + + function Name + (Info : in Device_Info) + return String; + + function Host_API + (Info : in Device_Info) + return Host_API_Index; + + function Max_Input_Channels + (Info : in Device_Info) + return Natural; + + function Max_Output_Channels + (Info : in Device_Info) + return Natural; + + function Default_Low_Input_Latency + (Info : in Device_Info) + return Time; + + function Default_Low_Output_Latency + (Info : in Device_Info) + return Time; + + function Default_High_Input_Latency + (Info : in Device_Info) + return Time; + + function Default_High_Output_Latency + (Info : in Device_Info) + return Time; + + function Default_Sample_Rate + (Info : in Device_Info) + return Hertz; + + + type Sample_Format is + (Float_32_Sample, + Int_32_Sample, + Int_24_Sample, + Int_16_Sample, + Int_8_Sample, + UInt_8_Sample); + + + type Float_32 is new Float; + for Float_32'Size use 32; + type Float_32_Array is array (Positive range <>) of Float_32; + + type Int_32 is new Interfaces.Integer_32; + type Int_32_Array is array (Positive range <>) of Int_32; + + type Int_24 is range -2 ** 23 .. 2 ** 23 - 1; + for Int_24'Size use 24; + type Int_24_Array is array (Positive range <>) of Int_24; + + type Int_16 is new Interfaces.Integer_16; + type Int_16_Array is array (Positive range <>) of Int_16; + + type Int_8 is new Interfaces.Integer_8; + type Int_8_Array is array (Positive range <>) of Int_8; + + type UInt_8 is new Interfaces.Unsigned_8; + type UInt_8_Array is array (Positive range <>) of UInt_8; + + + type Frame_Amount is new Interfaces.Unsigned_32; + + + type Sample_Buffer is tagged private; + + function Kind + (Buffer : in Sample_Buffer) + return Sample_Format; + + function Channels + (Buffer : in Sample_Buffer) + return Natural; + + function Frames + (Buffer : in Sample_Buffer) + return Frame_Amount; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Float_32 + with Pre => Buffer.Kind = Float_32_Sample; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_32 + with Pre => Buffer.Kind = Int_32_Sample; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_24 + with Pre => Buffer.Kind = Int_24_Sample; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_16 + with Pre => Buffer.Kind = Int_16_Sample; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_8 + with Pre => Buffer.Kind = Int_8_Sample; + + function Get + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return UInt_8 + with Pre => Buffer.Kind = UInt_8_Sample; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Float_32) + with Pre => Buffer.Kind = Float_32_Sample; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_32) + with Pre => Buffer.Kind = Int_32_Sample; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_24) + with Pre => Buffer.Kind = Int_24_Sample; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_16) + with Pre => Buffer.Kind = Int_16_Sample; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_8) + with Pre => Buffer.Kind = Int_8_Sample; + + procedure Put + (Buffer : in Sample_Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in UInt_8) + with Pre => Buffer.Kind = UInt_8_Sample; + + + function Wrap + (Store : access Float_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_24_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_16_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_8_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access UInt_8_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Sample_Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + + type Stream_Parameters is private; + + function Create + (Device : in Device_Index; + Channels : in Natural; + Format : in Sample_Format; + Latency : in Time) + return Stream_Parameters + with Pre => Device /= No_Device; + + + type Stream_Flags is private; + + function "+" + (A, B : in Stream_Flags) + return Stream_Flags; + + -- No flags + No_Flag : constant Stream_Flags; + + -- Disable default clipping + Clip_Off_Flag : constant Stream_Flags; + + -- Disable default dithering + Dither_Off_Flag : constant Stream_Flags; + + -- Never drop input + Never_Drop_Flag : constant Stream_Flags; + + -- Prime output buffers using stream callback + Prime_Output_Flag : constant Stream_Flags; + + + type Audio_Stream is tagged limited private; + + + type Stream_Info is tagged private; + + function Input_Latency + (Info : in Stream_Info) + return Time; + + function Output_Latency + (Info : in Stream_Info) + return Time; + + function Sample_Rate + (Info : in Stream_Info) + return Hertz; + + + type Callback_Result is (Continue, Complete, Finish); + + + type Callback_Time_Info is tagged private; + + function Input_ADC_Time + (Info : in Callback_Time_Info) + return Time; + + function Current_Time + (Info : in Callback_Time_Info) + return Time; + + function Output_DAC_Time + (Info : in Callback_Time_Info) + return Time; + + + type Callback_Flags is private; + + function Has_Input_Underflow + (Flags : in Callback_Flags) + return Boolean; + + function Has_Input_Overflow + (Flags : in Callback_Flags) + return Boolean; + + function Has_Output_Underflow + (Flags : in Callback_Flags) + return Boolean; + + function Has_Output_Overflow + (Flags : in Callback_Flags) + return Boolean; + + function Has_Priming_Output + (Flags : in Callback_Flags) + return Boolean; + + + -- Due to how void pointers are wrapped into Sample_Buffers + -- the Output here is given as 'in' mode, but you can still + -- write to it just fine using the Put subprograms + type Callback_Function is access function + (Input : in Sample_Buffer; + Output : in Sample_Buffer; + Frames : in Frame_Amount; + Timing : in Callback_Time_Info; + Flags : in Callback_Flags) + return Callback_Result; + + + + + ------------------ + -- Exceptions -- + ------------------ + + Not_Initialized_Error : exception; + + Unanticipated_Host_Error : exception; + + Invalid_Channel_Count_Error : exception; + + Invalid_Sample_Rate_Error : exception; + + Invalid_Device_Error : exception; + + Invalid_Flag_Error : exception; + + Sample_Format_Not_Supported_Error : exception; + + Bad_IO_Device_Combination_Error : exception; + + Buffer_Too_Big_Error : exception; + + Buffer_Too_Small_Error : exception; + + Null_Callback_Error : exception; + + Bad_Stream_Pointer_Error : exception; + + Timed_Out_Error : exception; + + Internal_Error : exception; + + Device_Unavailable_Error : exception; + + Incompatible_Host_API_Specific_Stream_Info_Error : exception; + + Stream_Is_Stopped_Error : exception; + + Stream_Is_Not_Stopped_Error : exception; + + Input_Overflowed_Error : exception; + + Output_Underflowed_Error : exception; + + Host_API_Not_Found_Error : exception; + + Invalid_Host_API_Error : exception; + + Can_Not_Read_From_A_Callback_Stream_Error : exception; + + Can_Not_Write_To_A_Callback_Stream_Error : exception; + + Can_Not_Read_From_An_Output_Only_Stream_Error : exception; + + Can_Not_Write_To_An_Input_Only_Stream_Error : exception; + + Incompatible_Stream_Host_API_Error : exception; + + Bad_Buffer_Pointer_Error : exception; + + Can_Not_Initialize_Recursively_Error : exception; + + General_Failure : exception; + + + + + --------------- + -- Utility -- + --------------- + + function Is_Open + (Stream : in Audio_Stream) + return Boolean; + + + + + ------------------------------- + -- Auxiliary API Interface -- + ------------------------------- + + function Get_Version + return Version_Number; + + function Get_Version_Info + return Version_Info; + + function Get_Host_API_Count + return Natural; + + function Get_Default_Host_API + return Host_API_Index + with Post => Get_Default_Host_API'Result in + Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); + + function Get_Host_API_Info + (Index : in Host_API_Index) + return Host_API_Info + with Pre => Index in Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); + + function To_Host_API_Index + (Kind : in Host_API_Kind) + return Host_API_Index + with Post => To_Host_API_Index'Result in + Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); + + function To_Device_Index + (Host_API : in Host_API_Index; + Host_Device : in Positive) + return Device_Index + with Pre => Host_API in Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count) and + Host_Device in 1 .. Get_Host_API_Info (Host_API).Device_Count, + Post => To_Device_Index'Result in + Device_Index (1) .. Device_Index (Get_Device_Count); + + function Get_Device_Count + return Natural; + + function Get_Default_Input_Device + return Device_Index; + + function Get_Default_Output_Device + return Device_Index; + + function Get_Device_Info + (Index : in Device_Index) + return Device_Info + with Pre => Index in Device_Index (1) .. Device_Index (Get_Device_Count); + + function Is_Format_Supported + (Input : access Stream_Parameters; + Output : access Stream_Parameters; + Rate : in Hertz) + return Boolean; + + function Get_Sample_Size + (Format : in Sample_Format) + return Positive; + + + + + ---------------------------- + -- Stream API Interface -- + ---------------------------- + + procedure Open_Input + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Output + (Stream : in out Audio_Stream; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Full + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Input_Blocking + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Output_Blocking + (Stream : in out Audio_Stream; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Full_Blocking + (Stream : in out Audio_Stream; + Input_Params : in Stream_Parameters; + Output_Params : in Stream_Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Flags : in Stream_Flags) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Default + (Stream : in out Audio_Stream; + Input_Channels : in Natural; + Output_Channels : in Natural; + Format : in Sample_Format; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open and + (Input_Channels > 0 or Output_Channels > 0), + Post => Stream.Is_Open; + + procedure Open_Default_Blocking + (Stream : in out Audio_Stream; + Input_Channels : in Natural; + Output_Channels : in Natural; + Format : in Sample_Format; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount) + with Pre => not Stream.Is_Open and + (Input_Channels > 0 or Output_Channels > 0), + Post => Stream.Is_Open; + + procedure Close + (Stream : in out Audio_Stream) + with Pre => Stream.Is_Open, + Post => not Stream.Is_Open; + + procedure Start + (Stream : in Audio_Stream) + with Pre => Stream.Is_Open; + + procedure Stop + (Stream : in Audio_Stream) + with Pre => Stream.Is_Open; + + procedure Term + (Stream : in Audio_Stream) + with Pre => Stream.Is_Open; + + function Is_Stopped + (Stream : in Audio_Stream) + return Boolean + with Pre => Stream.Is_Open; + + function Is_Active + (Stream : in Audio_Stream) + return Boolean + with Pre => Stream.Is_Open; + + function Get_Info + (Stream : in Audio_Stream) + return Stream_Info'Class + with Pre => Stream.Is_Open; + + function Get_Time + (Stream : in Audio_Stream) + return Time + with Pre => Stream.Is_Open; + + function Get_CPU_Load + (Stream : in Audio_Stream) + return Load + with Pre => Stream.Is_Open; + + procedure Read_Blocking + (Stream : in Audio_Stream; + Buffer : in Sample_Buffer'Class; + Frames : in Frame_Amount) + with Pre => Stream.Is_Open and then Stream.Is_Active; + + procedure Write_Blocking + (Stream : in Audio_Stream; + Buffer : in Sample_Buffer'Class; + Frames : in Frame_Amount) + with Pre => Stream.Is_Open and then Stream.Is_Active; + + function Get_Read_Available + (Stream : in Audio_Stream) + return Frame_Amount + with Pre => Stream.Is_Open and then Stream.Is_Active; + + function Get_Write_Available + (Stream : in Audio_Stream) + return Frame_Amount + with Pre => Stream.Is_Open and then Stream.Is_Active; + + +private + + + pragma Linker_Options ("-lportaudio"); + + + + + type C_Version_Info is record + My_Major : Interfaces.C.int; + My_Minor : Interfaces.C.int; + My_Subminor : Interfaces.C.int; + My_Revision : Interfaces.C.Strings.chars_ptr; + My_Text : Interfaces.C.Strings.chars_ptr; + end record with Convention => C; + + type Version_Info is tagged record + Ptr : System.Address; + end record; + + + type C_Host_Error_Info is record + My_Host_API_Type : Interfaces.C.int; + My_Error_Code : Interfaces.C.long; + My_Error_Text : Interfaces.C.Strings.chars_ptr; + end record with Convention => C; + + + type C_Host_API_Info is record + My_Struct_Version : Interfaces.C.int; + My_Host_API_Type : Interfaces.C.int; + My_Name : Interfaces.C.Strings.chars_ptr; + My_Device_Count : Interfaces.C.int; + My_Default_Input : Interfaces.C.int; + My_Default_Output : Interfaces.C.int; + end record with Convention => C; + + type Host_API_Info is tagged record + Ptr : System.Address; + end record; + + + type C_Device_Info is record + My_Struct_Version : Interfaces.C.int; + My_Name : Interfaces.C.Strings.chars_ptr; + My_Host_API_Index : Interfaces.C.int; + My_Input_Channels : Interfaces.C.int; + My_Output_Channels : Interfaces.C.int; + My_Low_Input_Latency : Interfaces.C.double; + My_Low_Output_Latency : Interfaces.C.double; + My_High_Input_Latency : Interfaces.C.double; + My_High_Output_Latency : Interfaces.C.double; + My_Sample_Rate : Interfaces.C.double; + end record with Convention => C; + + type Device_Info is tagged record + Ptr : System.Address; + end record; + + + pragma Convention (C, Float_32_Array); + pragma Convention (C, Int_32_Array); + pragma Convention (C, Int_24_Array); + pragma Convention (C, Int_16_Array); + pragma Convention (C, Int_8_Array); + pragma Convention (C, UInt_8_Array); + + type Sample_Buffer is tagged record + My_Sam_Code : Interfaces.C.unsigned_long; + My_Channels : Natural; + My_Frames : Frame_Amount; + My_Array : System.Address; + end record; + + + type Stream_Parameters is record + My_Device : Interfaces.C.int; + My_Channels : Interfaces.C.int; + My_Samples : Interfaces.C.unsigned_long; + My_Latency : Interfaces.C.double; + My_Specific : System.Address; + end record with Convention => C; + + + type Stream_Flags is new Interfaces.C.unsigned_long; + + No_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_no_flag"; + + Clip_Off_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_clip_off"; + + Dither_Off_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_dither_off"; + + Never_Drop_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_never_drop_input"; + + Prime_Output_Flag : constant Stream_Flags + with Import => True, Convention => C, + External_Name => "pa_prime_output_buffers_using_stream_callback"; + + + type Audio_Stream is tagged limited record + Ptr : System.Address; + Open : Boolean := False; + Func : Callback_Function; + Chin : Interfaces.C.int := 0; + Chout : Interfaces.C.int := 0; + Sin : Interfaces.C.unsigned_long := 0; + Sout : Interfaces.C.unsigned_long := 0; + end record; + + + type C_Stream_Info is record + My_Struct_Version : Interfaces.C.int; + My_Input_Latency : Interfaces.C.double; + My_Output_Latency : Interfaces.C.double; + My_Sample_Rate : Interfaces.C.double; + end record with Convention => C; + + type Stream_Info is tagged record + Ptr : System.Address; + end record; + + + type C_Callback_Time_Info is record + My_Input_ADC : Interfaces.C.double; + My_Current : Interfaces.C.double; + My_Output_DAC : Interfaces.C.double; + end record with Convention => C; + + type Callback_Time_Info is tagged record + Ptr : System.Address; + end record; + + + type Callback_Flags is new Interfaces.C.unsigned_long; + + + + + No_Device : constant Device_Index := 0; + + + + + procedure Raise_Error + (Num : in Interfaces.C.int); + + function To_Hat_Kind + (Num : in Interfaces.C.int) + return Host_API_Kind; + + function To_Cint + (Ident : in Host_API_Kind) + return Interfaces.C.int; + + function To_For_Sam + (Num : in Interfaces.C.unsigned_long) + return Sample_Format; + + function To_Cnum + (Form : in Sample_Format) + return Interfaces.C.unsigned_long; + + function To_Cint + (Result : in Callback_Result) + return Interfaces.C.int; + + + + + -- The clunky way of ensuring that PortAudio is always shut down properly + + type Final_Controller is new Ada.Finalization.Controlled with null record; + + overriding procedure Finalize + (This : in out Final_Controller); + + Cleanup : Final_Controller; + + +end Portaudio; + + |