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

(defun get-CPM-or-CPm (key)
　　(cond ((upper-char-p key)
　　　　　　　(list (list key 'Major)
　　　　　　　　　　(get-CPM-with-key-at-random key)
　　　　　　　　　　(get-related-key key)))
　　　　　　((lower-char-p key)
　　　　　　　(list (list key 'Minor)
　　　　　　　　　　(get-CPm-with-key-at-random key)
　　　　　　　　　　(get-related-key key)))))

(defun build-CP ()
　　(prog (key w r)
　　　　(my-randomize)
　　　　(setf w nil)
　　　　loop
　　　　(format t "~%The chord progression is ~a." w)
　　　　(format t "~%The length of the chord progression is ~a." (length w))
　　　　;;;
　　　　loop2
　　　　(format t "~%So far is it OK ? (y or n)")
　　　　(setf r (car (read-sentence)))
　　　　(if (not (or (eq r 'y) (eq r 'n)))
　　　　　　(go loop2))
　　　　;;;
　　　　(cond ((eq r 'n)
　　　　　　　　　(setf w (butlast w))
　　　　　　　　　(go loop))
　　　　　　　　　((eq r 'y)
　　　　　　　　　　(go next)))
　　　　next
　　　　(format t "~%Enter a key!~%")
　　　　(setf key (car (read-sentence)))
　　　　(if (or (eq key 'end) (eq key 'END))
　　　　　　(go exit))
　　　　(if (not (or (upper-char-p key)
　　　　　　　　　　　　(lower-char-p key)))
　　　　　　(go next))
　　　　exit
　　　　(cond ((or (eq key 'end)
　　　　　　　　　　　(eq key 'END))
　　　　　　　　　(return w))
　　　　　　　　(t
　　　　　　　　　(setf w (append w (list (get-CPM-or-CPm key))))
　　　　　　　　　(go loop)))))

(defun get-first-and-second-part (lst)
　　(list (first lst) (second lst)))

;;;
;;;
;;;
(defun make-chord-progression ()
　　(format t "~%~a" (mapcar #'get-first-and-second-part (build-CP))))