path: root/src/portaudio.ads

--  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;