--- /dev/null
+/* Stub code to access libsndfile functions from OCaml */
+
+/*
+** Copyright (c) 2006, 2007 Erik de Castro Lopo <erikd at mega-nerd dot com>
+** 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 <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#include <caml/bigarray.h>
+
+#include <stdlib.h>
+#include <string.h>
+
+#include <sndfile.h>
+
+#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 */
projects / Faustine.git / blobdiff