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

(defun connect-lists-for-phrase-by-a-pair-pt (pair)
  (let ((lst (get-a-pt-at-random pair)))
    (remove (car (avoid-note pair)) 
            (connect-lists-for-phrase lst))))

(defun get-a-phrase-1-aux-pt (pair)
  (cut-list-at-length (+ (random 2) 1) 
        (connect-lists-for-phrase-by-a-pair-pt pair)))

(defun get-a-phrase-2-aux-pt (pair)
  (cut-list-at-length (+ (random 4) 1)
        (connect-lists-for-phrase-by-a-pair-pt pair)))

(defun get-a-phrase-3-aux-pt (pair)
  (cut-list-at-length (+ (random 6) 1) 
        (connect-lists-for-phrase-by-a-pair-pt pair)))

(defun get-a-phrase-4-aux-pt (pair)
  (cut-list-at-length (+ (random 8) 1) 
        (connect-lists-for-phrase-by-a-pair-pt pair)))


(defun get-a-phrase-one-aux-pt (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-pt 
                            (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-pt 
                             (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-pt
                               (list (first lst)
                                     (second lst))))))
                (push l3 w))))))



(defun get-a-phrase-two-aux-pt (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-pt 
                              (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-pt
                                (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-pt
                             (list (first lst)
                                   (second lst))))))
               (push l3 w))))))


(defun get-a-phrase-one-2-aux-pt (pair)
  (let ((l (get-a-phrase-one-aux-pt 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-pt (pair)
  (let ((l (get-a-phrase-two-aux-pt 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-pt (l)
  (do ((lst l (cdr lst))
       (w))
      ((null lst) (reverse w))
    (let ((ll (get-a-phrase-one-2-aux-pt (car lst))))
      (format t "~%~a" ll)
      (push ll w))))

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


(defun auto-comp-one-pt (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-pt l2)))


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



(defun length-of-wn (wn)
  (- (length wn) 1))

(defun select-pair-from-key (key)
  (case key
    (C '("CM7" ion))
    (F '("FM7" ion))))

(defun connect-lists-for-phrase-pt-from-key (key)
  (let ((lst (get-chordscale key 'pt)))
    (connect-lists-for-phrase lst)))

(defun get-a-phrase-1-aux-pt-from-key (key)
  (cut-list-at-length (+ (random 2) 1)
        (connect-lists-for-phrase-pt-from-key key)))

(defun get-a-phrase-2-aux-pt-from-key (key)
  (cut-list-at-length (+ (random 4) 1)
        (connect-lists-for-phrase-pt-from-key key)))

(defun get-a-phrase-3-aux-pt-from-key (key)
  (cut-list-at-length (+ (random 6) 1)
       (connect-lists-for-phrase-pt-from-key key)))

(defun get-a-phrase-4-aux-pt-from-key (key)
  (cut-list-at-length (+ (random 8) 1)
       (connect-lists-for-phrase-pt-from-key key)))

(defun get-a-phrase-one-aux-pt-from-key (key 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-pt-from-key key))))
               (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-pt-from-key key))))
               (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-pt-from-key key))))
                (push l3 w))))))



(defun get-a-phrase-two-aux-pt-from-key (key 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-pt-from-key key))))
               (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-pt-from-key key))))
               (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-pt-from-key key))))
               (push l3 w))))))


(defun get-a-phrase-one-2-aux-pt-from-key (key lst)
  (let ((l (get-a-phrase-one-aux-pt-from-key key lst))
        (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-pt-from-key (key lst)
  (let ((l (get-a-phrase-two-aux-pt-from-key key lst))
        (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-pt-from-key (key l)
  (do ((lst l (cdr lst))
       (w))
      ((null lst) (reverse w))
    (let ((ll (get-a-phrase-one-2-aux-pt-from-key
                       key (car lst))))
      (format t "~%~a" ll)
      (push ll w))))

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



;;;
;;;
;;;
(defun auto-comp-one-pt-from-key (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-pt-from-key (car l1) l2)))


(defun auto-comp-two-pt-from-key (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-pt-from-key (car l1) l2)))