;;; An example of a unidimensional automaton

;;; Return an array to be used as population
;;;
;;; if the argument is a number return an array of that size
;;; filled with a random population, if it is a list then 
;;; return an array of the size of the list with the list as
;;; initial contents

;;; NOTE: compile and load the fm-violin before running the 
;;; examples, you should also load "make-cells", "step-cells"
;;; and "population" as those functions are needed by all the
;;; examples...

(defun make-cells (arg)
  (let* ((size (if (listp arg)
		   (length arg)
		 arg)))
    (make-array size
		:initial-contents (if (listp arg)
				      arg
				    (loop repeat size 
				      collect (if (< (random 1.0) 0.5) 0 1))))))
	      
;;; Create the next generation of cells

(defun step-cells (cells)
  ;; cells is a one dimensional array, elements contain either
  ;; a zero (the cell is dead) or one (the cell is alive)
  (let* ((size (array-dimension cells 0))
	 (next (make-array size :initial-element 0)))
    (loop for i from 0 below size do
      (let* ((neighbors (list (aref cells i)
			      (aref cells (mod (+ i 1) size))
			      (aref cells (mod (+ i 2) size)))))
	;; set the guy in the middle to be born, hang on or die
	(setf (aref next (mod (+ i 1) size))
	      (cond
	       ((equal neighbors '(0 0 0)) 0)
	       ((equal neighbors '(0 0 1)) 1)
	       ((equal neighbors '(0 1 0)) 1)
	       ((equal neighbors '(0 1 1)) 0)
	       ((equal neighbors '(1 0 0)) 1)
	       ((equal neighbors '(1 0 1)) 1)
	       ((equal neighbors '(1 1 0)) 0)
	       ((equal neighbors '(1 1 1)) 0)
	       ;; we should never get here...
	       (t nil)))))
    ;; return the next generation
    next))

;;; return number of critters that are alive on the current generation

(defun population (cells)
  (loop for cell across cells sum cell))

;;; EXAMPLES:

;;; here we step the automata through 20 generations...

(progn 
  (format t "~%")
  (loop 
    with cells = (make-cells '(0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0))
    repeat 20
    do
    (loop for cell across cells do (format t "~a" (if (= cell 1) "*" " ")))
    (format t "~%")
    (setf cells (step-cells cells))))

;;; print the population of the automata over 20 generations

(loop 
  with cells = (make-cells '(0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0))
  repeat 20
  do
  (format t "~s~%" (population cells))
  (setf cells (step-cells cells)))

;;; link the population of the automata to a controlled parameter
;;; in this example: pitch of the fm-violin notes...
;;; pretty boring uh?

(with-sound ()
  (loop 
    with cells = (make-cells '(0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0))
    repeat 50
    for time from 0 by 0.2
    for population = (population cells)
    do
    (fm-violin time 0.1 (pitch (+ 60 population)) 0.1)
    (setf cells (step-cells cells))))

;;; let's try the same example but seeded with a random population
;;; it eventually finds the loop point again...

(with-sound ()
  (loop 
    with cells = (make-cells 23)
    repeat 50
    for time from 0 by 0.2
    for population = (population cells)
    do
    (fm-violin time 0.1 (pitch (+ 60 population)) 0.1)
    (setf cells (step-cells cells))))

;;; one more cell and it's not the same...

(with-sound ()
  (loop 
    with cells = (make-cells 24)
    repeat 50
    for time from 0 by 0.2
    for population = (population cells)
    do
    (fm-violin time 0.1 (pitch (+ 60 population)) 0.1)
    (setf cells (step-cells cells))))

;;; Control more than one parameter with different automatas:
;;;
;;; freq-cells controls frequency
;;; rhythm-cells control rhythm

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with freq-cells = (make-cells 20)
    with rhythm-cells = (make-cells 20)
    repeat 60
    do
    (setf rhythm (/ (population rhythm-cells) 40))
    (format t "~s:~s " (population rhythm-cells) (float rhythm))
    (fm-violin (+ time rhythm) rhythm
	       (pitch (+ 60 (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells))))

;;; on this example we control rhythm through a random
;;; "tempo map" that has powers of two as the map value
;;; (very short "rhythm" values give rise to some sort of
;;; inflections that could be inetersting...)

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with freq-cells = (make-cells 20)
    with rhythm-cells = (make-cells 20)
    with rhythm-map = (loop repeat 20 collect (expt 2 (random 5)))
    repeat 60
    do
    (setf rhythm (/ (nth (population rhythm-cells) rhythm-map) 40))
    (format t "~s:~s " (population rhythm-cells) (float rhythm))
    (fm-violin (+ time rhythm) rhythm
	       (pitch (+ 60 (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells))))

;;; and another run with different parameters
;;; (obviously this could be turned into a function
;;; with the appropriate parameters...)

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with freq-cells = (make-cells 60)
    with rhythm-cells = (make-cells 60)
    with rhythm-map = (loop repeat 60 collect (expt 2 (random 5)))
    repeat 60
    do
    (setf rhythm (/ (nth (population rhythm-cells) rhythm-map) 40))
    (format t "~s:~s " (population rhythm-cells) (float rhythm))
    (fm-violin (+ time rhythm) rhythm
	       (pitch (+ 40 (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells))))

;;; So far examples have focused on tracking population of the
;;; automata. The following examples try to focus on the individuals
;;; and maps their comings and goings to a parameter...

;;; in the following code snippet each individual in the automata
;;; is assigned a distinct pitch. If the critter is there a note
;;; sounds, otherwise silence (are they singing while alive?)

(with-sound ()
  (loop 
    with cells = (make-cells '(0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0))
    repeat 20
    for time from 0 by 0.2
    do
    (loop 
      for cell across cells
      for index from 0
      do
      (if (= cell 1)
	  ;; if it is there then it sings its note
	  (fm-violin time 0.1 (pitch (+ 30 (min 128 (* index 4)))) 0.05)))
    ;; create next generation
    (setf cells (step-cells cells))))

;;; what about giving each _cell_ a random song to sing? (if they are alive)
;;; this cells will have really good memories... they'll keep singing the 
;;; same tune at the same place they left it when they last passed away...

(with-sound ()
  (loop 
    with cells = (make-cells '(0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0))
    with songs = (make-array 
		  ;; we want as many songs as we have cells
		  (length cells)
		  ;; create the item streams that are going to the "songs"
		  :initial-contents
		  (loop repeat (length cells)
		    collect (make-item-stream 'items 'heap 
					      (loop repeat 6 collect (random 6)))))
    repeat 20
    for time from 0 by 0.2
    do
    (loop 
      for cell across cells
      for index from 0
      do
      (if (= cell 1)
	  ;; if it is there then it sings its note
	  (fm-violin time 0.1 (pitch (min 128 (+ 20 (* index 6)(item (aref songs index))))) 0.05)))
    ;; create next generation
    (setf cells (step-cells cells))))

;;; one more go with a random population and some different numbers in it...

(with-sound ()
  (loop 
    with cells = (make-cells 24)
    with songs = (make-array 
		  ;; we want as many songs as we have cells
		  (length cells)
		  ;; create the item streams that are going to the "songs"
		  :initial-contents
		  (loop repeat (length cells)
		    collect (make-item-stream 'items 'cycle 
					      (loop repeat 6 collect (random 4)))))
    repeat 20
    for time from 0 by 0.2
    do
    (loop 
      for cell across cells
      for index from 0
      do
      (if (= cell 1)
	  ;; if it is there then it sings its note
	  (fm-violin time 0.1 (pitch (min 128 
					  ;; minimum note number plus
					  (+ 10 
					     ;; this guy's order in the automata *6 plus
					     (* index 6)
					     ;; the offset for the song it is singing
					     (item (aref songs index))))) 0.05)))
    ;; create next generation
    (setf cells (step-cells cells))))

;;; In the following example we are randomly altering the onset time
;;; of each note, chords are now randomly arpegiated...

(with-sound ()
  (loop 
    with note-cells = (make-cells '(0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0))
    with amp-cells = (make-cells '(0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0))
    repeat 20
    for time from 0 by 0.2
    do
    (loop 
      for note across note-cells
      for index from 0
      do
      (if (= note 1)
	  (fm-violin (+ time (- (random 0.2) 0.1))
		     0.1 (pitch (+ 30 (min 128 (* index 4)))) 
		     (/ (population amp-cells)(length amp-cells) 10))))
    (setf note-cells (step-cells note-cells))
    (setf amp-cells (step-cells amp-cells))))

(with-sound ()
  (loop 
    with note-cells = (make-cells 20)
    with amp-cells = (make-cells 20)
    repeat 20
    for time from 0 by 0.2
    do
    (loop 
      for note across note-cells
      for index from 0
      do
      (if (= note 1)
	  (fm-violin (+ time (- (random 0.2) 0.1))
		     0.1 (pitch (+ 30 (min 128 (* index 4)))) 
		     (/ (population amp-cells)(length amp-cells) 10))))
    (setf note-cells (step-cells note-cells))
    (setf amp-cells (step-cells amp-cells))))