;;;
;;; c:\\program files\\acl62\\music36.cl
;;;
(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))))