;;;
;;; c:\\program files\\acl62\\music31.cl
;;;
(load "c:\\program files\\acl62\\music30.cl")

(defun make-a-phrase-with-scale-from-tension-4 (pair)
　　(cut-list-at-length (nth (random 4) '(1 2 3 4)) (make-a-phrase-with-scale-from-tension-2 pair)))

(defun make-a-phrase-with-scale-from-elm-4 (pair)
　　(cut-list-at-length (nth (random 4) '(1 2 3 4)) (make-a-phrase-with-scale-from-elm-2 pair)))

(defun get-elements-of-melody-at-random-4 (pair)
　　(cut-list-at-length (nth (random 4) '(1 2 3 4)) (get-elements-of-melody-at-random-2 pair)))

(defun make-a-phrase-with-UST-at-random-4 (pair)
　　(cut-list-at-length (nth (random 4) '(1 2 3 4)) (get-notes-from-UST-at-random-2 pair)))

;;;
;;;
;;;
(defun auto-comp1-4-aux (pair)
　　(let* ((l (make-a-phrase-with-scale-from-tension-4 pair))
　　　　　　(n (length l))
　　　　　　(r3 (get-rythm-of-3beat n))
　　　　　　(r4 (get-rythm-of-4beat n)))
　　　　(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
　　　　(read-sentence)))

(defun auto-comp2-4-aux (pair)
　　(let* ((l (make-a-phrase-with-scale-from-elm-4 pair))
　　　　　　(n (length l))
　　　　　　(r3 (get-rythm-of-3beat n))
　　　　　　(r4 (get-rythm-of-4beat n)))
　　　　(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
　　　　(read-sentence)))

(defun auto-comp3-4-aux (pair)
　　(let* ((l (get-elements-of-melody-at-random-4 pair))
　　　　　　(n (length l))
　　　　　　(r3 (get-rythm-of-3beat n))
　　　　　　(r4 (get-rythm-of-4beat n)))
　　　　(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
　　　　(read-sentence)))

(defun auto-comp4-4-aux (pair)
　　(let* ((l (make-a-phrase-with-UST-at-random-4 pair))
　　　　　　(n (length l))
　　　　　　(r3 (get-rythm-of-3beat n))
　　　　　　(r4 (get-rythm-of-4beat n)))
　　　　(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
　　　　(read-sentence)))

;;;
;;;
;;;
(defun auto-comp1-4-aux-2 (pairs)
　　(do ((lst pairs (cdr lst)))
　　　　　((null lst))
　　　　(print (car lst))
　　　　(do ((ll (car lst) (cddr ll)))
　　　　　　　((null ll))
　　　　　　(let ((l (list (first ll) (second ll))))
　　　　　　　　(print l)
　　　　　　　　(auto-comp1-4-aux l)))))

(defun auto-comp2-4-aux-2 (pairs)
　　(do ((lst pairs (cdr lst)))
　　　　　((null lst))
　　　　(print (car lst))
　　　　(do ((ll (car lst) (cddr ll)))
　　　　　　　((null ll))
　　　　　　(let ((l (list (first ll) (second ll))))
　　　　　　　　(print l)
　　　　　　　　(auto-comp2-4-aux l)))))

(defun auto-comp3-4-aux-2 (pairs)
　　(do ((lst pairs (cdr lst)))
　　　　　((null lst))
　　　　(print (car lst))
　　　　(do ((ll (car lst) (cddr ll)))
　　　　　　　((null ll))
　　　　　　(let ((l (list (first ll) (second ll))))
　　　　　　　　(print l)
　　　　　　　　(auto-comp3-4-aux l)))))

(defun auto-comp4-4-aux-2 (pairs)
　　(do ((lst pairs (cdr lst)))
　　　　　((null lst))
　　　　(print (car lst))
　　　　(do ((ll (car lst) (cddr ll)))
　　　　　　　((null ll))
　　　　　　(let ((l (list (first ll) (second ll))))
　　　　　　　　(print l)
　　　　　　　　(auto-comp4-4-aux l)))))

;;;
;;;
;;;
(defun auto-comp1-4 (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-comp1-4-aux-2 l2)))

(defun auto-comp2-4 (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-comp2-4-aux-2 l2)))

(defun auto-comp3-4 (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-comp3-4-aux-2 l2)))

(defun auto-comp4-4 (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-comp4-4-aux-2 l2)))