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

;;; 
;;; (get-UST-from-a-pair '("CM7" ion)) 
;;; 
(defun get-UST-from-a-pair-2 (pair)
　　(list (first pair) 
　　　　　(assoc (second pair)
　　　　　　　　 (get-UST (first pair)))))

;;; 
;;; (get-UST-from-pairs-aux 
;;;     '("Dm7" dor "G7" alt "CM7" ion))
;;; 
(defun get-UST-from-pairs-aux (pairs)
　　(do ((lst pairs (cddr lst))
         (w)) 
　　　　((null lst) (reverse w)) 
　　　(push (get-UST-from-a-pair-2 
                 (list (first lst) 
                       (second lst)))
       w)))

(defun get-UST-from-pairs-aux-2 (pairs)
　　(do ((lst pairs (cddr lst))
         (w)) 
　　　　((null lst) (reverse w)) 
　　　(push (list (first lst)
                  (get-UST (first lst))) w)))

;;; 
;;; (get-UST-from-pairs '(("CM7" ion "A7" hmp5)
;;;                       ("Dm7" dor "G7" alt)
;;;                       ("CM7" ion)))
;;; 
(defun get-UST-from-pairs (pairs) 
　　(do ((lst pairs (cdr lst))) 
　　　　((null lst)) 
　　　(print '****************) 
　　　(print (car lst)) 
　　　(print (get-UST-from-pairs-aux
                  (car lst))))) 

(defun get-UST-from-pairs-2 (pairs)
　　(do ((lst pairs (cdr lst))) 
　　　　((null lst)) 
　　　(print '****************) 
　　　(print (car lst)) 
　　　(print (get-UST-from-pairs-aux-2
                  (car lst))))) 

;;; 
;;; (indicate-UST *w1*)
;;; 
(defun indicate-UST (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))
　　(get-UST-from-pairs l2))) 

(defun indicate-UST-2 (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))
　　(get-UST-from-pairs-2 l2)))