From 17ed86acaee20590b3ef4d1eea10f2fd27bd3350 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 17 Jul 2023 00:59:56 +1200 Subject: Split binding into a minimal hierarchy, improved documentation slightly --- src/portaudio-streams.adb | 1079 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1079 insertions(+) create mode 100644 src/portaudio-streams.adb (limited to 'src/portaudio-streams.adb') 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; + + -- cgit