;;;
;;; "c:\\program files\\acl62\\music47.cl"
;;;
(load "c:\\program files\\acl62\\music46.cl")
(setf *chords-related-to-C-major*
'(("CM7" ion) ("Em7" phr)
("Am7" aeo) ("+Fm7-5" loc)
("FM7" lyd) ("Dm7" dor)
("F7" lyd-7) ("-BM7" lyd)
("B7" alt) ("Fm7" dor)
("Dm7-5" loc+2) ("-AM7" lyd)
("-B7" lyd-7) ("-DM7" lyd)
("-A7" lyd-7)
("G7" mix lyd-7 hmp5 alt comd wt)
("Bm7-5" loc) ("-D7" lyd-7)
("Bdim7" dim)))
(setf *chords-related-to-A-minor*
'(("Am7" dor) ("AmM7" h m)
("CM7" ion lyd) ("C+M7" lyd)
("FM7" lyd) ("+Fm7-5" loc)
("DM7" lyd) ("D7" lyd-7)
("Bm7" dor-2) ("+G7" alt)
("Dm7" dor) ("Bm7-5" loc)
("G7" mix) ("-BM7" lyd)
("F7" lyd-7) ("+FmM7" dor)
("E7" mix lyd-7 hmp5 alt comd wt)
("+Gdim7" dim) ("+Gm7-5" loc)
("-B7" lyd-7) ("Em7" phr)))
(defun make-original-C-major-chord-progression ()
(my-randomize)
(let ((lst *chords-related-to-C-major*))
(do ((l lst)
(w))
((null l) (reverse w))
(let ((chord (nth (random (length l)) l)))
(push chord w)
(setf l (remove chord l))))))
(defun make-original-A-minor-chord-progression ()
(my-randomize)
(let ((lst *chords-related-to-A-minor*))
(do ((l lst)
(w))
((null l) (reverse w))
(let ((chord (nth (random (length l)) l)))
(push chord w)
(setf l (remove chord l))))))
(defun make-original-major-chord-progression (key)
(let ((lst
(make-original-C-major-chord-progression)))
(if (eq key 'C)
lst
(modulate-key1-to-key2 lst 'C key))))
(defun make-original-minor-chord-progression (key)
(let ((lst
(make-original-A-minor-chord-progression)))
(if (eq key 'A)
lst
(modulate-key1-to-key2 lst 'A key))))
(defun print-original-major-chord-progression (key)
(format t "~%***** ~a~a *****" key "-major")
(format t "~%~a" (instantiate-a-key key 'major))
(format t "~%~a"
(make-original-major-chord-progression key)))
(defun print-original-minor-chord-progression (key)
(format t "~%***** ~a~a *****" key "-minor")
(format t "~%~a" (instantiate-a-key key 'minor))
(format t "~%~a"
(make-original-minor-chord-progression key)))
(defun my-po-major-cp (key)
(print-original-major-chord-progression key))
(defun my-po-minor-cp (key)
(print-original-minor-chord-progression key))
|