;;;
;;; c:\\program files\\alc62\\music29.cl
;;;
(load "c:\\program files\\acl62\\music28.cl")
(defun auto-comp1-1-aux (pair)
(let* ((l (make-a-phrase-with-scale-from-tension pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp1-2-aux (pair)
(let* ((l (make-a-phrase-with-scale-from-tension-2 pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp2-1-aux (pair)
(let* ((l (make-a-phrase-with-scale-from-elm pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp2-2-aux (pair)
(let* ((l (make-a-phrase-with-scale-from-elm-2 pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp3-1-aux (pair)
(let* ((l (get-elements-of-melody-at-random pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp3-2-aux (pair)
(let* ((l (get-elements-of-melody-at-random-2 pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp4-1-aux (pair)
(let* ((l (make-a-phrase-with-UST-at-random pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
(defun auto-comp4-2-aux (pair)
(let* ((l (get-notes-from-UST-at-random-2 pair))
(n (length l))
(r3 (get-rythm-of-3beat n))
(r4 (get-rythm-of-4beat n)))
(format t "~%~a" (list l (list 3 r3) (list 4 r4)))
(read-sentence)))
;;;
;;;
;;;
(defun auto-comp1-1-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp1-1-aux l)))))
(defun auto-comp1-2-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp1-2-aux l)))))
(defun auto-comp2-1-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp2-1-aux l)))))
(defun auto-comp2-2-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp2-2-aux l)))))
(defun auto-comp3-1-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp3-1-aux l)))))
(defun auto-comp3-2-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp3-2-aux l)))))
(defun auto-comp4-1-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp4-1-aux l)))))
(defun auto-comp4-2-aux-2 (pairs)
(do ((lst pairs (cdr lst)))
((null lst))
(print (car lst))
(do ((ll (car lst) (cddr ll)))
((null ll))
(let ((l (list (first ll) (second ll))))
(print l)
(auto-comp4-2-aux l)))))
;;;
;;;
;;;
(defun auto-comp1-1 (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))
(auto-comp1-1-aux-2 l2)))
(defun auto-comp1-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))
(auto-comp1-2-aux-2 l2)))
(defun auto-comp2-1 (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))
(auto-comp2-1-aux-2 l2)))
(defun auto-comp2-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))
(auto-comp2-2-aux-2 l2)))
(defun auto-comp3-1 (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))
(auto-comp3-1-aux-2 l2)))
(defun auto-comp3-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))
(auto-comp3-2-aux-2 l2)))
(defun auto-comp4-1 (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))
(auto-comp4-1-aux-2 l2)))
(defun auto-comp4-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))
(auto-comp4-2-aux-2 l2)))