Prolog's Makin'n Music - Part 1

wav.lgt

:- object(wav).
        
    :- public(prepare/1).
    :- public(write_audio/2).

    num_samples(100000).
    num_channels(1).
    bits_per_sample(16).
    sample_rate(22050).

    prepare(File) :-
        open(File, write, S, [type(binary)]),
        phrase(wav_file, Data),
        write_data(Data, S),
        close(S).

    write_audio(Samples, File) :-
        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 -->
        {num_samples(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)],
        test_data.

    data_string --> [word(4, big, 0x64617461)]. %"data".
    test_data --> {num_samples(N)}, sine_wave(N).

    sine_wave(0) --> [].
    sine_wave(N) -->
        {N > 0,
        sample_rate(SR),
        N1 is N - 1,
        %% Standard concert pitch, 440 Hz.
        Freq is 440,
        ScaleFactor is 2*pi*Freq/SR,
        %% Needed since sin(X) returns an integer in [-1, 1], which
        %% is barely (if at all) perceivable by the human ear. The
        %% constant 32767 is used since we're dealing with 16 bit,
        %% signed integers, i.e. the range of the samples is [-32768,
        %% 32767].
        VolumeFactor is 32767,
        X is ScaleFactor*N,
        Sample0 is sin(X),
        %% Floor the sample. Otherwise we would end up with a floating
        %% point number, which is not allowed.
        Sample is floor(Sample0*VolumeFactor)},
        [word(2, little, Sample)],
        sine_wave(N1).

:- end_object.