-- 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;