;;;
;;; c:\\program files\\acl62\\music23.cl
;;;
(load "c:\\program files\\acl62\\music22.cl")
(defun generate-8-elements-at-random (pair)
(do ((i 8 (1- i))
(w))
((<= i 0) (reverse w))
(push (generate-a-note-at-random pair) w)))
;;;
;;;(make-a-phrase-for-waltz-2-4-1 '("CM7" ion "Dm7" dor))
;;;(("CM7" ion) la re ("Dm7" dor) mi)
;;;
(defun make-a-phrase-for-waltz-2-4-1 (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))
(generate-8-elements-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))
(generate-8-elements-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))
(generate-8-elements-at-random (list (first lst)
(second lst))))))))))))
(defun make-a-phrase-for-waltz-2-4-1-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))
(generate-8-elements-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))
(generate-8-elements-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))
(generate-8-elements-at-random (list (first lst)
(second lst))))))))))))
;;;
;;;(make-a-phrase-for-ballad-2-4-1 '("CM7" ion "Dm7" dor))
;;;(("CM7" ion) re re ("Dm7" dor) fa mi)
;;;
(defun make-a-phrase-for-ballad-2-4-1 (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))
(generate-8-elements-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))
(generate-8-elements-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))
(generate-8-elements-at-random (list (first lst)
(second lst))))))))))))
(defun make-a-phrase-for-ballad-2-4-1-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))
(generate-8-elements-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))
(generate-8-elements-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))
(generate-8-elements-at-random (list (first lst)
(second lst))))))))))))
;;;
;;;(make-a-phrase-for-song '("CM7" ion "Dm7" dor))
;;;(((re mi si so fa so) (16 16 16 16 "3(8pause 8pause 8)" 4))
;;; ((re mi si so fa do fa) ("3(8pause 8pause 8)" 16 16 16 16 4 4)))
;;;
(defun make-a-phrase-for-song-of-waltz-1 (l)
(let ((l1 (make-a-phrase-for-waltz-2-4-1 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-song-of-waltz-2 (l)
(let ((l1 (make-a-phrase-for-waltz-2-4-1-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-song-of-ballad-1 (l)
(let ((l1 (make-a-phrase-for-ballad-2-4-1 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-song-of-ballad-2 (l)
(let ((l1 (make-a-phrase-for-ballad-2-4-1-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))))))))
;;;
;;;(make-a-phrase-for-song '("CM7" ion "Dm7" dor))
;;;(***waltz*** ((("CM7" ion) la la re ("Dm7" dor) do fa) (3beat ("3(8pause 8 8)" "3(8pause 8 8)" 4)))
;;; ***ballad*** ((("CM7" ion) la si re ("Dm7" dor) fa) (4beat (4 8 8 2))))
;;;
(defun make-a-phrase-for-song-1 (l)
(list '***waltz*** (make-a-phrase-for-song-of-waltz-1 l) '***ballad***
(make-a-phrase-for-song-of-ballad-1 l)))
(defun make-a-phrase-for-song-2 (l)
(list '***waltz*** (make-a-phrase-for-song-of-waltz-2 l) '***ballad***
(make-a-phrase-for-song-of-ballad-2 l)))
;;;
;;;(make-phrases-for-song '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;*********** (CM7 ion A7 hmp5) ***********
;;;(***waltz*** (((CM7 ion) la re mi (A7 hmp5) so fa do) (3beat (16 16 8 4 8 8))) ***ballad***
;;; (((CM7 ion) re mi re (A7 hmp5) +la do do so) (4beat (4 4 16 16 16 16 4))))
;;;*********** (Dm7 dor G7 alt) ***********
;;;(***waltz*** (((Dm7 dor) fa (G7 alt) +so +so re) (3beat (8.5 16 4 3(8pause 8pause 8)))) ***ballad***
;;; (((Dm7 dor) fa mi (G7 alt) +la +la +so) (4beat (3(8pause 8 8) 4 4 4))))
;;;*********** (CM7 ion) ***********
;;;(***waltz*** (((CM7 ion) la) (3beat (2.5))) ***ballad***
;;; (((CM7 ion) re la la mi la si la la)
;;; (4beat (8 16 16 3(8pause 8pause 8) 16pause 16 16 16 3(8pause 8pause 8)))))
;;;
(defun make-phrases-for-song-1 (l)
(do ((lst l (cdr lst)))
((null lst))
(format t "~%*********** ~a ***********" (car lst))
(format t "~%~a" (make-a-phrase-for-song-1 (car lst)))))
(defun make-phrases-for-song-2 (l)
(do ((lst l (cdr lst)))
((null lst))
(format t "~%*********** ~a ***********" (car lst))
(format t "~%~a" (make-a-phrase-for-song-2 (car lst)))))
;;;
;;; (make-song *w3*)
;;;
(defun make-song (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-song-1 l2)))
(defun make-song-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-song-2 l2)))