X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83..refs/heads/master:/interpreter/faustio.ml?ds=inline

diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml
index 7df74a6..408d750 100644
--- a/interpreter/faustio.ml
+++ b/interpreter/faustio.ml
@@ -11,20 +11,26 @@ open Value;;
 open Signal;;
 open Beam;;
 open Aux;;
+open Nest;;
+
+exception IO_Error of string;;
 
 let csv_read_buffer_length = 0xFFFF;;
+let nst_read_buffer_length = 0xFFFF;;
 
 class virtual io = 
   object
+    val mutable _filename = ""
     val mutable _basename = ""
     val mutable _dir = ""
-    method set : string -> string -> unit = 
-      fun (dir : string) ->
-	fun (basename : string) ->
-	  _basename <- basename; _dir <- dir
+    method set : string -> string -> string -> unit = 
+      fun (filename : string) ->
+	fun (dir : string) ->
+	  fun (basename : string) ->
+	    _filename <- filename; _basename <- basename; _dir <- dir
 
     method virtual read : string array -> beam
-    method virtual write : rate array -> data -> string array
+    (*method virtual write : rate array -> data -> string * string -> string array*)
     
     method private concat : data -> matrix = 
       fun (origin : data) ->
@@ -66,27 +72,37 @@ class waveio : io_type =
 	    array_map2 (new signal) rates (Array.map stream2func containers) in
 	  new beam signals
 
-    method write : rate array -> data -> string array = 
+    method write : rate array -> data -> string * string -> 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 
-
+	  fun (info : string * string) ->
+	    let stdoutput = fst info in
+	    let basename = snd info in
+	    let n = Array.length output in
+	    let paths = 
+	      if n = 1 && stdoutput <> "" && basename = "" then 
+		let () = Unix.unlink stdoutput in [|stdoutput|]
+	      else if stdoutput = "" && basename <> "" then 
+		Array.init n (fun i -> 
+		  _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") 		
+	      else if stdoutput = "" && basename = "" then
+		raise (IO_Error "Please specify stdout or output basename.")
+	      else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") 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
+	    paths
   end;;
 
 
@@ -121,79 +137,200 @@ class csvio : io_type =
 	let signals = Array.map self#csvread files in
 	new beam signals
 
-    method write : rate array -> data -> string array = 
+    method write : rate array -> data -> string * string -> string array = 
       fun (rates : rate array) ->
 	fun (data : data) ->
-	  let paths = 
+	  fun (info : string * string) -> 
+	    let stdoutput = fst info in
+	    let basename = snd info in
 	    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
+	    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
+
+	    if stdoutput = "" && basename = "" then
+	      let _ = Array.map (output_string stdout) strings in
+	      [|"Stdout"|]
+	    else 
+	      let paths = 
+		if n = 1 && stdoutput <> "" && basename = "" then 
+		  let () = Unix.unlink stdoutput in [|stdoutput|]
+		else if stdoutput = "" && basename <> "" then 
+		  Array.init n (fun i -> 
+		    _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv") 
+		else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
+              let files = Array.map open_out paths in
+	      let _ = array_map2 output_string files strings in
+	      let _ = Array.map close_out files in
+	      paths
   end;;
 
 
+
+class nstio = 
+  object (self)
+    inherit io
+    method private nstread : in_channel -> signal = 
+      fun (ic : in_channel) ->
+	let buffer = Buffer.create nst_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 basics = List.map basic_from_nest (List.map nest_from_string lines) in
+        let values = Array.map (new value) (Array.of_list basics) 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#nstread files in
+	new beam signals
+
+    method write : rate array -> raw_data -> string * string -> string array = 
+      fun (rates : rate array) ->
+	fun (data : raw_data) ->
+	  fun (info : string * string) -> 
+	    let stdoutput = fst info in
+	    let basename = snd info in
+	    let length = Array.length data in
+            let width = Array.length rates in
+
+	    let strings = 
+              let value2string : value -> string =
+                fun (v : value) -> v#to_neststring in
+              let init = "" in
+              let container = Array.make length (Array.make width init) in
+              let index = ref 0 in
+
+              try 
+                while !index < length do
+                  container.(!index) <- Array.map value2string data.(!index);
+                  incr index;
+                done;
+                Array.map (String.concat "\n") 
+                  (Array.map Array.to_list (transpose width container))
+
+              with x -> 
+                match x with
+                | Invalid_argument s -> 
+                    let fragments = Array.sub container 0 !index in
+                    let string_lists = 
+                      Array.map Array.to_list (transpose width fragments) in
+                    Array.map (String.concat "\n") string_lists
+                | _ -> raise x in
+
+	    if stdoutput = "" && basename = "" then
+	      let _ = Array.map (output_string stdout) strings in
+	      [|"Stdout"|]
+	    else 
+	      let paths = 
+		if width = 1 && stdoutput <> "" && basename = "" then 
+		  let () = Unix.unlink stdoutput in [|stdoutput|]
+		else if stdoutput = "" && basename <> "" then 
+		  Array.init width (fun i -> 
+		    _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".nst") 
+		else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
+              let files = Array.map open_out paths 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 nst = new nstio
+    val mutable _filename = ""
     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 formats = List.map format_of_file 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 if format = "nst" then nst#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 set : string -> string -> string -> string -> unit = 
+      fun (filename : string) ->
+	fun (dir : string) ->
+	  fun (format : string) ->
+	    fun (basename : string) ->
+	      _filename <- filename;
+	      _dir <- dir; 
+	      _format <- format; 
+	      _basename <- basename;
+	      wave#set _filename _dir _basename;
+	      csv#set _filename _dir _basename;
+	      nst#set _filename _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.")
-	
+	  let n = Array.length rates in
+	  if n = 1 then (
+	    if _filename <> "" then (
+	      let fmt = format_of_file _filename in
+	      if fmt = "csv" then csv#write rates data (_filename, "")
+	      else if fmt = "wav" then wave#write rates data (_filename, "")
+	      else raise (IO_Error "Unknown stdout format."))
+	    else if _basename <> "" && _format <> "" then (
+	      if _format = "csv" then csv#write rates data ("", _basename)
+	      else if _format = "wav" then wave#write rates data ("", _basename)
+	      else raise (IO_Error "Unknown --oformat."))
+	    else if _filename = "" && _basename = "" && _format = "" then
+	      csv#write rates data ("", "")
+	    else raise (IO_Error "Please specify both --obasename and --oformat."))
+
+	  else if n > 1 then (
+	    if _filename <> "" then
+	      raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
+            else if _basename <> "" && _format <> "" then (
+	      if _format = "csv" then csv#write rates data ("", _basename)
+	      else if _format = "wav" then wave#write rates data ("", _basename)
+	      else raise (IO_Error "Unknown --oformat."))
+	    else raise (IO_Error "Please specify both --obasename and --oformat."))
+
+	  else 
+	    [|"no output signal."|]
+
+    method write_nst : rate array -> raw_data -> string array = 
+      fun (rates : rate array) ->
+	fun (rd : raw_data) ->
+	  let n = Array.length rates in	  
+          let info = 
+              if _filename <> "" && n = 1 then (_filename, "")
+              else if _basename <> "" && _format <> "" then ("", _basename)
+              else if _filename = "" && _basename = "" && _format = "" then
+                ("", "")             
+              else if _filename <> "" && n > 1 then 
+                raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
+              else raise (IO_Error "Please specify both --obasename and --oformat.") in
+          nst#write rates rd info
+
   end;;
+
+