Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Prolog's Makin' Music - Part 3
:- protocol(l_system).
:- public(rule//1).
:- public(axiom/1).
:- end_protocol.
:- object(algae,
implements(l_system)).
axiom([a]).
rule(a) --> [a,b].
rule(b) --> [a].
:- end_object.
:- object(koch_curve,
implements(l_system)).
axiom([f]).
rule(-) --> [-].
rule(+) --> [+].
rule(f) --> [f,+,f,-,f,-,f,+,f].
:- end_object.
:- object(dragon_curve,
implements(l_system)).
axiom([f,x]).
rule(-) --> [-].
rule(+) --> [+].
rule(f) --> [f].
rule(x) --> [x,+,y,f].
rule(y) --> [f,x,-,y].
:- end_object.
:- object(fractal_plant,
implements(l_system)).
axiom([x]).
rule(-) --> [-].
rule(+) --> [+].
rule(s) --> [s].
rule(r) --> [r].
rule(x) --> [f,-,s,s,x,r,+,x,r,+,f,s,+,f,x,r,-,x].
rule(f) --> [f,f].
:- end_object.
:- object(beast,
implements(l_system)).
axiom([f]).
rule(-) --> [-].
rule(+) --> [+].
rule(f) --> [f,f,-].
:- end_object.
:- object(hilbert_curve,
implements(l_system)).
axiom([a]).
rule(-) --> [-].
rule(+) --> [+].
rule(f) --> [f].
rule(a) --> [-,b,f,+,a,f,a,+,f,b,-].
rule(b) --> [+,a, f,-,b,f,b,-,f,a,+].
:- end_object.
:- object(hilbert_curve2,
implements(l_system)).
axiom([x]).
rule(-) --> [-].
rule(+) --> [+].
rule(f) --> [f].
rule(x) --> [x,f,y,f,x,+,f,+,y,f,x,f,y,-,f,-,x,f,y,f,x].
rule(y) --> [y,f,x,f,y,-,f,-,x,f,y,f,x,+,f,+,y,f,x,f,y].
:- end_object.
:- object(test,
implements(l_system)).
axiom([x]).
rule(-) --> [-].
rule(+) --> [+].
rule(f) --> [f].
rule(s) --> [s].
rule(r) --> [r].
rule(x) --> [y,a,y].
rule(y) --> [f,f,-,f,s,+,+,f].
rule(a) --> [+,f,+,f,x,+,+,f,r].
:- end_object.
:- object(l_systems).
:- public(next/3).
:- public(generation/3).
:- public(transform/5).
generation(1, L, X) :-
L::axiom(X).
generation(N, L, X) :-
N > 1,
N1 is N - 1,
generation(N1, L, Y),
phrase(next(Y, L), X, []).
next(Xs, _, Xs).
next(Xs, L, Zs) :-
phrase(next(Xs, L), Ys, []),
next(Ys, L, Zs).
next([], _) --> [].
next([X|Xs], L) -->
L::rule(X),
next(Xs, L).
%% This could/should be kept inside each L-system instead.
skip(x). skip(y). skip(a). skip(b).
transform([], _, _, _, []).
transform([f|Cs], Scale, N, S, [N|Ns]) :-
transform(Cs, Scale, N, S, Ns).
transform([-|Cs], Scale, N, S, Ns) :-
Scale::lower(N, N1),
transform(Cs, Scale, N1, S, Ns).
transform([+|Cs], Scale, N, S, Ns) :-
Scale::raise(N, N1),
transform(Cs, Scale, N1, S, Ns).
transform([s|Cs], Scale, N, S, Ns) :-
transform(Cs, Scale, N, [N|S], Ns).
transform([r|Cs], Scale, _, [N|S], Ns) :-
transform(Cs, Scale, N, S, Ns).
transform([C|Cs], Scale, N, S, Ns) :-
skip(C),
transform(Cs, Scale, N, S, Ns).
:- end_object.
:- initialization((
logtalk_load(library(metapredicates_loader)),
logtalk_load(library(types_loader)),
logtalk_load(scales),
logtalk_load(synthesizer),
logtalk_load(wav),
logtalk_load(l_system),
logtalk_load(xenakis)
)).
:- protocol(scalep).
:- public(raise/2).
:- public(lower/2).
:- public(add/3).
:- public(nth/2).
:- public(length/1).
:- public(frequency/2).
:- end_protocol.
:- object(chromatic_scale,
implements(scalep)).
%A, A#, ..., G, G#.
length(12).
raise(N, N1) :-
N1 is (N + 1) mod 12.
lower(N, N1) :-
N1 is (N - 1) mod 12.
add(N1, N2, N3) :-
N3 is (N1 + N2) mod 12.
nth(I, I) :-
% Used so that we can call nth/2 with uninstantiated
% arguments.
between(0, 11, I).
%A4 to G#4.
frequency(N, F) :-
F is 440 * 2 ** (N/12).
:- end_object.
:- object(c_major,
implements(scalep)).
nth(0, 0).
nth(1, 2).
nth(2, 4).
nth(3, 5).
nth(4, 7).
nth(5, 9).
nth(6, 11).
raise(N, N1) :-
nth(I1, N),
I2 is ((I1 + 1) mod 7),
nth(I2, N1).
lower(N, N1) :-
nth(I1, N),
I2 is ((I1 - 1) mod 7),
nth(I2, N1).
% As far as I know, this is the only way to make sense of addition
% in C major. Simply adding the distance from the tonic doesn't work
% since that makes it possible to get notes outside the scale.
add(N1, N2, N3) :-
nth(I1, N1),
nth(I2, N2),
% I3 \in 0, ..., 7.
I3 is ((I1 + I2) mod 7),
nth(I3, N3).
% C, D, E, F, G, A, B.
length(7).
%C5 to B5.
frequency(N, F) :-
F is 440 * 2 ** ((N + 3)/12).
:- end_object.
:- object(c_minor,
implements(scalep)).
nth(0, 0).
nth(1, 2).
nth(2, 3).
nth(3, 5).
nth(4, 7).
nth(5, 8).
nth(6, 10).
raise(N, N1) :-
nth(I1, N),
I2 is ((I1 + 1) mod 7),
nth(I2, N1).
lower(N, N1) :-
nth(I1, N),
I2 is ((I1 - 1) mod 7),
nth(I2, N1).
add(N1, N2, N3) :-
nth(I1, N1),
nth(I2, N2),
% I3 \in 0, ..., 7.
I3 is ((I1 + I2) mod 7),
nth(I3, N3).
length(7).
frequency(N, F) :-
F is 440 * 2 ** ((N + 3)/12).
:- end_object.
:- object(synthesizer).
:- public(samples/4).
:- public(sample_rate/1).
:- public(bits_per_sample/1).
:- private(filter/3).
:- private(volume/3).
:- private(wave//3).
bits_per_sample(16).
sample_rate(22050).
samples(Frequency, Duration, Filter, Samples) :-
sample_rate(SR),
F is floor(Frequency),
X is (1/Frequency)*SR, N is X*F*Duration,
phrase(wave(N, Frequency, Filter), Samples).
%% We could have implemented this as higher order predicates
%% instead, but the performance loss would not have been worth it
%% since the filter might be applied to millions of samples.
filter(sine, Sample0, Sample) :-
Sample is sin(Sample0).
filter(sawtooth, Sample0, Sample) :-
Sample is Sample0 - floor(Sample0).
filter(triangle, Sample0, Sample) :-
Sample is -((acos(sin(Sample0)) / pi - 0.5)*2).
filter(square, Sample0, Sample) :-
Sample1 is sin(Sample0),
( Sample1 < 0 ->
Sample = -1
; Sample = 1
).
volume(M, N, V) :-
bits_per_sample(BPS),
V0 is (2**BPS)/2 - 1,
%% Decrease the volume over time.
Percent is (M/N)/2,
V is V0*(1 - Percent).
wave(N, Freq, F) --> wave(0, N, Freq, F).
wave(M, N, _, _) --> {M > N, !}, [].
wave(M, N, Freq, F) -->
{M =< N, % Not needed due to the cut.
sample_rate(SR),
M1 is M + 1,
volume(M, N, V),
X is (2*pi*Freq)*M/SR,
filter(F, X, Sample0),
Sample is floor(Sample0*V)},
[word(2, little, Sample)],
wave(M1, N, Freq, F).
:- end_object.
:- object(wav).
:- public(prepare/2).
:- public(write_audio/2).
num_channels(1).
bits_per_sample(16).
sample_rate(22050).
prepare(File, Size) :-
open(File, write, S, [type(binary)]),
phrase(wav_file(Size), Data),
write_data(Data, S),
close(S).
write_audio(File, Samples) :-
open(File, append, S, [type(binary)]),
write_data(Samples, S),
close(S).
write_data([], _).
write_data([B|Bs], S) :-
write_word(B, S),
write_data(Bs, S).
%% There's a reason why we use put_byte/2 directly and don't
%% e.g. define an auxiliary predicate that takes a list of bytes
%% as arguments and iteratively calls put_byte/2: this crude
%% method is much faster when we're dealing with millions of
%% samples.
write_word(word(2, Endian, Bs), S) :-
!,
X1 is (Bs >> 8) /\ 0x00ff,
X2 is Bs /\ 0x00ff,
( Endian = big ->
put_byte(S, X1),
put_byte(S, X2)
; put_byte(S, X2),
put_byte(S, X1)
).
write_word(word(4, Endian, Bs), S) :-
X1 is (Bs >> 24) /\ 0x000000ff,
X2 is (Bs /\ 0x00ff0000) >> 16,
X3 is (Bs /\ 0x0000ff00) >> 8,
X4 is (Bs /\ 0x000000ff),
( Endian = big ->
put_byte(S, X1),
put_byte(S, X2),
put_byte(S, X3),
put_byte(S, X4)
; put_byte(S, X4),
put_byte(S, X3),
put_byte(S, X2),
put_byte(S, X1)
).
wav_file(N) -->
{bits_per_sample(BPS),
num_channels(Cs),
Data_Chunk_Size is N*BPS*Cs/8},
riff_chunk(Data_Chunk_Size),
fmt_chunk,
data_chunk(Data_Chunk_Size).
riff_chunk(Data_Chunk_Size) -->
riff_string,
chunk_size(Data_Chunk_Size),
wave_string.
riff_string --> [word(2, big, 0x5249), word(2, big, 0x4646)].
wave_string --> [word(2, big, 0x5741), word(2, big, 0x5645)].
chunk_size(Data_Chunk_Size) -->
{Size is Data_Chunk_Size + 36}, % Magic constant!
[word(4, little, Size)].
fmt_chunk -->
fmt_string,
sub_chunk1_size,
audio_format,
number_of_channels,
sample_rate,
byte_rate,
block_align,
bits_per_sample.
fmt_string --> [word(2, big, 0x666d), word(2, big, 0x7420)]. %"fmt".
sub_chunk1_size --> [word(4, little, 16)]. %16, for PCM.
audio_format --> [word(2, little, 1)]. %PCM.
number_of_channels -->
[word(2, little, N)],
{num_channels(N)}.
sample_rate -->
[word(4, little, SR)],
{sample_rate(SR)}.
byte_rate -->
[word(4, little, BR)],
{sample_rate(SR),
num_channels(Cs),
bits_per_sample(BPS),
BR is (SR*Cs*BPS/8)}.
block_align -->
[word(2, little, BA)],
{num_channels(Cs),
bits_per_sample(BPS),
BA is (Cs*BPS/8)}.
bits_per_sample -->
[word(2, little, BPS)],
{bits_per_sample(BPS)}.
data_chunk(Data_Chunk_Size) -->
data_string,
[word(4, little, Data_Chunk_Size)].
data_string --> [word(2, big, 0x6461), word(2, big, 0x7461)]. %"data".
:- end_object.
:- object(xenakis).
:- public(init/3).
init(L_System, I, Scale) :-
%% N is the number of samples.
generate_notes(L_System, I, Scale, Ts, N),
wav::prepare(output, N),
write_samples(Ts).
generate_notes(L, I, Scale, Notes, Number_Of_Samples) :-
l_systems::generation(I, L, X),
Scale::nth(0, Tonic),
l_systems::transform(X, Scale, Tonic, [], Notes0),
findall(F-0.2,
(list::member(Note, Notes0),
Scale::frequency(Note, F)),
Notes),
length(Notes, Length),
synthesizer::sample_rate(SR),
Number_Of_Samples is Length*(SR/5).
%% Write the notes to 'output'.
write_samples([]).
write_samples([F-D|Fs]) :-
synthesizer::samples(F, D, square, Samples),
wav::write_audio(output, Samples),
write_samples(Fs).
:- end_object.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment