Bug fixed for unix error "readlink /proc/self/fd/0" on MacOS.
[Faustine.git] / interpreter / 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 open Aux;;
15
16 class beam : signal_type array -> beam_type =
17 fun (signals_init : signal_type array) ->
18 object (self)
19 val signals = signals_init
20
21 method get = signals
22 method width = Array.length signals
23
24 method sub : int -> int -> beam_type =
25 fun start ->
26 fun len ->
27 new beam (Array.sub self#get start len)
28
29 method cut : int -> beam_type * beam_type =
30 fun (cut_width : int)->
31 ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width)))
32
33 method append : beam_type -> beam_type =
34 fun (b : beam_type) ->
35 new beam (Array.append self#get b#get)
36
37 method private add_memory : int -> unit =
38 fun (window : int) ->
39 let signal_add_memory : int -> signal_type -> unit =
40 fun (l : int) ->
41 fun (s : signal) ->
42 s#add_memory l in
43 let _ = Array.map (signal_add_memory window) self#get in ()
44
45 method matching : int -> beam_type =
46 fun size ->
47 if size = self#width then new beam self#get
48
49 else if (size > self#width) && (size mod self#width = 0) then
50 let () = self#add_memory 1 in
51 let split_signals =
52 Array.concat (Array.to_list
53 (Array.make (size/self#width) self#get)) in
54 new beam split_signals
55
56 else if (size < self#width) && (self#width mod size = 0) then
57 let rec merge_rec =
58 fun (sa : signal_type array) ->
59 fun (l : int) ->
60 fun (i : int) ->
61 if i + l < Array.length sa then
62 (sa.(i))#add (merge_rec sa l (i + l))
63 else sa.(i) in
64 let merge_signals = Array.init size (merge_rec self#get size) in
65 new beam merge_signals
66
67 else raise (Beam_matching "matching size error")
68
69 method at : time -> value_type array =
70 fun t ->
71 let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
72 Array.map (signal_at t) self#get
73
74 method output : int -> data =
75 fun (length_max : int) ->
76 let value2float = fun (v : value_type) -> v#to_float_array in
77 let init = [|0.|] in
78 let container = Array.make length_max
79 (Array.make self#width init) in
80 let index = ref 0 in
81
82 try
83 while !index < length_max do
84 container.(!index) <- Array.map value2float (self#at !index);
85 incr index;
86 done;
87 transpose self#width container
88
89 with x ->
90 match x with
91 | Invalid_argument s ->
92 transpose self#width (Array.sub container 0 !index)
93 | _ -> raise x
94
95
96 method output_values : int -> raw_data =
97 fun (length_max : int) ->
98 let init = new value (N 0) in
99 let container = Array.make length_max
100 (Array.make self#width init) in
101 let index = ref 0 in
102
103 try
104 while !index < length_max do
105 container.(!index) <- self#at !index;
106 incr index;
107 done;
108 container
109
110 with x ->
111 match x with
112 | Invalid_argument s ->
113 Array.sub container 0 !index
114 | _ -> raise x
115
116
117 method frequency : rate_type array =
118 let each_rate : signal -> rate =
119 fun (s : signal) ->
120 let rate = s#frequency in
121 if rate#num > 0 then rate
122 else if rate#num = 0 then new rate 44100 1
123 else raise (Beam_matching "frequency error.") in
124 Array.map each_rate self#get
125
126 end