From: Karim Barkati Date: Wed, 11 Sep 2013 06:38:15 +0000 (+0200) Subject: libsndfile-ocaml source files. X-Git-Url: https://scm.cri.mines-paristech.fr/git/Faustine.git/commitdiff_plain/60771194f4808507a435db7c201e3e75675986be?hp=f1f94803668061f90a5ce88bf06ee72bba8e41a5 libsndfile-ocaml source files. --- diff --git a/interpretor/lib/src/libsndfile-ocaml/Makefile b/interpretor/lib/src/libsndfile-ocaml/Makefile new file mode 100644 index 0000000..299214a --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/Makefile @@ -0,0 +1,67 @@ + +CC = gcc +CFLAGS = -g -W -Wall -Werror + +OCAMLC = ocamlc +OCAMLOPT = ocamlopt +OCAMLDEP = ocamldep +OCAMLDOC = ocamldoc + +SNDFILE_CFLAGS = $(shell pkg-config --cflags sndfile) +SNDFILE_LIBS = $(shell pkg-config --libs sndfile) + +OCAML_CFLAGS = -I /usr/lib/ocaml/$(shell ocamlopt -version) + +LIBSNDFILE = -ccopt -L/home/erikd/Local/lib -cclib -lsndfile -cclib -lm + +all: sndfile.cma sndfile.cmxa + +sndfile.cma: sndfile.ml sndfile.cmi sndfile_stub.o + $(OCAMLC) -c sndfile.ml + $(OCAMLC) -a -o $@ -custom sndfile_stub.o sndfile.cmo $(LIBSNDFILE) + + +sndfile.cmxa: sndfile.ml sndfile.cmi sndfile_stub.o + $(OCAMLOPT) -c sndfile.ml + $(OCAMLOPT) -a -o $@ sndfile.cmx sndfile_stub.o $(LIBSNDFILE) + +Sndfile.html: sndfile.mli sndfile.cmi + $(OCAMLDOC) -stars -html -colorize-code $< + + +sndfile_stub.o: sndfile_stub.c + $(CC) $(CFLAGS) $(SNDFILE_CFLAGS) $(OCAML_CFLAGS) -c $< + +sndfile_stub.e: sndfile_stub.c + $(CC) $(CFLAGS) -E $(SNDFILE_CFLAGS) $(OCAML_CFLAGS) -c $< > $@ + +%.cmi: %.mli + $(OCAMLC) -c $< + + +depend: sndfile.ml sndfile.mli + $(OCAMLDEP) *.mli *.ml > .depend + +.depend: sndfile.ml sndfile.mli + $(OCAMLDEP) *.mli *.ml > .depend + +include .depend + +######################################################################## + +test_sndfile: sndfile.cma test_sndfile.ml + $(OCAMLC) -o $@ sndfile.cma test_sndfile.ml + +test_sndfile.opt: sndfile.cmxa test_sndfile.ml + $(OCAMLOPT) -o $@ sndfile.cmxa test_sndfile.ml + +check : test_sndfile test_sndfile.opt + ./test_sndfile + ./test_sndfile.opt + +######################################################################## + +clean: + rm -f *~ .*~ *.o *.cm[aiox] *.cmxa *.a *.so test_sndfile test_sndfile.opt + @ find . -type f -perm +u=x -exec rm -f {} \; + @ rm -f *.html *.css diff --git a/interpretor/lib/src/libsndfile-ocaml/Todo.txt b/interpretor/lib/src/libsndfile-ocaml/Todo.txt new file mode 100644 index 0000000..35fbf21 --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/Todo.txt @@ -0,0 +1,168 @@ + +Look at Bigarray module: + + http://caml.inria.fr/pub/docs/manual-ocaml/manual043.html + http://pauillac.inria.fr/cdrom/www/caml/ocaml/htmlman/manual042.html + http://jhenrikson.org/forklift/checkout/doc/higher_order.html + +From : + + http://webcvs.freedesktop.org/cairo/cairo-ocaml/test/basket.ml?revision=1.7&view=markup + + begin + prerr_endline "Bigarray, PPM and PNG (ARGB32) " ; + let arr = + Bigarray.Array2.create Bigarray.int32 Bigarray.c_layout + (int_of_float y_inches * 72) (int_of_float x_inches * 72) in + Bigarray.Array2.fill arr 0xffffffl ; + let s = Cairo_bigarray.of_bigarr_32 ~alpha:true arr in + let c = Cairo.create s in + draw c ; + do_file_out "basket.ppm" + (fun oc -> Cairo_bigarray.write_ppm_int32 oc arr) ; + Cairo_png.surface_write_to_file s "basket.png" + end + + +=========================================================================== + +Actually many scientific OCaml libraries use the bigarray module. It +is also the case of Lacaml (a binding to LAPACK) or FFTW (a binding +to, hum, FFTW!). + +Now I do not understand why you could not have a function + + val read_array1 : t -> ('a,'b,'c) Bigarray.Array1.t -> int + + Sndfile.read_array1 f a read data from the file f into the supplied + bigarray a and return the number of float values read. + + For multi-channel files, the array length must be an integer + multiple of the number of channels. + +The idea is that the read function adapts the type of the bigarray +passed (if possible; if not, raise an exception). One could also +require that a Bigarray.Array2.t is used with one of its dimensions +being the number of channels (if possible allowing easy slicing to +extract a given channel). + +Same goes for a write function. + +BTW, the last part of the comment is a bit laconic: one wonders "or +what ?". An exception is raised ? The array slots with higher +indexes are never filled ? Garbage can be returned ? etc. + +> I was particularly interested if there was any utility to providing +> functions for accessing shorts or ints. So far noone has come up +> with a need for these. + +I did not follow thoroughly the discussion but there is an Int32 +module and the C interface has "Int32_val(v)" and "Int64_val(v)". To +create a caml Int32.t (resp. Int64.t), you must allocate a custom +block containing an "int32" (resp. int64). See section 18 of the +manual. + + + +=========================================================================== + + +(* cairo_bigarray.mli *) +(* + +open Bigarray + +val of_bigarr : + ('a, 'b, c_layout) Array2.t -> Cairo.format -> + width:int -> height:int -> stride:int -> Cairo.image_surface + +val of_bigarr_32 : alpha:bool -> (int32, int32_elt, c_layout) Array2.t -> Cairo.image_surface +val of_bigarr_24 : (int, int_elt, c_layout) Array2.t -> Cairo.image_surface +val of_bigarr_8 : (int, int8_unsigned_elt, c_layout) Array2.t -> Cairo.image_surface + +val write_ppm_int32 : out_channel -> (int32, int32_elt, c_layout) Array2.t -> unit +val write_ppm_int : out_channel -> (int, int_elt, c_layout) Array2.t -> unit + +*) + + + + + +(* cairo_bigarray.ml *) +(* + +open Bigarray + +external bigarray_kind_float : ('a, 'b, c_layout) Array2.t -> bool + = "ml_bigarray_kind_float" +external bigarray_byte_size : ('a, 'b, c_layout) Array2.t -> int + = "ml_bigarray_byte_size" + +external image_surface_create : + ('a, 'b, c_layout) Array2.t -> + Cairo.format -> width:int -> height:int -> stride:int -> + Cairo.image_surface = "ml_cairo_image_surface_create_for_data" + + +let of_bigarr arr format ~width ~height ~stride = + if bigarray_kind_float arr + then invalid_arg "wrong Bigarray kind" ; + if bigarray_byte_size arr < stride * height + then invalid_arg "Bigarray too small" ; + image_surface_create arr format width height stride + +let of_bigarr_32 ~alpha (arr : (int32, int32_elt, c_layout) Array2.t) = + let h = Array2.dim1 arr in + let w = Array2.dim2 arr in + of_bigarr arr + (if alpha then Cairo.FORMAT_ARGB32 else Cairo.FORMAT_RGB24) + w h (4 * w) + +let of_bigarr_24 (arr : (int, int_elt, c_layout) Array2.t) = + if Sys.word_size <> 32 + then failwith "your ints have 63 bits" ; + let h = Array2.dim1 arr in + let w = Array2.dim2 arr in + of_bigarr arr + Cairo.FORMAT_RGB24 + w h (4 * w) + +let of_bigarr_8 (arr : (int, int8_unsigned_elt, c_layout) Array2.t) = + let h = Array2.dim1 arr in + let w = Array2.dim2 arr in + of_bigarr arr + Cairo.FORMAT_A8 + w h w + +let output_pixel oc p = + let r = (p lsr 16) land 0xff in + output_byte oc r ; + let g = (p lsr 8) land 0xff in + output_byte oc g ; + let b = p land 0xff in + output_byte oc b + +let write_ppm_int32 oc (arr : (int32, int32_elt, c_layout) Array2.t) = + let h = Array2.dim1 arr in + let w = Array2.dim2 arr in + Printf.fprintf oc "P6 %d %d 255\n" w h ; + for i=0 to pred h do + for j=0 to pred w do + output_pixel oc (Int32.to_int arr.{i, j}) + done + done ; + flush oc + +let write_ppm_int oc (arr : (int, int_elt, c_layout) Array2.t) = + let h = Array2.dim1 arr in + let w = Array2.dim2 arr in + Printf.fprintf oc "P6 %d %d 255\n" w h ; + for i=0 to pred h do + for j=0 to pred w do + output_pixel oc arr.{i, j} + done + done ; + flush oc + +*) diff --git a/interpretor/lib/src/libsndfile-ocaml/sndfile.ml b/interpretor/lib/src/libsndfile-ocaml/sndfile.ml new file mode 100644 index 0000000..065dac9 --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/sndfile.ml @@ -0,0 +1,138 @@ +(* +** File: sndfile.ml +** +** 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 +*) + +type open_mode_t = + | READ + | WRITE + | RDWR + +type seek_mode_t = + | SEEK_SET + | SEEK_CUR + | SEEL_END + +type major_format_t = + | MAJOR_NONE + | MAJOR_WAV + | MAJOR_AIFF + | MAJOR_AU + | MAJOR_RAW + | MAJOR_PAF + | MAJOR_SVX + | MAJOR_NIST + | MAJOR_VOC + | MAJOR_IRCAM + | MAJOR_W64 + | MAJOR_MAT4 + | MAJOR_MAT5 + | MAJOR_PVF + | MAJOR_XI + | MAJOR_HTK + | MAJOR_SDS + | MAJOR_AVR + | MAJOR_WAVEX + | MAJOR_SD2 + | MAJOR_FLAC + | MAJOR_CAF + +type minor_format_t = + | MINOR_NONE + | MINOR_PCM_S8 + | MINOR_PCM_16 + | MINOR_PCM_24 + | MINOR_PCM_32 + | MINOR_PCM_U8 + | MINOR_FLOAT + | MINOR_DOUBLE + | MINOR_ULAW + | MINOR_ALAW + | MINOR_IMA_ADPCM + | MINOR_MS_ADPCM + | MINOR_GSM610 + | MINOR_VOX_ADPCM + | MINOR_G721_32 + | MINOR_G723_24 + | MINOR_G723_40 + | MINOR_DWVW_12 + | MINOR_DWVW_16 + | MINOR_DWVW_24 + | MINOR_DWVW_N + | MINOR_DPCM_8 + | MINOR_DPCM_16 + +type endianness_t = + | ENDIAN_FILE + | ENDIAN_LITTLE + | ENDIAN_BIG + | ENDIAN_CPU + + +type file_format_t + +type error = + | No_error + | Unrecognised_format + | System + | Malformed_file + | Unsupported_encoding + | Internal + +exception Error of (error * string) + +type t + +external format_e : major_format_t -> minor_format_t -> endianness_t -> file_format_t = "caml_sf_format_e" + +let format major minor = + format_e major minor ENDIAN_FILE + +external open_private : + string -> (* filename *) + open_mode_t -> + file_format_t -> + int -> (* channels *) + int -> (* samplerate *) + t = "caml_sf_open_private" + +let bad_format = format MAJOR_NONE MINOR_NONE + +let openfile ?(info = (READ, bad_format, 0, 0)) filename = + let (mode, fmt, channels, samplerate) = info in + open_private filename mode fmt channels samplerate + +external close : t -> unit = "caml_sf_close" + +external read : t -> float array -> int = "caml_sf_read" +external write : t -> float array -> int = "caml_sf_write" + + +external frames : t -> Int64.t = "caml_sf_frames" + +external samplerate : t -> int = "caml_sf_samplerate" + +external channels : t -> int = "caml_sf_channels" + +external seek : t -> Int64.t -> seek_mode_t -> Int64.t = "caml_sf_seek" + +external compare : t -> t -> int = "caml_sf_compare" + +let _ = + Callback.register_exception "sndfile_open_exn" (Error (No_error, "No error.")) diff --git a/interpretor/lib/src/libsndfile-ocaml/sndfile_bigarray.ml b/interpretor/lib/src/libsndfile-ocaml/sndfile_bigarray.ml new file mode 100644 index 0000000..12fea26 --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/sndfile_bigarray.ml @@ -0,0 +1,28 @@ +(* +** File: sndfile_bigarray.ml +** +** 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 +*) + +open Bigarray + +external read_short : Sndfile.t -> (int, int16_signed_elt, c_layout) Array1.t -> int + = "caml_sf_read_short" + +external write_short : Sndfile.t -> (int, int16_signed_elt, c_layout) Array1.t -> int + = "caml_sf_write_short" diff --git a/interpretor/lib/src/libsndfile-ocaml/sndfile_bigarray_stub.c b/interpretor/lib/src/libsndfile-ocaml/sndfile_bigarray_stub.c new file mode 100644 index 0000000..91b2f28 --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/sndfile_bigarray_stub.c @@ -0,0 +1,63 @@ +/* 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 "sndfile_stub.h" + +value +caml_sf_read_short (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + +puts (__func__) ; + + CAMLparam1 (v_wrapper) ; + + wrapper = Data_custom_val (v_wrapper) ; + + CAMLreturn (Val_int (0)) ; +} /* caml_read_short */ + +value +caml_sf_write_short (value v_wrapper) +{ + SF_WRAPPER *wrapper ; + +puts (__func__) ; + + CAMLparam1 (v_wrapper) ; + + wrapper = Data_custom_val (v_wrapper) ; + + CAMLreturn (Val_int (0)) ; +} /* caml_write_short */ + 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 */ diff --git a/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.h b/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.h new file mode 100644 index 0000000..1b580ce --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.h @@ -0,0 +1,29 @@ +/* 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 +*/ + +#define ARRAY_LEN(x) ((int) (sizeof (x) / sizeof (x [0]))) + +typedef struct +{ SNDFILE * file ; + SF_INFO info ; +} SF_WRAPPER ; + + diff --git a/interpretor/lib/src/libsndfile-ocaml/test_sndfile.ml b/interpretor/lib/src/libsndfile-ocaml/test_sndfile.ml new file mode 100644 index 0000000..8cee2b7 --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/test_sndfile.ml @@ -0,0 +1,59 @@ +(* Rudimentary testing of the Ocaml libsndfile wrapper. *) + +let write_test filename = + let fmt = Sndfile.format Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in + let file = Sndfile.openfile ~info:(Sndfile.WRITE, fmt, 2, 44100) filename in + let writecount = Sndfile.write file [| 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.5 |] in + Printf.printf "Wrote %d items.\n" writecount ; + Sndfile.close file + +let read_test filename = + let file = Sndfile.openfile filename in + Printf.printf "File contains %Ld frames.\n" (Sndfile.frames file) ; + let data = Array.create 100 0.0 in + let readcount = Sndfile.read file data in + Printf.printf "Read %d items.\n" readcount ; + Sndfile.close file + +let finalize_test filename = + let sub_open_file = + let file = Sndfile.openfile filename in + ignore file + in + (* Compact the heap. *) + Gc.compact () ; + let pre_stat = Gc.stat () in + sub_open_file ; + (* Compact the heap again. *) + Gc.compact () ; + (* Compare before and after. *) + let post_stat = Gc.stat () in + if pre_stat.Gc.heap_words != post_stat.Gc.heap_words then + ( Printf.printf "\nFinalize not working : before %d -> after %d\n\n" pre_stat.Gc.heap_words post_stat.Gc.heap_words ; + exit 1 + ) + else () + +let bad_read_test filename = + try + let file = Sndfile.openfile filename in + ignore file ; + print_endline "Ooops, this should have failed." ; + exit 1 + with + Sndfile.Error (e, s) -> + if s = "System error." then () else + ( Printf.printf "Bad error '%s'\n" s ; + exit 1 + ) + + +let _ = + print_endline "------------------------" ; + let filename = "a.wav" in + write_test filename ; + read_test filename ; + finalize_test filename ; + bad_read_test "this_file_does_not_exist.wav" ; + print_endline "Done : All passed." + diff --git a/interpretor/lib/src/libsndfile-ocaml/test_sndfile_bigarray.ml b/interpretor/lib/src/libsndfile-ocaml/test_sndfile_bigarray.ml new file mode 100644 index 0000000..f6caa1c --- /dev/null +++ b/interpretor/lib/src/libsndfile-ocaml/test_sndfile_bigarray.ml @@ -0,0 +1,46 @@ +(* Rudimentary testing of the Ocaml libsndfile wrapper. *) + +let write_test filename = + let fmt = Sndfile.format Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in + let file = Sndfile.openfile filename ~info:(Sndfile.WRITE, fmt, 2, 44100) () in + if Sndfile.error file != 0 then + Printf.printf "Error writing '%s' : %s\n" filename (Sndfile.strerror file) + else + let writecount = Sndfile_bigarray.write_short file [| 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; 0.5 |] in + Printf.printf "Wrote %d items.\n" writecount ; + Sndfile.close file + +let read_test filename = + let file = Sndfile.openfile filename () in + Printf.printf "File contains %Ld frames.\n" (Sndfile.frames file) ; + let data = Array.create 100 0.0 in + let readcount = Sndfile_bigarray.read_short file data in + Printf.printf "Read %d items.\n" readcount ; + Sndfile.close file + +let finalize_test filename = + let sub_open_file = + let file = Sndfile.openfile filename () in + ignore file + in + (* Compact the heap. *) + Gc.compact () ; + let pre_stat = Gc.stat () in + sub_open_file ; + (* Compact the heap again. *) + Gc.compact () ; + (* Compare before and after. *) + let post_stat = Gc.stat () in + if pre_stat.Gc.heap_words != post_stat.Gc.heap_words then + ( Printf.printf "\nFinalize not working : before %d -> after %d\n\n" pre_stat.Gc.heap_words post_stat.Gc.heap_words ; + exit 1 + ) + else () + + +let _ = + print_endline "------------------------" ; + let filename = "a.wav" in + write_test filename ; + read_test filename ; + finalize_test filename