;;;
;;; c:\\program files\\acl62\\music51.cl
;;;
(load "c:\\program files\\acl62\\music50.cl")

(defun next-of-Cad (atom)
  (case atom
   (tonic (nth (random 4) '(tonic SD SDm D)))
   (SD (nth (random 4) '(tonic SD SDm D)))
   (SDm (nth (random 4) '(tonic SD SDm D)))
   (D (nth (random 2) '(tonic D)))))

(defun make-Cad (n)
  (do ((l '(tonic))
     (nn n (1- nn))
     (w))
    ((<= nn 0) (reverse l))
   (push (next-of-Cad (car l)) w)
   (setf l (cons (car w) l))))

(defun next-of-Cad-minor (atom)
  (case atom
    (Tm (nth (random 5) '(Tm SD SDm D Dm)))
    (SD (nth (random 5) '(Tm SD SDm D Dm)))
    (SDm (nth (random 5) '(Tm SD SDm D Dm)))
    (D (nth (random 3) '(Tm D Dm)))
    (Dm (nth (random 3) '(Tm D Dm)))))

(defun make-Cad-minor (n)
  (do ((l '(Tm))
     (nn n (1- nn))
     (w))
     ((<= nn 0) (reverse l))
   (push (next-of-Cad-minor (car l)) w)
   (setf l (cons (car w) l))))

(defun get-tonic (key type)
  (let ((lst (instantiate-a-key key type)))
    (cdadr (first (cdr lst)))))

(defun get-Tm (key type)
  (let ((lst (instantiate-a-key key type)))
    (cdadr (first (cdr lst)))))

(defun get-SD (key type)
  (let ((lst (instantiate-a-key key type)))
    (cdadr (second (cdr lst)))))

(defun get-SDm (key type)
  (let ((lst (instantiate-a-key key type)))
    (cdadr (third (cdr lst)))))

(defun get-D (key type)
  (let ((lst (instantiate-a-key key type)))
    (cdadr (nth 3 (cdr lst)))))

(defun get-Dm (key type)
  (let ((lst (instantiate-a-key key type)))
    (cdadr (nth 4 (cdr lst)))))

(defun get-tonic-at-random (key type)
  (let ((lst (get-tonic key type)))
    (nth (random (length lst)) lst)))

(defun get-Tm-at-random (key type)
  (let ((lst (get-Tm key type)))
    (nth (random (length lst)) lst)))

(defun get-SD-at-random (key type)
  (let ((lst (get-SD key type)))
    (nth (random (length lst)) lst)))

(defun get-SDm-at-random (key type)
  (let ((lst (get-SDm key type)))
    (nth (random (length lst)) lst)))

(defun get-D-at-random (key type)
  (let ((lst (get-D key type)))
    (nth (random (length lst)) lst)))

(defun get-Dm-at-random (key type)
  (let ((lst (get-Dm key type)))
    (nth (random (length lst)) lst)))

(defun change-Cad-to-chord (Cad key type)
  (case Cad
    (tonic (get-tonic-at-random key type))
    (SD (get-SD-at-random key type))
    (SDm (get-SDm-at-random key type))
    (D (get-D-at-random key type))))

(defun change-Cad-to-chord-minor (Cad key type)
  (case Cad
    (Tm (get-Tm-at-random key type))
    (SD (get-SD-at-random key type))
    (SDm (get-SDm-at-random key type))
    (D (get-D-at-random key type))
    (Dm (get-Dm-at-random key type))))

(defun change-Cad-to-chords (lst-of-Cad key type)
  (mapcar #'(lambda (x) (change-Cad-to-chord x key type)) lst-of-Cad))

(defun change-Cad-to-chords-minor (lst-of-Cad key type)
  (mapcar #'(lambda (x) (change-Cad-to-chord-minor x key type)) lst-of-Cad))

;;;
;;; (make-cp-from-Cad 5 'C 'major)
;;;
(defun make-cp-from-Cad (n key type)
  (change-Cad-to-chords (make-Cad n) key type))

(defun make-cp-from-Cad-minor (n key type)
  (change-Cad-to-chords-minor (make-Cad-minor n) key type))