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

(defun get-elements-of-melody-3 (pair)
  (translate-flat-to-sharp-in-a-list
     (append (last (chord-tone pair)) 
                   (tension-note pair))))

(defun get-20elements-in-a-list (l) 
  (do ((i 1 (1+ i))
       (w))
      ((> i 20) w)
       (push (nth (random (length l)) l) w)))

(defun get-a-phrase-1-aux-3-7 (pair)
  (cut-list-at-length (+ (random 2) 1)
    (get-20elements-in-a-list 
       (get-elements-of-melody-2 pair)))) 

(defun get-a-phrase-2-aux-3-7 (pair)
  (cut-list-at-length (+ (random 4) 1)
    (get-20elements-in-a-list 
        (get-elements-of-melody-2 pair)))) 

(defun get-a-phrase-3-aux-3-7 (pair) 
  (cut-list-at-length (+ (random 6) 1)
    (get-20elements-in-a-list 
        (get-elements-of-melody-2 pair)))) 

(defun get-a-phrase-4-aux-3-7 (pair)
   (cut-list-at-length (+ (random 8) 1)
      (get-20elements-in-a-list 
          (get-elements-of-melody-2 pair)))) 

(defun get-a-phrase-1-aux-7 (pair) 
   (cut-list-at-length (+ (random 2) 1) 
      (get-20elements-in-a-list 
          (get-elements-of-melody-3 pair)))) 

(defun get-a-phrase-2-aux-7 (pair) 
   (cut-list-at-length (+ (random 4) 1) 
      (get-20elements-in-a-list 
          (get-elements-of-melody-3 pair)))) 

(defun get-a-phrase-3-aux-7 (pair) 
   (cut-list-at-length (+ (random 6) 1)
      (get-20elements-in-a-list 
          (get-elements-of-melody-3 pair)))) 

(defun get-a-phrase-4-aux-7 (pair)
   (cut-list-at-length (+ (random 8) 1)
      (get-20elements-in-a-list 
           (get-elements-of-melody-3 pair)))) 

(defun get-a-phrase-one-aux-3-7 (l) 
   (cond ((equal (length l) 2) 
          (do ((lst l (cddr lst)) 
               (w))
              ((null lst) (reverse w))
            (let ((l1 (cons (list (first lst)
                                  (second lst))
                         (get-a-phrase-4-aux-3-7 
                            (list (first lst) 
                                  (second lst))))))
              (push l1 w))))
         ((equal (length l) 4)
          (do ((lst l (cddr lst))
               (w))
              ((null lst) (reverse w))
            (let ((l2 (cons (list 
                               (first lst)
                               (second lst))
                            (get-a-phrase-3-aux-3-7 
                               (list (first lst)
                                     (second lst))))))
              (push l2 w)))) 
         ((equal (length l) 6)
          (do ((lst l (cddr lst))
               (w))
              ((null lst) (reverse w))
            (let ((l3 (cons 
                         (list (first lst)
                               (second lst))
                         (get-a-phrase-2-aux-3-7 
                             (list (first lst)
                                   (second lst))))))
              (push l3 w)))))) 

(defun get-a-phrase-two-aux-3-7 (l)
  (cond ((equal (length l) 2)
         (do ((lst l (cddr lst))
              (w))
             ((null lst) (reverse w))
           (let ((l1 (cons 
                        (list (first lst) 
                              (second lst))
                        (get-a-phrase-3-aux-3-7
                           (list (first lst)
                                 (second lst))))))
             (push l1 w))))
         ((equal (length l) 4)
          (do ((lst l (cddr lst))
               (n2)
               (w)) 
              ((null lst) (reverse w))
            (let ((l2 (cons (list 
                              (first lst)
                              (second lst))
              (get-a-phrase-2-aux-3-7 
                   (list (first lst) 
                         (second lst))))))
             (push l2 w))))
         ((equal (length l) 6)
          (do ((lst l (cddr lst))
               (w))
              ((null lst) (reverse w))
           (let ((l3 (cons (list (first lst)
                                 (second lst))
             (get-a-phrase-1-aux-3-7 
                  (list (first lst)
                  (second lst))))))
           (push l3 w)))))) 

(defun get-a-phrase-one-aux-7 (l) 
   (cond ((equal (length l) 2)
          (do ((lst l (cddr lst))
               (w))
              ((null lst) (reverse w))
            (let ((l1 (cons (list (first lst)
                                  (second lst))
                            (get-a-phrase-4-aux-7 
                                (list (first lst)
                                      (second lst))))))
              (push l1 w))))
         ((equal (length l) 4)
          (do ((lst l (cddr lst)) 
               (w))
              ((null lst) (reverse w))
           (let ((l2 (cons (list (first lst)
                                 (second lst)) 
                           (get-a-phrase-3-aux-7 
                           (list (first lst)
                                 (second lst))))))
             (push l2 w))))
         ((equal (length l) 6)
          (do ((lst l (cddr lst))
               (w)) 
              ((null lst) (reverse w))
            (let ((l3 (cons (list (first lst)
                                  (second lst))
                            (get-a-phrase-2-aux-7
                                (list (first lst)
                                      (second lst))))))
              (push l3 w)))))) 

(defun get-a-phrase-two-aux-7 (l)
  (cond ((equal (length l) 2)
         (do ((lst l (cddr lst))
              (w))
             ((null lst) (reverse w))
           (let ((l1 (cons (list (first lst) (second lst))
                           (get-a-phrase-3-aux-7 
                               (list (first lst) 
                                     (second lst))))))
            (push l1 w))))
        ((equal (length l) 4)
         (do ((lst l (cddr lst))
              (n2)
              (w))
             ((null lst) (reverse w))
           (let ((l2 (cons (list (first lst) (second lst))
                           (get-a-phrase-2-aux-7 
                              (list (first lst)
                                    (second lst))))))
             (push l2 w))))
         ((equal (length l) 6)
          (do ((lst l (cddr lst))
               (w))
              ((null lst) (reverse w))
            (let ((l3 (cons (list (first lst) (second lst))
                            (get-a-phrase-1-aux-7
                                 (list (first lst)
                                       (second lst))))))
              (push l3 w)))))) 

(defun get-a-phrase-one-2-aux-3-7 (pair) 
  (let ((l (get-a-phrase-one-aux-3-7 pair))
        (n))
    (setf n (number-of-notes l))
    (list l '***4beat*** (get-rythm-of-4beat n) 
            '***3beat*** (get-rythm-of-3beat n))))

 (defun get-a-phrase-two-2-aux-3-7 (pair) 
   (let ((l (get-a-phrase-two-aux-3-7 pair))
         (n)) 
     (setf n (number-of-notes l))
     (list l '***4beat*** (get-rythm-of-4beat n) 
             '***3beat*** (get-rythm-of-3beat n))))

(defun get-a-phrase-one-2-aux-7 (pair)
  (let ((l (get-a-phrase-one-aux-7 pair))
        (n))
    (setf n (number-of-notes l))
    (list l '***4beat*** (get-rythm-of-4beat n) 
            '***3beat*** (get-rythm-of-3beat n)))) 

(defun get-a-phrase-two-2-aux-7 (pair) 
  (let ((l (get-a-phrase-two-aux-7 pair))
        (n))
    (setf n (number-of-notes l))
    (list l '***4beat*** (get-rythm-of-4beat n) 
            '***3beat*** (get-rythm-of-3beat n)))) 

(defun get-phrases-one-3-7 (l) 
   (do ((lst l (cdr lst)) 
        (w)) ((null lst) (reverse w)) 
     (let ((ll (get-a-phrase-one-2-aux-3-7 
                      (car lst))))
       (format t "~%~a" ll) (push ll w)))) 

(defun get-phrases-two-3-7 (l) 
  (do ((lst l (cdr lst)) 
       (w))
      ((null lst) (reverse w))
    (let ((ll (get-a-phrase-two-2-aux-3-7
                    (car lst)))) 
      (format t "~%~a" ll)
      (push ll w)))) 

(defun get-phrases-one-7 (l) 
  (do ((lst l (cdr lst)) 
       (w)) 
      ((null lst) (reverse w))
    (let ((ll (get-a-phrase-one-2-aux-7 
                  (car lst)))) 
      (format t "~%~a" ll)
      (push ll w)))) 

(defun get-phrases-two-7 (l) 
  (do ((lst l (cdr lst)) 
       (w)) 
      ((null lst) (reverse w))
    (let ((ll (get-a-phrase-two-2-aux-7 
                   (car lst)))) 
      (format t "~%~a" ll)
      (push ll w)))) 

defun auto-comp-one-3-7 (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)) 
     ;(print l2)
     (get-phrases-one-3-7 l2))) 

(defun auto-comp-two-3-7 (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))
     (get-phrases-two-3-7 l2))) 

(defun auto-comp-one-7 (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)) 
     ;(print l2)
     (get-phrases-one-7 l2))) 

(defun auto-comp-two-7 (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)) 
     (get-phrases-two-7 l2)))