X-Git-Url: https://svn.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/a6be79ccb7456a5181561f094c1f2a4f90aadb02..60771194f4808507a435db7c201e3e75675986be:/interpretor/faustio.ml diff --git a/interpretor/faustio.ml b/interpretor/faustio.ml index dc1ee1d..7df74a6 100644 --- a/interpretor/faustio.ml +++ b/interpretor/faustio.ml @@ -12,17 +12,25 @@ open Signal;; open Beam;; open Aux;; -let default_output_path = "../output_sounds/";; let csv_read_buffer_length = 0xFFFF;; class virtual io = object + val mutable _basename = "" + val mutable _dir = "" + method set : string -> string -> unit = + fun (dir : string) -> + fun (basename : string) -> + _basename <- basename; _dir <- dir + method virtual read : string array -> beam - method virtual write : int array -> float array array array -> string array - method private concat : float array array array -> float array array = - fun (origin : float array array array) -> + method virtual write : rate array -> data -> string array + + method private concat : data -> matrix = + fun (origin : data) -> Array.map Array.concat (Array.map Array.to_list origin) - method private channels : float array array array -> int array = + + method private channels : data -> int array = fun data -> let get_channel = fun s -> let l = Array.length s in @@ -43,7 +51,12 @@ class waveio : io_type = let files = Array.map Sndfile.openfile paths in let frames = Array.map Int64.to_int (Array.map Sndfile.frames files) in - let rates = Array.map Sndfile.samplerate files in + let make_rate = + fun (denom : int) -> + fun (num : int) -> + new rate num denom in + let nums = Array.map Sndfile.samplerate files in + let rates = Array.map (make_rate 1) nums in let create_container = fun l -> Array.create l 1. in let containers = Array.map create_container frames in let _ = array_map2 Sndfile.read files containers in @@ -53,32 +66,26 @@ class waveio : io_type = array_map2 (new signal) rates (Array.map stream2func containers) in new beam signals - method write : int array -> float array array array -> string array = - fun (rates : int array) -> - fun (output : float array array array) -> - let () = print_string(" Faustine -> Writing wave files...") in - let tic = Sys.time () in - + method write : rate array -> data -> string array = + fun (rates : rate array) -> + fun (output : data) -> let n = Array.length output in let paths = Array.init n (fun i -> - default_output_path ^ "output" ^ (string_of_int (i + 1)) ^ ".wav") in + _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 rate -> - Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, rate) path in - array_map3 openwr paths channels rates 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 () = let data = self#concat output in let _ = array_map2 Sndfile.write files data in let _ = Array.map Sndfile.close files in - let toc = Sys.time () in - let duration = toc -. tic in - print_endline - (" Done. (duration: " ^ (string_of_float duration) ^ "s)") in paths end;; @@ -106,7 +113,7 @@ class csvio : io_type = let values = let convertor = new value Zero in Array.map (convertor#of_float_array) data in - new signal 0 (Array.get values) + new signal (new rate 0 1) (Array.get values) method read : string array -> beam = fun (paths : string array) -> @@ -114,16 +121,13 @@ class csvio : io_type = let signals = Array.map self#csvread files in new beam signals - method write : int array -> float array array array -> string array = - fun (rates : int array) -> - fun (data : float array array array) -> - let () = print_string(" Faustine -> Writing csv files...") in - let tic = Sys.time () in - + method write : rate array -> data -> string array = + fun (rates : rate array) -> + fun (data : data) -> let paths = let n = Array.length data in let path_pattern = fun i -> - default_output_path ^ "output" ^ (string_of_int (i + 1)) ^ ".csv" in + _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv" in Array.init n path_pattern in let files = Array.map open_out paths in @@ -139,8 +143,57 @@ class csvio : io_type = Array.map signal2string data in let _ = array_map2 output_string files strings in let _ = Array.map close_out files in - let toc = Sys.time () in - let () = print_endline - (" Done. (duration: " ^ (string_of_float (toc -. tic)) ^ "s)") in paths end;; + + +class iomanager = + object (self) + val wave = new waveio + val csv = new csvio + 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 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 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 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.") + + end;;