516 lines
15 KiB
Plaintext
516 lines
15 KiB
Plaintext
(******************************************************************************)
|
|
(* SYNTHÈSE SONORE ÉLÉMENTAIRE EN HEPTAGON *)
|
|
(******************************************************************************)
|
|
|
|
(* Le but de ce fichier est de démontrer quelques techniques élémentaires de
|
|
génération de son en Heptagon, à travers de modestes expérimentations. Il n'a
|
|
bien sûr pas vocation à se substituer à un cours de traitement du signal ou
|
|
d'acoustique. En revanche, il peut facilement servir d'illustration de
|
|
diverses techniques de programmation en Heptagon. *)
|
|
|
|
(* Le flot d'échantillons sonores produits par ce programme synchrone est
|
|
branché à un petit bout de code C qui les envoie au système sonore de votre
|
|
système d'exploitation par le biais de la bibliothèque SDL2. Votre OS les
|
|
transmet à la carte son qui elle même les envoie à vos enceintes, casque ou
|
|
écouteurs. *)
|
|
|
|
(* Les langages synchrones ont été utilisés pour la synthèse sonore. Si ce sujet
|
|
vous intéresse, vous pouvez par exemple consulter la page du langage Faust, à
|
|
la syntaxe rudimentaire mais aux bibliothèques acoustiques, sonores et
|
|
musicales très développées : http://faust.grame.fr *)
|
|
|
|
(* On va utiliser une petite bibliothèque de composants mathématiques. Les
|
|
curieuses et curieux pourront aller voir mathext.epci. *)
|
|
|
|
open Mathext
|
|
|
|
(* Avant de commencer, on a besoin de quelques définitions et outils. *)
|
|
|
|
(* Le nombre d'échantillons, c'est à dire ici de pas synchrones, que le système
|
|
sonore va consommer une seconde. *)
|
|
|
|
const period : int = 44100
|
|
|
|
(* Un signal mono est un simple flot de nombres à virgule flottante. *)
|
|
|
|
type mono = float
|
|
|
|
(* Un signal stéréo fournit deux échantillons, gauche et droit, la carte son se
|
|
chargeant de les mixer pour donner l'impression d'un son 'surround'. *)
|
|
|
|
type stereo = { l : float; r : float }
|
|
|
|
(* Le signal constant silencieux. *)
|
|
|
|
const silence : stereo = { l = 0.0; r = 0.0 }
|
|
|
|
(* On peut dupliquer un signal mono pour obtenir un signal stéréo
|
|
inintéressant, les deux canaux portant la même valeur. *)
|
|
|
|
fun stereo_of_mono(a : mono) returns (o : stereo)
|
|
let
|
|
o = { l = a; r = a }
|
|
tel
|
|
|
|
(* On peut appliquer un gain à un signal stéréo, c'est à dire le multiplier par
|
|
un flottant pour l'amener à une amplitude différente. *)
|
|
|
|
fun stereo_gain(g : float; s : stereo) returns (o : stereo)
|
|
let
|
|
o = { l = g *. s.l; r = g *. s.r };
|
|
tel
|
|
|
|
(* Étant donné deux signaux, on peut les combiner via leur somme. *)
|
|
|
|
fun stereo_sum(s1, s2 : stereo) returns (o : stereo)
|
|
let
|
|
o = { l = s1.l +. s2.l; r = s1.r +. s2.r }
|
|
tel
|
|
|
|
(* Quand on utilise les deux fonctions qu'on vient de définir, gare à
|
|
l'amplitude en sortie ! Une amplitude trop élevée risque de dépasser la
|
|
capacité de votre carte son, enceintes ou écouteurs, ce qui cause un
|
|
phénomène de saturation : tous les échantillons d'amplitude trop élevée sont
|
|
écrasés sur l'amplitude maximale. *)
|
|
|
|
(* La fonction mix ci-dessous pallie le défaut de la fonction stereo_sum en
|
|
renormalisant le résultat. De plus, elle traite un tableau de signaux, et
|
|
donc moralement un nombre d'entrées arbitraires. *)
|
|
|
|
fun stereo_mix<<n : int>>(s : stereo^n) returns (o : stereo)
|
|
let
|
|
o = stereo_gain(1.0 /. float(n), fold<<n>> stereo_sum(s, silence));
|
|
tel
|
|
|
|
(* On peut commencer à écouter un peu de son, par exemple celui du silence. *)
|
|
|
|
node main0() returns (o : stereo)
|
|
let
|
|
o = silence;
|
|
tel
|
|
|
|
(* Quid du noeud suivant ? *)
|
|
|
|
node cracks() returns (o : stereo)
|
|
let
|
|
o = { l = 4200.0; r = 4200.0 };
|
|
tel
|
|
|
|
(* On entendu un craquement, puis plus rien, puis un craquement lorsqu'on
|
|
interromp le programme. Pourquoi ?
|
|
|
|
Physiquement, le son est une vibration produit par une onde acoustique, c'est
|
|
à dire une oscillation de la pression de l'air. Autrement dit, il s'agit
|
|
d'une *variation*. Donc, le signal constant ne peut pas donner lieu à un son,
|
|
sauf au premier instant (passage de 0 à 4200) puis lorsqu'on interromp le
|
|
programme (passage de 4200 à 0).
|
|
|
|
Et si on essayait un signal qui varie ? Par exemple, un signal carré qui
|
|
passe de 1 à 0 toutes les demi-secondes. *)
|
|
|
|
node periodic(p : int) returns (o : int)
|
|
var n : int;
|
|
let
|
|
o = 0 fby (if n = p then 0 else n);
|
|
n = o + 1;
|
|
tel
|
|
|
|
node beats_1() returns (o : stereo)
|
|
let
|
|
o = stereo_of_mono(if periodic(period) <= period / 2 then 1.0 else -. 1.0);
|
|
tel
|
|
|
|
(* On obtient une série de battements simples. Faire en sorte que le canal droit
|
|
soit l'opposé du canal gauche produit un effet intéressant. *)
|
|
|
|
node beats_2() returns (o : stereo)
|
|
var l : float;
|
|
let
|
|
l = if periodic(period) <= period / 2 then 1.0 else -. 1.0;
|
|
o = { l = l; r = -. l };
|
|
tel
|
|
|
|
(* Essayons maintenant de générer un signal qui croît indéfiniment. *)
|
|
|
|
node fcnt(ini : float; step : float) returns (o : float)
|
|
let
|
|
o = ini fby (o +. step);
|
|
tel
|
|
|
|
node sawtooth_1() returns (o : stereo)
|
|
let
|
|
o = stereo_of_mono(fcnt(0.0, 1.0));
|
|
tel
|
|
|
|
(* On entend quelques craquements, puis plus rien. Normal : ce signal n'oscille
|
|
pas vraiment, ou du moins pas avant d'atteindre l'overflow. Pourquoi ne pas
|
|
tester un signal périodique en dents de scie, dans ce cas ? *)
|
|
|
|
node sawtooth_2() returns (o : stereo)
|
|
var t : float;
|
|
let
|
|
t = float(periodic(128));
|
|
o = stereo_of_mono(t);
|
|
tel
|
|
|
|
(* Tiens, un son à peu près constant ! Pas très harmonieux cependant. *)
|
|
|
|
(* Est-ce qu'appliquer un gain ferait une différence ? Pour bien observer la
|
|
différence, on n'a qu'à faire passer le gain de 0 à 1 à chaque seconde.
|
|
C'est très facile à programmer en Heptagon. *)
|
|
|
|
node sawtooth_3() returns (o : stereo)
|
|
var t : float; g : float;
|
|
let
|
|
t = float(periodic(128));
|
|
g = float(periodic(period)) /. float(period);
|
|
o = stereo_gain(g, stereo_of_mono(t));
|
|
tel
|
|
|
|
(* On entend nettement le signal en dent de scie, avec un pic à la fin de la
|
|
seconde. De façon intéressante, si on augmente le gain, le son apparaît comme
|
|
plus pincé, un peu comme les notes d'une guitare. *)
|
|
|
|
node sawtooth_4() returns (o : stereo)
|
|
var t : float; g : float;
|
|
let
|
|
t = float(periodic(128));
|
|
g = 3.0 *. float(periodic(period)) /. float(period);
|
|
o = stereo_gain(g, stereo_of_mono(t));
|
|
tel
|
|
|
|
(* En augmentant la période, les pics s'éloignent, en la diminuant, les
|
|
pics se rapprochent. *)
|
|
|
|
node period_per_sec(a : int) returns (o : float)
|
|
let
|
|
o = float(periodic(period / a)) /. float(period / a);
|
|
tel
|
|
|
|
node sawtooth_5() returns (o : stereo)
|
|
var t : float; g : float;
|
|
let
|
|
t = float(periodic(128));
|
|
g = period_per_sec(2);
|
|
o = stereo_gain(g, stereo_of_mono(t));
|
|
tel
|
|
|
|
(* On peut aussi appliquer des gains différents sur le canal mono et stéréo. *)
|
|
|
|
node every_sec(s : int) returns (c : bool)
|
|
let
|
|
c = periodic(period * s) = ((- 1) fby 0);
|
|
tel
|
|
|
|
node sawtooth_6() returns (o : stereo)
|
|
var t : float; g1, g2 : float;
|
|
let
|
|
t = float(periodic(128));
|
|
o = { l = g1 *. t; r = g2 *. t };
|
|
automaton
|
|
state FastLeftSlowRight
|
|
do g1 = period_per_sec(1);
|
|
g2 = period_per_sec(8);
|
|
until every_sec(5) then SlowLeftFastRight
|
|
|
|
state SlowLeftFastRight
|
|
do g1 = period_per_sec(5);
|
|
g2 = period_per_sec(1);
|
|
until every_sec(5) then FastLeftSlowRight
|
|
end
|
|
tel
|
|
|
|
(* Tous ces sons ne sont pas très harmonieux. Peut-on en obtenir de plus purs ?
|
|
|
|
Le traitement du signal nous enseigne, via la théorie de la transformée de
|
|
Fourier, que tout signal raisonnablement régulier peut se décomposer en une
|
|
somme (infinie) de sinusoïde. Autrement dit, les signaux sinusoïdaux peuvent
|
|
servir de briques de base élémentaires mais universelles. Considérés comme
|
|
des signaux audio, ils forment des tons purs, élémentaires.
|
|
*)
|
|
|
|
node pure_tone(p : float) returns (o : float)
|
|
var t : float;
|
|
let
|
|
t = fcnt(0.0, 1.0);
|
|
o = sin(t *. (p /. float(period)) *. 2.0 *. Mathext.pi);
|
|
tel
|
|
|
|
(* Par exemple, la sinusoïde de fréquence 440.1 Hz, communément désignée sous le
|
|
nom de La 440, devrait vous être familière. *)
|
|
|
|
node main_pure_1() returns (o : stereo)
|
|
let
|
|
o = stereo_of_mono(pure_tone(440.0));
|
|
tel
|
|
|
|
(* En plus d'être la tonalité du téléphone, elle sert de référence pour
|
|
l'accordage des pianos, violons et d'autres instruments.
|
|
|
|
https://fr.wikipedia.org/wiki/La_440 *)
|
|
|
|
(* En mélangeant plusieurs sinusoïdes ensembles, on peut obtenir des effets
|
|
rétro assez amusants. *)
|
|
|
|
node some_pure_tone(p : float; i : int) returns (s : stereo)
|
|
let
|
|
s = stereo_gain(period_per_sec(i + 1), stereo_of_mono(pure_tone(p)));
|
|
tel
|
|
|
|
node oscillating_counter<<m : int>>(i : int) returns (last o : int = 0)
|
|
var step : int;
|
|
let
|
|
step = if every_sec(1) then 1 else 0;
|
|
automaton
|
|
state Init
|
|
do o = i
|
|
until true then Increase
|
|
|
|
state Increase
|
|
do o = last o + step
|
|
until o >= m then Decrease
|
|
|
|
state Decrease
|
|
do o = last o - step
|
|
until o <= 0 then Increase
|
|
end
|
|
tel
|
|
|
|
node main_pure_2() returns (o : stereo)
|
|
var periods : float^3; speeds : int^3;
|
|
let
|
|
periods = [440.0, 261.6256, 4186.009];
|
|
speeds = map<<3>>(oscillating_counter<<10>>)([1, 3, 7]);
|
|
o = stereo_mix<<3>>(map<<3>> some_pure_tone(periods, speeds));
|
|
tel
|
|
|
|
(* Enfin, les amatrices et amateurs de piano pourront trouver sur la page
|
|
|
|
https://en.wikipedia.org/wiki/Piano_key_frequencies
|
|
|
|
une formule associant une fréquence de sinusoïde à une note de piano. On peut
|
|
l'utiliser comme suit. *)
|
|
|
|
fun piano_freq_of_key(k : int) returns (f : float)
|
|
let
|
|
f = Mathext.pow(2.0, (Mathext.float(k) -. 49.0) /. 12.0) *. 440.0;
|
|
tel
|
|
|
|
node tone_of_piano_key(k : int) returns (o : stereo)
|
|
let
|
|
o = stereo_of_mono(pure_tone(piano_freq_of_key(k)));
|
|
tel
|
|
|
|
node maintain(c : bool; x : int on c; ini : int) returns (o : int)
|
|
let
|
|
o = merge c x ((ini fby o) whenot c);
|
|
tel
|
|
|
|
node main_pure_3() returns (o : stereo)
|
|
var k : int; c : bool;
|
|
let
|
|
o = tone_of_piano_key(k);
|
|
k = maintain(c, 40 + periodic(53 - 40), 40);
|
|
c = periodic(period) = 0;
|
|
tel
|
|
|
|
(* On peut essayer de programmer un piano midi. *)
|
|
|
|
(* Pour générer des transitions propres entre les notes, on a besoin de modifier
|
|
nos tons à travers une "enveloppe". La plus classique est l'enveloppe dite
|
|
"Attack-Decay-Sustain-Release", cf. Wikipédia.
|
|
|
|
https://en.wikipedia.org/wiki/Envelope_(music)#ADSR
|
|
|
|
Le noeud ci-dessous produit une telle enveloppe périodiquement, tous les t
|
|
instants. L'enveloppe prend la forme d'un gain entre 0 et 1.
|
|
|
|
Les paramètres a, d et s doivent-être tels que 0.0 < a + d + s < 1.0. Ils
|
|
expriment la fraction de t correspondant à chacune des quatre phases, la
|
|
phase d étant la fraction de t définie comme 1 - a - d - s.
|
|
|
|
Le paramètre s_level est le niveau de la phase S, entre 0 et 1 donc.
|
|
|
|
*)
|
|
|
|
node adsr_envelope(t : int; a, d, s : float; s_level : float)
|
|
returns (e : float)
|
|
var c, a_stop, d_stop, s_stop : int;
|
|
let
|
|
a_stop = int(float(t) *. a);
|
|
d_stop = a_stop + int(float(t) *. d);
|
|
s_stop = d_stop + int(float(t) *. s);
|
|
c = periodic(t);
|
|
automaton
|
|
state Attack
|
|
do e = float(c) /. float(a_stop);
|
|
unless c >= a_stop continue Decay
|
|
|
|
state Decay
|
|
var f : float;
|
|
do e = 1.0 -. (1.0 -. s_level) *. f;
|
|
f = float(c - a_stop) /. float(d_stop - a_stop);
|
|
unless c >= d_stop continue Sustain
|
|
|
|
state Sustain
|
|
do e = s_level;
|
|
unless c >= s_stop continue Release
|
|
|
|
state Release
|
|
do e = s_level *. (1.0 -. float(c - s_stop) /. float(t - s_stop));
|
|
until c + 1 >= t continue Attack
|
|
end
|
|
tel
|
|
|
|
node midi_piano<<n : int>>(keys : int^2^n; time : int^n) returns (o : stereo)
|
|
var i, j : int; next : bool; duree_mesure : int; e : float;
|
|
let
|
|
duree_mesure = 2 * period; (* 1 mesure = 8 noires = 4 sec à 120 BPM. *)
|
|
|
|
i = periodic(n);
|
|
j = maintain(next, i, 0);
|
|
o = stereo_gain(e, stereo_mix<<2>>(map<<2>> tone_of_piano_key(keys[>j<])));
|
|
e = adsr_envelope(duree_mesure / time[> j <], 0.3, 0.1, 0.4, 0.5);
|
|
|
|
automaton
|
|
state Next
|
|
do next = true
|
|
until true then Wait
|
|
|
|
state Wait
|
|
var c : int;
|
|
do next = false;
|
|
c = 0 fby (c + 1);
|
|
until c >= (duree_mesure / time[> j <]) then Next
|
|
end
|
|
tel
|
|
|
|
const num_keys : int = 82
|
|
|
|
node main_pure_4() returns (o : stereo)
|
|
var keys : int^2^num_keys; time : int^num_keys;
|
|
let
|
|
keys = [
|
|
[44, 00], [37, 00], [40, 00], [42, 00],
|
|
[44, 00], [37, 00], [40, 00], [42, 00],
|
|
[44, 00], [37, 00], [40, 00], [42, 00],
|
|
[44, 00], [37, 00], [40, 00], [42, 00],
|
|
[44, 00], [37, 00], [41, 00], [42, 00],
|
|
[44, 00], [37, 00], [41, 00], [42, 00],
|
|
[44, 00], [37, 00], [41, 00], [42, 00],
|
|
[44, 00], [37, 00], [41, 00], [42, 00],
|
|
|
|
[44, 00],
|
|
[37, 00],
|
|
[40, 37], [42, 00], [44, 00],
|
|
[37, 00], [40, 00], [42, 00],
|
|
|
|
[35, 39], [32, 00], [35, 00], [37, 00],
|
|
[39, 00], [32, 00], [35, 00], [37, 00],
|
|
[35, 39], [32, 00], [35, 00], [37, 00],
|
|
[39, 00], [32, 00], [35, 00],
|
|
|
|
[42, 00],
|
|
[35, 00],
|
|
[35, 40], [39, 00], [42, 00],
|
|
[35, 00], [40, 00], [39, 00],
|
|
[33, 37], [30, 00], [33, 00], [35, 00],
|
|
[33, 00], [30, 00], [33, 00], [35, 00],
|
|
[33, 37], [30, 00], [33, 00], [35, 00],
|
|
[37, 00], [30, 00], [33, 00],
|
|
|
|
[0, 0], [0, 0], [0, 0], [0, 0] (* silence *)
|
|
];
|
|
time = [
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
|
|
2,
|
|
2,
|
|
8, 8, 2,
|
|
2, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 4,
|
|
|
|
2,
|
|
2,
|
|
8, 8, 2,
|
|
2, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 8, 8,
|
|
4, 4, 4,
|
|
|
|
1, 1, 1, 1 (* silence *)
|
|
];
|
|
o = midi_piano<<num_keys>>(keys, time);
|
|
tel
|
|
|
|
(* Bonus : la méthode de Karplus-Strong pour la synthèse de son de guitare.
|
|
|
|
https://en.wikipedia.org/wiki/Karplus%E2%80%93Strong_string_synthesis
|
|
|
|
http://sites.music.columbia.edu/cmc/MusicAndComputers/chapter4/04_09.php
|
|
*)
|
|
|
|
node flip(i: int) returns (o: float)
|
|
let
|
|
o = if (i % 2 = 0) then 1.0 else -.1.0
|
|
tel
|
|
|
|
node karplus_strong<<l:int>>() returns (y : float)
|
|
var b : float^l; i: int;
|
|
let
|
|
i = 0 fby ((i+1) % l);
|
|
y = 0.5 *. (b[>i<] +. 0.0 fby y);
|
|
b = (mapi<<l>> flip ()) fby ([b with [i] = y]);
|
|
tel
|
|
|
|
node repeat<<n : int>>(x : stereo) returns (o : stereo)
|
|
var last t : stereo^n = silence^n;
|
|
let
|
|
automaton
|
|
state Fill
|
|
do o = x;
|
|
t = [ last t with [ periodic(n) ] = x ]
|
|
until periodic(n) = n - 1 then Repeat
|
|
|
|
state Repeat
|
|
do o = t[> periodic(n) <]
|
|
end
|
|
tel
|
|
|
|
node saturating_counter(max : int) returns (o : int)
|
|
var c : int;
|
|
let
|
|
c = 0 fby (c + 1);
|
|
o = if c < max then c else max;
|
|
tel
|
|
|
|
node main_kp() returns (o : stereo)
|
|
var s : stereo;
|
|
let
|
|
s = repeat<<period>>({ l = karplus_strong<<115>>();
|
|
r = karplus_strong<<55>>() });
|
|
o = stereo_gain(float(saturating_counter(5 * period)) /. float(5 * period),
|
|
s);
|
|
tel
|
|
|
|
(* Le noeud principal du programme. *)
|
|
|
|
(* Vous pouvez choisir un des noeuds principaux main_XXX écrits ci-dessus, ou
|
|
bien écrire le votre. *)
|
|
|
|
node main() returns (o : stereo)
|
|
let
|
|
o = main_pure_4();
|
|
tel
|