;;; 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...

;;; Create a unidimensional cellular automata (a linear string of cells)

(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
	;; this implements the rule set of this automata
	(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
;;; can be used to control parameters...

(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))))

(progn 
  (format t "~%")
  (loop 
    with cells = (make-cells 33)
    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
    ;;; start with a non-random state for all cells
    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 (hertz (+ 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
    ;;; start with 23 random cells
    with cells = (make-cells 23)
    repeat 50
    for time from 0 by 0.2
    for population = (population cells)
    do
    (loop for cell across cells do (format t "~a" (if (= cell 1) "*" " ")))
    (format t "~%")
    (fm-violin time 0.1 (hertz (+ 60 population)) 0.1)
    (setf cells (step-cells cells))))

(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 (hertz (+ 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 (hertz (+ 60 population)) 0.1)
    (setf cells (step-cells cells))))

(with-sound ()
  (loop 
    with cells = (make-cells 35)
    repeat 50
    for time from 0 by 0.2
    for population = (population cells)
    do
    (fm-violin time 0.1 (hertz (+ 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
	       (hertz (+ 60 (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells))))

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

;;; map to better control spaces
;;; rhythm is mapped through common music's rhythm function, we override
;;; the overall tempo through "with"

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with index = 0
    with freq-cells = (make-cells 20)
    with rhythm-cells = (make-cells 20)
    with index-cells = (make-cells 30)
    with *tempo* = 190
    repeat 60
    do
    (setf rhythm (rhythm (/ (population rhythm-cells) 40)))
    (setf index (/ (- (population index-cells) 10) 4))
    (format t "~s " (population index-cells))
    (fm-violin (+ time rhythm) rhythm
	       (hertz (+ 60 (population freq-cells))) 0.1 :fm-index index)
    (incf time rhythm)
    ;;; next generation
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells)
	  index-cells (step-cells index-cells))))

;;; variable tempo

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with index = 0
    with freq-cells = (make-cells 20)
    with rhythm-cells = (make-cells 20)
    with index-cells = (make-cells 30)
    ;; an envelopt we use to set the overall tempo
    with tempo-control = '(0 120 2 120 6 400 10 60)
    repeat 60
    do
    (setf rhythm (rhythm (/ (population rhythm-cells) 40) (interpl time tempo-control)))
    (setf index (/ (- (population index-cells) 10) 4))
    (format t "~s " (population index-cells))
    (fm-violin (+ time rhythm) rhythm
	       (hertz (+ 60 (population freq-cells))) 0.1 :fm-index index)
    (incf time rhythm)
    ;;; next generation
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells)
	  index-cells (step-cells index-cells))))

;;; add a constant to the duration of the notes... legato

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with index = 0
    with freq-cells = (make-cells 20)
    with rhythm-cells = (make-cells 20)
    with index-cells = (make-cells 30)
    with tempo-control = '(0 120 2 120 6 400 10 60)
    while (< time 10)
    do
    (setf rhythm (expt (rhythm (/ (population rhythm-cells) 40) (interpl time tempo-control)) 1.6))
    (setf index (/ (- (population index-cells) 10) 4))
    (format t "~s " (population index-cells))
    (fm-violin (+ time rhythm) (+ rhythm 0.1)
	       (hertz (+ 60 (population freq-cells))) 0.1 :fm-index index)
    (incf time rhythm)
    ;;; next generation
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells)
	  index-cells (step-cells index-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 interesting...)

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with freq-cells = (make-cells 20)
    with rhythm-cells = (make-cells 20)
    ;; create a list with the rythm mapping
    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
	       (hertz (+ 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
	       (hertz (+ 40 (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells))))

;;; Now we map duration as well as rhythm...

(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)))
    with duration-cells = (make-cells 60)
    with duration-map = (loop repeat 60 collect (expt 2 (random 6)))
    repeat 60
    do
    (setf rhythm (/ (nth (population rhythm-cells) rhythm-map) 40))
    (setf duration (/ (nth (population duration-cells) duration-map) 40))
    (format t "~s:~s [~s]  " (population rhythm-cells) (float rhythm) (float duration))
    (fm-violin (+ time rhythm) duration
	       (hertz (+ 40 (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells)
	  duration-cells (step-cells duration-cells))))

;;; mapping pitches to a given set

(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)))
    with duration-cells = (make-cells 60)
    with duration-map = (loop repeat 60 collect (expt 2 (random 6)))
    with scale-map = '(5 12 13 14 17 19 20 24 25 35)
    repeat 60
    do
    (setf pitch (+ 60 (nth (mod (population freq-cells)
				(length scale-map))
			   scale-map)))
    (setf rhythm (/ (nth (population rhythm-cells) rhythm-map) 40))
    (setf duration (/ (nth (population duration-cells) duration-map) 40))
    (format t "~s:~s [~s]  " (population rhythm-cells) (float rhythm) (float duration))
    (fm-violin (+ time rhythm) duration
	       (hertz pitch) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells)
	  duration-cells (step-cells duration-cells))))

;;; or use note names

(defun map (input map)
  (nth (mod input (length map)) map))

(with-sound ()
  (loop 
    with time = 0
    with rhythm = 0
    with freq-cells = (make-cells 60)
    with rhythm-cells = (make-cells 60)
    with rhythm-map = '(q q q e s s.)
    with duration-cells = (make-cells 60)
    with duration-map = '(q q w s s s s)
    with scale-map = '(a4 as4 a5 f3 g4 cs3 c3)
    with *tempo* = 120
    repeat 60
    do
    (setf note (map (population freq-cells) scale-map))
    (setf rhythm (rhythm (map (population rhythm-cells) rhythm-map)))
    (setf duration (rhythm (map (population duration-cells) duration-map)))
    (format t "~s:~s [~s]  " (population rhythm-cells) (float rhythm) (float duration))
    (fm-violin (+ time rhythm) duration (hertz note) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells)
	  duration-cells (step-cells duration-cells))))

;;; define a function that "runs" an automata

(defun run-automata (start-time duration cells
				&key
				(rhythm-cell-number 60)
				(rhythm-scaler 1.0)
				(pitch-scaler 1.0)
				(pitch-offset 40.0))
  (loop 
    with time = start-time
    with rhythm = 0
    with freq-cells = (make-cells cells)
    with rhythm-cells = (make-cells cells)
    with rhythm-map = (loop repeat rhythm-cell-number collect (expt 2 (random 5)))
    while (< (- time start-time) duration)
    do
    (setf rhythm (* rhythm-scaler (/ (nth (population rhythm-cells) rhythm-map) 40)))
    (format t "~s:~s " (population rhythm-cells) (float rhythm))
    (fm-violin (+ time rhythm) rhythm
	       (hertz (+ pitch-offset (population freq-cells))) 0.1)
    (incf time rhythm)
    (setf freq-cells (step-cells freq-cells)
	  rhythm-cells (step-cells rhythm-cells))))

;;; add another layer

(defun bunch-of-automata (start-time duration number from-pop to-pop)
  (loop
    with population-increment = (/ (- to-pop from-pop) number)
    repeat number
    for population from from-pop by population-increment
    do
    (run-automata start-time duration (floor population)
		  :pitch-offset (+ 30 (/ population 2))
		  :rhythm-scaler (* population 0.3))))


;;; 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 (hertz (+ 30 (min 128 (* index 4)))) 0.05)))
    ;; create next generation
    (setf cells (step-cells cells))))

(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 do (format t "~a" (if (= cell 1) "*" " ")))
    (format t "~%")
    (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 (hertz (+ 30 (min 128 (* index 4)))) 0.05)))
    ;; create next generation
    (setf cells (step-cells cells))))

; add another automata that controls rhythms

(with-sound ()
  (loop 
    with cells = (make-cells '(0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0))
    with rcells = (make-cells '(0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0))
    repeat 20
    with time = (make-array (length cells) :initial-element 0.0)
    do
    (loop for cell across cells do (format t "~a" (if (= cell 1) "*" " ")))
    (format t "~%")
    (loop 
      for cell across cells
      for index from 0
      do
      (if (= cell 1)
	  ;; if it is there then it sings its note
	  (progn
	    (fm-violin (aref time index) 0.1 (hertz (+ 30 (min 128 (* index 4)))) 0.05)
	    (incf (aref time index)(if (= (aref rcells index) 1)
				       (+ (random 0.3) 0.5) (+ (random 0.03) 0.1))))))
    ;; create next generation
    (setf cells (step-cells cells)
	  rcells (step-cells rcells))))

(with-sound ()
  (loop
    with *tempo* = 180
    with cells = (make-cells '(0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0))
    with rcells = (make-cells '(0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0))
    repeat 20
    with time = (make-array (length cells) :initial-element 0.0)
    do
    (loop for cell across cells do (format t "~a" (if (= cell 1) "*" " ")))
    (format t "~%")
    (loop 
      for cell across cells
      for index from 0
      do
      (if (= cell 1)
	  ;; if it is there then it sings its note
	  (progn
	    (fm-violin (aref time index) 0.1 (hertz (+ 30 (min 128 (* index 4)))) 0.05)
	    (incf (aref time index)(rhythm (if (= (aref rcells index) 1)
					       (+ (random 0.3) 0.5) (+ (random 0.03) 0.1)))))))
    ;; create next generation
    (setf cells (step-cells cells)
	  rcells (step-cells rcells))))

;;; 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 (new heap :of (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 (hertz (min 128 (+ 20 (* index 6)(next (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 (new cycle :of (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 (hertz (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
					     (next (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 (hertz (+ 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 (hertz (+ 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))))


;;; restrict singing to some individuals

(with-sound ()
  (loop 
    with note-cells = (make-cells '(0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 0))
    with amp-cells = (make-cells '(0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0))
    repeat 30
    for time from 0 by 0.2
    do
    (loop for cell across note-cells do (format t "~a" (if (= cell 1) "*" " ")))
    (format t "~%")
    (loop 
      for note across note-cells
      for index from 0
      do
      (if (and (= note 1)(= 0 (mod note 4)))
	  (fm-violin (+ time (- (random 0.2) 0.1))
		     0.1 (hertz (+ 60 (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))))