-- 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 Storage.Integer_Address; Output : in Storage.Integer_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 Storage.Integer_Address; In_Params : in Storage.Integer_Address; Out_Params : in Storage.Integer_Address; Rate : in Interfaces.C.double; Frames : in Interfaces.C.unsigned_long; Flags : in Interfaces.C.unsigned_long; Callback : in Storage.Integer_Address; Userdata : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_open_stream, "Pa_OpenStream"); function pa_open_default_stream (Stream : in out Storage.Integer_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 Storage.Integer_Address; Userdata : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_open_default_stream, "Pa_OpenDefaultStream"); function pa_close_stream (Stream : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_close_stream, "Pa_CloseStream"); function pa_set_stream_finished_callback (Stream : in Storage.Integer_Address; Callback : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_set_stream_finished_callback, "Pa_SetStreamFinishedCallback"); function pa_start_stream (Stream : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_start_stream, "Pa_StartStream"); function pa_stop_stream (Stream : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_stop_stream, "Pa_StopStream"); function pa_abort_stream (Stream : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_abort_stream, "Pa_AbortStream"); function pa_is_stream_stopped (Stream : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_is_stream_stopped, "Pa_IsStreamStopped"); function pa_is_stream_active (Stream : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, pa_is_stream_active, "Pa_IsStreamActive"); function pa_get_stream_info (Stream : in Storage.Integer_Address) return Storage.Integer_Address; pragma Import (C, pa_get_stream_info, "Pa_GetStreamInfo"); function pa_get_stream_time (Stream : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, pa_get_stream_time, "Pa_GetStreamTime"); function pa_get_stream_cpu_load (Stream : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, pa_get_stream_cpu_load, "Pa_GetStreamCpuLoad"); function pa_read_stream (Stream : in Storage.Integer_Address; Buffer : in Storage.Integer_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 Storage.Integer_Address; Buffer : in Storage.Integer_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 Storage.Integer_Address) return Interfaces.C.long; pragma Import (C, pa_get_stream_read_available, "Pa_GetStreamReadAvailable"); function pa_get_stream_write_available (Stream : in Storage.Integer_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.Callfun (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; procedure Stream_Finished_Callback_Hook (Userdata : in System.Address) is Stream_Actual : Audio_Stream; for Stream_Actual'Address use Userdata; pragma Import (Ada, Stream_Actual); begin Stream_Actual.Finfun.all; end Stream_Finished_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 Interfaces.IEEE_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 Interfaces.Integer_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 Integer_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 Interfaces.Integer_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 Interfaces.Integer_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 Interfaces.Unsigned_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 Interfaces.IEEE_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 Interfaces.Integer_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 Integer_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 Interfaces.Integer_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 Interfaces.Integer_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 Interfaces.Unsigned_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 : aliased in 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'Address); end Wrap; function Wrap (Store : aliased in 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'Address); end Wrap; function Wrap (Store : aliased in 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'Address); end Wrap; function Wrap (Store : aliased in 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'Address); end Wrap; function Wrap (Store : aliased in 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'Address); end Wrap; function Wrap (Store : aliased in 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'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 => Null_Pointer); 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 (Storage.To_Integer (Input_Address), Storage.To_Integer (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 not null Callback_Function) is Code : Interfaces.C.int; begin Code := pa_open_stream (Stream.Ptr, Storage.To_Integer (Input_Params'Address), Null_Pointer, Interfaces.C.double (Sample_Rate), Interfaces.C.unsigned_long (Buffer_Frames), Interfaces.C.unsigned_long (Bunting), Storage.To_Integer (Stream_Callback_Hook'Address), Storage.To_Integer (Stream'Address)); if Code /= pa_no_error then Raise_Error (Code); raise Program_Error; else Stream.Open := True; Stream.Callfun := Callback; Stream.Chin := Input_Params.My_Channels; Stream.Sin := Input_Params.My_Samples; 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 not null Callback_Function) is Code : Interfaces.C.int; begin Code := pa_open_stream (Stream.Ptr, Null_Pointer, Storage.To_Integer (Output_Params'Address), Interfaces.C.double (Sample_Rate), Interfaces.C.unsigned_long (Buffer_Frames), Interfaces.C.unsigned_long (Bunting), Storage.To_Integer (Stream_Callback_Hook'Address), Storage.To_Integer (Stream'Address)); if Code /= pa_no_error then Raise_Error (Code); raise Program_Error; else Stream.Open := True; Stream.Callfun := Callback; Stream.Chout := Output_Params.My_Channels; 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 not null Callback_Function) is Code : Interfaces.C.int; begin Code := pa_open_stream (Stream.Ptr, Storage.To_Integer (Input_Params'Address), Storage.To_Integer (Output_Params'Address), Interfaces.C.double (Sample_Rate), Interfaces.C.unsigned_long (Buffer_Frames), Interfaces.C.unsigned_long (Bunting), Storage.To_Integer (Stream_Callback_Hook'Address), Storage.To_Integer (Stream'Address)); if Code /= pa_no_error then Raise_Error (Code); raise Program_Error; else Stream.Open := True; Stream.Callfun := 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, Storage.To_Integer (Input_Params'Address), Null_Pointer, Interfaces.C.double (Sample_Rate), Interfaces.C.unsigned_long (Buffer_Frames), Interfaces.C.unsigned_long (Bunting), Null_Pointer, Null_Pointer); 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, Null_Pointer, Storage.To_Integer (Output_Params'Address), Interfaces.C.double (Sample_Rate), Interfaces.C.unsigned_long (Buffer_Frames), Interfaces.C.unsigned_long (Bunting), Null_Pointer, Null_Pointer); 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, Storage.To_Integer (Input_Params'Address), Storage.To_Integer (Output_Params'Address), Interfaces.C.double (Sample_Rate), Interfaces.C.unsigned_long (Buffer_Frames), Interfaces.C.unsigned_long (Bunting), Null_Pointer, Null_Pointer); 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 not null 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), Storage.To_Integer (Stream_Callback_Hook'Address), Storage.To_Integer (Stream'Address)); if Code /= pa_no_error then Raise_Error (Code); raise Program_Error; else Stream.Open := True; Stream.Callfun := 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), Null_Pointer, Null_Pointer); 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 Set_Finished_Callback (Stream : in out Audio_Stream; Callback : in not null Stream_Finished_Function) is Code : Interfaces.C.int; begin Stream.Finfun := Callback; Code := pa_set_stream_finished_callback (Stream.Ptr, Storage.To_Integer (Stream_Finished_Callback_Hook'Address)); if Code /= pa_no_error then Raise_Error (Code); raise Program_Error; end if; end Set_Finished_Callback; procedure Clear_Finished_Callback (Stream : in out Audio_Stream) is Code : Interfaces.C.int; begin Code := pa_set_stream_finished_callback (Stream.Ptr, Null_Pointer); if Code /= pa_no_error then Raise_Error (Code); raise Program_Error; end if; end Clear_Finished_Callback; 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 : Storage.Integer_Address; begin Result := pa_get_stream_info (Stream.Ptr); if Result = Null_Pointer then raise General_Failure; else declare C_Data : C_Stream_Info; for C_Data'Address use Storage.To_Address (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, Storage.To_Integer (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, Storage.To_Integer (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;