libsndfile-ocaml source files.

diff --git a/interpretor/lib/src/libsndfile-ocaml/Makefile b/interpretor/lib/src/libsndfile-ocaml/Makefile
new file mode 100644 (file)
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 (file)
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 (file)
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 <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
+*)
+
+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 (file)
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 <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
+*)
+
+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 (file)
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 <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/bigarray.h>
+
+#include <stdlib.h>
+#include <string.h>
+
+#include <sndfile.h>
+
+#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 (file)
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 <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 */

diff --git a/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.h b/interpretor/lib/src/libsndfile-ocaml/sndfile_stub.h
new file mode 100644 (file)
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 <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
+*/
+
+#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 (file)
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 (file)
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