;;;
;;; (load "c:\\program files\\acl62\\music60.cl")
;;;
(load "c:\\program files\\acl62\\music59.cl")
(make-frame-from-list
'(avoid-note (ion (value 3.5))
(dor (value 5.5))
(phr (value 1.5))
(aeo (value 5.0))
(loc (value 1.5))
(mix (value 3.5))
(mixsus4 (value 3.0))
(hmp5 (value 3.0))))
;;;
;;; (get-avoid-note 'C 'ion)--->(fa)
;;;
(defun get-avoid-note (c csn)
(translate-list-of-number-to-sound (fget-i 'avoid-note csn) (1- (translate-alphabet-to-number
c)) c))
;;;
;;;(avoid-note '("CM7" ion))--->(fa)
;;;(avoid-note '("G7" alt))--->nil
;;;(avoid-note '("CM7" lyd))--->nil
;;;
(defun avoid-note (pair)
(get-avoid-note (intern (involve-char-p (car pair))) (second pair)))
;;;
;;;(print (connect-lists-for-c-point '(do re mi fa so la si)))
;;;(la so fa mi fa mi re do si la so la si do re do si la so fa mi re do si la so fa mi fa so la si do re mi fa
;;; so la si do re mi re do re mi fa so fa so la so fa mi re)
;;;
(defun connect-lists-for-c-point (l)
(let* ((ll (rotate-list-from-elment-at-random-and-cut l))
(l1 (rotate-list-from-elment-and-cut (car (last ll)) l))
(l2 (rotate-list-from-elment-and-cut (car (last l1)) l))
(l3 (rotate-list-from-elment-and-cut (car (last l2)) l))
(l4 (rotate-list-from-elment-and-cut (car (last l3)) l))
(l5 (rotate-list-from-elment-and-cut (car (last l4)) l))
(l6 (rotate-list-from-elment-and-cut (car (last l5)) l))
(l7 (rotate-list-from-elment-and-cut (car (last l6)) l))
(l8 (rotate-list-from-elment-and-cut (car (last l7)) l))
(l9 (rotate-list-from-elment-and-cut (car (last l8)) l))
(l10 (rotate-list-from-elment-and-cut (car (last l9)) l))
(l11 (rotate-list-from-elment-and-cut (car (last l10)) l))
(l12 (rotate-list-from-elment-and-cut (car (last l11)) l))
(l13 (rotate-list-from-elment-and-cut (car (last l12)) l))
(l14 (rotate-list-from-elment-and-cut (car (last l13)) l))
(l15 (rotate-list-from-elment-and-cut (car (last l14)) l))
(l16 (rotate-list-from-elment-and-cut (car (last l15)) l))
(l17 (rotate-list-from-elment-and-cut (car (last l16)) l))
(l18 (rotate-list-from-elment-and-cut (car (last l17)) l))
(l19 (rotate-list-from-elment-and-cut (car (last l18)) l))
(l20 (rotate-list-from-elment-and-cut (car (last l19)) l)))
(append (butlast ll) (butlast l1) (butlast l2) (butlast l3) (butlast
l4) (butlast l5)
(butlast l6) (butlast l7) (butlast l8) (butlast l9) (butlast l10)
(butlast l11)
(butlast l12) (butlast l13) (butlast l14) (butlast l15) (butlast
l16) (butlast l17)
(butlast l18) (butlast l19) (butlast l20))))
(setf *ex1* '(la so fa mi fa mi re do si la so la si do re do si la so fa mi re do si la so fa mi fa so la si do re mi fa
so la si do re mi re do re mi fa so fa so la so fa mi re))
(defun divide-a-list-into-two-parts-0 (l)
(do ((lst l (cdr lst))
(w1)
(w2))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 2) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 2) 1) w2))))
(let ((note (car lst)))
(case (random 2)
(0 (push note w1))
(1 (push note w2))))))
(defun divide-a-list-into-two-parts-1 (l)
(do ((lst l (cdr lst))
(w1)
(w2))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 4) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 4) 1) w2))))
(let ((note (car lst)))
(case (random 2)
(0 (push note w1))
(1 (push note w2))))))
(defun divide-a-list-into-two-parts-2 (l)
(do ((lst l (cdr lst))
(w1)
(w2))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 6) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 6) 1) w2))))
(let ((note (car lst)))
(case (random 2)
(0 (push note w1))
(1 (push note w2))))))
(defun divide-a-list-into-two-parts-3 (l)
(do ((lst l (cdr lst))
(w1)
(w2))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 8) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 8) 1) w2))))
(let ((note (car lst)))
(case (random 2)
(0 (push note w1))
(1 (push note w2))))))
(defun divide-a-list-into-three-parts-0 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 2) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 2) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 2) 1) w3))))
(let ((note (car lst)))
(case (random 3)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))))))
(defun divide-a-list-into-three-parts-1 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 4) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 4) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 4) 1) w3))))
(let ((note (car lst)))
(case (random 3)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))))))
(defun divide-a-list-into-three-parts-2 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 6) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 6) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 6) 1) w3))))
(let ((note (car lst)))
(case (random 3)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))))))
(defun divide-a-list-into-three-parts-3 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 8) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 8) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 8) 1) w3))))
(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-0 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3)
(w4))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 2) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 2) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 2) 1) w3))
(list 'part4 (cut-list-at-length (+ (random 2) 1) w4))))
(let ((note (car lst)))
(case (random 4)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))
(3 (push note w4))))))
(defun divide-a-list-into-four-parts-1 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3)
(w4))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 4) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 4) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 4) 1) w3))
(list 'part4 (cut-list-at-length (+ (random 4) 1) w4))))
(let ((note (car lst)))
(case (random 4)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))
(3 (push note w4))))))
(defun divide-a-list-into-four-parts-2 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3)
(w4))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 6) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 6) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 6) 1) w3))
(list 'part4 (cut-list-at-length (+ (random 6) 1) w4))))
(let ((note (car lst)))
(case (random 4)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))
(3 (push note w4))))))
(defun divide-a-list-into-four-parts-3 (l)
(do ((lst l (cdr lst))
(w1)
(w2)
(w3)
(w4))
((null lst) (list (list 'part1 (cut-list-at-length (+ (random 8) 1)
w1))
(list 'part2 (cut-list-at-length (+ (random 8) 1) w2))
(list 'part3 (cut-list-at-length (+ (random 8) 1) w3))
(list 'part4 (cut-list-at-length (+ (random 8) 1) w4))))
(let ((note (car lst)))
(case (random 4)
(0 (push note w1))
(1 (push note w2))
(2 (push note w3))
(3 (push note w4))))))
;;;
;;;(make-two-part-1 '("CM7" ion))
;;;((part1 (la)) (part2 (do re re re)))
;;;(make-two-part-1 '("Dm7" dor))
;;;((part1 (la do la fa)) (part2 (so so fa re)))
;;;(make-two-part-1 '("G7" alt))
;;;((part1 (+so so)) (part2 (+la si +do)))
;;;
(defun make-two-part-0 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-two-parts-0 l2)))
(defun make-two-part-1 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-two-parts-1 l2)))
(defun make-two-part-2 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-two-parts-2 l2)))
(defun make-two-part-3 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-two-parts-3 l2)))
;;;
;;;(make-two-part-one '("CM7" ion))
;;;((("CM7" ion) (part1 (do si la so mi re do)) (part2 (mi la si la do si))))
;;;(make-two-part-one '("CM7" ion "Dm7" dor))
;;;((("CM7" ion) (part1 (do si mi re si)) (part2 (la so do))) (("Dm7" dor) (part1 (do)) (part2 (la so la))))
;;;(make-two-part-one '("CM7" ion "Dm7" dor "G7" alt))
;;;((("CM7" ion) (part1 (la si re re)) (part2 (so))) (("Dm7" dor) (part1 (fa re mi)) (part2 (mi)))
;;; (("G7" alt) (part1 (si +do si +la)) (part2 (so))))
;;;
(defun make-two-part-one (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(make-two-part-3 (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))
(make-two-part-2 (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))
(make-two-part-1 (list (first lst) (second lst))))))
(push l3 w))))))
;;;
;;;(put-rythm-to-two-parts-one '("CM7" ion))
;;;
;;;((((CM7 ion) (part1 (do re do si do mi so la)) (part2 (mi re)))) part1 **4beat**
;;; (3(8 8 8) 16pause 16 16 16 3(8pause 8pause 8) 8pause 8) **3beat** (8 16 16 8.5 16 16 16 8) part2 **4beat**
;;; (2 2) **3beat** (2 4))
;;;nil
;;;(put-rythm-to-two-parts-one '("CM7" ion "Dm7" dor))
;;;
;;;((((CM7 ion) (part1 (so mi re)) (part2 (do la mi mi so)))
;;; ((Dm7 dor) (part1 (la)) (part2 (do re mi fa fa so))))
;;; part1 **4beat** (2 4 8 8) **3beat** (3(8pause 8pause 8) 8pause 8 8 8) part2 **4beat**
;;; (16 16 16 16 4 16 16 16 16 8.5 16) **3beat** (3(8 8 8) 16 16 16 16 16 16 16 16))
;;;nil
;;;(put-rythm-to-two-parts-one '("CM7" ion "Dm7" dor "G7" alt))
;;;
;;;((((CM7 ion) (part1 (do)) (part2 (si))) ((Dm7 dor) (part1 (fa so fa)) (part2 (mi la so mi)))
;;; ((G7 alt) (part1 (+la)) (part2 (fa))))
;;; part1 **4beat** (4 4 8.5 16 4) **3beat** (4 4 8 16 16) part2 **4beat** (4 4 8 16 16 3(8pause 8pause 8))
;;; **3beat** (8.5 16 8pause 8 3(8 8 8)))
;;;nil
;;;
(defun put-rythm-to-two-parts-one (pair)
(let ((lst (make-two-part-one pair)))
;(print lst)
(do ((ll lst (cdr ll))
(n1 0)
(n2 0))
((null ll)
(format t "~%~a~%" (list lst
'part1 '**4beat** (get-rythm-of-4beat n1)
'**3beat** (get-rythm-of-3beat n1)
'part2 '**4beat** (get-rythm-of-4beat n2)
'**3beat** (get-rythm-of-3beat n2))))
(setf n1 (+ n1 (length (second (assoc 'part1 (car ll))))))
(setf n2 (+ n2 (length (second (assoc 'part2 (car ll)))))))))
;;;
;;;(make-two-parts-one '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) (part1 (so)) (part2 (la))) ((A7 hmp5) (part1 (la so mi re)) (part2 (fa)))) part1 **4beat**
;;; (8.5 16 8pause 8 4 4) **3beat** (4 3(8 8 8) 4) part2 **4beat** (4 2.5) **3beat** (4 2))
;;;
;;;((((Dm7 dor) (part1 (do re)) (part2 (mi so fa mi do))) ((G7 alt) (part1 (+re)) (part2 (fa +do +la fa))))
;;; part1 **4beat** (2.5 8 8) **3beat** (4 4.5 8) part2 **4beat** (16pause 16 16 16 4 4 16 16 16 16) **3beat**
;;; (16 16 16 16 16 16 16 16 4))
;;;
;;;((((CM7 ion) (part1 (la mi)) (part2 (la si so re do si)))) part1 **4beat** (2 2) **3beat** (2 4) part2
;;; **4beat** (8 16 16 4 4 4) **3beat** (8 16 16 4 8 8))
;;;nil
;;;
(defun make-two-parts-one (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(let ((l (car lst)))
(put-rythm-to-two-parts-one l))))
;;;
;;;
;;;
(defun make-two-part-two (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(make-two-part-2 (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))
(make-two-part-1 (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))
(make-two-part-0 (list (first lst) (second lst))))))
(push l3 w))))))
(defun put-rythm-to-two-parts-two (pair)
(let ((lst (make-two-part-two pair)))
;(print lst)
(do ((ll lst (cdr ll))
(n1 0)
(n2 0))
((null ll)
(format t "~%~a~%" (list lst
'part1 '**4beat** (get-rythm-of-4beat n1)
'**3beat** (get-rythm-of-3beat n1)
'part2 '**4beat** (get-rythm-of-4beat n2)
'**3beat** (get-rythm-of-3beat n2))))
(setf n1 (+ n1 (length (second (assoc 'part1 (car ll))))))
(setf n2 (+ n2 (length (second (assoc 'part2 (car ll)))))))))
;;;
;;;(make-two-parts-two '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) (part1 (mi so)) (part2 (si la so))) ((A7 hmp5) (part1 (mi)) (part2 (fa so)))) part1 **4beat**
;;; (4 2 4) **3beat** (4 4.5 8) part2 **4beat** (8.5 16 4 4 3(8pause 8pause 8)) **3beat** (4 8pause 8 8 16 16))
;;;
;;;((((Dm7 dor) (part1 (la so)) (part2 (fa so))) ((G7 alt) (part1 (+la si fa)) (part2 (+do)))) part1 **4beat**
;;; (8.5 16 4 3(8pause 8pause 8) 8pause 8) **3beat** (8pause 8 3(8 8 8) 4) part2 **4beat** (2 4 4) **3beat**
;;; (8 8 2))
;;;
;;;((((CM7 ion) (part1 (mi)) (part2 (so si)))) part1 **4beat** (1) **3beat** (2.5) part2 **4beat** (4 2.5)
;;; **3beat** (2 4))
;;;
(defun make-two-parts-two (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(let ((l (car lst)))
(put-rythm-to-two-parts-two l))))
;;;
;;;
;;;
(defun make-three-part-0 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-three-parts-0 l2)))
(defun make-three-part-1 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-three-parts-1 l2)))
(defun make-three-part-2 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-three-parts-2 l2)))
(defun make-three-part-3 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-three-parts-3 l2)))
(defun make-three-part-one (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(make-three-part-3 (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))
(make-three-part-2 (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))
(make-three-part-1 (list (first lst) (second lst))))))
(push l3 w))))))
(defun put-rythm-to-three-parts-one (pair)
(let ((lst (make-three-part-one pair)))
;(print lst)
(do ((ll lst (cdr ll))
(n1 0)
(n2 0)
(n3 0))
((null ll)
(format t "~%~a~%" (list lst
'part1 '**4beat** (get-rythm-of-4beat n1)
'**3beat** (get-rythm-of-3beat n1)
'part2 '**4beat** (get-rythm-of-4beat n2)
'**3beat** (get-rythm-of-3beat n2)
'part3 '**4beat** (get-rythm-of-4beat n3)
'**3beat** (get-rythm-of-3beat n3))))
(setf n1 (+ n1 (length (second (assoc 'part1 (car ll))))))
(setf n2 (+ n2 (length (second (assoc 'part2 (car ll))))))
(setf n3 (+ n3 (length (second (assoc 'part3 (car ll)))))))))
;;;
;;;(make-three-parts-one '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) (part1 (mi mi re si)) (part2 (do so re )) (part3 (do la re )))
;;; ((A7 hmp5) (part1 (so fa mi fa la)) (part2 (la so fa la)) (part3 (do +la +la +la do re))))
;;; part1 **4beat** (4 3(8 8 8) 8 16 16 3(8pause 8 8)) **3beat** (8 16 16 3(8 8 8) 8 16 16) part2 **4beat**
;;; (4 4 4 16 16 16 16) **3beat** (8 8 8 8 3(8 8 8)) part3 **4beat**
;;; (8pause 8 16 16 16 16 3(8pause 8pause 8) 16pause 16 16 16) **3beat** (16 16 16 16 16 16 16 16 4))
;;;
;;;((((Dm7 dor) (part1 (la so)) (part2 (fa so)) (part3 (la so fa re so)))
;;; ((G7 alt) (part1 (fa)) (part2 (si +re so +la)) (part3 (+re fa +do +so))))
;;; part1 **4beat** (2 4.5 8) **3beat** (8 8 2) part2 **4beat** (4 8 8 3(8pause 8 8) 4) **3beat**
;;; (4 8 8 8 16 16) part3 **4beat** (4 16 16 16 16 8 16 16 4) **3beat** (16 16 16 16 4 16 16 16 16))
;;;
;;;((((CM7 ion) (part1 (mi la si la mi mi so)) (part2 (so)) (part3 (so do si re so)))) part1 **4beat**
;;; (8.5 16 4 8.5 16 8 8) **3beat** (16 16 8 4 16 16 8) part2 **4beat** (1) **3beat** (2.5) part3 **4beat**
;;; (4 4 3(8pause 8 8) 8pause 8) **3beat** (3(8pause 8pause 8) 8 8 8.5 16))
;;;nil
;;;
(defun make-three-parts-one (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(let ((l (car lst)))
(put-rythm-to-three-parts-one l))))
;;;
;;;
;;;
(defun make-three-part-two (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(make-three-part-2 (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))
(make-three-part-1 (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))
(make-three-part-0 (list (first lst) (second lst))))))
(push l3 w))))))
(defun put-rythm-to-three-parts-two (pair)
(let ((lst (make-three-part-two pair)))
;(print lst)
(do ((ll lst (cdr ll))
(n1 0)
(n2 0)
(n3 0))
((null ll)
(format t "~%~a~%" (list lst
'part1 '**4beat** (get-rythm-of-4beat n1)
'**3beat** (get-rythm-of-3beat n1)
'part2 '**4beat** (get-rythm-of-4beat n2)
'**3beat** (get-rythm-of-3beat n2)
'part3 '**4beat** (get-rythm-of-4beat n3)
'**3beat** (get-rythm-of-3beat n3))))
(setf n1 (+ n1 (length (second (assoc 'part1 (car ll))))))
(setf n2 (+ n2 (length (second (assoc 'part2 (car ll))))))
(setf n3 (+ n3 (length (second (assoc 'part3 (car ll)))))))))
;;;
;;;(make-three-parts-two '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) (part1 (so)) (part2 (si si)) (part3 (do la mi do)))
;;; ((A7 hmp5) (part1 (do so re mi)) (part2 (re fa fa mi)) (part3 (+la la))))
;;; part1 **4beat** (4 4 4 3(8pause 8 8)) **3beat** (4 4 16 16 8) part2 **4beat**
;;; (3(8pause 8pause 8) 8.5 16 8 8 4) **3beat** (4 8 16 16 8.5 16) part3 **4beat** (8 16 16 8pause 8 4 4)
;;; **3beat** (3(8 8 8) 4 3(8pause 8 8)))
;;;
;;;((((Dm7 dor) (part1 (re do)) (part2 (la mi la la)) (part3 (fa re)))
;;; ((G7 alt) (part1 (si +la)) (part2 (+re)) (part3 (+do fa so))))
;;; part1 **4beat** (4 8 8 2) **3beat** (8pause 8 4 8.5 16) part2 **4beat**
;;; (3(8pause 8pause 8) 3(8pause 8pause 8) 8 8 3(8pause 8pause 8)) **3beat** (4 8 8 8.5 16) part3 **4beat**
;;; (8.5 16 4 4 4) **3beat** (8 8 8pause 8 8.5 16))
;;;
;;;((((CM7 ion) (part1 (si do mi do re so)) (part2 (do si)) (part3 (mi)))) part1 **4beat**
;;; (8 8 3(8pause 8pause 8) 3(8pause 8 8) 3(8pause 8pause 8)) **3beat** (3(8 8 8) 4 3(8pause 8 8)) part2
;;; **4beat** (2 2) **3beat** (4 2) part3 **4beat** (1) **3beat** (2.5))
;;;nil
;;;
(defun make-three-parts-two (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(let ((l (car lst)))
(put-rythm-to-three-parts-two l))))
;;;
;;;
;;;
(defun make-four-part-0 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-four-parts-0 l2)))
(defun make-four-part-1 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-four-parts-1 l2)))
(defun make-four-part-2 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-four-parts-2 l2)))
(defun make-four-part-3 (pair)
(let* ((l1 (butlast (chord-scale pair)))
(l2 (remove (car (avoid-note pair)) (connect-lists-for-c-point l1))))
(divide-a-list-into-four-parts-3 l2)))
;;;
;;;
;;;
(defun make-four-part-one (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(make-four-part-3 (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))
(make-four-part-2 (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))
(make-four-part-1 (list (first lst) (second lst))))))
(push l3 w))))))
(defun put-rythm-to-four-parts-one (pair)
(let ((lst (make-four-part-one pair)))
;(print lst)
(do ((ll lst (cdr ll))
(n1 0)
(n2 0)
(n3 0)
(n4 0))
((null ll)
(format t "~%~a~%" (list lst
'part1 '**4beat** (get-rythm-of-4beat n1)
'**3beat** (get-rythm-of-3beat n1)
'part2 '**4beat** (get-rythm-of-4beat n2)
'**3beat** (get-rythm-of-3beat n2)
'part3 '**4beat** (get-rythm-of-4beat n3)
'**3beat** (get-rythm-of-3beat n3)
'part4 '**4beat** (get-rythm-of-4beat n4)
'**3beat** (get-rythm-of-4beat n4))))
(setf n1 (+ n1 (length (second (assoc 'part1 (car ll))))))
(setf n2 (+ n2 (length (second (assoc 'part2 (car ll))))))
(setf n3 (+ n3 (length (second (assoc 'part3 (car ll))))))
(setf n4 (+ n4 (length (second (assoc 'part4 (car ll)))))))))
;;;
;;;(make-four-parts-one '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) (part1 (re)) (part2 (mi)) (part3 (re so)) (part4 (so so la mi)))
;;; ((A7 hmp5) (part1 (do so re fa)) (part2 (la +la re la do re)) (part3 (fa do mi la))
;;; (part4 (+la mi do +la))))
;;; part1 **4beat** (4 8pause 8 8.5 16 3(8pause 8pause 8)) **3beat** (8pause 8 3(8 8 8) 4) part2 **4beat**
;;; (3(8pause 8 8) 4 8 8 8.5 16) **3beat** (8 16 16 4 16 16 8) part3 **4beat**
;;; (4 3(8pause 8pause 8) 16pause 16 16 16 8pause 8) **3beat** (3(8pause 8pause 8) 16 16 16 16 4) part4
;;; **4beat** (4 8.5 16 3(8pause 8pause 8) 16 16 16 16) **3beat** (8 8 4 4 16 16 16 16))
;;;
;;;((((Dm7 dor) (part1 (do mi do la so la)) (part2 (do la so )) (part3 (fa mi mi)) (part4 (re re fa re)))
;;; ((G7 alt) (part1 (+do)) (part2 (fa +re si +la si so)) (part3 (+re)) (part4 (so))))
;;; part1 **4beat** (4 8.5 16 8.5 16 8 8) **3beat** (4 8.5 16 16 16 16 16) part2 **4beat**
;;; (16 16 16 16 3(8 8 8) 4 4) **3beat** (16 16 16 16 16 16 16 16 8pause 8) part3 **4beat** (2 8 8 4) **3beat**
;;; (4 8.5 16 8pause 8) part4 **4beat** (3(8pause 8 8) 4 4 4) **3beat**
;;; (8.5 16 8pause 8 8pause 8 3(8pause 8pause 8)))
;;;
;;;((((CM7 ion) (part1 (la do la mi mi la mi)) (part2 (re so so si do)) (part3 (so si la so re la si mi))
;;; (part4 (la))))
;;; part1 **4beat** (3(8pause 8pause 8) 8.5 16 3(8 8 8) 3(8pause 8pause 8)) **3beat**
;;; (8pause 8 8 16 16 8 16 16) part2 **4beat** (3(8pause 8 8) 4 4 4) **3beat** (8 16 16 4 4) part3 **4beat**
;;; (8 16 16 3(8pause 8pause 8) 16pause 16 16 16 8pause 8) **3beat** (16 16 8 8 16 16 8 8) part4 **4beat** (1)
;;; **3beat** (1))
;;;nil
;;;
(defun make-four-parts-one (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(let ((l (car lst)))
(put-rythm-to-four-parts-one l))))
;;;
;;;
;;;
(defun make-four-part-two (l)
(cond ((equal (length l) 2)
(do ((lst l (cddr lst))
(w))
((null lst) (reverse w))
(let ((l1 (cons (list (first lst) (second lst))
(make-four-part-2 (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))
(make-four-part-1 (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))
(make-four-part-0 (list (first lst) (second lst))))))
(push l3 w))))))
(defun put-rythm-to-four-parts-two (pair)
(let ((lst (make-four-part-two pair)))
;(print lst)
(do ((ll lst (cdr ll))
(n1 0)
(n2 0)
(n3 0)
(n4 0))
((null ll)
(format t "~%~a~%" (list lst
'part1 '**4beat** (get-rythm-of-4beat n1)
'**3beat** (get-rythm-of-3beat n1)
'part2 '**4beat** (get-rythm-of-4beat n2)
'**3beat** (get-rythm-of-3beat n2)
'part3 '**4beat** (get-rythm-of-4beat n3)
'**3beat** (get-rythm-of-3beat n3)
'part4 '**4beat** (get-rythm-of-4beat n4)
'**3beat** (get-rythm-of-4beat n4))))
(setf n1 (+ n1 (length (second (assoc 'part1 (car ll))))))
(setf n2 (+ n2 (length (second (assoc 'part2 (car ll))))))
(setf n3 (+ n3 (length (second (assoc 'part3 (car ll))))))
(setf n4 (+ n4 (length (second (assoc 'part4 (car ll)))))))))
;;;
;;;(make-four-parts-two '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) (part1 (so la)) (part2 (so mi)) (part3 (la si do)) (part4 (la)))
;;; ((A7 hmp5) (part1 (re mi)) (part2 (+la)) (part3 (fa do la mi)) (part4 (do re mi fa))))
;;; part1 **4beat** (8 8 2 4) **3beat** (3(8pause 8pause 8) 3(8pause 8 8) 4) part2 **4beat** (4 4 2) **3beat**
;;; (4 4 4) part3 **4beat** (4 4 4 16 16 16 16) **3beat** (3(8 8 8) 3(8pause 8pause 8) 3(8 8 8)) part4
;;; **4beat** (4 4 8.5 16 4) **3beat** (4 4 3(8pause 8 8) 3(8pause 8pause 8)))
;;;
;;;((((Dm7 dor) (part1 (re)) (part2 (re mi re do)) (part3 (la mi fa)) (part4 (do re la so)))
;;; ((G7 alt) (part1 (+re +do si)) (part2 (+so si +do +la)) (part3 (+la)) (part4 (fa +re +la))))
;;; part1 **4beat** (4.5 8 4 4) **3beat** (3(8pause 8pause 8) 4 8 8) part2 **4beat**
;;; (8 16 16 4 4 16pause 16 16 16) **3beat** (3(8pause 8 8) 3(8 8 8) 8 16 16) part3 **4beat** (4 4 4 4)
;;; **3beat** (8 8 4 3(8pause 8pause 8)) part4 **4beat** (8pause 8 4 4 16 16 16 16) **3beat**
;;; (4 16 16 16 16 4 4))
;;;
;;;((((CM7 ion) (part1 (la si la do)) (part2 (do la re si la so)) (part3 (si do si)) (part4 (si so do re))))
;;; part1 **4beat** (2 8 8 4) **3beat** (8.5 16 4 4) part2 **4beat** (8pause 8 3(8pause 8 8) 8 8 4) **3beat**
;;; (4 16 16 8 8.5 16) part3 **4beat** (2 4 4) **3beat** (4 4.5 8) part4 **4beat** (2 4 8 8) **3beat**
;;; (4 4 4 4))
;;;nil
;;;
(defun make-four-parts-two (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(let ((l (car lst)))
(put-rythm-to-four-parts-two l))))
;;;
;;;
;;;
(defun auto-comp-tow-part-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))
(make-two-parts-one l2)))
(defun auto-comp-two-part-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))
(make-two-parts-two l2)))
(defun auto-comp-three-part-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))
(make-three-parts-one l2)))
(defun auto-comp-three-part-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))
(make-two-parts-two l2)))
(defun auto-comp-four-part-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))
(make-four-parts-one l2)))
(defun auto-comp-four-part-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))
(make-four-parts-two l2)))