;;;
;;; c:\\program files\\acl62\\music22.cl
;;;
(load "c:\\program files\\acl62\\music21.cl")

(defun make-a-phrase-1-3 (l)
  (let ((num (length l)))
    (case num
      (2 (do ((lst l (cddr lst))
           (w))
          ((null lst) w)
         (setf w (cut-list-at-length
               (1+ (random 8))
               (squash (generate-a-phrase-at-random (list (first lst) (second lst))))))))
      (4 (do ((lst l (cddr lst))
           (w))
           ((null lst) w)
         (setf w (append w
                    (cut-list-at-length
                    (1+ (random 4))
                    (squash (generate-a-phrase-at-random (list (first lst) (second lst)))))))))
      (6 (do ((lst l (cddr lst))
           (w))
           ((null lst) w)
         (setf w (append w
                   (cut-list-at-length
                   (1+ (random 3))
                   (squash (generate-a-phrase-at-random (list (first lst) (second lst))))))))))))

(defun make-a-phrase-2-3 (l)
  (let ((num (length l)))
    (case num
      (2 (do ((lst l (cddr lst))
           (w))
           ((null lst) w)
         (setf w (cut-list-at-length
               (1+ (random 8))
               (squash (generate-a-phrase-at-random-2 (list (car lst) (cadr lst))))))))
      (4 (do ((lst l (cddr lst))
           (w))
           ((null lst) w)
         (setf w (append w
                    (cut-list-at-length
                    (1+ (random 4))
                    (squash (generate-a-phrase-at-random-2 (list (car lst) (cadr lst)))))))))
      (6 (do ((lst l (cddr lst))
           (w))
           ((null lst) w)
         (setf w (append w
                    (cut-list-at-length
                    (1+ (random 3))
                    (squash (generate-a-phrase-at-random-2 (list (car lst) (cadr lst))))))))))))

(defun make-a-phrase-for-ballad (l)
  (let* ((l1 (make-a-phrase-1-3 l))
      (l2 (make-a-phrase-2-3 l))
      (n1 (length l1))
      (n2 (length l2))
      (r1 (get-rythm-of-4beat n1))
      (r2 (get-rythm-of-4beat n2)))
    (list (list l1 r1) (list l2 r2))))

(defun make-phrases-for-ballad (l)
  (do ((lst l (cdr lst)))
     ((null lst))
    (format t "~%*********** ~a *************" (car lst))
    (format t "~%~a" (make-a-phrase-for-ballad (car lst)))))

;;;
;;; (make-ballad *w3*)
;;;
(defun make-ballad (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))
    (make-phrases-for-ballad l2)))