X-Git-Url: https://scm.cri.mines-paristech.fr/git/Faustine.git/blobdiff_plain/66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83..02c1ef905d2101df872ccccccb2e4c7c0a508571:/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;; + +