;;;
;;; c:\\progra files\\acl62\\music4.cl
;;;
(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))))