/* JOHN HARRISON PIECE WRITER --- FINAL PROJECT CMPS 411 */ /* LIST OF TYPES USED IN PROGRAM (NECESSARY FOR TURBO PROLOG) */ domains int= integer. list = integer*. l_of_l = list* sym = symbol. slist = sym* accidental = flat;natural;sharp. accidental_list = accidental*. note_struct = note(symbol,accidental,int,sym). note_list = note_struct*. note_l_of_l = note_list* key_mode = major;minor. m_b_type = m_b(int,int). key_struct = key(symbol,accidental,key_mode);m_b(int,int). keylist = key_struct*. l_of_keylist = keylist*. key_str = key(l_of_keylist). /* INTERNAL STRUCTURES USED IN THE PROGRAM, BUT NOTE INPUTTED OR OUTPUTTED */ xnote = note(int,int);rule(int,sign). xbeat = xnote*. xvce = xbeat*. xsect = section(symbol,int,int,int,xvce). xlist = xsect*. oldinf = old(xvce,xvce,int,int,int);empty. answer = yes;no;low;high. sign = positive; negative. /* STRUCTURE FOR VOICE LEADING RULES */ v_lstruct = v_l(int,list). v_llist = v_lstruct*. len_type = length(int). complex = complexity(int,int). relation = unrelated(complex,len_type); transposition_of(symbol,int,int,len_type). struct_el = time(int,int);measures(int);section(symbol,m_b_type,int,relation). struct = struct_el* harm_str = harmony(l_of_l). ryth_struct = r(int,int,int,int);mn(int). ryth_list = ryth_struct*. ryth_l_of_l = ryth_list*. /* CONSTANTS USED IN THE PROGRAM */ constants norm_vcing = 1 norm_rhythm = 1 bass = 1 alto = 2 soprano = 3 beat_rest = [note(0,4)] /* DEGREE 0 WITH 4 SUBBEATS */ keys = [c,x,d,x,e,f,x,g,x,a,x,b] /* OFFSET FOR KEYS */ scale = [1,2,3,4,5,6,7] maj_scale = [1,3,5,6,8,10,12] min_scale_asc = [1,3,4,6,8,10,12] /* MELODIC ASCENDING */ min_scale_desc = [1,3,4,6,8,9,11] /* MELODIC DESCENDING */ minor_scale = 1 /* MODES */ major_scale = 2 /* THE FOLLOWING 2 LISTS ARE RULES FOR VOICE LEADING THAT MUST BE FOLLOWED. TRANSLATION: THE 12th SCALE DEGREE MUST BE FOLLOWED BY ANOTHER 12th SCALE DEGREE OR THE 1st SCALE DEGREE (I.E. LEADING TONES ALWAYS GO UP), ETC. THE 1st SCALE DEGREE CANNOT BE FOLLOWED BY THE 11th (CAN'T GO TO TONIC AFTER MELODIC DESCENDING SCALE) ETC. */ must =[v_l(12,[1,12]),v_l(11,[11,9]),v_l(9,[9,8])] must_not=[v_l(1,[11]),v_l(8,[9]),v_l(9,[10]),v_l(10,[8,9,11]),v_l(11,[10,12,1]),v_l(12,[11,10])] bad_int_list = [6,10,11,13,14] /* BAD INTERVAL JUMPS */ numb_of_voices = 3 /* FOR EXPANSION TO 4 VCE WRITER */ numb_notes_triad = 3 /* FOR EXPANSIION FOR 7th CHORDS */ octave = 12 /* NUMBER OF 1/2 STEPS IN OCTAVE */ parallel_list = [7,12] /* AVOID THESE PARALLELS BETWEEN VCES */ type = [flat,natural,sharp] vce_ranges = [bass,alto,sop] /* THE FOLLOWING IS A LIST OF RHYTHMS FOLLOWED AND A LIST OF WHERE THE MAIN NOTE SHOULD BE. EACH BEAT IS DIVIDED INTO 4 SUB-BEATS (EACH SUB-BEAT= 1 16th NOTE.) EACH BEAT ALSO HAS A MAIN NOTE ASSOCIATED WITH IT, WHICH MUST FALL ON ONE OF THE SUB BEATS. SO THE rhythms LIST IS A LIST OF RHYTHMS: 1st ELEMENT = 1 QUARTER NOTE (1 NOTE=4 SUBBEATS AND 3 NOTES = 0 SUBBEATS), THE 3rd ELEMENT IS 2 EIGHTHS, ETC. THE mnplace LIST IS A LIST CORRESPONDING TO THE rhythms LIST SAYING WHERE THE MAIN NOTE SHOULD FALL. SO THE FIRST 3 ELEMENTS SAY THE MAN NOTE SHOULD FALL ON THE 1st SUB-BEAT, THE 4th ALLOWS THE MAIN NOTE TO FALL ON THE 3rd SUB-BEAT, ETC. */ rhythms = [r(4,0,0,0),r(4,0,0,0),r(2,2,0,0),r(2,2,0,0),r(3,1,0,0),r(3,1,0,0),r(2,1,1,0),r(2,1,1,0),r(1,1,2,0),r(1,1,2,0),r(1,3,0,0),r(1,3,0,0),r(1,1,1,1),r(1,1,1,1)] mnplace = [mn(1),mn(1),mn(1),mn(3),mn(1),mn(1),mn(1),mn(1),mn(1),mn(3),mn(1),mn(1),mn(1),mn(3)] /* THE FOLLOWING IS TURBO PROLOG GARBAGE DECLARING ALL THE PREDICATES. THEY ARE OUT OF ORDER --- SORRY. I SUGGEST YOU IGNORE THIS SECTION, SINCE IT IS WORTHLESS FOR UNDERSTANDING THE PROGRAM, AND WOULDN'T EVEN BE HERE, IF I WEREN'T USING TURBO PROLOG */ predicates write_piece(struct,harm_str,key_str,xvce,xvce,xvce). w_p_do(struct,list,l_of_l,xvce,xvce,xvce,int,xvce,xvce,xvce,xlist) get_rule(xbeat,xnote). get_last_note_sd(xbeat,int,int,int,int). g_l_n_sd_do(int,int,int). get_unchoosen_voices(xvce,xvce,xvce,int,xvce,int,xvce,int) get_choosen_voice(xvce,xvce,xvce,int,xvce). paste_voice(xvce,xvce,xbeat,xvce,xvce,int,int,int,xvce). initialize(struct,harm_str,key_str,struct,list,l_of_l,xvce,xvce,xvce,int). convert_input(harm_str,key_str,int,list,l_of_l). convert_keys(l_of_keylist,int,l_of_l). get_time_signature(struct,struct,int). get_numb_of_measures(struct,struct,int). get_next_section(struct_el,int,symbol,int,int,relation). get_related_voice(relation,list,xlist,xvce,xvce,xvce,l_of_l,oldinf,int). alter_voice(xvce,xvce,int,int,xvce,xvce). lookup_voice(symbol,xlist,int,int,int,xvce). extract_voice(int,int,int,xvce,xvce,xvce,xvce). get_key(l_of_l,int,int,int,l_of_l,int,int). write_section(int,relation,oldinf,int,list,l_of_l,int,int,int,int,int,int, xvce,int,xvce,int,xnote,xvce,xvce). write_main_notes(int,int,list,int,int,int,xvce,int,xvce,int,xvce,xvce,l_of_l, int,int,int,xnote,xnote). elaborate_main_notes(int,xvce,xvce,int,int,int,list,int,xvce,int,xvce,int, l_of_l,int,int,int,int,xnote,xvce,xvce,xnote). e_m_n_do(int,int,int,int,int,int,int,xvce,int,xvce,int,int,int,list,int,int, xnote,xbeat,xbeat,xnote,int,int,int). make_note(int,int,xnote). get_last_note(xbeat,int,int). rewrite_line(int,oldinf,int,l_of_l,int,int,list,int,int,int,xvce,int, xvce,int,xnote,xvce,xvce,xnote). rewrite_line_do(int,xvce,xvce,int,list,int,int,int,xvce,int,xvce,int,l_of_l, int,int,int,xnote,xvce,xvce,xnote). r_l_do_do(xbeat,xbeat,int,int,int,int,int,xvce,int,xvce,int,int,int,int,xnote, xbeat,xbeat,int,xnote,int,int,int). get_mode(int,list). see_note(xbeat,xbeat,int,int,int,xbeat,xbeat). generate_possibility(int,int,int,int). getoffset(int,int,int,int,int,int,int). get_sd(int,int,int). trans_line_sds(xvce,int,xvce). transposeline(xvce,int,int,xvce). tl_do(xvce,int,int,int,xvce). lowernote(int,int). make_octave_list(int,list,list). alter_list(list,int,int,int,list,list). alter_list_do(list,int,list,int,list,list). alter_list_do_do(int,int,list,int,list,list). transpose_for_voice(int,int,int,list,list). in_range(int,int,answer). get_note(int,list,list,int,int,xvce,int,xvce,int,int,int,int,int,int, xnote,xnote). note_ok(int,int,int,int,int,int,int,xvce,int,xvce,int,xnote,xnote). vce_ok_key(int,int,int,int). vce_ok_key_do(int,int,int,int,v_llist,answer). vce_ok_melody(int,int,int,xnote,xnote). step(int,int,sign). vce_ok_interval(int,int). vce_ok_vce(int,int,int,int,int,int). voicedistanceok(int,int,int). no_parallels(int,int,int,int). parallel(int,int,int). parallel_lookup(int,list,int). get_approp_notes(xvce,int,int,int,int). g_a_n_do(xvce,int,int,int). g_a_n_do_do(xbeat,int,int,int,int,int,int). trans_key(key_struct,int,int). set_mode_value(key_mode,int). print_output(xvce,xvce,xvce). p_o_do(xvce,int). get_vce_name(int,string). convert_output(xvce,note_l_of_l). get_octave(int,int,int). get_octave_do(int,int,int,int). trans_to_pitch(int,sym,accidental). convert_length(int,sym). /* STANDARD ROUTINES */ append(list,list,list). append(xvce,xvce,xvce). between(int,int,int,answer). flatten(l_of_l,list). get_endless_nth(int,list,int). get_endless_nth_do(int,list,int,list). get_last(list,int). get_last(xvce,xbeat). get_length(list,int). get_length(xvce,int). get_length_do(list,int,int). get_length_do(xvce,int,int). get_random(int,int). loc_in_list(sym,slist,int,int). loc_in_list(accidental,accidental_list,int,int). get_nth(int,list,int). get_nth(int,slist,sym). make_int_list(list,int,int,int). make_mult(int,int,list). make_mult(xbeat,int,xvce). member(int,list). pick_rnd(l_of_l,int,list). pick_rnd(ryth_l_of_l,int,ryth_list). pick_rnd_if_failure(l_of_l,int,list,list). pick_rnd_if_failure(ryth_l_of_l,int,ryth_list,ryth_list). play(xvce). get_pitches(xvce,xbeat). convert_this(int,int,int). play_this(xbeat,int). remove_int(list,int,list,int,int). remove_int_list(l_of_l,int,l_of_l,int,list). remove_int_list(ryth_l_of_l,int,ryth_l_of_l,int,ryth_list). remove_int_list_do(l_of_l,l_of_l,int,list). remove_int_list_do(ryth_l_of_l,ryth_l_of_l,int,ryth_list). remove_nth(int,list,list,int). remove_nth(int,ryth_list,ryth_list,ryth_struct). remove_nth(int,xvce,xvce,xbeat). set_if_positive(int,int). split_list(xvce,int,xvce,xvce). split_list(list,int,list,list). split_list(ryth_list,int,ryth_list,ryth_list). subtract(int,int,int,sign). unify(int,int). unify(list,list). unify(l_of_l,l_of_l). unify(sym,sym). unify(accidental,accidental). unify(xbeat,xbeat). /* EXAMPLE GOAL --- TAKES SEVERAL HOURS */ goal write_piece([time(4,4),measures(10), section(subject,m_b(1,1),alto,unrelated(complexity(1,8),length(8))), section(answer,m_b(3,1),soprano, transposition_of(subject,norm_vcing,norm_rhythm,length(8))), section(subjbass,m_b(5,1),bass, transposition_of(subject,norm_vcing,norm_rhythm,length(8))), section(cs1,m_b(3,1),alto,unrelated(complexity(3,14),length(8))), section(cs11,m_b(5,1),soprano, transposition_of(cs1,norm_vcing,norm_rhythm,length(8))), section(ep1a,m_b(7,1),soprano, transposition_of(subject,norm_vcing,norm_rhythm,length(2))), section(ep1b,m_b(7,3),soprano, transposition_of(ep1a,norm_vcing,norm_rhythm,length(2))), section(ep1c,m_b(8,1),soprano, transposition_of(ep1a,norm_vcing,norm_rhythm,length(2))), section(ep1d,m_b(8,3),soprano, transposition_of(ep1a,norm_vcing,norm_rhythm,length(2))), section(ep2a,m_b(7,1),bass, transposition_of(cs1,norm_vcing,norm_rhythm,length(2))), section(ep2b,m_b(7,3),bass, transposition_of(ep2a,norm_vcing,norm_rhythm,length(2))), section(ep2c,m_b(8,1),bass, transposition_of(ep2a,norm_vcing,norm_rhythm,length(2))), section(ep2d,m_b(8,3),bass, transposition_of(ep2a,norm_vcing,norm_rhythm,length(2))), section(cs2,m_b(5,1),alto, unrelated(complexity(3,14),length(8))), section(acc1,m_b(7,1),alto, unrelated(complexity(1,5),length(8))), section(endsop,m_b(9,1),soprano, unrelated(complexity(1,1),length(1))), section(endalt,m_b(9,1),alto, unrelated(complexity(1,1),length(1))), section(endbass,m_b(9,1),bass, unrelated(complexity(1,1),length(1)))], harmony([[1,6,2,4],[5,6,5,5],[1,6,2,4],[5,6,5,5],[1,6,2,4],[5,6,5,5], [1,1,5,5],[1,1,5,5],[1,1,1,1]]), key([[key(a,natural,minor),m_b(1,1)], [key(e,natural,minor),m_b(3,1)], [key(a,natural,minor),m_b(5,1)], [key(d,natural,minor),m_b(8,1)], [key(a,natural,minor),m_b(9,1)]]), Soprano,Alto,Bass). clauses /* MAIN ROUTINE */ write_piece(Struct,Harms,Keys,NBass,NAlto,NSop) :- initialize(Struct,Harms,Keys,TStruct,THarms,TKeys,Bass,Alto,Sop,Q2M), w_p_do(TStruct,THarms,TKeys,Bass,Alto,Sop,Q2M,NBass,NAlto,NSop,[]), print_output(NBass,NAlto,NSop). /* GET TIME SIGNATURE, CONVERT HARMONIES AND KEYS INTO INTERNAL STRUCTURES EASIER FOR THE PROGRAM TO MANIPULATE, AND WRITE BLANK MEASURES (MEASURES WITH QUARTER NOTE RESTS) FOR EACH VOICE TO BE REPLACED WHERE NECESSARY BY NOTES LATER */ initialize(Struct,Harms,Keys,NewStruct,NewHarms,NewKeys,Bass,Alto,Sop,Q2M) :- get_time_signature(Struct,TmpStruct,Q2M), convert_input(Harms,Keys,Q2M,NewHarms,NewKeys), get_numb_of_measures(TmpStruct,NewStruct,Measures), CompMeasures = Measures + 2, make_mult(beat_rest,CompMeasures,Bass), make_mult(beat_rest,CompMeasures,Alto), make_mult(beat_rest,Compmeasures,Sop). /* HERE'S THE HEART OF THE PROGRAM. THIS ROUTINE WRITES EACH SECTION ONE AT A TIME. IT STORES INTERNAL A LIST Sects, WHICH HAS INFORMATION ABOUT SECTIONS ALREADY WRITTEN, SO THAT THEY CAN BE FOUND WHEN NEEDED BY A SECTION USING THE transposition_of OPTION. */ w_p_do([Str|RStrs],Harms,Keys,Bass,Alto,Sop,Q2M,NBass,NAlto,NSop,Sects):- write("\nAt w_p_do:"),!, get_next_section(Str,Q2M,Name,Place,VN,Rel), /* WHAT DO WE WRITE? */ write("\nEntering get_related_voice"), get_related_voice(Rel,Harms,Sects,Bass,Alto,Sop,Keys,OldInfo,Len), split_list(Bass,Place,BassBegin,BEnd), /* CUT VOICES INTO WHERE */ split_list(Alto,Place,AltoBegin,AEnd), /* WE ARE IN THE PIECE */ split_list(Sop,Place,SopBegin,SEnd), split_list(Harms,Place,_,THarms), get_unchoosen_voices(BEnd,AEnd,SEnd,VN,Vc1,VN1,Vc2,VN2), get_choosen_voice(BEnd,AEnd,SEnd,VN,CV), /*VOICE SECTION SHOULD BE IN */ get_key(Keys,1,major_scale,Place,TKeys,Key,Mode), /* GET CURRENT KEY */ CV = [LB,FirstBeat|RestBeats], /* UNIFICATION */ get_last_note_sd(LB,Key,LN,LSD,LNV), get_rule(FirstBeat,Rule), /* RULE THE SECTION SHOULD START WITH */ write("\nentering write_section"), write_section(Place,Rel,OldInfo,Len,THarms,TKeys,Key,Mode, LN,LSD,LNV,VN,Vc1,VN1,Vc2,VN2,Rule,NVoiceEnd,NSDs), TSects = [section(Name,Place,Len,VN,NSDs)|Sects], paste_voice(Bass,BassBegin,LB,BEnd,NVoiceEnd,Len,VN,bass,TBass), paste_voice(Alto,AltoBegin,LB,AEnd,NVoiceEnd,Len,VN,alto,TAlto), paste_voice(Sop,SopBegin,LB,SEnd,NVoiceEnd,Len,VN,soprano,TSop), w_p_do(RStrs,Harms,Keys,TBass,TAlto,TSop,Q2M,NBass,NAlto,NSop,TSects). /* BASE CASE --- ALL SECTIONS HAVE BEEN WRITTEN */ w_p_do([],_,_,Bas,Alto,Sop,_,Bas,Alto,Sop,_) :- !. /* THE FOLLOWING DECIDES WHERE WE NEED TO TRANSPOSE AN EXISTING MELODY OR WRITE AN ENTIRELY NEW ONE, AND ACTS APPROPRIATELY. WHEN CALLED, VOICES AND HARMS ARE POINTING TO THE BEAT BEFORE THE BEAT WHERE WE WANT TO START */ /* WRITE NEW MELODY: WRITE THE MAIN NOTES OF THE MELODY FIRST. THEN ORNAMENT THESE NOTES. */ write_section(Place,Rel,OldInfo,Len,Harms,Keys,Key,Mode,LN,LSD,LNV,VN,Vc1, VN1,Vc2,VN2,ORule,Voice,SDs) :- write("passing unrelated?"), Rel = unrelated(complexity(LowX,HighX),length(_)), write("Writing Section"),!, write_main_notes(Place,Len,Harms,LN,LSD,LNV,Vc1,VN1,Vc2,VN2,MNs,MSDs, Keys,Key,Mode,VN,ORule,TRule), elaborate_main_notes(Place,MNs,MSDs,LN,LSD,LNV,Harms,VN,Vc1,VN1,Vc2, VN2,Keys,Key,Mode,LowX,HighX,ORule,TVoice,SDs, NRule), append(TVoice,[[NRule]],Voice). /* SAVE RULE IN THE VOICE */ /* TRANSPOSE AN EXISTING MELODY */ write_section(Place,Rel,OldInfo,Len,Harms,Keys,Key,Mode,LN,LSD,LNV,VN,Vc1, VN1,Vc2,VN2,ORule,Voice,SDs) :- Rel = transposition_of(Name,_,_,_),!, rewrite_line(Place,Oldinfo,VN,Keys,Key,Mode,Harms,LN,LSD,LNV, Vc1,VN1,Vc2,VN2,ORule,TVoice,SDs,NRule), append(TVoice,[[NRule]],Voice). /* SAVE RULE IN THE VOICE */ /* WRITE THE MAIN NOTES IN A MELODY. FOR EACH BEAT, MAKE A LIST OF NOTES TO CHOOSE FROM, ADJUST FOR THE KEY AND VOICE WE ARE WRITING FOR, AND GET A NOTE THAT FITS THE RULES FOR "GOOD" COUNTERPOINT */ write_main_notes(Place,Len,[Harm|Harms],LastNote,LastSD,LNV,Vc1,VN1,Vc2,VN2, [[note(Note,4)]|MainNotes],[[note(SD,4)]|RestSDs],Keys,Key, Mode,VN,OldRule,NewRule):- Len > 0,!, AllHarms = [Harm|Harms], get_key(Keys,Key,Mode,Place,NewKeys,NewKey,NewMode), P1 = Place + 1, make_int_list(TriadNotes,numb_notes_triad,Harm,2), alter_list(TriadNotes,NewKey,NewMode,VN,SDs,Notes), get_length(Notes,Length), /*NUMBER OF NOTES TO CHOOSE FROM */ get_note(4,SDs,Notes,Length,VN,Vc1,VN1,VC2,VN2,LastNote,LastSD,LNV,Note, SD,OldRule,TmpRule), Len1 = Len - 1, Vc1 = [_|Vc11], Vc2 = [_|Vc21], write_main_notes(P1,Len1,Harms,Note,SD,4,Vc11,VN1,Vc21,VN2,MainNotes, RestSDs,NewKeys,NewKey,NewMode,VN,TmpRule,NewRule). write_main_notes(_,0,_,_,_,_,_,_,_,_,[],[],_,_,_,_,Rule,Rule) :- write("\nMain Notes written"),!. /* THE FOLLOWING ELABORATES MAIN NOTES WRITTEN FOR EACH BEAT. IT CHOOSES A RHYTHMIC PATTERN FOR A BEAT FROM THE 14 IN THE rhythms LIST (IN THE constants SECTION.) THE 14 ARE RANKED FROM SIMPLEST RHYTHM (1 QUARTER NOTE) TO MOST COMPLEX (4 SIXTEENTHS). THE USER SPECIFIES THE RANGE OF RHYTHMIC COMPLEXITY ALLOWED FOR THESE NOTES. WE CYCLE THROUGH EACH BEAT. FOR EACH BEAT, CALL e_m_n_do TO DO ALL THE WORK */ elaborate_main_notes(Place,[[note(MN,4)]|MNs],[[note(SD,4)]|SDs],LastNote, LastSD,LNV,AllHarms,VN,Vc1,VN1,Vc2,VN2,Keys,Key,Mode, LowX,HighX,OldRule,[Notes|RestNotes],[NewSDs|RestNewSDs], NewRule) :- AllHarms = [Harm|Harms], get_key(Keys,Key,Mode,Place,NewKeys,NewKey,NewMode), P1 = Place + 1, split_list(rhythms,LowX,_,RElabs), split_list(mnplace,LowX,_,MNElabs), Complex = HighX-LowX+1, pick_rnd([RElabs,MNElabs],Complex,[r(M1,M2,M3,M4),mn(MNPlace)]), e_m_n_do(MN,SD,LastNote,LastSD,LNV,Harm,VN,Vc1,VN1,Vc2,VN2,Key, Mode,[M1,M2,M3,M4],MNPlace,1,OldRule,Notes,NewSDs,TmpRule, NewLN,NewLSD,NNV), Vc1 = [_|Vc11], Vc2 = [_|Vc21], elaborate_main_notes(P1,MNs,SDs,NewLN,NewLSD,NNV,Harms,VN,Vc11,VN1,Vc21, VN2,NewKeys,NewKey,NewMode,LowX,HighX,TmpRule, RestNotes,RestNewSDs,NewRule). /* END ELABORATION IF NO MAIN NOTES */ elaborate_main_notes(_,[],_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Rule,[],[],Rule):- !. /* WE ARE AT SUBBEAT WHERE MAIN NOTE WILL GO */ /* CASE: THE MAIN NOTE SHOULD GO IN THIS SUBBEAT. IF THE NOTE FITS, WRITE IT. IF NOTE, BACKTRACKING WILL DO THE JOB */ e_m_n_do(MN,SD,LastNote,LastSD,LNV,Harm,VN,Vc1,VN1,Vc2,VN2,Key,Mode,[NV|NVs], SBeat,SBeat,OldRule,[FNote|RNotes],[FSD|RSDs],NewRule,NewLN,NewLSD,NNV):-!, note_ok(SBeat,MN,SD,LastNote,LastSD,LNV,VN,Vc1,VN1,Vc2,VN2,OldRule, TmpRule), make_note(MN,NV,FNote), make_note(SD,NV,FSD), SBeat1 = SBeat+NV, e_m_n_do(MN,SD,MN,SD,NV,Harm,VN,Vc1,VN1,Vc2,VN2,Key,Mode,NVs,SBeat, SBeat1,TmpRule,RNotes,RSDs,NewRule,NewLN,NewLSD,NNV). /* WE HAVE FILLED IN ALL SUBBEATS FOR THIS BEAT */ e_m_n_do(_,_,LN,LSD,NV,_,_,_,_,_,_,_,_,_,_,5,Rule,[],[],Rule,LN,LSD,NV):- !. /* WE NEED TO PICK A NOTE FOR THE SUBBEAT WE ARE AT (NOT THE MAIN NOTE) MAKE A LIST OF POSSIBLE NOTES (JUST LIKE IN write_main_notes) AND USE get_note TO MAKE SURE WE HAVE A NOTE THAT WORKS. */ e_m_n_do(MN,MSD,LastNote,LastSD,LNV,Harm,VN,Vc1,VN1,Vc2,VN2,Key,Mode,[NV|NVs], AccBeat,SBeat,OldRule,[FNote|RNotes],[FSD|RSDs],NewRule,NewLN,NewLSD, NewNV) :- SBeat <> AccBeat, SBeat < 5,!, alter_list(scale,Key,Mode,VN,PosSDs,PosNotes), get_length(PosNotes,Length), get_note(SBeat,PosSDs,PosNotes,Length,VN,Vc1,VN1,Vc2,VN2,LastNote, LastSD,LNV,Note,SD,OldRule,TmpRule), make_note(Note,NV,FNote), make_note(SD,NV,FSD), SBeat1 = SBeat+NV, e_m_n_do(MN,MSD,Note,SD,NV,Harm,VN,Vc1,VN1,Vc2,VN2,Key,Mode,NVs, AccBeat,SBeat1,TmpRule,RNotes,RSDs,NewRule,NewLN,NewLSD, NewNV). /* TRANSPOSE A VOICE: GET SCALE DEGREE OFFSET AND NOTE OFFSET BETWEEN THE OLD SECTION AND THE NEW SECTION. THIS IS DONE BY COMPARING THE KEYS AND HARMONIES OF THE TWO SECTIONS */ rewrite_line(Place,OldInfo,VN,Keys,Key,Mode,[Harm|Harms],LastNote, LastSD,LNV,Vc1,VN1,Vc2,VN2,OldRule,NewLine,SDs,NewRule) :- OldInfo = old(ONotes,OSDs,OldKey,OldMode,OldHarm), getoffset(OldHarm,1,OldMode,Harm,1,Mode,SDOffset), getoffset(OldHarm,OldKey,OldMode,Harm,Key,Mode,NoteOffset), trans_line_sds(OSDs,SDOffset,TSDs), transposeline(ONotes,VN,NoteOffset,TNotes), rewrite_line_do(Place,TNotes,TSDs,VN,[Harm|Harms],LastNote,LastSD,LNV, Vc1,VN1,Vc2,VN2,Keys,Key,OldMode,Mode,OldRule,NewLine, SDs,NewRule). /* TRY EACH BEAT IN TRANSPOSED LINE TO SEE IF IT FITS BY CALLING r_l_do_do */ rewrite_line_do(Place,[OldB1N|RestOB1N],[OldB1S|RestOB1S],VN,[Harm|Harms], LastNote,LastSD,LNV,Vc1,VN1,Vc2,VN2,Keys,Key,OldMd,Mode,OldRule, [NewB1N|RestB1N],[NewB1S|RestB1S],NewRule) :- get_key(Keys,Key,Mode,Place,NKeys,NKey,NMode), P1 = Place + 1, r_l_do_do(OldB1N,OldB1S,VN,Harm,LastNote,LastSD,LNV,Vc1,VN1,Vc2,VN2, NKey,OldMd,NMode,OldRule,NewB1N,NewB1S,1,TmpRule,NewLN,NewLSD, NewLNV), Vc1 = [_|Vc11], Vc2 = [_|Vc21], rewrite_line_do(P1,RestOB1N,RestOB1S,VN,Harms,NewLN,NewLSD,NewLNV,Vc11, VN1,Vc21,VN2,NKeys,NKey,OldMd,NMode,TmpRule,RestB1N, RestB1S,NewRule). rewrite_line_do(_,[],[],_,_,_,_,_,_,_,_,_,_,_,_,_,Rule,[],[],Rule) :- !. /* TRY EACH NOTE IN A BEAT BY GETTING A POSSIBLE NOTE, MAKING SURE IT'S A MEMBER OF THE SCALE, AND MAKING SURE IT FITS THE VOICING REQUIREMENTS */ r_l_do_do(OldNotes,OldSDs,VN,Harm,LastNote,LastSD,LNV,Vc1,VN1, Vc2,VN2,Key,OldMd,Mode,OldRule,[note(PosNote,NV)|Notes], [note(PosSD,NV)|SDs],SB,NewRule,NewLN,NewLSD,NewLNV) :- not(unify(OldNotes,[])),!, see_note(OldNotes,OldSDs,Note,SD,NV,RestNotes,RestSDs), generate_possibility(Note,SD,PosNote,PosSD), get_mode(OldMode,Scale), member(PosSD,Scale), note_ok(SB,PosNote,PosSD,LastNote,LastSD,LNV,VN,Vc1,VN1,Vc2,VN2,OldRule, TmpRule), SB1 = SB + NV, r_l_do_do(RestNotes,RestSDs,VN,Harm,PosNote,PosSD,NV,Vc1,VN1,Vc2,VN2, Key,OldMd,Mode,TmpRule,Notes,SDs,SB1,NewRule,NewLN,NewLSD, NewLNV). r_l_do_do([],[],_,_,LastNote,LastSD,LNV,_,_,_,_,_,_,_,Rule,[],[],_,Rule, LastNote,LastSD,LNV) :- !. /* PICK A RANDOM NOTE AND SCALE DEGREE FROM THE LIST. THIS PICKS A NOTE RANDOMLY FROM GIVEN LISTS AND TRIES IT ON THE VOICE LEADING RULES. IF THE NOTE IS NO GOOD, note_ok WILL FAIL, AND BACKTRACKING WILL MAKE pick_rnd PICK ANOTHER RANDOM NOTE. NOTE THAT pick_rnd WILL NEVER PICK THE SAME NOTE TWICE, SINCE IT BACKTRACKS WITH ITS ALTERED LIST (SEE pick_rnd) */ get_note(SB,SDs,Notes,Length,VN,Vc1,VN1,Vc2,VN2,LastNote,LastSD,LNV,Note,SD, OldRule,NewRule) :- pick_rnd([SDs,Notes],Length,[SD,Note]), note_ok(SB,Note,SD,LastNote,LastSD,LNV,VN,Vc1,VN1,Vc2,VN2,OldRule, NewRule). /* SUCCEEDS IF Note IS APPROPRIATE. COMPARED WITH THE TWO OTHER VOICES, WHOSE VOICE LISTS BEGIN ON THE SAME BEAT AS LastNote */ note_ok(SB,Note,SD,LastNote,LastSD,LNV,VN,Vc1,VN1,Vc2,VN2,OldRule,NewRule) :- vce_ok_melody(Note,LastNote,LNV,OldRule,NewRule),/* CHECK STEPS/SKIPS*/ vce_ok_key(SD,LastSD,Note,LastNote), /* CHECK LEADING TONES ETC */ vce_ok_interval(Note,LastNote), /* CHECK INTERVAL JUMP */ get_approp_notes(Vc1,SB,LastNote1,_,Note1), /* COMPARE WITH */ vce_ok_vce(Note,LastNote,VN,Note1,LastNote1,VN1), /* OTHER VOICES */ get_approp_notes(Vc2,SB,LastNote2,_,Note2), vce_ok_vce(Note,LastNote,VN,Note2,LastNote2,VN2). /* CHECK RULES ON STEPS AND SKIPS. WHEN A LARGE INTERVAL IS MADE, GOOD VOICE LEADING DICTATES THAT THE INTERVAL BE "FILLED IN" BY NOTES IN THE OPPOSITE DIRECTION BY STEP. WHAT DEFINES A LARGE INTERVAL AND HOW MUCH IF IT SHOULD BE FILLED IN IS A FUNCTION OF THE NOTE VALUE FROM WHERE THE INTERVAL IS. vce_ok_melody ACCEPTS AS INPUT THE CURRENT RULE, REFLECTING IF THERE WERE RECENT LARGE INTERVALS. IF NOT, IT ALLOWS SUCH AN INTERVAL AND REUTRNS A RULE FOR IT. OTHERWISE IT UPDATES THE CURRENT RULE. */ /* CASE: NO CURRENT RULE. */ vce_ok_melody(Note,LastNote,LastNoteValue,rule(0,_),rule(Value,Sign)) :- Note >0, LastNote>0,!, /* IGNORE RESTS */ subtract(LastNote,Note,TmpVal,Sign), TmpVal1 = TmpVal/4-LastNoteValue+2, set_if_positive(TmpVal1,Value). /* CASE: FOLLOW CURRENT RULE AND UPDATE IT */ vce_ok_melody(Note,LastNote,_,rule(OldVal,Sign),rule(NewVal,Sign)) :- OldVal > 0,!, NewVal = OldVal - 1, step(LastNote,Note,Sign). /* MUST HAVE STEP */ vce_ok_melody(0,_,_,Rule,Rule) :- !. /* RESTS ALWAYS OK */ vce_ok_melody(_,0,_,Rule,Rule) :- !. /* THE FOLLOWING SUCCEEDS IF THE TWO NOTES ARE A STEP AWAY AND IN THE DIRECTION OF Sign */ step(Note1,Note2,Sign) :- subtract(Note2,Note1,Difference,Sign), between(0,2,Difference,yes). /* CHECK THAT LEADING TONES GO UP ETC. FROM A LIST OF musts AND must_nots FOR SCALE DEGREES */ vce_ok_key(SD,LastDeg,Note,LastNote) :-!, vce_ok_key_do(SD,LastDeg,Note,LastNote,must,yes), vce_ok_key_do(SD,LastDeg,Note,LastNote,must_not,no). vce_ok_key_do(SD,LastDeg,Note,LastNote,[v_l(LastDeg,List)|Restv_ls],yes) :-!, member(SD,List), subtract(SD,LastDeg,Difference,Sign), Difference < 6. /* MAKE SURE NO OCTAVE SKIP */ vce_ok_key_do(SD,LastDeg,Note,LastNote,[v_l(LastDeg,List)|Restv_ls],no) :- !, not(member(SD,List)). vce_ok_key_do(SD,LastDeg,Note,LastNote,[v_l(AnothDeg,List)|Restv_ls],Ans) :- LastDeg <> AnothDeg, !, vce_ok_key_do(SD,LastDeg,Note,LastNote,Restv_ls,Ans). /* WE GET HERE ONLY IF WE DID NOT FIND THE SD IN QUESTION IN THE LIST */ vce_ok_key_do(_,_,_,_,[],_) :- !. /* MAKE SURE THE INTERVAL JUMP IN THE VOICE IS OK */ vce_ok_interval(Note,LastNote) :- subtract(Note,LastNote,Difference,_), not(member(Difference,bad_int_list)). /* THE FOLLOWING GET THE LAST NOTE AND CURRENT NOTE OF SOME UNCHOOSEN VOICE FOR USE IN THE PARALLELS, VOICE CROSSING CHECK, ETC. TESTS BETWEEN THIS UNCHOOSEN VOICE AND THE VOICE WE ARE WRITING A SECTION IN. */ /* GET CURRENT NOTE AND LAST NOTE */ get_approp_notes([LastBeat,CurrentBeat|Junk],SubBeat,LastNote,LNV,Note) :- !,g_a_n_do([LastBeat,CurrentBeat],SubBeat,Note,NV), SB1 = SubBeat - 1, g_a_n_do([LastBeat,CurrentBeat],SB1,LastNote,LNV). /* SUB BEAT 0 IMPLIES THE LAST BEAT IN THE PRECEDING MEASURE */ g_a_n_do([LastBeat,CurrentBeat],0,Note,NV) :-!, g_a_n_do([LastBeat],4,Note,NV). g_a_n_do(Vce,SubBeat,Note,NV) :- SubBeat>0,!, get_last(Vce,BackBeat), g_a_n_do_do(BackBeat,SubBeat,0,1,0,Note,NV). /* GET THE NOTE AT OR JUST BEFORE THE SUBBEAT */ g_a_n_do_do([note(Note1,NV1)|RBeat],SubBeat,_,_,AccBeat,Note2,NV2) :- AccBeat=SubBeat,!. g_a_n_do_do([],SubBeat,Note,NV,AccBeat,Note,NV) :- !. /* RULES IN THE VOICE IMPLY 1 BEAT RESTS */ g_a_n_do_do([rule(_,_)|Junk],SubBeat,Note,NV,AccBeat,Note,NV) :- !. /* SUCCEEDS IF THERE ARE NO BAD PARALLELS, VOICE CROSSING, ETC. BETWEEN 2 VOICES. VOICES CAN ONLY BE AN OCTAVE AWAY FROM EACH OTHER (EXCEPT THE BASS VOICE, WHICH CAN BE AS FAR AWAY AS IT WANTS FROM ANYTHING. THE VOICES CAN NEVER CROSS EACH OTHER */ vce_ok_vce(Note1,LastNote1,VN1,Note2,LastNote2,VN2) :- Note1 >0, LastNote1 >0, /* NO RESTS */ Note2 >0, LastNote2 >0,!, subtract(VN1,VN2,_,Sign), subtract(Note1,Note2,Distance,Sign), /* CHECK VOICE CROSSING */ voicedistanceok(VN1,VN2,Distance), no_parallels(Note1,LastNote1,Note2,LastNote2). vce_ok_vce(0,_,_,_,_,_) :- !. /* OK IF RESTS IN EITHER VOICE */ vce_ok_vce(_,0,_,_,_,_) :- !. vce_ok_vce(_,_,_,0,_,_) :- !. vce_ok_vce(_,_,_,_,0,_) :- !. voicedistanceok(1,_,_) :- !. /* OK IF EITHER VOICE IS A BASS */ voicedistanceok(_,1,_) :- !. voicedistanceok(VN1,VN2,Distance) :- /* OK IF LESS THAN OCTAVE SPACING */ VN1>1, VN2>1,!, Distance <=octave. /* SUCCEEDS IF THERE ARE NO PARALLEL PERFECT INTERVALS BETWEEN VOICE 1 AND VOICE 2 */ no_parallels(Note1,LastNote1,Note2,LastNote2) :- not(parallel(Note1,Note2,_)),!. no_parallels(Note1,LastNote1,Note2,LastNote2) :- parallel(Note1,Note2,Type),!, not(parallel(LastNote1,LastNote2,Type)). /* SUCCEEDS IF THERE IS A PERFECT INTERVAL BETWEEN Note1 AND Note2 */ parallel(Note1,Note2,Type) :- subtract(Note1,Note2,Distance,_), parallel_lookup(Distance,parallel_list,Type). parallel_lookup(Distance,[Distance|Rest],Distance) :- !. parallel_lookup(Distance1,[Distance2|Rest],Type) :- Distance1<>Distance2,!, parallel_lookup(Distance1,Rest,Type). /* THE ABOVE IS THE REAL "HEART" OF THE LOGIC IN THIS PROGRAM. THE REST OF THE ROUTINES ARE JUST HELPERS TO GET AT SPECIFIC FIELDS ETC. */ /* PRINT OUT THE RESULTING 3 VOICES AS LAST STEP FOR THE PROGRAM */ print_output(Vc1,Vc2,Vc3) :- p_o_do(Vc1,1), /* DO EACH VOICE 1 AT A TIME */ p_o_do(Vc2,2), p_o_do(Vc3,3). p_o_do(Vce,VN) :- get_vce_name(VN,VName), /* SOPRANO, ALTO, BASS */ convert_output(Vce,ConvVce), /* CONVERT TO "HUMAN" FORM */ write("\n",VName,": ",ConvVce). get_vce_name(1,"Bass") :- !. get_vce_name(2,"Alto") :- !. get_vce_name(3,"Soprano") :- !. /* CONVERTS EACH NOTE NUMBER INTO A NOTE AND sharp OR flat. */ convert_output([[note(CNote,Length)|CNotes]|RestCNotes], [[note(Note,Accidental,Oct,LName)|Notes]|RestNotes]) :-!, CNote1 = CNote -1, get_octave(CNote1,Oct,TransNote), /* GET REGISTER */ trans_to_pitch(TransNote,Note,Accidental), /* GET NOTE NAME */ convert_length(Length,LName), /* 16th,8th, ETC */ convert_output([CNotes|RestCNotes],[Notes|RestNotes]). convert_output([[rule(_,_)]|RestCNotes],Notes) :- !, convert_output([beat_rest|RestCNotes],Notes). convert_output([[]|CNotes],[[]|Notes]) :-!, convert_output(CNotes,Notes). convert_output([],[]) :- !. /* GET THE CURRENT RULE, IF THERE IS ONE */ get_rule([rule(X,Y)],rule(X,Y)) :- !. get_rule(Beat,rule(0,positive)) :- not(unify(Beat,[rule(_,_)])),!. /* GET THE LAST NOTE FROM THE LAST BEAT OF A VOICE, AND COMPUTE ITS SCALE DEGREE */ get_last_note_sd(LB,Key,LN,LSD,LNV) :-!, get_last_note(LB,LN,LNV), g_l_n_sd_do(Key,LN,LSD). g_l_n_sd_do(_,0,0) :- !. /* REST */ g_l_n_sd_do(Key,LN,LSD) :-!, TmpLSD1 = Key, lowernote(TmpLSD1,TmpLSD2), /* LOWER TO NEGATIVE */ LSD = TmpLSD2+octave. /* ADD OCTAVE FOR SD */ get_unchoosen_voices(Vc1,Vc2,Vc3,1,Vc2,2,Vc3,3) :- !. get_unchoosen_voices(Vc1,Vc2,Vc3,2,Vc1,1,Vc3,3) :- !. get_unchoosen_voices(Vc1,Vc2,Vc3,3,Vc1,1,Vc2,2) :- !. get_choosen_voice(Vc1,Vc2,Vc3,1,Vc1) :- !. get_choosen_voice(Vc1,Vc2,Vc3,2,Vc2) :- !. get_choosen_voice(Vc1,Vc2,Vc3,3,Vc3) :- !. /* PASTE UP NEWLY WRITTEN PART INTO THE CHOOSEN VOICE. FOR AN UNCHOOSEN VOICE, LEAVE UNALTERED */ paste_voice(Voice,VoiceBegin,Beat,VE1,VE2,Len,VN,VN,Result) :- !, append(VoiceBegin,[Beat|VE2],TmpResult), TmpLen = Len + 2, split_list(VE1,TmpLen,_,RestVoice), append(TmpResult,RestVoice,Result). paste_voice(Voice,_,_,_,_,_,VN1,VN2,Voice) :- VN1 <>VN2,!. /* CONVERT INPUT FROM HUMAN FORM TO COMPUTER FORM */ convert_input(harmony(L_of_L_Harms),key(L_of_L_Keys),Q2M,NewHarms, NewKeys) :- flatten(L_of_L_Harms,NewHarms), convert_keys(L_of_L_Keys,Q2M,NewKeys). /* CONVERTS KEYS FROM INPUT TO A LIST OF A LIST OF OFFSETS FOR THE KEY, MODE NUMBER, AND THE BEAT THE KEY FALLS ON */ convert_keys([[OKey,OPlace]|RestOKeys],Q2M,[[Key,Mode,NPlace]|RestNKeys]) :-!, trans_key(OKey,Key,Mode), OPlace = m_b(Meas,Beat), NPlace = (Meas-1)*Q2M+Beat, convert_keys(RestOKeys,Q2M,RestNKeys). convert_keys([],_,[]) :- !. get_time_signature([time(X,4)|Structure],Structure,X). get_numb_of_measures([measures(X)|Structure],Structure,X). /* GET NEXT SECTION TO WRITE */ get_next_section(Sec,Q2M,SecName,SecPlace,Voice,Relation) :- Sec = section(SecName,m_b(Meas,Beat),Voice,Relation), SecPlace = (Meas-1)*Q2M+Beat. /* IF THE NEXT SECTION IS A TRANSPOSITION OF A PREVIOUS SECTION, WRITE GET INFORMATION ABOUT THE PREVIOUS SECTION FROM AN INTERNAL LIST, AND EXTRACT THE SECTION FROM ITS VOICE */ get_related_voice(Rel,Harms,Sects,Bass,Alto,Sop,_,empty,Len) :- Rel = unrelated(_,length(Len)),!. /* CASE: TRANSPOSITION. CHOSE RANDOM STARTING PLACE TO START TRANSPOSITION, AND EXTRACT THE VOICE */ get_related_voice(Rel,Harms,Sects,Bass,Alto,Sop,Keys, old(Notes,SDs,Key,Mode,OldHarm),Length):- Rel = transposition_of(Name,Voicing,Rhythm,length(Length)),!, lookup_voice(Name,Sects,TEntrance,FullLength,Voice,OSDs), Range = FullLength - Length + 1, make_int_list(Numbs,Range,TEntrance,1), pick_rnd([Numbs],Range,[Entrance]), extract_voice(Entrance,Length,Voice,Bass,Alto,Sop,ONotes), alter_voice(ONotes,OSDs,Voicing,Rhythm,Notes,SDs), get_key(Keys,1,major_scale,Entrance,_,Key,Mode), get_nth(Entrance,Harms,OldHarm). /* THE FOLLOWING IS FOR ALTERING A PREVIOUS VOICE BEFORE TRANSPOSING IT. RIGHT NOW, NO ALTERING IS POSSIBLE. EVENTUALLY, SECTIONS MIGHT BE INVERTED, REVERSED, ETC. */ alter_voice(Notes,SDs,norm_vcing,norm_rhythm,Notes,SDs). /* LOOK UP INFORMATION ABOUT A PREVIOUS SECTION FROM THE INTERNAL LIST */ lookup_voice(Name,[section(Name,Ent,Len,Vce,SDs)|Sects],Ent,Len,Vce,SDs):-!. lookup_voice(Name1,[section(Name2,_,_,_,_)|Sects],Ent,Len,Voice,SDs) :- Name1 <> Name2,!, lookup_voice(Name1,Sects,Ent,Len,Voice,SDs). /* EXTRACT A PREVIOUS VOICE, SO THAT WE MAY WORK WITH IT */ extract_voice(Entrance,Length,VN,Bass,Alto,Sop,Notes) :- Begin = Entrance +1, /*SKIP BEAT 0 */ End = Length + 1, get_choosen_voice(Bass,Alto,Sop,VN,Voice), split_list(Voice,Begin,_,TVoice), split_list(TVoice,End,Notes,_). /* GET CURRENT KEY FROM THE LIST OF KEYS. A NEW LIST IS RETURNED, SO THAT get_key DOESN'T HAVE TO LOOK THROUGH THE BEGINNING OF THE LIST, IF WE ARE AT THE END OF THE PIECE */ get_key([[Key,Mode,Beat]|RKeys],OrigKey,OrigMode,Beat,RKeys,Key,Mode):-!. get_key([[Key,Mode,Place]|RKeys],OKey,OMode,Beat,NKeys,NKey,NMode) :- Place Beat,!. make_note(NotePitch,NoteVal,note(NotePitch,NoteVal)). /* GET LAST NOTE IN A BEAT */ get_last_note([note(Pitch,NoteVal)],Pitch,NoteVal) :- !. get_last_note([Note1,Note2|Notes],P,NV) :- !,get_last_note([Note2|Notes],P,NV). get_last_note([rule(_,_)],0,4) :- !. /* TRANSFER THE MODE TO A LIST OF POSSIBLE SCALE DEGREES. A MINOR SCALE IS DIFFERENT WHEN ASCENDING THAN DESCENDING */ get_mode(major_scale,maj_scale) :- !. get_mode(minor_scale,min_scale_asc). get_mode(minor_scale,min_scale_desc). /* GET NOTE,SD,AND NV FROM A LIST OF NOTES AND SDS */ see_note([note(Pitch,NV)|Notes],[note(SD,NV)|SDs],Pitch,SD,NV,Notes,SDs). /* GET POSSIBLE NOTES WHEN TRANSPOSING. A NOTE CAN BE UP TO 1 FULL STEP AWAY FROM THE ORIGINAL NOTE AND STILL BE PERMITTED */ generate_possibility(Note,SD,Note,SD). generate_possibility(Note1,SD1,Note2,SD2) :- Note2 = Note1-1, TmpSD = SD1-1, transpose_for_voice(TmpSD,0,TmpSD,_,[SD2]). generate_possibility(Note1,SD1,Note2,SD2) :- Note2 = Note1+1, TmpSD = SD1-octave+1, transpose_for_voice(TmpSD,0,TmpSD,_,[SD2]). generate_possibility(Note1,SD1,Note2,SD2) :- Note2 = Note1-2, TmpSD = SD1-octave+1, transpose_for_voice(TmpSD,0,TmpSD,_,[SD2]). generate_possibility(Note1,SD1,Note2,SD2) :- Note2 = Note1+2, TmpSD = SD1-octave+1, transpose_for_voice(TmpSD,0,TmpSD,_,[SD2]). /* CALCULATE OFFSET FOR TRANSPOSING A LINE */ getoffset(OrigHarm,OrigKey,OrigMode,Harm,Key,Mode,NewOffset) :- get_sd(Harm,Mode,TmpOffset1), /* GET SD OF HARMS */ get_sd(OrigHarm,OrigMode,TmpOffset2), NewOffset = TmpOffset1-TmpOffset2+Key-OrigKey. get_sd(ScalePos,major_scale,SD) :-!, get_endless_nth(ScalePos,maj_scale,SD). get_sd(ScalePos,minor_scale,SD) :- get_endless_nth(ScalePos,min_scale_asc,SD). get_sd(ScalePos,minor_scale,SD) :- get_endless_nth(ScalePos,min_scale_desc,SD). /* TRANSLATE THE SCALE DEGREES IN A LINE */ trans_line_sds([[FN|RestBeat]|RestLine],Offset,[[note(SD,Val)|RSDsB]|RSDs]) :- !,FN = note(FirstSD,Val), TmpSD = FirstSD+Offset, lowernote(TmpSD,LoweredFirstSD), transpose_for_voice(LoweredFirstSD,0,0,_,[SD]), trans_line_sds([RestBeat|RestLine],Offset,[RSDsB|RSDs]). trans_line_sds([[]|RestLine],Offset,[[]|RSDs]) :- !, trans_line_sds(RestLine,Offset,RSDs). trans_line_sds([],_,[]) :- !. /* TRANSPOSE THE NOTES THEMSELVES */ transposeline([[FN|RestBeat]|RestLine],VN,Offset,TransList) :- FN = note(FirstNote,_), TmpNote = FirstNote+Offset, lowernote(TmpNote,LoweredFirstNote), transpose_for_voice(LoweredFirstNote,VN,0,_,PosNotes), make_octave_list(TmpNote,PosNotes,OctList), get_length(OctList,Length), pick_rnd([OctList],Length,[Octave]), tl_do([[FN|RestBeat]|RestLine],VN,Octave,Offset,TransList). tl_do([[note(FirstNote,NV)|RestBeat]|RestLine],VN,Octave,Offset, [[note(TransNote,NV)|RestTB]|RestTL]):-!, TransNote = FirstNote+Octave+Offset, in_range(TransNote,VN,yes), tl_do([RestBeat|RestLine],VN,Octave,Offset,[RestTB|RestTL]). tl_do([[]|RestLine],VN,Octave,Offset,[[]|RestTL]) :- !, TL_do(RestLine,VN,Octave,Offset,RestTL). tl_do([],_,_,_,[]) :- !. /* LOWER A NOTE BY OCTAVES UNTIL WE HAVE A NEGATIVE VALUE */ lowernote(Note,LoweredNote) :- Note >0,!, NewNote = Note - octave, lowernote(NewNote,LoweredNote). lowernote(Note,Note) :- Note <=0,!. /* MAKE A LIST OF HOW FAR AWAY THE ORIGINAL NOTE CAN BE FROM THE TRANSPOSED NOTE AND STILL BE IN RANGE OF THE VOICE */ make_octave_list(Note,[FNote|RNotes],[FOct|ROcts]) :-!, FOct = FNote - Note, make_octave_list(Note,RNotes,ROcts). make_octave_list(_,[],[]) :- !. /* TRANSLATE POSITIONS IN THE SCALE INTO SCALE DEGREES */ /* CHOOSE THE RIGHT SCALE: */ alter_list(TNotes,Key,major_scale,VN,AllSDs,AllNotes) :- !, alter_list_do(TNotes,Key,maj_scale,VN,AllSDs,AllNotes). alter_list(TNotes,Key,minor_scale,VN,AllSDs,AllNotes) :- alter_list_do(TNotes,Key,min_scale_asc,VN,AllSDs,AllNotes). alter_list(TNotes,Key,minor_scale,VN,AllSDs,AllNotes) :- !, alter_list_do(TNotes,Key,min_scale_desc,VN,AllSDs,AllNotes). alter_list_do([TNote|Rest],Key,Scale,VN,AllSDs,AllNotes) :-!, alter_list_do_do(TNote,Key,Scale,VN,SDList,NoteList), alter_list_do(Rest,Key,Scale,VN,RestSDs,RestNotes), append(NoteList,RestNotes,AllNotes), append(SDList,RestSDs,AllSDs). alter_list_do([],_,_,_,[],[]) :- !. /* GO 1 NOTE AT A TIME */ alter_list_do_do(TNote,Key,Scale,VN,AllSDs,NoteList) :- get_endless_nth(TNote,Scale,SD), TNote1 = SD+Key-octave, transpose_for_voice(TNote1,VN,SD,AllSDs,NoteList). /* RETURNS LIST OF ACCEPTABLE NOTES IN RANGE OF VoiceNumber */ transpose_for_voice(OldNote,VoiceNumber,SD,[SD|RestSDs],[OldNote|Rest]) :- in_range(OldNote,VoiceNumber,yes),!, OldNote1 = OldNote+octave, transpose_for_voice(OldNote1,VoiceNumber,SD,RestSDs,Rest). transpose_for_voice(OldNote,VoiceNumber,SD,SDs,Notes) :- in_range(OldNote,VoiceNumber,low),!, OldNote1 = OldNote + octave, transpose_for_voice(OldNote1,VoiceNumber,SD,SDs,Notes). transpose_for_voice(OldNote,VoiceNumber,SD,[],[]) :- in_range(OldNote,VoiceNumber,high),!. /* RANGES ALLOWED FOR EACH VOICE. 1 =BASS,2=ALTO, 3=SOPRANO */ in_range(Note,0,Ans) :- between(1,12,Note,Ans),!. /* USED TO GET SDs */ in_range(Note,1,Ans) :- between(1,26,Note,Ans),!. in_range(Note,2,Ans) :- between(23,41,Note,Ans),!. in_range(Note,3,Ans) :- between(26,49,Note,Ans),!. /* TRANSLATE A KEY FROM 'HUMAN' INPUT TO AN OFFSET AND A MODE VALUE. MINOR MODE HAS MODE VALUE 1, WHILE MAJOR IS 2. A D SCALE IS 2 STEPS FROM C, SO WOULD HAVE OFFSET 2, E HAS OFFSET 4, ETC. */ trans_key(key(Ky,Type,Mode),Offset,ModeVal) :- loc_in_list(Ky,keys,Loc1,1), loc_in_list(Type,type,Loc2,-1), Offset = Loc1 + Loc2, set_mode_value(Mode,ModeVal). set_mode_value(minor,minor_scale) :- !. set_mode_value(major,major_scale) :- !. /* LOWER A NOTE TO A SCALE DEGREE, AND FIND OUT HOW MANY OCTAVES WE HAD TO GO TO DO THIS */ get_octave(Note,Octave,TransposedNote) :- get_octave_do(Note,Octave,TransposedNote,0). get_octave_do(Note,Oct,TransposedNote,Acc) :- Note > octave,!, Note1 = Note -octave, Acc1 = Acc+1, get_octave_do(Note1,Oct,TransposedNote,Acc1). get_octave_do(Note,Oct,Note,Oct) :- Note <=octave,!. /* GET OUTPUT TO HUMAN READABLE FORM: CONVERT NUMBERS TO PITCHES */ trans_to_pitch(-1,rest,natural) :- !. trans_to_pitch(TransNote,Note,sharp) :- get_nth(TransNote,keys,x),!, TN1 = TransNote -1, get_nth(TN1,keys,Note). trans_to_pitch(TransNote,Note,natural) :- get_nth(TransNote,keys,Note), not(unify(Note,x)),!. /* CONVERT TO HUMAN READABLE FORM */ convert_length(1,sixteenth). convert_length(2,eighth). convert_length(3,dotted_eighth). convert_length(4,quarter). /* THE FOLLOWING AREN'T USED IN THIS "FINAL" VERSION OF THE PROGRAM, BUT ARE HANDY FOR PLAYING INDIVIDUAL VOICE LINES THROUGH THE COMPUTER SPEAKER: */ play(Notes) :-!, get_pitches(Notes,PlayThis), play_this(PlayThis,25). /* CONVERTS NOTES INTO FREQUENCY,DURATION PAIRS FOR THE COMPUTER TO PLAY */ get_pitches([[note(Note,Length)|Rest]|RR],[note(GoodNote,Length)|RestNotes]):-!, Note1 = Note+10, convert_this(Note1,GoodNote,72), get_pitches([Rest|RR],RestNotes). get_pitches([[]|RR],RestNotes) :- !,get_pitches(RR,RestNotes). get_pitches([],[]) :- !. /* CONVERTS OWN NOTE TO A FREQUENCY */ convert_this(Note,GoodNote,Acc) :- Note >0,!, Acc1 = Acc*1.0600859, Note1 = Note - 1, convert_this(Note1,GoodNote,Acc1). convert_this(0,Acc,Acc) :- !. /* PLAYS THE FREQUENCY,DURATION PAIRS */ play_this([note(Pitch,Value)|Notes],Length) :- Hold = Value * Length, sound(Hold,Pitch), play_this(Notes,25). play_this([],_) :- !. /* STANDARD "LIBRARY" ROUTINES (IN ALPHABETICAL ORDER) */ append([],Ys,Ys) :- !. append([X|Xs],Ys,[X|Zs]) :- !,append(Xs,Ys,Zs). /* CHECKS TO SEE IF Z IS BETWEEN X AND Y: */ between(X,Y,Z,yes) :- Z>=X, Z <= Y,!. between(X,Y,Z,low) :- ZY,!. flatten([[X|Rest]|Xs],[X|Ys]) :- !,flatten([Rest|Xs],Ys). flatten([[]|Xs],Ys) :- !,flatten(Xs,Ys). flatten([],[]) :- !. /* THE FOLLOWING GETS THE Nth ELEMENT IN THE LIST Xs AND RETURNS IT IN X. IF THE LIST RUNS OUT BEFORE THE ELEMENT IS FOUND, WE START SEARCHING FROM THE FIRST ELEMENT IN THE LIST AGAIN (SO THE LIST IS "ENDLESS") */ get_endless_nth(Nth,Xs,X) :- get_endless_nth_do(Nth,Xs,X,Xs). get_endless_nth_do(Nth,[X|Xs],Ans,Spare) :- Nth>1, !,Nth1 = Nth-1, get_endless_nth_do(Nth1,Xs,Ans,Spare). get_endless_nth_do(Nth,[],Ans,Spare) :- !, get_endless_nth_do(Nth,Spare,Ans,Spare). get_endless_nth_do(1,[X|Xs],X,_) :- !. /* GETS THE LAST ELEMENT IN A LIST */ get_last([Y,Z|Xs],X) :- !,get_last([Z|Xs],X). get_last([X],X) :- !. /* RETURNS THE LENGTH OF A LIST */ get_length(Xs,Length) :- get_length_do(Xs,Length,0). get_length_do([X|Xs],Length,Acc) :- !, Acc1 = Acc+1, get_length_do(Xs,Length,Acc1). get_length_do([],Length,Length) :- !. /* GET Nth ELEMENT IN THE LIST */ get_nth(Nth,[X|Xs],Ans) :- Nth>1,!, Nth1 = Nth-1, get_nth(Nth1,Xs,Ans). get_nth(1,[X|Xs],X) :- !. /* RETURNS A RANDOM INTEGER RandomX BETWEEN THE VALUES OF 1 AND Range */ get_random(Range,RandomX) :- random(Range,X), RandomX = X+1. /*GET ELEMENT X IN LIST Xs, AND RETURN WHERE IT WAS IN THE LIST */ loc_in_list(X,[X|Xs],Loc,Loc) :- !. loc_in_list(X,[Y|Xs],Loc,Acc) :- not(unify(Y,X)), Acc1 = Acc +1, loc_in_list(X,Xs,Loc,Acc1). /* MAKE A LIST OF ASCENDING INTEGERS FROM Numb. MAKE Dec OF THEM, AND INCREMENT EACH FROM THE LAST BY Step */ make_int_list([Numb|RestNumbs],Dec,Numb,Step) :- Dec>0,!, Dec1 = Dec-1, Numb1 = Numb+Step, make_int_list(RestNumbs,Dec1,Numb1,Step). make_int_list([],0,_,_) :- !. /* MAKE A LIST OF El Times TIMES */ make_mult(El,Times,[El|Els]) :- Times >1,!, Times1 = Times - 1, make_mult(El,Times1,Els). make_mult(EL,1,[EL]):-!. member(X,[X|Xs]) :- !. member(X,[Y|Xs]) :- not(unify(Y,X)),!,member(X,Xs). /* PICKS RANDOM NUMBERS FROM LIST OF LISTS. LAST NUMBER PICKED IS DELETED FROM LIST OF LISTS ON BACKTRACKING. THIS ROUTINE IS THE "HEART" OF THE "GENERATE AND TEST" APPROACH I TAKE TO CHOOSING NOTES. I DIDN'T WANT THE COMPUTER TO BE WRITING THE SAME PIECE EVERY TIME IT GETS THE SAME INPUT, SO THIS ROUTINE CHOOSES ELEMENTS FROM A LIST OF LISTS RANDOMLY. ON BACKTRACKING, THE WE CHOOSES A DIFFERENT ELEMENT, SINCE THE ELEMENT WE CHOSE LAST WAS DELETED FROM THE LIST. */ pick_rnd(Lists,Length,RndEls) :- remove_int_list(Lists,Length,NewLists,TmpPlace,TmpEls), Length1 = Length - 1, pick_rnd_if_failure(NewLists,Length1,TmpEls,RndEls). /* BACKTRACKING FOR pick)_rnd */ pick_rnd_if_failure(Lists,Length,Elements,Elements). pick_rnd_if_failure(Lists,Length,OldEls,NewEls) :- Length >0, pick_rnd(Lists,Length,NewEls). /* CHOOSES AN ELEMENT RANDOMLY FROM A LIST AND DELETES IT. THE ELEMENT IS RETURNED, ALONG WITH WHERE THE ELEMENT WAS IN THE LIST, AND A NEW LIST WITHOUT THE ELEMENT. */ remove_int(OldList,Length,NewList,RndNum,RndEl) :- remove_int_list([OldList],Length,[NewList],RndNum,[RndEl]). /* CHOOSES ELEMENTS RANDOMLY FROM A LIST OF LISTS AND DELETES THEM TO MAKE A LIST OF DELETED ELEMENTS AND A NEW LIST OF LISTS WITHOUT THE DELETED ELEMENTS */ remove_int_list(IntLists,Length,IntLists1,IntNumber,DeleteList) :- get_random(Length,IntNumber), remove_int_list_do(IntLists,IntLists1,IntNumber,DeleteList). remove_int_list_do([OldList|RestOld],[NewList|RestNew],Int,[DelEl|RestDel]) :- !,remove_nth(Int,OldList,NewList,DelEl), remove_int_list_do(RestOld,RestNew,Int,RestDel). remove_int_list_do([],[],_,[]) :- !. /* REMOVE THE Nth ELEMENT IN A LIST. RETURN THE DELETED ELEMENT AS WELL AS A NEW LIST */ remove_nth(Nth,[X|OldList],[X|NewList],Deleted) :- Nth>1, Nth1 = Nth-1,!, remove_nth(Nth1,OldList,NewList,Deleted). remove_nth(1,[Deleted|Rest],Rest,Deleted) :- !. set_if_positive(X,X) :- X>0,!. set_if_positive(X,0) :- X<=0,!. /* THE FOLLOWING SPLITS A LIST. THE BEGINNING OF THE SECOND LIST STARTS WHERE THE Nth ELEMENT IS */ split_list([El|Els],Nth,[El|RestListBegin],ListEnd) :- Nth>1,!, Nth1 = Nth-1, split_list(Els,Nth1,RestListBegin,ListEnd). split_list(List,1,[],List). /* SUBTRACT: ALWAYS RETURNS Z AS A POSITIVE NUMBER (OR 0) */ subtract(X,Y,Z,positive) :- X>Y,!, Z = X-Y. subtract(X,Y,Z,negative) :- X