;;;
;;; c:\\program files\\acl62\\music10.cl
;;;
(load "c:\\program files\\acl62\\music9.cl")

(defun get-the-number-of-notes (l)
  (do ((lst l (cddr lst))
     (w))
     ((null lst) (length w))
   (setf w (append w (second lst)))))

(defun get-a-melody-at-random (pair)
  (let* ((l1 (get-a-phrase-at-random pair))
      (n1 (get-the-number-of-notes l1))
      (l2 (get-rythm-of-4beat n1)))
   (list l1 (list '4beat l2))))

(defun get-a-melody-at-random-2 (pair)
  (let* ((l1 (get-a-phrase-at-random-2 pair))
      (n1 (get-the-number-of-notes l1))
      (l2 (get-rythm-of-4beat n1)))
    (list l1 (list '4beat l2))))

(defun get-a-melody-for-ballad (pair)
  (let* ((l1 (get-a-phrase-for-ballad pair))
      (n1 (get-the-number-of-notes l1))
      (r4 (get-rythm-of-4beat n1))
      (r3 (get-rythm-of-3beat n1)))
    (list l1 (list '4beat r4) (list '3beat r3))))

(defun get-a-melody-for-waltz (pair)
  (let* ((l1 (get-a-phrase-for-waltz pair))
      (n1 (get-the-number-of-notes l1))
      (r4 (get-rythm-of-4beat n1))
      (r3 (get-rythm-of-3beat n1)))
   (list l1 (list '3beat r3) (list '4beat r4))))

;;;
;;;
;;;
(defun auto-comp-aux (pair)
  (format t "~% Melody-1 ~%~a" (get-a-melody-at-random pair))
  (format t "~% Melody-2 ~%~a" (get-a-melody-at-random-2 pair))
  (format t "~% Melody-3 ~%~a" (get-a-melody-for-ballad pair))
  (format t "~% Melody-4 ~%~a" (get-a-melody-for-waltz pair))
  (read-sentence))

(defun auto-comp-aux-2 (pairs)
  (do ((lst pairs (cdr lst)))
     ((null lst))
     (print (car lst))
     (interpret-a-pair-2 (car lst))
     (auto-comp-aux (car lst))))

(defun interpret-a-pair-aux-2 (l)
  (format t "~% ***** ~a ***** について" l)
  (format t "~% コードスケール  ~a" (chord-scale l))
  (format t "~% コード構成音 ~a" (chord-tone l))
  (format t "~% テンションノート ~a" (tension-note l))
  (format t "~% ガイドトーン ~a" (guide-tone l))
  (format t "~% 旋律の要素 ~a" (get-elements-of-melody l))
  (format t "~% UST ~a" (UST l)))

(defun interpret-a-pair-2 (l)
  (do ((lst l (cddr lst)))
     ((null lst))
   (interpret-a-pair-aux-2 (list (first lst) (second lst)))))

;;;
;;;
;;;
(defun auto-comp (wn)
  (tagbody
    (my-randomize)
    (format t "~%***** ~a *****" (second (first wn)))
    (format t "~%The original key is ~a." (first (first wn)))
    (format t "~%Enter a key.")
    loop1
    (setf l1 (read-sentence))
    (if (not (key-p (car l1))) (go loop1))
    (if (equal (car l1) (first (first wn)))
      (setf l2 (cdr wn))
     (setf l2 (modulate-key1-to-key2 (cdr wn) (first (first wn)) (car l1))))
    (format t "~%***** The key is ~a. *****" (car l1))
    (auto-comp-aux-2 l2)))

;;;
;;; (auto-comp *w1*)
;;;
(setf *w1* '((-E "When I Fall In Love")
        ("-EM7" ion "C7" hmp5) ("Fm7" dor "-B7" mix) ("-EM7" ion "C7" hmp5)
        ("Fm7" dor "-B7" mix)
        ("-EM7" ion) ("C7" alt) ("F7" lyd-7) ("-B7" mix)
        ("-EM7" ion) ("Fm7" dor "-B7" mix) ("-EM7" ion "C7" hmp5) ("Fm7" dor "C7" hmp5)
        ("Fm7" dor) ("C7" hmp5) ("Fm7" dor) ("-B7" mix)
        ("-EM7" ion "C7" hmp5) ("Fm7" dor "-B7" mix) ("-EM7" ion "C7" hmp5)
        ("Fm7" dor "-B7" mix)
        ("-EM7" ion) ("C7" alt) ("F7" lyd-7) ("-B7" mix)
        ("-EM7" ion) ("Am7-5" loc "D7" hmp5) ("Gm7" phr "C7" hmp5)
        ("Fm7" dor "-D7" lyd-7)
        ("Gm7" phr "C7" hmp5) ("Fm7" dor "-B7" mix)
        ("-EM7" ion "Edim7" dim) ("Fm7" dor "-B7" mix)
        ("-EM7" ion)))