% (c) 2000 John Fulton
% AMI Agent for Music Inscription

% This program is free software; you can redistribute it and/or
% modify it under the terms of the GNU General Public License
% as published by the Free Software Foundation; either version 2
% of the License, or (at your option) any later version.

% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.  www.gnu.org


:- use_module(library(random)).

% the following is a basis that allows me to get any 
% chord or interval in a generic way, by the laws of 
% music theory.  

% the following facts and predicates are used to define, 
% all the main intervals between any two notes.  

note(c,1). note(c-sharp,2). note(d,3). note(d-sharp,4). 
note(e,5). note(f,6). note(f-sharp,7). note(g,8). 
note(g-sharp,9). note(a,10). note(a-sharp,11). note(b,12). 
note(c,13). note(c-sharp,14). note(d,15). note(d-sharp,16). 
note(e,17). note(f,18). note(f-sharp,19). note(g,20). 
note(g-sharp,21). note(a,22). note(a-sharp,23). note(b,24).

half_step(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 1, Num < 13.

whole_step(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 2, Num < 13.

minor_third(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 3, Num < 13.

major_third(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 4, Num < 13.

perfect_fourth(N1, N2):- perfect_fith(N2, N1).

tri_tone(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 6, Num < 13.

perfect_fith(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 7, Num < 13.

minor_sixth(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 8, Num < 13.

major_sixth(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 9, Num < 13.

minor_seventh(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 10, Num < 13.

major_seventh(N1, N2):- note(N1, Num), note(N2, Num2), 
    Num2 is Num + 11, Num < 13.

octave(N, N).  

% gives the harmonic distance of the second note 
% to the root.  

distance(N,N,0).
distance(Root, Note, X):-
	note(Root, D1), note(Note, D2), X is D2 - D1, 
	D1 < 13, X > 0, X < 13, Root \== Note.  

% Key2 is relative minor of Key, inverse can be used 
% to get relative major

relative_minor(chord(Key, major), chord(Key2, minor)):-
    note(Key, Num), note(Key2, Num2), Num2 is Num + 9, 
    Num < 13.

% these predicates can be used to find a hamonic interval 
% in a chord progression.  assumes you are working with a 
% diatonic scale as opposed to harmonic or melodic minor

root(chord(Key, major), chord(Key, major)).  

second(chord(Key, major), chord(Key2, minor)):-
        note(Key, Num), note(Key2, Num2), Num2 is Num + 2, 
        Num < 13.

third(chord(Key, major), chord(Key2, minor)):-
        note(Key, Num), note(Key2, Num2), Num2 is Num + 4, 
        Num < 13.

fourth(chord(Key, major), chord(Key2, major)):-
        note(Key, Num), note(Key2, Num2), Num2 is Num + 5, 
        Num < 13.

fith(chord(Key, major), chord(Key2, major)):-
        note(Key, Num), note(Key2, Num2), Num2 is Num + 7, 
        Num < 13.

sixth(chord(Key, major), chord(Key2, minor)):- 
	relative_minor(chord(Key, major), 
	chord(Key2, minor)).  

seventh(chord(Key, major), chord(Key2, diminished)):-
	note(Key, Num), note(Key2, Num2), Num2 is Num + 11, 
        Num < 13.


% helper functions

not(X):- X, !, fail.
not(_).

append([], L, L).
append([A|X], Y, [A|Z]):- append(X,Y,Z).

listlen([],0).
listlen([_|T],N):- listlen(T,N1), N is N1 + 1. 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% CHORD PROGRESSIONS


% p will be the actual progression relation.  it is true if Prog is
% the progression of length L that starts with the first argument, and
% A is the number of the list that within L

p(_,L,_):- L < 5, nl, write('progression must be more than 4 bars!'), nl.  


p(chord(Note, minor), L, Prog):-
	paux(chord(Note, minor), L, 1, [chord(Note,minor)], Prog).

paux(chord(Note, minor), L, A, Pre, Post):-  
	cruel_world(chord(Note,minor), Chord), 
	append(Pre, [Chord], Pre2), 
	A2 is A+1, not(end(L,A,3)), 
	paux(chord(Note, minor), L, A2, Pre2, Post).   
	

paux(chord(Note, minor), L, A, Pre, Post):-  
     end(L,A,3), random(1,7,R), cadence(chord(Note,minor), R, Pre, Post),!.


% place where AMI must serach......
% it is cruel because the unresolving chords are the most probable
% but in the end the cadence always makes things resolve nicely 

cruel_world(chord(N,minor), chord(X,Y)):-
    relative_minor(chord(K,major), chord(N,minor)),
    random(1,7,Rnd), cwaux(chord(K,major),Rnd,chord(X,Y)).  

cwaux(chord(R,major), 1, chord(X,Y)):-  
     tonic(chord(R,major), chord(X,Y)),!.

cwaux(chord(R,major), 2, chord(X,Y)):-
      dominant(chord(R,major), chord(X,Y)),!.

cwaux(chord(R,major), 3, chord(X,Y)):-
      dominant(chord(R,major), chord(X,Y)),!.

cwaux(chord(R,major), V, chord(X,Y)):-
     V > 3, pre_dominant(chord(R,major), chord(X,Y)),!.


%%%%% Types of Chords

%% Tonic  (occurs 1/6 of the time)

tonic(chord(R,major), chord(X,Y)):-
    random(1,3,Rnd), tonic_aux(Rnd, chord(R,major), chord(X,Y)).  

tonic_aux(1, chord(R,major), chord(R,major)).  
tonic_aux(2, chord(R,major), chord(X,minor)):- 
	relative_minor(chord(R,major), chord(X,minor)).   

%% Dominant  (occurs 2/6 of the time)

dominant(chord(R,major), chord(X,minor)):-
	third(chord(R,major), chord(X,minor)).

%% Pre-Dominant (occurs the rest of the time)

pre_dominant(chord(R,major), chord(X,Y)):-
    random(1,4,Rnd), pd_aux(Rnd, chord(R,major), chord(X,Y)).

pd_aux(1, chord(R,major), chord(X,diminished)):-
	seventh(chord(R,major), chord(X,diminished)).

pd_aux(2, chord(R,major), chord(X,minor)):-
        second(chord(R,major), chord(X,minor)).

pd_aux(3, chord(R,major), chord(X,major)):-
        fourth(chord(R,major), chord(X,major)).


%%%%% Cadence 

% quick helper relation, symbolizing end of progression
end(X,Y,Z):- Z is X-Y.

% cadence is true if the first chord it is given is at the 
% end of list Prog, it also appends one of 6 consonant
% cadences to L, this new list is Prog, it is queried with 
% a random value to pick which cadence it will append

cadence(chord(Note, minor), 1, L, Prog):- 
    relative_minor(chord(K, major), chord(Note, minor)),
    third(chord(K, major), chord(One, minor)),
    second(chord(K, major), chord(Two, minor)),	
    append(L, 
    [chord(One,minor),chord(Two,minor),chord(Note,minor)], Prog).  

cadence(chord(Note, minor), 2, L, Prog):-
    relative_minor(chord(K, major), chord(Note, minor)),
    fith(chord(K, major), chord(One, major)),  
    second(chord(K, major), chord(Two, minor)),
    append(L, 
    [chord(One,major),chord(Two,minor),chord(Note,minor)], Prog).

cadence(chord(Note, minor), 3, L, Prog):-
    relative_minor(chord(K, major), chord(Note, minor)),
    fourth(chord(K, major), chord(One, major)),
    fith(chord(K, major), chord(Two, major)),
    append(L,
    [chord(One,major),chord(Two,major),chord(Note,minor)], Prog).

cadence(chord(Note, minor), 4, L, Prog):-
    relative_minor(chord(K, major), chord(Note, minor)),
    second(chord(K, major), chord(One, minor)),
    fith(chord(K, major), chord(Two, major)),
    append(L,
    [chord(One,minor),chord(Two,major),chord(Note,minor)], Prog).

cadence(chord(Note, minor), 5, L, Prog):-
    relative_minor(chord(K, major), chord(Note, minor)),
    fourth(chord(K, major), chord(One, major)),
    third(chord(K, major), chord(Two, minor)),
    append(L,
    [chord(One,major),chord(Two,minor),chord(Note,minor)], Prog).

cadence(chord(Note, minor), 6, L, Prog):-
    relative_minor(chord(K, major), chord(Note, minor)),
    second(chord(K, major), chord(One, minor)),
    third(chord(K, major), chord(Two, minor)),
    append(L,
    [chord(One,minor),chord(Two,minor),chord(Note,minor)], Prog).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% MOTIFS

% m is the real motif generator, that is true if L
% is a list of notes that is a motif.  this predicate
% is only true if L follows certain rules of what a 
% "good" motif is (includes random numbers)

m(chord(X,minor), List):- 
    rm(L), rn(chord(X,minor), L, List), 
    nl, write(List), nl.  


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% HARMONIC ASPECTS OF MOTIF


% rn is true if the second list is a list of staffs with the 
% rhythms of the first note (rn -> rhythms to notes)

rn(_, [], []).

rn(chord(X,minor), [R|T], [staff(N,R)|T2]):- 
    notes(D), rhyNotes(D, chord(X,minor), [R|T], [staff(N,R)|T2]).  

rhyNotes(1, chord(X,minor), [R|T], [staff(N,R)|T2]):- 
    rn(chord(X,minor), T, T2), whole_step(X,N), !.

rhyNotes(2, chord(X,minor), [R|T], [staff(N,R)|T2]):-
    rn(chord(X,minor), T, T2), minor_third(X,N), !.

rhyNotes(3, chord(X,minor), [R|T], [staff(N,R)|T2]):-
    rn(chord(X,minor), T, T2), perfect_fourth(X,N), !.

rhyNotes(4, chord(X,minor), [R|T], [staff(N,R)|T2]):-
    rn(chord(X,minor), T, T2), perfect_fith(X,N), !.

rhyNotes(5, chord(X,minor), [R|T], [staff(N,R)|T2]):-
    rn(chord(X,minor), T, T2), minor_sixth(X,N), !.

rhyNotes(6, chord(X,minor), [R|T], [staff(N,R)|T2]):-
    rn(chord(X,minor), T, T2), minor_seventh(X,N), !.

rhyNotes(7, chord(X,minor), [R|T], [staff(N,R)|T2]):-
    rn(chord(X,minor), T, T2), octave(X,N), !.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% RHYTHMS


% rm is the rhythmic motif generator
% it is true if L is a list of rhythms

rm(L):- ntimes(No), rmaux([],L,No).

rmaux([],L,No):- 
    rhythms(R1), ntimes(N1), apply(R1,N1,L1), 
    rhythms(R2), ntimes(N2), apply(R2,N2,L2), R1 \== R2, 
    append(L1,L2,L3), rmaux(L3,L,No), !.  

rmaux([],L,No):-
    ntimes(N1), apply(8,N1,L1),
    ntimes(N2), apply(4,N2,L2),
    append(L1,L2,L3), rmaux(L3,L,No), !.

rmaux(L1,L,1):-
    apply(16,4,L2), append(L1,L2,L),!.

rmaux(L1,L,2):-
    rhythms(R), ntimes(N), apply(R,N,L2),
    append(L1,L2,L),!.
    
rmaux(L1,L5,3):-
    rhythms(R), ntimes(N), apply(R,N,L2),
    rhythms(R1), ntimes(N1), apply(R1,N1,L3), 
    append(L1,L2,L4), append(L3,L4,L5),!.  

rmaux(L1,L7,4):-
    rhythms(R), ntimes(N), apply(R,N,L2),
    rhythms(R1), ntimes(N1), apply(R1,N1,L3),
    rhythms(R2), ntimes(N2), apply(R2,N2,L4),
    append(L1,L2,L5), append(L3,L4,L6),
    append(L5,L6,L7),!.


% rl is true if its motif's rhythms add up to N
% N will be the ratio of the time sig

rl([],0).
rl([X|T], N):- rl(T, N1), N is N1 + 1/X. 


% apply is true, if X is repeated up to 4 times
% this is to be used with ntimes

apply(_,0,[]).
apply(X,1,[X]).
apply(X,2,[X,X]).
apply(X,3,[X,X,X]).   
apply(X,4,[X,X,X,X]).


% random number generator based aux functions

notes(N):- random(1, 7, N).
% is true if N is the next accpetable note in a scale
% to be used with harmonic distance     


rhythms(N):- random(1,4, X), X > 2, rh_aux1(N), !.
rhythms(N):- random(1,4, X), X < 3, rh_aux2(N), !.
rhythms(4).  
rh_aux1(N):- random(3,6, N).  % no whole or half notes  
rh_aux2(N):- random(1,3, X), N is X * 8.  


% is true if N is one of the accpetable rhythmic values
% it has a bias of 2/3 probability towards the faster 
% 8th or 16th notes, for what I think would be a more
% exciting piece, as well as a defualt to the common
% quarter note.  

ntimes(N):- random(1,5,N).
% is true if N is the amount of times that AMI will
% repeat something of the same value for consistency
% this other value will be generated randomly also

    
time_sig(N, 8):- random(3, 8, N), random(0,2,X),
    X is 0, !.  
time_sig(N, 4):- random(3, 8, N), random(0,2,X),
    X is 1, !.  
time_sig(4,4).

% is true if N represents a reasonable but
% random key signature, with 8th notes or quarter
% notes.  defaults to common time (4/4).  


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% TRANSPOSITIONS
    

% this predicate takes a motif that implies a chord and 
% changes it to make it imply a different chord, while
% maintaing melodic contour.  it turned out to be a long
% formalization to cover all cases correctly....

% Base case
next([], chord(_, minor), chord(_, _), []).


% Root
next([staff(N,R)|T], chord(Key, minor), chord(I, major), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    root(chord(K, major), chord(I, major)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(whole_step(Key,N)),
    not(perfect_fourth(Key,N)),
    not(perfect_fith(Key,N)),
    not(octave(Key,N)), 
    distance(N2,N3,1),
    next(T, chord(Key,minor), chord(I,major), T2),!.

next([staff(N,R)|T], chord(Key, minor), chord(I, major), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    root(chord(K, major), chord(I, major)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(minor_third(Key,N)), not(minor_sixth(Key,N)), 
    not(minor_seventh(Key,N)), 
    distance(N2,N3,0),
    next(T, chord(Key,minor), chord(I,major), T2),!.

% Fourth
next([staff(N,R)|T], chord(Key, minor), chord(I, major), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    fourth(chord(K, major), chord(I, major)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(whole_step(Key,N)),
    not(perfect_fith(Key,N)),
    not(octave(Key,N)), 
    distance(N2,N3,1),
    next(T, chord(Key,minor), chord(I,major), T2),!.

next([staff(N,R)|T], chord(Key, minor), chord(I, major), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    fourth(chord(K, major), chord(I, major)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(minor_third(Key,N)), 
    not(perfect_fourth(Key,N)),
    not(minor_sixth(Key,N)), 
    not(minor_seventh(Key,N)), 
    distance(N2,N3,0),
    next(T, chord(Key,minor), chord(I,major), T2),!.

% Fith
next([staff(N,R)|T], chord(Key, minor), chord(I, major), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    fith(chord(K, major), chord(I, major)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(whole_step(Key,N)),
    not(perfect_fourth(Key,N)),
    not(perfect_fith(Key,N)),
    not(minor_seventh(Key,N)),
    not(octave(Key,N)), 
    distance(N2,N3,1),
    next(T, chord(Key,minor), chord(I,major), T2),!.

next([staff(N,R)|T], chord(Key, minor), chord(I, major), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    fith(chord(K, major), chord(I, major)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(minor_third(Key,N)), 
    not(minor_sixth(Key,N)), 
    distance(N2,N3,0),
    next(T, chord(Key,minor), chord(I,major), T2),!.

% Seventh
next([staff(N,R)|T], chord(Key, minor), chord(I, diminished), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    seventh(chord(K, major), chord(I, diminished)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(minor_third(Key,N)), 
    not(perfect_fourth(Key,N)),
    not(minor_sixth(Key,N)), 
    not(minor_seventh(Key,N)),
    not(octave(Key,N)),
    distance(N3,N2,1),  % note swap(N2,N3)
    next(T, chord(Key,minor), chord(I,diminished), T2),!.

next([staff(N,R)|T], chord(Key, minor), chord(I, diminished), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    seventh(chord(K, major), chord(I, diminished)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(whole_step(Key,N)),
    not(perfect_fith(Key,N)),
    distance(N2,N3,0),
    next(T, chord(Key,minor), chord(I,diminished), T2),!.

% Second
next([staff(N,R)|T], chord(Key, minor), chord(I, minor), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    second(chord(K, major), chord(I, minor)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(whole_step(Key,N)),
    not(minor_third(Key,N)), 
    not(perfect_fourth(Key,N)),
    not(perfect_fith(Key,N)),
    not(minor_seventh(Key,N)),
    not(octave(Key,N)),
    distance(N2,N3,1),
    next(T, chord(Key,minor), chord(I,minor), T2),!.

next([staff(N,R)|T], chord(Key, minor), chord(I, minor), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    second(chord(K, major), chord(I, minor)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(minor_sixth(Key,N)),
    distance(N2,N3,0),
    next(T, chord(Key,minor), chord(I,minor), T2),!.


% Third
next([staff(N,R)|T], chord(Key, minor), chord(I, minor), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    third(chord(K, major), chord(I, minor)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(minor_third(Key,N)), 
    not(perfect_fourth(Key,N)),
    not(perfect_fith(Key,N)),
    not(minor_sixth(Key,N)),
    not(minor_seventh(Key,N)),
    not(octave(Key,N)),
    distance(N3,N2,1), % note swap(N2,N3)
    next(T, chord(Key,minor), chord(I,minor), T2),!.

next([staff(N,R)|T], chord(Key, minor), chord(I, minor), 
    [staff(N3,R)|T2]):-

    relative_minor(chord(K, major), chord(Key, minor)), 
    third(chord(K, major), chord(I, minor)),     
    distance(Key,N,Interval), distance(I,N2,Interval),
    not(whole_step(Key,N)),
    distance(N2,N3,0),
    next(T, chord(Key,minor), chord(I,minor), T2),!.

% Sixth
next(X, chord(Key,minor), chord(Key,minor), X).  


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Helpers

head_tail([H|T], H, T).

% takes a list, gives first & second, gives back list
% with second removed.  

first_second(L, F, S, L4):- 
    head_tail(L, F, L2), head_tail(L2, S, L3), 
    append([F], L3, L4).  
    
% this predicate takes a motif and progression list, and 
% prints a piece of music

give(_, Pr):- listlen(Pr,1), nl, write('done'), nl,!.

give(M, Pr):-
    listlen(Pr, L), L > 1, 
    first_second(Pr, Root, Second, New),
    next(M, Root, Second, M2), 
    nl, write(M2), nl, 
    give(M,New).


%%%%%%%%%%%%%%%%%%%%%%%%%

% RUN 

go(Key,Length):- 
      p(chord(Key,minor),Length,Prog), 
      m(chord(Key,minor),Motif), 
      give(Motif, Prog), 
      nl, write('Progression is: '), 
      nl, write(Prog), nl.