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