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

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



(defun make-phrase-for-ballad-and-waltz (pair)
  (append (make-a-phrase-for-ballad pair)
          (make-a-phrase-for-waltz pair)))

(defun make-phrase-for-ballad-and-waltz-2 (pair)
  (append (make-a-phrase-for-ballad-second pair)
          (make-a-phrase-for-waltz-second pair)))


(defun choose-a-phrase-one (pair)
  (case (random 16)
    (0 (list 'scale-1 
             (get-a-phrase-one-2-aux pair)))
    (1 (list 'scale-2 
             (get-a-phrase-one-2-aux-div2 pair)))
    (2 (list 'scale-3 
             (get-a-phrase-one-2-aux-div3 pair)))
    (3 (list 'scale-4 
             (get-a-phrase-one-2-aux-div4 pair)))
    (4 (list 'pt 
             (get-a-phrase-one-2-aux-pt pair)))
    (5 (list '4th 
             (get-a-phrase-one-2-aux-4th pair)))
    (6 (list 'UST 
             (get-a-phrase-one-2-aux-UST pair)))
    (7 (list 'chord 
             (get-a-phrase-one-2-aux-chord pair)))
    (8 (list 'lhv 
             (get-a-phrase-one-2-aux-lhv pair)))
    (9 (list '37th 
             (get-a-phrase-one-2-aux-3-7 pair)))
    (10 (list '7th 
             (get-a-phrase-one-2-aux-7 pair)))
    (11 (list 'comp2 
             (make-a-phrase-1-2-aux pair)))
    (12 (list 'comp3 
             (make-a-phrase-2-2-aux pair)))
    (13 (list 'song 
             (make-a-phrase-for-song-1 pair)))
    (14 (list 'ballad-waltz
        (make-phrase-for-ballad-and-waltz-2 pair)))
    (15 (list 'chromatic
        (get-a-phrase-one-2-aux-chromatic pair)))))


(defun choose-a-phrase-two (pair)
  (case (random 16)
    (0 (list 'scale-1 
             (get-a-phrase-two-2-aux pair)))
    (1 (list 'scale-2 
             (get-a-phrase-two-2-aux-div2 pair)))
    (2 (list 'scale-3 
             (get-a-phrase-two-2-aux-div3 pair)))
    (3 (list 'scale-4 
             (get-a-phrase-two-2-aux-div4 pair)))
    (4 (list 'pt 
             (get-a-phrase-two-2-aux-pt pair)))
    (5 (list '4th 
             (get-a-phrase-two-2-aux-4th pair)))
    (6 (list 'UST 
             (get-a-phrase-two-2-aux-UST pair)))
    (7 (list 'chord 
             (get-a-phrase-two-2-aux-chord pair)))
    (8 (list 'lhv 
             (get-a-phrase-two-2-aux-lhv pair)))
    (9 (list '37th
             (get-a-phrase-two-2-aux-3-7 pair)))
    (10 (list '7th
             (get-a-phrase-two-2-aux-7 pair)))
    (11 (list 'comp2 
              (make-a-phrase-1-2-aux-third pair)))
    (12 (list 'comp3 
              (make-a-phrase-2-2-forth-aux pair)))
    (13 (list 'song 
              (make-a-phrase-for-song-2 pair)))
    (14 (list 'ballad-waltz 
        (make-phrase-for-ballad-and-waltz pair)))
    (15 (list 'chromatic 
        (get-a-phrase-two-2-aux-chromatic pair)))))



(defun choose-phrases-one (l)
  (do ((lst l (cdr lst))
       (w))
      ((null lst))
    (let ((ll (choose-a-phrase-one (car lst))))
      (format t "~%~a" ll)
      (push ll w))))

(defun choose-phrases-two (l)
  (do ((lst l (cdr lst))
       (w))
      ((null lst))
    (let ((ll (choose-a-phrase-two (car lst))))
      (format t "~%~a" ll)
      (push ll w))))


(defun auto-comp-mix-one (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)
    (choose-phrases-one l2)))


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