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 let csv_read_buffer_length = 0xFFFF;;
  16
  17 class virtual io =
  18   object
  19     val mutable _basename = ""
  20     val mutable _dir = ""
  21     method set : string -> string -> unit =
  22       fun (dir : string) ->
  23         fun (basename : string) ->
  24           _basename <- basename; _dir <- dir
  25
  26     method virtual read : string array -> beam
  27     method virtual write : rate array -> data -> string array
  28
  29     method private concat : data -> matrix =
  30       fun (origin : data) ->
  31         Array.map Array.concat (Array.map Array.to_list origin)
  32
  33     method private channels : data -> int array =
  34       fun data ->
  35         let get_channel = fun s ->
  36           let l = Array.length s in
  37           Array.length s.(l - 1) in
  38         Array.map get_channel data
  39   end;;
  40
  41 class waveio : io_type =
  42   object (self)
  43     inherit io
  44     method read : string array -> beam =
  45       fun (paths : string array) ->
  46         let n = Array.length paths in
  47         if n = 0 then
  48           new beam [||]
  49         else
  50           let signals =
  51             let files = Array.map Sndfile.openfile paths in
  52             let frames = Array.map Int64.to_int
  53                 (Array.map Sndfile.frames files) in
  54             let make_rate =
  55               fun (denom : int) ->
  56                 fun (num : int) ->
  57                   new rate num denom in
  58             let nums = Array.map Sndfile.samplerate files in
  59             let rates = Array.map (make_rate 1) nums in
  60             let create_container = fun l -> Array.create l 1. in
  61             let containers = Array.map create_container frames in
  62             let _ = array_map2 Sndfile.read files containers in
  63             let _ = Array.map Sndfile.close files in
  64             let stream2func =
  65               fun stream -> fun t -> new value (R stream.(t)) in
  66             array_map2 (new signal) rates (Array.map stream2func containers) in
  67           new beam signals
  68
  69     method write : rate array -> data -> string array =
  70       fun (rates : rate array) ->
  71         fun (output : data) ->
  72           let n = Array.length output in
  73           let paths = Array.init n (fun i ->
  74             _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") in
  75           let get_freq = fun (r : rate) -> r#to_int in
  76           let freqs = Array.map get_freq rates in
  77
  78           let files =
  79             let channels = self#channels output in
  80             let file_format = Sndfile.format
  81                 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
  82             let openwr = fun path -> fun channel -> fun freq ->
  83               Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
  84             array_map3 openwr paths channels freqs in
  85
  86             let data = self#concat output in
  87             let _ = array_map2 Sndfile.write files data in
  88             let _ = Array.map Sndfile.close files in
  89           paths
  90   end;;
  91
  92
  93
  94 class csvio : io_type =
  95   object (self)
  96     inherit io
  97     method private csvread : in_channel -> signal =
  98       fun (ic : in_channel) ->
  99         let buffer = Buffer.create csv_read_buffer_length in
 100         let () =
 101           try
 102             while true do
 103               Buffer.add_string buffer (input_line ic);
 104               Buffer.add_char buffer '\t';
 105             done;
 106           with End_of_file -> () in
 107         let content = Buffer.contents buffer in
 108         let lines = Str.split (Str.regexp "\t") content in
 109         let elements = List.map (Str.split (Str.regexp ",")) lines in
 110         let data =
 111           let data_in_list = List.map (List.map float_of_string) elements in
 112           Array.of_list (List.map Array.of_list data_in_list) in
 113         let values =
 114           let convertor = new value Zero in
 115           Array.map (convertor#of_float_array) data in
 116         new signal (new rate 0 1) (Array.get values)
 117
 118     method read : string array -> beam =
 119       fun (paths : string array) ->
 120         let files = Array.map open_in paths in
 121         let signals = Array.map self#csvread files in
 122         new beam signals
 123
 124     method write : rate array -> data -> string array =
 125       fun (rates : rate array) ->
 126         fun (data : data) ->
 127           let paths =
 128             let n = Array.length data in
 129             let path_pattern = fun i ->
 130               _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv" in
 131             Array.init n path_pattern in
 132
 133           let files = Array.map open_out paths in
 134           let strings =
 135             let value2string : float array -> string =
 136               fun (v : float array) ->
 137                 let strings = Array.map string_of_float v in
 138                 String.concat "," (Array.to_list strings) in
 139             let signal2string : float array array -> string =
 140               fun (s : float array array) ->
 141                 let lines = Array.map value2string s in
 142                 String.concat "\n" (Array.to_list lines) in
 143             Array.map signal2string data in
 144           let _ = array_map2 output_string files strings in
 145           let _ = Array.map close_out files in
 146           paths
 147   end;;
 148
 149
 150 class iomanager =
 151   object (self)
 152     val wave = new waveio
 153     val csv = new csvio
 154     val mutable _dir = ""
 155     val mutable _format = ""
 156     val mutable _basename = ""
 157
 158     method private grab_format : string -> string =
 159       fun (path : string) ->
 160         let fragments = Str.split (Str.regexp "\.") path in
 161         let n = List.length fragments in
 162         List.nth fragments (n - 1)
 163
 164     method read : string list -> beam_type =
 165       fun (paths : string list) ->
 166         let formats = List.map self#grab_format paths in
 167         let read_one : string -> string -> beam_type =
 168           fun (format : string) ->
 169             fun (path : string) ->
 170               if format = "wav" then wave#read [|path|]
 171               else if format = "csv" then csv#read [|path|]
 172               else raise (Invalid_argument "Unknown format.") in
 173         let beams = List.map2 read_one formats paths in
 174         let concat : beam_type -> beam_type -> beam_type =
 175           fun b1 -> fun b2 -> b1#append b2 in
 176         List.fold_left concat (new beam [||]) beams
 177
 178     method set : string -> string -> string -> unit =
 179       fun (dir : string) ->
 180         fun (format : string) ->
 181           fun (basename : string) ->
 182             _dir <- dir;
 183             _format <- format;
 184             _basename <- basename;
 185             wave#set _dir _basename;
 186             csv#set _dir _basename
 187
 188     method write : rate array -> data -> string array =
 189       fun (rates : rate array) ->
 190         fun (data : data) ->
 191           if _format = "" then
 192             raise (Invalid_argument "output format unset.")
 193           else if _format = "wav" then
 194             wave#write rates data
 195           else if _format = "csv" then
 196             csv#write rates data
 197           else raise (Invalid_argument "unknown format.")
 198
 199   end;;