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

;;;
;;;(chord-tone '("CM7" ion))--->(do mi so si)
;;;
(defun connect-lists-for-phrase-by-a-pair-chord (pair)
　　(let ((lst (chord-tone pair)))
　　　(remove (car (avoid-note pair)) (connect-lists-for-phrase lst))))

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

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

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

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


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



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


(defun get-a-phrase-one-2-aux-chord (pair)
　　(let ((l (get-a-phrase-one-aux-chord 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-chord (pair)
　　(let ((l (get-a-phrase-two-aux-chord pair))
　　　　　(n))
　　　　(setf n (number-of-notes l))
　　　　(list l '***4beat*** (get-rythm-of-4beat n) '***3beat*** (get-rythm-of-3beat n))))


;;;
;;;(get-phrases-one-chord '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) mi do si) ((A7 hmp5) so mi mi so)) ***4beat*** (8 8 8.5 16 3(8pause 8 8) 3(8pause 8pause 8))
;;; ***3beat*** (4 3(8pause 8 8) 16 16 16 16))
;;;((((Dm7 dor) la do) ((G7 alt) so fa re)) ***4beat*** (4 8.5 16 8pause 8 3(8pause 8pause 8)) ***3beat***
;;; (4 4 16 16 8))
;;;((((CM7 ion) so mi do)) ***4beat*** (4 4 2) ***3beat*** (2 8 8))
;;;((((("CM7" ion) mi do si) (("A7" hmp5) so mi mi so)) ***4beat***
;;; (8 8 8.5 16 "3(8pause 8 8)" "3(8pause 8pause 8)") ***3beat*** (4 "3(8pause 8 8)" 16 16 16 16))
;;; (((("Dm7" dor) la do) (("G7" alt) so fa re)) ***4beat*** (4 8.5 16 8pause 8 "3(8pause 8pause 8)")
;;; ***3beat*** (4 4 16 16 8))
;;; (((("CM7" ion) so mi do)) ***4beat*** (4 4 2) ***3beat*** (2 8 8)))
;;;
;;;(get-phrases-two-chord '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) mi do si so) ((A7 hmp5) mi la so mi)) ***4beat*** (3(8pause 8pause 8) 16 16 16 16 8 8 4)
;;; ***3beat*** (16 16 16 16 8 16 16 8pause 8))
;;;((((Dm7 dor) fa re) ((G7 alt) re si)) ***4beat*** (4 8 8 2) ***3beat*** (3(8pause 8 8) 4 4))
;;;((((CM7 ion) so si do mi)) ***4beat*** (4 4 4 4) ***3beat*** (4 4 8 8))
;;;((((("CM7" ion) mi do si so) (("A7" hmp5) mi la so mi)) ***4beat*** ("3(8pause 8pause 8)" 16 16 16 16 8 8 4)
;;; ***3beat*** (16 16 16 16 8 16 16 8pause 8))
;;; (((("Dm7" dor) fa re) (("G7" alt) re si)) ***4beat*** (4 8 8 2) ***3beat*** ("3(8pause 8 8)" 4 4))
;;; (((("CM7" ion) so si do mi)) ***4beat*** (4 4 4 4) ***3beat*** (4 4 8 8)))
;;;
(defun get-phrases-one-chord (l)
　　(do ((lst l (cdr lst))
　　　　　(w))
　　　　　((null lst) (reverse w))
　　　　(let ((ll (get-a-phrase-one-2-aux-chord (car lst))))
　　　　　(format t "~%~a" ll)
　　　　　(push ll w))))

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


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


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