1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
let to_string_channels (channels : Signal.t list) : string =
let c = List.length channels in
let n = match channels with [] -> 0 | s :: _ -> Array.length s in
let b = Buffer.create (44 + (2 * c * n)) in
let u32 v = Buffer.add_int32_le b (Int32.of_int v) and u16 v = Buffer.add_uint16_le b v in
Buffer.add_string b "RIFF";
u32 (36 + (2 * c * n));
Buffer.add_string b "WAVEfmt ";
u32 16;
u16 1;
u16 c;
u32 Signal.rate;
u32 (2 * c * Signal.rate);
u16 (2 * c);
u16 16;
Buffer.add_string b "data";
u32 (2 * c * n);
for i = 0 to n - 1 do
List.iter (fun s -> Buffer.add_int16_le b (Signal.to_int16 s.(i))) channels
done;
Buffer.contents b
let to_string (samples : Signal.t) : string = to_string_channels [ samples ]
let chunks (s : string) : (string * int * int) list =
let rec go i acc =
if i + 8 > String.length s then List.rev acc
else
let size = Int32.to_int (String.get_int32_le s (i + 4)) in
go (i + 8 + size + (size land 1)) ((String.sub s i 4, i + 8, size) :: acc)
in
go 12 []
let of_string (s : string) : (Signal.t, string) result =
if String.length s < 12 || String.sub s 0 4 <> "RIFF" || String.sub s 8 4 <> "WAVE" then Error "not a WAV file"
else
let cs = chunks s in
match (List.find_opt (fun (n, _, _) -> n = "fmt ") cs, List.find_opt (fun (n, _, _) -> n = "data") cs) with
| Some (_, fmt, _), Some (_, data, size) ->
let u16 i = String.get_uint16_le s (fmt + i) in
let channels = u16 2 and rate = Int32.to_int (String.get_int32_le s (fmt + 4)) in
if u16 0 <> 1 || u16 14 <> 16 || (channels <> 1 && channels <> 2) then Error "not 16-bit PCM, mono or stereo"
else
let size = min size (String.length s - data) in
let frames = size / (2 * channels) in
let sample i c = float_of_int (String.get_int16_le s (data + (2 * ((i * channels) + c)))) /. 32767. in
let mono =
Array.init frames (fun i -> if channels = 1 then sample i 0 else (sample i 0 +. sample i 1) /. 2.)
in
Ok (Resample.to_rate Linear rate mono)
| _ -> Error "no fmt or no data chunk"
let write (path : string) (samples : Signal.t) : unit =
Out_channel.with_open_bin path (fun oc -> Out_channel.output_string oc (to_string samples))
let read (path : string) : (Signal.t, string) result = of_string (In_channel.with_open_bin path In_channel.input_all)
let write_stereo (path : string) (s : Signal.stereo) : unit =
Out_channel.with_open_bin path (fun oc -> Out_channel.output_string oc (to_string_channels [ s.left; s.right ]))