;;;
;;; c:\\program files\\acl62\\music12.cl
;;;
(load "c:\\program files\\acl62\\music11")

;;;
;;; (tell-a-chord "CM7(13)") etc.
;;;
(defun tell-a-chord (scn)
  (let ((cd (get-representative-chord scn)))
    (format t "~%*********** ~a ************" scn)
    (format t "~%Chord Tone ~a" (get-chord-tone scn))
    (format t "~%Guide Tone ~a" (get-guide-tone scn))
    (format t "~%UST ~a" (get-UST cd))
    (format t "~%Function of Chord ~a" (if (search-s1-in-s2 "dim7" cd)
                             "nothing"
                            (get-function-of-chord cd)))
    (format t "~%Tension Notes")
    (show-tension-notes cd)
    (format t "~%Chord Scales")
    (show-scales cd)))

(defun get-scale-name-aux (scn)
  (cond ((search-s1-in-s2 "dim7" scn)
       (remove 'all (mapcar #'car (get-UST scn))))
      (t (remove 'all (mapcar #'car (get-function-of-chord scn))))))

(defun get-scale-name (scn)
  (mapcar #'(lambda (x) (list scn x)) (get-scale-name-aux scn)))

(defun show-scales (scn)
  (let ((l (get-scale-name scn)))
   (do ((lst l (cdr lst)))
      ((null lst))
    (format t "~%~a ~a" (second (car lst)) (chord-scale (car lst))))))

(defun show-tension-notes (scn)
  (let ((l (get-scale-name scn)))
   (do ((lst l (cdr lst)))
      ((null lst))
    (format t "~%~a ~a" (second (car lst)) (tension-note (car lst))))))

(defun representative-of-chord (scn)
  (cond ((search-s1-in-s2 "7(+11 13)" scn) "7")
      ((search-s1-in-s2 "7(+9+11)" scn) "7")
      ((search-s1-in-s2 "7(-9+11)" scn) "7")
      ((search-s1-in-s2 "7(9+11)" scn) "7")
      ((search-s1-in-s2 "M7(+11)" scn) "M7")
      ((search-s1-in-s2 "mM7(11)" scn) "mM7")
      ((search-s1-in-s2 "mM7(13)" scn) "mM7")
      ((search-s1-in-s2 "7(+11)" scn) "7")
      ((search-s1-in-s2 "m7(11)" scn) "m7")
      ((search-s1-in-s2 "m7(13)" scn) "m7")
      ((search-s1-in-s2 "M7(13)" scn) "M7")
      ((search-s1-in-s2 "mM7(9)" scn) "mM7")
      ((search-s1-in-s2 "dimM7" scn) "dim7")
      ((search-s1-in-s2 "augM7" scn) "M7")
      ((search-s1-in-s2 "7sus4" scn) "7sus4")
      ((search-s1-in-s2 "(+11)" scn) "M7")
      ((search-s1-in-s2 "m(11)" scn) "m")
      ((search-s1-in-s2 "7(-9)" scn) "7")
      ((search-s1-in-s2 "madd9" scn) "m")
      ((search-s1-in-s2 "7(+9)" scn) "7")
      ((search-s1-in-s2 "7(13)" scn) "7")
      ((search-s1-in-s2 "m7(9)" scn) "m7")
      ((search-s1-in-s2 "M7(9)" scn) "M7")
      ((search-s1-in-s2 "sus4" scn) "7sus4")
      ((search-s1-in-s2 "dim7" scn) "dim7")
      ((search-s1-in-s2 "m7-5" scn) "m7-5")
      ((search-s1-in-s2 "aug7" scn) "7")
      ((search-s1-in-s2 "add9" scn) "M7")
      ((search-s1-in-s2 "7(9)" scn) "7")
      ((search-s1-in-s2 "aug" scn) "M7")
      ((search-s1-in-s2 "dim" scn) "dim7")
      ((search-s1-in-s2 "mM7" scn) "mM7")
      ((search-s1-in-s2 "m69" scn) "m7")
      ((search-s1-in-s2 "7-5" scn) "7")
      ((search-s1-in-s2 "-5" scn) "M7")
      ((search-s1-in-s2 "m7" scn) "m7")
      ((search-s1-in-s2 "M7" scn) "M7")
      ((search-s1-in-s2 "m6" scn) "m7")
      ((search-s1-in-s2 "69" scn) "M7")
      ((search-s1-in-s2 "m" scn) "m")
      ((search-s1-in-s2 "7" scn) "7")
      ((search-s1-in-s2 "6" scn) "M7")
      (t "M7")))

(defun get-representative-chord (scn)
  (concatenate 'string (string (involve-character-p scn)) (representative-of-chord scn))