;;;
;;; c:\\program files\\acl62\\music23.cl
;;;
(load "c:\\program files\\acl62\\music22.cl")

(defun generate-8-elements-at-random (pair)
　　(do ((i 8 (1- i))
　　　　　(w))
　　　　　((<= i 0) (reverse w))
　　　　(push (generate-a-note-at-random pair) w)))

(defun make-a-phrase-for-waltz-2 (l)
　　(let ((num (length l)))
　　　　(case num
　　　　　　(2 (do ((lst l (cddr lst))
　　　　　　　　　　　(w))
　　　　　　　　　　　((null lst) w)
　　　　　　　　　(setf w (cut-list-at-length (1+ (random 6))
　　　　　　　　　　　　　　　　　　　(generate-8-elements-at-random (list (first lst) (second lst)))))))
　　　　　　(4 (do ((lst l (cddr lst))
　　　　　　　　　　　(w))
　　　　　　　　　　　((null lst) w)
　　　　　　　　　(setf w (append w (cut-list-at-length (1+ (random 3))
　　　　　　　　　　　　　　　　　　　　　(generate-8-elements-at-random (list (first lst) (second lst))))))))
　　　　　　(6 (do ((lst l (cddr lst))
　　　　　　　　　　　(w)) ((null lst) w)
　　　　　　　　　(setf w (append w (cut-list-at-length (1+ (random 2))
　　　　　　　　　　　　　　　　　　　　　(generate-8-elements-at-random (list (first lst) (second lst)))))))))))

(defun make-a-phrase-for-ballad-2 (l)
　　(let ((num (length l)))
　　　　(case num
　　　　　　(2 (do ((lst l (cddr lst))
　　　　　　　　　　　(w))
　　　　　　　　　　　((null lst) w)
　　　　　　　　　(setf w (cut-list-at-length (1+ (random 8))
　　　　　　　　　　　　　　　　　　　　(generate-8-elements-at-random (list (first lst) (second lst)))))))
　　　　　　(4 (do ((lst l (cddr lst))
　　　　　　　　　　　(w))
　　　　　　　　　　　((null lst) w)
　　　　　　　　　(setf w (append w (cut-list-at-length (1+ (random 4))
　　　　　　　　　　　　　　　　　　　　　(generate-8-elements-at-random (list (first lst) (second lst))))))))
　　　　　　(6 (do ((lst l (cddr lst))
　　　　　　　　　　　(w))
　　　　　　　　　　　((null lst) w)
　　　　　　　　　(setf w (append w (cut-list-at-length (1+ (random 3))
　　　　　　　　　　　　　　　　　　　　　(generate-8-elements-at-random (list (first lst) (second lst)))))))))))

(defun make-a-phrase-for-song (l)
　　(let* ((l1 (make-a-phrase-for-waltz-2 l))
　　　　　　(l2 (make-a-phrase-for-ballad-2 l))
　　　　　　(n1 (length l1))
　　　　　　(n2 (length l2))
　　　　　　(r1 (get-rythm-of-3beat n1))
　　　　　　(r2 (get-rythm-of-4beat n2)))
　　　　(list (list l1 r1) (list l2 r2))))

(defun make-phrases-for-song (l)
　　　(do ((lst l (cdr lst)))
　　　　　　((null lst))
　　　　　(format t "~%*********** ~a ***********" (car lst))
　　　　　(format t "~%~a" (make-a-phrase-for-song (car lst)))))

;;;
;;; (make-song *w3*)
;;;
(defun make-song (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-for-song l2)))