/* 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 */