;;;
;;; 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))))))