-- Programmed by Jedidiah Barber -- Released into the public domain pragma Ada_2012; 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 C_File_Info) return System.Address; pragma Import (C, asf_open, "asf_open"); function asf_format_check (Sfinfo : in C_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.Data.My_Frames := 0; This.Data.My_Sample_Rate := Interfaces.C.int (Rate); This.Data.My_Channels := Interfaces.C.int (Channels); This.Data.My_Major := To_Cint (Major); This.Data.My_Minor := To_Cint (Minor); This.Data.My_Endian := To_Cint (Endian); This.Data.My_Sections := 0; This.Data.My_Seekable := 0; end return; end Create; function Frames (Info : in File_Info) return Count_Type is begin return Count_Type (Info.Data.My_Frames); end Frames; function Rate (Info : in File_Info) return Natural is begin return Natural (Info.Data.My_Sample_Rate); end Rate; function Channels (Info : in File_Info) return Natural is begin return Natural (Info.Data.My_Channels); end Channels; function Major (Info : in File_Info) return Major_Format is begin return To_Major (Info.Data.My_Major); end Major; function Minor (Info : in File_Info) return Minor_Format is begin return To_Minor (Info.Data.My_Minor); end Minor; function Endian (Info : in File_Info) return Endianness is begin return To_Endian (Info.Data.My_Endian); end Endian; function Sections (Info : in File_Info) return Natural is begin return Natural (Info.Data.My_Sections); end Sections; function Seekable (Info : in File_Info) return Boolean is begin if Info.Data.My_Seekable = sf_false then return False; elsif Info.Data.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'Class) 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.Data); if Result = System.Null_Address then Raise_Error (sf_error (Result)); raise Program_Error; else File.Ptr := Result; File.FMode := Mode; File.Chans := Info.Data.My_Channels; end if; end Open; function Format_Check (Info : in File_Info) return Boolean is Result : Interfaces.C.int := asf_format_check (Info.Data); 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;