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