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 open Nest;;
  15
  16 exception IO_Error of string;;
  17
  18 let csv_read_buffer_length = 0xFFFF;;
  19 let nst_read_buffer_length = 0xFFFF;;
  20
  21 class virtual io =
  22   object
  23     val mutable _filename = ""
  24     val mutable _basename = ""
  25     val mutable _dir = ""
  26     method set : string -> string -> string -> unit =
  27       fun (filename : string) ->
  28         fun (dir : string) ->
  29           fun (basename : string) ->
  30             _filename <- filename; _basename <- basename; _dir <- dir
  31
  32     method virtual read : string array -> beam
  33     (*method virtual write : rate array -> data -> string * string -> string array*)
  34
  35     method private concat : data -> matrix =
  36       fun (origin : data) ->
  37         Array.map Array.concat (Array.map Array.to_list origin)
  38
  39     method private channels : data -> int array =
  40       fun data ->
  41         let get_channel = fun s ->
  42           let l = Array.length s in
  43           Array.length s.(l - 1) in
  44         Array.map get_channel data
  45   end;;
  46
  47 class waveio : io_type =
  48   object (self)
  49     inherit io
  50     method read : string array -> beam =
  51       fun (paths : string array) ->
  52         let n = Array.length paths in
  53         if n = 0 then
  54           new beam [||]
  55         else
  56           let signals =
  57             let files = Array.map Sndfile.openfile paths in
  58             let frames = Array.map Int64.to_int
  59                 (Array.map Sndfile.frames files) in
  60             let make_rate =
  61               fun (denom : int) ->
  62                 fun (num : int) ->
  63                   new rate num denom in
  64             let nums = Array.map Sndfile.samplerate files in
  65             let rates = Array.map (make_rate 1) nums in
  66             let create_container = fun l -> Array.create l 1. in
  67             let containers = Array.map create_container frames in
  68             let _ = array_map2 Sndfile.read files containers in
  69             let _ = Array.map Sndfile.close files in
  70             let stream2func =
  71               fun stream -> fun t -> new value (R stream.(t)) in
  72             array_map2 (new signal) rates (Array.map stream2func containers) in
  73           new beam signals
  74
  75     method write : rate array -> data -> string * string -> string array =
  76       fun (rates : rate array) ->
  77         fun (output : data) ->
  78           fun (info : string * string) ->
  79             let stdoutput = fst info in
  80             let basename = snd info in
  81             let n = Array.length output in
  82             let paths =
  83               if n = 1 && stdoutput <> "" && basename = "" then
  84                 let () = Unix.unlink stdoutput in [|stdoutput|]
  85               else if stdoutput = "" && basename <> "" then
  86                 Array.init n (fun i ->
  87                   _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav")
  88               else if stdoutput = "" && basename = "" then
  89                 raise (IO_Error "Please specify stdout or output basename.")
  90               else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
  91             let get_freq = fun (r : rate) -> r#to_int in
  92             let freqs = Array.map get_freq rates in
  93
  94             let files =
  95               let channels = self#channels output in
  96               let file_format = Sndfile.format
  97                   Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
  98               let openwr = fun path -> fun channel -> fun freq ->
  99                 Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
 100               array_map3 openwr paths channels freqs in
 101
 102             let data = self#concat output in
 103             let _ = array_map2 Sndfile.write files data in
 104             let _ = Array.map Sndfile.close files in
 105             paths
 106   end;;
 107
 108
 109
 110 class csvio : io_type =
 111   object (self)
 112     inherit io
 113     method private csvread : in_channel -> signal =
 114       fun (ic : in_channel) ->
 115         let buffer = Buffer.create csv_read_buffer_length in
 116         let () =
 117           try
 118             while true do
 119               Buffer.add_string buffer (input_line ic);
 120               Buffer.add_char buffer '\t';
 121             done;
 122           with End_of_file -> () in
 123         let content = Buffer.contents buffer in
 124         let lines = Str.split (Str.regexp "\t") content in
 125         let elements = List.map (Str.split (Str.regexp ",")) lines in
 126         let data =
 127           let data_in_list = List.map (List.map float_of_string) elements in
 128           Array.of_list (List.map Array.of_list data_in_list) in
 129         let values =
 130           let convertor = new value Zero in
 131           Array.map (convertor#of_float_array) data in
 132         new signal (new rate 0 1) (Array.get values)
 133
 134     method read : string array -> beam =
 135       fun (paths : string array) ->
 136         let files = Array.map open_in paths in
 137         let signals = Array.map self#csvread files in
 138         new beam signals
 139
 140     method write : rate array -> data -> string * string -> string array =
 141       fun (rates : rate array) ->
 142         fun (data : data) ->
 143           fun (info : string * string) ->
 144             let stdoutput = fst info in
 145             let basename = snd info in
 146             let n = Array.length data in
 147             let strings =
 148               let value2string : float array -> string =
 149                 fun (v : float array) ->
 150                   let strings = Array.map string_of_float v in
 151                   String.concat "," (Array.to_list strings) in
 152               let signal2string : float array array -> string =
 153                 fun (s : float array array) ->
 154                   let lines = Array.map value2string s in
 155                   String.concat "\n" (Array.to_list lines) in
 156               Array.map signal2string data in
 157
 158             if stdoutput = "" && basename = "" then
 159               let _ = Array.map (output_string stdout) strings in
 160               [|"Stdout"|]
 161             else
 162               let paths =
 163                 if n = 1 && stdoutput <> "" && basename = "" then
 164                   let () = Unix.unlink stdoutput in [|stdoutput|]
 165                 else if stdoutput = "" && basename <> "" then
 166                   Array.init n (fun i ->
 167                     _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv")
 168                 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
 169               let files = Array.map open_out paths in
 170               let _ = array_map2 output_string files strings in
 171               let _ = Array.map close_out files in
 172               paths
 173   end;;
 174
 175
 176
 177 class nstio =
 178   object (self)
 179     inherit io
 180     method private nstread : in_channel -> signal =
 181       fun (ic : in_channel) ->
 182         let buffer = Buffer.create nst_read_buffer_length in
 183         let () =
 184           try
 185             while true do
 186               Buffer.add_string buffer (input_line ic);
 187               Buffer.add_char buffer '\t';
 188             done;
 189           with End_of_file -> () in
 190         let content = Buffer.contents buffer in
 191         let lines = Str.split (Str.regexp "\t") content in
 192         let basics = List.map basic_from_nest (List.map nest_from_string lines) in
 193         let values = Array.map (new value) (Array.of_list basics) in
 194         new signal (new rate 0 1) (Array.get values)
 195
 196     method read : string array -> beam =
 197       fun (paths : string array) ->
 198         let files = Array.map open_in paths in
 199         let signals = Array.map self#nstread files in
 200         new beam signals
 201
 202     method write : rate array -> raw_data -> string * string -> string array =
 203       fun (rates : rate array) ->
 204         fun (data : raw_data) ->
 205           fun (info : string * string) ->
 206             let stdoutput = fst info in
 207             let basename = snd info in
 208             let length = Array.length data in
 209             let width = Array.length rates in
 210
 211             let strings =
 212               let value2string : value -> string =
 213                 fun (v : value) -> v#to_neststring in
 214               let init = "" in
 215               let container = Array.make length (Array.make width init) in
 216               let index = ref 0 in
 217
 218               try
 219                 while !index < length do
 220                   container.(!index) <- Array.map value2string data.(!index);
 221                   incr index;
 222                 done;
 223                 Array.map (String.concat "\n")
 224                   (Array.map Array.to_list (transpose width container))
 225
 226               with x ->
 227                 match x with
 228                 | Invalid_argument s ->
 229                     let fragments = Array.sub container 0 !index in
 230                     let string_lists =
 231                       Array.map Array.to_list (transpose width fragments) in
 232                     Array.map (String.concat "\n") string_lists
 233                 | _ -> raise x in
 234
 235             if stdoutput = "" && basename = "" then
 236               let _ = Array.map (output_string stdout) strings in
 237               [|"Stdout"|]
 238             else
 239               let paths =
 240                 if width = 1 && stdoutput <> "" && basename = "" then
 241                   let () = Unix.unlink stdoutput in [|stdoutput|]
 242                 else if stdoutput = "" && basename <> "" then
 243                   Array.init width (fun i ->
 244                     _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".nst")
 245                 else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
 246               let files = Array.map open_out paths in
 247               let _ = array_map2 output_string files strings in
 248               let _ = Array.map close_out files in
 249               paths
 250   end;;
 251
 252 class iomanager =
 253   object (self)
 254     val wave = new waveio
 255     val csv = new csvio
 256     val nst = new nstio
 257     val mutable _filename = ""
 258     val mutable _dir = ""
 259     val mutable _format = ""
 260     val mutable _basename = ""
 261
 262     method read : string list -> beam_type =
 263       fun (paths : string list) ->
 264         let formats = List.map format_of_file paths in
 265         let read_one : string -> string -> beam_type =
 266           fun (format : string) ->
 267             fun (path : string) ->
 268               if format = "wav" then wave#read [|path|]
 269               else if format = "csv" then csv#read [|path|]
 270               else if format = "nst" then nst#read [|path|]
 271               else raise (Invalid_argument "Unknown format.") in
 272         let beams = List.map2 read_one formats paths in
 273         let concat : beam_type -> beam_type -> beam_type =
 274           fun b1 -> fun b2 -> b1#append b2 in
 275         List.fold_left concat (new beam [||]) beams
 276
 277     method set : string -> string -> string -> string -> unit =
 278       fun (filename : string) ->
 279         fun (dir : string) ->
 280           fun (format : string) ->
 281             fun (basename : string) ->
 282               _filename <- filename;
 283               _dir <- dir;
 284               _format <- format;
 285               _basename <- basename;
 286               wave#set _filename _dir _basename;
 287               csv#set _filename _dir _basename;
 288               nst#set _filename _dir _basename
 289
 290     method write : rate array -> data -> string array =
 291       fun (rates : rate array) ->
 292         fun (data : data) ->
 293           let n = Array.length rates in
 294           if n = 1 then (
 295             if _filename <> "" then (
 296               let fmt = format_of_file _filename in
 297               if fmt = "csv" then csv#write rates data (_filename, "")
 298               else if fmt = "wav" then wave#write rates data (_filename, "")
 299               else raise (IO_Error "Unknown stdout format."))
 300             else if _basename <> "" && _format <> "" then (
 301               if _format = "csv" then csv#write rates data ("", _basename)
 302               else if _format = "wav" then wave#write rates data ("", _basename)
 303               else raise (IO_Error "Unknown --oformat."))
 304             else if _filename = "" && _basename = "" && _format = "" then
 305               csv#write rates data ("", "")
 306             else raise (IO_Error "Please specify both --obasename and --oformat."))
 307
 308           else if n > 1 then (
 309             if _filename <> "" then
 310               raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
 311             else if _basename <> "" && _format <> "" then (
 312               if _format = "csv" then csv#write rates data ("", _basename)
 313               else if _format = "wav" then wave#write rates data ("", _basename)
 314               else raise (IO_Error "Unknown --oformat."))
 315             else raise (IO_Error "Please specify both --obasename and --oformat."))
 316
 317           else
 318             [|"no output signal."|]
 319
 320     method write_nst : rate array -> raw_data -> string array =
 321       fun (rates : rate array) ->
 322         fun (rd : raw_data) ->
 323           let n = Array.length rates in
 324           let info =
 325               if _filename <> "" && n = 1 then (_filename, "")
 326               else if _basename <> "" && _format <> "" then ("", _basename)
 327               else if _filename = "" && _basename = "" && _format = "" then
 328                 ("", "")
 329               else if _filename <> "" && n > 1 then
 330                 raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
 331               else raise (IO_Error "Please specify both --obasename and --oformat.") in
 332           nst#write rates rd info
 333
 334   end;;
 335
 336