libsndfile-ocaml source files.
[Faustine.git] / interpretor / faustio.ml
1 (**
2 Module: Faustio
3 Description: audio input/output, csv input/output
4 @author WANG Haisheng
5 Created: 12/08/2013 Modified: 13/08/2013
6 *)
7
8 open Types;;
9 open Basic;;
10 open Value;;
11 open Signal;;
12 open Beam;;
13 open Aux;;
14
15 let csv_read_buffer_length = 0xFFFF;;
16
17 class virtual io =
18 object
19 val mutable _basename = ""
20 val mutable _dir = ""
21 method set : string -> string -> unit =
22 fun (dir : string) ->
23 fun (basename : string) ->
24 _basename <- basename; _dir <- dir
25
26 method virtual read : string array -> beam
27 method virtual write : rate array -> data -> string array
28
29 method private concat : data -> matrix =
30 fun (origin : data) ->
31 Array.map Array.concat (Array.map Array.to_list origin)
32
33 method private channels : data -> int array =
34 fun data ->
35 let get_channel = fun s ->
36 let l = Array.length s in
37 Array.length s.(l - 1) in
38 Array.map get_channel data
39 end;;
40
41 class waveio : io_type =
42 object (self)
43 inherit io
44 method read : string array -> beam =
45 fun (paths : string array) ->
46 let n = Array.length paths in
47 if n = 0 then
48 new beam [||]
49 else
50 let signals =
51 let files = Array.map Sndfile.openfile paths in
52 let frames = Array.map Int64.to_int
53 (Array.map Sndfile.frames files) in
54 let make_rate =
55 fun (denom : int) ->
56 fun (num : int) ->
57 new rate num denom in
58 let nums = Array.map Sndfile.samplerate files in
59 let rates = Array.map (make_rate 1) nums in
60 let create_container = fun l -> Array.create l 1. in
61 let containers = Array.map create_container frames in
62 let _ = array_map2 Sndfile.read files containers in
63 let _ = Array.map Sndfile.close files in
64 let stream2func =
65 fun stream -> fun t -> new value (R stream.(t)) in
66 array_map2 (new signal) rates (Array.map stream2func containers) in
67 new beam signals
68
69 method write : rate array -> data -> string array =
70 fun (rates : rate array) ->
71 fun (output : data) ->
72 let n = Array.length output in
73 let paths = Array.init n (fun i ->
74 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") in
75 let get_freq = fun (r : rate) -> r#to_int in
76 let freqs = Array.map get_freq rates in
77
78 let files =
79 let channels = self#channels output in
80 let file_format = Sndfile.format
81 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
82 let openwr = fun path -> fun channel -> fun freq ->
83 Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
84 array_map3 openwr paths channels freqs in
85
86 let data = self#concat output in
87 let _ = array_map2 Sndfile.write files data in
88 let _ = Array.map Sndfile.close files in
89 paths
90 end;;
91
92
93
94 class csvio : io_type =
95 object (self)
96 inherit io
97 method private csvread : in_channel -> signal =
98 fun (ic : in_channel) ->
99 let buffer = Buffer.create csv_read_buffer_length in
100 let () =
101 try
102 while true do
103 Buffer.add_string buffer (input_line ic);
104 Buffer.add_char buffer '\t';
105 done;
106 with End_of_file -> () in
107 let content = Buffer.contents buffer in
108 let lines = Str.split (Str.regexp "\t") content in
109 let elements = List.map (Str.split (Str.regexp ",")) lines in
110 let data =
111 let data_in_list = List.map (List.map float_of_string) elements in
112 Array.of_list (List.map Array.of_list data_in_list) in
113 let values =
114 let convertor = new value Zero in
115 Array.map (convertor#of_float_array) data in
116 new signal (new rate 0 1) (Array.get values)
117
118 method read : string array -> beam =
119 fun (paths : string array) ->
120 let files = Array.map open_in paths in
121 let signals = Array.map self#csvread files in
122 new beam signals
123
124 method write : rate array -> data -> string array =
125 fun (rates : rate array) ->
126 fun (data : data) ->
127 let paths =
128 let n = Array.length data in
129 let path_pattern = fun i ->
130 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv" in
131 Array.init n path_pattern in
132
133 let files = Array.map open_out paths in
134 let strings =
135 let value2string : float array -> string =
136 fun (v : float array) ->
137 let strings = Array.map string_of_float v in
138 String.concat "," (Array.to_list strings) in
139 let signal2string : float array array -> string =
140 fun (s : float array array) ->
141 let lines = Array.map value2string s in
142 String.concat "\n" (Array.to_list lines) in
143 Array.map signal2string data in
144 let _ = array_map2 output_string files strings in
145 let _ = Array.map close_out files in
146 paths
147 end;;
148
149
150 class iomanager =
151 object (self)
152 val wave = new waveio
153 val csv = new csvio
154 val mutable _dir = ""
155 val mutable _format = ""
156 val mutable _basename = ""
157
158 method private grab_format : string -> string =
159 fun (path : string) ->
160 let fragments = Str.split (Str.regexp "\.") path in
161 let n = List.length fragments in
162 List.nth fragments (n - 1)
163
164 method read : string list -> beam_type =
165 fun (paths : string list) ->
166 let formats = List.map self#grab_format paths in
167 let read_one : string -> string -> beam_type =
168 fun (format : string) ->
169 fun (path : string) ->
170 if format = "wav" then wave#read [|path|]
171 else if format = "csv" then csv#read [|path|]
172 else raise (Invalid_argument "Unknown format.") in
173 let beams = List.map2 read_one formats paths in
174 let concat : beam_type -> beam_type -> beam_type =
175 fun b1 -> fun b2 -> b1#append b2 in
176 List.fold_left concat (new beam [||]) beams
177
178 method set : string -> string -> string -> unit =
179 fun (dir : string) ->
180 fun (format : string) ->
181 fun (basename : string) ->
182 _dir <- dir;
183 _format <- format;
184 _basename <- basename;
185 wave#set _dir _basename;
186 csv#set _dir _basename
187
188 method write : rate array -> data -> string array =
189 fun (rates : rate array) ->
190 fun (data : data) ->
191 if _format = "" then
192 raise (Invalid_argument "output format unset.")
193 else if _format = "wav" then
194 wave#write rates data
195 else if _format = "csv" then
196 csv#write rates data
197 else raise (Invalid_argument "unknown format.")
198
199 end;;