;;;
;;; (load "c:\\program files\\acl62\\music71.cl")
;;;
(load "c:\\program files\\acl62\\music70.cl")
;;;(defun get-an-element-in-a-list (l)
;;; (nth (random (length l)) l))
;;;(defun connect-lists-for-phrase (l)
;;; (let* ((ll (rotate-list-from-elment-and-cut (get-an-element-in-a-list l) 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))))
;;;
;;;(defun connect-lists-for-phrase-by-a-pair (pair)
;;; (let ((lst (butlast (chord-scale pair))))
;;; (remove (car (avoid-note pair)) (connect-lists-for-phrase lst))))
;;;
;;;
;;;(rotate-list-from-elment-and-cut-2 'c '(a b c d e f g))
;;;(c)
;;;
;;;(defun rotate-list-from-elment-and-cut-2 (element l)
;;; (case (random 2)
;;; (0 (rotate-list-from-elment-forward-and-cut-2 element l))
;;; (1 (rotate-list-from-elment-backward-and-cut-2 element l))))
;;;
(defun connect-lists-for-phrase-chromatic (pair l)
(let* ((ll (rotate-list-from-elment-and-cut
(get-an-element-in-a-list (butlast (translate-flat-to-sharp-in-a-list
(chord-scale pair))))
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))))
(defun connect-lists-for-phrase-by-a-pair-chromatic (pair)
(let ((lst '(do +do re +re mi fa +fa so +so la +la si)))
(remove (car (avoid-note pair)) (connect-lists-for-phrase-chromatic
pair lst))))
(defun get-a-phrase-1-aux-chromatic (pair)
(cut-list-at-length (+ (random 2) 1) (connect-lists-for-phrase-by-a-pair-chromatic
pair)))
(defun get-a-phrase-2-aux-chromatic (pair)
(cut-list-at-length (+ (random 4) 1) (connect-lists-for-phrase-by-a-pair-chromatic
pair)))
(defun get-a-phrase-3-aux-chromatic (pair)
(cut-list-at-length (+ (random 6) 1) (connect-lists-for-phrase-by-a-pair-chromatic
pair)))
(defun get-a-phrase-4-aux-chromatic (pair)
(cut-list-at-length (+ (random 8) 1) (connect-lists-for-phrase-by-a-pair-chromatic
pair)))
(defun get-a-phrase-one-aux-chromatic (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-chromatic (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-chromatic (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-chromatic (list (first lst) (second
lst))))))
(push l3 w))))))
(defun get-a-phrase-two-aux-chromatic (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-chromatic (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-chromatic (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-chromatic (list (first lst) (second
lst))))))
(push l3 w))))))
;;;(defun number-of-notes (l)
;;; (cond ((equal (length l) 1)
;;; (- (length (first l)) 1))
;;; ((equal (length l) 2)
;;; (- (+ (length (first l)) (length (second l))) 2))
;;; ((equal (length l) 3)
;;; (- (+ (length (first l)) (length (second l)) (length (third
l))) 3))))
(defun get-a-phrase-one-2-aux-chromatic (pair)
(let ((l (get-a-phrase-one-aux-chromatic 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-chromatic (pair)
(let ((l (get-a-phrase-two-aux-chromatic pair))
(n))
(setf n (number-of-notes l))
(list l '***4beat*** (get-rythm-of-4beat n) '***3beat*** (get-rythm-of-3beat
n))))
;;;cg-user(67): (get-phrases-one-chromatic '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) si) ((A7 hmp5) do si +la la +so so)) ***4beat*** (4 3(8pause 8 8) 4 8 16 16) ***3beat***
;;; (4 8 16 16 8 16 16))
;;;((((Dm7 dor) re +re mi fa +fa) ((G7 alt) +la si do +do re)) ***4beat***
;;; (3(8pause 8pause 8) 16pause 16 16 16 3(8 8 8) 16pause 16 16 16) ***3beat*** (16 16 16 16 8 16 16 8 16 16))
;;;((((CM7 ion) mi)) ***4beat*** (1) ***3beat*** (2.5))
;;;nil
;;;cg-user(68): (get-phrases-two-chromatic '(("CM7" ion "A7" hmp5) ("Dm7" dor "G7" alt) ("CM7" ion)))
;;;
;;;((((CM7 ion) mi +fa so +so) ((A7 hmp5) la +so)) ***4beat*** (4 3(8 8 8) 4 4) ***3beat***
;;; (8 16 16 3(8pause 8pause 8) 8 8))
;;;((((Dm7 dor) fa mi +re) ((G7 alt) +so so +fa)) ***4beat*** (4 3(8 8 8) 4 8pause 8) ***3beat***
;;; (16 16 16 16 4 8pause 8))
;;;((((CM7 ion) so +fa mi +re re +do)) ***4beat*** (4 4 3(8 8 8) 4) ***3beat*** (16 16 16 16 4 8pause 8))
;;;nil
;;;
(defun get-phrases-one-chromatic (l)
(do ((lst l (cdr lst))
(w))
((null lst))
(let ((ll (get-a-phrase-one-2-aux-chromatic (car lst))))
(format t "~%~a" ll)
(push ll w))))
(defun get-phrases-two-chromatic (l)
(do ((lst l (cdr lst))
(w))
((null lst))
(let ((ll (get-a-phrase-two-2-aux-chromatic (car lst))))
(format t "~%~a" ll)
(push ll w))))
;;;
;;;
;;;
(defun auto-comp-one-chromatic (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-chromatic l2)))
(defun auto-comp-two-chromatic (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-chromatic l2)))