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