X-Git-Url: https://svn.cri.mines-paristech.fr/git/Faustine.git/blobdiff_plain/e3449439410ee92986e5ef95fc933813dfa6c67b..HEAD:/interpreter/faustio.ml?ds=inline
diff --git a/interpreter/faustio.ml b/interpreter/faustio.ml
index 9539bf3..408d750 100644
--- a/interpreter/faustio.ml
+++ b/interpreter/faustio.ml
@@ -11,10 +11,12 @@ open Value;;
open Signal;;
open Beam;;
open Aux;;
+open Nest;;
-exception Faustine_IO_Error of string;;
+exception IO_Error of string;;
let csv_read_buffer_length = 0xFFFF;;
+let nst_read_buffer_length = 0xFFFF;;
class virtual io =
object
@@ -28,7 +30,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 +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 =
- 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,41 +137,124 @@ 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;;
+
+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 mutable _output_filename = ""
+ val nst = new nstio
+ val mutable _filename = ""
val mutable _dir = ""
val mutable _format = ""
val mutable _basename = ""
@@ -179,6 +267,7 @@ class iomanager =
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 =
@@ -190,29 +279,58 @@ 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;
+ nst#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."|]
+
+ 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;;
+
+