1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
type transport = Stopped | Playing | Recording of int
type t = {
reel : Signal.t array;
levels : float array;
mutable head : float;
mutable speed : float;
mutable transport : transport;
mutable loop : (int * int) option;
mutable memory : Signal.t;
}
let create ?(seconds = 360.) ?(tracks = 4) () : t =
let n = Signal.samples seconds in
{
reel = Array.init tracks (fun _ -> Array.make n 0.);
levels = Array.make tracks 1.;
head = 0.;
speed = 1.;
transport = Stopped;
loop = None;
memory = [||];
}
let tracks (t : t) : int = Array.length t.reel
let length (t : t) : int = Array.length t.reel.(0)
let track (t : t) (k : int) : Signal.t = t.reel.(k)
let head (t : t) : float = t.head
let set_head (t : t) (h : float) : unit = t.head <- Float.max 0. (Float.min (float_of_int (length t - 1)) h)
let speed (t : t) : float = t.speed
let set_speed (t : t) (s : float) : unit = t.speed <- s
let play (t : t) : unit = t.transport <- Playing
let record (t : t) (k : int) : unit = if k >= 0 && k < tracks t then t.transport <- Recording k
let stop (t : t) : unit = t.transport <- Stopped
let moving (t : t) : bool = t.transport <> Stopped
let recording (t : t) : int option = match t.transport with Recording k -> Some k | _ -> None
let set_level (t : t) (k : int) (level : float) : unit = t.levels.(k) <- Float.max 0. (Float.min 1. level)
let set_loop (t : t) (l : (int * int) option) : unit = t.loop <- l
let write (track : Signal.t) (position : float) (x : float) : unit =
let i = Float.to_int (Float.floor position) in
let frac = position -. float_of_int i in
let n = Array.length track in
if i >= 0 && i < n then track.(i) <- track.(i) +. ((1. -. frac) *. x);
if i + 1 >= 0 && i + 1 < n && frac > 0. then track.(i + 1) <- track.(i + 1) +. (frac *. x)
let process (t : t) ~(input : Signal.t) (out : Signal.t) : unit =
let last = float_of_int (length t - 1) in
Array.iteri
(fun i _ ->
match t.transport with
| Stopped -> out.(i) <- 0.
| Playing | Recording _ ->
let x = ref 0. in
Array.iteri (fun k track -> x := !x +. (t.levels.(k) *. Resample.read Linear track t.head)) t.reel;
out.(i) <- !x;
(match t.transport with Recording k when i < Array.length input -> write t.reel.(k) t.head input.(i) | _ -> ());
t.head <- t.head +. t.speed;
(match t.loop with
| Some (a, b) when t.speed > 0. && t.head >= float_of_int b -> t.head <- t.head -. float_of_int (b - a)
| Some (a, b) when t.speed < 0. && t.head < float_of_int a -> t.head <- t.head +. float_of_int (b - a)
| _ -> ());
if t.head < 0. || t.head > last then begin
t.head <- Float.max 0. (Float.min last t.head);
t.transport <- Stopped
end)
out
let lift (t : t) (k : int) ~(from : int) ~(until : int) : unit =
let from = max 0 from and until = min (length t) until in
if until > from then begin
t.memory <- Array.sub t.reel.(k) from (until - from);
Array.fill t.reel.(k) from (until - from) 0.
end
let drop (t : t) (k : int) : unit =
let at = Float.to_int (Float.round t.head) in
Array.iteri (fun i x -> if at + i < length t then t.reel.(k).(at + i) <- t.reel.(k).(at + i) +. x) t.memory