X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/992d59159547267e1491fcd1c5123765b4c452b8..63cf293f572ae7d5c1c83b9dffb31e7d774f8854:/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.c diff --git a/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.c b/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.c new file mode 100644 index 0000000..ccf2b16 --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.c @@ -0,0 +1,352 @@ +/* Stub code to access libsndfile functions from OCaml */ + +/* +** Copyright (c) 2006, 2007 Erik de Castro Lopo +** WWW: http://www.mega-nerd.com/libsndfile/Ocaml/ +** +** This library is free software; you can redistribute it and/or +** modify it under the terms of the GNU Lesser General Public +** License as published by the Free Software Foundation; either +** version 2 of the License, or (at your option) any later version. +** +** This library is distributed in the hope that it will be useful, +** but WITHOUT ANY WARRANTY; without even the implied warranty of +** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +** Lesser General Public License for more details. +** +** You should have received a copy of the GNU Lesser General Public +** License along with this library; if not, write to the Free Software +** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*/ + +#include +#include +#include +#include +#include +#include +#include + +#include +#include + +#include + +#define CAML_SNDFILE_VERSION "v0.1" + +#define ARRAY_LEN(x) ((int) (sizeof (x) / sizeof (x [0]))) + +typedef struct +{ SNDFILE * file ; + SF_INFO info ; +} SF_WRAPPER ; + + +static void caml_sf_finalize (value file) ; +static int caml_val_to_major_format (int f) ; +static int caml_val_to_minor_format (int f) ; + +static struct custom_operations sndfile_custom_ops = +{ + /* identifier */ "SNDFILE/CAMLinterface/" CAML_SNDFILE_VERSION "/sndfile", + /* finalize */ caml_sf_finalize, + /* compare */ NULL, + /* hash */ NULL, + /* serialize */ NULL, + /* deserialize */ NULL +} ; + +value +caml_sf_format_e (value v_major, value v_minor, value v_endian) +{ + int minor, major, endian ; + + CAMLparam3 (v_major, v_minor, v_endian) ; + + minor = caml_val_to_minor_format (Int_val (v_minor)) ; + major = caml_val_to_major_format (Int_val (v_major)) ; + endian = (Int_val (v_endian) << 28) & SF_FORMAT_ENDMASK ; + + CAMLreturn (Val_int (endian + major + minor)) ; +} /* caml_sf_format_e */ + +value +caml_sf_open_private (value v_filename, value v_mode, value v_fmt, value v_channels, value v_samplerate) +{ + value v_wrapper ; + SF_WRAPPER *wrapper ; + int mode = 0 ; + + CAMLparam5 (v_filename, v_mode, v_fmt, v_channels, v_samplerate) ; + + v_wrapper = caml_alloc_custom (&sndfile_custom_ops, sizeof (SF_WRAPPER), sizeof (SF_WRAPPER), sizeof (SF_WRAPPER)) ; + wrapper = Data_custom_val (v_wrapper) ; + if (wrapper == NULL) + failwith ("Sndfile.sf_open : caml_alloc_custom failed.") ; + + memset (wrapper, 0, sizeof (*wrapper)) ; + + switch (Int_val (v_mode)) + { case 0 : + mode = SFM_READ ; + break ; + case 1 : + mode = SFM_WRITE ; + wrapper->info.format = Int_val (v_fmt) ; + wrapper->info.channels = Int_val (v_channels) ; + wrapper->info.samplerate = Int_val (v_samplerate) ; + break ; + case 2 : + mode = SFM_RDWR ; + wrapper->info.format = Int_val (v_fmt) ; + wrapper->info.channels = Int_val (v_channels) ; + wrapper->info.samplerate = Int_val (v_samplerate) ; + break ; + default : + break ; + } ; + + wrapper->file = sf_open (String_val (v_filename), mode, &wrapper->info) ; + + if (wrapper->file == NULL) + { int errnum = sf_error (NULL) ; + const char *err_str = sf_error_number (errnum) ; + + if (err_str == NULL) + err_str = "????" ; + + value sferr = caml_alloc_tuple (2) ; + + switch (errnum) + { case SF_ERR_NO_ERROR : + case SF_ERR_UNRECOGNISED_FORMAT : + case SF_ERR_SYSTEM : + case SF_ERR_MALFORMED_FILE : + case SF_ERR_UNSUPPORTED_ENCODING : + break ; + default : + errnum = SF_ERR_UNSUPPORTED_ENCODING + 1 ; + break ; + } ; + + Store_field (sferr, 0, caml_copy_nativeint (errnum)) ; + Store_field (sferr, 1, caml_copy_string (err_str)) ; + + value *exn = caml_named_value ("sndfile_open_exn") ; + if (exn == NULL) + failwith ("asdasdasdas") ; + + caml_raise_with_arg (*exn, sferr) ; + } ; + + CAMLreturn (v_wrapper) ; +} /* caml_sf_open_private */ + +value +caml_sf_close (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + + CAMLparam1 (v_wrapper) ; + wrapper = Data_custom_val (v_wrapper) ; + + if (wrapper->file != NULL) + { sf_close (wrapper->file) ; + wrapper->file = NULL ; + } ; + + CAMLreturn (Val_unit) ; +} /* caml_sf_close */ + +/* Pulled from ocaml-cairo sources. Not sure how portable/reliable this is. */ +#define Double_array_val(v) ((double *)(v)) +#define Double_array_length(v) (Wosize_val(v) / Double_wosize) + +value +caml_sf_read (value v_wrapper, value v_data) +{ + SF_WRAPPER *wrapper ; + int count ; + + CAMLparam2 (v_wrapper, v_data) ; + wrapper = Data_custom_val (v_wrapper) ; + + count = sf_read_double (wrapper->file, Double_array_val (v_data), Double_array_length (v_data)) ; + + CAMLreturn (Val_int (count)) ; +} /* caml_sf_read */ + +value +caml_sf_write (value v_wrapper, value v_data) +{ + SF_WRAPPER *wrapper ; + int count ; + + CAMLparam2 (v_wrapper, v_data) ; + wrapper = Data_custom_val (v_wrapper) ; + + count = sf_write_double (wrapper->file, Double_array_val (v_data), Double_array_length (v_data)) ; + + CAMLreturn (Val_int (count)) ; +} /* caml_sf_write */ + +value +caml_sf_frames (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + sf_count_t frames = 0 ; + + CAMLparam1 (v_wrapper) ; + wrapper = Data_custom_val (v_wrapper) ; + + if (wrapper->file != NULL) + frames = wrapper->info.frames ; + + CAMLreturn (caml_copy_int64 (frames)) ; +} /* caml_sf_frames */ + +value +caml_sf_samplerate (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + int samplerate = 0 ; + + CAMLparam1 (v_wrapper) ; + wrapper = Data_custom_val (v_wrapper) ; + + if (wrapper->file != NULL) + samplerate = wrapper->info.samplerate ; + + CAMLreturn (Val_int (samplerate)) ; +} /* caml_sf_samplerate */ + +value +caml_sf_channels (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + int channels = 0 ; + + CAMLparam1 (v_wrapper) ; + wrapper = Data_custom_val (v_wrapper) ; + + if (wrapper->file != NULL) + channels = wrapper->info.channels ; + + CAMLreturn (Val_int (channels)) ; +} /* caml_sf_channels */ + +value +caml_sf_seek (value v_wrapper, value v_pos, value v_mode) +{ + SF_WRAPPER *wrapper ; + sf_count_t pos ; + int mode ; + + CAMLparam3 (v_wrapper, v_pos, v_mode) ; + + wrapper = Data_custom_val (v_wrapper) ; + mode = Int_val (v_mode) ; + pos = Int64_val (v_pos) ; + + pos = sf_seek (wrapper->file, pos, mode) ; + + CAMLreturn (Val_int (pos)) ; +} /* caml_sf_seek */ + +value +caml_sf_compare (value v_wrapper1, value v_wrapper2) +{ + SF_WRAPPER *wrapper1, *wrapper2 ; + + CAMLparam2 (v_wrapper1, v_wrapper2) ; + + wrapper1 = Data_custom_val (v_wrapper1) ; + wrapper2 = Data_custom_val (v_wrapper2) ; + + CAMLreturn (Val_int (wrapper2 - wrapper1)) ; +} /* caml_sf_compare */ + +/*============================================================================== +*/ + +static void +caml_sf_finalize (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + + wrapper = Data_custom_val (v_wrapper) ; + + if (wrapper->file != NULL) + { sf_close (wrapper->file) ; + wrapper->file = NULL ; + } ; + +} /* caml_sf_finalize */ + + +static int +caml_val_to_major_format (int f) +{ static int format [] = + { 0, + 0x010000, /* SF_FORMAT_WAV */ + 0x020000, /* SF_FORMAT_AIFF */ + 0x030000, /* SF_FORMAT_AU */ + 0x040000, /* SF_FORMAT_RAW */ + 0x050000, /* SF_FORMAT_PAF */ + 0x060000, /* SF_FORMAT_SVX */ + 0x070000, /* SF_FORMAT_NIST */ + 0x080000, /* SF_FORMAT_VOC */ + 0x0A0000, /* SF_FORMAT_IRCAM */ + 0x0B0000, /* SF_FORMAT_W64 */ + 0x0C0000, /* SF_FORMAT_MAT4 */ + 0x0D0000, /* SF_FORMAT_MAT5 */ + 0x0E0000, /* SF_FORMAT_PVF */ + 0x0F0000, /* SF_FORMAT_XI */ + 0x100000, /* SF_FORMAT_HTK */ + 0x110000, /* SF_FORMAT_SDS */ + 0x120000, /* SF_FORMAT_AVR */ + 0x130000, /* SF_FORMAT_WAVEX */ + 0x160000, /* SF_FORMAT_SD2 */ + 0x170000, /* SF_FORMAT_FLAC */ + 0x180000 /* SF_FORMAT_CAF */ + } ; + + if (f < 0 || f >= ARRAY_LEN (format)) + return 0 ; + + return format [f] ; +} /* caml_val_to_major_format */ + +static int +caml_val_to_minor_format (int f) +{ static int format [] = + { 0, + 0x0001, /* SF_FORMAT_PCM_S8 */ + 0x0002, /* SF_FORMAT_PCM_16 */ + 0x0003, /* SF_FORMAT_PCM_24 */ + 0x0004, /* SF_FORMAT_PCM_32 */ + 0x0005, /* SF_FORMAT_PCM_U8 */ + 0x0006, /* SF_FORMAT_FLOAT */ + 0x0007, /* SF_FORMAT_DOUBLE */ + 0x0010, /* SF_FORMAT_ULAW */ + 0x0011, /* SF_FORMAT_ALAW */ + 0x0012, /* SF_FORMAT_IMA_ADPCM */ + 0x0013, /* SF_FORMAT_MS_ADPCM */ + 0x0020, /* SF_FORMAT_GSM610 */ + 0x0021, /* SF_FORMAT_VOX_ADPCM */ + 0x0030, /* SF_FORMAT_G721_32 */ + 0x0031, /* SF_FORMAT_G723_24 */ + 0x0032, /* SF_FORMAT_G723_40 */ + 0x0040, /* SF_FORMAT_DWVW_12 */ + 0x0041, /* SF_FORMAT_DWVW_16 */ + 0x0042, /* SF_FORMAT_DWVW_24 */ + 0x0043, /* SF_FORMAT_DWVW_N */ + 0x0050, /* SF_FORMAT_DPCM_8 */ + 0x0051, /* SF_FORMAT_DPCM_16 */ + } ; + + if (f < 0 || f >= ARRAY_LEN (format)) + return 0 ; + + return format [f] ; +} /* caml_val_to_minor_format */