From 543cd19ab514ec632d965acd5177c5bf6695520f Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sat, 15 Jul 2023 20:18:26 +1200 Subject: Initial commit --- src/portaudio.ads | 933 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 933 insertions(+) create mode 100644 src/portaudio.ads (limited to 'src/portaudio.ads') diff --git a/src/portaudio.ads b/src/portaudio.ads new file mode 100644 index 0000000..bc07a44 --- /dev/null +++ b/src/portaudio.ads @@ -0,0 +1,933 @@ + + +-- 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; + + -- cgit