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

;;;
;;;(interpret-pairs '(("G7" alt) ("CM7" ion)))
;;;
;;;*********************************
;;;************* (G7 alt) **************
;;; ***** (G7 alt) *****
;;; chord-scale: (so +so +la si do re fa so)
;;; chord-tone: (so si re fa)
;;; tension-notes: (+so +la do re)
;;; guide-tone: (si fa)
;;; elements-of-melody: (si fa +so +la do re)
;;;
;;;*********************************
;;;************* (CM7 ion) **************
;;; ***** (CM7 ion) *****
;;; chord-scale: (do re mi fa so la si do)
;;; chord-tone: (do mi so si)
;;; tension-notes: (re la)
;;; guide-tone: (mi si)
;;; elements-of-melody: (mi si re la)
;;;
;;;nil


(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 get-all-UST (chord-name)
(rest (second (assoc 'all (get-UST chord-name)))))

(defun select-UST-at-random (pair)
(let ((l2 (get-all-UST (car pair))))
(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))))

;;;
;;;(append-two-phrases-1 4 4 '("G7" alt "CM7" ion))
;;;(("G7" alt) (fa -re -re fa) ("CM7" ion) (mi la la do))
;;;
(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)))))))