X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/e1705e136ab823be2e76e63728db1a5359d5d443..dbded051d69cc5ba556884eb285feba032e09d29:/interpretor/beam.ml?ds=inline diff --git a/interpretor/beam.ml b/interpretor/beam.ml index 33fb08e..bec7ed0 100644 --- a/interpretor/beam.ml +++ b/interpretor/beam.ml @@ -7,35 +7,102 @@ exception Beam_matching of string;; +open Types;; +open Basic;; +open Value;; open Signal;; class beam : signal_type array -> beam_type = - fun (sa_init : signal_type array) -> + fun (signals_init : signal_type array) -> object (self) - val sa = sa_init - val l = Array.length sa + val signals = signals_init - method get = sa - - method length = l + method get = signals + method width = Array.length signals method sub : int -> int -> beam_type = fun start -> fun len -> new beam (Array.sub self#get start len) + method cut : int -> beam_type * beam_type = + fun (cut_width : int)-> + ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width))) + method append : beam_type -> beam_type = - fun b -> - new beam (Array.append self#get b) + fun (b : beam_type) -> + new beam (Array.append self#get b#get) + + method private add_memory : int -> unit = + fun (window : int) -> + let signal_add_memory : int -> signal_type -> unit = + fun (l : int) -> + fun (s : signal) -> + s#add_memory l in + let _ = Array.map (signal_add_memory window) self#get in () - method matching : int -> beam_type + method matching : int -> beam_type = fun size -> - if size = self#length then self - else if size > self#length && size mod self#length = 0 then - - else if size < self#length && self#length mod size = 0 then - + if size = self#width then new beam self#get + + else if (size > self#width) && (size mod self#width = 0) then + let () = self#add_memory 1 in + let split_signals = + Array.concat (Array.to_list + (Array.make (size/self#width) self#get)) in + new beam split_signals + + else if (size < self#width) && (self#width mod size = 0) then + let rec merge_rec = + fun (sa : signal_type array) -> + fun (l : int) -> + fun (i : int) -> + if i + l < Array.length sa then + (sa.(i))#add (merge_rec sa l (i + l)) + else sa.(i) in + let merge_signals = Array.init size (merge_rec self#get size) in + new beam merge_signals + else raise (Beam_matching "matching size error") + method at : time -> value_type array = + fun t -> + let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in + Array.map (signal_at t) self#get + + method output : int -> data = + fun (length_max : int) -> + let transpose : 'a array array -> 'a array array = + fun matrix -> + let get_element = fun i -> fun array -> array.(i) in + let get_column = fun m -> fun i -> Array.map (get_element i) m in + Array.init self#width (get_column matrix) in + let value2float = fun (v : value_type) -> v#to_float_array in + let init = [|0.|] in + let container = Array.make length_max + (Array.make self#width init) in + let index = ref 0 in + + try + while !index < length_max do + container.(!index) <- Array.map value2float (self#at !index); + incr index; + done; + transpose container + + with x -> + match x with + | Invalid_argument s -> + transpose (Array.sub container 0 !index) + | _ -> raise x + + method frequency : rate_type array = + let each_rate : signal -> rate = + fun (s : signal) -> + let rate = s#frequency in + if rate#num > 0 then rate + else if rate#num = 0 then new rate 44100 1 + else raise (Beam_matching "frequency error.") in + Array.map each_rate self#get end