X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/8d0f7daae8a3ec7cda6d4a74c4c819d5ece97a8b..f3caf3d551b4ba1cd98d55678f0fd8085522669f:/interpreter/faustio.ml diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml index 9539bf3..8cca058 100644 --- a/interpreter/faustio.ml +++ b/interpreter/faustio.ml @@ -12,7 +12,7 @@ open Signal;; open Beam;; open Aux;; -exception Faustine_IO_Error of string;; +exception IO_Error of string;; let csv_read_buffer_length = 0xFFFF;; @@ -28,7 +28,7 @@ class virtual io = _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) -> @@ -70,34 +70,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 = - 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 - 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;; @@ -132,33 +135,39 @@ 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 n = Array.length data in - let paths = - 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 = - 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 + fun (info : string * string) -> + let stdoutput = fst info in + let basename = snd info in + let n = Array.length data 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 + + 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;; @@ -166,7 +175,7 @@ class iomanager = object (self) val wave = new waveio val csv = new csvio - val mutable _output_filename = "" + val mutable _filename = "" val mutable _dir = "" val mutable _format = "" val mutable _basename = "" @@ -190,29 +199,40 @@ class iomanager = fun (dir : string) -> fun (format : string) -> fun (basename : string) -> - _output_filename <- filename; + _filename <- filename; _dir <- dir; _format <- format; _basename <- basename; - wave#set _output_filename _dir _basename; - csv#set _output_filename _dir _basename + wave#set _filename _dir _basename; + csv#set _filename _dir _basename method write : rate array -> data -> string array = fun (rates : rate array) -> fun (data : data) -> - 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))) + 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."|] end;;