;;;
;;; c:\\program files\\acl62\\music28.cl
;;;
(load "c:\\program files\\acl62\\music27.cl")

(defun get-all-DC-chords-aux-1 (dominant-chord)
　　(append (get-DC0 dominant-chord) (get-DC01 dominant-chord)))

(defun get-all-DC-chords-aux-2 (dominant-chord)
　　(append (get-DC0 dominant-chord) (get-DC02 dominant-chord)))

(defun get-all-DC-chords-1-aux (dominant-chord)
　　(mapcar #'car (get-all-DC-chords-aux-2 dominant-chord)))

(defun get-all-DC-chords-2-aux (dominant-chord)
　　(mapcar #'car (get-all-DC-chords-aux-1 dominant-chord)))

(defun get-all-DC-chords-1 (dominant-chord)
　　(let ((lst (get-all-DC-chords-1-aux dominant-chord)))
　　　(append lst (mapcar #'change-a-chord-name lst))))

(defun get-all-DC-chords-2 (dominant-chord)
　　(let ((lst (get-all-DC-chords-2-aux dominant-chord)))
　　　(append lst (mapcar #'change-a-chord-name lst))))

(defun translate-and+ (sc)
　　(cond ((equal sc "-D") "+C")
　　　　　　((equal sc "-E") "+D")
　　　　　　((equal sc "-G") "+F")
　　　　　　((equal sc "-A") "+G")
　　　　　　((equal sc "-B") "+A")
　　　　　　((equal sc "+C") "-D")
　　　　　　((equal sc "+D") "-E")
　　　　　　((equal sc "+F") "-G")
　　　　　　((equal sc "+G") "-A")
　　　　　　((equal sc "+A") "-B")
　　　　　　(t sc)))

;;;
;;; (change-a-chord-name "+Cm7") ====> "-Dm7"
;;;
(defun change-a-chord-name (chord)
　　(let* ((lst (divide-a-chord chord))
　　　　　　(cha (translate-and+ (first lst)))
　　　　　　(type (second lst)))
　　　　(concatenate 'string cha type)))

(defun member-of-all-DC-chords-1 (dominant-chord chord)
　　(if (member chord (get-all-DC-chords-1 dominant-chord) :test #'equal)
　　　　dominant-chord
　　　nil))

(defun member-of-all-DC-chords-2 (dominant-chord chord)
　　(if (member chord (get-all-DC-chords-2 dominant-chord) :test #'equal)
　　　　dominant-chord
　　　nil))

(setf *dominant-chords*
　　'("C7" "+C7" "-D7" "D7" "+D7" "-E7" "E7" "F7" "+F7" "-G7" "G7"
　　　"+G7" "-A7" "A7" "+A7" "-B7" "B7"))

;;;
;;; (back-to-dominant-chords-1 "Em7") ====> (("D7" "F7" "G7" "B7") "Em7")
;;;
(defun back-to-dominant-chords-1 (chord)
　　(do ((lst *dominant-chords* (cdr lst))
　　　　　(w))
　　　　((null lst) (list (reverse w) chord))
　　　(let ((e (member-of-all-DC-chords-1 (car lst) chord)))
　　　　(if (not (null e)) (push e w)))))

(defun back-to-dominant-chords-2 (chord)
　　(do ((lst *dominant-chords* (cdr lst))
　　　　　(w))
　　　　((null lst) (list (reverse w) chord))
　　　(let ((e (member-of-all-DC-chords-2 (car lst) chord)))
　　　　(if (not (null e)) (push e w)))))

(make-frame-from-list
　　'(DC0 (G7 (value ("CM7" ion) ("-GM7" ion) ("+FM7" ion)
　　　　　　　　　　　　　("Cm7" all) ("-Gm7" all) ("+Fm7" all) ("Cm7-5" loc)
　　　　　　　　　　　　　("-Gm7-5" loc) ("+Fm7-5" loc) ("C7" all)
　　　　　　　　　　　　　("-G7" all) ("+F7" all)))))

(make-frame-from-list
　　'(DC01 (G7 (value ("Em7" phr) ("Am7" aeo) ("Em7-5" loc) ("Am7-5" loc)
　　　　　　　　　　　　　　("+Fm7-5" loc) ("-Gm7-5" loc) ("-EM7" lyd) ("+DM7" lyd)
　　　　　　　　　　　　　　("-AM7" lyd) ("+GM7" lyd) ("-DM7" lyd) ("+CM7" lyd)
　　　　　　　　　　　　　　("-BM7" lyd) ("+AM7" lyd) ("-B7" lyd-7) ("+A7" lyd-7)
　　　　　　　　　　　　　　("-Em7" dor)))))

(make-frame-from-list
　　'(DC02 (G7 (value ("Em7" phr) ("Am7" aeo) ("Em7-5" loc) ("Am7-5" loc)
　　　　　　　　　　　　　　("+Fm7-5" loc) ("-Gm7-5" loc) ("-EM7" lyd) ("+DM7" lyd)
　　　　　　　　　　　　　　("-AM7" lyd) ("+GM7" lyd) ("-DM7" lyd) ("+CM7" lyd)))))

(defun get-DC0-of-G7 () (fget-i 'DC0 'G7))
(defun get-DC01-of-G7 () (fget-i 'DC01 'G7))
(defun get-DC02-of-G7 () (fget-i 'DC02 'G7))

(defun get-DC0 (dominant-chord)
　　(modulate-key1-to-key2 (get-DC0-of-G7)
　　　　　　　　　　　　　　　　　　　'C
　　　　　　　　　　　　　　　　　　　(translate-dominant-atom (involve-atom-p dominant-chord))))

(defun get-DC01 (dominant-chord)
　　(modulate-key1-to-key2 (get-DC01-of-G7)
　　　　　　　　　　　　　　　　　　　'C
　　　　　　　　　　　　　　　　　　　(translate-dominant-atom (involve-atom-p dominant-chord))))

(defun get-DC02 (dominant-chord)
　　(modulate-key1-to-key2 (get-DC02-of-G7)
　　　　　　　　　　　　　　　　　　　'C
　　　　　　　　　　　　　　　　　　　(translate-dominant-atom (involve-atom-p dominant-chord))))