From 543cd19ab514ec632d965acd5177c5bf6695520f Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sat, 15 Jul 2023 20:18:26 +1200 Subject: Initial commit --- src/portaudio.adb | 2038 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2038 insertions(+) create mode 100644 src/portaudio.adb (limited to 'src/portaudio.adb') 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; + + -- cgit