interpretor/lib/src/libsndfile-ocaml/sndfile_stub.c

   1 /* Stub code to access libsndfile functions from OCaml */
   2
   3 /*
   4 **      Copyright (c) 2006, 2007 Erik de Castro Lopo <erikd at mega-nerd dot com>
   5 **      WWW: http://www.mega-nerd.com/libsndfile/Ocaml/
   6 **
   7 **      This library is free software; you can redistribute it and/or
   8 **      modify it under the terms of the GNU Lesser General Public
   9 **      License as published by the Free Software Foundation; either
  10 **      version 2 of the License, or (at your option) any later version.
  11 **
  12 **      This library is distributed in the hope that it will be useful,
  13 **      but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 **      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 **      Lesser General Public License for more details.
  16 **
  17 **      You should have received a copy of the GNU Lesser General Public
  18 **      License along with this library; if not, write to the Free Software
  19 **      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20 */
  21
  22 #include <caml/mlvalues.h>
  23 #include <caml/alloc.h>
  24 #include <caml/memory.h>
  25 #include <caml/custom.h>
  26 #include <caml/fail.h>
  27 #include <caml/callback.h>
  28 #include <caml/bigarray.h>
  29
  30 #include <stdlib.h>
  31 #include <string.h>
  32
  33 #include <sndfile.h>
  34
  35 #define CAML_SNDFILE_VERSION "v0.1"
  36
  37 #define ARRAY_LEN(x)    ((int) (sizeof (x) / sizeof (x [0])))
  38
  39 typedef struct
  40 {       SNDFILE * file ;
  41         SF_INFO info ;
  42 } SF_WRAPPER ;
  43
  44
  45 static void caml_sf_finalize (value file) ;
  46 static int caml_val_to_major_format (int f) ;
  47 static int caml_val_to_minor_format (int f) ;
  48
  49 static struct custom_operations sndfile_custom_ops =
  50 {
  51         /* identifier */ "SNDFILE/CAMLinterface/" CAML_SNDFILE_VERSION "/sndfile",
  52         /* finalize */ caml_sf_finalize,
  53         /* compare */ NULL,
  54         /* hash */ NULL,
  55         /* serialize */ NULL,
  56         /* deserialize */ NULL
  57 } ;
  58
  59 value
  60 caml_sf_format_e (value v_major, value v_minor, value v_endian)
  61 {
  62         int minor, major, endian ;
  63
  64         CAMLparam3 (v_major, v_minor, v_endian) ;
  65
  66         minor = caml_val_to_minor_format (Int_val (v_minor)) ;
  67         major = caml_val_to_major_format (Int_val (v_major)) ;
  68         endian = (Int_val (v_endian) << 28) & SF_FORMAT_ENDMASK ;
  69
  70         CAMLreturn (Val_int (endian + major + minor)) ;
  71 } /* caml_sf_format_e */
  72
  73 value
  74 caml_sf_open_private (value v_filename, value v_mode, value v_fmt, value v_channels, value v_samplerate)
  75 {
  76         value v_wrapper ;
  77         SF_WRAPPER *wrapper ;
  78         int mode = 0 ;
  79
  80         CAMLparam5 (v_filename, v_mode, v_fmt, v_channels, v_samplerate) ;
  81
  82         v_wrapper = caml_alloc_custom (&sndfile_custom_ops, sizeof (SF_WRAPPER), sizeof (SF_WRAPPER), sizeof (SF_WRAPPER)) ;
  83         wrapper = Data_custom_val (v_wrapper) ;
  84         if (wrapper == NULL)
  85                 failwith ("Sndfile.sf_open : caml_alloc_custom failed.") ;
  86
  87         memset (wrapper, 0, sizeof (*wrapper)) ;
  88
  89         switch (Int_val (v_mode))
  90         {       case 0 :
  91                         mode = SFM_READ ;
  92                         break ;
  93                 case 1 :
  94                         mode = SFM_WRITE ;
  95                         wrapper->info.format = Int_val (v_fmt) ;
  96                         wrapper->info.channels = Int_val (v_channels) ;
  97                         wrapper->info.samplerate = Int_val (v_samplerate) ;
  98                         break ;
  99                 case 2 :
 100                         mode = SFM_RDWR ;
 101                         wrapper->info.format = Int_val (v_fmt) ;
 102                         wrapper->info.channels = Int_val (v_channels) ;
 103                         wrapper->info.samplerate = Int_val (v_samplerate) ;
 104                         break ;
 105                 default :
 106                         break ;
 107                 } ;
 108
 109         wrapper->file = sf_open (String_val (v_filename), mode, &wrapper->info) ;
 110
 111         if (wrapper->file == NULL)
 112         {       int errnum = sf_error (NULL) ;
 113                 const char *err_str = sf_error_number (errnum) ;
 114
 115                 if (err_str == NULL)
 116                         err_str = "????" ;
 117
 118                 value sferr = caml_alloc_tuple (2) ;
 119
 120                 switch (errnum)
 121                 {       case SF_ERR_NO_ERROR :
 122                         case SF_ERR_UNRECOGNISED_FORMAT :
 123                         case SF_ERR_SYSTEM :
 124                         case SF_ERR_MALFORMED_FILE :
 125                         case SF_ERR_UNSUPPORTED_ENCODING :
 126                                 break ;
 127                         default :
 128                                 errnum = SF_ERR_UNSUPPORTED_ENCODING + 1 ;
 129                                 break ;
 130                         } ;
 131
 132                 Store_field (sferr, 0, caml_copy_nativeint (errnum)) ;
 133                 Store_field (sferr, 1, caml_copy_string (err_str)) ;
 134
 135                 value *exn = caml_named_value ("sndfile_open_exn") ;
 136                 if (exn == NULL)
 137                         failwith ("asdasdasdas") ;
 138
 139                 caml_raise_with_arg (*exn, sferr) ;
 140                 } ;
 141
 142     CAMLreturn (v_wrapper) ;
 143 } /* caml_sf_open_private */
 144
 145 value
 146 caml_sf_close (value v_wrapper)
 147 {
 148         SF_WRAPPER *wrapper ;
 149
 150         CAMLparam1 (v_wrapper) ;
 151         wrapper = Data_custom_val (v_wrapper) ;
 152
 153         if (wrapper->file != NULL)
 154         {       sf_close (wrapper->file) ;
 155                 wrapper->file = NULL ;
 156                 } ;
 157
 158     CAMLreturn (Val_unit) ;
 159 } /* caml_sf_close */
 160
 161 /* Pulled from ocaml-cairo sources. Not sure how portable/reliable this is. */
 162 #define Double_array_val(v)    ((double *)(v))
 163 #define Double_array_length(v) (Wosize_val(v) / Double_wosize)
 164
 165 value
 166 caml_sf_read (value v_wrapper, value v_data)
 167 {
 168         SF_WRAPPER *wrapper ;
 169         int count ;
 170
 171         CAMLparam2 (v_wrapper, v_data) ;
 172         wrapper = Data_custom_val (v_wrapper) ;
 173
 174         count = sf_read_double (wrapper->file, Double_array_val (v_data), Double_array_length (v_data)) ;
 175
 176     CAMLreturn (Val_int (count)) ;
 177 } /* caml_sf_read */
 178
 179 value
 180 caml_sf_write (value v_wrapper, value v_data)
 181 {
 182         SF_WRAPPER *wrapper ;
 183         int count ;
 184
 185         CAMLparam2 (v_wrapper, v_data) ;
 186         wrapper = Data_custom_val (v_wrapper) ;
 187
 188         count = sf_write_double (wrapper->file, Double_array_val (v_data), Double_array_length (v_data)) ;
 189
 190     CAMLreturn (Val_int (count)) ;
 191 } /* caml_sf_write */
 192
 193 value
 194 caml_sf_frames (value v_wrapper)
 195 {
 196         SF_WRAPPER *wrapper ;
 197         sf_count_t frames = 0 ;
 198
 199         CAMLparam1 (v_wrapper) ;
 200         wrapper = Data_custom_val (v_wrapper) ;
 201
 202         if (wrapper->file != NULL)
 203                 frames = wrapper->info.frames ;
 204
 205         CAMLreturn (caml_copy_int64 (frames)) ;
 206 } /* caml_sf_frames */
 207
 208 value
 209 caml_sf_samplerate (value v_wrapper)
 210 {
 211         SF_WRAPPER *wrapper ;
 212         int samplerate = 0 ;
 213
 214         CAMLparam1 (v_wrapper) ;
 215         wrapper = Data_custom_val (v_wrapper) ;
 216
 217         if (wrapper->file != NULL)
 218                 samplerate = wrapper->info.samplerate ;
 219
 220         CAMLreturn (Val_int (samplerate)) ;
 221 } /* caml_sf_samplerate */
 222
 223 value
 224 caml_sf_channels (value v_wrapper)
 225 {
 226         SF_WRAPPER *wrapper ;
 227         int channels = 0 ;
 228
 229         CAMLparam1 (v_wrapper) ;
 230         wrapper = Data_custom_val (v_wrapper) ;
 231
 232         if (wrapper->file != NULL)
 233                 channels = wrapper->info.channels ;
 234
 235         CAMLreturn (Val_int (channels)) ;
 236 } /* caml_sf_channels */
 237
 238 value
 239 caml_sf_seek (value v_wrapper, value v_pos, value v_mode)
 240 {
 241         SF_WRAPPER *wrapper ;
 242         sf_count_t pos ;
 243         int mode ;
 244
 245         CAMLparam3 (v_wrapper, v_pos, v_mode) ;
 246
 247         wrapper = Data_custom_val (v_wrapper) ;
 248         mode = Int_val (v_mode) ;
 249         pos = Int64_val (v_pos) ;
 250
 251         pos = sf_seek (wrapper->file, pos, mode) ;
 252
 253         CAMLreturn (Val_int (pos)) ;
 254 } /* caml_sf_seek */
 255
 256 value
 257 caml_sf_compare (value v_wrapper1, value v_wrapper2)
 258 {
 259         SF_WRAPPER *wrapper1, *wrapper2 ;
 260
 261         CAMLparam2 (v_wrapper1, v_wrapper2) ;
 262
 263         wrapper1 = Data_custom_val (v_wrapper1) ;
 264         wrapper2 = Data_custom_val (v_wrapper2) ;
 265
 266         CAMLreturn (Val_int (wrapper2 - wrapper1)) ;
 267 } /* caml_sf_compare */
 268
 269 /*==============================================================================
 270 */
 271
 272 static void
 273 caml_sf_finalize (value v_wrapper)
 274 {
 275         SF_WRAPPER *wrapper ;
 276
 277         wrapper = Data_custom_val (v_wrapper) ;
 278
 279         if (wrapper->file != NULL)
 280         {       sf_close (wrapper->file) ;
 281                 wrapper->file = NULL ;
 282                 } ;
 283
 284 } /* caml_sf_finalize */
 285
 286
 287 static int
 288 caml_val_to_major_format (int f)
 289 {       static int format [] =
 290         {       0,
 291                 0x010000,       /* SF_FORMAT_WAV */
 292                 0x020000,       /* SF_FORMAT_AIFF */
 293                 0x030000,       /* SF_FORMAT_AU */
 294                 0x040000,       /* SF_FORMAT_RAW */
 295                 0x050000,       /* SF_FORMAT_PAF */
 296                 0x060000,       /* SF_FORMAT_SVX */
 297                 0x070000,       /* SF_FORMAT_NIST */
 298                 0x080000,       /* SF_FORMAT_VOC */
 299                 0x0A0000,       /* SF_FORMAT_IRCAM */
 300                 0x0B0000,       /* SF_FORMAT_W64 */
 301                 0x0C0000,       /* SF_FORMAT_MAT4 */
 302                 0x0D0000,       /* SF_FORMAT_MAT5 */
 303                 0x0E0000,       /* SF_FORMAT_PVF */
 304                 0x0F0000,       /* SF_FORMAT_XI */
 305                 0x100000,       /* SF_FORMAT_HTK */
 306                 0x110000,       /* SF_FORMAT_SDS */
 307                 0x120000,       /* SF_FORMAT_AVR */
 308                 0x130000,       /* SF_FORMAT_WAVEX */
 309                 0x160000,       /* SF_FORMAT_SD2 */
 310                 0x170000,       /* SF_FORMAT_FLAC */
 311                 0x180000        /* SF_FORMAT_CAF */
 312                 } ;
 313
 314         if (f < 0 || f >= ARRAY_LEN (format))
 315                 return 0 ;
 316
 317         return format [f] ;
 318 } /* caml_val_to_major_format */
 319
 320 static int
 321 caml_val_to_minor_format (int f)
 322 {       static int format [] =
 323         {       0,
 324                 0x0001, /* SF_FORMAT_PCM_S8 */
 325                 0x0002, /* SF_FORMAT_PCM_16 */
 326                 0x0003, /* SF_FORMAT_PCM_24 */
 327                 0x0004, /* SF_FORMAT_PCM_32 */
 328                 0x0005, /* SF_FORMAT_PCM_U8 */
 329                 0x0006, /* SF_FORMAT_FLOAT */
 330                 0x0007, /* SF_FORMAT_DOUBLE */
 331                 0x0010, /* SF_FORMAT_ULAW */
 332                 0x0011, /* SF_FORMAT_ALAW */
 333                 0x0012, /* SF_FORMAT_IMA_ADPCM */
 334                 0x0013, /* SF_FORMAT_MS_ADPCM */
 335                 0x0020, /* SF_FORMAT_GSM610 */
 336                 0x0021, /* SF_FORMAT_VOX_ADPCM */
 337                 0x0030, /* SF_FORMAT_G721_32 */
 338                 0x0031, /* SF_FORMAT_G723_24 */
 339                 0x0032, /* SF_FORMAT_G723_40 */
 340                 0x0040, /* SF_FORMAT_DWVW_12 */
 341                 0x0041, /* SF_FORMAT_DWVW_16 */
 342                 0x0042, /* SF_FORMAT_DWVW_24 */
 343                 0x0043, /* SF_FORMAT_DWVW_N */
 344                 0x0050, /* SF_FORMAT_DPCM_8 */
 345                 0x0051, /* SF_FORMAT_DPCM_16 */
 346                 } ;
 347
 348         if (f < 0 || f >= ARRAY_LEN (format))
 349                 return 0 ;
 350
 351         return format [f] ;
 352 } /* caml_val_to_minor_format */