path: root/src/libsndfile-commands.adb

--  Programmed by Jedidiah Barber
--  Released into the public domain


with

    Ada.Assertions,
    Ada.Strings.Fixed,
    Interfaces.C.Strings,
    System;

use type

    Interfaces.C.int,
    Interfaces.Unsigned_32;


package body Libsndfile.Commands is


    ------------------------
    --  Constants From C  --
    ------------------------

    sfc_get_lib_version : constant Interfaces.C.int;
    pragma Import (C, sfc_get_lib_version, "sfc_get_lib_version");

    sfc_get_log_info : constant Interfaces.C.int;
    pragma Import (C, sfc_get_log_info, "sfc_get_log_info");

    sfc_calc_signal_max : constant Interfaces.C.int;
    pragma Import (C, sfc_calc_signal_max, "sfc_calc_signal_max");

    sfc_calc_norm_signal_max : constant Interfaces.C.int;
    pragma Import (C, sfc_calc_norm_signal_max, "sfc_calc_norm_signal_max");

    sfc_calc_max_all_channels : constant Interfaces.C.int;
    pragma Import (C, sfc_calc_max_all_channels, "sfc_calc_max_all_channels");

    sfc_calc_norm_max_all_channels : constant Interfaces.C.int;
    pragma Import (C, sfc_calc_norm_max_all_channels, "sfc_calc_norm_max_all_channels");

    sfc_get_signal_max : constant Interfaces.C.int;
    pragma Import (C, sfc_get_signal_max, "sfc_get_signal_max");

    sfc_get_max_all_channels : constant Interfaces.C.int;
    pragma Import (C, sfc_get_max_all_channels, "sfc_get_max_all_channels");

    sfc_set_norm_float : constant Interfaces.C.int;
    pragma Import (C, sfc_set_norm_float, "sfc_set_norm_float");

    sfc_set_norm_double : constant Interfaces.C.int;
    pragma Import (C, sfc_set_norm_double, "sfc_set_norm_double");

    sfc_get_norm_float : constant Interfaces.C.int;
    pragma Import (C, sfc_get_norm_float, "sfc_get_norm_float");

    sfc_get_norm_double : constant Interfaces.C.int;
    pragma Import (C, sfc_get_norm_double, "sfc_get_norm_double");

    sfc_set_scale_float_int_read : constant Interfaces.C.int;
    pragma Import (C, sfc_set_scale_float_int_read, "sfc_set_scale_float_int_read");

    sfc_set_scale_int_float_write : constant Interfaces.C.int;
    pragma Import (C, sfc_set_scale_int_float_write, "sfc_set_scale_int_float_write");

    sfc_get_simple_format_count : constant Interfaces.C.int;
    pragma Import (C, sfc_get_simple_format_count, "sfc_get_simple_format_count");

    sfc_get_simple_format : constant Interfaces.C.int;
    pragma Import (C, sfc_get_simple_format, "sfc_get_simple_format");

    sfc_get_format_info : constant Interfaces.C.int;
    pragma Import (C, sfc_get_format_info, "sfc_get_format_info");

    sfc_get_format_major_count : constant Interfaces.C.int;
    pragma Import (C, sfc_get_format_major_count, "sfc_get_format_major_count");

    sfc_get_format_major : constant Interfaces.C.int;
    pragma Import (C, sfc_get_format_major, "sfc_get_format_major");

    sfc_get_format_subtype_count : constant Interfaces.C.int;
    pragma Import (C, sfc_get_format_subtype_count, "sfc_get_format_subtype_count");

    sfc_get_format_subtype : constant Interfaces.C.int;
    pragma Import (C, sfc_get_format_subtype, "sfc_get_format_subtype");

    sfc_set_add_peak_chunk : constant Interfaces.C.int;
    pragma Import (C, sfc_set_add_peak_chunk, "sfc_set_add_peak_chunk");

    sfc_update_header_now : constant Interfaces.C.int;
    pragma Import (C, sfc_update_header_now, "sfc_update_header_now");

    sfc_set_update_header_auto : constant Interfaces.C.int;
    pragma Import (C, sfc_set_update_header_auto, "sfc_set_update_header_auto");

    sfc_set_clipping : constant Interfaces.C.int;
    pragma Import (C, sfc_set_clipping, "sfc_set_clipping");

    sfc_get_clipping : constant Interfaces.C.int;
    pragma Import (C, sfc_get_clipping, "sfc_get_clipping");

    sfc_wavex_get_ambisonic : constant Interfaces.C.int;
    pragma Import (C, sfc_wavex_get_ambisonic, "sfc_wavex_get_ambisonic");

    sfc_wavex_set_ambisonic : constant Interfaces.C.int;
    pragma Import (C, sfc_wavex_set_ambisonic, "sfc_wavex_set_ambisonic");

    sfc_set_vbr_encoding_quality : constant Interfaces.C.int;
    pragma Import (C, sfc_set_vbr_encoding_quality, "sfc_set_vbr_encoding_quality");

    sfc_set_ogg_page_latency_ms : constant Interfaces.C.int;
    pragma Import (C, sfc_set_ogg_page_latency_ms, "sfc_set_ogg_page_latency_ms");

    sfc_get_ogg_stream_serialno : constant Interfaces.C.int;
    pragma Import (C, sfc_get_ogg_stream_serialno, "sfc_get_ogg_stream_serialno");

    sfc_set_compression_level : constant Interfaces.C.int;
    pragma Import (C, sfc_set_compression_level, "sfc_set_compression_level");

    sfc_raw_data_needs_endswap : constant Interfaces.C.int;
    pragma Import (C, sfc_raw_data_needs_endswap, "sfc_raw_data_needs_endswap");

    sfc_get_broadcast_info : constant Interfaces.C.int;
    pragma Import (C, sfc_get_broadcast_info, "sfc_get_broadcast_info");

    sfc_set_broadcast_info : constant Interfaces.C.int;
    pragma Import (C, sfc_set_broadcast_info, "sfc_set_broadcast_info");

    sfc_get_channel_map_info : constant Interfaces.C.int;
    pragma Import (C, sfc_get_channel_map_info, "sfc_get_channel_map_info");

    sfc_set_channel_map_info : constant Interfaces.C.int;
    pragma Import (C, sfc_set_channel_map_info, "sfc_set_channel_map_info");

    --  ...

    sfc_get_cue_count : constant Interfaces.C.int;
    pragma Import (C, sfc_get_cue_count, "sfc_get_cue_count");

    --  ...

    sfc_rf64_auto_downgrade : constant Interfaces.C.int;
    pragma Import (C, sfc_rf64_auto_downgrade, "sfc_rf64_auto_downgrade");

    sfc_get_original_samplerate : constant Interfaces.C.int;
    pragma Import (C, sfc_get_original_samplerate, "sfc_get_original_samplerate");

    sfc_set_original_samplerate : constant Interfaces.C.int;
    pragma Import (C, sfc_set_original_samplerate, "sfc_set_original_samplerate");

    sfc_get_bitrate_mode : constant Interfaces.C.int;
    pragma Import (C, sfc_get_bitrate_mode, "sfc_get_bitrate_mode");

    sfc_set_bitrate_mode : constant Interfaces.C.int;
    pragma Import (C, sfc_set_bitrate_mode, "sfc_set_bitrate_mode");


    sf_ambisonic_none : constant Interfaces.C.int;
    pragma Import (C, sf_ambisonic_none, "sf_ambisonic_none");

    sf_ambisonic_b_format : constant Interfaces.C.int;
    pragma Import (C, sf_ambisonic_b_format, "sf_ambisonic_b_format");


    sf_bitrate_mode_constant : constant Interfaces.C.int;
    pragma Import (C, sf_bitrate_mode_constant, "sf_bitrate_mode_constant");

    sf_bitrate_mode_average : constant Interfaces.C.int;
    pragma Import (C, sf_bitrate_mode_average, "sf_bitrate_mode_average");

    sf_bitrate_mode_variable : constant Interfaces.C.int;
    pragma Import (C, sf_bitrate_mode_variable, "sf_bitrate_mode_variable");


    sf_format_typemask : constant Interfaces.Unsigned_32;
    pragma Import (C, sf_format_typemask, "sf_format_typemask");

    sf_format_submask : constant Interfaces.Unsigned_32;
    pragma Import (C, sf_format_submask, "sf_format_submask");

    sf_format_endmask : constant Interfaces.Unsigned_32;
    pragma Import (C, sf_format_endmask, "sf_format_endmask");




    ------------------------
    --  Functions From C  --
    ------------------------

    function sf_command
           (File : in System.Address;
            Cmd  : in Interfaces.C.int;
            Data : in System.Address;
            Size : in Interfaces.C.int)
        return Interfaces.C.int;
    pragma Import (C, sf_command, "sf_command");

    function asfc_get_current_sf_info
           (File : in     System.Address;
            Info :    out File_Info)
        return Interfaces.C.int;
    pragma Import (C, asfc_get_current_sf_info, "asfc_get_current_sf_info");

    function asfc_file_truncate
           (File : in System.Address;
            Pos  : in Interfaces.Integer_64)
        return Interfaces.C.int;
    pragma Import (C, asfc_file_truncate, "asfc_file_truncate");

    function asfc_set_raw_start_offset
           (File : in System.Address;
            Pos  : in Interfaces.Integer_64)
        return Interfaces.C.int;
    pragma Import (C, asfc_set_raw_start_offset, "asfc_set_raw_start_offset");

    function asfc_get_embed_file_info
           (File : in     System.Address;
            Info : in out Embedded_Info)
        return Interfaces.C.int;
    pragma Import (C, asfc_get_embed_file_info, "asfc_get_embed_file_info");




    ----------------------------------
    --  Data Structure Subprograms  --
    ----------------------------------

    function Major
           (Info : in Format_Info)
        return Major_Format
    is
        Raw : Interfaces.Unsigned_32 :=
            Interfaces.Unsigned_32 (Info.My_Format) and sf_format_typemask;
    begin
        return To_Major (Interfaces.C.int (Raw));
    end Major;

    function Minor
           (Info : in Format_Info)
        return Minor_Format
    is
        Raw : Interfaces.Unsigned_32 :=
            Interfaces.Unsigned_32 (Info.My_Format) and sf_format_submask;
    begin
        return To_Minor (Interfaces.C.int (Raw));
    end Minor;

    function Endian
           (Info : in Format_Info)
        return Endianness
    is
        Raw : Interfaces.Unsigned_32 :=
            Interfaces.Unsigned_32 (Info.My_Format) and sf_format_endmask;
    begin
        return To_Endian (Interfaces.C.int (Raw));
    end Endian;

    function Name
           (Info : in Format_Info)
        return String is
    begin
        return Interfaces.C.Strings.Value (Info.My_Name);
    end Name;

    function Extension
           (Info : in Format_Info)
        return String is
    begin
        return Interfaces.C.Strings.Value (Info.My_Extension);
    end Extension;


    function Offset
           (Info : in Embedded_Info)
        return Count_Type is
    begin
        return Count_Type (Info.My_Offset);
    end Offset;

    function Length
           (Info : in Embedded_Info)
        return Count_Type is
    begin
        return Count_Type (Info.My_Length);
    end Length;


    function Create
           (Description          : in String;
            Originator           : in String;
            Originator_Reference : in String;
            Origination_Date     : in String;
            Origination_Time     : in String;
            Time_Reference_Low   : in Interfaces.Unsigned_32;
            Time_Reference_High  : in Interfaces.Unsigned_32;
            Version              : in Short_Integer;
            Umid                 : in String;
            Reserved             : in String;
            Coding_History_Size  : in Interfaces.Unsigned_32;
            Coding_History       : in String)
        return Broadcast_Info
    is
        Buffer : String (1 .. 256);

        function Pad
               (Input : in String;
                Size  : in Natural)
            return String is
        begin
            Ada.Strings.Fixed.Move (Source => Input, Target => Buffer, Pad => Character'Val (0));
            return Buffer (1 .. Size);
        end Pad;
    begin
        return
           (My_Description          => Interfaces.C.To_C (Pad (Description, 256), False),
            My_Originator           => Interfaces.C.To_C (Pad (Originator, 32), False),
            My_Originator_Reference => Interfaces.C.To_C (Pad (Originator_Reference, 32), False),
            My_Origination_Date     => Interfaces.C.To_C (Pad (Origination_Date, 10), False),
            My_Origination_Time     => Interfaces.C.To_C (Pad (Origination_Time, 8), False),
            My_Time_Reference_Low   => Interfaces.C.unsigned (Time_Reference_Low),
            My_Time_Reference_High  => Interfaces.C.unsigned (Time_Reference_High),
            My_Version              => Interfaces.C.short (Version),
            My_Umid                 => Interfaces.C.To_C (Pad (Umid, 64), False),
            My_Reserved             => Interfaces.C.To_C (Pad (Reserved, 190), False),
            My_Coding_History_Size  => Interfaces.C.unsigned (Coding_History_Size),
            My_Coding_History       => Interfaces.C.To_C (Pad (Coding_History, 256), False));
    end Create;

    function Description
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Description,
            Interfaces.C.Is_Nul_Terminated (Info.My_Description));
    end Description;

    function Originator
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Originator,
            Interfaces.C.Is_Nul_Terminated (Info.My_Originator));
    end Originator;

    function Originator_Reference
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Originator_Reference,
            Interfaces.C.Is_Nul_Terminated (Info.My_Originator_Reference));
    end Originator_Reference;

    function Origination_Date
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Origination_Date,
            Interfaces.C.Is_Nul_Terminated (Info.My_Origination_Date));
    end Origination_Date;

    function Origination_Time
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Origination_Time,
            Interfaces.C.Is_Nul_Terminated (Info.My_Origination_Time));
    end Origination_Time;

    function Time_Reference_Low
           (Info : in Broadcast_Info)
        return Interfaces.Unsigned_32 is
    begin
        return Interfaces.Unsigned_32 (Info.My_Time_Reference_Low);
    end Time_Reference_Low;

    function Time_Reference_High
           (Info : in Broadcast_Info)
        return Interfaces.Unsigned_32 is
    begin
        return Interfaces.Unsigned_32 (Info.My_Time_Reference_High);
    end Time_Reference_High;

    function Version
           (Info : in Broadcast_Info)
        return Short_Integer is
    begin
        return Short_Integer (Info.My_Version);
    end Version;

    function Umid
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Umid,
            Interfaces.C.Is_Nul_Terminated (Info.My_Umid));
    end Umid;

    function Reserved
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Reserved,
            Interfaces.C.Is_Nul_Terminated (Info.My_Reserved));
    end Reserved;

    function Coding_History_Size
           (Info : in Broadcast_Info)
        return Interfaces.Unsigned_32 is
    begin
        return Interfaces.Unsigned_32 (Info.My_Coding_History_Size);
    end Coding_History_Size;

    function Coding_History
           (Info : in Broadcast_Info)
        return String is
    begin
        return Interfaces.C.To_Ada
           (Info.My_Coding_History,
            Interfaces.C.Is_Nul_Terminated (Info.My_Coding_History));
    end Coding_History;




    ---------------------
    --  API Interface  --
    ---------------------

    function Get_Library_String
           (Buffer : out String)
        return Natural is
    begin
        return Natural (sf_command
           (System.Null_Address,
            sfc_get_lib_version,
            Buffer'Address,
            Buffer'Length));
    end Get_Library_String;

    function Get_Log_Info
           (File   : in  Sound_File;
            Buffer : out String)
        return Natural is
    begin
        return Natural (sf_command
           (File.Ptr,
            sfc_get_log_info,
            Buffer'Address,
            Buffer'Length));
    end Get_Log_Info;

    function Get_Current_File_Info
           (File : in Sound_File)
        return File_Info
    is
        Result : File_Info;
        Code   : Interfaces.C.int;
    begin
        Code := asfc_get_current_sf_info (File.Ptr, Result);
        if Code /= 0 then
            Raise_Error (Code);
            raise Program_Error;
        else
            return Result;
        end if;
    end Get_Current_File_Info;

    function Calculate_Signal_Maximum
           (File : in Sound_File)
        return Long_Float
    is
        Result : Interfaces.C.double;
        Code   : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_calc_signal_max,
            Result'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            Raise_Error (Code);
            raise Program_Error;
        else
            return Long_Float (Result);
        end if;
    end Calculate_Signal_Maximum;

    function Calculate_Normed_Signal_Maximum
           (File : in Sound_File)
        return Long_Float
    is
        Result : Interfaces.C.double;
        Code   : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_calc_norm_signal_max,
            Result'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            Raise_Error (Code);
            raise Program_Error;
        else
            return Long_Float (Result);
        end if;
    end Calculate_Normed_Signal_Maximum;

    function Calculate_Maximum_All_Channels
           (File : in Sound_File)
        return Long_Float_Array
    is
        Result : Long_Float_Array (1 .. Natural (File.Chans));
        Code   : Interfaces.C.int;
    begin
        Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size);
        Code := sf_command
           (File.Ptr,
            sfc_calc_max_all_channels,
            Result'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT * File.Chans);
        if Code /= 0 then
            Raise_Error (Code);
            raise Program_Error;
        else
            return Result;
        end if;
    end Calculate_Maximum_All_Channels;

    function Calculate_Normed_Maximum_All_Channels
           (File : in Sound_File)
        return Long_Float_Array
    is
        Result : Long_Float_Array (1 .. Natural (File.Chans));
        Code   : Interfaces.C.int;
    begin
        Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size);
        Code := sf_command
           (File.Ptr,
            sfc_calc_norm_max_all_channels,
            Result'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT * File.Chans);
        if Code /= 0 then
            Raise_Error (Code);
            raise Program_Error;
        else
            return Result;
        end if;
    end Calculate_Normed_Maximum_All_Channels;

    function Get_Signal_Maximum
           (File : in Sound_File)
        return Long_Float
    is
        Result : Interfaces.C.double;
        Code   : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_signal_max,
            Result'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code = sf_true then
            return Long_Float (Result);
        else
            raise Program_Error;
        end if;
    end Get_Signal_Maximum;

    function Get_Maximum_All_Channels
           (File : in Sound_File)
        return Long_Float_Array
    is
        Result : Long_Float_Array (1 .. Natural (File.Chans));
        Code   : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_max_all_channels,
            Result'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT * File.Chans);
        if Code = sf_false then
            raise Command_Error;
        elsif Code = sf_true then
            return Result;
        else
            raise Program_Error;
        end if;
    end Get_Maximum_All_Channels;

    procedure Set_Normed_Float
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_norm_float,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Normed_Float;

    procedure Set_Normed_Double
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_norm_double,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Normed_Double;

    function Get_Normed_Float
           (File : in Sound_File)
        return Boolean
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_norm_float,
            System.Null_Address,
            0);
        if Code = sf_true then
            return True;
        elsif Code = sf_false then
            return False;
        else
            raise Program_Error;
        end if;
    end Get_Normed_Float;

    function Get_Normed_Double
           (File : in Sound_File)
        return Boolean
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_norm_double,
            System.Null_Address,
            0);
        if Code = sf_true then
            return True;
        elsif Code = sf_false then
            return False;
        else
            raise Program_Error;
        end if;
    end Get_Normed_Double;

    procedure Set_Scale_Float_Integer_Read
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_scale_float_int_read,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Scale_Float_Integer_Read;

    procedure Set_Scale_Integer_Float_Write
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_scale_int_float_write,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Scale_Integer_Float_Write;

    function Get_Simple_Format_Count
        return Natural
    is
        Result, Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_simple_format_count,
            Result'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT);
        if Result < 0 then
            raise Program_Error;
        else
            return Natural (Result);
        end if;
    end Get_Simple_Format_Count;

    function Get_Simple_Format
           (Index : in Positive)
        return Format_Info
    is
        Result : Format_Info :=
           (My_Format    => Interfaces.C.int (Index) - 1,
            My_Name      => Interfaces.C.Strings.Null_Ptr,
            My_Extension => Interfaces.C.Strings.Null_Ptr);
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_simple_format,
            Result'Address,
            Format_Info'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            raise Command_Error;
        else
            return Result;
        end if;
    end Get_Simple_Format;

    function Do_Get_Format_Info
           (Format : in Interfaces.C.int)
        return Format_Info
    is
        Result : Format_Info :=
           (My_Format    => Format,
            My_Name      => Interfaces.C.Strings.Null_Ptr,
            My_Extension => Interfaces.C.Strings.Null_Ptr);
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_format_info,
            Result'Address,
            Format_Info'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            raise Command_Error;
        else
            return Result;
        end if;
    end Do_Get_Format_Info;

    function Get_Format_Info
           (Format : in Major_Format)
        return Format_Info is
    begin
        return Do_Get_Format_Info (To_Cint (Format));
    end Get_Format_Info;

    function Get_Format_Info
           (Format : in Minor_Format)
        return Format_Info is
    begin
        return Do_Get_Format_Info (To_Cint (Format));
    end Get_Format_Info;

    function Get_Format_Major_Count
        return Natural
    is
        Result, Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_format_major_count,
            Result'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT);
        return Natural (Result);
    end Get_Format_Major_Count;

    function Get_Format_Major
           (Index : in Positive)
        return Format_Info
    is
        Result : Format_Info :=
           (My_Format    => Interfaces.C.int (Index) - 1,
            My_Name      => Interfaces.C.Strings.Null_Ptr,
            My_Extension => Interfaces.C.Strings.Null_Ptr);
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_format_major,
            Result'Address,
            Format_Info'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            raise Command_Error;
        else
            return Result;
        end if;
    end Get_Format_Major;

    function Get_Format_Subtype_Count
        return Natural
    is
        Result, Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_format_subtype_count,
            Result'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT);
        return Natural (Result);
    end Get_Format_Subtype_Count;

    function Get_Format_Subtype
           (Index : in Positive)
        return Format_Info
    is
        Result : Format_Info :=
           (My_Format    => Interfaces.C.int (Index) - 1,
            My_Name      => Interfaces.C.Strings.Null_Ptr,
            My_Extension => Interfaces.C.Strings.Null_Ptr);
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (System.Null_Address,
            sfc_get_format_subtype,
            Result'Address,
            Format_Info'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            raise Command_Error;
        else
            return Result;
        end if;
    end Get_Format_Subtype;

    procedure Set_Add_Peak_Chunk
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_add_peak_chunk,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Add_Peak_Chunk;

    procedure Update_Header_Now
           (File : in Sound_File)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_update_header_now,
            System.Null_Address,
            0);
    end Update_Header_Now;

    procedure Set_Update_Header_Auto
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_update_header_auto,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Update_Header_Auto;

    procedure File_Truncate
           (File     : in Sound_File;
            Position : in Count_Type)
    is
        Code : Interfaces.C.int;
    begin
        Code := asfc_file_truncate (File.Ptr, Interfaces.Integer_64 (Position));
        if Code /= 0 then
            raise Command_Error;
        end if;
    end File_Truncate;

    procedure Set_Raw_Start_Offset
           (File     : in Sound_File;
            Position : in Count_Type)
    is
        Code : Interfaces.C.int;
    begin
        Code := asfc_set_raw_start_offset (File.Ptr, Interfaces.Integer_64 (Position));
        if Code /= 0 then
            raise Command_Error;
        end if;
    end Set_Raw_Start_Offset;

    procedure Set_Clipping
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_clipping,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end Set_Clipping;

    function Get_Clipping
           (File : in Sound_File)
        return Boolean
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_clipping,
            System.Null_Address,
            0);
        if Code = sf_true then
            return True;
        elsif Code = sf_false then
            return False;
        else
            raise Program_Error;
        end if;
    end Get_Clipping;

    function Get_Embedded_File_Info
           (File : in Sound_File)
        return Embedded_Info
    is
        Info : Embedded_Info;
        Code : Interfaces.C.int;
    begin
        Code := asfc_get_embed_file_info (File.Ptr, Info);
        if Code /= 0 then
            raise Command_Error;
        else
            return Info;
        end if;
    end Get_Embedded_File_Info;

    function Wavex_Get_Ambisonic
           (File : in Sound_File)
        return Ambisonic
    is
        Result : Interfaces.C.int;
    begin
        Result := sf_command
           (File.Ptr,
            sfc_wavex_get_ambisonic,
            System.Null_Address,
            0);
        if Result = 0 then
            return Ambisonic_Unsupported;
        elsif Result = sf_ambisonic_none then
            return Ambisonic_Off;
        elsif Result = sf_ambisonic_b_format then
            return Ambisonic_B_Format;
        else
            raise Program_Error;
        end if;
    end Wavex_Get_Ambisonic;

    procedure Wavex_Set_Ambisonic
           (File  : in Sound_File;
            Value : in Ambisonic)
    is
        My_Value, Code : Interfaces.C.int;
    begin
        case Value is
            when Ambisonic_Unsupported =>
                return;
            when Ambisonic_Off =>
                My_Value := sf_ambisonic_none;
            when Ambisonic_B_Format =>
                My_Value := sf_ambisonic_b_format;
        end case;
        Code := sf_command
           (File.Ptr,
            sfc_wavex_set_ambisonic,
            System.Null_Address,
            My_Value);
        if Code = 0 then
            raise Command_Error;
        elsif Code /= sf_ambisonic_none and Code /= sf_ambisonic_b_format then
            raise Program_Error;
        end if;
    end Wavex_Set_Ambisonic;

    procedure Set_Variable_Bitrate_Encoding_Quality
           (File  : in Sound_File;
            Value : in Long_Long_Float)
    is
        Code : Interfaces.C.int;
        My_Value : Interfaces.C.double;
    begin
        My_Value := Interfaces.C.double (Value);
        Code := sf_command
           (File.Ptr,
            sfc_set_vbr_encoding_quality,
            My_Value'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        end if;
    end Set_Variable_Bitrate_Encoding_Quality;

    procedure Set_Ogg_Page_Latency_Milliseconds
           (File  : in Sound_File;
            Value : in Long_Long_Float)
    is
        Code : Interfaces.C.int;
        My_Value : Interfaces.C.double;
    begin
        My_Value := Interfaces.C.double (Value);
        Code := sf_command
           (File.Ptr,
            sfc_set_ogg_page_latency_ms,
            My_Value'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT);
        if Code /= 0 then
            raise Command_Error;
        end if;
    end Set_Ogg_Page_Latency_Milliseconds;

    function Get_Ogg_Stream_Serial
           (File : in Sound_File)
        return Integer
    is
        Code : Interfaces.C.int;
        Result : Interfaces.Integer_32;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_ogg_stream_serialno,
            Result'Address,
            Interfaces.Integer_32'Size / Interfaces.C.CHAR_BIT);
        if Code = 0 then
            return Integer (Result);
        else
            raise Command_Error;
        end if;
    end Get_Ogg_Stream_Serial;

    procedure Set_Compression_Level
           (File  : in Sound_File;
            Value : in Compression)
    is
        Code : Interfaces.C.int;
        My_Value : Interfaces.C.double;
    begin
        My_Value := Interfaces.C.double (Value);
        Code := sf_command
           (File.Ptr,
            sfc_set_compression_level,
            My_Value'Address,
            Interfaces.C.double'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        end if;
    end Set_Compression_Level;

    function Raw_Data_Needs_Endswap
           (File : in Sound_File)
        return Boolean
    is
        Result : Interfaces.C.int;
    begin
        Result := sf_command
           (File.Ptr,
            sfc_raw_data_needs_endswap,
            System.Null_Address,
            0);
        if Result = sf_true then
            return True;
        elsif Result = sf_false then
            return False;
        else
            raise Program_Error;
        end if;
    end Raw_Data_Needs_Endswap;

    function Get_Broadcast_Info
           (File : in Sound_File)
        return Broadcast_Info
    is
        Result : Broadcast_Info;
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_broadcast_info,
            Result'Address,
            Broadcast_Info'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_true then
            return Result;
        elsif Code = sf_false then
            raise Command_Error;
        else
            raise Program_Error;
        end if;
    end Get_Broadcast_Info;

    procedure Set_Broadcast_Info
           (File  : in Sound_File;
            Value : in Broadcast_Info)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_broadcast_info,
            Value'Address,
            Broadcast_Info'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        end if;
    end Set_Broadcast_Info;

    function Get_Channel_Map_Info
           (File : in Sound_File)
        return Channel_Map_Array
    is
        Raw : array (Positive range 1 .. Natural (File.Chans)) of Interfaces.C.int;
        Result : Channel_Map_Array (1 .. Natural (File.Chans));
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_channel_map_info,
            Raw'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT * File.Chans);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        else
            for Index in Raw'Range loop
                Result (Index) := Channel_Map'Val (Raw (Index));
            end loop;
            return Result;
        end if;
    end Get_Channel_Map_Info;

    procedure Set_Channel_Map_Info
           (File  : in Sound_File;
            Value : in Channel_Map_Array)
    is
        My_Value : array (Positive range 1 .. Natural (File.Chans)) of Interfaces.C.int;
        Code : Interfaces.C.int;
    begin
        if Value'Length /= File.Chans then
            raise Command_Error;
        end if;
        for Index in Value'Range loop
            My_Value (Index) := Channel_Map'Pos (Value (Index));
        end loop;
        Code := sf_command
           (File.Ptr,
            sfc_set_channel_map_info,
            My_Value'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT * File.Chans);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        end if;
    end Set_Channel_Map_Info;

    function Get_Cue_Count
           (File : in Sound_File)
        return Interfaces.Unsigned_32
    is
        Result : Interfaces.Unsigned_32;
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_cue_count,
            Result'Address,
            Interfaces.Unsigned_32'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code = sf_true then
            return Result;
        else
            raise Program_Error;
        end if;
    end Get_Cue_Count;

    procedure RF64_Auto_Downgrade
           (File  : in Sound_File;
            Value : in Boolean)
    is
        Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_rf64_auto_downgrade,
            System.Null_Address,
            (if Value then sf_true else sf_false));
    end RF64_Auto_Downgrade;

    function Get_Original_Samplerate
           (File : in Sound_File)
        return Natural
    is
        Result, Code : Interfaces.C.int;
    begin
        Code := sf_command
           (File.Ptr,
            sfc_get_original_samplerate,
            Result'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_true then
            return Natural (Result);
        else
            raise Command_Error;
        end if;
    end Get_Original_Samplerate;

    procedure Set_Original_Samplerate
           (File  : in Sound_File;
            Value : in Natural)
    is
        My_Value, Code : Interfaces.C.int;
    begin
        My_Value := Interfaces.C.int (Value);
        Code := sf_command
           (File.Ptr,
            sfc_set_original_samplerate,
            My_Value'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        end if;
    end Set_Original_Samplerate;

    function Get_Bitrate_Mode
           (File : in Sound_File)
        return Bitrate_Mode
    is
        Result : Interfaces.C.int;
    begin
        Result := sf_command
           (File.Ptr,
            sfc_get_bitrate_mode,
            System.Null_Address,
            0);
        if Result = sf_bitrate_mode_constant then
            return Constant_Mode;
        elsif Result = sf_bitrate_mode_average then
            return Average_Mode;
        elsif Result = sf_bitrate_mode_variable then
            return Variable_Mode;
        elsif Result = -1 then
            raise Command_Error;
        else
            raise Program_Error;
        end if;
    end Get_Bitrate_Mode;

    procedure Set_Bitrate_Mode
           (File  : in Sound_File;
            Value : in Bitrate_Mode)
    is
        Code : Interfaces.C.int;
        My_Value : Interfaces.C.int := (case Value is
            when Constant_Mode => sf_bitrate_mode_constant,
            when Average_Mode  => sf_bitrate_mode_average,
            when Variable_Mode => sf_bitrate_mode_variable);
    begin
        Code := sf_command
           (File.Ptr,
            sfc_set_bitrate_mode,
            My_Value'Address,
            Interfaces.C.int'Size / Interfaces.C.CHAR_BIT);
        if Code = sf_false then
            raise Command_Error;
        elsif Code /= sf_true then
            raise Program_Error;
        end if;
    end Set_Bitrate_Mode;


end Libsndfile.Commands;