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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
type shot = { samples : Signal.stereo; mutable at : int }
type continuous = {
mutable voice : Synth.voice;
mutable running : Synth.running;
mutable kept : bool;
mutable filter : Synth.filter option;
memory : Filter.memory;
mutable pan : float;
mutable last_pan : float;
}
type looped = { sound : Signal.stereo; mutable pos : int; mutable played : int; mutable stopping : bool }
type played_live = { live : Instrument.t; mutable ending : bool }
type t = {
mutable shots : shot list;
continuous : (string, continuous) Hashtbl.t;
loops : (string, looped) Hashtbl.t;
instruments : (string, played_live) Hashtbl.t;
}
let max_playing = 32
let stereo = ref true
let length (s : Signal.stereo) : int = Array.length s.left
let create () : t = { shots = []; continuous = Hashtbl.create 8; loops = Hashtbl.create 2; instruments = Hashtbl.create 2 }
let loop (m : t) (name : string) (sound : Signal.stereo) : unit =
match Hashtbl.find_opt m.loops name with
| Some l when not l.stopping -> ()
| _ -> if length sound > 0 then Hashtbl.replace m.loops name { sound; pos = 0; played = 0; stopping = false }
let change (m : t) (name : string) (sound : Signal.stereo) : unit =
match Hashtbl.find_opt m.loops name with
| Some l when (not l.stopping) && length sound > 0 ->
let pos = l.pos * length sound / length l.sound in
Hashtbl.replace m.loops name { l with sound; pos = min pos (length sound - 1) }
| _ -> loop m name sound
let stop (m : t) (name : string) : unit =
Option.iter (fun l -> l.stopping <- true) (Hashtbl.find_opt m.loops name);
Option.iter (fun i -> i.ending <- true) (Hashtbl.find_opt m.instruments name)
let looping (m : t) : string list = Hashtbl.fold (fun name _ acc -> name :: acc) m.loops [] |> List.sort compare
let instrument (m : t) (name : string) (live : Instrument.t) : unit =
match Hashtbl.find_opt m.instruments name with
| Some i when not i.ending -> ()
| _ -> Hashtbl.replace m.instruments name { live; ending = false }
let instruments (m : t) : string list =
Hashtbl.fold (fun name i acc -> if i.ending then acc else name :: acc) m.instruments [] |> List.sort compare
let play (m : t) (samples : Signal.stereo) : unit =
m.shots <- List.filteri (fun i _ -> i < max_playing) ({ samples; at = 0 } :: m.shots)
let keep ?filter ?(pan = 0.) (m : t) (name : string) (voice : Synth.voice) : unit =
match Hashtbl.find_opt m.continuous name with
| Some c ->
c.voice <- voice;
c.filter <- filter;
c.pan <- pan;
c.kept <- true
| None ->
Hashtbl.replace m.continuous name
{ voice; running = Synth.start (); kept = true; filter; memory = Filter.silence (); pan; last_pan = pan }
let pull (m : t) (n : int) : Signal.stereo =
let left = Array.make n 0. and right = Array.make n 0. in
m.shots
|> List.iter (fun s ->
let k = min n (length s.samples - s.at) in
for i = 0 to k - 1 do
left.(i) <- left.(i) +. s.samples.left.(s.at + i);
right.(i) <- right.(i) +. s.samples.right.(s.at + i)
done;
s.at <- s.at + k);
m.shots <- List.filter (fun s -> s.at < length s.samples) m.shots;
let gone = ref [] in
m.continuous
|> Hashtbl.iter (fun name c ->
let samples =
if c.kept then (
let (samples, running) = Synth.continue c.running c.voice n in
c.running <- running;
samples)
else (
gone := name :: !gone;
Synth.release c.running c.voice n)
in
let samples =
match c.filter with
| None -> samples
| Some f ->
let q = Filter.biquad f.kind ~cutoff:f.cutoff ~q:f.q in
Array.map (Filter.step q c.memory) samples
in
let (l0, r0) = Space.pan c.last_pan and (l1, r1) = Space.pan c.pan in
Array.iteri
(fun i x ->
let a = float_of_int (i + 1) /. float_of_int n in
left.(i) <- left.(i) +. (x *. (l0 +. ((l1 -. l0) *. a)));
right.(i) <- right.(i) +. (x *. (r0 +. ((r1 -. r0) *. a))))
samples;
c.last_pan <- c.pan;
c.kept <- false);
List.iter (Hashtbl.remove m.continuous) !gone;
let stopped = ref [] in
m.loops
|> Hashtbl.iter (fun name l ->
let len = length l.sound in
for i = 0 to n - 1 do
let fade = if l.stopping then 1. -. (float_of_int i /. float_of_int n) else 1. in
left.(i) <- left.(i) +. (fade *. l.sound.left.(l.pos));
right.(i) <- right.(i) +. (fade *. l.sound.right.(l.pos));
l.pos <- (l.pos + 1) mod len
done;
l.played <- l.played + n;
if l.stopping then stopped := name :: !stopped);
List.iter (Hashtbl.remove m.loops) !stopped;
let ended = ref [] in
m.instruments
|> Hashtbl.iter (fun name i ->
let block : Signal.stereo = { left = Array.make n 0.; right = Array.make n 0. } in
i.live.fill block;
for k = 0 to n - 1 do
let fade = if i.ending then 1. -. (float_of_int k /. float_of_int n) else 1. in
left.(k) <- left.(k) +. (fade *. block.left.(k));
right.(k) <- right.(k) +. (fade *. block.right.(k))
done;
if i.ending then ended := name :: !ended);
List.iter (Hashtbl.remove m.instruments) !ended;
let out : Signal.stereo = { left = Mix.limit ~soft:true left; right = Mix.limit ~soft:true right } in
if !stereo then out else Signal.both (Signal.mono out)
let playing (m : t) : int * int = (List.length m.shots, Hashtbl.length m.continuous)
let played (m : t) (name : string) : int option = Option.map (fun l -> l.played) (Hashtbl.find_opt m.loops name)