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