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