diff options
Diffstat (limited to 'src/portaudio.adb')
| -rw-r--r-- | src/portaudio.adb | 1470 |
1 files changed, 7 insertions, 1463 deletions
diff --git a/src/portaudio.adb b/src/portaudio.adb index 5b75a97..2ed90ea 100644 --- a/src/portaudio.adb +++ b/src/portaudio.adb @@ -4,6 +4,9 @@ -- Released into the public domain +pragma Ada_2012; + + with Ada.Strings.Fixed, @@ -12,12 +15,8 @@ with use type - Interfaces.C.double, Interfaces.C.int, - Interfaces.C.long, - Interfaces.C.unsigned_long, - Interfaces.Unsigned_32, - System.Address; + Interfaces.Unsigned_32; package body Portaudio is @@ -27,9 +26,6 @@ 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"); @@ -169,59 +165,6 @@ package body Portaudio is 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"); - - ------------------------ @@ -250,163 +193,10 @@ package body Portaudio is 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"); - @@ -578,52 +368,6 @@ package body Portaudio is 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; - @@ -646,49 +390,6 @@ package body Portaudio is - ---------------------- - -- 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 -- --------------------------------- @@ -773,70 +474,6 @@ package body Portaudio is 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 @@ -901,510 +538,11 @@ package body Portaudio is 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 -- - ------------------------------- + ----------------------- + -- API Subprograms -- + ----------------------- function Get_Version return Version_Number @@ -1424,600 +562,6 @@ package body Portaudio is 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; - |