Prolog's Makin' Music - Part 3

l_system.lgt

:- 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.

loader.lgt

:- 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)
   )).

scales.lgt

:- 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.

synthesizer.lgt

:- 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.

wav.lgt

:- 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.

xenakis.lgt

:- 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.