From 049d2a9a337331295b4a2d4ad13061bc73536236 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sun, 2 Jul 2023 21:36:34 +1200 Subject: Initial commit --- src/libsndfile-commands.adb | 1305 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1305 insertions(+) create mode 100644 src/libsndfile-commands.adb (limited to 'src/libsndfile-commands.adb') diff --git a/src/libsndfile-commands.adb b/src/libsndfile-commands.adb new file mode 100644 index 0000000..0d3f767 --- /dev/null +++ b/src/libsndfile-commands.adb @@ -0,0 +1,1305 @@ + + +-- 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; + + -- cgit