;;;
;;; c:\\program files\\alc62\\music29.cl
;;;


(load "c:\\program files\\acl62\\music28.cl") 

(defun auto-comp1-1-aux (pair) 
  (let* ((l (make-a-phrase-with-scale-from-tension 
                   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-2-aux (pair)
  (let* ((l (make-a-phrase-with-scale-from-tension-2
                   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-1-aux (pair)
  (let* ((l (make-a-phrase-with-scale-from-elm
                   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-2-aux (pair)
  (let* ((l (make-a-phrase-with-scale-from-elm-2
                   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-1-aux (pair)
  (let* ((l (get-elements-of-melody-at-random
                  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-2-aux (pair)
  (let* ((l (get-elements-of-melody-at-random-2
                  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-1-aux (pair)
  (let* ((l (make-a-phrase-with-UST-at-random
                   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-2-aux (pair) 
  (let* ((l (get-notes-from-UST-at-random-2
                  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-1-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-1-aux l))))) 

(defun auto-comp1-2-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-2-aux l)))))

(defun auto-comp2-1-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-1-aux l)))))

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

(defun auto-comp3-1-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-1-aux l)))))

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

(defun auto-comp4-1-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-1-aux l)))))

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

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

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

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

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

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

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

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

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