;;;
;;; c:\\program files\\acl62\\music21.cl
;;;
(load "c:\\program files\\acl62\\music20.cl")
;;;
;;;(make-a-phrase-1-2-2 '("CM7" ion "Em7" phr))
;;;(("CM7" ion) si ("Em7" phr) so re do)
;;;
(defun make-a-phrase-1-2-2 (l)
(let ((num (length l)))
(case num
(2 (do ((lst l (cddr lst))
(w))
((null lst) w)
(setf w
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 6))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 3))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 2))
(squash (generate-a-phrase-at-random (list
(first lst) (second lst)))))))))))))
;;;
;;;
;;;
(defun make-a-phrase-1-2-2-second (l)
(let ((num (length l)))
(case num
(2 (do ((lst l (cddr lst))
(w))
((null lst) w)
(setf w
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 3))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 2))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 1))
(squash (generate-a-phrase-at-random (list
(first lst) (second lst)))))))))))))
;;;
;;;(make-a-phrase-2-2-2 '("CM7" ion "Em7" phr))
;;;(("CM7" ion) re do re ("Em7" phr) do)
;;;
(defun make-a-phrase-2-2-2 (l)
(let ((num (length l)))
(case num
(2 (do ((lst l (cddr lst))
(w))
((null lst) w)
(setf w
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 6))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 3))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 2))
(squash (generate-a-phrase-at-random-2 (list (car
lst) (cadr lst)))))))))))))
;;;
;;;
;;;
(defun make-a-phrase-2-2-2-second (l)
(let ((num (length l)))
(case num
(2 (do ((lst l (cddr lst))
(w))
((null lst) w)
(setf w
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 3))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 2))
(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
(cons (list (first lst) (second lst))
(cut-list-at-length (1+ (random 1))
(squash (generate-a-phrase-at-random-2 (list
(car lst) (cadr lst)))))))))))))
;;;
;;;(make-a-phrase-for-waltz '("CM7" ion "Em7" phr))
;;;
;;;(***ex1*** ((("CM7" ion) si la ("Em7" phr) re so) (3beat (8.5 16 4 4))) ***ex2***
;;; ((("CM7" ion) si ("Em7" phr) la si) (3beat (4 4 4))))
;;;
(defun make-a-phrase-for-waltz-1-2 (l)
(let ((l1 (make-a-phrase-1-2-2 l)))
(cond ((equal (length l) 2)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 1)))))
((equal (length l) 4)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 2)))))
((equal (length l) 6)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 3))))))))
(defun make-a-phrase-for-waltz-1-2-second (l)
(let ((l1 (make-a-phrase-1-2-2-second l)))
(cond ((equal (length l) 2)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 1)))))
((equal (length l) 4)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 2)))))
((equal (length l) 6)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 3))))))))
(defun make-a-phrase-for-waltz-2-2 (l)
(let ((l1 (make-a-phrase-2-2-2 l)))
(cond ((equal (length l) 2)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 1)))))
((equal (length l) 4)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 2)))))
((equal (length l) 6)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 3))))))))
(defun make-a-phrase-for-waltz-2-2-second (l)
(let ((l1 (make-a-phrase-2-2-2-second l)))
(cond ((equal (length l) 2)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 1)))))
((equal (length l) 4)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 2)))))
((equal (length l) 6)
(list l1 (list '3beat (get-rythm-of-3beat (- (length l1) 3))))))))
(defun make-a-phrase-for-waltz (l)
(list '***ex1*** (make-a-phrase-for-waltz-1-2 l) '***ex2*** (make-a-phrase-for-waltz-2-2
l)))
(defun make-a-phrase-for-waltz-second (l)
(list '***ex1*** (make-a-phrase-for-waltz-1-2-second l) '***ex2*** (make-a-phrase-for-waltz-2-2-second
l)))
;;;
;;;(make-phrases-for-waltz '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;*********** (CM7 ion A7 hmp5) *************
;;;(***ex1*** (((CM7 ion) mi re (A7 hmp5) do do) (3beat (4 8.5 16 4))) ***ex2***
;;; (((CM7 ion) si mi mi (A7 hmp5) fa mi do) (3beat (8.5 16 3(8 8 8) 4))))
;;;*********** (Dm7 dor G7 alt) *************
;;;(***ex1*** (((Dm7 dor) fa fa so (G7 alt) si) (3beat (8 8 4 4))) ***ex2***
;;; (((Dm7 dor) so (G7 alt) do) (3beat (4 2))))
;;;*********** (CM7 ion) *************
;;;(***ex1*** (((CM7 ion) mi mi re do) (3beat (4 8pause 8 8.5 16))) ***ex2***
;;; (((CM7 ion) si si la +la si) (3beat (8.5 16 4 3(8pause 8 8)))))
;;;
(defun make-phrases-for-waltz (l)
(do ((lst l (cdr lst)))
((null lst))
(format t "~%*********** ~a *************" (car lst))
(format t "~%~a" (make-a-phrase-for-waltz (car lst)))))
(defun make-phrases-for-waltz-second (l)
(do ((lst l (cdr lst)))
((null lst))
(format t "~%*********** ~a *************" (car lst))
(format t "~%~a" (make-a-phrase-for-waltz-second (car lst)))))
;;;
;;; (make-waltz *w3*)
;;;
(defun make-waltz (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-waltz l2)))
(defun make-waltz-2 (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-waltz-second l2)))