;;;
;;; (load "c:\\program files\\acl62\\music69.cl")
;;;
(load "c:\\program files\\acl62\\music68.cl")
(defun connect-lists-for-phrase-by-a-pair-div (pair)
(let ((lst (butlast (chord-scale pair))))
(remove (car (avoid-note pair)) (connect-lists-for-phrase lst))))
(defun divide-a-list-into-two-parts-sec (l)
(do ((lst l (cdr lst))
(w1)
(w2))
((null lst) w1)
(let ((note (car lst)))
(case (random 2)
(0 (push note w1))
(1 (push note w2))))))
(defun divide-a-list-into-three-parts-sec (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3))
((null lst) w1)
(let ((note (car lst)))
(case (random 3)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))))))
(defun divide-a-list-into-four-parts-sec (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3)
(w4))
((null lst) w1)
(let ((note (car lst)))
(case (random 4)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))
(3 (push note w4))))))
(defun get-a-phrase-1-aux-div2 (pair)
(cut-list-at-length (+ (random 2) 1)
(divide-a-list-into-two-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-2-aux-div2 (pair)
(cut-list-at-length (+ (random 4) 1)
(divide-a-list-into-two-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-3-aux-div2 (pair)
(cut-list-at-length (+ (random 6) 1)
(divide-a-list-into-two-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-4-aux-div2 (pair)
(cut-list-at-length (+ (random 8) 1)
(divide-a-list-into-two-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-1-aux-div3 (pair)
(cut-list-at-length (+ (random 2) 1)
(divide-a-list-into-three-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-2-aux-div3 (pair)
(cut-list-at-length (+ (random 4) 1)
(divide-a-list-into-three-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-3-aux-div3 (pair)
(cut-list-at-length (+ (random 6) 1)
(divide-a-list-into-three-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-4-aux-div3 (pair)
(cut-list-at-length (+ (random 8) 1)
(divide-a-list-into-three-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-1-aux-div4 (pair)
(cut-list-at-length (+ (random 2) 1)
(divide-a-list-into-four-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-2-aux-div4 (pair)
(cut-list-at-length (+ (random 4) 1)
(divide-a-list-into-four-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-3-aux-div4 (pair)
(cut-list-at-length (+ (random 6) 1)
(divide-a-list-into-four-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-4-aux-div4 (pair)
(cut-list-at-length (+ (random 8) 1)
(divide-a-list-into-four-parts-sec
(connect-lists-for-phrase-by-a-pair-div pair))))
(defun get-a-phrase-one-aux-div2 (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-div2 (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-div2 (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-div2 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-two-aux-div2 (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-div2 (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-div2 (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-div2 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-one-aux-div3 (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-div3 (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-div3 (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-div3 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-two-aux-div3 (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-div3 (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-div3 (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-div3 (list (first lst) (second
lst))))))
(push l3 w))))))
(defun get-a-phrase-one-aux-div4 (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-div4 (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-div4 (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-div4 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-two-aux-div4 (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-div4 (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-div4 (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-div4 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-one-2-aux-div2 (pair)
(let ((l (get-a-phrase-one-aux-div2 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-div2 (pair)
(let ((l (get-a-phrase-two-aux-div2 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-div3 (pair)
(let ((l (get-a-phrase-one-aux-div3 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-div3 (pair)
(let ((l (get-a-phrase-two-aux-div3 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-div4 (pair)
(let ((l (get-a-phrase-one-aux-div4 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-div4 (pair)
(let ((l (get-a-phrase-two-aux-div4 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-div2 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) so la) ((A7 hmp5) la mi so la)) ***4beat*** (8 8 4 8.5 16 4) ***3beat***
;;; (3(8pause 8pause 8) 16 16 16 16 4))
;;;((((Dm7 dor) la re so) ((G7 alt) +do so si +so so so)) ***4beat***
;;; (4 3(8pause 8pause 8) 16pause 16 16 16 16 16 16 16) ***3beat*** (8.5 16 16 16 8 16 16 16 16))
;;;((((CM7 ion) la mi so si so do)) ***4beat*** (4 4 4 8 16 16) ***3beat*** (8pause 8 4 16 16 16 16))
;;;
;;;(get-phrases-two-div2 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) la la do so) ((A7 hmp5) fa so la)) ***4beat*** (8.5 16 8 8 4 3(8pause 8 8)) ***3beat***
;;; (8.5 16 3(8pause 8 8) 3(8 8 8)))
;;;((((Dm7 dor) do la re mi) ((G7 alt) +do)) ***4beat*** (3(8pause 8 8) 4 4 4) ***3beat*** (4 16 16 8 4))
;;;((((CM7 ion) do so so)) ***4beat*** (4 4 2) ***3beat*** (2 8 8))
;;;
;;;(get-phrases-one-div3 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) la mi re so) ((A7 hmp5) fa so)) ***4beat*** (3(8pause 8pause 8) 4 4 16pause 16 16 16)
;;; ***3beat*** (16 16 16 16 4 4))
;;;((((Dm7 dor) do fa la re) ((G7 alt) fa so +re si +la +do)) ***4beat*** (8.5 16 16 16 16 16 8 8 8.5 16)
;;; ***3beat*** (8 8 16 16 16 16 16 16 16 16))
;;;((((CM7 ion) la mi)) ***4beat*** (2 2) ***3beat*** (4 2))
;;;
;;;(get-phrases-two-div3 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) do la) ((A7 hmp5) fa la do do)) ***4beat*** (4 4 3(8pause 8 8) 3(8pause 8 8)) ***3beat***
;;; (4 3(8pause 8 8) 16 16 8))
;;;((((Dm7 dor) la do) ((G7 alt) +so +la)) ***4beat*** (8 8 2 4) ***3beat*** (4 8pause 8 3(8pause 8 8)))
;;;((((CM7 ion) la mi si so re re)) ***4beat*** (3(8pause 8pause 8) 3(8pause 8pause 8) 3(8pause 8 8) 8 8)
;;; ***3beat*** (3(8pause 8 8) 4 8 16 16))
;;;
;;;(get-phrases-one-div4 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) re si la si si la) ((A7 hmp5) +la so)) ***4beat***
;;; (3(8 8 8) 3(8pause 8pause 8) 8pause 8 3(8 8 8)) ***3beat*** (8 8 3(8pause 8 8) 16 16 16 16))
;;;((((Dm7 dor) re la do mi mi la) ((G7 alt) +la +re +so)) ***4beat*** (16 16 16 16 4 4 3(8 8 8)) ***3beat***
;;; (3(8pause 8 8) 8 16 16 16 16 16 16))
;;;((((CM7 ion) la re re la so)) ***4beat*** (4 4 8pause 8 8.5 16) ***3beat*** (16 16 8 4 4))
;;;
;;;(get-phrases-two-div4 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) re do la do) ((A7 hmp5) so la)) ***4beat*** (3(8pause 8 8) 4 4 8 8) ***3beat***
;;; (8.5 16 3(8 8 8) 3(8pause 8pause 8)))
;;;((((Dm7 dor) la so) ((G7 alt) +so +so)) ***4beat*** (4 2 8 8) ***3beat*** (4 4 8 8))
;;;((((CM7 ion) do la)) ***4beat*** (4 2.5) ***3beat*** (4 2))
;;;
(defun get-phrases-one-div2 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-one-2-aux-div2 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-two-div2 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-two-2-aux-div2 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-one-div3 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-one-2-aux-div3 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-two-div3 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-two-2-aux-div3 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-one-div4 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-one-2-aux-div4 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-two-div4 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-two-2-aux-div4 (car lst))))
(format t "~%~a" ll)
(push ll w))))
;;;
;;;
;;;
(defun auto-comp-one-div2 (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-div2 l2)))
(defun auto-comp-two-div2 (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-div2 l2)))
(defun auto-comp-one-div3 (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-div3 l2)))
(defun auto-comp-two-div3 (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-div3 l2)))
(defun auto-comp-one-div4 (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-div4 l2)))
(defun auto-comp-two-div4 (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-div4 l2)))