diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_asndfile.c | 189 | ||||
| -rw-r--r-- | src/c_asndfile.h | 141 | ||||
| -rw-r--r-- | src/c_asndfile_command.c | 112 | ||||
| -rw-r--r-- | src/c_asndfile_command.h | 86 | ||||
| -rw-r--r-- | src/c_asndfile_virtual.c | 71 | ||||
| -rw-r--r-- | src/c_asndfile_virtual.h | 26 | ||||
| -rw-r--r-- | src/libsndfile-commands.adb | 1305 | ||||
| -rw-r--r-- | src/libsndfile-commands.ads | 442 | ||||
| -rw-r--r-- | src/libsndfile-virtual.adb | 162 | ||||
| -rw-r--r-- | src/libsndfile-virtual.ads | 116 | ||||
| -rw-r--r-- | src/libsndfile.adb | 1094 | ||||
| -rw-r--r-- | src/libsndfile.ads | 452 |
12 files changed, 4196 insertions, 0 deletions
diff --git a/src/c_asndfile.c b/src/c_asndfile.c new file mode 100644 index 0000000..116fa0c --- /dev/null +++ b/src/c_asndfile.c @@ -0,0 +1,189 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <sndfile.h> +#include "c_asndfile.h" + + + +const int sf_false = SF_FALSE; +const int sf_true = SF_TRUE; + +const int sfm_read = SFM_READ; +const int sfm_write = SFM_WRITE; +const int sfm_rdwr = SFM_RDWR; + +const int sf_seek_set = SF_SEEK_SET; +const int sf_seek_cur = SF_SEEK_CUR; +const int sf_seek_end = SF_SEEK_END; + +const int sf_str_title = SF_STR_TITLE; +const int sf_str_copyright = SF_STR_COPYRIGHT; +const int sf_str_software = SF_STR_SOFTWARE; +const int sf_str_artist = SF_STR_ARTIST; +const int sf_str_comment = SF_STR_COMMENT; +const int sf_str_date = SF_STR_DATE; +const int sf_str_album = SF_STR_ALBUM; +const int sf_str_license = SF_STR_LICENSE; +const int sf_str_tracknumber = SF_STR_TRACKNUMBER; +const int sf_str_genre = SF_STR_GENRE; + +const int format_wav = SF_FORMAT_WAV; +const int format_aiff = SF_FORMAT_AIFF; +const int format_au = SF_FORMAT_AU; +const int format_raw = SF_FORMAT_RAW; +const int format_paf = SF_FORMAT_PAF; +const int format_svx = SF_FORMAT_SVX; +const int format_nist = SF_FORMAT_NIST; +const int format_voc = SF_FORMAT_VOC; +const int format_ircam = SF_FORMAT_IRCAM; +const int format_w64 = SF_FORMAT_W64; +const int format_mat4 = SF_FORMAT_MAT4; +const int format_mat5 = SF_FORMAT_MAT5; +const int format_pvf = SF_FORMAT_PVF; +const int format_xi = SF_FORMAT_XI; +const int format_htk = SF_FORMAT_HTK; +const int format_sds = SF_FORMAT_SDS; +const int format_avr = SF_FORMAT_AVR; +const int format_wavex = SF_FORMAT_WAVEX; +const int format_sd2 = SF_FORMAT_SD2; +const int format_flac = SF_FORMAT_FLAC; +const int format_caf = SF_FORMAT_CAF; +const int format_wve = SF_FORMAT_WVE; +const int format_ogg = SF_FORMAT_OGG; +const int format_mpc2k = SF_FORMAT_MPC2K; +const int format_rf64 = SF_FORMAT_RF64; +const int format_mpeg = SF_FORMAT_MPEG; + +const int format_pcm_s8 = SF_FORMAT_PCM_S8; +const int format_pcm_16 = SF_FORMAT_PCM_16; +const int format_pcm_24 = SF_FORMAT_PCM_24; +const int format_pcm_32 = SF_FORMAT_PCM_32; +const int format_pcm_u8 = SF_FORMAT_PCM_U8; +const int format_float = SF_FORMAT_FLOAT; +const int format_double = SF_FORMAT_DOUBLE; +const int format_ulaw = SF_FORMAT_ULAW; +const int format_alaw = SF_FORMAT_ALAW; +const int format_ima_adpcm = SF_FORMAT_IMA_ADPCM; +const int format_ms_adpcm = SF_FORMAT_MS_ADPCM; +const int format_gsm610 = SF_FORMAT_GSM610; +const int format_vox_adpcm = SF_FORMAT_VOX_ADPCM; +const int format_nms_adpcm_16 = SF_FORMAT_NMS_ADPCM_16; +const int format_nms_adpcm_24 = SF_FORMAT_NMS_ADPCM_24; +const int format_nms_adpcm_32 = SF_FORMAT_NMS_ADPCM_32; +const int format_g721_32 = SF_FORMAT_G721_32; +const int format_g723_24 = SF_FORMAT_G723_24; +const int format_g723_40 = SF_FORMAT_G723_40; +const int format_dwvw_12 = SF_FORMAT_DWVW_12; +const int format_dwvw_16 = SF_FORMAT_DWVW_16; +const int format_dwvw_24 = SF_FORMAT_DWVW_24; +const int format_dwvw_n = SF_FORMAT_DWVW_N; +const int format_dpcm_8 = SF_FORMAT_DPCM_8; +const int format_dpcm_16 = SF_FORMAT_DPCM_16; +const int format_vorbis = SF_FORMAT_VORBIS; +const int format_opus = SF_FORMAT_OPUS; +const int format_alac_16 = SF_FORMAT_ALAC_16; +const int format_alac_20 = SF_FORMAT_ALAC_20; +const int format_alac_24 = SF_FORMAT_ALAC_24; +const int format_alac_32 = SF_FORMAT_ALAC_32; +const int format_mpeg_layer_i = SF_FORMAT_MPEG_LAYER_I; +const int format_mpeg_layer_ii = SF_FORMAT_MPEG_LAYER_II; +const int format_mpeg_layer_iii = SF_FORMAT_MPEG_LAYER_III; + +const int endian_file = SF_ENDIAN_FILE; +const int endian_little = SF_ENDIAN_LITTLE; +const int endian_big = SF_ENDIAN_BIG; +const int endian_cpu = SF_ENDIAN_CPU; + +const int err_no_error = SF_ERR_NO_ERROR; +const int err_unrecognised_format = SF_ERR_UNRECOGNISED_FORMAT; +const int err_system = SF_ERR_SYSTEM; +const int err_malformed_file = SF_ERR_MALFORMED_FILE; +const int err_unsupported_encoding = SF_ERR_UNSUPPORTED_ENCODING; + + + +SNDFILE * asf_open(const char * path, int mode, Asf_Info * sfinfo) { + SF_INFO actual; + + actual.frames = (sf_count_t)sfinfo->frames; + actual.samplerate = sfinfo->samplerate; + actual.channels = sfinfo->channels; + actual.format = sfinfo->major & sfinfo->minor & sfinfo->endian; + actual.sections = sfinfo->sections; + actual.seekable = sfinfo->seekable; + + SNDFILE * result = sf_open(path, mode, &actual); + if (result == NULL) { return NULL; } + + sfinfo->frames = (long long)actual.frames; + sfinfo->samplerate = actual.samplerate; + sfinfo->channels = actual.channels; + sfinfo->major = actual.format & SF_FORMAT_TYPEMASK; + sfinfo->minor = actual.format & SF_FORMAT_SUBMASK; + sfinfo->endian = actual.format & SF_FORMAT_ENDMASK; + sfinfo->sections = actual.sections; + sfinfo->seekable = actual.seekable; + + return result; +} + + +int asf_format_check(Asf_Info * sfinfo) { + SF_INFO actual; + + actual.frames = (sf_count_t)sfinfo->frames; + actual.samplerate = sfinfo->samplerate; + actual.channels = sfinfo->channels; + actual.format = sfinfo->major & sfinfo->minor & sfinfo->endian; + actual.sections = sfinfo->sections; + actual.seekable = sfinfo->seekable; + + return sf_format_check (&actual); +} + + +int64_t asf_seek(SNDFILE * sndfile, int64_t frames, int whence) { + return (int64_t) sf_seek(sndfile, (sf_count_t) frames, whence); +} + + +int64_t asf_readf_short(SNDFILE * sndfile, short *ptr, int64_t items) { + return (int64_t) sf_readf_short(sndfile, ptr, (sf_count_t) items); +} +int64_t asf_readf_int(SNDFILE * sndfile, int * ptr, int64_t items) { + return (int64_t) sf_readf_int(sndfile, ptr, (sf_count_t) items); +} +int64_t asf_readf_float(SNDFILE * sndfile, float * ptr, int64_t items) { + return (int64_t) sf_readf_float(sndfile, ptr, (sf_count_t) items); +} +int64_t asf_readf_double(SNDFILE * sndfile, double * ptr, int64_t items) { + return (int64_t) sf_readf_double(sndfile, ptr, (sf_count_t) items); +} + + +int64_t asf_writef_short(SNDFILE * sndfile, short * ptr, int64_t items) { + return (int64_t) sf_writef_short(sndfile, ptr, (sf_count_t) items); +} +int64_t asf_writef_int(SNDFILE * sndfile, int * ptr, int64_t items) { + return (int64_t) sf_writef_int(sndfile, ptr, (sf_count_t) items); +} +int64_t asf_writef_float(SNDFILE * sndfile, float * ptr, int64_t items) { + return (int64_t) sf_writef_float(sndfile, ptr, (sf_count_t) items); +} +int64_t asf_writef_double(SNDFILE * sndfile, double * ptr, int64_t items) { + return (int64_t) sf_writef_double(sndfile, ptr, (sf_count_t) items); +} + + +int64_t asf_read_raw(SNDFILE * sndfile, void * ptr, int64_t bytes) { + return (int64_t) sf_read_raw(sndfile, ptr, (sf_count_t) bytes); +} +int64_t asf_write_raw(SNDFILE * sndfile, void * ptr, int64_t bytes) { + return (int64_t) sf_write_raw(sndfile, ptr, (sf_count_t) bytes); +} + + diff --git a/src/c_asndfile.h b/src/c_asndfile.h new file mode 100644 index 0000000..8c2a173 --- /dev/null +++ b/src/c_asndfile.h @@ -0,0 +1,141 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef ASNDFILE_GUARD +#define ASNDFILE_GUARD + +#include <sndfile.h> + + +extern const int sf_false; +extern const int sf_true; + +extern const int sfm_read; +extern const int sfm_write; +extern const int sfm_rdwr; + +extern const int sf_seek_set; +extern const int sf_seek_cur; +extern const int sf_seek_end; + +extern const int sf_str_title; +extern const int sf_str_copyright; +extern const int sf_str_software; +extern const int sf_str_artist; +extern const int sf_str_comment; +extern const int sf_str_date; +extern const int sf_str_album; +extern const int sf_str_license; +extern const int sf_str_tracknumber; +extern const int sf_str_genre; + +extern const int format_wav; +extern const int format_aiff; +extern const int format_au; +extern const int format_raw; +extern const int format_paf; +extern const int format_svx; +extern const int format_nist; +extern const int format_voc; +extern const int format_ircam; +extern const int format_w64; +extern const int format_mat4; +extern const int format_mat5; +extern const int format_pvf; +extern const int format_xi; +extern const int format_htk; +extern const int format_sds; +extern const int format_avr; +extern const int format_wavex; +extern const int format_sd2; +extern const int format_flac; +extern const int format_caf; +extern const int format_wve; +extern const int format_ogg; +extern const int format_mpc2k; +extern const int format_rf64; +extern const int format_mpeg; + +extern const int format_pcm_s8; +extern const int format_pcm_16; +extern const int format_pcm_24; +extern const int format_pcm_32; +extern const int format_pcm_u8; +extern const int format_float; +extern const int format_double; +extern const int format_ulaw; +extern const int format_alaw; +extern const int format_ima_adpcm; +extern const int format_ms_adpcm; +extern const int format_gsm610; +extern const int format_vox_adpcm; +extern const int format_nms_adpcm_16; +extern const int format_nms_adpcm_24; +extern const int format_nms_adpcm_32; +extern const int format_g721_32; +extern const int format_g723_24; +extern const int format_g723_40; +extern const int format_dwvw_12; +extern const int format_dwvw_16; +extern const int format_dwvw_24; +extern const int format_dwvw_n; +extern const int format_dpcm_8; +extern const int format_dpcm_16; +extern const int format_vorbis; +extern const int format_opus; +extern const int format_alac_16; +extern const int format_alac_20; +extern const int format_alac_24; +extern const int format_alac_32; +extern const int format_mpeg_layer_i; +extern const int format_mpeg_layer_ii; +extern const int format_mpeg_layer_iii; + +extern const int endian_file; +extern const int endian_little; +extern const int endian_big; +extern const int endian_cpu; + +extern const int err_no_error; +extern const int err_unrecognised_format; +extern const int err_system; +extern const int err_malformed_file; +extern const int err_unsupported_encoding; + + +typedef struct { + int64_t frames; + int samplerate; + int channels; + int major; + int minor; + int endian; + int sections; + int seekable; +} Asf_Info; + + +SNDFILE * asf_open(const char * path, int mode, Asf_Info * sfinfo); +int asf_format_check(Asf_Info * sfinfo); +int64_t asf_seek(SNDFILE * sndfile, int64_t frames, int whence); + +int64_t asf_readf_short(SNDFILE * sndfile, short * ptr, int64_t items); +int64_t asf_readf_int(SNDFILE * sndfile, int * ptr, int64_t items); +int64_t asf_readf_float(SNDFILE * sndfile, float * ptr, int64_t items); +int64_t asf_readf_double(SNDFILE * sndfile, double * ptr, int64_t items); + +int64_t asf_writef_short(SNDFILE * sndfile, short * ptr, int64_t items); +int64_t asf_writef_int(SNDFILE * sndfile, int * ptr, int64_t items); +int64_t asf_writef_float(SNDFILE * sndfile, float * ptr, int64_t items); +int64_t asf_writef_double(SNDFILE * sndfile, double * ptr, int64_t items); + +int64_t asf_read_raw(SNDFILE * sndfile, void * ptr, int64_t bytes); +int64_t asf_write_raw(SNDFILE * sndfile, void * ptr, int64_t bytes); + + +#endif + + diff --git a/src/c_asndfile_command.c b/src/c_asndfile_command.c new file mode 100644 index 0000000..1d86b1c --- /dev/null +++ b/src/c_asndfile_command.c @@ -0,0 +1,112 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <sndfile.h> +#include "c_asndfile_command.h" + + + +const int sfc_get_lib_version = SFC_GET_LIB_VERSION; +const int sfc_get_log_info = SFC_GET_LOG_INFO; +const int sfc_calc_signal_max = SFC_CALC_SIGNAL_MAX; +const int sfc_calc_norm_signal_max = SFC_CALC_NORM_SIGNAL_MAX; +const int sfc_calc_max_all_channels = SFC_CALC_MAX_ALL_CHANNELS; +const int sfc_calc_norm_max_all_channels = SFC_CALC_NORM_MAX_ALL_CHANNELS; +const int sfc_get_signal_max = SFC_GET_SIGNAL_MAX; +const int sfc_get_max_all_channels = SFC_GET_MAX_ALL_CHANNELS; +const int sfc_set_norm_float = SFC_SET_NORM_FLOAT; +const int sfc_set_norm_double = SFC_SET_NORM_DOUBLE; +const int sfc_get_norm_float = SFC_GET_NORM_FLOAT; +const int sfc_get_norm_double = SFC_GET_NORM_DOUBLE; +const int sfc_set_scale_float_int_read = SFC_SET_SCALE_FLOAT_INT_READ; +const int sfc_set_scale_int_float_write = SFC_SET_SCALE_INT_FLOAT_WRITE; +const int sfc_get_simple_format_count = SFC_GET_SIMPLE_FORMAT_COUNT; +const int sfc_get_simple_format = SFC_GET_SIMPLE_FORMAT; +const int sfc_get_format_info = SFC_GET_FORMAT_INFO; +const int sfc_get_format_major_count = SFC_GET_FORMAT_MAJOR_COUNT; +const int sfc_get_format_major = SFC_GET_FORMAT_MAJOR; +const int sfc_get_format_subtype_count = SFC_GET_FORMAT_SUBTYPE_COUNT; +const int sfc_get_format_subtype = SFC_GET_FORMAT_SUBTYPE; +const int sfc_set_add_peak_chunk = SFC_SET_ADD_PEAK_CHUNK; +const int sfc_update_header_now = SFC_UPDATE_HEADER_NOW; +const int sfc_set_update_header_auto = SFC_SET_UPDATE_HEADER_AUTO; +const int sfc_set_clipping = SFC_SET_CLIPPING; +const int sfc_get_clipping = SFC_GET_CLIPPING; +const int sfc_wavex_get_ambisonic = SFC_WAVEX_GET_AMBISONIC; +const int sfc_wavex_set_ambisonic = SFC_WAVEX_SET_AMBISONIC; +const int sfc_set_vbr_encoding_quality = SFC_SET_VBR_ENCODING_QUALITY; +const int sfc_set_ogg_page_latency_ms = SFC_SET_OGG_PAGE_LATENCY_MS; +const int sfc_get_ogg_stream_serialno = SFC_GET_OGG_STREAM_SERIALNO; +const int sfc_set_compression_level = SFC_SET_COMPRESSION_LEVEL; +const int sfc_raw_data_needs_endswap = SFC_RAW_DATA_NEEDS_ENDSWAP; +const int sfc_get_broadcast_info = SFC_GET_BROADCAST_INFO; +const int sfc_set_broadcast_info = SFC_SET_BROADCAST_INFO; +const int sfc_get_channel_map_info = SFC_GET_CHANNEL_MAP_INFO; +const int sfc_set_channel_map_info = SFC_SET_CHANNEL_MAP_INFO; +// ... +const int sfc_get_cue_count = SFC_GET_CUE_COUNT; +// ... +const int sfc_rf64_auto_downgrade = SFC_RF64_AUTO_DOWNGRADE; +const int sfc_get_original_samplerate = SFC_GET_ORIGINAL_SAMPLERATE; +const int sfc_set_original_samplerate = SFC_SET_ORIGINAL_SAMPLERATE; +const int sfc_get_bitrate_mode = SFC_GET_BITRATE_MODE; +const int sfc_set_bitrate_mode = SFC_SET_BITRATE_MODE; + +const int sf_ambisonic_none = SF_AMBISONIC_NONE; +const int sf_ambisonic_b_format = SF_AMBISONIC_B_FORMAT; + +const int sf_bitrate_mode_constant = SF_BITRATE_MODE_CONSTANT; +const int sf_bitrate_mode_average = SF_BITRATE_MODE_AVERAGE; +const int sf_bitrate_mode_variable = SF_BITRATE_MODE_VARIABLE; + +const unsigned int sf_format_typemask = SF_FORMAT_TYPEMASK; +const unsigned int sf_format_submask = SF_FORMAT_SUBMASK; +const unsigned int sf_format_endmask = SF_FORMAT_ENDMASK; + + + +int asfc_get_current_sf_info(SNDFILE * sndfile, Asf_Info * sfinfo) { + SF_INFO actual; + + int result = sf_command(sndfile, SFC_GET_CURRENT_SF_INFO, &actual, sizeof(SF_INFO)); + + sfinfo->frames = (long long)actual.frames; + sfinfo->samplerate = actual.samplerate; + sfinfo->channels = actual.channels; + sfinfo->major = actual.format & SF_FORMAT_TYPEMASK; + sfinfo->minor = actual.format & SF_FORMAT_SUBMASK; + sfinfo->endian = actual.format & SF_FORMAT_ENDMASK; + sfinfo->sections = actual.sections; + sfinfo->seekable = actual.seekable; + + return result; +} + + +int asfc_file_truncate(SNDFILE * sndfile, int64_t pos) { + sf_count_t actual = (sf_count_t) pos; + return sf_command(sndfile, SFC_FILE_TRUNCATE, &actual, sizeof(sf_count_t)); +} + + +int asfc_set_raw_start_offset(SNDFILE * sndfile, int64_t pos) { + sf_count_t actual = (sf_count_t) pos; + return sf_command(sndfile, SFC_SET_RAW_START_OFFSET, &actual, sizeof(sf_count_t)); +} + + +int asfc_get_embed_file_info(SNDFILE * sndfile, Asf_Embed * sfembed) { + SF_EMBED_FILE_INFO actual; + + int result = sf_command(sndfile, SFC_GET_EMBED_FILE_INFO, &actual, sizeof(SF_EMBED_FILE_INFO)); + + sfembed->offset = actual.offset; + sfembed->length = actual.length; + + return result; +} + + diff --git a/src/c_asndfile_command.h b/src/c_asndfile_command.h new file mode 100644 index 0000000..a9ed13e --- /dev/null +++ b/src/c_asndfile_command.h @@ -0,0 +1,86 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef ASND_COMMAND_GUARD +#define ASND_COMMAND_GUARD + +#include <sndfile.h> +#include "c_asndfile.h" + + +extern const int sfc_get_lib_version; +extern const int sfc_get_log_info; +extern const int sfc_calc_signal_max; +extern const int sfc_calc_norm_signal_max; +extern const int sfc_calc_max_all_channels; +extern const int sfc_calc_norm_max_all_channels; +extern const int sfc_get_signal_max; +extern const int sfc_get_max_all_channels; +extern const int sfc_set_norm_float; +extern const int sfc_set_norm_double; +extern const int sfc_get_norm_float; +extern const int sfc_get_norm_double; +extern const int sfc_set_scale_float_int_read; +extern const int sfc_set_scale_int_float_write; +extern const int sfc_get_simple_format_count; +extern const int sfc_get_simple_format; +extern const int sfc_get_format_info; +extern const int sfc_get_format_major_count; +extern const int sfc_get_format_major; +extern const int sfc_get_format_subtype_count; +extern const int sfc_get_format_subtype; +extern const int sfc_set_add_peak_chunk; +extern const int sfc_update_header_now; +extern const int sfc_set_update_header_auto; +extern const int sfc_set_clipping; +extern const int sfc_get_clipping; +extern const int sfc_wavex_get_ambisonic; +extern const int sfc_wavex_set_ambisonic; +extern const int sfc_set_vbr_encoding_quality; +extern const int sfc_set_ogg_page_latency_ms; +extern const int sfc_get_ogg_stream_serialno; +extern const int sfc_set_compression_level; +extern const int sfc_raw_data_needs_endswap; +extern const int sfc_get_broadcast_info; +extern const int sfc_set_broadcast_info; +extern const int sfc_get_channel_map_info; +extern const int sfc_set_channel_map_info; +// ... +extern const int sfc_get_cue_count; +// ... +extern const int sfc_rf64_auto_downgrade; +extern const int sfc_get_original_samplerate; +extern const int sfc_set_original_samplerate; +extern const int sfc_get_bitrate_mode; +extern const int sfc_set_bitrate_mode; + +extern const int sf_ambisonic_none; +extern const int sf_ambisonic_b_format; + +extern const int sf_bitrate_mode_constant; +extern const int sf_bitrate_mode_average; +extern const int sf_bitrate_mode_variable; + +extern const unsigned int sf_format_typemask; +extern const unsigned int sf_format_submask; +extern const unsigned int sf_format_endmask; + + +typedef struct { + int64_t offset; + int64_t length; +} Asf_Embed; + + +int asfc_get_current_sf_info(SNDFILE * sndfile, Asf_Info * sfinfo); +int asfc_file_truncate(SNDFILE * sndfile, int64_t pos); +int asfc_set_raw_start_offset(SNDFILE * sndfile, int64_t pos); +int asfc_get_embed_file_info(SNDFILE * sndfile, Asf_Embed * sfembed); + + +#endif + + diff --git a/src/c_asndfile_virtual.c b/src/c_asndfile_virtual.c new file mode 100644 index 0000000..a7bd941 --- /dev/null +++ b/src/c_asndfile_virtual.c @@ -0,0 +1,71 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <sndfile.h> +#include "c_asndfile_virtual.h" + + + +sf_count_t c_filelen_hook(void * user_data) { + return (sf_count_t) ada_filelen_hook(user_data); +} + + +sf_count_t c_seek_hook(sf_count_t offset, int whence, void * user_data) { + return (sf_count_t) ada_seek_hook((int64_t) offset, whence, user_data); +} + + +sf_count_t c_read_hook(void * ptr, sf_count_t count, void * user_data) { + return (sf_count_t) ada_read_hook(ptr, (int64_t) count, user_data); +} + + +sf_count_t c_write_hook(const void * ptr, sf_count_t count, void * user_data) { + return (sf_count_t) ada_write_hook(ptr, (int64_t) count, user_data); +} + + +sf_count_t c_tell_hook(void * user_data) { + return (sf_count_t) ada_tell_hook(user_data); +} + + +SF_VIRTUAL_IO hooks = { + .get_filelen = &c_filelen_hook, + .seek = &c_seek_hook, + .read = &c_read_hook, + .write = &c_write_hook, + .tell = &c_tell_hook +}; + + +SNDFILE * asf_open_virtual(int mode, Asf_Info * sfinfo, void * user_data) { + SF_INFO actual; + + actual.frames = (sf_count_t)sfinfo->frames; + actual.samplerate = sfinfo->samplerate; + actual.channels = sfinfo->channels; + actual.format = sfinfo->major & sfinfo->minor & sfinfo->endian; + actual.sections = sfinfo->sections; + actual.seekable = sfinfo->seekable; + + SNDFILE * result = sf_open_virtual(&hooks, mode, &actual, user_data); + if (result == NULL) { return NULL; } + + sfinfo->frames = (long long)actual.frames; + sfinfo->samplerate = actual.samplerate; + sfinfo->channels = actual.channels; + sfinfo->major = actual.format & SF_FORMAT_TYPEMASK; + sfinfo->minor = actual.format & SF_FORMAT_SUBMASK; + sfinfo->endian = actual.format & SF_FORMAT_ENDMASK; + sfinfo->sections = actual.sections; + sfinfo->seekable = actual.seekable; + + return result; +} + + diff --git a/src/c_asndfile_virtual.h b/src/c_asndfile_virtual.h new file mode 100644 index 0000000..0ec7906 --- /dev/null +++ b/src/c_asndfile_virtual.h @@ -0,0 +1,26 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef ASND_VIRTUAL_GUARD +#define ASND_VIRTUAL_GUARD + +#include <sndfile.h> +#include "c_asndfile.h" + + +int64_t ada_filelen_hook(void * user_data); +int64_t ada_seek_hook(int64_t offset, int whence, void * user_data); +int64_t ada_read_hook(void * ptr, int64_t count, void * user_data); +int64_t ada_write_hook(const void * ptr, int64_t count, void * user_data); +int64_t ada_tell_hook(void * user_data); + + +SNDFILE * asf_open_virtual(int mode, Asf_Info * sfinfo, void * user_data); + + +#endif + + 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; + + diff --git a/src/libsndfile-commands.ads b/src/libsndfile-commands.ads new file mode 100644 index 0000000..8540fdc --- /dev/null +++ b/src/libsndfile-commands.ads @@ -0,0 +1,442 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces; + +private with + + Interfaces.C.Strings; + + +package Libsndfile.Commands is + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + type Long_Float_Array is array (Positive range <>) of Long_Float; + + + type Format_Info is private; + + function Major + (Info : in Format_Info) + return Major_Format; + + function Minor + (Info : in Format_Info) + return Minor_Format; + + function Endian + (Info : in Format_Info) + return Endianness; + + function Name + (Info : in Format_Info) + return String; + + function Extension + (Info : in Format_Info) + return String; + + + type Embedded_Info is private; + + function Offset + (Info : in Embedded_Info) + return Count_Type; + + function Length + (Info : in Embedded_Info) + return Count_Type; + + + type Ambisonic is + (Ambisonic_Unsupported, + Ambisonic_Off, + Ambisonic_B_Format); + + subtype Compression is Long_Float range 0.0 .. 1.0; + + + type Broadcast_Info is private; + + 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 + with Pre => + Description'Length <= 256 and + Originator'Length <= 32 and + Originator_Reference'Length <= 32 and + Origination_Date'Length <= 10 and + Origination_Time'Length <= 8 and + Umid'Length <= 64 and + Reserved'Length <= 190 and + Coding_History'Length <= 256; + + function Description + (Info : in Broadcast_Info) + return String; + + function Originator + (Info : in Broadcast_Info) + return String; + + function Originator_Reference + (Info : in Broadcast_Info) + return String; + + function Origination_Date + (Info : in Broadcast_Info) + return String; + + function Origination_Time + (Info : in Broadcast_Info) + return String; + + function Time_Reference_Low + (Info : in Broadcast_Info) + return Interfaces.Unsigned_32; + + function Time_Reference_High + (Info : in Broadcast_Info) + return Interfaces.Unsigned_32; + + function Version + (Info : in Broadcast_Info) + return Short_Integer; + + function Umid + (Info : in Broadcast_Info) + return String; + + function Reserved + (Info : in Broadcast_Info) + return String; + + function Coding_History_Size + (Info : in Broadcast_Info) + return Interfaces.Unsigned_32; + + function Coding_History + (Info : in Broadcast_Info) + return String; + + + type Channel_Map is + (Map_Invalid, + Map_Mono, + Map_Left, + Map_Right, + Map_Center, + Map_Front_Left, + Map_Front_Right, + Map_Front_Center, + Map_Rear_Center, + Map_Rear_Left, + Map_Rear_Right, + Map_LFE, + Map_Front_Left_Of_Center, + Map_Front_Right_Of_Center, + Map_Side_Left, + Map_Side_Right, + Map_Top_Center, + Map_Top_Front_Left, + Map_Top_Front_Right, + Map_Top_Front_Center, + Map_Top_Rear_Left, + Map_Top_Rear_Right, + Map_Top_Rear_Center, + Map_Ambisonic_B_W, + Map_Ambisonic_B_X, + Map_Ambisonic_B_Y, + Map_Ambisonic_B_Z, + Map_Max); + + type Channel_Map_Array is array (Positive range <>) of Channel_Map; + + type Bitrate_Mode is + (Constant_Mode, + Average_Mode, + Variable_Mode); + + + + + ------------------ + -- Exceptions -- + ------------------ + + -- May be raised by Get_Signal_Maximum, Get_Maximum_All_Channels + Command_Error : exception; + + + + + --------------------- + -- API Interface -- + --------------------- + + function Get_Library_String + (Buffer : out String) + return Natural; + + function Get_Log_Info + (File : in Sound_File; + Buffer : out String) + return Natural; + + function Get_Current_File_Info + (File : in Sound_File) + return File_Info; + + function Calculate_Signal_Maximum + (File : in Sound_File) + return Long_Float; + + function Calculate_Normed_Signal_Maximum + (File : in Sound_File) + return Long_Float; + + function Calculate_Maximum_All_Channels + (File : in Sound_File) + return Long_Float_Array; + + function Calculate_Normed_Maximum_All_Channels + (File : in Sound_File) + return Long_Float_Array; + + function Get_Signal_Maximum + (File : in Sound_File) + return Long_Float; + + function Get_Maximum_All_Channels + (File : in Sound_File) + return Long_Float_Array; + + procedure Set_Normed_Float + (File : in Sound_File; + Value : in Boolean); + + procedure Set_Normed_Double + (File : in Sound_File; + Value : in Boolean); + + function Get_Normed_Float + (File : in Sound_File) + return Boolean; + + function Get_Normed_Double + (File : in Sound_File) + return Boolean; + + procedure Set_Scale_Float_Integer_Read + (File : in Sound_File; + Value : in Boolean); + + procedure Set_Scale_Integer_Float_Write + (File : in Sound_File; + Value : in Boolean); + + function Get_Simple_Format_Count + return Natural; + + function Get_Simple_Format + (Index : in Positive) + return Format_Info; + + function Get_Format_Info + (Format : in Major_Format) + return Format_Info; + + function Get_Format_Info + (Format : in Minor_Format) + return Format_Info; + + function Get_Format_Major_Count + return Natural; + + function Get_Format_Major + (Index : in Positive) + return Format_Info; + + function Get_Format_Subtype_Count + return Natural; + + function Get_Format_Subtype + (Index : in Positive) + return Format_Info; + + procedure Set_Add_Peak_Chunk + (File : in Sound_File; + Value : in Boolean); + + procedure Update_Header_Now + (File : in Sound_File); + + procedure Set_Update_Header_Auto + (File : in Sound_File; + Value : in Boolean); + + procedure File_Truncate + (File : in Sound_File; + Position : in Count_Type); + + procedure Set_Raw_Start_Offset + (File : in Sound_File; + Position : in Count_Type); + + procedure Set_Clipping + (File : in Sound_File; + Value : in Boolean); + + function Get_Clipping + (File : in Sound_File) + return Boolean; + + function Get_Embedded_File_Info + (File : in Sound_File) + return Embedded_Info; + + function Wavex_Get_Ambisonic + (File : in Sound_File) + return Ambisonic; + + procedure Wavex_Set_Ambisonic + (File : in Sound_File; + Value : in Ambisonic); + + procedure Set_Variable_Bitrate_Encoding_Quality + (File : in Sound_File; + Value : in Long_Long_Float); + + procedure Set_Ogg_Page_Latency_Milliseconds + (File : in Sound_File; + Value : in Long_Long_Float); + + function Get_Ogg_Stream_Serial + (File : in Sound_File) + return Integer; + + procedure Set_Compression_Level + (File : in Sound_File; + Value : in Compression); + + function Raw_Data_Needs_Endswap + (File : in Sound_File) + return Boolean; + + function Get_Broadcast_Info + (File : in Sound_File) + return Broadcast_Info; + + procedure Set_Broadcast_Info + (File : in Sound_File; + Value : in Broadcast_Info); + + function Get_Channel_Map_Info + (File : in Sound_File) + return Channel_Map_Array; + + procedure Set_Channel_Map_Info + (File : in Sound_File; + Value : in Channel_Map_Array); + + -- Get_Cart_Info goes here + + -- Set_Cart_Info goes here + + -- Get_Loop_Info goes here + + -- Get_Instrument goes here + + -- Set_Instrument goes here + + function Get_Cue_Count + (File : in Sound_File) + return Interfaces.Unsigned_32; + + -- Get_Cue goes here + + -- Set_Cue goes here + + -- Why the hell would you design this command in this way? + -- You shouldn't have to intentionally try to set the thing after writing + -- in order to find the value of it. + procedure RF64_Auto_Downgrade + (File : in Sound_File; + Value : in Boolean); + + function Get_Original_Samplerate + (File : in Sound_File) + return Natural; + + procedure Set_Original_Samplerate + (File : in Sound_File; + Value : in Natural); + + function Get_Bitrate_Mode + (File : in Sound_File) + return Bitrate_Mode; + + procedure Set_Bitrate_Mode + (File : in Sound_File; + Value : in Bitrate_Mode); + + +private + + + -- This corresponds to the C-side SF_FORMAT_INFO + type Format_Info is record + My_Format : Interfaces.C.int; + My_Name : Interfaces.C.Strings.chars_ptr; + My_Extension : Interfaces.C.Strings.chars_ptr; + end record with Convention => C; + + + -- This cannot correspond to the C-side SF_EMBED_FILE_INFO struct since + -- sf_count_t can vary + type Embedded_Info is record + My_Offset : Interfaces.Integer_64; + My_Length : Interfaces.Integer_64; + end record with Convention => C; + + + -- This corresponds to the C-side SF_BROADCAST_INFO + type Broadcast_Info is record + My_Description : Interfaces.C.char_array (1 .. 256); + My_Originator : Interfaces.C.char_array (1 .. 32); + My_Originator_Reference : Interfaces.C.char_array (1 .. 32); + My_Origination_Date : Interfaces.C.char_array (1 .. 10); + My_Origination_Time : Interfaces.C.char_array (1 .. 8); + My_Time_Reference_Low : Interfaces.C.unsigned; + My_Time_Reference_High : Interfaces.C.unsigned; + My_Version : Interfaces.C.short; + My_Umid : Interfaces.C.char_array (1 .. 64); + My_Reserved : Interfaces.C.char_array (1 .. 190); + My_Coding_History_Size : Interfaces.C.unsigned; + My_Coding_History : Interfaces.C.char_array (1 .. 256); + end record with Convention => C; + + +end Libsndfile.Commands; + + diff --git a/src/libsndfile-virtual.adb b/src/libsndfile-virtual.adb new file mode 100644 index 0000000..2e8f438 --- /dev/null +++ b/src/libsndfile-virtual.adb @@ -0,0 +1,162 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C, + System.Address_To_Access_Conversions; + +use type + + Interfaces.C.int, + System.Address; + + +package body Libsndfile.Virtual is + + + package Virt_Conversions is new System.Address_To_Access_Conversions (Virtual_Data); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function asf_open_virtual + (Mode : in Interfaces.C.int; + Sfinfo : in out File_Info; + Data : in System.Address) + return System.Address; + pragma Import (C, asf_open_virtual, "asf_open_virtual"); + + + + + ---------------------- + -- Callback Hooks -- + ---------------------- + + function Ada_Filelen_Hook + (Data : in System.Address) + return Interfaces.Integer_64 + is + Virtual : Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Data); + begin + return Interfaces.Integer_64 (Virtual.My_Length.all); + end Ada_Filelen_Hook; + + + function Ada_Seek_Hook + (Offset : in Interfaces.Integer_64; + Whence : in Interfaces.C.int; + Data : in System.Address) + return Interfaces.Integer_64 + is + Virtual : Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Data); + My_Whence : Seek_From; + begin + if Whence = sf_seek_set then + My_Whence := From_Start; + elsif Whence = sf_seek_cur then + My_Whence := From_Current; + elsif Whence = sf_seek_end then + My_Whence := From_End; + else + raise Program_Error; + end if; + return Interfaces.Integer_64 (Virtual.My_Seek.all (Count_Type (Offset), My_Whence)); + end Ada_Seek_Hook; + + + function Ada_Read_Hook + (Ptr : in System.Address; + Count : in Interfaces.Integer_64; + Data : in System.Address) + return Interfaces.Integer_64 + is + Virtual : Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Data); + Buffer : Raw_Data (1 .. Integer (Count)); + for Buffer'Address use Ptr; + pragma Import (Ada, Buffer); + begin + return Interfaces.Integer_64 (Virtual.My_Read (Buffer, Count_Type (Count))); + end Ada_Read_Hook; + + + function Ada_Write_Hook + (Ptr : in System.Address; + Count : in Interfaces.Integer_64; + Data : in System.Address) + return Interfaces.Integer_64 + is + Virtual : Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Data); + Buffer : Raw_Data (1 .. Integer (Count)); + for Buffer'Address use Ptr; + pragma Import (Ada, Buffer); + begin + return Interfaces.Integer_64 (Virtual.My_Write (Buffer, Count_Type (Count))); + end Ada_Write_Hook; + + + function Ada_Tell_Hook + (Data : in System.Address) + return Interfaces.Integer_64 + is + Virtual : Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Data); + begin + return Interfaces.Integer_64 (Virtual.My_Tell.all); + end Ada_Tell_Hook; + + + + + --------------------- + -- API Interface -- + --------------------- + + procedure Open + (File : in out Virtual_Sound_File; + Mode : in File_Mode; + Info : in out File_Info; + Length : in File_Length_Function; + Seek : in Seek_Function; + Read : in Read_Function; + Write : in Write_Function; + Tell : in Tell_Function) + 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 + File.My_Virtual.My_Length := Length; + File.My_Virtual.My_Seek := Seek; + File.My_Virtual.My_Read := Read; + File.My_Virtual.My_Write := Write; + File.My_Virtual.My_Tell := Tell; + Result := asf_open_virtual (Mode_Int, Info, File.My_Virtual'Address); + 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; + + +end Libsndfile.Virtual; + + diff --git a/src/libsndfile-virtual.ads b/src/libsndfile-virtual.ads new file mode 100644 index 0000000..4ce27e6 --- /dev/null +++ b/src/libsndfile-virtual.ads @@ -0,0 +1,116 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +private with + + Interfaces, + System; + + +package Libsndfile.Virtual is + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + type Virtual_Sound_File is new Sound_File with private; + + type File_Length_Function is access function + return Count_Type; + + type Seek_Function is access function + (Offset : in Count_Type; + Whence : in Seek_From) + return Count_Type; + + type Read_Function is access function + (Data : out Raw_Data; + Bytes : in Count_Type) + return Count_Type; + + type Write_Function is access function + (Data : in Raw_Data; + Bytes : in Count_Type) + return Count_Type; + + type Tell_Function is access function + return Count_Type; + + + + + --------------------- + -- API Interface -- + --------------------- + + procedure Open + (File : in out Virtual_Sound_File; + Mode : in File_Mode; + Info : in out File_Info; + Length : in File_Length_Function; + Seek : in Seek_Function; + Read : in Read_Function; + Write : in Write_Function; + Tell : in Tell_Function) + with Pre => not Is_Open (File), + Post => Is_Open (File); + + +private + + + type Virtual_Data is limited record + My_Length : File_Length_Function; + My_Seek : Seek_Function; + My_Read : Read_Function; + My_Write : Write_Function; + My_Tell : Tell_Function; + end record with Convention => C; + + + type Virtual_Sound_File is new Sound_File with record + My_Virtual : Virtual_Data; + end record; + + + + + function Ada_Filelen_Hook + (Data : in System.Address) + return Interfaces.Integer_64; + pragma Export (C, Ada_Filelen_Hook, "ada_filelen_hook"); + + function Ada_Seek_Hook + (Offset : in Interfaces.Integer_64; + Whence : in Interfaces.C.int; + Data : in System.Address) + return Interfaces.Integer_64; + pragma Export (C, Ada_Seek_Hook, "ada_seek_hook"); + + function Ada_Read_Hook + (Ptr : in System.Address; + Count : in Interfaces.Integer_64; + Data : in System.Address) + return Interfaces.Integer_64; + pragma Export (C, Ada_Read_Hook, "ada_read_hook"); + + function Ada_Write_Hook + (Ptr : in System.Address; + Count : in Interfaces.Integer_64; + Data : in System.Address) + return Interfaces.Integer_64; + pragma Export (C, Ada_Write_Hook, "ada_write_hook"); + + function Ada_Tell_Hook + (Data : in System.Address) + return Interfaces.Integer_64; + pragma Export (C, Ada_Tell_Hook, "ada_tell_hook"); + + +end Libsndfile.Virtual; + + 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; + + diff --git a/src/libsndfile.ads b/src/libsndfile.ads new file mode 100644 index 0000000..67e355f --- /dev/null +++ b/src/libsndfile.ads @@ -0,0 +1,452 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +private with + + Interfaces.C, + System; + + +package Libsndfile is + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- + + type Count_Type is new Long_Long_Integer; + + type Sound_File is tagged limited private; + + type File_Mode is (Read_Only, Write_Only, Read_Write); + + type Seek_From is (From_Start, From_Current, From_End); + + type Short_Data is array (Positive range <>) of Short_Integer; + type Integer_Data is array (Positive range <>) of Integer; + type Float_Data is array (Positive range <>) of Float; + type Double_Data is array (Positive range <>) of Long_Float; + + type Raw_Data is new String; + + type Metadata is + (Title_String, + Copyright_String, + Software_String, + Artist_String, + Comment_String, + Date_String, + Album_String, + License_String, + Track_Number_String, + Genre_String); + + type File_Info is private; + + type Major_Format is + (Format_Unknown, + Wav_Format, + Aiff_Format, + Au_Format, + Raw_Format, + Paf_Format, + Svx_Format, + Nist_Format, + Voc_Format, + Ircam_Format, + W64_Format, + Mat4_Format, + Mat5_Format, + Pvf_Format, + Xi_Format, + Htk_Format, + Sds_Format, + Avr_Format, + Wavex_Format, + Sd2_Format, + Flac_Format, + Caf_Format, + Wve_Format, + Ogg_Format, + Mpc2k_Format, + Rf64_Format, + Mpeg_Format); + + type Minor_Format is + (Encoding_Unknown, + Pcm_S8_Encoding, + Pcm_16_Encoding, + Pcm_24_Encoding, + Pcm_32_Encoding, + Pcm_U8_Encoding, + Float_Encoding, + Double_Encoding, + Ulaw_Encoding, + Alaw_Encoding, + Ima_Adpcm_Encoding, + Ms_Adpcm_Encoding, + Gsm610_Encoding, + Vox_Adpcm_Encoding, + Nms_Adpcm_16_Encoding, + Nms_Adpcm_24_Encoding, + Nms_Adpcm_32_Encoding, + G721_32_Encoding, + G723_24_Encoding, + G723_40_Encoding, + Dwvw_12_Encoding, + Dwvw_16_Encoding, + Dwvw_24_Encoding, + Dwvw_N_Encoding, + Dpcm_8_Encoding, + Dpcm_16_Encoding, + Vorbis_Encoding, + Opus_Encoding, + Alac_16_Encoding, + Alac_20_Encoding, + Alac_24_Encoding, + Alac_32_Encoding, + Mpeg_Layer_I_Encoding, + Mpeg_Layer_II_Encoding, + Mpeg_Layer_III_Encoding); + + type Endianness is + (Default_Endian, + Little_Endian, + Big_Endian, + Machine_Native); + + -- Use a copy of this for reading non-raw files + Blank_Info : constant File_Info; + + -- Use this for reading raw files and writing files + function Create + (Rate : in Positive; + Channels : in Positive; + Major : in Major_Format; + Minor : in Minor_Format; + Endian : in Endianness := Default_Endian) + return File_Info; + + function Frames + (Info : in File_Info) + return Count_Type; + + function Rate + (Info : in File_Info) + return Natural; + + function Channels + (Info : in File_Info) + return Natural; + + function Major + (Info : in File_Info) + return Major_Format; + + function Minor + (Info : in File_Info) + return Minor_Format; + + function Endian + (Info : in File_Info) + return Endianness; + + function Sections + (Info : in File_Info) + return Natural; + + function Seekable + (Info : in File_Info) + return Boolean; + + + + + ------------------ + -- Exceptions -- + ------------------ + + -- May be raised by Open + Unrecognised_Format_Error : exception; + + -- May be raised by Open + Unsupported_Encoding_Error : exception; + + -- May be raised by Open + Malformed_File_Error : exception; + + -- May be raised by Open, Close? + System_Error : exception; + + -- May be raised by Seek + Seek_Error : exception; + + -- May be raised by Current_Byterate + Unknown_Byterate_Error : exception; + + -- May be raised by Open, Close + General_Failure : exception; + + -- Program_Error may be raised if libsndfile in general does something out of spec + -- Set_Meta may raise errors but it is unclear which ones + + + + + --------------- + -- Utility -- + --------------- + + function Is_Open + (File : in Sound_File) + return Boolean; + + + + + --------------------- + -- API Interface -- + --------------------- + + procedure Open + (File : in out Sound_File; + Name : in String; + Mode : in File_Mode; + Info : in out File_Info) + with Pre => not Is_Open (File), + Post => Is_Open (File); + + function Format_Check + (Info : in File_Info) + return Boolean; + + function Seek + (File : in Sound_File; + Offset : in Count_Type; + Whence : in Seek_From; + Mode : in File_Mode := Read_Write) + return Count_Type + with Pre => Is_Open (File); + + procedure Close + (File : in out Sound_File) + with Pre => Is_Open (File), + Post => not Is_Open (File); + + procedure Write_Sync + (File : in Sound_File) + with Pre => Is_Open (File); + + function Read_Short + (File : in Sound_File; + Data : out Short_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Read_Integer + (File : in Sound_File; + Data : out Integer_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Read_Float + (File : in Sound_File; + Data : out Float_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Read_Double + (File : in Sound_File; + Data : out Double_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Write_Short + (File : in Sound_File; + Data : in Short_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Write_Integer + (File : in Sound_File; + Data : in Integer_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Write_Float + (File : in Sound_File; + Data : in Float_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Write_Double + (File : in Sound_File; + Data : in Double_Data; + Frames : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Read_Raw + (File : in Sound_File; + Data : out Raw_Data; + Bytes : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Write_Raw + (File : in Sound_File; + Data : in Raw_Data; + Bytes : in Count_Type) + return Count_Type + with Pre => Is_Open (File); + + function Get_Meta + (File : in Sound_File; + Kind : in Metadata) + return String + with Pre => Is_Open (File); + + procedure Set_Meta + (File : in Sound_File; + Kind : in Metadata; + Value : in String) + with Pre => Is_Open (File); + + function Version_String + return String; + + function Current_Byterate + (File : in Sound_File) + return Natural + with Pre => Is_Open (File); + + -- RIFF chunk API goes here + + +private + + + pragma Linker_Options ("-lsndfile"); + + pragma Inline (Is_Open); + pragma Inline (Write_Sync); + pragma Inline (Read_Raw); + pragma Inline (Write_Raw); + pragma Inline (Version_String); + + + + + type Sound_File is tagged limited record + Ptr : System.Address := System.Null_Address; + FMode : File_Mode := Read_Only; + Chans : Interfaces.C.int := 0; + end record; + + + type C_Short_Data is array (Positive range <>) of Interfaces.C.short; + type C_Integer_Data is array (Positive range <>) of Interfaces.C.int; + type C_Float_Data is array (Positive range <>) of Interfaces.C.C_float; + type C_Double_Data is array (Positive range <>) of Interfaces.C.double; + + + -- This cannot correspond to the C-side SF_INFO since sf_count_t can vary + type File_Info is record + My_Frames : Interfaces.Integer_64; + My_Sample_Rate : Interfaces.C.int; + My_Channels : Interfaces.C.int; + My_Major : Interfaces.C.int; + My_Minor : Interfaces.C.int; + My_Endian : Interfaces.C.int; + My_Sections : Interfaces.C.int; + My_Seekable : Interfaces.C.int; + end record with Convention => C; + + + Blank_Info : constant File_Info := (My_Frames => 0, others => 0); + + + + + procedure Raise_Error + (Num : in Interfaces.C.int); + + function To_Major + (Num : in Interfaces.C.int) + return Major_Format; + + function To_Minor + (Num : in Interfaces.C.int) + return Minor_Format; + + function To_Endian + (Num : in Interfaces.C.int) + return Endianness; + + function To_Cint + (Major : in Major_Format) + return Interfaces.C.int; + + function To_Cint + (Minor : in Minor_Format) + return Interfaces.C.int; + + function To_Cint + (Endian : in Endianness) + return Interfaces.C.int; + + + + + sf_false : constant Interfaces.C.int; + pragma Import (C, sf_false, "sf_false"); + + sf_true : constant Interfaces.C.int; + pragma Import (C, sf_true, "sf_true"); + + + + + sfm_read : constant Interfaces.C.int; + pragma Import (C, sfm_read, "sfm_read"); + + sfm_write : constant Interfaces.C.int; + pragma Import (C, sfm_write, "sfm_write"); + + sfm_rdwr : constant Interfaces.C.int; + pragma Import (C, sfm_rdwr, "sfm_rdwr"); + + + + + sf_seek_set : constant Interfaces.C.int; + pragma Import (C, sf_seek_set, "sf_seek_set"); + + sf_seek_cur : constant Interfaces.C.int; + pragma Import (C, sf_seek_cur, "sf_seek_cur"); + + sf_seek_end : constant Interfaces.C.int; + pragma Import (C, sf_seek_end, "sf_seek_end"); + + + + + function sf_error + (File : in System.Address) + return Interfaces.C.int; + pragma Import (C, sf_error, "sf_error"); + + +end Libsndfile; + + |