X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/c0ac16bdf3099698bb61bb8183f047381a6c713e..66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83:/interpretor/faustio.ml diff --git a/interpretor/faustio.ml b/interpretor/faustio.ml deleted file mode 100644 index 3094ce9..0000000 --- a/interpretor/faustio.ml +++ /dev/null @@ -1,192 +0,0 @@ -(** - Module: Faustio - Description: audio input/output, csv input/output - @author WANG Haisheng - Created: 12/08/2013 Modified: 13/08/2013 -*) - -open Types;; -open Basic;; -open Value;; -open Signal;; -open Beam;; -open Aux;; - -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) -> - Array.map Array.concat (Array.map Array.to_list origin) - - method private channels : float array array array -> int array = - fun data -> - let get_channel = fun s -> - let l = Array.length s in - Array.length s.(l - 1) in - Array.map get_channel data - end;; - -class waveio : io_type = - object (self) - inherit io - method read : string array -> beam = - fun (paths : string array) -> - let n = Array.length paths in - if n = 0 then - new beam [||] - else - let signals = - 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 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 - let _ = Array.map Sndfile.close files in - let stream2func = - fun stream -> fun t -> new value (R stream.(t)) in - 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 n = Array.length output in - let paths = Array.init n (fun i -> - _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") 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 data = self#concat output in - let _ = array_map2 Sndfile.write files data in - let _ = Array.map Sndfile.close files in - paths - end;; - - - -class csvio : io_type = - object (self) - inherit io - method private csvread : in_channel -> signal = - fun (ic : in_channel) -> - let buffer = Buffer.create csv_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 elements = List.map (Str.split (Str.regexp ",")) lines in - let data = - let data_in_list = List.map (List.map float_of_string) elements in - Array.of_list (List.map Array.of_list data_in_list) in - let values = - let convertor = new value Zero in - Array.map (convertor#of_float_array) data in - new signal 0 (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#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 paths = - 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 - 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 : int array -> float array array array -> string array = - fun (rates : int array) -> - fun (data : float array array array) -> - 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;;