User Manual first draft.
[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 ^ ".wav")|]
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 ^ ".csv")|]
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 private grab_format : string -> string =
175 fun (path : string) ->
176 let fragments = Str.split (Str.regexp "\.") path in
177 let n = List.length fragments in
178 List.nth fragments (n - 1)
179
180 method read : string list -> beam_type =
181 fun (paths : string list) ->
182 let formats = List.map self#grab_format paths in
183 let read_one : string -> string -> beam_type =
184 fun (format : string) ->
185 fun (path : string) ->
186 if format = "wav" then wave#read [|path|]
187 else if format = "csv" then csv#read [|path|]
188 else raise (Invalid_argument "Unknown format.") in
189 let beams = List.map2 read_one formats paths in
190 let concat : beam_type -> beam_type -> beam_type =
191 fun b1 -> fun b2 -> b1#append b2 in
192 List.fold_left concat (new beam [||]) beams
193
194 method set : string -> string -> string -> string -> unit =
195 fun (filename : string) ->
196 fun (dir : string) ->
197 fun (format : string) ->
198 fun (basename : string) ->
199 _output_filename <- filename;
200 _dir <- dir;
201 _format <- format;
202 _basename <- basename;
203 wave#set _output_filename _dir _basename;
204 csv#set _output_filename _dir _basename
205
206 method write : rate array -> data -> string array =
207 fun (rates : rate array) ->
208 fun (data : data) ->
209 if _format = "" then
210 raise (Invalid_argument "output format unset.")
211 else if _format = "wav" then
212 wave#write rates data
213 else if _format = "csv" then
214 csv#write rates data
215 else raise (Invalid_argument "unknown format.")
216
217 end;;