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;;