(load "c:\\program files\\acl62\\music3.cl")

(make-frame-from-list
　　'(c-major (T-key (value C))
　　　　　　　(p-m-key-of-SD-key (value d))
　　　　　　　(p-m-key-of-D-key (value e))
　　　　　　　(SD-key (value F))
　　　　　　　(D-key (value G))
　　　　　　　(p-m (value a))))

(make-frame-from-list
　　'(c-minor (T-key (value c))
　　　　　　　(p-M-key-of-SD-key (value -E))
　　　　　　　(SD-key (value f))
　　　　　　　(D-key (value g))
　　　　　　　(p-M-key-of-SD-key (value -A))
　　　　　　　(p-M-key-of-D-key (value -B))))

(defun get-related-key-of-major-key (c)
　　(replace-key1-to-key2 
       (cdr (fget-frame 'c-major)) 'C c))

(defun get-related-key-of-minor-key (c)
　　(replace-key1-to-key2 
       (cdr (fget-frame 'c-minor)) 'c c))

;;; 
;;; (get-related-key 'C)
;;;
(defun get-related-key (c)
　　(cond ((upper-char-p c) 
           (get-related-key-of-major-key c))
　　　　　((lower-char-p c) 
           (get-related-key-of-minor-key c))))

;;; 
;;;*******************************************
;;;
(make-frame-from-list
　　'(DC1 (G7 (value ("Em7" phr) ("Am7" aeo)
                     ("Em7-5" loc) 
                     ("Am7-5" loc) ("+Fm7-5" loc) 
                     ("-EM7" lyd) ("-AM7" lyd) 
                     ("-DM7" lyd)))))

(make-frame-from-list
　　'(DC2 (G7 (value ("-BM7" lyd) 
                     (("-EM7" lyd) ("-AM7" lyd) 
                      ("-DM7" lyd) ("CM7" ion))))))

(make-frame-from-list
　　'(DC3 (G7 (value ("-B7" lyd-7) 
                     (("A7" lyd-7) ("-A7" lyd-7)
　　　　　　　　　　　("G7" mix lyd-7 hmp5
                            alt comd wt)
                      ("CM7" ion))))))

(make-frame-from-list
　　'(DC4 (G7 (value ("-Em7" dor) 
                     (("-A7" lyd-7) ("Dm7" dor)
　　　　　　　　　　　("G7" mix lyd-7 hmp5
                            alt comd wt)
                      ("CM7" ion))))))
;;; 
;;; 
;;;
(defun get-DC1-of-G7 () (fget-i 'DC1 'G7))
(defun get-DC2-of-G7 () (fget-i 'DC2 'G7))
(defun get-DC3-of-G7 () (fget-i 'DC3 'G7))
(defun get-DC4-of-G7 () (fget-i 'DC4 'G7))

(defun translate-dominant-atom (c)
　　(case c 
　　　　(G 'C) 
　　　　(+G '+C)(-A '-D) 
　　　　(A 'D)
　　　　(+A '+D)(-B '-E)
　　　　(B 'E)
　　　　(C 'F)
　　　　(+C '+F)(-D '-G)
　　　　(D 'G)
　　　　(+D '+G)(-E '-A)
　　　　(E 'A)
　　　　(F '-B)
　　　　(+F 'B)(-G 'B)))

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

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

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

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

;;;
;;;(get-DC "G7" 1)
;;;
(defun get-DC (dominant-chord &optional (n 1))
　　(case n (1 (get-DC1 dominant-chord))
　　　　　　(2 (get-DC2 dominant-chord))
　　　　　　(3 (get-DC3 dominant-chord))
　　　　　　(4 (get-DC4 dominant-chord))))