Erosion and dilasion by square successfully tested.
[Faustine.git] / interpretor / beam.ml
1 (**
2 Module: Beam
3 Description: beam definition and operations
4 @author WANG Haisheng
5 Created: 21/07/2013 Modified: 21/07/2013
6 *)
7
8 exception Beam_matching of string;;
9
10 open Types;;
11 open Basic;;
12 open Value;;
13 open Signal;;
14
15 class beam : signal_type array -> beam_type =
16 fun (signals_init : signal_type array) ->
17 object (self)
18 val signals = signals_init
19
20 method get = signals
21 method width = Array.length signals
22
23 method sub : int -> int -> beam_type =
24 fun start ->
25 fun len ->
26 new beam (Array.sub self#get start len)
27
28 method cut : int -> beam_type * beam_type =
29 fun (cut_width : int)->
30 ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width)))
31
32 method append : beam_type -> beam_type =
33 fun (b : beam_type) ->
34 new beam (Array.append self#get b#get)
35
36 method private add_memory : int -> unit =
37 fun (window : int) ->
38 let signal_add_memory : int -> signal_type -> unit =
39 fun (l : int) ->
40 fun (s : signal) ->
41 s#add_memory l in
42 let _ = Array.map (signal_add_memory window) self#get in ()
43
44 method matching : int -> beam_type =
45 fun size ->
46 if size = self#width then new beam self#get
47
48 else if (size > self#width) && (size mod self#width = 0) then
49 let () = self#add_memory 1 in
50 let split_signals =
51 Array.concat (Array.to_list
52 (Array.make (size/self#width) self#get)) in
53 new beam split_signals
54
55 else if (size < self#width) && (self#width mod size = 0) then
56 let rec merge_rec =
57 fun (sa : signal_type array) ->
58 fun (l : int) ->
59 fun (i : int) ->
60 if i + l < Array.length sa then
61 (sa.(i))#add (merge_rec sa l (i + l))
62 else sa.(i) in
63 let merge_signals = Array.init size (merge_rec self#get size) in
64 new beam merge_signals
65
66 else raise (Beam_matching "matching size error")
67
68 method at : time -> value_type array =
69 fun t ->
70 let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
71 Array.map (signal_at t) self#get
72
73 method output : int -> float array array array =
74 fun (length_max : int) ->
75 let transpose : 'a array array -> 'a array array =
76 fun matrix ->
77 let get_element = fun i -> fun array -> array.(i) in
78 let get_column = fun m -> fun i -> Array.map (get_element i) m in
79 Array.init self#width (get_column matrix) in
80 let value2float = fun (v : value_type) -> v#to_float_array in
81 let init = [|0.|] in
82 let container = Array.make length_max
83 (Array.make self#width init) in
84 let index = ref 0 in
85
86 try
87 while !index < length_max do
88 container.(!index) <- Array.map value2float (self#at !index);
89 incr index;
90 done;
91 transpose container
92
93 with x ->
94 match x with
95 | Invalid_argument s ->
96 transpose (Array.sub container 0 !index)
97 | _ -> raise x
98
99 method frequency : int array =
100 let each_rate : signal -> int =
101 fun (s : signal) ->
102 let rate = s#frequency in
103 if rate > 0 then rate
104 else if rate = 0 then 44100
105 else raise (Beam_matching "frequency error.") in
106 Array.map each_rate self#get
107
108 end