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 Faustine_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 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 array =
  74       fun (rates : rate array) ->
  75         fun (output : data) ->
  76           let n = Array.length output in
  77           let paths =
  78             if _filename = "" then
  79               Array.init n (fun i ->
  80                 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav")
  81             else if n = 1 then
  82               let () = Unix.unlink "_filename" in [|(_filename ^ ".wav")|]
  83             else raise (Faustine_IO_Error ("The process has several output signals,
  84                         however stdout supports only one output signal. Please remove
  85                         the '> " ^ _filename ^ "'.")) in
  86           let get_freq = fun (r : rate) -> r#to_int in
  87           let freqs = Array.map get_freq rates in
  88
  89           let files =
  90             let channels = self#channels output in
  91             let file_format = Sndfile.format
  92                 Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
  93             let openwr = fun path -> fun channel -> fun freq ->
  94               Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
  95             array_map3 openwr paths channels freqs in
  96
  97             let data = self#concat output in
  98             let _ = array_map2 Sndfile.write files data in
  99             let _ = Array.map Sndfile.close files in
 100           paths
 101   end;;
 102
 103
 104
 105 class csvio : io_type =
 106   object (self)
 107     inherit io
 108     method private csvread : in_channel -> signal =
 109       fun (ic : in_channel) ->
 110         let buffer = Buffer.create csv_read_buffer_length in
 111         let () =
 112           try
 113             while true do
 114               Buffer.add_string buffer (input_line ic);
 115               Buffer.add_char buffer '\t';
 116             done;
 117           with End_of_file -> () in
 118         let content = Buffer.contents buffer in
 119         let lines = Str.split (Str.regexp "\t") content in
 120         let elements = List.map (Str.split (Str.regexp ",")) lines in
 121         let data =
 122           let data_in_list = List.map (List.map float_of_string) elements in
 123           Array.of_list (List.map Array.of_list data_in_list) in
 124         let values =
 125           let convertor = new value Zero in
 126           Array.map (convertor#of_float_array) data in
 127         new signal (new rate 0 1) (Array.get values)
 128
 129     method read : string array -> beam =
 130       fun (paths : string array) ->
 131         let files = Array.map open_in paths in
 132         let signals = Array.map self#csvread files in
 133         new beam signals
 134
 135     method write : rate array -> data -> string array =
 136       fun (rates : rate array) ->
 137         fun (data : data) ->
 138           let n = Array.length data in
 139           let paths =
 140             if _filename = "" then
 141               Array.init n (fun i ->
 142                 _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv")
 143             else if n = 1 then
 144               let () = Unix.unlink _filename in [|(_filename ^ ".csv")|]
 145             else raise (Faustine_IO_Error ("The process has several output signals,
 146                         however stdout supports only one output signal. Please remove
 147                         the '> " ^ _filename ^ "'.")) in
 148           let files = Array.map open_out paths in
 149           let strings =
 150             let value2string : float array -> string =
 151               fun (v : float array) ->
 152                 let strings = Array.map string_of_float v in
 153                 String.concat "," (Array.to_list strings) in
 154             let signal2string : float array array -> string =
 155               fun (s : float array array) ->
 156                 let lines = Array.map value2string s in
 157                 String.concat "\n" (Array.to_list lines) in
 158             Array.map signal2string data in
 159           let _ = array_map2 output_string files strings in
 160           let _ = Array.map close_out files in
 161           paths
 162   end;;
 163
 164
 165 class iomanager =
 166   object (self)
 167     val wave = new waveio
 168     val csv = new csvio
 169     val mutable _output_filename = ""
 170     val mutable _dir = ""
 171     val mutable _format = ""
 172     val mutable _basename = ""
 173
 174     method private grab_format : string -> string =
 175       fun (path : string) ->
 176         let fragments = Str.split (Str.regexp "\.") path in
 177         let n = List.length fragments in
 178         List.nth fragments (n - 1)
 179
 180     method read : string list -> beam_type =
 181       fun (paths : string list) ->
 182         let formats = List.map self#grab_format paths in
 183         let read_one : string -> string -> beam_type =
 184           fun (format : string) ->
 185             fun (path : string) ->
 186               if format = "wav" then wave#read [|path|]
 187               else if format = "csv" then csv#read [|path|]
 188               else raise (Invalid_argument "Unknown format.") in
 189         let beams = List.map2 read_one formats paths in
 190         let concat : beam_type -> beam_type -> beam_type =
 191           fun b1 -> fun b2 -> b1#append b2 in
 192         List.fold_left concat (new beam [||]) beams
 193
 194     method set : string -> string -> string -> string -> unit =
 195       fun (filename : string) ->
 196         fun (dir : string) ->
 197           fun (format : string) ->
 198             fun (basename : string) ->
 199               _output_filename <- filename;
 200               _dir <- dir;
 201               _format <- format;
 202               _basename <- basename;
 203               wave#set _output_filename _dir _basename;
 204               csv#set _output_filename _dir _basename
 205
 206     method write : rate array -> data -> string array =
 207       fun (rates : rate array) ->
 208         fun (data : data) ->
 209           if _format = "" then
 210             raise (Invalid_argument "output format unset.")
 211           else if _format = "wav" then
 212             wave#write rates data
 213           else if _format = "csv" then
 214             csv#write rates data
 215           else raise (Invalid_argument "unknown format.")
 216
 217   end;;