X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/1059e1cc0c2ecfa237406949aa26155b6a5b9154..66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83:/interpreter/faustio.ml

diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml
new file mode 100644
index 0000000..7df74a6
--- /dev/null
+++ b/interpreter/faustio.ml
@@ -0,0 +1,199 @@
+(**
+ 	Module: Faustio	
+	Description: audio input/output, csv input/output
+	@author WANG Haisheng	
+	Created: 12/08/2013	Modified: 13/08/2013
+*)
+
+open Types;;
+open Basic;;
+open Value;;
+open Signal;;
+open Beam;;
+open Aux;;
+
+let csv_read_buffer_length = 0xFFFF;;
+
+class virtual io = 
+  object
+    val mutable _basename = ""
+    val mutable _dir = ""
+    method set : string -> string -> unit = 
+      fun (dir : string) ->
+	fun (basename : string) ->
+	  _basename <- basename; _dir <- dir
+
+    method virtual read : string array -> beam
+    method virtual write : rate array -> data -> string array
+    
+    method private concat : data -> matrix = 
+      fun (origin : data) ->
+	Array.map Array.concat (Array.map Array.to_list origin)
+
+    method private channels : data -> int array = 
+      fun data ->
+	let get_channel = fun s -> 
+	  let l = Array.length s in
+	  Array.length s.(l - 1) in
+	Array.map get_channel data  
+  end;;
+
+class waveio : io_type = 
+  object (self)
+    inherit io
+    method read : string array -> beam = 
+      fun (paths : string array) ->
+	let n = Array.length paths in
+	if n = 0 then
+	  new beam [||]
+	else 
+	  let signals = 
+	    let files = Array.map Sndfile.openfile paths in
+	    let frames = Array.map Int64.to_int 
+		(Array.map Sndfile.frames files) in
+	    let make_rate = 
+	      fun (denom : int) ->
+		fun (num : int) ->
+		  new rate num denom in
+	    let nums = Array.map Sndfile.samplerate files in
+	    let rates = Array.map (make_rate 1) nums in
+	    let create_container = fun l -> Array.create l 1. in
+	    let containers = Array.map create_container frames in
+	    let _ = array_map2 Sndfile.read files containers in
+	    let _ = Array.map Sndfile.close files in
+	    let stream2func = 
+	      fun stream -> fun t -> new value (R stream.(t)) in
+	    array_map2 (new signal) rates (Array.map stream2func containers) in
+	  new beam signals
+
+    method write : rate array -> data -> string array = 
+      fun (rates : rate array) ->
+	fun (output : data) ->
+	  let n = Array.length output in	  
+	  let paths = Array.init n (fun i -> 
+	    _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") in
+	  let get_freq = fun (r : rate) -> r#to_int in
+	  let freqs = Array.map get_freq rates in
+
+	  let files = 
+	    let channels = self#channels output in 
+	    let file_format = Sndfile.format 
+		Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
+	    let openwr = fun path -> fun channel -> fun freq ->
+	      Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
+	    array_map3 openwr paths channels freqs in 
+
+	    let data = self#concat output in
+	    let _ = array_map2 Sndfile.write files data in
+	    let _ = Array.map Sndfile.close files in
+	  paths
+  end;;
+
+
+
+class csvio : io_type = 
+  object (self)
+    inherit io
+    method private csvread : in_channel -> signal = 
+      fun (ic : in_channel) ->
+	let buffer = Buffer.create csv_read_buffer_length in
+	let () = 
+	  try
+	    while true do
+	      Buffer.add_string buffer (input_line ic);
+	      Buffer.add_char buffer '\t';
+	    done; 
+	  with End_of_file -> () in
+	let content = Buffer.contents buffer in
+	let lines = Str.split (Str.regexp "\t") content in
+	let elements = List.map (Str.split (Str.regexp ",")) lines in
+	let data = 
+	  let data_in_list = List.map (List.map float_of_string) elements in
+	  Array.of_list (List.map Array.of_list data_in_list) in      
+	let values = 
+	  let convertor = new value Zero in
+	  Array.map (convertor#of_float_array) data in
+	new signal (new rate 0 1) (Array.get values)
+
+    method read : string array -> beam =
+      fun (paths : string array) ->
+	let files = Array.map open_in paths in
+	let signals = Array.map self#csvread files in
+	new beam signals
+
+    method write : rate array -> data -> string array = 
+      fun (rates : rate array) ->
+	fun (data : data) ->
+	  let paths = 
+	    let n = Array.length data in
+	    let path_pattern = fun i -> 
+	      _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv" in
+	    Array.init n path_pattern in	  
+
+	  let files = Array.map open_out paths in
+	  let strings = 
+	    let value2string : float array -> string =
+	      fun (v : float array) ->
+		let strings = Array.map string_of_float v in
+		String.concat "," (Array.to_list strings) in
+	    let signal2string : float array array -> string = 
+	      fun (s : float array array) -> 
+		let lines = Array.map value2string s in
+		String.concat "\n" (Array.to_list lines) in
+	    Array.map signal2string data in
+	  let _ = array_map2 output_string files strings in
+	  let _ = Array.map close_out files in
+	  paths
+  end;;
+
+
+class iomanager = 
+  object (self)
+    val wave = new waveio
+    val csv = new csvio
+    val mutable _dir = ""
+    val mutable _format = ""
+    val mutable _basename = ""
+
+    method private grab_format : string -> string = 
+      fun (path : string) ->
+	let fragments = Str.split (Str.regexp "\.") path in
+	let n = List.length fragments in
+	List.nth fragments (n - 1)	
+
+    method read : string list -> beam_type = 
+      fun (paths : string list) ->
+	let formats = List.map self#grab_format paths in
+	let read_one : string -> string -> beam_type = 
+	  fun (format : string) ->
+	    fun (path : string) ->
+	      if format = "wav" then wave#read [|path|]
+	      else if format = "csv" then csv#read [|path|]
+	      else raise (Invalid_argument "Unknown format.") in
+	let beams = List.map2 read_one formats paths in
+	let concat : beam_type -> beam_type -> beam_type = 
+	  fun b1 -> fun b2 -> b1#append b2 in
+	List.fold_left concat (new beam [||]) beams
+	      
+    method set : string -> string -> string -> unit = 
+      fun (dir : string) ->
+	fun (format : string) ->
+	  fun (basename : string) ->
+	    _dir <- dir; 
+	    _format <- format; 
+	    _basename <- basename;
+	    wave#set _dir _basename;
+	    csv#set _dir _basename
+
+    method write : rate array -> data -> string array = 
+      fun (rates : rate array) ->
+	fun (data : data) ->
+	  if _format = "" then
+	    raise (Invalid_argument "output format unset.")
+	  else if _format = "wav" then 
+	    wave#write rates data
+	  else if _format = "csv" then
+	    csv#write rates data 
+	  else raise (Invalid_argument "unknown format.")
+	
+  end;;