Pretty printing of main.ml.
[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 default_output_path = "../output_sounds/";;
16 let csv_read_buffer_length = 0xFFFF;;
17
18 class virtual io =
19 object
20 method virtual read : string array -> beam
21 method virtual write : int array -> float array array array -> string array
22 method private concat : float array array array -> float array array =
23 fun (origin : float array array array) ->
24 Array.map Array.concat (Array.map Array.to_list origin)
25 method private channels : float array array array -> int array =
26 fun data ->
27 let get_channel = fun s ->
28 let l = Array.length s in
29 Array.length s.(l - 1) in
30 Array.map get_channel data
31 end;;
32
33 class waveio : io_type =
34 object (self)
35 inherit io
36 method read : string array -> beam =
37 fun (paths : string array) ->
38 let n = Array.length paths in
39 if n = 0 then
40 new beam [||]
41 else
42 let signals =
43 let files = Array.map Sndfile.openfile paths in
44 let frames = Array.map Int64.to_int
45 (Array.map Sndfile.frames files) in
46 let rates = Array.map Sndfile.samplerate files in
47 let create_container = fun l -> Array.create l 1. in
48 let containers = Array.map create_container frames in
49 let _ = array_map2 Sndfile.read files containers in
50 let _ = Array.map Sndfile.close files in
51 let stream2func =
52 fun stream -> fun t -> new value (R stream.(t)) in
53 array_map2 (new signal) rates (Array.map stream2func containers) in
54 new beam signals
55
56 method write : int array -> float array array array -> string array =
57 fun (rates : int array) ->
58 fun (output : float array array array) ->
59 let () = print_string(" Faustine -> Writing wave files...") in
60 let tic = Sys.time () in
61
62 let n = Array.length output in
63 let paths = Array.init n (fun i ->
64 default_output_path ^ "output" ^ (string_of_int (i + 1)) ^ ".wav") in
65
66 let files =
67 let channels = self#channels output in
68 let file_format = Sndfile.format
69 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
70 let openwr = fun path -> fun channel -> fun rate ->
71 Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, rate) path in
72 array_map3 openwr paths channels rates in
73
74 let () =
75 let data = self#concat output in
76 let _ = array_map2 Sndfile.write files data in
77 let _ = Array.map Sndfile.close files in
78 let toc = Sys.time () in
79 let duration = toc -. tic in
80 print_endline
81 (" Done. (duration: " ^ (string_of_float duration) ^ "s)") in
82 paths
83 end;;
84
85
86
87 class csvio : io_type =
88 object (self)
89 inherit io
90 method private csvread : in_channel -> signal =
91 fun (ic : in_channel) ->
92 let buffer = Buffer.create csv_read_buffer_length in
93 let () =
94 try
95 while true do
96 Buffer.add_string buffer (input_line ic);
97 Buffer.add_char buffer '\t';
98 done;
99 with End_of_file -> () in
100 let content = Buffer.contents buffer in
101 let lines = Str.split (Str.regexp "\t") content in
102 let elements = List.map (Str.split (Str.regexp ",")) lines in
103 let data =
104 let data_in_list = List.map (List.map float_of_string) elements in
105 Array.of_list (List.map Array.of_list data_in_list) in
106 let values =
107 let convertor = new value Zero in
108 Array.map (convertor#of_float_array) data in
109 new signal 0 (Array.get values)
110
111 method read : string array -> beam =
112 fun (paths : string array) ->
113 let files = Array.map open_in paths in
114 let signals = Array.map self#csvread files in
115 new beam signals
116
117 method write : int array -> float array array array -> string array =
118 fun (rates : int array) ->
119 fun (data : float array array array) ->
120 let () = print_string(" Faustine -> Writing csv files...") in
121 let tic = Sys.time () in
122
123 let paths =
124 let n = Array.length data in
125 let path_pattern = fun i ->
126 default_output_path ^ "output" ^ (string_of_int (i + 1)) ^ ".csv" in
127 Array.init n path_pattern in
128
129 let files = Array.map open_out paths in
130 let strings =
131 let value2string : float array -> string =
132 fun (v : float array) ->
133 let strings = Array.map string_of_float v in
134 String.concat "," (Array.to_list strings) in
135 let signal2string : float array array -> string =
136 fun (s : float array array) ->
137 let lines = Array.map value2string s in
138 String.concat "\n" (Array.to_list lines) in
139 Array.map signal2string data in
140 let _ = array_map2 output_string files strings in
141 let _ = Array.map close_out files in
142 let toc = Sys.time () in
143 let () = print_endline
144 (" Done. (duration: " ^ (string_of_float (toc -. tic)) ^ "s)") in
145 paths
146 end;;