;;;
;;; C:\\program files\\acl62\\music20.cl
;;;
(load "c:\\program files\\acl62\\music19.cl")
;;;
;;;(sharp-till-chord-tone-2 're '("CM7" ion))
;;;(re +re mi)
;;;
(defun sharp-till-chord-tone-2 (note pair)
(do ((nt note (sharp-a-note nt))
(w))
((member-of-chord-tone-2 nt pair)
(push nt w)
(reverse w))
(push nt w)))
;;;
;;;(flat-till-chord-tone-2 're '("CM7" ion))
;;;(re +do do)
;;;
(defun flat-till-chord-tone-2 (note pair)
(do ((nt note (flat-a-note nt))
(w))
((member-of-chord-tone-2 nt pair)
(push nt w)
(reverse w))
(push nt w)))
;;;
;;;(generate-a-phrase-aux-2 '("CM7" ion))
;;;((la so) (la +so so) mi si si mi si (re +do do))
;;;
(defun generate-a-phrase-aux-2 (pair)
(do ((i 8 (1- i))
(w))
((<= i 0) (reverse w))
(let ((nt (generate-a-note-at-random pair)))
(cond ((member-of-guide-tone-2 nt pair)
(push nt w))
((member-of-tension-note-2 nt pair)
(push (case (random 4)
(0 (flat-till-chord-tone nt pair))
(1 (sharp-till-chord-tone nt pair))
(2 (flat-till-chord-tone-2 nt pair))
(3 (sharp-till-chord-tone-2 nt pair))) w))
(t
(push (case (random 4)
(0 (flat-till-chord-tone nt pair))
(1 (sharp-till-chord-tone nt pair))
(2 (flat-till-chord-tone-2 nt pair))
(3 (sharp-till-chord-tone-2 nt pair))) w))))))
(defun generate-a-phrase-of-n-notes-2 (pair n)
(cut-list-at-length n (generate-a-phrase-aux-2 pair)))
(defun generate-a-phrase-at-random-2-1 (pair)
(generate-a-phrase-of-n-notes-2 pair (1+ (random 4))))
(defun generate-a-phrase-at-random-2-2 (pair)
(generate-a-phrase-of-n-notes pair (1+ (random 3))))
(defun generate-a-phrase-at-random-2-3 (pair)
(generate-a-phrase-of-n-notes pair (1+ (random 2))))
(defun generate-a-phrase-at-random-2-4 (pair)
(generate-a-phrase-of-n-notes pair (1+ (random 1))))
(defun make-a-phrase-2 (l)
(do ((lst l (cddr lst)))
((null lst))
(format t "~%*********** On ~a ************" l)
(format t "~%*********** On ~a ************" (list (first
lst) (second lst)))
(format t "~%Chord Scale: ~a" (chord-scale (list (first lst)
(second lst))))
(format t "~%~a" (squash (generate-a-phrase-at-random-2-1
(list (first lst) (second lst)))))
(format t "~%~a" (squash (generate-a-phrase-at-random-2-1
(list (first lst) (second lst)))))
(format t "~%~a" (squash (generate-a-phrase-at-random-2-1
(list (first lst) (second lst)))))
(format t "~%~a" (squash (generate-a-phrase-at-random-2-1
(list (first lst) (second lst)))))
(format t "~%~a" (squash (generate-a-phrase-at-random-2-1
(list (first lst) (second lst)))))))
;;;
;;;(make-phrases-2 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;*********** On (CM7 ion A7 hmp5) ************
;;;*********** On (CM7 ion) ************
;;;Chord Scale: (do re mi fa so la si do)
;;;(la si mi si re do si)
;;;(mi re do si)
;;;(mi)
;;;(re +do do si)
;;;(mi mi la si la +la si la +la si)
;;;*********** On (CM7 ion A7 hmp5) ************
;;;*********** On (A7 hmp5) ************
;;;Chord Scale: (la +la do do re mi fa so la)
;;;(so do)
;;;(do do)
;;;(+la si do do fa mi do +la do)
;;;(do)
;;;(fa so do do +la si do)
;;;*********** On (Dm7 dor G7 alt) ************
;;;*********** On (Dm7 dor) ************
;;;Chord Scale: (re mi fa so la si do re)
;;;(so la do do)
;;;(fa fa do mi re mi fa do)
;;;(mi fa fa so +so la mi fa do)
;;;(fa mi re mi +re re)
;;;(so fa do fa so la so +so la mi re)
;;;*********** On (Dm7 dor G7 alt) ************
;;;*********** On (G7 alt) ************
;;;Chord Scale: (so +so +la si do re fa so)
;;;(re re)
;;;(+la la +so so do si fa do si si)
;;;(do +do re +la si +la si)
;;;(do re fa +so so)
;;;(+la si +la la +so so +so la +la si +la la +so so fa +so so)
;;;*********** On (CM7 ion) ************
;;;*********** On (CM7 ion) ************
;;;Chord Scale: (do re mi fa so la si do)
;;;(mi)
;;;(mi si)
;;;(re +re mi si la +la si mi mi)
;;;(re mi)
;;;(si)
;;;nil
;;;
(defun make-phrases-2 (l)
(do ((lst l (cdr lst)))
((null lst))
(make-a-phrase-2 (car lst))))
;;;
;;;(make-a-phrase-2-1-aux '("CM7" ion))
;;;((("CM7" ion) re do mi la so mi si la +so ...))
;;;(make-a-phrase-2-1-aux '("CM7" ion "Dm7" dor))
;;;((("CM7" ion) mi) (("Dm7" dor) so fa fa))
;;;(make-a-phrase-2-1-aux '("CM7" ion "Dm7" dor "G7" alt))
;;;((("CM7" ion) la si) (("Dm7" dor) do) (("G7" alt) si fa))
;;;
(defun make-a-phrase-2-1-aux (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(squash (generate-a-phrase-at-random-2-1 (list (first
lst) (second lst)))))))
(push l1 w))))
((equal (length l) 4)
(do ((lst l (cddr lst))
(n2)
(w))
((null lst) (reverse w))
(let ((l2 (cons (list (first lst) (second lst))
(squash (generate-a-phrase-at-random-2-2 (list (first
lst) (second lst)))))))
(push l2 w))))
((equal (length l) 6)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l3 (cons (list (first lst) (second lst))
(squash (generate-a-phrase-at-random-2-3 (list (first
lst) (second lst)))))))
(push l3 w))))))
;;;
;;;(make-a-phrase-2-2-aux-third '("CM7" ion))
;;;((("CM7" ion) mi))
;;;(make-a-phrase-2-2-aux-third '("CM7" ion "Dm7" dor))
;;;((("CM7" ion) mi la si) (("Dm7" dor) mi fa))
;;;(make-a-phrase-2-2-aux-third '("CM7" ion "Dm7" dor "G7" alt))
;;;((("CM7" ion) la so) (("Dm7" dor) so fa) (("G7" alt) +la si))
;;;
(defun make-a-phrase-2-2-aux-third (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(squash (generate-a-phrase-at-random-2-2 (list (first
lst) (second lst)))))))
(push l1 w))))
((equal (length l) 4)
(do ((lst l (cddr lst))
(n2)
(w))
((null lst) (reverse w))
(let ((l2 (cons (list (first lst) (second lst))
(squash (generate-a-phrase-at-random-2-3 (list (first
lst) (second lst)))))))
(push l2 w))))
((equal (length l) 6)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l3 (cons (list (first lst) (second lst))
(squash (generate-a-phrase-at-random-2-4 (list (first
lst) (second lst)))))))
(push l3 w))))))
;;;
;;;(make-a-phrase-2-2-aux '("CM7" ion))
;;;(((("CM7" ion) re do si la so re +do do mi ...)) ***3beat*** ("3(8 8 8)" 16 16 16 16 8 16 16) ***4beat***
;;; ("3(8pause 8pause 8)" 16 16 16 16 4 16 16 16 16))
;;;(make-a-phrase-2-2-aux '("CM7" ion "Dm7" dor))
;;;(((("CM7" ion) re do) (("Dm7" dor) mi fa)) ***3beat*** (4 8.5 16 4) ***4beat*** (4 4 4 4))
;;;(make-a-phrase-2-2-aux '("CM7" ion "Dm7" dor "G7" alt))
;;;(((("CM7" ion) la si) (("Dm7" dor) so la) (("G7" alt) si fa)) ***3beat*** (8.5 16 4 16 16 8) ***4beat***
;;; (8pause 8 8pause 8 16pause 16 16 16 "3(8pause 8pause 8)"))
;;;
(defun make-a-phrase-2-2-aux (pair)
(let ((l (make-a-phrase-2-1-aux pair))
(n))
(setf n (number-of-notes l))
(list l '***3beat*** (get-rythm-of-3beat n) '***4beat*** (get-rythm-of-4beat
n))))
;;;
;;;(make-a-phrase-2-2 '("CM7" ion))
;;;***((((CM7 ion) re mi re +do do)) ***3beat*** (4 4 16 16 8) ***4beat***
;;; (8pause 8 4 3(8pause 8pause 8) 8.5 16))
;;;nil
;;;(make-a-phrase-2-2 '("CM7" ion "Dm7" dor))
;;;***((((CM7 ion) re mi re mi re do) ((Dm7 dor) do fa mi re)) ***3beat*** (8 8 16 16 16 16 16 16 16 16)
;;; ***4beat*** (16 16 16 16 8 8 8 16 16 4))
;;;nil
;;;(make-a-phrase-2-2 '("CM7" ion "Dm7" dor "G7" alt))
;;;***((((CM7 ion) mi) ((Dm7 dor) mi fa) ((G7 alt) +so +la si +so +la si)) ***3beat***
;;; (3(8 8 8) 8 16 16 8 16 16) ***4beat*** (3(8pause 8 8) 4 3(8 8 8) 3(8 8 8)))
;;;
(defun make-a-phrase-2-2 (pair)
(let ((l (make-a-phrase-2-1-aux pair))
(n))
(setf n (number-of-notes l))
(format t "~%***~a" (list l '***3beat*** (get-rythm-of-3beat
n) '***4beat*** (get-rythm-of-4beat n)))))
;;;
;;;(make-phrases-2-2 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;***((((CM7 ion) re do) ((A7 hmp5) do)) ***3beat*** (8 8 2) ***4beat*** (4 4 2))
;;;***((((Dm7 dor) mi fa do) ((G7 alt) +so +la si)) ***3beat*** (8.5 16 3(8 8 8) 8pause 8) ***4beat***
;;; (3(8pause 8 8) 3(8pause 8 8) 4 3(8pause 8pause 8)))
;;;***((((CM7 ion) mi si si)) ***3beat*** (4 4.5 8) ***4beat*** (2.5 8 8))
;;;
(defun make-phrases-2-2 (l)
(do ((lst l (cdr lst)))
((null lst))
(make-a-phrase-2-2 (car lst))))
;;;
;;;(make-a-phrase-2-2-forth '("CM7" ion))
;;;***((((CM7 ion) la si re do)) ***3beat*** (8pause 8 4 3(8pause 8 8)) ***4beat*** (2 8 8 4))
;;;nil
;;;(make-a-phrase-2-2-forth '("CM7" ion "Dm7" dor))
;;;***((((CM7 ion) la so mi) ((Dm7 dor) so la do)) ***3beat*** (8pause 8 3(8pause 8pause 8) 16 16 16 16)
;;; ***4beat*** (8.5 16 8pause 8 3(8pause 8pause 8) 8 8))
;;;nil
;;;(make-a-phrase-2-2-forth '("CM7" ion "Dm7" dor "G7" alt))
;;;***((((CM7 ion) la si) ((Dm7 dor) mi fa) ((G7 alt) +so +la si)) ***3beat*** (3(8 8 8) 4 3(8 8 8))
;;; ***4beat*** (8 8 3(8 8 8) 4 4))
;;;
(defun make-a-phrase-2-2-forth (pair)
(let ((l (make-a-phrase-2-2-aux-third pair))
(n))
(setf n (number-of-notes l))
(format t "~%***~a" (list l '***3beat*** (get-rythm-of-3beat
n) '***4beat*** (get-rythm-of-4beat n)))))
;;;
;;;(make-a-phrase-2-2-forth-aux '("CM7" ion))
;;;(((("CM7" ion) la so)) ***3beat*** (4 2) ***4beat*** (4 2.5))
;;;(make-a-phrase-2-2-forth-aux '("CM7" ion "Dm7" dor))
;;;(((("CM7" ion) mi re do) (("Dm7" dor) fa)) ***3beat*** (4 4 "3(8pause 8 8)") ***4beat*** (4 4.5 4 8))
;;;(make-a-phrase-2-2-forth-aux '("CM7" ion "Dm7" dor "G7" alt))
;;;(((("CM7" ion) re do) (("Dm7" dor) mi fa) (("G7" alt) fa)) ***3beat*** (8 8 4 8 8) ***4beat*** (4 4 4 8 8))
;;;
(defun make-a-phrase-2-2-forth-aux (pair)
(let ((l (make-a-phrase-2-2-aux-third pair))
(n))
(setf n (number-of-notes l))
(list l '***3beat*** (get-rythm-of-3beat n) '***4beat*** (get-rythm-of-4beat
n))))
;;;
;;;(make-phrases-2-3 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;***((((CM7 ion) la si si) ((A7 hmp5) fa so so)) ***3beat*** (4 16 16 16 16 8pause 8) ***4beat***
;;; (16pause 16 16 16 4 4 4))
;;;***((((Dm7 dor) mi fa) ((G7 alt) +la +so so do re)) ***3beat*** (8 8 3(8 8 8) 8.5 16) ***4beat***
;;; (8 8 8 8 4 8.5 16))
;;;***((((CM7 ion) mi la so)) ***3beat*** (4.5 8 4) ***4beat*** (2 4.5 8))
;;;
(defun make-phrases-2-3 (l)
(do ((lst l (cdr lst)))
((null lst))
(make-a-phrase-2-2-forth (car lst))))
;;;
;;; (auto-comp3 *w3*) etc.
;;;
(defun auto-comp3 (wn)
(tagbody
(my-randomize)
(format t "~%********** ~a ************" (second (first wn)))
(format t "~%The original key is ~a." (first (first wn)))
(format t "~%Enter a key.")
loop1
(setf l1 (read-sentence))
(if (not (key-p (car l1)))
(go loop1))
(if (equal (car l1) (first (first wn)))
(setf l2 (cdr wn))
(setf l2 (modulate-key1-to-key2 (cdr wn) (first (first wn)) (car l1))))
(format t "~%********* The key is ~a. **********" (car l1))
(make-phrases-2 l2)))
(defun auto-comp3-2 (wn)
(tagbody
(my-randomize)
(format t "~%********** ~a ************" (second (first wn)))
(format t "~%The original key is ~a." (first (first wn)))
(format t "~%Enter a key.")
loop1
(setf l1 (read-sentence))
(if (not (key-p (car l1)))
(go loop1))
(if (equal (car l1) (first (first wn)))
(setf l2 (cdr wn))
(setf l2 (modulate-key1-to-key2 (cdr wn) (first (first wn)) (car l1))))
(format t "~%********* The key is ~a. **********" (car l1))
(make-phrases-2-2 l2)))
(defun auto-comp3-3 (wn)
(tagbody
(my-randomize)
(format t "~%********** ~a ************" (second (first wn)))
(format t "~%The original key is ~a." (first (first wn)))
(format t "~%Enter a key.")
loop1
(setf l1 (read-sentence))
(if (not (key-p (car l1)))
(go loop1))
(if (equal (car l1) (first (first wn)))
(setf l2 (cdr wn))
(setf l2 (modulate-key1-to-key2 (cdr wn) (first (first wn)) (car l1))))
(format t "~%********* The key is ~a. **********" (car l1))
(make-phrases-2-3 l2)))