;;;
;;; (load "c:\\program files\\acl62\\music68.cl")
;;;
(load "c:\\program files\\acl62\\music67.cl")
;;;
;;;(get-elements-of-melody-2 '("-BM7" ion))--->(re la do so)
;;;
;;;(get-elements-of-melody-2 '("G7" alt))--->(si fa +so +la +do +re)
;;;
;;;(get-elements-of-melody-3 '("CM7" ion))--->(si re la)
;;;
;;;(get-elements-of-melody-3 '("GM7" ion))--->(+fa la mi)
;;;
;;;(get-elements-of-melody-3 '("G7" alt))--->(fa +so +la +do +re)
;;;
;;;(defun get-elements-of-melody-2 (pair)
;;; (translate-flat-to-sharp-in-a-list (get-elements-of-melody pair)))
;;;
;;;
;;;(print (get-elements-in-a-list-at-random '(do re mi fa so la si)))
;;;(fa si do do fa so re la fa mi mi)
;;;
;;;(print (get-elements-in-a-list-at-random '(do mi so si)))
;;;(si mi mi do so si mi do mi so si mi mi mi si mi mi mi mi do)
;;;
;;;(print (get-20elements-in-a-list '(re la do so)))
;;;(la do so do la so so re do so so do do la re la do so re la)
;;;
(defun get-elements-of-melody-3 (pair)
(translate-flat-to-sharp-in-a-list (append (last (chord-tone pair)) (tension-note
pair))))
(defun get-20elements-in-a-list (l)
(do ((i 1 (1+ i))
(w))
((> i 20) w)
(push (nth (random (length l)) l) w)))
(defun get-a-phrase-1-aux-3-7 (pair)
(cut-list-at-length (+ (random 2) 1) (get-20elements-in-a-list (get-elements-of-melody-2
pair))))
(defun get-a-phrase-2-aux-3-7 (pair)
(cut-list-at-length (+ (random 4) 1) (get-20elements-in-a-list (get-elements-of-melody-2
pair))))
(defun get-a-phrase-3-aux-3-7 (pair)
(cut-list-at-length (+ (random 6) 1) (get-20elements-in-a-list (get-elements-of-melody-2
pair))))
(defun get-a-phrase-4-aux-3-7 (pair)
(cut-list-at-length (+ (random 8) 1) (get-20elements-in-a-list (get-elements-of-melody-2
pair))))
(defun get-a-phrase-1-aux-7 (pair)
(cut-list-at-length (+ (random 2) 1) (get-20elements-in-a-list (get-elements-of-melody-3
pair))))
(defun get-a-phrase-2-aux-7 (pair)
(cut-list-at-length (+ (random 4) 1) (get-20elements-in-a-list (get-elements-of-melody-3
pair))))
(defun get-a-phrase-3-aux-7 (pair)
(cut-list-at-length (+ (random 6) 1) (get-20elements-in-a-list (get-elements-of-melody-3
pair))))
(defun get-a-phrase-4-aux-7 (pair)
(cut-list-at-length (+ (random 8) 1) (get-20elements-in-a-list (get-elements-of-melody-3
pair))))
(defun get-a-phrase-one-aux-3-7 (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-3-7 (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-3-7 (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-3-7 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-two-aux-3-7 (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-3-7 (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-3-7 (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-3-7 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-one-aux-7 (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-7 (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-7 (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-7 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-two-aux-7 (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-7 (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-7 (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-7 (list (first lst) (second lst))))))
(push l3 w))))))
(defun get-a-phrase-one-2-aux-3-7 (pair)
(let ((l (get-a-phrase-one-aux-3-7 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-3-7 (pair)
(let ((l (get-a-phrase-two-aux-3-7 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-7 (pair)
(let ((l (get-a-phrase-one-aux-7 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-7 (pair)
(let ((l (get-a-phrase-two-aux-7 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-3-7 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((("CM7" ion) re si mi) (("A7" hmp5) +do +la)) ***4beat*** (4 "3(8pause 8pause 8)" 4 8.5 16) ***3beat***
;;; ("3(8 8 8)" "3(8pause 8pause 8)" "3(8pause 8pause 8)"))
;;; (((("Dm7" dor) fa do so) (("G7" alt) +so +re fa +so +re)) ***4beat***
;;; (8pause 8 8pause 8 "3(8 8 8)" 16pause 16 16 16) ***3beat*** (8.5 16 8 8 16 16 16 16))
;;; (((("CM7" ion) la la mi re mi)) ***4beat*** (4 "3(8pause 8 8)" 4 4) ***3beat*** ("3(8 8 8)" 4 4)))
;;;
;;;(get-phrases-two-3-7 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;((((("CM7" ion) re) (("A7" hmp5) +do so do fa)) ***4beat*** (8pause 8 4 8pause 8 "3(8pause 8 8)")
;;; ***3beat*** (4 "3(8pause 8 8)" 8 8))
;;; (((("Dm7" dor) fa fa so) (("G7" alt) +so fa)) ***4beat***
;;; (4 "3(8pause 8 8)" "3(8pause 8pause 8)" "3(8pause 8pause 8)") ***3beat*** (8 8 4 8.5 16))
;;; (((("CM7" ion) re la si re)) ***4beat*** (2 8 8 4) ***3beat***
;;; ("3(8pause 8 8)" 8pause 8 "3(8pause 8pause 8)")))
;;;
;;;(get-phrases-one-7 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;((((("CM7" ion) si la si re la la) (("A7" hmp5) fa)) ***4beat*** (4 8pause 8 4 16 16 16 16) ***3beat***
;;; (4 16 16 8 "3(8 8 8)"))
;;; (((("Dm7" dor) so mi mi) (("G7" alt) +do +do +re)) ***4beat*** ("3(8 8 8)" 4 "3(8pause 8pause 8)" 4)
;;; ***3beat*** (16 16 16 16 4 4))
;;; (((("CM7" ion) la re si la la re la si)) ***4beat*** (4 4 8 16 16 16pause 16 16 16) ***3beat***
;;; ("3(8pause 8pause 8)" 16 16 8 16 16 16 16)))
;;;
;;;(get-phrases-two-7 '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;((((("CM7" ion) la si si) (("A7" hmp5) fa do)) ***4beat*** ("3(8pause 8pause 8)" 8 8 4 4) ***3beat***
;;; (8 16 16 4 8pause 8))
;;; (((("Dm7" dor) mi) (("G7" alt) +la +so +do +la)) ***4beat*** ("3(8pause 8pause 8)" 8.5 16 4 4) ***3beat***
;;; (4 8.5 16 "3(8pause 8 8)"))
;;; (((("CM7" ion) si la)) ***4beat*** (2 2) ***3beat*** (2 4)))
;;;
(defun get-phrases-one-3-7 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-one-2-aux-3-7 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-two-3-7 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-two-2-aux-3-7 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-one-7 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-one-2-aux-7 (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-two-7 (l)
(do ((lst l (cdr lst))
(w))
((null lst) (reverse w))
(let ((ll (get-a-phrase-two-2-aux-7 (car lst))))
(format t "~%~a" ll)
(push ll w))))
;;;
;;;
;;;
(defun auto-comp-one-3-7 (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-3-7 l2)))
(defun auto-comp-two-3-7 (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-3-7 l2)))
(defun auto-comp-one-7 (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-7 l2)))
(defun auto-comp-two-7 (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-7 l2)))