-- Programmed by Jedidiah Barber -- Released into the public domain with Interfaces; private with Ada.Finalization, Interfaces.C.Strings, System; package Portaudio is ----------------------- -- Data Types and Structures -- ----------------------- type Version_Number is record Major : Natural; Minor : Natural; Subminor : Natural; end record; function "<" (A, B : in Version_Number) return Boolean; function Image (Num : in Version_Number) return String; type Version_Info is tagged private; function Major (Version : in Version_Info) return Natural; function Minor (Version : in Version_Info) return Natural; function Subminor (Version : in Version_Info) return Natural; function Revision (Version : in Version_Info) return String; function Text (Version : in Version_Info) return String; type Host_API_Kind is (In_Development, Direct_Sound_Host, MME_Host, ASIO_Host, Sound_Manager_Host, Core_Audio_Host, OSS_Host, ALSA_Host, AL_Host, BeOS_Host, WDMKS_Host, JACK_Host, WASAPI_Host, 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 (Num : in Time) return String; subtype Hertz is Long_Float with Static_Predicate => Hertz >= 0.0; function Hertz_Image (Num : in Hertz) return String; subtype Load is Long_Float with Static_Predicate => Load >= 0.0; function Load_Image (Num : in Load) 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; ------------------ -- Exceptions -- ------------------ Not_Initialized_Error : exception; Unanticipated_Host_Error : exception; Invalid_Channel_Count_Error : exception; Invalid_Sample_Rate_Error : exception; Invalid_Device_Error : exception; Invalid_Flag_Error : exception; Sample_Format_Not_Supported_Error : exception; Bad_IO_Device_Combination_Error : exception; Buffer_Too_Big_Error : exception; Buffer_Too_Small_Error : exception; Null_Callback_Error : exception; Bad_Stream_Pointer_Error : exception; Timed_Out_Error : exception; Internal_Error : exception; Device_Unavailable_Error : exception; Incompatible_Host_API_Specific_Stream_Info_Error : exception; Stream_Is_Stopped_Error : exception; Stream_Is_Not_Stopped_Error : exception; Input_Overflowed_Error : exception; Output_Underflowed_Error : exception; Host_API_Not_Found_Error : exception; Invalid_Host_API_Error : exception; Can_Not_Read_From_A_Callback_Stream_Error : exception; Can_Not_Write_To_A_Callback_Stream_Error : exception; Can_Not_Read_From_An_Output_Only_Stream_Error : exception; Can_Not_Write_To_An_Input_Only_Stream_Error : exception; Incompatible_Stream_Host_API_Error : exception; Bad_Buffer_Pointer_Error : exception; Can_Not_Initialize_Recursively_Error : exception; General_Failure : exception; --------------- -- Utility -- --------------- function Is_Open (Stream : in Audio_Stream) return Boolean; ------------------------------- -- Auxiliary API Interface -- ------------------------------- function Get_Version return Version_Number; 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 pragma Linker_Options ("-lportaudio"); type C_Version_Info is record My_Major : Interfaces.C.int; My_Minor : Interfaces.C.int; My_Subminor : Interfaces.C.int; My_Revision : Interfaces.C.Strings.chars_ptr; My_Text : Interfaces.C.Strings.chars_ptr; end record with Convention => C; type Version_Info is tagged record Ptr : System.Address; end record; type C_Host_Error_Info is record My_Host_API_Type : Interfaces.C.int; My_Error_Code : Interfaces.C.long; My_Error_Text : Interfaces.C.Strings.chars_ptr; 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; procedure Raise_Error (Num : in Interfaces.C.int); function To_Hat_Kind (Num : in Interfaces.C.int) return Host_API_Kind; function To_Cint (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 (This : in out Final_Controller); Cleanup : Final_Controller; end Portaudio;