8cca058fb5981a1781d7619bbea03afc1ee684c8
[Faustine.git] / interpreter / 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 exception IO_Error of string;;
16
17 let csv_read_buffer_length = 0xFFFF;;
18
19 class virtual io =
20 object
21 val mutable _filename = ""
22 val mutable _basename = ""
23 val mutable _dir = ""
24 method set : string -> string -> string -> unit =
25 fun (filename : string) ->
26 fun (dir : string) ->
27 fun (basename : string) ->
28 _filename <- filename; _basename <- basename; _dir <- dir
29
30 method virtual read : string array -> beam
31 method virtual write : rate array -> data -> string * string -> string array
32
33 method private concat : data -> matrix =
34 fun (origin : data) ->
35 Array.map Array.concat (Array.map Array.to_list origin)
36
37 method private channels : data -> int array =
38 fun data ->
39 let get_channel = fun s ->
40 let l = Array.length s in
41 Array.length s.(l - 1) in
42 Array.map get_channel data
43 end;;
44
45 class waveio : io_type =
46 object (self)
47 inherit io
48 method read : string array -> beam =
49 fun (paths : string array) ->
50 let n = Array.length paths in
51 if n = 0 then
52 new beam [||]
53 else
54 let signals =
55 let files = Array.map Sndfile.openfile paths in
56 let frames = Array.map Int64.to_int
57 (Array.map Sndfile.frames files) in
58 let make_rate =
59 fun (denom : int) ->
60 fun (num : int) ->
61 new rate num denom in
62 let nums = Array.map Sndfile.samplerate files in
63 let rates = Array.map (make_rate 1) nums in
64 let create_container = fun l -> Array.create l 1. in
65 let containers = Array.map create_container frames in
66 let _ = array_map2 Sndfile.read files containers in
67 let _ = Array.map Sndfile.close files in
68 let stream2func =
69 fun stream -> fun t -> new value (R stream.(t)) in
70 array_map2 (new signal) rates (Array.map stream2func containers) in
71 new beam signals
72
73 method write : rate array -> data -> string * string -> string array =
74 fun (rates : rate array) ->
75 fun (output : data) ->
76 fun (info : string * string) ->
77 let stdoutput = fst info in
78 let basename = snd info in
79 let n = Array.length output in
80 let paths =
81 if n = 1 && stdoutput <> "" && basename = "" then
82 let () = Unix.unlink stdoutput in [|stdoutput|]
83 else if stdoutput = "" && basename <> "" then
84 Array.init n (fun i ->
85 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav")
86 else if stdoutput = "" && basename = "" then
87 raise (IO_Error "Please specify stdout or output basename.")
88 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
89 let get_freq = fun (r : rate) -> r#to_int in
90 let freqs = Array.map get_freq rates in
91
92 let files =
93 let channels = self#channels output in
94 let file_format = Sndfile.format
95 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
96 let openwr = fun path -> fun channel -> fun freq ->
97 Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
98 array_map3 openwr paths channels freqs in
99
100 let data = self#concat output in
101 let _ = array_map2 Sndfile.write files data in
102 let _ = Array.map Sndfile.close files in
103 paths
104 end;;
105
106
107
108 class csvio : io_type =
109 object (self)
110 inherit io
111 method private csvread : in_channel -> signal =
112 fun (ic : in_channel) ->
113 let buffer = Buffer.create csv_read_buffer_length in
114 let () =
115 try
116 while true do
117 Buffer.add_string buffer (input_line ic);
118 Buffer.add_char buffer '\t';
119 done;
120 with End_of_file -> () in
121 let content = Buffer.contents buffer in
122 let lines = Str.split (Str.regexp "\t") content in
123 let elements = List.map (Str.split (Str.regexp ",")) lines in
124 let data =
125 let data_in_list = List.map (List.map float_of_string) elements in
126 Array.of_list (List.map Array.of_list data_in_list) in
127 let values =
128 let convertor = new value Zero in
129 Array.map (convertor#of_float_array) data in
130 new signal (new rate 0 1) (Array.get values)
131
132 method read : string array -> beam =
133 fun (paths : string array) ->
134 let files = Array.map open_in paths in
135 let signals = Array.map self#csvread files in
136 new beam signals
137
138 method write : rate array -> data -> string * string -> string array =
139 fun (rates : rate array) ->
140 fun (data : data) ->
141 fun (info : string * string) ->
142 let stdoutput = fst info in
143 let basename = snd info in
144 let n = Array.length data in
145 let strings =
146 let value2string : float array -> string =
147 fun (v : float array) ->
148 let strings = Array.map string_of_float v in
149 String.concat "," (Array.to_list strings) in
150 let signal2string : float array array -> string =
151 fun (s : float array array) ->
152 let lines = Array.map value2string s in
153 String.concat "\n" (Array.to_list lines) in
154 Array.map signal2string data in
155
156 if stdoutput = "" && basename = "" then
157 let _ = Array.map (output_string stdout) strings in
158 [|"Stdout"|]
159 else
160 let paths =
161 if n = 1 && stdoutput <> "" && basename = "" then
162 let () = Unix.unlink stdoutput in [|stdoutput|]
163 else if stdoutput = "" && basename <> "" then
164 Array.init n (fun i ->
165 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv")
166 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
167 let files = Array.map open_out paths in
168 let _ = array_map2 output_string files strings in
169 let _ = Array.map close_out files in
170 paths
171 end;;
172
173
174 class iomanager =
175 object (self)
176 val wave = new waveio
177 val csv = new csvio
178 val mutable _filename = ""
179 val mutable _dir = ""
180 val mutable _format = ""
181 val mutable _basename = ""
182
183 method read : string list -> beam_type =
184 fun (paths : string list) ->
185 let formats = List.map format_of_file paths in
186 let read_one : string -> string -> beam_type =
187 fun (format : string) ->
188 fun (path : string) ->
189 if format = "wav" then wave#read [|path|]
190 else if format = "csv" then csv#read [|path|]
191 else raise (Invalid_argument "Unknown format.") in
192 let beams = List.map2 read_one formats paths in
193 let concat : beam_type -> beam_type -> beam_type =
194 fun b1 -> fun b2 -> b1#append b2 in
195 List.fold_left concat (new beam [||]) beams
196
197 method set : string -> string -> string -> string -> unit =
198 fun (filename : string) ->
199 fun (dir : string) ->
200 fun (format : string) ->
201 fun (basename : string) ->
202 _filename <- filename;
203 _dir <- dir;
204 _format <- format;
205 _basename <- basename;
206 wave#set _filename _dir _basename;
207 csv#set _filename _dir _basename
208
209 method write : rate array -> data -> string array =
210 fun (rates : rate array) ->
211 fun (data : data) ->
212 let n = Array.length rates in
213 if n = 1 then (
214 if _filename <> "" then (
215 let fmt = format_of_file _filename in
216 if fmt = "csv" then csv#write rates data (_filename, "")
217 else if fmt = "wav" then wave#write rates data (_filename, "")
218 else raise (IO_Error "Unknown stdout format."))
219 else if _basename <> "" && _format <> "" then (
220 if _format = "csv" then csv#write rates data ("", _basename)
221 else if _format = "wav" then wave#write rates data ("", _basename)
222 else raise (IO_Error "Unknown --oformat."))
223 else if _filename = "" && _basename = "" && _format = "" then
224 csv#write rates data ("", "")
225 else raise (IO_Error "Please specify both --obasename and --oformat."))
226
227 else if n > 1 then (
228 if _filename <> "" then
229 raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
230 else if _basename <> "" && _format <> "" then (
231 if _format = "csv" then csv#write rates data ("", _basename)
232 else if _format = "wav" then wave#write rates data ("", _basename)
233 else raise (IO_Error "Unknown --oformat."))
234 else raise (IO_Error "Please specify both --obasename and --oformat."))
235
236 else
237 [|"no output signal."|]
238 end;;