Have a melody (in this case by Joseph Jacobsen, related text by Hans-Herrmann Bittger)
Clear[line]
line[t_?NumericQ, x_String] := {
{(* Takt 1 *)
SoundNote[None, 3 t/4, x],
SoundNote["CFlat4", t/8, x], SoundNote["CFlat4", t/8, x]},
{(* Takt 2 *)
SoundNote["E4", t/4, x], SoundNote["E4", t/8, x],
SoundNote["FSharp4", t/8, x], SoundNote["G4", t/4, x],
SoundNote["FSharp4", t/8, x], SoundNote["G4", t/8, x]},
{(* Takt 3 *)
SoundNote["E4", 3 t/4, x], SoundNote["E4", t/8, x],
SoundNote["E4", t/8, x]},
{(* Takt 4 *)
SoundNote["A4", t/4, x], SoundNote["A4", t/8, x],
SoundNote["CFlat5", t/8, x], SoundNote["C5", t/4, x],
SoundNote["CFlat5", t/8, x], SoundNote["A4", t/8, x]},
{(* Takt 5 *)
SoundNote["CFlat5", 3 t/4, x], SoundNote["CFlat5", t/8, x],
SoundNote["A4", t/8, x]},
{(* Takt 6 *)
SoundNote["G4", t/4, x], SoundNote["G4", t/8, x],
SoundNote["A4", t/8, x], SoundNote["CFlat5", t/4, x],
SoundNote["C5", t/8, x], SoundNote["CFlat5", t/8, x]},
{(* Takt 7 *)
SoundNote["A4", t/8, x], SoundNote["C5", t/8, x],
SoundNote["CFlat5", t/8, x], SoundNote["A4", t/8, x],
SoundNote["G4", t/4, x], SoundNote["G4", t/4, x]},
{(* Takt 8 *)
SoundNote["FSharp4", t/4, x], SoundNote["FSharp4", t/8, x],
SoundNote["G4", t/8, x], SoundNote["A4", t/4, x],
SoundNote["G4", t/8, x], SoundNote["FSharp4", t/8, x]},
{(* Takt 9 *)
SoundNote["G4", t/8, x], SoundNote["FSharp4", t/8, x],
SoundNote["E4", t/2, x], SoundNote[None, t/4, x]}
};
Sound[line[E, "Bandoneon"]]
make it into a canon a two voices
(* Zweistimmig *)
Clear[noteQ, acC, equalBar, intersequenceQ, stammer, \
intersequenceBar, doIntersequences, canonA2]
noteQ[x_] := Head[x] == SoundNote
acC[x1_SoundNote, x2_SoundNote] :=
SoundNote[{x1[[1]], x2[[1]]}, Sequence @@ Rest[x1]]
equalBar[v1_List, v2_List] := Inner[acC, v1, v2, List];
intersequenceQ[t1_List, t2_List] :=
Block[{o1 = 1, o2 = 1, a1 = Accumulate[t1], a2 = Accumulate[t2], r},
(* Wird das grössere Intervall einerseits durch mehrere kleinere \
Intervalle andererseits aufgefüllt? *)
r = Sign[a1[[1]] - a2[[1]]];
While[o1 <= Length[t1] && o2 <= Length[t2],
If[a1[[o1]] == a2[[o2]],
o1++;
o2++;
r = 0, (* else *)
If[a1[[o1]] < a2[[o2]],
If[r <= 0, r--, Return[False]];
o1++, (* else *)
If[r >= 0, r++, Return[False]];
o2++
]
]
];
r == 0
]
stammer[v1_List, v2_List] :=
Block[{long, short, o, rS = {}},
(* v1 oder v2 bestehen aus genau einer Note *)
(* Print["stammer v1: ",v1,"|v2: ",v2]; *)
If[Length[v1] <= Length[v2],
short = v1[[1]];
long = v2, (* else *)
short = v2[[1]];
long = v1
];
For[o = 1, o <= Length[long], o++,
rS = Join[
rS, {SoundNote[{short[[1]], long[[o, 1]]}, long[[o, 2]],
long[[o, 3]]]}]
];
rS
] /; Length[v1] == 1 || Length[v2] == 1
intersequenceBar[v1_List, v2_List] :=
Block[{a1 = Accumulate[v1[[All, 2]]], a2 = Accumulate[v2[[All, 2]]],
o1 = 1, o2 = 1, s1 = 1, s2 = 1, rS = {}},
(* intersequenceQ was True *)
While[o1 <= Length[a1] && o2 <= Length[a2],
If[a1[[o1]] == a2[[o2]],
rS = Join[rS, stammer[v1[[s1 ;; o1]], v2[[s2 ;; o2]]]];
o1++;
o2++;
s1 = o1;
s2 = o2;
r = 0, (* else *)
If[a1[[o1]] < a2[[o2]],
o1++, (* else *)
o2++
]
]
];
rS
]
doIntersequences[v1_List, v2_List] :=
Block[{w1 = v1, w2 = v2, o1, o2, a1, a2, frac},
(* v1 und v2 sind jeweils ein ganzer Takt *)
Label[oneMoreTime];
o1 = 1; o2 = 1;
a1 = Accumulate[w1[[All, 2]]];
a2 = Accumulate[w2[[All, 2]]];
r = Sign[a1[[1]] - a2[[1]]];
While[o1 <= Length[a1] && o2 <= Length[a2],
If[a1[[o1]] == a2[[o2]],
o1++;
o2++;
r = 0, (* else *)
If[a1[[o1]] < a2[[o2]],
If[r <= 0,
r--, (* else:
die aktuelle Note in w1 nach Massgabe von w2 zerlegen *)
frac = w2[[o2 - 1, 2]];
w1 = Join[w1[[1 ;; o1 - 1]], {ReplacePart[w1[[o1]], 2 -> frac],
ReplacePart[w1[[o1]], 2 -> w1[[o1, 2]] - frac]},
w1[[o1 + 1 ;;]]];
Goto[oneMoreTime]
];
o1++, (* else *)
If[r >= 0,
r++, (* else:
die aktuelle Note in w2 nach Massgabe von w1 zerlegen *)
frac = w1[[o1 - 1, 2]];
w2 = Join[w2[[1 ;; o2 - 1]], {ReplacePart[w2[[o2]], 2 -> frac],
ReplacePart[w2[[o2]], 2 -> w2[[o2, 2]] - frac]},
w2[[o2 + 1 ;;]]];
Goto[oneMoreTime]
];
o2++
]
]
];
{w1, w2}
]
canonA2[l_Symbol (* the notes *),
off_Integer?Positive (* the offset *),
x_String (* instrument *),
s_?NumericQ (* second length *),
takt_Integer: 1 (* takt *)] :=
Module[{v1 = Join[l[1, x], l[1, x]],
v2 = Take[
Join[ConstantArray[{SoundNote[None, takt, x]}, {off - 1}],
l[1, x], l[1, x]], 2 Length[l[1, x]]], rS = {}, t1, t2},
(* processing into accords *)
For[o = 1, o <= 2 Length[l[s, x]], o++,
t1 = v1[[o]][[All, 2]];
t2 = v2[[o]][[All, 2]];
If[Total[t1] != takt || Total[t2] != takt,
Print["Bar ", o, " length failure."];
Return[$Failed]
];
If[t1 == t2,
rS = Join[rS, equalBar[v1[[o]], v2[[o]]]],(* else *)
If[intersequenceQ[t1, t2],
rS = Join[rS, intersequenceBar[v1[[o]], v2[[o]]]], (* else *)
rS =
Join[rS, intersequenceBar[doIntersequences[v1[[o]], v2[[o]]]]]
]
]
];
Sound[rS /. SoundNote[a_, b__, c___] -> SoundNote[a, s b, c]]
] /; And @@ (VectorQ[#, noteQ] & /@ l[1, x]) &&
off <= Length[l[1, x]] &&
And @@ (AtomQ /@ (Flatten[l[1, x]][[All, 1]]))
canonA2[line, 5, "Bandoneon", E, 1]
One more parameter would be an offset in the pitch. It stammers because SoundNote[] has no substructure if playing a chord , i.e. each note within a chord has to have the same length: if one had
SoundNote[{{"A4"},{"C5","C5","C5"},{"E5","E5"}},{{1},{1/2,1/4,1/4},{1/2,1/2}},"Bandoneon"]
it wouldn't stammer. If one even had
SoundNote[{{"A4"},{"C5","C5","C5"},{"E5","E5"}},{{1},{1/2,1/4,1/4},{1/2,1/2}},{"Bandoneon", "Violin", "Trumpet"}]
the voices could have different instruments.
Experimenting with $y$ in canonA2[line, y, "Bandoneon", E, 1] one hears that $y=5$ is the right thing, as musicians say and play.
