Merge branch 'master' of https://scm.cri.ensmp.fr/git/Faustine
[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 Faustine_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 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 array =
74 fun (rates : rate array) ->
75 fun (output : data) ->
76 let n = Array.length output in
77 let paths =
78 if _filename = "" then
79 Array.init n (fun i ->
80 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav")
81 else if n = 1 then
82 let () = Unix.unlink _filename in [|_filename|]
83 else raise (Faustine_IO_Error ("The process has several output signals,
84 however stdout supports only one output signal. Please remove
85 the '> " ^ _filename ^ "'.")) in
86 let get_freq = fun (r : rate) -> r#to_int in
87 let freqs = Array.map get_freq rates in
88
89 let files =
90 let channels = self#channels output in
91 let file_format = Sndfile.format
92 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
93 let openwr = fun path -> fun channel -> fun freq ->
94 Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
95 array_map3 openwr paths channels freqs in
96
97 let data = self#concat output in
98 let _ = array_map2 Sndfile.write files data in
99 let _ = Array.map Sndfile.close files in
100 paths
101 end;;
102
103
104
105 class csvio : io_type =
106 object (self)
107 inherit io
108 method private csvread : in_channel -> signal =
109 fun (ic : in_channel) ->
110 let buffer = Buffer.create csv_read_buffer_length in
111 let () =
112 try
113 while true do
114 Buffer.add_string buffer (input_line ic);
115 Buffer.add_char buffer '\t';
116 done;
117 with End_of_file -> () in
118 let content = Buffer.contents buffer in
119 let lines = Str.split (Str.regexp "\t") content in
120 let elements = List.map (Str.split (Str.regexp ",")) lines in
121 let data =
122 let data_in_list = List.map (List.map float_of_string) elements in
123 Array.of_list (List.map Array.of_list data_in_list) in
124 let values =
125 let convertor = new value Zero in
126 Array.map (convertor#of_float_array) data in
127 new signal (new rate 0 1) (Array.get values)
128
129 method read : string array -> beam =
130 fun (paths : string array) ->
131 let files = Array.map open_in paths in
132 let signals = Array.map self#csvread files in
133 new beam signals
134
135 method write : rate array -> data -> string array =
136 fun (rates : rate array) ->
137 fun (data : data) ->
138 let n = Array.length data in
139 let paths =
140 if _filename = "" then
141 Array.init n (fun i ->
142 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv")
143 else if n = 1 then
144 let () = Unix.unlink _filename in [|_filename|]
145 else raise (Faustine_IO_Error ("The process has several output signals,
146 however stdout supports only one output signal. Please remove
147 the '> " ^ _filename ^ "'.")) in
148 let files = Array.map open_out paths in
149 let strings =
150 let value2string : float array -> string =
151 fun (v : float array) ->
152 let strings = Array.map string_of_float v in
153 String.concat "," (Array.to_list strings) in
154 let signal2string : float array array -> string =
155 fun (s : float array array) ->
156 let lines = Array.map value2string s in
157 String.concat "\n" (Array.to_list lines) in
158 Array.map signal2string data in
159 let _ = array_map2 output_string files strings in
160 let _ = Array.map close_out files in
161 paths
162 end;;
163
164
165 class iomanager =
166 object (self)
167 val wave = new waveio
168 val csv = new csvio
169 val mutable _output_filename = ""
170 val mutable _dir = ""
171 val mutable _format = ""
172 val mutable _basename = ""
173
174 method read : string list -> beam_type =
175 fun (paths : string list) ->
176 let formats = List.map format_of_file paths in
177 let read_one : string -> string -> beam_type =
178 fun (format : string) ->
179 fun (path : string) ->
180 if format = "wav" then wave#read [|path|]
181 else if format = "csv" then csv#read [|path|]
182 else raise (Invalid_argument "Unknown format.") in
183 let beams = List.map2 read_one formats paths in
184 let concat : beam_type -> beam_type -> beam_type =
185 fun b1 -> fun b2 -> b1#append b2 in
186 List.fold_left concat (new beam [||]) beams
187
188 method set : string -> string -> string -> string -> unit =
189 fun (filename : string) ->
190 fun (dir : string) ->
191 fun (format : string) ->
192 fun (basename : string) ->
193 _output_filename <- filename;
194 _dir <- dir;
195 _format <- format;
196 _basename <- basename;
197 wave#set _output_filename _dir _basename;
198 csv#set _output_filename _dir _basename
199
200 method write : rate array -> data -> string array =
201 fun (rates : rate array) ->
202 fun (data : data) ->
203 if _output_filename = "" then (
204 if _format = "" then
205 raise (Invalid_argument "output format unset.")
206 else if _format = "wav" then
207 wave#write rates data
208 else if _format = "csv" then
209 csv#write rates data
210 else raise (Invalid_argument "unknown format."))
211 else (
212 let format = format_of_file _output_filename in
213 if format = "wav" then
214 wave#write rates data
215 else if format = "csv" then
216 csv#write rates data
217 else raise (Invalid_argument ("unknown format" ^ format)))
218 end;;