X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/e3449439410ee92986e5ef95fc933813dfa6c67b..refs/heads/master:/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;; + +