;;;
;;; c:\\program files\\acl62\\music9.cl
;;;
(load "c:\\program files\\acl62\\music8.cl")
(defun interpret-a-work (wn)
(tagbody
(my-randomize)
(format t "~%***** ~a *****"
(second (first wn)))
(format t "~%The original key is ~a."
(first (first wn)))
(format t "~%Entey 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))
(interpret-pairs l2)))
(defun key-p (c)
(if (member c '(C +C -D D
+D -E E F
+F -G G +G
-A A +A -B B
c +c -d d
+d -e e f
+f -g g +g
-a a +a -b b))
t
nil))
;;;
;;;
;;;
(defun select-UST-at-random (pair)
(let* ((l1 (assoc (second pair)
(UST pair)))
(l2 (rest (second l1))))
(nth (random (length l2)) l2)))
(defun make-a-phrase-with-UST-at-random (pair)
(get-notes-from-UST-at-random
(select-UST-at-random pair)))
;;;
;;;
;;;
(defun get-a-phrase-at-random-aux (pair)
(case (random 4)
(0 (get-elements-of-melody-at-random
pair))
(1 (make-a-phrase-with-UST-at-random
pair))
(2 (make-a-phrase-with-scale-from-tension
pair))
(3 (make-a-phrase-with-scale-from-elm
pair))))
(defun get-a-phrase-at-random-2-aux (pair)
(case (random 4)
(0 (get-elements-of-melody-at-random-2
pair))
(1 (get-notes-from-UST-at-random-2
pair))
(2 (make-a-phrase-with-scale-from-tension-2
pair))
(3 (make-a-phrase-with-scale-from-elm-2
pair))))
(defun get-a-phrase-for-ballad-aux (pair)
(let ((lst (get-a-phrase-at-random-aux
pair)))
(cut-list-at-length
(nth (random 4) '(1 2 3 4)) lst)))
(defun get-a-phrase-for-waltz-aux (pair)
(let ((lst (get-a-phrase-at-random-aux pair)))
(cut-list-at-length
(nth (random 6) '(1 2 3 4 5 6)) lst)))
;;;
;;;
;;;
(defun make-a-phrase-with-scale-from-tension-2 (pair)
(do ((i 8 (1- i))
(w (rotate-a-scale-from-tension-and-cut
pair)))
((or (= i 0) (> (length w) 8))
(cut-list-at-length
(nth (random 3) '(4 6 8)) w))
(setf w
(append w
(rotate-a-scale-from-a-note-and-cut
(get-a-note-around-a-note-in-a-scale
(car (last w))
pair) pair)
))))
(defun make-a-phrase-with-scale-from-elm-2 (pair)
(do ((i 8 (1- i))
(w (rotate-a-scale-from-elm-and-cut
pair)))
((or (= i 0) (> (length w) 8))
(cut-list-at-length
(nth (random 3) '(4 6 8)) w))
(setf w (append w
(rotate-a-scale-from-a-note-and-cut
(get-a-note-around-a-note-in-a-scale
(car (last w))
pair) pair)
))))
(defun get-elements-of-melody-at-random-2 (pair)
(get-n-elements-of-melody
pair
(nth (random 3) '(4 6 8))))
(defun get-notes-from-UST-at-random-2 (pair)
(get-n-notes-from-UST
(select-UST-at-random pair)
(nth (random 3) '(4 6 8))))
;;;
;;;
;;;
(defun append-two-phrases-1 (n1 n2 pair)
(append (list (list (first pair) (second pair))
(cut-list-at-length
n1
(get-a-phrase-at-random-2-aux
(list (first pair) (second pair)))))
(list (list (third pair) (fourth pair))
(cut-list-at-length
n2
(get-a-phrase-at-random-2-aux
(list (third pair) (fourth pair)))))))
(defun append-three-phrases-1 (n1 n2 n3 pair)
(append (list (list (first pair) (second pair))
(cut-list-at-length
n1
(get-a-phrase-at-random-2-aux
(list (first pair) (second pair)))))
(list (list (third pair) (fourth pair))
(cut-list-at-length
n2
(get-a-phrase-at-random-2-aux
(list (third pair) (fourth pair)))))
(list (list (fifth pair) (sixth pair))
(cut-list-at-length
n3
(get-a-phrase-at-random-2-aux
(list (fifth pair) (sixth pair)))))))
(defun append-four-phrases-1 (n1 n2 n3 n4 pair)
(append (list (list (first pair) (second pair))
(cut-list-at-length
n1
(get-a-phrase-at-random-2-aux
(list (first pair) (second pair)))))
(list (list (third pair) (fourth pair))
(cut-list-at-length
n2
(get-a-phrase-at-random-2-aux
(list (third pair) (fourth pair)))))
(list (list (fifth pair) (sixth pair))
(cut-list-at-length
n3
(get-a-phrase-at-random-2-aux
(list (fifth pair) (sixth pair)))))
(list (list (seventh pair) (eighth pair))
(cut-list-at-length
n4
(get-a-phrase-at-random-2-aux
(list (seventh pair) (eighth pair))
)))))
(defun get-a-phrase-at-random (pair)
(case (length pair)
(2 (list pair (get-a-phrase-at-random-aux pair)))
(4 (case (nth (random 14) '(1 2 3 4 5 6 7
8 9 10 11 12 13 14))
(1 (append-two-phrases-1 1 1 pair))
(2 (append-two-phrases-1 1 2 pair))
(3 (append-two-phrases-1 2 1 pair))
(4 (append-two-phrases-1 2 2 pair))
(5 (append-two-phrases-1 2 3 pair))
(6 (append-two-phrases-1 3 2 pair))
(7 (append-two-phrases-1 3 3 pair))
(8 (append-two-phrases-1 4 3 pair))
(9 (append-two-phrases-1 3 4 pair))
(10 (append-two-phrases-1 4 4 pair))
(11 (append-two-phrases-1 1 1 pair))
(12 (append-two-phrases-1 2 2 pair))
(13 (append-two-phrases-1 3 3 pair))
(14 (append-two-phrases-1 4 4 pair))))
(6 (case (nth (random 18) '(1 2 3 4 5 6 7
8 9 10 11 12 13
14 15 16 17 18))
(1 (append-three-phrases-1 1 1 1 pair))
(2 (append-three-phrases-1 2 1 1 pair))
(3 (append-three-phrases-1 1 2 1 pair))
(4 (append-three-phrases-1 1 1 2 pair))
(5 (append-three-phrases-1 2 2 1 pair))
(6 (append-three-phrases-1 2 1 2 pair))
(7 (append-three-phrases-1 1 2 2 pair))
(8 (append-three-phrases-1 2 2 2 pair))
(9 (append-three-phrases-1 2 2 3 pair))
(10 (append-three-phrases-1 2 3 2 pair))
(11 (append-three-phrases-1 3 2 2 pair))
(12 (append-three-phrases-1 2 3 3 pair))
(13 (append-three-phrases-1 3 2 3 pair))
(14 (append-three-phrases-1 3 3 2 pair))
(15 (append-three-phrases-1 1 1 1 pair))
(16 (append-three-phrases-1 1 1 1 pair))
(17 (append-three-phrases-1 2 2 2 pair))
(18 (append-three-phrases-1 2 2 2 pair))))
(8 (case (nth (random 30) '(1 2 3 4 5 6 7 8
9 10 11 12 13 14
15 16 17 18 19 20
21 22 23 24 25 26
27 28 29 30))
(1 (append-four-phrases-1 1 1 1 1 pair))
(2 (append-four-phrases-1 2 1 1 1 pair))
(3 (append-four-phrases-1 1 2 1 1 pair))
(4 (append-four-phrases-1 1 1 2 1 pair))
(5 (append-four-phrases-1 1 1 1 2 pair))
(6 (append-four-phrases-1 2 2 1 1 pair))
(7 (append-four-phrases-1 2 1 2 1 pair))
(8 (append-four-phrases-1 2 1 1 2 pair))
(9 (append-four-phrases-1 1 2 2 1 pair))
(10 (append-four-phrases-1 1 2 1 2 pair))
(11 (append-four-phrases-1 1 1 2 2 pair))
(12 (append-four-phrases-1 2 2 2 1 pair))
(13 (append-four-phrases-1 2 2 1 2 pair))
(14 (append-four-phrases-1 2 1 2 2 pair))
(15 (append-four-phrases-1 1 2 2 2 pair))
(16 (append-four-phrases-1 2 2 2 2 pair))
(17 (append-four-phrases-1 1 1 1 1 pair))
(18 (append-four-phrases-1 1 1 1 1 pair))
(19 (append-four-phrases-1 1 1 1 1 pair))
(20 (append-four-phrases-1 1 1 1 1 pair))
(21 (append-four-phrases-1 1 1 1 1 pair))
(22 (append-four-phrases-1 2 1 1 1 pair))
(23 (append-four-phrases-1 1 2 1 1 pair))
(24 (append-four-phrases-1 2 2 2 1 pair))
(25 (append-four-phrases-1 2 2 1 2 pair))
(26 (append-four-phrases-1 2 2 2 2 pair))
(27 (append-four-phrases-1 2 2 2 2 pair))
(28 (append-four-phrases-1 2 2 2 2 pair))
(29 (append-four-phrases-1 2 2 2 2 pair))
(30 (append-four-phrases-1 2 2 2 2 pair))))))
(defun get-a-phrase-at-random-2 (pair)
(case (length pair)
(2 (list pair (get-a-phrase-at-random-2-aux pair)))
(4 (case (nth (random 3) '(1 2 3))
(1 (append-two-phrases-1 2 2 pair))
(2 (append-two-phrases-1 3 3 pair))
(3 (append-two-phrases-1 4 4 pair))))
(6 (case (nth (random 9) '(1 2 3 4 5 6 7 8 9))
(1 (append-three-phrases-1 2 1 1 pair))
(2 (append-three-phrases-1 1 2 1 pair))
(3 (append-three-phrases-1 1 1 2 pair))
(4 (append-three-phrases-1 2 2 2 pair))
(5 (append-three-phrases-1 2 3 3 pair))
(6 (append-three-phrases-1 3 2 3 pair))
(7 (append-three-phrases-1 3 3 2 pair))
(8 (append-three-phrases-1 2 2 2 pair))
(9 (append-three-phrases-1 2 2 2 pair))))
(8 (case (nth (random 18) '(1 2 3 4 5 6 7 8
9 10 11 12 13 14
15 16 17 18))
(1 (append-four-phrases-1 1 1 1 1 pair))
(2 (append-four-phrases-1 1 1 1 1 pair))
(3 (append-four-phrases-1 1 1 1 1 pair))
(4 (append-four-phrases-1 1 1 1 1 pair))
(5 (append-four-phrases-1 1 1 1 1 pair))
(6 (append-four-phrases-1 1 1 1 1 pair))
(7 (append-four-phrases-1 2 2 1 1 pair))
(8 (append-four-phrases-1 2 1 2 1 pair))
(9 (append-four-phrases-1 2 1 1 2 pair))
(10 (append-four-phrases-1 1 2 2 1 pair))
(11 (append-four-phrases-1 1 2 1 2 pair))
(12 (append-four-phrases-1 1 1 2 2 pair))
(13 (append-four-phrases-1 2 2 2 2 pair))
(14 (append-four-phrases-1 2 2 2 2 pair))
(15 (append-four-phrases-1 2 2 2 2 pair))
(16 (append-four-phrases-1 2 2 2 2 pair))
(17 (append-four-phrases-1 2 2 2 2 pair))
(18 (append-four-phrases-1 2 2 2 2 pair))))))
(defun get-a-phrase-for-ballad (pair)
(case (length pair)
(2 (list pair (get-a-phrase-for-ballad-aux pair)))
(4 (case (nth (random 6) '(1 2 3 4 5 6))
(1 (append-two-phrases-1 1 1 pair))
(2 (append-two-phrases-1 1 1 pair))
(3 (append-two-phrases-1 1 2 pair))
(4 (append-two-phrases-1 2 1 pair))
(5 (append-two-phrases-1 2 2 pair))
(6 (append-two-phrases-1 2 2 pair))))
(6 (case (nth (random 6) '(1 2 3 4 5 6))
(1 (append-three-phrases-1 1 1 1 pair))
(2 (append-three-phrases-1 1 1 1 pair))
(3 (append-three-phrases-1 1 1 1 pair))
(4 (append-three-phrases-1 2 1 1 pair))
(5 (append-three-phrases-1 1 2 1 pair))
(6 (append-three-phrases-1 1 1 2 pair))))
(8 (append-four-phrases-1 1 1 1 1 pair))))
(defun get-a-phrase-for-waltz (pair)
(case (length pair)
(2 (list pair
(get-a-phrase-for-waltz-aux pair)))
(4 (case (nth (random 10) '(1 2 3 4 5
6 7 8 9 10))
(1 (append-two-phrases-1 1 1 pair))
(2 (append-two-phrases-1 1 1 pair))
(3 (append-two-phrases-1 1 2 pair))
(4 (append-two-phrases-1 2 1 pair))
(5 (append-two-phrases-1 2 2 pair))
(6 (append-two-phrases-1 2 2 pair))
(7 (append-two-phrases-1 2 3 pair))
(8 (append-two-phrases-1 3 2 pair))
(9 (append-two-phrases-1 3 3 pair))
(10 (append-two-phrases-1 3 3 pair))))
(6 (case (nth (random 12) '(1 2 3 4 5 6 7
8 9 10 11 12))
(1 (append-three-phrases-1 1 1 1 pair)
(2 (append-three-phrases-1 1 1 1 pair))
(3 (append-three-phrases-1 1 1 1 pair))
(4 (append-three-phrases-1 2 1 1 pair))
(5 (append-three-phrases-1 1 2 1 pair))
(6 (append-three-phrases-1 1 1 2 pair))
(7 (append-three-phrases-1 2 2 1 pair))
(8 (append-three-phrases-1 2 1 2 pair))
(9 (append-three-phrases-1 1 2 2 pair))
(10 (append-three-phrases-1 2 2 2 pair))
(11 (append-three-phrases-1 2 2 2 pair))
(12 (append-three-phrases-1 2 2 2 pair))))
(8 (case (nth (random 18) '(1 2 3 4 5 6 7 8
9 10 11 12 13 14
15 16 17 18))
(1 (append-four-phrases-1 1 1 1 1 pair))
(2 (append-four-phrases-1 1 1 1 1 pair))
(3 (append-four-phrases-1 1 1 1 1 pair))
(4 (append-four-phrases-1 1 1 1 1 pair))
(5 (append-four-phrases-1 1 1 1 1 pair))
(6 (append-four-phrases-1 1 1 1 1 pair))
(7 (append-four-phrases-1 2 1 1 1 pair))
(8 (append-four-phrases-1 1 2 1 1 pair))
(9 (append-four-phrases-1 1 1 2 1 pair))
(10 (append-four-phrases-1 1 1 1 2 pair))
(11 (append-four-phrases-1 1 2 1 1 pair))
(12 (append-four-phrases-1 1 1 2 1 pair))
(13 (append-four-phrases-1 2 2 1 1 pair))
(14 (append-four-phrases-1 2 1 2 1 pair))
(15 (append-four-phrases-1 2 1 1 2 pair))
(16 (append-four-phrases-1 1 2 2 1 pair))
(17 (append-four-phrases-1 1 2 1 2 pair))
(18 (append-four-phrases-1 1 1 2 2 pair))))))
|