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

(defun collect-chords (l)
　　(let ((lst (squash l)))
　　　(do ((ll lst (cdr ll))
　　　　　 (w)) 
　　　　　((null ll) (remove-duplicate (reverse w)))
　　　　(if (stringp (car ll)) (push (car ll) w)))))

(defun tell-chords-aux (l)
　　(let ((lst (collect-chords l)))
　　　(do ((ll lst (cdr ll))) 
　　　　　　((null ll)) 
　　　　(tell-a-chord (car ll)))))

;;; 
;;; (tell-chords *w1*)
;;; 
(defun tell-chords (wn)
　　(tagbody 
　　　(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)) 
　　　(tell-chords-aux l2)))

(defun tell-chords-2 (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))
　　　(tell-pairs-aux (remove-duplicate l2))))