projects / Faustine.git / blob
? search:


ccf2b169e804791f29573bfa2bc6e9d9c8b33bf6
[Faustine.git] / interpreter / 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 */
An OCaml-based interpreter for Faust and its vector extension