Prolog's Makin' Music - Part 2

loader.lgt

:- initialization((
   logtalk_load(library(metapredicates_loader)),
   logtalk_load(library(types_loader)),
   logtalk_load(scales),
   logtalk_load(synthesizer),
   logtalk_load(wav),
   logtalk_load(xenakis)
   )).

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

    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,
        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) :-
        Bs >= 0,!,
        X1 is Bs >> 8,
        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(2, Endian, Bs), S) :-
        Bs < 0, % Not really needed due to the cut.
        Bs1 is Bs + 0xffff,
        write_word(word(2, Endian, Bs1), S).

    write_word(word(4, Endian, Bs), S) :-
        Bs >= 0, !,              
        X1 is Bs >> 24,
        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)
        ).
    write_word(word(4, Endian, Bs), S) :-
        Bs < 0, % Not really needed due to the cut.
        Bs1 is Bs + 0xffffffff,
        write_word(word(4, Endian, Bs1), S).

    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(4, big, 0x52494646)].
    wave_string --> [word(4, big, 0x57415645)].
    
    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(4, big, 0x666d7420)]. %"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(4, big, 0x64617461)]. %"data".

:- end_object.

xenakis.lgt

:- object(xenakis).

   :- public(init/0).

   init :-
       %% N is the number of samples.
       generate_notes(Ts, N),
       wav::prepare(output, N),
       write_samples(Ts).

   %% Generate the frequencies in the C major scale. Each note has a
   %% duration of 0.5 seconds.
   generate_notes(Ts, N) :-
       Scale = c_major,           
       findall(F-0.5,
               (Scale::nth(_, Note),
                Scale::frequency(Note, F)),
               Ts),
       Scale::length(L),
       synthesizer::sample_rate(SR),
       N is L*SR/2.

   %% Write the notes to 'output'.     
   write_samples([]).
   write_samples([F-D|Fs]) :-
        synthesizer::samples(F, D, sine, Samples),
        wav::write_audio(output, Samples),
        write_samples(Fs).

:- end_object.