;;; 
;;; c:\\program files\\acl62\\rythm.cl 
;;; 
(load "c:\\program files\\acl62\\music2.cl") 

(make-frame-from-list 
　'(4n (add0 (value 4 (8pause 8) 
                    "3(8pause 8pause 8)")) 
　　　　(add1 (value (8 8) (8.5 16) 
                     "3(8pause 8 8)")) 
　　　　(add2 (value (16pause 16 16 16) 
                     (8 16 16) "3(8 8 8)"))
　　　　(add3 (value (16 16 16 16))))) 

(defun fget-addn-of-4n (n) 
　　(case n 
　　　　(0 (fget-i '4n 'add0)) 
　　　　(1 (fget-i '4n 'add1)) 
　　　　(2 (fget-i '4n 'add2)) 
　　　　(3 (fget-i '4n 'add3)))) 

(defun select-addn-of-4n (n) 
　　(let ((lst (fget-addn-of-4n n))) 
　　　　(nth (random (length lst)) lst))) 

(defun generate-a-list-of-disorder-n (n) 
　　(prog (w num) 
　　　loop 
　　　(setf num (1+ (random n))) 
　　　(if (and (not (member num w)) 
 　　　　　　　(<= num n)) 
　　　　　(push num w)) 
　　　(if (>= (length w) n) 
　　　　　(go exit) 
　　　　  (go loop)) 
　　　exit 
　　　(return w))) 

(defun replace-nth-element-in-a-list (l n e) 
　　(do ((lst l (cdr lst)) 
 　　　　(num 1 (1+ num)) 
   　　　(w)) 
　　　　((null lst) (reverse w)) 
　　　(if (= num n) 
　　　　　(push e w) 
　　　　  (push (car lst) w)))) 

(defun replace-n-place-with-addn-of-4n (n1 l) 
　　(do ((lst 
         (generate-a-list-of-disorder-n 4) 
                (cdr lst)) 
 　　　　(lst2 l (cdr lst2)) 
 　　　　(num1 0 (1+ num1)) 
 　　　　(w '(4 4 4 4))) 
　　　　((= num1 n1) (squash w)) 
　　　(setf w (replace-nth-element-in-a-list 
                       w 
　　　　 　　　　　　　(car lst) 
 　　　　　　　　　　　(select-addn-of-4n 
                           (car lst2)))))) 

;;; 
;;; 
;;; 
(defun add1-4n () 
　　(case (random 3) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                1 '(1))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                2 '(0 1))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                4 '(0 0 0 1))))) 

(defun add2-4n () 
　　(case (random 7) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                3 '(0 1 1))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                4 '(0 0 1 1))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                2 '(0 2))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                3 '(0 0 2))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                4 '(0 0 0 2))) 
　　　　(5 (replace-n-place-with-addn-of-4n 
                2 '(1 1))) 
　　　　(6 (replace-n-place-with-addn-of-4n 
                1 '(2))))) 

(defun add3-4n () 
　　(case (random 8) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                3 '(0 1 2))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                4 '(0 0 1 2))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                4 '(0 1 1 1))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                2 '(0 3))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                4 '(0 0 0 3))) 
　　　　(5 (replace-n-place-with-addn-of-4n 
                2 '(1 2))) 
　　　　(6 (replace-n-place-with-addn-of-4n 
                3 '(1 1 1))) 
　　　　(7 (replace-n-place-with-addn-of-4n 
                1 '(3))))) 

(defun add4-4n () 
　　(case (random 8) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(0 1 1 2))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                3 '(0 1 3))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                4 '(0 0 1 3))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                3 '(0 2 2))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                4 '(0 0 2 2))) 
　　　　(5 (replace-n-place-with-addn-of-4n 
                3 '(1 1 2))) 
　　　　(6 (replace-n-place-with-addn-of-4n 
                2 '(1 3))) 
　　　　(7 (replace-n-place-with-addn-of-4n 
                2 '(2 2))))) 

(defun add5-4n () 
　　(case (random 7) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(0 1 2 2))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                4 '(0 1 1 3))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                3 '(0 2 3))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                4 '(0 0 2 3))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                3 '(1 2 2))) 
　　　　(5 (replace-n-place-with-addn-of-4n 
                2 '(2 3))) 
　　　　(6 (replace-n-place-with-addn-of-4n 
                3 '(1 1 3))))) 

(defun add6-4n () 
　　(case (random 9) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(0 1 2 3))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                3 '(1 2 3))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                4 '(0 2 2 2))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                3 '(0 3 3))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                4 '(0 0 3 3))) 
　　　　(5 (replace-n-place-with-addn-of-4n 
                4 '(1 1 2 2))) 
　　　　(6 (replace-n-place-with-addn-of-4n 
                4 '(1 1 1 3))) 
　　　　(7 (replace-n-place-with-addn-of-4n 
                3 '(2 2 2))) 
　　　　(8 (replace-n-place-with-addn-of-4n 
                2 '(3 3))))) 

(defun add7-4n () 
　　(case (random 6) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(0 1 3 3))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                4 '(0 2 2 3))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                4 '(1 1 2 3))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                3 '(1 3 3))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                4 '(1 2 2 2))) 
　　　　(5 (replace-n-place-with-addn-of-4n 
                3 '(2 2 3))))) 

(defun add8-4n () 
　　(case (random 5) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(1 2 2 3))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                3 '(2 3 3))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                4 '(1 1 3 3))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                4 '(2 2 2 2))) 
　　　　(4 (replace-n-place-with-addn-of-4n 
                4 '(0 2 3 3))))) 

(defun add9-4n () 
　　(case (random 4) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(1 2 3 3))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                4 '(2 2 2 3))) 
　　　　(2 (replace-n-place-with-addn-of-4n 
                3 '(3 3 3))) 
　　　　(3 (replace-n-place-with-addn-of-4n 
                4 '(0 3 3 3))))) 

(defun add10-4n () 
　　(case (random 2) 
　　　　(0 (replace-n-place-with-addn-of-4n 
                4 '(2 2 3 3))) 
　　　　(1 (replace-n-place-with-addn-of-4n 
                4 '(3 3 3 1))))) 

(defun add11-4n () 
　　(replace-n-place-with-addn-of-4n 
                4 '(2 3 3 3))) 

(defun add12-4n () 
　　(replace-n-place-with-addn-of-4n 
                4 '(3 3 3 3))) 

(defun add0-4n () 
　　(nth (random 10) 
           '((4 4 4 4) (4.5 8 4 4) 
             (4 4 4.5 8) (4 4.5 4 8) 
             (4 2 8 8) (2 4 8 8) 
             (4 8 8 2) (2 8 8 4) 
             (8 8 2 4) (4 8 8 2)))) 

(defun add-1-4n () 
　　(nth (random 7) 
           '((2 4 4) (4 4 2) 
             (4 2 4) (4.5 8 2) 
             (2 4.5 8) (2.5 8 8) 
             (8 8 2.5)))) 

(defun add-2-4n () 
　　(nth (random 6) 
           '((2.5 4) (4 2.5) 
             (2.5 4) (4 2.5) 
             (2 2) (2 2)))) 

(defun add-3-4n () 
    (nth (random 2) '((1) (1)))) 

;;; 
;;; 
;;; 
(defun get-rythm-of-4beat (n) 
　　(case n 
　　　　(1 (add-3-4n)) 
　　　　(2 (add-2-4n)) 
　　　　(3 (add-1-4n)) 
　　　　(4 (add0-4n)) 
　　　　(5 (add1-4n)) 
　　　　(6 (add2-4n)) 
　　　　(7 (add3-4n)) 
　　　　(8 (add4-4n)) 
　　　　(9 (add5-4n)) 
　　　　(10 (add6-4n)) 
　　　　(11 (add7-4n)) 
　　　　(12 (add8-4n)) 
　　　　(13 (add9-4n)) 
　　　　(14 (add10-4n)) 
　　　　(15 (add11-4n)) 
　　　　(16 (add12-4n)))) 

(defun get-4beat-below-n (n) 
　　(get-rythm-of-4beat (1+ (random n)))) 

(defun get-4beat () 
　　(get-rythm-of-4beat (1+ (random 16)))) 

;;; 
;;;*************************************** 
;;; 
(make-frame-from-list 
　　'(3n (add0 (value 4 (8pause 8) 
                     "3(8pause 8pause 8)"))
 　　　　(add1 (value (8 8) (8.5 16) 
                      "3(8pause 8 8)")) 
 　　　　(add2 (value (16 16 8) (8 16 16) 
                      "3(8 8 8)")) 
 　　　　(add3 (value (16 16 16 16))))) 

(defun fget-addn-of-3n (n) 
　　(case n 
　　　　(0 (fget-i '3n 'add0)) 
　　　　(1 (fget-i '3n 'add1)) 
　　　　(2 (fget-i '3n 'add2)) 
　　　　(3 (fget-i '3n 'add3)))) 

(defun select-addn-of-3n (n) 
　　(let ((lst (fget-addn-of-3n n))) 
　　　(nth (random (length lst)) lst)))

(defun replace-n-place-with-addn-of-3n (n1 l)
　　(do ((lst 
           (generate-a-list-of-disorder-n 3) 
           (cdr lst)) 
　　 　　(lst2 l (cdr lst2)) 
 　　　　(num1 0 (1+ num1)) 
 　　　　(w '(4 4 4))) 
　　　　((= n1 num1) (squash w)) 
　　　(setf w (replace-nth-element-in-a-list 
                    w 
 　　　　　　　　　(car lst) 
 　　　　　　　　　(select-addn-of-3n 
                       (car lst2)))))) 

(defun add1-3n () 
　　(case (random 3) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 2 '(0 1))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 3 '(0 0 1))) 
　　　　(2 (replace-n-place-with-addn-of-3n 
                 1 '(1))))) 

(defun add2-3n () 
　　(case (random 5) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 3 '(0 1 1))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 2 '(0 2))) 
　　　　(2 (replace-n-place-with-addn-of-3n 
                 3 '(0 0 2))) 
　　　　(3 (replace-n-place-with-addn-of-3n 
                 2 '(1 1))) 
　　　　(4 (replace-n-place-with-addn-of-3n 
                 1 '(2))))) 

(defun add3-3n () 
　　(case (random 4) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 3 '(0 1 2))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 2 '(0 3))) 
　　　　(2 (replace-n-place-with-addn-of-3n 
                 3 '(0 0 3))) 
　　　　(3 (replace-n-place-with-addn-of-3n 
                 2 '(1 2))))) 

(defun add4-3n () 
　　(case (random 5) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 2 '(1 3))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 3 '(0 2 2))) 
　　　　(2 (replace-n-place-with-addn-of-3n 
                 3 '(1 1 2))) 
　　　　(3 (replace-n-place-with-addn-of-3n 
                 2 '(1 3))) 
　　　　(4 (replace-n-place-with-addn-of-3n 
                 2 '(2 2))))) 

(defun add5-3n () 
　　(case (random 4) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 3 '(0 2 3))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 3 '(1 2 2))) 
　　　　(2 (replace-n-place-with-addn-of-3n 
                 2 '(2 3))) 
　　　　(3 (replace-n-place-with-addn-of-3n 
                 3 '(1 1 3))))) 

(defun add6-3n () 
　　(case (random 4) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 3 '(1 2 3))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 3 '(0 3 3))) 
　　　　(2 (replace-n-place-with-addn-of-3n 
                 3 '(2 2 2))) 
　　　　(3 (replace-n-place-with-addn-of-3n 
                 2 '(3 3))))) 

(defun add7-3n () 
　　(case (random 2) 
　　　　(0 (replace-n-place-with-addn-of-3n 
                 3 '(1 3 3))) 
　　　　(1 (replace-n-place-with-addn-of-3n 
                 3 '(2 2 3))))) 

(defun add8-3n () 
　　(replace-n-place-with-addn-of-3n 
                 3 '(2 3 3))) 

(defun add9-3n () 
　　(replace-n-place-with-addn-of-3n 
                 3 '(3 3 3))) 

(defun add0-3n () 
　　(nth (random 5) 
           '((4 4 4) (4 4.5 8) 
             (4.5 8 4) (2 8 8) 
             (8 8 2)))) 

(defun add-1-3n () 
　　(nth (random 2) '((2 4) (4 2))))

(defun add-2-3n () '(2.5)) 

;;; 
;;; 
;;; 
(defun get-rythm-of-3beat (n) 
　　(case n 
　　　　(1 (add-2-3n)) 
　　　　(2 (add-1-3n)) 
　　　　(3 (add0-3n)) 
　　　　(4 (add1-3n)) 
　　　　(5 (add2-3n)) 
　　　　(6 (add3-3n)) 
　　　　(7 (add4-3n)) 
　　　　(8 (add5-3n)) 
　　　　(9 (add6-3n)) 
　　　　(10 (add7-3n)) 
　　　　(11 (add8-3n)) 
　　　　(12 (add9-3n)))) 

(defun get-3beat-below-n (n) 
　　(get-rythm-of-3beat 
          (1+ (random n)))) 

(defun get-3beat () 
　　(get-rythm-of-3beat 
          (1+ (random 12))))