-- Programmed by Jedidiah Barber -- Released into the public domain pragma Ada_2012; 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_cart_info : constant Interfaces.C.int; pragma Import (C, sfc_get_cart_info, "sfc_get_cart_info"); sfc_set_cart_info : constant Interfaces.C.int; pragma Import (C, sfc_set_cart_info, "sfc_set_cart_info"); sfc_get_loop_info : constant Interfaces.C.int; pragma Import (C, sfc_get_loop_info, "sfc_get_loop_info"); sfc_get_instrument : constant Interfaces.C.int; pragma Import (C, sfc_get_instrument, "sfc_get_instrument"); sfc_set_instrument : constant Interfaces.C.int; pragma Import (C, sfc_set_instrument, "sfc_set_instrument"); sfc_get_cue_count : constant Interfaces.C.int; pragma Import (C, sfc_get_cue_count, "sfc_get_cue_count"); sfc_get_cue : constant Interfaces.C.int; pragma Import (C, sfc_get_cue, "sfc_get_cue"); sfc_set_cue : constant Interfaces.C.int; pragma Import (C, sfc_set_cue, "sfc_set_cue"); 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_loop_none : constant Interfaces.C.int; pragma Import (C, sf_loop_none, "sf_loop_none"); sf_loop_forward : constant Interfaces.C.int; pragma Import (C, sf_loop_forward, "sf_loop_forward"); sf_loop_backward : constant Interfaces.C.int; pragma Import (C, sf_loop_backward, "sf_loop_backward"); sf_loop_alternating : constant Interfaces.C.int; pragma Import (C, sf_loop_alternating, "sf_loop_alternating"); 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 C_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 C_Embedded_Info) return Interfaces.C.int; pragma Import (C, asfc_get_embed_file_info, "asfc_get_embed_file_info"); ------------------------ -- Internal Utility -- ------------------------ function To_Ada (Num : in Interfaces.C.int) return Loop_Mode is begin if Num = sf_loop_none then return No_Loop; elsif Num = sf_loop_forward then return Loop_Forward; elsif Num = sf_loop_backward then return Loop_Backward; elsif Num = sf_loop_alternating then return Loop_Alternating; else raise Program_Error; end if; end To_Ada; function To_C (Enum : in Loop_Mode) return Interfaces.C.int is begin case Enum is when No_Loop => return sf_loop_none; when Loop_Forward => return sf_loop_forward; when Loop_Backward => return sf_loop_backward; when Loop_Alternating => return sf_loop_alternating; end case; end To_C; --------------------------------- -- Data Types and Structures -- --------------------------------- function Major (Info : in Format_Info) return Major_Format is Raw : Interfaces.Unsigned_32 := Interfaces.Unsigned_32 (Info.C_Data.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.C_Data.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.C_Data.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.C_Data.My_Name); end Name; function Extension (Info : in Format_Info) return String is begin return Interfaces.C.Strings.Value (Info.C_Data.My_Extension); end Extension; function Create (Base : in Instrument_Data; Repeats : in Loop_Data_Array) return Instrument_Info is begin return Result : Instrument_Info do Result.C_Data.My_Gain := Interfaces.C.int (Base.Gain); Result.C_Data.My_Basenote := Interfaces.C.char (Base.Basenote); Result.C_Data.My_Detune := Interfaces.C.char (Base.Detune); Result.C_Data.My_Velocity_Lo := Interfaces.C.char (Base.Velocity_Low); Result.C_Data.My_Velocity_Hi := Interfaces.C.char (Base.Velocity_High); Result.C_Data.My_Key_Lo := Interfaces.C.char (Base.Key_Low); Result.C_Data.My_Key_Hi := Interfaces.C.char (Base.Key_High); Result.C_Data.My_Loop_Count := Repeats'Length; for Index in Repeats'Range loop Result.C_Data.My_Loops (Index).My_Mode := To_C (Repeats (Index).Mode); Result.C_Data.My_Loops (Index).My_Start := Interfaces.C.unsigned (Repeats (Index).Start); Result.C_Data.My_Loops (Index).My_End := Interfaces.C.unsigned (Repeats (Index).Finish); Result.C_Data.My_Loops (Index).My_Count := Interfaces.C.unsigned (Repeats (Index).Count); end loop; end return; end Create; function Base (Info : in Instrument_Info) return Instrument_Data is begin return Result : Instrument_Data do Result.Gain := Integer (Info.C_Data.My_Gain); Result.Basenote := Character (Info.C_Data.My_Basenote); Result.Detune := Character (Info.C_Data.My_Detune); Result.Velocity_Low := Character (Info.C_Data.My_Velocity_Lo); Result.Velocity_High := Character (Info.C_Data.My_Velocity_Hi); Result.Key_Low := Character (Info.C_Data.My_Key_Lo); Result.Key_High := Character (Info.C_Data.My_Key_Hi); end return; end Base; function Repeats (Info : in Instrument_Info) return Loop_Data_Array is begin return Result : Loop_Data_Array (1 .. Integer (Info.C_Data.My_Loop_Count)) do for Index in Result'Range loop Result (Index).Mode := To_Ada (Info.C_Data.My_Loops (Index).My_Mode); Result (Index).Start := Interfaces.Unsigned_32 (Info.C_Data.My_Loops (Index).My_Start); Result (Index).Finish := Interfaces.Unsigned_32 (Info.C_Data.My_Loops (Index).My_End); Result (Index).Count := Interfaces.Unsigned_32 (Info.C_Data.My_Loops (Index).My_Count); end loop; end return; end Repeats; --------------------- -- 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.Data); 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 Raw : C_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, Raw'Address, C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else return (C_Data => Raw); end if; end Get_Simple_Format; function Do_Get_Format_Info (Format : in Interfaces.C.int) return Format_Info is Raw : C_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, Raw'Address, C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else return (C_Data => Raw); 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 Raw : C_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, Raw'Address, C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else return (C_Data => Raw); 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 Raw : C_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, Raw'Address, C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else return (C_Data => Raw); 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 Raw : C_Embedded_Info; Code : Interfaces.C.int; begin Code := asfc_get_embed_file_info (File.Ptr, Raw); if Code /= 0 then raise Command_Error; else return (Offset => Count_Type (Raw.My_Offset), Length => Count_Type (Raw.My_Length)); 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 Raw : C_Broadcast_Info; Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_get_broadcast_info, Raw'Address, C_Broadcast_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_true then return Result : Broadcast_Info do Result.Description := Interfaces.C.To_Ada (Raw.My_Description, False); Result.Originator := Interfaces.C.To_Ada (Raw.My_Originator, False); Result.Originator_Reference := Interfaces.C.To_Ada (Raw.My_Originator_Reference, False); Result.Origination_Date := Interfaces.C.To_Ada (Raw.My_Origination_Date, False); Result.Origination_Time := Interfaces.C.To_Ada (Raw.My_Origination_Time, False); Result.Time_Reference_Low := Interfaces.Unsigned_32 (Raw.My_Time_Reference_Low); Result.Time_Reference_High := Interfaces.Unsigned_32 (Raw.My_Time_Reference_High); Result.Version := Short_Integer (Raw.My_Version); Result.Umid := Interfaces.C.To_Ada (Raw.My_Umid, False); Result.Reserved := Interfaces.C.To_Ada (Raw.My_Reserved, False); Result.Coding_History_Size := Interfaces.Unsigned_32 (Raw.My_Coding_History_Size); Result.Coding_History := Interfaces.C.To_Ada (Raw.My_Coding_History, False); end return; 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 C_Data : C_Broadcast_Info := (My_Description => Interfaces.C.To_C (Value.Description, False), My_Originator => Interfaces.C.To_C (Value.Originator, False), My_Originator_Reference => Interfaces.C.To_C (Value.Originator_Reference, False), My_Origination_Date => Interfaces.C.To_C (Value.Origination_Date, False), My_Origination_Time => Interfaces.C.To_C (Value.Origination_Time, False), My_Time_Reference_Low => Interfaces.C.unsigned (Value.Time_Reference_Low), My_Time_Reference_High => Interfaces.C.unsigned (Value.Time_Reference_High), My_Version => Interfaces.C.short (Value.Version), My_Umid => Interfaces.C.To_C (Value.Umid, False), My_Reserved => Interfaces.C.To_C (Value.Reserved, False), My_Coding_History_Size => Interfaces.C.unsigned (Value.Coding_History_Size), My_Coding_History => Interfaces.C.To_C (Value.Coding_History, False)); Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_set_broadcast_info, C_Data'Address, C_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_Cart_Info (File : in Sound_File) return Cart_Info is Raw : C_Cart_Info; Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_get_cart_info, Raw'Address, Raw'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; elsif Code = sf_true then return Result : Cart_Info (Natural (Raw.My_Tag_Text_Size)) do Result.Version := Interfaces.C.To_Ada (Raw.My_Version, False); Result.Title := Interfaces.C.To_Ada (Raw.My_Title, False); Result.Artist := Interfaces.C.To_Ada (Raw.My_Artist, False); Result.Cut_ID := Interfaces.C.To_Ada (Raw.My_Cut_ID, False); Result.Client_ID := Interfaces.C.To_Ada (Raw.My_Client_ID, False); Result.Category := Interfaces.C.To_Ada (Raw.My_Category, False); Result.Classification := Interfaces.C.To_Ada (Raw.My_Classification, False); Result.Out_Cue := Interfaces.C.To_Ada (Raw.My_Out_Cue, False); Result.Start_Date := Interfaces.C.To_Ada (Raw.My_Start_Date, False); Result.Start_Time := Interfaces.C.To_Ada (Raw.My_Start_Time, False); Result.End_Date := Interfaces.C.To_Ada (Raw.My_End_Date, False); Result.End_Time := Interfaces.C.To_Ada (Raw.My_End_Time, False); Result.Producer_App_ID := Interfaces.C.To_Ada (Raw.My_Producer_App_ID, False); Result.Producer_App_Version := Interfaces.C.To_Ada (Raw.My_Producer_App_Version, False); Result.User_Defined := Interfaces.C.To_Ada (Raw.My_User_Def, False); Result.Level_Reference := Long_Integer (Raw.My_Level_Reference); for Index in Result.Post_Timers'Range loop Result.Post_Timers (Index).Usage := Interfaces.C.To_Ada (Raw.My_Post_Timers (Index).My_Usage, False); Result.Post_Timers (Index).Value := Raw.My_Post_Timers (Index).My_Value; end loop; Result.Reserved := Interfaces.C.To_Ada (Raw.My_Reserved, False); Result.URL := Interfaces.C.To_Ada (Raw.My_URL, False); Result.Tag_Text := Interfaces.C.To_Ada (Raw.My_Tag_Text (1 .. Interfaces.C.size_t (Raw.My_Tag_Text_Size)), False); end return; else raise Program_Error; end if; end Get_Cart_Info; procedure Set_Cart_Info (File : in Sound_File; Info : in Cart_Info) is C_Data : C_Cart_Info := (My_Version => Interfaces.C.To_C (Info.Version, False), My_Title => Interfaces.C.To_C (Info.Title, False), My_Artist => Interfaces.C.To_C (Info.Artist, False), My_Cut_ID => Interfaces.C.To_C (Info.Cut_ID, False), My_Client_ID => Interfaces.C.To_C (Info.Client_ID, False), My_Category => Interfaces.C.To_C (Info.Category, False), My_Classification => Interfaces.C.To_C (Info.Classification, False), My_Out_Cue => Interfaces.C.To_C (Info.Out_Cue, False), My_Start_Date => Interfaces.C.To_C (Info.Start_Date, False), My_Start_Time => Interfaces.C.To_C (Info.Start_Time, False), My_End_Date => Interfaces.C.To_C (Info.End_Date, False), My_End_Time => Interfaces.C.To_C (Info.End_Time, False), My_Producer_App_ID => Interfaces.C.To_C (Info.Producer_App_ID, False), My_Producer_App_Version => Interfaces.C.To_C (Info.Producer_App_Version, False), My_User_Def => Interfaces.C.To_C (Info.User_Defined, False), My_Level_Reference => Interfaces.C.long (Info.Level_Reference), My_Post_Timers => (others => (" ", 0)), My_Reserved => Interfaces.C.To_C (Info.Reserved, False), My_URL => Interfaces.C.To_C (Info.URL, False), My_Tag_Text_Size => Interfaces.C.unsigned (Info.Tag_Size), My_Tag_Text => (others => ' ')); Code : Interfaces.C.int; begin for Index in C_Data.My_Post_Timers'Range loop C_Data.My_Post_Timers (Index).My_Usage := Interfaces.C.To_C (Info.Post_Timers (Index).Usage, False); C_Data.My_Post_Timers (Index).My_Value := Info.Post_Timers (Index).Value; end loop; C_Data.My_Tag_Text (1 .. Interfaces.C.size_t (C_Data.My_Tag_Text_Size)) := Interfaces.C.To_C (Info.Tag_Text, False); Code := sf_command (File.Ptr, sfc_set_cart_info, C_Data'Address, C_Data'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_Cart_Info; function Get_Loop_Info (File : in Sound_File) return Loop_Info is Raw : C_Loop_Info; Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_get_loop_info, Raw'Address, C_Loop_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; elsif Code = sf_true then return Result : Loop_Info do Result.Time_Sig_Num := Short_Integer (Raw.My_Time_Sig_Num); Result.Time_Sig_Den := Short_Integer (Raw.My_Time_Sig_Den); Result.Mode := To_Ada (Raw.My_Loop_Mode); Result.Beats := Positive (Raw.My_Num_Beats); Result.BPM := Beats_Per_Minute (Raw.My_BPM); Result.Root_Key := MIDI_Note (Raw.My_Root_Key); for Index in Result.Future'Range loop Result.Future (Index) := Integer (Raw.My_Future (Index)); end loop; end return; else raise Program_Error; end if; end Get_Loop_Info; function Get_Instrument (File : in Sound_File) return Instrument_Info is Result : Instrument_Info; Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_get_instrument, Result.C_Data'Address, C_Instrument_Info'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_Instrument; procedure Set_Instrument (File : in Sound_File; Info : in Instrument_Info) is Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_set_instrument, Info.C_Data'Address, C_Instrument_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_Instrument; 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; function Get_Cue (File : in Sound_File) return Cue_Marker_Array is Raw : C_Cue_Info; Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_get_cue, Raw'Address, C_Cue_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; elsif Code = sf_true then return Result : Cue_Marker_Array (1 .. Integer (Raw.My_Cue_Count)) do for Index in Result'Range loop Result (Index).Index := Integer (Raw.My_Cue_Points (Index).My_Indx); Result (Index).Position := Raw.My_Cue_Points (Index).My_Position; Result (Index).FCC_Chunk := Integer (Raw.My_Cue_Points (Index).My_FCC_Chunk); Result (Index).Chunk_Start := Integer (Raw.My_Cue_Points (Index).My_Chunk_Start); Result (Index).Block_Start := Integer (Raw.My_Cue_Points (Index).My_Block_Start); Result (Index).Sample_Offset := Raw.My_Cue_Points (Index).My_Sample_Offset; Result (Index).Name := Interfaces.C.To_Ada (Raw.My_Cue_Points (Index).My_Name, False); end loop; end return; else raise Program_Error; end if; end Get_Cue; procedure Set_Cue (File : in Sound_File; Info : in Cue_Marker_Array) is C_Data : C_Cue_Info; Code : Interfaces.C.int; begin C_Data.My_Cue_Count := Info'Length; for Index in Info'Range loop C_Data.My_Cue_Points (Index).My_Indx := Interfaces.Integer_32 (Info (Index).Index); C_Data.My_Cue_Points (Index).My_Position := Info (Index).Position; C_Data.My_Cue_Points (Index).My_FCC_Chunk := Interfaces.Integer_32 (Info (Index).FCC_Chunk); C_Data.My_Cue_Points (Index).My_Chunk_Start := Interfaces.Integer_32 (Info (Index).Chunk_Start); C_Data.My_Cue_Points (Index).My_Block_Start := Interfaces.Integer_32 (Info (Index).Block_Start); C_Data.My_Cue_Points (Index).My_Sample_Offset := Info (Index).Sample_Offset; C_Data.My_Cue_Points (Index).My_Name := Interfaces.C.To_C (Info (Index).Name, False); end loop; Code := sf_command (File.Ptr, sfc_set_cue, C_Data'Address, C_Cue_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_Cue; 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;