(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))))