summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c_asndfile.c189
-rw-r--r--src/c_asndfile.h141
-rw-r--r--src/c_asndfile_command.c112
-rw-r--r--src/c_asndfile_command.h86
-rw-r--r--src/c_asndfile_virtual.c71
-rw-r--r--src/c_asndfile_virtual.h26
-rw-r--r--src/libsndfile-commands.adb1305
-rw-r--r--src/libsndfile-commands.ads442
-rw-r--r--src/libsndfile-virtual.adb162
-rw-r--r--src/libsndfile-virtual.ads116
-rw-r--r--src/libsndfile.adb1094
-rw-r--r--src/libsndfile.ads452
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;
+
+