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

diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml
index 7df74a6..9539bf3 100644
--- a/interpreter/faustio.ml
+++ b/interpreter/faustio.ml
@@ -12,16 +12,20 @@ open Signal;;
 open Beam;;
 open Aux;;
 
+exception Faustine_IO_Error of string;;
+
 let csv_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
@@ -70,11 +74,18 @@ class waveio : io_type =
       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 paths = 
+	    if _filename = "" then 
+	      Array.init n (fun i -> 
+		_dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") 
+	    else if n = 1 then 
+	      let () = Unix.unlink _filename in [|_filename|]
+	    else raise (Faustine_IO_Error ("The process has several output signals, 
+			however stdout supports only one output signal. Please remove 
+			the '> " ^ _filename ^ "'.")) 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 
@@ -124,12 +135,16 @@ class csvio : io_type =
     method write : rate array -> data -> string array = 
       fun (rates : rate array) ->
 	fun (data : data) ->
+	  let n = Array.length data in
 	  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	  
-
+	    if _filename = "" then 
+	      Array.init n (fun i -> 
+		_dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv") 
+	    else if n = 1 then 
+	      let () = Unix.unlink _filename in [|_filename|]
+	    else raise (Faustine_IO_Error ("The process has several output signals, 
+			however stdout supports only one output signal. Please remove 
+			the '> " ^ _filename ^ "'.")) in
 	  let files = Array.map open_out paths in
 	  let strings = 
 	    let value2string : float array -> string =
@@ -151,19 +166,14 @@ class iomanager =
   object (self)
     val wave = new waveio
     val csv = new csvio
+    val mutable _output_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) ->
@@ -175,25 +185,34 @@ class iomanager =
 	  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) ->
+	      _output_filename <- filename;
+	      _dir <- dir; 
+	      _format <- format; 
+	      _basename <- basename;
+	      wave#set _output_filename _dir _basename;
+	      csv#set _output_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.")
-	
+	  if _output_filename = "" then (
+	    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."))
+	  else (
+	    let format = format_of_file _output_filename in
+	    if format = "wav" then
+	      wave#write rates data
+	    else if format = "csv" then
+	      csv#write rates data
+	    else raise (Invalid_argument ("unknown format" ^ format)))
   end;;