diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/portaudio-devices.adb | 389 | ||||
| -rw-r--r-- | src/portaudio-devices.ads | 171 | ||||
| -rw-r--r-- | src/portaudio-streams.adb | 1079 | ||||
| -rw-r--r-- | src/portaudio-streams.ads | 537 | ||||
| -rw-r--r-- | src/portaudio.adb | 1470 | ||||
| -rw-r--r-- | src/portaudio.ads | 705 |
6 files changed, 2192 insertions, 2159 deletions
diff --git a/src/portaudio-devices.adb b/src/portaudio-devices.adb new file mode 100644 index 0000000..7e0e5e6 --- /dev/null +++ b/src/portaudio-devices.adb @@ -0,0 +1,389 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +pragma Ada_2012; + + +with + + Interfaces.C.Strings, + System; + +use type + + Interfaces.C.int, + System.Address; + + +package body Portaudio.Devices is + + + ------------------------ + -- Constants From C -- + ------------------------ + + pa_no_device : constant Interfaces.C.int; + pragma Import (C, pa_no_device, "pa_no_device"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + 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_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"); + + + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + 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 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; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + 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; + + +end Portaudio.Devices; + + diff --git a/src/portaudio-devices.ads b/src/portaudio-devices.ads new file mode 100644 index 0000000..aae6674 --- /dev/null +++ b/src/portaudio-devices.ads @@ -0,0 +1,171 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +pragma Ada_2012; + + +private with + + Interfaces.C.Strings, + System; + + +package Portaudio.Devices is + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + type Host_API_Info is tagged private; + + function Kind + (Info : in Host_API_Info) + return Host_API_Kind; + + function Name + (Info : in Host_API_Info) + return String; + + function Device_Count + (Info : in Host_API_Info) + return Natural; + + function Default_Input_Device + (Info : in Host_API_Info) + return Device_Index; + + function Default_Output_Device + (Info : in Host_API_Info) + return Device_Index; + + + type Device_Info is tagged private; + + function Name + (Info : in Device_Info) + return String; + + function Host_API + (Info : in Device_Info) + return Host_API_Index; + + function Max_Input_Channels + (Info : in Device_Info) + return Natural; + + function Max_Output_Channels + (Info : in Device_Info) + return Natural; + + function Default_Low_Input_Latency + (Info : in Device_Info) + return Time; + + function Default_Low_Output_Latency + (Info : in Device_Info) + return Time; + + function Default_High_Input_Latency + (Info : in Device_Info) + return Time; + + function Default_High_Output_Latency + (Info : in Device_Info) + return Time; + + function Default_Sample_Rate + (Info : in Device_Info) + return Hertz; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Host_API_Count + return Natural; + + function Get_Default_Host_API + return Host_API_Index + with Post => Get_Default_Host_API'Result in + Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); + + function Get_Host_API_Info + (Index : in Host_API_Index) + return Host_API_Info + with Pre => Index in Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); + + function To_Host_API_Index + (Kind : in Host_API_Kind) + return Host_API_Index + with Post => To_Host_API_Index'Result in + Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); + + function To_Device_Index + (Host_API : in Host_API_Index; + Host_Device : in Positive) + return Device_Index + with Pre => Host_API in Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count) and + Host_Device in 1 .. Get_Host_API_Info (Host_API).Device_Count, + Post => To_Device_Index'Result in + Device_Index (1) .. Device_Index (Get_Device_Count); + + function Get_Device_Count + return Natural; + + function Get_Default_Input_Device + return Device_Index; + + function Get_Default_Output_Device + return Device_Index; + + function Get_Device_Info + (Index : in Device_Index) + return Device_Info + with Pre => Index in Device_Index (1) .. Device_Index (Get_Device_Count); + + +private + + + type C_Host_API_Info is record + My_Struct_Version : Interfaces.C.int; + My_Host_API_Type : Interfaces.C.int; + My_Name : Interfaces.C.Strings.chars_ptr; + My_Device_Count : Interfaces.C.int; + My_Default_Input : Interfaces.C.int; + My_Default_Output : Interfaces.C.int; + end record with Convention => C; + + type Host_API_Info is tagged record + Ptr : System.Address; + end record; + + + type C_Device_Info is record + My_Struct_Version : Interfaces.C.int; + My_Name : Interfaces.C.Strings.chars_ptr; + My_Host_API_Index : Interfaces.C.int; + My_Input_Channels : Interfaces.C.int; + My_Output_Channels : Interfaces.C.int; + My_Low_Input_Latency : Interfaces.C.double; + My_Low_Output_Latency : Interfaces.C.double; + My_High_Input_Latency : Interfaces.C.double; + My_High_Output_Latency : Interfaces.C.double; + My_Sample_Rate : Interfaces.C.double; + end record with Convention => C; + + type Device_Info is tagged record + Ptr : System.Address; + end record; + + +end Portaudio.Devices; + + diff --git a/src/portaudio-streams.adb b/src/portaudio-streams.adb new file mode 100644 index 0000000..0df71ee --- /dev/null +++ b/src/portaudio-streams.adb @@ -0,0 +1,1079 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +pragma Ada_2012; + + +with + + Interfaces.C, + System.Address_To_Access_Conversions; + +use type + + Interfaces.C.double, + Interfaces.C.int, + Interfaces.C.long, + Interfaces.C.unsigned_long, + System.Address; + + +package body Portaudio.Streams is + + + ------------------------ + -- Constants From C -- + ------------------------ + + 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_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 -- + ------------------------ + + function To_For_Sam + (Num : in Interfaces.C.unsigned_long) + return Sample_Format is + begin + if Num = pa_float_32 then + return Float_32_Format; + elsif Num = pa_int_32 then + return Int_32_Format; + elsif Num = pa_int_24 then + return Int_24_Format; + elsif Num = pa_int_16 then + return Int_16_Format; + elsif Num = pa_int_8 then + return Int_8_Format; + elsif Num = pa_uint_8 then + return UInt_8_Format; + else + raise Program_Error; + end if; + end To_For_Sam; + + function To_Cnum + (Format : in Sample_Format) + return Interfaces.C.unsigned_long is + begin + case Format is + when Float_32_Format => return pa_float_32; + when Int_32_Format => return pa_int_32; + when Int_24_Format => return pa_int_24; + when Int_16_Format => return pa_int_16; + when Int_8_Format => return pa_int_8; + when UInt_8_Format => return pa_uint_8; + end case; + end To_Cnum; + + function To_Cint + (Ret_Value : in Callback_Result) + return Interfaces.C.int is + begin + case Ret_Value is + when Continue => return pa_continue; + when Complete => return pa_complete; + when Finish => return pa_abort; + end case; + end To_Cint; + + + + + ---------------------- + -- 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 : 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 : Buffer := + (My_Sam_Code => Stream_Actual.Sout, + My_Channels => Natural (Stream_Actual.Chout), + My_Frames => Frame_Amount (Frame_Count), + My_Array => Output_Ptr); + + Raw_Time : C_Callback_Time_Info; + for Raw_Time'Address use Time_Ptr; + pragma Import (Ada, Raw_Time); + + Result : Callback_Result; + begin + Result := Stream_Actual.Func + (Input_Buffer, + Output_Buffer, + Frame_Amount (Frame_Count), + (Input_ADC => Time (Raw_Time.My_Input_ADC), + Current => Time (Raw_Time.My_Current), + Output_DAC => Time (Raw_Time.My_Output_DAC)), + (Input_Underflow => (Flag_Mask and pa_input_underflow) /= 0, + Input_Overflow => (Flag_Mask and pa_input_overflow) /= 0, + Output_Underflow => (Flag_Mask and pa_output_underflow) /= 0, + Output_Overflow => (Flag_Mask and pa_output_overflow) /= 0, + Priming_Output => (Flag_Mask and pa_priming_output) /= 0)); + return To_Cint (Result); + end Stream_Callback_Hook; + + + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + function Kind + (Store : in Buffer) + return Sample_Format is + begin + return To_For_Sam (Store.My_Sam_Code); + end Kind; + + function Channels + (Store : in Buffer) + return Natural is + begin + return Store.My_Channels; + end Channels; + + function Frames + (Store : in Buffer) + return Frame_Amount is + begin + return Store.My_Frames; + end Frames; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Float_32 + is + Actual : Float_32_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel); + end Get; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_32 + is + Actual : Int_32_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel); + end Get; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_24 + is + Actual : Int_24_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel); + end Get; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_16 + is + Actual : Int_16_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel); + end Get; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_8 + is + Actual : Int_8_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel); + end Get; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return UInt_8 + is + Actual : UInt_8_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + return Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel); + end Get; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Float_32) + is + Actual : Float_32_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_32) + is + Actual : Int_32_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_24) + is + Actual : Int_24_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_16) + is + Actual : Int_16_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_8) + is + Actual : Int_8_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel) := Value; + end Put; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in UInt_8) + is + Actual : UInt_8_Array (1 .. Store.My_Channels * Integer (Store.My_Frames)); + for Actual'Address use Store.My_Array; + pragma Import (Ada, Actual); + begin + Actual ((Integer (Frame) - 1) * Store.My_Channels + Channel) := Value; + end Put; + + function Wrap + (Store : access Float_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return 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 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 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 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 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 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 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 "+"; + + + + + --------------- + -- Utility -- + --------------- + + function Is_Open + (Stream : in Audio_Stream) + return Boolean is + begin + return Stream.Open; + end Is_Open; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Is_Format_Supported + (Input : access Parameters; + Output : access Parameters; + Rate : in Hertz) + return Boolean + is + Code : Interfaces.C.int; + package Param_Conversions is new System.Address_To_Access_Conversions (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; + + procedure Open_Input + (Stream : in out Audio_Stream; + Input_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : 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 (Bunting), + 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 Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : 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 (Bunting), + 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 Parameters; + Output_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : 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 (Bunting), + 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 Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : 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 (Bunting), + 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 Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : 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 (Bunting), + 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 Parameters; + Output_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : 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 (Bunting), + 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 + is + Result : System.Address; + begin + Result := pa_get_stream_info (Stream.Ptr); + if Result = System.Null_Address then + raise General_Failure; + else + declare + C_Data : C_Stream_Info; + for C_Data'Address use Result; + pragma Import (Ada, C_Data); + begin + return + (Input_Latency => Time (C_Data.My_Input_Latency), + Output_Latency => Time (C_Data.My_Output_Latency), + Sample_Rate => Hertz (C_Data.My_Sample_Rate)); + end; + 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; + Store : in Buffer'Class; + Frames : in Frame_Amount) + is + Code : Interfaces.C.int; + begin + Code := pa_read_stream + (Stream.Ptr, + Store.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; + Store : in Buffer'Class; + Frames : in Frame_Amount) + is + Code : Interfaces.C.int; + begin + Code := pa_write_stream + (Stream.Ptr, + Store.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; + + 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; + + +end Portaudio.Streams; + + diff --git a/src/portaudio-streams.ads b/src/portaudio-streams.ads new file mode 100644 index 0000000..bdd6247 --- /dev/null +++ b/src/portaudio-streams.ads @@ -0,0 +1,537 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +pragma Ada_2012; + + +with + + Interfaces; + +private with + + Interfaces.C, + System; + + +package Portaudio.Streams is + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + type Sample_Format is + (Float_32_Format, + Int_32_Format, + Int_24_Format, + Int_16_Format, + Int_8_Format, + UInt_8_Format); + + + type Float_32 is new Float; + for Float_32'Size use 32; + type Float_32_Array is array (Positive range <>) of Float_32; + + type Int_32 is new Interfaces.Integer_32; + type Int_32_Array is array (Positive range <>) of Int_32; + + type Int_24 is range -2 ** 23 .. 2 ** 23 - 1; + for Int_24'Size use 24; + type Int_24_Array is array (Positive range <>) of Int_24; + + type Int_16 is new Interfaces.Integer_16; + type Int_16_Array is array (Positive range <>) of Int_16; + + type Int_8 is new Interfaces.Integer_8; + type Int_8_Array is array (Positive range <>) of Int_8; + + type UInt_8 is new Interfaces.Unsigned_8; + type UInt_8_Array is array (Positive range <>) of UInt_8; + + + type Frame_Amount is new Interfaces.Unsigned_32; + + + type Buffer is tagged private; + + function Kind + (Store : in Buffer) + return Sample_Format; + + function Channels + (Store : in Buffer) + return Natural; + + function Frames + (Store : in Buffer) + return Frame_Amount; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Float_32 + with Pre => Store.Kind = Float_32_Format; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_32 + with Pre => Store.Kind = Int_32_Format; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_24 + with Pre => Store.Kind = Int_24_Format; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_16 + with Pre => Store.Kind = Int_16_Format; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return Int_8 + with Pre => Store.Kind = Int_8_Format; + + function Get + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive) + return UInt_8 + with Pre => Store.Kind = UInt_8_Format; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Float_32) + with Pre => Store.Kind = Float_32_Format; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_32) + with Pre => Store.Kind = Int_32_Format; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_24) + with Pre => Store.Kind = Int_24_Format; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_16) + with Pre => Store.Kind = Int_16_Format; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in Int_8) + with Pre => Store.Kind = Int_8_Format; + + procedure Put + (Store : in Buffer; + Frame : in Frame_Amount; + Channel : in Positive; + Value : in UInt_8) + with Pre => Store.Kind = UInt_8_Format; + + function Wrap + (Store : access Float_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_32_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_24_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_16_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access Int_8_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + function Wrap + (Store : access UInt_8_Array; + Frames : in Frame_Amount; + Channels : in Natural) + return Buffer + with Pre => Store.all'Length = Frames * Frame_Amount (Channels); + + + type Parameters is private; + + function Create + (Device : in Device_Index; + Channels : in Natural; + Format : in Sample_Format; + Latency : in Time) + return Parameters + with Pre => Device /= No_Device; + + + type Stream_Flags is private; + + function "+" + (A, B : in Stream_Flags) + return Stream_Flags; + + -- No flags + No_Flag : constant Stream_Flags; + + -- Disable default clipping + Clip_Off_Flag : constant Stream_Flags; + + -- Disable default dithering + Dither_Off_Flag : constant Stream_Flags; + + -- Never drop input + Never_Drop_Flag : constant Stream_Flags; + + -- Prime output buffers using stream callback + Prime_Output_Flag : constant Stream_Flags; + + + type Audio_Stream is tagged limited private; + + + type Stream_Info is record + Input_Latency : Time; + Output_Latency : Time; + Sample_Rate : Hertz; + end record; + + + type Callback_Result is (Continue, Complete, Finish); + + + type Time_Info is record + Input_ADC : Time; + Current : Time; + Output_DAC : Time; + end record; + + + type Callback_Flags is record + Input_Underflow : Boolean; + Input_Overflow : Boolean; + Output_Underflow : Boolean; + Output_Overflow : Boolean; + Priming_Output : Boolean; + end record; + + + -- Due to how void pointers are wrapped into Buffers, + -- the Output here is given as 'in' mode, but you can + -- still write to it just fine using the Put subprograms + type Callback_Function is access function + (Input : in Buffer; + Output : in Buffer; + Frames : in Frame_Amount; + Timing : in Time_Info; + Bunting : in Callback_Flags) + return Callback_Result; + + + + + --------------- + -- Utility -- + --------------- + + function Is_Open + (Stream : in Audio_Stream) + return Boolean; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Is_Format_Supported + (Input : access Parameters; + Output : access Parameters; + Rate : in Hertz) + return Boolean; + + procedure Open_Input + (Stream : in out Audio_Stream; + Input_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : in Stream_Flags; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Output + (Stream : in out Audio_Stream; + Output_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : in Stream_Flags; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Full + (Stream : in out Audio_Stream; + Input_Params : in Parameters; + Output_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : in Stream_Flags; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Input_Blocking + (Stream : in out Audio_Stream; + Input_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : in Stream_Flags) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Output_Blocking + (Stream : in out Audio_Stream; + Output_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : in Stream_Flags) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Full_Blocking + (Stream : in out Audio_Stream; + Input_Params : in Parameters; + Output_Params : in Parameters; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Bunting : in Stream_Flags) + with Pre => not Stream.Is_Open, + Post => Stream.Is_Open; + + procedure Open_Default + (Stream : in out Audio_Stream; + Input_Channels : in Natural; + Output_Channels : in Natural; + Format : in Sample_Format; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount; + Callback : in Callback_Function) + with Pre => not Stream.Is_Open and + (Input_Channels > 0 or Output_Channels > 0), + Post => Stream.Is_Open; + + procedure Open_Default_Blocking + (Stream : in out Audio_Stream; + Input_Channels : in Natural; + Output_Channels : in Natural; + Format : in Sample_Format; + Sample_Rate : in Hertz; + Buffer_Frames : in Frame_Amount) + with Pre => not Stream.Is_Open and + (Input_Channels > 0 or Output_Channels > 0), + Post => Stream.Is_Open; + + procedure Close + (Stream : in out Audio_Stream) + with Pre => Stream.Is_Open, + Post => not Stream.Is_Open; + + procedure Start + (Stream : in Audio_Stream) + with Pre => Stream.Is_Open; + + procedure Stop + (Stream : in Audio_Stream) + with Pre => Stream.Is_Open; + + procedure Term + (Stream : in Audio_Stream) + with Pre => Stream.Is_Open; + + function Is_Stopped + (Stream : in Audio_Stream) + return Boolean + with Pre => Stream.Is_Open; + + function Is_Active + (Stream : in Audio_Stream) + return Boolean + with Pre => Stream.Is_Open; + + function Get_Info + (Stream : in Audio_Stream) + return Stream_Info + with Pre => Stream.Is_Open; + + function Get_Time + (Stream : in Audio_Stream) + return Time + with Pre => Stream.Is_Open; + + function Get_CPU_Load + (Stream : in Audio_Stream) + return Load + with Pre => Stream.Is_Open; + + procedure Read_Blocking + (Stream : in Audio_Stream; + Store : in Buffer'Class; + Frames : in Frame_Amount) + with Pre => Stream.Is_Open and then Stream.Is_Active; + + procedure Write_Blocking + (Stream : in Audio_Stream; + Store : in Buffer'Class; + Frames : in Frame_Amount) + with Pre => Stream.Is_Open and then Stream.Is_Active; + + function Get_Read_Available + (Stream : in Audio_Stream) + return Frame_Amount + with Pre => Stream.Is_Open and then Stream.Is_Active; + + function Get_Write_Available + (Stream : in Audio_Stream) + return Frame_Amount + with Pre => Stream.Is_Open and then Stream.Is_Active; + + function Get_Sample_Size + (Format : in Sample_Format) + return Positive; + + +private + + + pragma Convention (C, Float_32_Array); + pragma Convention (C, Int_32_Array); + pragma Convention (C, Int_24_Array); + pragma Convention (C, Int_16_Array); + pragma Convention (C, Int_8_Array); + pragma Convention (C, UInt_8_Array); + + + type Buffer is tagged record + My_Sam_Code : Interfaces.C.unsigned_long; + My_Channels : Natural; + My_Frames : Frame_Amount; + My_Array : System.Address; + end record; + + + type Parameters is record + My_Device : Interfaces.C.int; + My_Channels : Interfaces.C.int; + My_Samples : Interfaces.C.unsigned_long; + My_Latency : Interfaces.C.double; + My_Specific : System.Address; + end record with Convention => C; + + + type Stream_Flags is new Interfaces.C.unsigned_long; + + No_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_no_flag"; + + Clip_Off_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_clip_off"; + + Dither_Off_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_dither_off"; + + Never_Drop_Flag : constant Stream_Flags + with Import => True, Convention => C, External_Name => "pa_never_drop_input"; + + Prime_Output_Flag : constant Stream_Flags + with Import => True, Convention => C, + External_Name => "pa_prime_output_buffers_using_stream_callback"; + + + type Audio_Stream is tagged limited record + Ptr : System.Address; + Open : Boolean := False; + Func : Callback_Function; + Chin : Interfaces.C.int := 0; + Chout : Interfaces.C.int := 0; + Sin : Interfaces.C.unsigned_long := 0; + Sout : Interfaces.C.unsigned_long := 0; + end record; + + + type C_Stream_Info is record + My_Struct_Version : Interfaces.C.int; + My_Input_Latency : Interfaces.C.double; + My_Output_Latency : Interfaces.C.double; + My_Sample_Rate : Interfaces.C.double; + end record with Convention => C; + + + type C_Callback_Time_Info is record + My_Input_ADC : Interfaces.C.double; + My_Current : Interfaces.C.double; + My_Output_DAC : Interfaces.C.double; + end record with Convention => C; + + + function To_For_Sam + (Num : in Interfaces.C.unsigned_long) + return Sample_Format; + + function To_Cnum + (Format : in Sample_Format) + return Interfaces.C.unsigned_long; + + function To_Cint + (Ret_Value : in Callback_Result) + return Interfaces.C.int; + + +end Portaudio.Streams; + + 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; - diff --git a/src/portaudio.ads b/src/portaudio.ads index bc07a44..2744047 100644 --- a/src/portaudio.ads +++ b/src/portaudio.ads @@ -4,9 +4,8 @@ -- Released into the public domain -with +pragma Ada_2012; - Interfaces; private with @@ -18,9 +17,9 @@ private with package Portaudio is - ----------------------- + --------------------------------- -- Data Types and Structures -- - ----------------------- + --------------------------------- type Version_Number is record Major : Natural; @@ -77,37 +76,14 @@ package Portaudio is Audio_Science_HPI_Host, Sndio_Host); + type Host_API_Index is new Positive; type Device_Index is new Natural; - No_Device : constant Device_Index; - type Host_API_Info is tagged private; - - function Kind - (Info : in Host_API_Info) - return Host_API_Kind; - - function Name - (Info : in Host_API_Info) - return String; - - function Device_Count - (Info : in Host_API_Info) - return Natural; - - function Default_Input_Device - (Info : in Host_API_Info) - return Device_Index; - - function Default_Output_Device - (Info : in Host_API_Info) - return Device_Index; - - type Time is delta 10.0**(-4) digits 12; function Image @@ -131,324 +107,6 @@ package Portaudio is return String; - type Device_Info is tagged private; - - function Name - (Info : in Device_Info) - return String; - - function Host_API - (Info : in Device_Info) - return Host_API_Index; - - function Max_Input_Channels - (Info : in Device_Info) - return Natural; - - function Max_Output_Channels - (Info : in Device_Info) - return Natural; - - function Default_Low_Input_Latency - (Info : in Device_Info) - return Time; - - function Default_Low_Output_Latency - (Info : in Device_Info) - return Time; - - function Default_High_Input_Latency - (Info : in Device_Info) - return Time; - - function Default_High_Output_Latency - (Info : in Device_Info) - return Time; - - function Default_Sample_Rate - (Info : in Device_Info) - return Hertz; - - - type Sample_Format is - (Float_32_Sample, - Int_32_Sample, - Int_24_Sample, - Int_16_Sample, - Int_8_Sample, - UInt_8_Sample); - - - type Float_32 is new Float; - for Float_32'Size use 32; - type Float_32_Array is array (Positive range <>) of Float_32; - - type Int_32 is new Interfaces.Integer_32; - type Int_32_Array is array (Positive range <>) of Int_32; - - type Int_24 is range -2 ** 23 .. 2 ** 23 - 1; - for Int_24'Size use 24; - type Int_24_Array is array (Positive range <>) of Int_24; - - type Int_16 is new Interfaces.Integer_16; - type Int_16_Array is array (Positive range <>) of Int_16; - - type Int_8 is new Interfaces.Integer_8; - type Int_8_Array is array (Positive range <>) of Int_8; - - type UInt_8 is new Interfaces.Unsigned_8; - type UInt_8_Array is array (Positive range <>) of UInt_8; - - - type Frame_Amount is new Interfaces.Unsigned_32; - - - type Sample_Buffer is tagged private; - - function Kind - (Buffer : in Sample_Buffer) - return Sample_Format; - - function Channels - (Buffer : in Sample_Buffer) - return Natural; - - function Frames - (Buffer : in Sample_Buffer) - return Frame_Amount; - - function Get - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive) - return Float_32 - with Pre => Buffer.Kind = Float_32_Sample; - - function Get - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive) - return Int_32 - with Pre => Buffer.Kind = Int_32_Sample; - - function Get - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive) - return Int_24 - with Pre => Buffer.Kind = Int_24_Sample; - - function Get - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive) - return Int_16 - with Pre => Buffer.Kind = Int_16_Sample; - - function Get - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive) - return Int_8 - with Pre => Buffer.Kind = Int_8_Sample; - - function Get - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive) - return UInt_8 - with Pre => Buffer.Kind = UInt_8_Sample; - - procedure Put - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive; - Value : in Float_32) - with Pre => Buffer.Kind = Float_32_Sample; - - procedure Put - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive; - Value : in Int_32) - with Pre => Buffer.Kind = Int_32_Sample; - - procedure Put - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive; - Value : in Int_24) - with Pre => Buffer.Kind = Int_24_Sample; - - procedure Put - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive; - Value : in Int_16) - with Pre => Buffer.Kind = Int_16_Sample; - - procedure Put - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive; - Value : in Int_8) - with Pre => Buffer.Kind = Int_8_Sample; - - procedure Put - (Buffer : in Sample_Buffer; - Frame : in Frame_Amount; - Channel : in Positive; - Value : in UInt_8) - with Pre => Buffer.Kind = UInt_8_Sample; - - - function Wrap - (Store : access Float_32_Array; - Frames : in Frame_Amount; - Channels : in Natural) - return Sample_Buffer - with Pre => Store.all'Length = Frames * Frame_Amount (Channels); - - function Wrap - (Store : access Int_32_Array; - Frames : in Frame_Amount; - Channels : in Natural) - return Sample_Buffer - with Pre => Store.all'Length = Frames * Frame_Amount (Channels); - - function Wrap - (Store : access Int_24_Array; - Frames : in Frame_Amount; - Channels : in Natural) - return Sample_Buffer - with Pre => Store.all'Length = Frames * Frame_Amount (Channels); - - function Wrap - (Store : access Int_16_Array; - Frames : in Frame_Amount; - Channels : in Natural) - return Sample_Buffer - with Pre => Store.all'Length = Frames * Frame_Amount (Channels); - - function Wrap - (Store : access Int_8_Array; - Frames : in Frame_Amount; - Channels : in Natural) - return Sample_Buffer - with Pre => Store.all'Length = Frames * Frame_Amount (Channels); - - function Wrap - (Store : access UInt_8_Array; - Frames : in Frame_Amount; - Channels : in Natural) - return Sample_Buffer - with Pre => Store.all'Length = Frames * Frame_Amount (Channels); - - - type Stream_Parameters is private; - - function Create - (Device : in Device_Index; - Channels : in Natural; - Format : in Sample_Format; - Latency : in Time) - return Stream_Parameters - with Pre => Device /= No_Device; - - - type Stream_Flags is private; - - function "+" - (A, B : in Stream_Flags) - return Stream_Flags; - - -- No flags - No_Flag : constant Stream_Flags; - - -- Disable default clipping - Clip_Off_Flag : constant Stream_Flags; - - -- Disable default dithering - Dither_Off_Flag : constant Stream_Flags; - - -- Never drop input - Never_Drop_Flag : constant Stream_Flags; - - -- Prime output buffers using stream callback - Prime_Output_Flag : constant Stream_Flags; - - - type Audio_Stream is tagged limited private; - - - type Stream_Info is tagged private; - - function Input_Latency - (Info : in Stream_Info) - return Time; - - function Output_Latency - (Info : in Stream_Info) - return Time; - - function Sample_Rate - (Info : in Stream_Info) - return Hertz; - - - type Callback_Result is (Continue, Complete, Finish); - - - type Callback_Time_Info is tagged private; - - function Input_ADC_Time - (Info : in Callback_Time_Info) - return Time; - - function Current_Time - (Info : in Callback_Time_Info) - return Time; - - function Output_DAC_Time - (Info : in Callback_Time_Info) - return Time; - - - type Callback_Flags is private; - - function Has_Input_Underflow - (Flags : in Callback_Flags) - return Boolean; - - function Has_Input_Overflow - (Flags : in Callback_Flags) - return Boolean; - - function Has_Output_Underflow - (Flags : in Callback_Flags) - return Boolean; - - function Has_Output_Overflow - (Flags : in Callback_Flags) - return Boolean; - - function Has_Priming_Output - (Flags : in Callback_Flags) - return Boolean; - - - -- Due to how void pointers are wrapped into Sample_Buffers - -- the Output here is given as 'in' mode, but you can still - -- write to it just fine using the Put subprograms - type Callback_Function is access function - (Input : in Sample_Buffer; - Output : in Sample_Buffer; - Frames : in Frame_Amount; - Timing : in Callback_Time_Info; - Flags : in Callback_Flags) - return Callback_Result; - - ------------------ @@ -518,20 +176,9 @@ package Portaudio is - --------------- - -- Utility -- - --------------- - - function Is_Open - (Stream : in Audio_Stream) - return Boolean; - - - - - ------------------------------- - -- Auxiliary API Interface -- - ------------------------------- + ----------------------- + -- API Subprograms -- + ----------------------- function Get_Version return Version_Number; @@ -539,211 +186,6 @@ package Portaudio is function Get_Version_Info return Version_Info; - function Get_Host_API_Count - return Natural; - - function Get_Default_Host_API - return Host_API_Index - with Post => Get_Default_Host_API'Result in - Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); - - function Get_Host_API_Info - (Index : in Host_API_Index) - return Host_API_Info - with Pre => Index in Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); - - function To_Host_API_Index - (Kind : in Host_API_Kind) - return Host_API_Index - with Post => To_Host_API_Index'Result in - Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count); - - function To_Device_Index - (Host_API : in Host_API_Index; - Host_Device : in Positive) - return Device_Index - with Pre => Host_API in Host_API_Index (1) .. Host_API_Index (Get_Host_API_Count) and - Host_Device in 1 .. Get_Host_API_Info (Host_API).Device_Count, - Post => To_Device_Index'Result in - Device_Index (1) .. Device_Index (Get_Device_Count); - - function Get_Device_Count - return Natural; - - function Get_Default_Input_Device - return Device_Index; - - function Get_Default_Output_Device - return Device_Index; - - function Get_Device_Info - (Index : in Device_Index) - return Device_Info - with Pre => Index in Device_Index (1) .. Device_Index (Get_Device_Count); - - function Is_Format_Supported - (Input : access Stream_Parameters; - Output : access Stream_Parameters; - Rate : in Hertz) - return Boolean; - - function Get_Sample_Size - (Format : in Sample_Format) - return Positive; - - - - - ---------------------------- - -- Stream API Interface -- - ---------------------------- - - procedure Open_Input - (Stream : in out Audio_Stream; - Input_Params : in Stream_Parameters; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Flags : in Stream_Flags; - Callback : in Callback_Function) - with Pre => not Stream.Is_Open, - Post => Stream.Is_Open; - - procedure Open_Output - (Stream : in out Audio_Stream; - Output_Params : in Stream_Parameters; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Flags : in Stream_Flags; - Callback : in Callback_Function) - with Pre => not Stream.Is_Open, - Post => Stream.Is_Open; - - procedure Open_Full - (Stream : in out Audio_Stream; - Input_Params : in Stream_Parameters; - Output_Params : in Stream_Parameters; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Flags : in Stream_Flags; - Callback : in Callback_Function) - with Pre => not Stream.Is_Open, - Post => Stream.Is_Open; - - procedure Open_Input_Blocking - (Stream : in out Audio_Stream; - Input_Params : in Stream_Parameters; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Flags : in Stream_Flags) - with Pre => not Stream.Is_Open, - Post => Stream.Is_Open; - - procedure Open_Output_Blocking - (Stream : in out Audio_Stream; - Output_Params : in Stream_Parameters; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Flags : in Stream_Flags) - with Pre => not Stream.Is_Open, - Post => Stream.Is_Open; - - procedure Open_Full_Blocking - (Stream : in out Audio_Stream; - Input_Params : in Stream_Parameters; - Output_Params : in Stream_Parameters; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Flags : in Stream_Flags) - with Pre => not Stream.Is_Open, - Post => Stream.Is_Open; - - procedure Open_Default - (Stream : in out Audio_Stream; - Input_Channels : in Natural; - Output_Channels : in Natural; - Format : in Sample_Format; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount; - Callback : in Callback_Function) - with Pre => not Stream.Is_Open and - (Input_Channels > 0 or Output_Channels > 0), - Post => Stream.Is_Open; - - procedure Open_Default_Blocking - (Stream : in out Audio_Stream; - Input_Channels : in Natural; - Output_Channels : in Natural; - Format : in Sample_Format; - Sample_Rate : in Hertz; - Buffer_Frames : in Frame_Amount) - with Pre => not Stream.Is_Open and - (Input_Channels > 0 or Output_Channels > 0), - Post => Stream.Is_Open; - - procedure Close - (Stream : in out Audio_Stream) - with Pre => Stream.Is_Open, - Post => not Stream.Is_Open; - - procedure Start - (Stream : in Audio_Stream) - with Pre => Stream.Is_Open; - - procedure Stop - (Stream : in Audio_Stream) - with Pre => Stream.Is_Open; - - procedure Term - (Stream : in Audio_Stream) - with Pre => Stream.Is_Open; - - function Is_Stopped - (Stream : in Audio_Stream) - return Boolean - with Pre => Stream.Is_Open; - - function Is_Active - (Stream : in Audio_Stream) - return Boolean - with Pre => Stream.Is_Open; - - function Get_Info - (Stream : in Audio_Stream) - return Stream_Info'Class - with Pre => Stream.Is_Open; - - function Get_Time - (Stream : in Audio_Stream) - return Time - with Pre => Stream.Is_Open; - - function Get_CPU_Load - (Stream : in Audio_Stream) - return Load - with Pre => Stream.Is_Open; - - procedure Read_Blocking - (Stream : in Audio_Stream; - Buffer : in Sample_Buffer'Class; - Frames : in Frame_Amount) - with Pre => Stream.Is_Open and then Stream.Is_Active; - - procedure Write_Blocking - (Stream : in Audio_Stream; - Buffer : in Sample_Buffer'Class; - Frames : in Frame_Amount) - with Pre => Stream.Is_Open and then Stream.Is_Active; - - function Get_Read_Available - (Stream : in Audio_Stream) - return Frame_Amount - with Pre => Stream.Is_Open and then Stream.Is_Active; - - function Get_Write_Available - (Stream : in Audio_Stream) - return Frame_Amount - with Pre => Stream.Is_Open and then Stream.Is_Active; - private @@ -751,8 +193,6 @@ private pragma Linker_Options ("-lportaudio"); - - type C_Version_Info is record My_Major : Interfaces.C.int; My_Minor : Interfaces.C.int; @@ -773,123 +213,11 @@ private end record with Convention => C; - type C_Host_API_Info is record - My_Struct_Version : Interfaces.C.int; - My_Host_API_Type : Interfaces.C.int; - My_Name : Interfaces.C.Strings.chars_ptr; - My_Device_Count : Interfaces.C.int; - My_Default_Input : Interfaces.C.int; - My_Default_Output : Interfaces.C.int; - end record with Convention => C; - - type Host_API_Info is tagged record - Ptr : System.Address; - end record; - - - type C_Device_Info is record - My_Struct_Version : Interfaces.C.int; - My_Name : Interfaces.C.Strings.chars_ptr; - My_Host_API_Index : Interfaces.C.int; - My_Input_Channels : Interfaces.C.int; - My_Output_Channels : Interfaces.C.int; - My_Low_Input_Latency : Interfaces.C.double; - My_Low_Output_Latency : Interfaces.C.double; - My_High_Input_Latency : Interfaces.C.double; - My_High_Output_Latency : Interfaces.C.double; - My_Sample_Rate : Interfaces.C.double; - end record with Convention => C; - - type Device_Info is tagged record - Ptr : System.Address; - end record; - - - pragma Convention (C, Float_32_Array); - pragma Convention (C, Int_32_Array); - pragma Convention (C, Int_24_Array); - pragma Convention (C, Int_16_Array); - pragma Convention (C, Int_8_Array); - pragma Convention (C, UInt_8_Array); - - type Sample_Buffer is tagged record - My_Sam_Code : Interfaces.C.unsigned_long; - My_Channels : Natural; - My_Frames : Frame_Amount; - My_Array : System.Address; - end record; - - - type Stream_Parameters is record - My_Device : Interfaces.C.int; - My_Channels : Interfaces.C.int; - My_Samples : Interfaces.C.unsigned_long; - My_Latency : Interfaces.C.double; - My_Specific : System.Address; - end record with Convention => C; - - - type Stream_Flags is new Interfaces.C.unsigned_long; - - No_Flag : constant Stream_Flags - with Import => True, Convention => C, External_Name => "pa_no_flag"; - - Clip_Off_Flag : constant Stream_Flags - with Import => True, Convention => C, External_Name => "pa_clip_off"; - - Dither_Off_Flag : constant Stream_Flags - with Import => True, Convention => C, External_Name => "pa_dither_off"; - - Never_Drop_Flag : constant Stream_Flags - with Import => True, Convention => C, External_Name => "pa_never_drop_input"; - - Prime_Output_Flag : constant Stream_Flags - with Import => True, Convention => C, - External_Name => "pa_prime_output_buffers_using_stream_callback"; - - - type Audio_Stream is tagged limited record - Ptr : System.Address; - Open : Boolean := False; - Func : Callback_Function; - Chin : Interfaces.C.int := 0; - Chout : Interfaces.C.int := 0; - Sin : Interfaces.C.unsigned_long := 0; - Sout : Interfaces.C.unsigned_long := 0; - end record; - - - type C_Stream_Info is record - My_Struct_Version : Interfaces.C.int; - My_Input_Latency : Interfaces.C.double; - My_Output_Latency : Interfaces.C.double; - My_Sample_Rate : Interfaces.C.double; - end record with Convention => C; - - type Stream_Info is tagged record - Ptr : System.Address; - end record; - - - type C_Callback_Time_Info is record - My_Input_ADC : Interfaces.C.double; - My_Current : Interfaces.C.double; - My_Output_DAC : Interfaces.C.double; - end record with Convention => C; - - type Callback_Time_Info is tagged record - Ptr : System.Address; - end record; - - - type Callback_Flags is new Interfaces.C.unsigned_long; - - - - No_Device : constant Device_Index := 0; + pa_no_error : constant Interfaces.C.int; + pragma Import (C, pa_no_error, "pa_no_error"); procedure Raise_Error @@ -903,23 +231,8 @@ private (Ident : in Host_API_Kind) return Interfaces.C.int; - function To_For_Sam - (Num : in Interfaces.C.unsigned_long) - return Sample_Format; - - function To_Cnum - (Form : in Sample_Format) - return Interfaces.C.unsigned_long; - - function To_Cint - (Result : in Callback_Result) - return Interfaces.C.int; - - - -- The clunky way of ensuring that PortAudio is always shut down properly - type Final_Controller is new Ada.Finalization.Controlled with null record; overriding procedure Finalize |