;; automata-envelopes.lisp
;; By Matt Wright, based on Cellular Automata code from Nando
;; and Nando's idea of making (amplitude) envelopes out of them

;; Some examples to try:

#|
(load "automata-envelopes.lisp")
(setf c (make-cells 10))
(add-n-nearby c 3)
(setf envs (make-ca-envelopes 30 10 20 ))
(setf envs (make-ca-envelopes 100 10 20 ))
(hear-envelopes envs 2.0 0.2)
(hear-envelopes (make-ca-envelopes 40 10 3) 2.0 0.2 :freq 100)
|#


(defun hear-envelopes (envs length space &key (freq 440))
  (with-sound ()
     (loop for env in envs
       for time from 0 by (+ length space) do
       (format T "~s~%" env)
       (fm-violin time length freq 0.1 :amp-env env) )))


(defun make-ca-envelopes (size n smoothness &key (scale 1.0))
  ;; Create a sequence of cellular automata envelopes
  (loop
    with cells = (make-cells size)
    repeat n
    collect
      (let* ((points (add-n-nearby cells smoothness))
	     (tapered (append '(0) points '(0)))
	     (unscaled (points->env tapered 0 0.1))
	     (scaled (normalize-envelope unscaled scale)))
	(setf cells (step-cells cells))
	scaled)))


;; Trivial recursive procedure to turn a set of numbers into
;; a CLM-style envelope
(defun points->env (points start interval)
  (if (endp points)
      '()
      (cons start
	    (cons (car points)
		  (points->env (cdr points) (+ start interval) interval) ))))


;; More interesting procedure (designed by Rego) that produces
;; irregularly-sampled envelopes
(defun points->env2 (points start interval)
  (if (endp points)
      '()
      (cons start
	    (cons (car points)
		  (points->env2 (cdr points) (+ interval start) (* 1.2 interval)) ))))




(defun add-n-nearby (cells n)
;; "Running sum filter": add each consecutive n values of the given array
;; and return the answers in a list.  (To smooth the 1/0 cell array.)
  (let ((size (length cells)))
    (loop for i from 0 to (- size n) collect 
	  (loop for j from i below (+ i n) sum (aref cells j)) )))



;; The rest of this is from fabric.lisp:


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

;;; 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 (length cells))
	 (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))