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.adb | 1094 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1094 insertions(+) create mode 100644 src/libsndfile.adb (limited to 'src/libsndfile.adb') diff --git a/src/libsndfile.adb b/src/libsndfile.adb new file mode 100644 index 0000000..8a61b4a --- /dev/null +++ b/src/libsndfile.adb @@ -0,0 +1,1094 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Assertions, + Interfaces.C.Strings, + System; + +use type + + Interfaces.Integer_64, + Interfaces.Unsigned_8, + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, + System.Address; + + +package body Libsndfile is + + + ------------------------ + -- Constants From C -- + ------------------------ + + sf_str_title : constant Interfaces.C.int; + pragma Import (C, sf_str_title, "sf_str_title"); + + sf_str_copyright : constant Interfaces.C.int; + pragma Import (C, sf_str_copyright, "sf_str_copyright"); + + sf_str_software : constant Interfaces.C.int; + pragma Import (C, sf_str_software, "sf_str_software"); + + sf_str_artist : constant Interfaces.C.int; + pragma Import (C, sf_str_artist, "sf_str_artist"); + + sf_str_comment : constant Interfaces.C.int; + pragma Import (C, sf_str_comment, "sf_str_comment"); + + sf_str_date : constant Interfaces.C.int; + pragma Import (C, sf_str_date, "sf_str_date"); + + sf_str_album : constant Interfaces.C.int; + pragma Import (C, sf_str_album, "sf_str_album"); + + sf_str_license : constant Interfaces.C.int; + pragma Import (C, sf_str_license, "sf_str_license"); + + sf_str_tracknumber : constant Interfaces.C.int; + pragma Import (C, sf_str_tracknumber, "sf_str_tracknumber"); + + sf_str_genre : constant Interfaces.C.int; + pragma Import (C, sf_str_genre, "sf_str_genre"); + + + sf_format_wav : constant Interfaces.C.int; + pragma Import (C, sf_format_wav, "format_wav"); + + sf_format_aiff : constant Interfaces.C.int; + pragma Import (C, sf_format_aiff, "format_aiff"); + + sf_format_au : constant Interfaces.C.int; + pragma Import (C, sf_format_au, "format_au"); + + sf_format_raw : constant Interfaces.C.int; + pragma Import (C, sf_format_raw, "format_raw"); + + sf_format_paf : constant Interfaces.C.int; + pragma Import (C, sf_format_paf, "format_paf"); + + sf_format_svx : constant Interfaces.C.int; + pragma Import (C, sf_format_svx, "format_svx"); + + sf_format_nist : constant Interfaces.C.int; + pragma Import (C, sf_format_nist, "format_nist"); + + sf_format_voc : constant Interfaces.C.int; + pragma Import (C, sf_format_voc, "format_voc"); + + sf_format_ircam : constant Interfaces.C.int; + pragma Import (C, sf_format_ircam, "format_ircam"); + + sf_format_w64 : constant Interfaces.C.int; + pragma Import (C, sf_format_w64, "format_w64"); + + sf_format_mat4 : constant Interfaces.C.int; + pragma Import (C, sf_format_mat4, "format_mat4"); + + sf_format_mat5 : constant Interfaces.C.int; + pragma Import (C, sf_format_mat5, "format_mat5"); + + sf_format_pvf : constant Interfaces.C.int; + pragma Import (C, sf_format_pvf, "format_pvf"); + + sf_format_xi : constant Interfaces.C.int; + pragma Import (C, sf_format_xi, "format_xi"); + + sf_format_htk : constant Interfaces.C.int; + pragma Import (C, sf_format_htk, "format_htk"); + + sf_format_sds : constant Interfaces.C.int; + pragma Import (C, sf_format_sds, "format_sds"); + + sf_format_avr : constant Interfaces.C.int; + pragma Import (C, sf_format_avr, "format_avr"); + + sf_format_wavex : constant Interfaces.C.int; + pragma Import (C, sf_format_wavex, "format_wavex"); + + sf_format_sd2 : constant Interfaces.C.int; + pragma Import (C, sf_format_sd2, "format_sd2"); + + sf_format_flac : constant Interfaces.C.int; + pragma Import (C, sf_format_flac, "format_flac"); + + sf_format_caf : constant Interfaces.C.int; + pragma Import (C, sf_format_caf, "format_caf"); + + sf_format_wve : constant Interfaces.C.int; + pragma Import (C, sf_format_wve, "format_wve"); + + sf_format_ogg : constant Interfaces.C.int; + pragma Import (C, sf_format_ogg, "format_ogg"); + + sf_format_mpc2k : constant Interfaces.C.int; + pragma Import (C, sf_format_mpc2k, "format_mpc2k"); + + sf_format_rf64 : constant Interfaces.C.int; + pragma Import (C, sf_format_rf64, "format_rf64"); + + sf_format_mpeg : constant Interfaces.C.int; + pragma Import (C, sf_format_mpeg, "format_mpeg"); + + + sf_format_pcm_s8 : constant Interfaces.C.int; + pragma Import (C, sf_format_pcm_s8, "format_pcm_s8"); + + sf_format_pcm_16 : constant Interfaces.C.int; + pragma Import (C, sf_format_pcm_16, "format_pcm_16"); + + sf_format_pcm_24 : constant Interfaces.C.int; + pragma Import (C, sf_format_pcm_24, "format_pcm_24"); + + sf_format_pcm_32 : constant Interfaces.C.int; + pragma Import (C, sf_format_pcm_32, "format_pcm_32"); + + sf_format_pcm_u8 : constant Interfaces.C.int; + pragma Import (C, sf_format_pcm_u8, "format_pcm_u8"); + + sf_format_float : constant Interfaces.C.int; + pragma Import (C, sf_format_float, "format_float"); + + sf_format_double : constant Interfaces.C.int; + pragma Import (C, sf_format_double, "format_double"); + + sf_format_ulaw : constant Interfaces.C.int; + pragma Import (C, sf_format_ulaw, "format_ulaw"); + + sf_format_alaw : constant Interfaces.C.int; + pragma Import (C, sf_format_alaw, "format_alaw"); + + sf_format_ima_adpcm : constant Interfaces.C.int; + pragma Import (C, sf_format_ima_adpcm, "format_ima_adpcm"); + + sf_format_ms_adpcm : constant Interfaces.C.int; + pragma Import (C, sf_format_ms_adpcm, "format_ms_adpcm"); + + sf_format_gsm610 : constant Interfaces.C.int; + pragma Import (C, sf_format_gsm610, "format_gsm610"); + + sf_format_vox_adpcm : constant Interfaces.C.int; + pragma Import (C, sf_format_vox_adpcm, "format_vox_adpcm"); + + sf_format_nms_adpcm_16 : constant Interfaces.C.int; + pragma Import (C, sf_format_nms_adpcm_16, "format_nms_adpcm_16"); + + sf_format_nms_adpcm_24 : constant Interfaces.C.int; + pragma Import (C, sf_format_nms_adpcm_24, "format_nms_adpcm_24"); + + sf_format_nms_adpcm_32 : constant Interfaces.C.int; + pragma Import (C, sf_format_nms_adpcm_32, "format_nms_adpcm_32"); + + sf_format_g721_32 : constant Interfaces.C.int; + pragma Import (C, sf_format_g721_32, "format_g721_32"); + + sf_format_g723_24 : constant Interfaces.C.int; + pragma Import (C, sf_format_g723_24, "format_g723_24"); + + sf_format_g723_40 : constant Interfaces.C.int; + pragma Import (C, sf_format_g723_40, "format_g723_40"); + + sf_format_dwvw_12 : constant Interfaces.C.int; + pragma Import (C, sf_format_dwvw_12, "format_dwvw_12"); + + sf_format_dwvw_16 : constant Interfaces.C.int; + pragma Import (C, sf_format_dwvw_16, "format_dwvw_16"); + + sf_format_dwvw_24 : constant Interfaces.C.int; + pragma Import (C, sf_format_dwvw_24, "format_dwvw_24"); + + sf_format_dwvw_n : constant Interfaces.C.int; + pragma Import (C, sf_format_dwvw_n, "format_dwvw_n"); + + sf_format_dpcm_8 : constant Interfaces.C.int; + pragma Import (C, sf_format_dpcm_8, "format_dpcm_8"); + + sf_format_dpcm_16 : constant Interfaces.C.int; + pragma Import (C, sf_format_dpcm_16, "format_dpcm_16"); + + sf_format_vorbis : constant Interfaces.C.int; + pragma Import (C, sf_format_vorbis, "format_vorbis"); + + sf_format_opus : constant Interfaces.C.int; + pragma Import (C, sf_format_opus, "format_opus"); + + sf_format_alac_16 : constant Interfaces.C.int; + pragma Import (C, sf_format_alac_16, "format_alac_16"); + + sf_format_alac_20 : constant Interfaces.C.int; + pragma Import (C, sf_format_alac_20, "format_alac_20"); + + sf_format_alac_24 : constant Interfaces.C.int; + pragma Import (C, sf_format_alac_24, "format_alac_24"); + + sf_format_alac_32 : constant Interfaces.C.int; + pragma Import (C, sf_format_alac_32, "format_alac_32"); + + sf_format_mpeg_layer_i : constant Interfaces.C.int; + pragma Import (C, sf_format_mpeg_layer_i, "format_mpeg_layer_i"); + + sf_format_mpeg_layer_ii : constant Interfaces.C.int; + pragma Import (C, sf_format_mpeg_layer_ii, "format_mpeg_layer_ii"); + + sf_format_mpeg_layer_iii : constant Interfaces.C.int; + pragma Import (C, sf_format_mpeg_layer_iii, "format_mpeg_layer_iii"); + + + sf_endian_file : constant Interfaces.C.int; + pragma Import (C, sf_endian_file, "endian_file"); + + sf_endian_little : constant Interfaces.C.int; + pragma Import (C, sf_endian_little, "endian_little"); + + sf_endian_big : constant Interfaces.C.int; + pragma Import (C, sf_endian_big, "endian_big"); + + sf_endian_cpu : constant Interfaces.C.int; + pragma Import (C, sf_endian_cpu, "endian_cpu"); + + + sf_err_no_error : constant Interfaces.C.int; + pragma Import (C, sf_err_no_error, "err_no_error"); + + sf_err_unrecognised_format : constant Interfaces.C.int; + pragma Import (C, sf_err_unrecognised_format, "err_unrecognised_format"); + + sf_err_system : constant Interfaces.C.int; + pragma Import (C, sf_err_system, "err_system"); + + sf_err_malformed_file : constant Interfaces.C.int; + pragma Import (C, sf_err_malformed_file, "err_malformed_file"); + + sf_err_unsupported_encoding : constant Interfaces.C.int; + pragma Import (C, sf_err_unsupported_encoding, "err_unsupported_encoding"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function asf_open + (Path : in Interfaces.C.char_array; + Mode : in Interfaces.C.int; + Sfinfo : in out File_Info) + return System.Address; + pragma Import (C, asf_open, "asf_open"); + + function asf_format_check + (Sfinfo : in File_Info) + return Interfaces.C.int; + pragma Import (C, asf_format_check, "asf_format_check"); + + function asf_seek + (Sndfile : in System.Address; + Frames : in Interfaces.Integer_64; + Whence : in Interfaces.C.int) + return Interfaces.Integer_64; + pragma Import (C, asf_seek, "asf_seek"); + pragma Inline (asf_seek); + + function sf_close + (File : in System.Address) + return Interfaces.C.int; + pragma Import (C, sf_close, "sf_close"); + + procedure sf_write_sync + (File : in System.Address); + pragma Import (C, sf_write_sync, "sf_write_sync"); + + function asf_readf_short + (File : in System.Address; + DPtr : out C_Short_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_readf_short, "asf_readf_short"); + pragma Inline (asf_readf_short); + + function asf_readf_int + (File : in System.Address; + DPtr : out C_Integer_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_readf_int, "asf_readf_int"); + pragma Inline (asf_readf_int); + + function asf_readf_float + (File : in System.Address; + DPtr : out C_Float_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_readf_float, "asf_readf_float"); + pragma Inline (asf_readf_float); + + function asf_readf_double + (File : in System.Address; + DPtr : out C_Double_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_readf_double, "asf_readf_double"); + pragma Inline (asf_readf_double); + + function asf_writef_short + (File : in System.Address; + DPtr : in C_Short_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_writef_short, "asf_writef_short"); + pragma Inline (asf_writef_short); + + function asf_writef_int + (File : in System.Address; + DPtr : in C_Integer_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_writef_int, "asf_writef_int"); + pragma Inline (asf_writef_int); + + function asf_writef_float + (File : in System.Address; + DPtr : in C_Float_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_writef_float, "asf_writef_float"); + pragma Inline (asf_writef_float); + + function asf_writef_double + (File : in System.Address; + DPtr : in C_Double_Data; + Items : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_writef_double, "asf_writef_double"); + pragma Inline (asf_writef_double); + + function asf_read_raw + (File : in System.Address; + DPtr : in System.Address; + Bytes : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_read_raw, "asf_read_raw"); + pragma Inline (asf_read_raw); + + function asf_write_raw + (File : in System.Address; + DPtr : in System.Address; + Bytes : in Interfaces.Integer_64) + return Interfaces.Integer_64; + pragma Import (C, asf_write_raw, "asf_write_raw"); + pragma Inline (asf_write_raw); + + function sf_get_string + (File : in System.Address; + Kind : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, sf_get_string, "sf_get_string"); + + function sf_set_string + (File : in System.Address; + Kind : in Interfaces.C.int; + Str : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, sf_set_string, "sf_set_string"); + + function sf_version_string + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, sf_version_string, "sf_version_string"); + + function sf_current_byterate + (File : in System.Address) + return Interfaces.C.int; + pragma Import (C, sf_current_byterate, "sf_current_byterate"); + + + function sf_error_number + (Num : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, sf_error_number, "sf_error_number"); + + + + + ------------------------ + -- Internal Utility -- + ------------------------ + + procedure Raise_Error + (Num : in Interfaces.C.int) is + begin + if Num = sf_err_unrecognised_format then + raise Unrecognised_Format_Error; + elsif Num = sf_err_system then + raise System_Error; + elsif Num = sf_err_malformed_file then + raise Malformed_File_Error; + elsif Num = sf_err_unsupported_encoding then + raise Unsupported_Encoding_Error; + else + raise General_Failure with Interfaces.C.Strings.Value (sf_error_number (Num)); + end if; + end Raise_Error; + + function To_Major + (Num : in Interfaces.C.int) + return Major_Format is + begin + if Num = 0 then + return Format_Unknown; + elsif Num = sf_format_wav then + return Wav_Format; + elsif Num = sf_format_aiff then + return Aiff_Format; + elsif Num = sf_format_au then + return Au_Format; + elsif Num = sf_format_raw then + return Raw_Format; + elsif Num = sf_format_paf then + return Paf_Format; + elsif Num = sf_format_svx then + return Svx_Format; + elsif Num = sf_format_nist then + return Nist_Format; + elsif Num = sf_format_voc then + return Voc_Format; + elsif Num = sf_format_ircam then + return Ircam_Format; + elsif Num = sf_format_w64 then + return W64_Format; + elsif Num = sf_format_mat4 then + return Mat4_Format; + elsif Num = sf_format_mat5 then + return Mat5_Format; + elsif Num = sf_format_pvf then + return Pvf_Format; + elsif Num = sf_format_xi then + return Xi_Format; + elsif Num = sf_format_htk then + return Htk_Format; + elsif Num = sf_format_sds then + return Sds_Format; + elsif Num = sf_format_avr then + return Avr_Format; + elsif Num = sf_format_wavex then + return Wavex_Format; + elsif Num = sf_format_sd2 then + return Sd2_Format; + elsif Num = sf_format_flac then + return Flac_Format; + elsif Num = sf_format_caf then + return Caf_Format; + elsif Num = sf_format_wve then + return Wve_Format; + elsif Num = sf_format_ogg then + return Ogg_Format; + elsif Num = sf_format_mpc2k then + return Mpc2k_Format; + elsif Num = sf_format_rf64 then + return Rf64_Format; + elsif Num = sf_format_mpeg then + return Mpeg_Format; + else + raise Program_Error; + end if; + end To_Major; + + function To_Minor + (Num : in Interfaces.C.int) + return Minor_Format is + begin + if Num = 0 then + return Encoding_Unknown; + elsif Num = sf_format_pcm_s8 then + return Pcm_S8_Encoding; + elsif Num = sf_format_pcm_16 then + return Pcm_16_Encoding; + elsif Num = sf_format_pcm_24 then + return Pcm_24_Encoding; + elsif Num = sf_format_pcm_32 then + return Pcm_32_Encoding; + elsif Num = sf_format_pcm_u8 then + return Pcm_U8_Encoding; + elsif Num = sf_format_float then + return Float_Encoding; + elsif Num = sf_format_double then + return Double_Encoding; + elsif Num = sf_format_ulaw then + return Ulaw_Encoding; + elsif Num = sf_format_alaw then + return Alaw_Encoding; + elsif Num = sf_format_ima_adpcm then + return Ima_Adpcm_Encoding; + elsif Num = sf_format_ms_adpcm then + return Ms_Adpcm_Encoding; + elsif Num = sf_format_gsm610 then + return Gsm610_Encoding; + elsif Num = sf_format_vox_adpcm then + return Vox_Adpcm_Encoding; + elsif Num = sf_format_nms_adpcm_16 then + return Nms_Adpcm_16_Encoding; + elsif Num = sf_format_nms_adpcm_24 then + return Nms_Adpcm_24_Encoding; + elsif Num = sf_format_nms_adpcm_32 then + return Nms_Adpcm_32_Encoding; + elsif Num = sf_format_g721_32 then + return G721_32_Encoding; + elsif Num = sf_format_g723_24 then + return G723_24_Encoding; + elsif Num = sf_format_g723_40 then + return G723_40_Encoding; + elsif Num = sf_format_dwvw_12 then + return Dwvw_12_Encoding; + elsif Num = sf_format_dwvw_16 then + return Dwvw_16_Encoding; + elsif Num = sf_format_dwvw_24 then + return Dwvw_24_Encoding; + elsif Num = sf_format_dwvw_n then + return Dwvw_N_Encoding; + elsif Num = sf_format_dpcm_8 then + return Dpcm_8_Encoding; + elsif Num = sf_format_dpcm_16 then + return Dpcm_16_Encoding; + elsif Num = sf_format_vorbis then + return Vorbis_Encoding; + elsif Num = sf_format_opus then + return Opus_Encoding; + elsif Num = sf_format_alac_16 then + return Alac_16_Encoding; + elsif Num = sf_format_alac_20 then + return Alac_20_Encoding; + elsif Num = sf_format_alac_24 then + return Alac_24_Encoding; + elsif Num = sf_format_alac_32 then + return Alac_32_Encoding; + elsif Num = sf_format_mpeg_layer_i then + return Mpeg_Layer_I_Encoding; + elsif Num = sf_format_mpeg_layer_ii then + return Mpeg_Layer_II_Encoding; + elsif Num = sf_format_mpeg_layer_iii then + return Mpeg_Layer_III_Encoding; + else + raise Program_Error; + end if; + end To_Minor; + + function To_Endian + (Num : in Interfaces.C.int) + return Endianness is + begin + if Num = sf_endian_file then + return Default_Endian; + elsif Num = sf_endian_little then + return Little_Endian; + elsif Num = sf_endian_big then + return Big_Endian; + elsif Num = sf_endian_cpu then + return Machine_Native; + else + raise Program_Error; + end if; + end To_Endian; + + function To_Cint + (Major : in Major_Format) + return Interfaces.C.int is + begin + case Major is + when Format_Unknown => return 0; + when Wav_Format => return sf_format_wav; + when Aiff_Format => return sf_format_aiff; + when Au_Format => return sf_format_au; + when Raw_Format => return sf_format_raw; + when Paf_Format => return sf_format_paf; + when Svx_Format => return sf_format_svx; + when Nist_Format => return sf_format_nist; + when Voc_Format => return sf_format_voc; + when Ircam_Format => return sf_format_ircam; + when W64_Format => return sf_format_w64; + when Mat4_Format => return sf_format_mat4; + when Mat5_Format => return sf_format_mat5; + when Pvf_Format => return sf_format_pvf; + when Xi_Format => return sf_format_xi; + when Htk_Format => return sf_format_htk; + when Sds_Format => return sf_format_sds; + when Avr_Format => return sf_format_avr; + when Wavex_Format => return sf_format_wavex; + when Sd2_Format => return sf_format_sd2; + when Flac_Format => return sf_format_flac; + when Caf_Format => return sf_format_caf; + when Wve_Format => return sf_format_wve; + when Ogg_Format => return sf_format_ogg; + when Mpc2k_Format => return sf_format_mpc2k; + when Rf64_Format => return sf_format_rf64; + when Mpeg_Format => return sf_format_mpeg; + end case; + end To_Cint; + + function To_Cint + (Minor : in Minor_Format) + return Interfaces.C.int is + begin + case Minor is + when Encoding_Unknown => return 0; + when Pcm_S8_Encoding => return sf_format_pcm_s8; + when Pcm_16_Encoding => return sf_format_pcm_16; + when Pcm_24_Encoding => return sf_format_pcm_24; + when Pcm_32_Encoding => return sf_format_pcm_32; + when Pcm_U8_Encoding => return sf_format_pcm_u8; + when Float_Encoding => return sf_format_float; + when Double_Encoding => return sf_format_double; + when Ulaw_Encoding => return sf_format_ulaw; + when Alaw_Encoding => return sf_format_alaw; + when Ima_Adpcm_Encoding => return sf_format_ima_adpcm; + when Ms_Adpcm_Encoding => return sf_format_ms_adpcm; + when Gsm610_Encoding => return sf_format_gsm610; + when Vox_Adpcm_Encoding => return sf_format_vox_adpcm; + when Nms_Adpcm_16_Encoding => return sf_format_nms_adpcm_16; + when Nms_Adpcm_24_Encoding => return sf_format_nms_adpcm_24; + when Nms_Adpcm_32_Encoding => return sf_format_nms_adpcm_32; + when G721_32_Encoding => return sf_format_g721_32; + when G723_24_Encoding => return sf_format_g723_24; + when G723_40_Encoding => return sf_format_g723_40; + when Dwvw_12_Encoding => return sf_format_dwvw_12; + when Dwvw_16_Encoding => return sf_format_dwvw_16; + when Dwvw_24_Encoding => return sf_format_dwvw_24; + when Dwvw_N_Encoding => return sf_format_dwvw_n; + when Dpcm_8_Encoding => return sf_format_dpcm_8; + when Dpcm_16_Encoding => return sf_format_dpcm_16; + when Vorbis_Encoding => return sf_format_vorbis; + when Opus_Encoding => return sf_format_opus; + when Alac_16_Encoding => return sf_format_alac_16; + when Alac_20_Encoding => return sf_format_alac_20; + when Alac_24_Encoding => return sf_format_alac_24; + when Alac_32_Encoding => return sf_format_alac_32; + when Mpeg_Layer_I_Encoding => return sf_format_mpeg_layer_i; + when Mpeg_Layer_II_Encoding => return sf_format_mpeg_layer_ii; + when Mpeg_Layer_III_Encoding => return sf_format_mpeg_layer_iii; + end case; + end To_Cint; + + function To_Cint + (Endian : in Endianness) + return Interfaces.C.int is + begin + case Endian is + when Default_Endian => return sf_endian_file; + when Little_Endian => return sf_endian_little; + when Big_Endian => return sf_endian_big; + when Machine_Native => return sf_endian_cpu; + end case; + end To_Cint; + + + + + ---------------------------------- + -- Data Structure Subprograms -- + ---------------------------------- + + function Create + (Rate : in Positive; + Channels : in Positive; + Major : in Major_Format; + Minor : in Minor_Format; + Endian : in Endianness := Default_Endian) + return File_Info is + begin + return This : File_Info do + This.My_Frames := 0; + This.My_Sample_Rate := Interfaces.C.int (Rate); + This.My_Channels := Interfaces.C.int (Channels); + This.My_Major := To_Cint (Major); + This.My_Minor := To_Cint (Minor); + This.My_Endian := To_Cint (Endian); + This.My_Sections := 0; + This.My_Seekable := 0; + end return; + end Create; + + function Frames + (Info : in File_Info) + return Count_Type is + begin + return Count_Type (Info.My_Frames); + end Frames; + + function Rate + (Info : in File_Info) + return Natural is + begin + return Natural (Info.My_Sample_Rate); + end Rate; + + function Channels + (Info : in File_Info) + return Natural is + begin + return Natural (Info.My_Channels); + end Channels; + + function Major + (Info : in File_Info) + return Major_Format is + begin + return To_Major (Info.My_Major); + end Major; + + function Minor + (Info : in File_Info) + return Minor_Format is + begin + return To_Minor (Info.My_Minor); + end Minor; + + function Endian + (Info : in File_Info) + return Endianness is + begin + return To_Endian (Info.My_Endian); + end Endian; + + function Sections + (Info : in File_Info) + return Natural is + begin + return Natural (Info.My_Sections); + end Sections; + + function Seekable + (Info : in File_Info) + return Boolean is + begin + if Info.My_Seekable = sf_false then + return False; + elsif Info.My_Seekable = sf_true then + return True; + else + raise Program_Error; + end if; + end Seekable; + + + + + --------------- + -- Utility -- + --------------- + + function Is_Open + (File : in Sound_File) + return Boolean is + begin + return File.Ptr /= System.Null_Address; + end Is_Open; + + + + + --------------------- + -- API Interface -- + --------------------- + + procedure Open + (File : in out Sound_File; + Name : in String; + Mode : in File_Mode; + Info : in out File_Info) + is + Mode_Int : Interfaces.C.int := (case Mode is + when Read_Only => sfm_read, + when Write_Only => sfm_write, + when Read_Write => sfm_rdwr); + Result : System.Address; + begin + Result := asf_open (Interfaces.C.To_C (Name), Mode_Int, Info); + if Result = System.Null_Address then + Raise_Error (sf_error (Result)); + raise Program_Error; + else + File.Ptr := Result; + File.FMode := Mode; + File.Chans := Info.My_Channels; + end if; + end Open; + + function Format_Check + (Info : in File_Info) + return Boolean + is + Result : Interfaces.C.int := asf_format_check (Info); + begin + if Result = sf_true then + return True; + elsif Result = sf_false then + return False; + else + raise Program_Error; + end if; + end Format_Check; + + function Seek + (File : in Sound_File; + Offset : in Count_Type; + Whence : in Seek_From; + Mode : in File_Mode := Read_Write) + return Count_Type + is + Result : Interfaces.Integer_64; + My_Whence : Interfaces.Unsigned_8; + begin + My_Whence := (case Whence is + when From_Start => Interfaces.Unsigned_8 (sf_seek_set), + when From_Current => Interfaces.Unsigned_8 (sf_seek_cur), + when From_End => Interfaces.Unsigned_8 (sf_seek_end)); + if File.FMode = Read_Write then + if Mode = Read_Only then + My_Whence := My_Whence or Interfaces.Unsigned_8 (sfm_read); + elsif Mode = Write_Only then + My_Whence := My_Whence or Interfaces.Unsigned_8 (sfm_write); + end if; + end if; + Result := asf_seek + (Sndfile => File.Ptr, + Frames => Interfaces.Integer_64 (Offset), + Whence => Interfaces.C.int (My_Whence)); + if Result = -1 then + raise Seek_Error; + else + return Count_Type (Result); + end if; + end Seek; + + procedure Close + (File : in out Sound_File) + is + Result : Interfaces.C.int; + begin + Result := sf_close (File.Ptr); + if Result /= 0 then + Raise_Error (Result); + else + File.Ptr := System.Null_Address; + end if; + end Close; + + procedure Write_Sync + (File : in Sound_File) is + begin + sf_write_sync (File.Ptr); + end Write_Sync; + + function Read_Short + (File : in Sound_File; + Data : out Short_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Short_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Short_Integer'Size = Interfaces.C.short'Size); + return Count_Type (asf_readf_short (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Read_Short; + + function Read_Integer + (File : in Sound_File; + Data : out Integer_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Integer_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Integer'Size = Interfaces.C.int'Size); + return Count_Type (asf_readf_int (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Read_Integer; + + function Read_Float + (File : in Sound_File; + Data : out Float_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Float_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Float'Size = Interfaces.C.C_float'Size); + return Count_Type (asf_readf_float (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Read_Float; + + function Read_Double + (File : in Sound_File; + Data : out Double_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Double_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size); + return Count_Type (asf_readf_double (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Read_Double; + + function Write_Short + (File : in Sound_File; + Data : in Short_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Short_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Short_Integer'Size = Interfaces.C.short'Size); + return Count_Type (asf_writef_short (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Write_Short; + + function Write_Integer + (File : in Sound_File; + Data : in Integer_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Integer_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Integer'Size = Interfaces.C.int'Size); + return Count_Type (asf_writef_int (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Write_Integer; + + function Write_Float + (File : in Sound_File; + Data : in Float_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Float_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Float'Size = Interfaces.C.C_float'Size); + return Count_Type (asf_writef_float (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Write_Float; + + function Write_Double + (File : in Sound_File; + Data : in Double_Data; + Frames : in Count_Type) + return Count_Type + is + Buffer : C_Double_Data (Data'First .. Data'Last); + for Buffer'Address use Data'Address; + pragma Import (Ada, Buffer); + begin + Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size); + return Count_Type (asf_writef_double (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); + end Write_Double; + + function Read_Raw + (File : in Sound_File; + Data : out Raw_Data; + Bytes : in Count_Type) + return Count_Type is + begin + Ada.Assertions.Assert (Character'Size = 8); + return Count_Type (asf_read_raw (File.Ptr, Data'Address, Interfaces.Integer_64 (Bytes))); + end Read_Raw; + + function Write_Raw + (File : in Sound_File; + Data : in Raw_Data; + Bytes : in Count_Type) + return Count_Type is + begin + Ada.Assertions.Assert (Character'Size = 8); + return Count_Type (asf_write_raw (File.Ptr, Data'Address, Interfaces.Integer_64 (Bytes))); + end Write_Raw; + + function Get_Meta + (File : in Sound_File; + Kind : in Metadata) + return String + is + Result : Interfaces.C.Strings.chars_ptr; + begin + Result := sf_get_string + (File.Ptr, + (case Kind is + when Title_String => sf_str_title, + when Copyright_String => sf_str_copyright, + when Software_String => sf_str_software, + when Artist_String => sf_str_artist, + when Comment_String => sf_str_comment, + when Date_String => sf_str_date, + when Album_String => sf_str_album, + when License_String => sf_str_license, + when Track_Number_String => sf_str_tracknumber, + when Genre_String => sf_str_genre)); + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Get_Meta; + + procedure Set_Meta + (File : in Sound_File; + Kind : in Metadata; + Value : in String) + is + Result : Interfaces.C.int; + begin + Result := sf_set_string + (File.Ptr, + (case Kind is + when Title_String => sf_str_title, + when Copyright_String => sf_str_copyright, + when Software_String => sf_str_software, + when Artist_String => sf_str_artist, + when Comment_String => sf_str_comment, + when Date_String => sf_str_date, + when Album_String => sf_str_album, + when License_String => sf_str_license, + when Track_Number_String => sf_str_tracknumber, + when Genre_String => sf_str_genre), + Interfaces.C.To_C (Value)); + if Result /= 0 then + Raise_Error (Result); + end if; + end Set_Meta; + + function Version_String + return String is + begin + return Interfaces.C.Strings.Value (sf_version_string); + end Version_String; + + function Current_Byterate + (File : in Sound_File) + return Natural + is + Result : Interfaces.C.int := sf_current_byterate (File.Ptr); + begin + if Result >= 0 then + return Natural (Result); + elsif Result = -1 then + raise Unknown_Byterate_Error; + else + raise Program_Error; + end if; + end Current_Byterate; + + +end Libsndfile; + + -- cgit