;;;
;;; c:\\program files\\acl62\\music35.cl
;;;


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

(defun make-a-phrase-with-scale-from-tension-5 (pair) 
  (cut-list-at-length 
         (nth (random 10) '(1 2 3 4 5 6 7 8 9 10))
         (make-a-phrase-with-scale-from-tension-2
               pair)))

(defun make-a-phrase-with-scale-from-elm-5 (pair)
  (cut-list-at-length 
         (nth (random 10) '(1 2 3 4 5 6 7 8 9 10))
         (make-a-phrase-with-scale-from-elm-2
               pair)))

(defun get-elements-of-melody-at-random-5 (pair)
  (cut-list-at-length 
         (nth (random 10) '(1 2 3 4 5 6 7 8 9 10))
         (get-elements-of-melody-at-random-2 pair)))

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

;;; 
;;; 
;;; 
(defun auto-comp1-5-aux (pair)
  (let* ((l (make-a-phrase-with-scale-from-tension-5
                    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)))))

(defun auto-comp2-5-aux (pair)
  (let* ((l (make-a-phrase-with-scale-from-elm-5
                     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)))))

(defun auto-comp3-5-aux (pair)
  (let* ((l (get-elements-of-melody-at-random-5
                   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)))))

(defun auto-comp4-5-aux (pair)
  (let* ((l (make-a-phrase-with-UST-at-random-5
                    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)))))

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

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

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

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

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

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

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

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