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