(load "c:\\program files\\acl62\\music19.cl") 

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

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

(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 (pair)
　　(generate-a-phrase-of-n-notes-2 pair (1+ (random 6))))

(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"
                (generate-a-phrase-at-random-2
                    (list (first lst) (second lst))))
  　　(format t "~%~a"
                (generate-a-phrase-at-random-2
                    (list (first lst) (second lst))))
　　　(format t "~%~a"
                (generate-a-phrase-at-random-2
                    (list (first lst) (second lst))))
　　　(format t "~%~a"
                (generate-a-phrase-at-random-2
                    (list (first lst) (second lst))))
  　　(format t "~%~a"
                (generate-a-phrase-at-random-2
                    (list (first lst) (second lst))))))

(defun make-phrases-2 (l)
　　(do ((lst l (cdr lst)))
　　　　((null lst))
　　　(make-a-phrase-2 (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)))