--- /dev/null
+
+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
--- /dev/null
+
+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
+
+*)
--- /dev/null
+(*
+** 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."))
--- /dev/null
+(*
+** 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"
--- /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/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 */
+
--- /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 */
--- /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
+*/
+
+#define ARRAY_LEN(x) ((int) (sizeof (x) / sizeof (x [0])))
+
+typedef struct
+{ SNDFILE * file ;
+ SF_INFO info ;
+} SF_WRAPPER ;
+
+
--- /dev/null
+(* 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."
+
--- /dev/null
+(* 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
projects / Faustine.git / commitdiff