;;;
;;; life.scm
;;;
;;; John Conway's game of life.
;;;
;;; ADU SICP October 2000.
;;;
;;; Original authorship unknown.  Adapted by John Pezaris, October 2000. 


;;; filter
;;;
;;; The standard procedure.  Used here and there.

(define (filter pred lst)
  (cond ((null? lst) nil)
	((pred (car lst))
	 (cons (car lst)
	       (filter pred (cdr lst))))
	(else
	 (filter pred (cdr lst)))))


;;; make-basic-cell
;;;
;;; 

(define (make-basic-cell rule)
  (define neighbors nil)
  (define state nil)
  (define next-state nil)
  (lambda (m)
    (cond ((eq? m 'change-state)
	   (set! state (rule state neighbors)))
	  ((eq? m 'current-state) state)
	  ((eq? m 'set-neighbors)
	   (lambda (n) (set! neighbors n)))
	  ((eq? m 'set-state)
	   (lambda (s) (set! state s)))
	  (else (error "bad message" m)))))


;;; life
;;;
;;; The main algorithm.  If a cell is alive and has two or three
;;; neighbors which are also alive, then the cell stays alive.  If the
;;; cell is dead, and three of its neighbors are alive, then it
;;; spontaneously generates.  Otherwise, it dies.

(define (life state neighbors)
  (let ((nbhd (count-neighbors neighbors)))
    (or (and state
	     (or (= nbhd 2) (= nbhd 3)))
	(and (not state)
	     (= nbhd 3)))))


;;; count-neighbors
;;;
;;; This counts the neighbors whose state is true.  

(define (count-neighbors neighbors)
  (length 
   (filter (lambda (c) (c 'current-state)) neighbors)))


(define (life-cell) (make-basic-cell life))


;;; make-cellular-space
;;;
;;; Cellular space constructor.

(define (make-cellular-space i n type)
  (if (= i 0)
      nil
      (cons (make-row n type)
	    (make-cellular-space (dec i) n type))))

(define (make-row n type)
  (if (= n 0)
      nil
      (cons (type)
	    (make-row (dec n) type))))


;;; cell
;;;
;;; Reference the cell at a particular address.

(define (cell cs x y)
  (cond ((or (< x 0) (< y 0))
	 nil)
	((or (<= (machine-x-size cs) x)
	     (<= (machine-y-size cs) y))
	 nil)
	(else (list-ref
	       (list-ref cs y) x))))


;;; make-machine
;;;
;;; Make a cellular machine.

(define (make-machine n type)
  (let ((cs (make-cellular-space n n type)))
    (wire-cs cs (dec n) (dec n) (dec n))
    cs))


;;; wire-cs
;;;
;;; Establish the grid of connections.

(define (wire-cs cs x y n)
  (cond ((< x 0) nil)
	((< y 0) (wire-cs cs (dec x) n n))
	(else
	 (((cell cs x y) 'set-neighbors)
	  (filter (lambda (x) x)
		  (list (cell cs (dec x) y      ) (cell cs (dec x) (dec y))
			(cell cs (inc x) y      ) (cell cs (inc x) (inc y))
			(cell cs x       (dec y)) (cell cs (dec x) (inc y))
			(cell cs x       (inc y)) (cell cs (inc x) (dec y)))))
	 (wire-cs cs x (dec y) n))))



;;; machine-x-size
;;; machine-y-size
;;;
;;; Measure how big the machine is.

(define (machine-x-size cs)
  (length (car cs)))

(define (machine-y-size cs)
  (length cs))


;;; print-machine
;;;
;;; Print the state of the machine.

(define (print-machine cs)
  (cond ((null? cs)
	 (newline))
	(else
	 (newline)
	 (display ";;; ")
	 (print-row     (car cs))
	 (print-machine (cdr cs)))))


(define (print-row r)
  (cond ((null? r) nil)
	(else (if ((car r) 'current-state)
		  (display "@ ")
		  (display ". "))
	      (print-row (cdr r)))))


;;; clock
;;;
;;; Clock the machine.  Tell each cell to compute the next state (tick
;;; messages), and then to take on that next state (tock messages).
;;; Also print the state of the machine after each cycle.

(define (clock cs n)
  (define (clock-iter i)
    (if (< n i)
	(begin
	  (newline)
	  #t)
	(begin
	  (newline)
	  (all-cells cs 'tick)
	  (all-cells cs 'tock)
	  (display ";;; Cycle ")
	  (display i)
	  (print-machine cs)
	  (clock-iter (inc i)))))
  (display ";;; Cycle ")
  (display 0)
  (print-machine cs)
  (clock-iter 1))

(define (all-cells cs m)
  (map (lambda (r)
	 (map (lambda (o) (o m))
	      r))
       cs))


;;; make-basic-cell
;;;
;;; Corrected version to include clock

(define (make-basic-cell rule)
  (define neighbors  nil)
  (define state      nil)
  (define next-state nil)
  (lambda (m)
    (cond ((eq? m 'tick)          (set! next-state (rule state neighbors)))
	  ((eq? m 'tock)          (set! state next-state))
	  ((eq? m 'current-state) state)
	  ((eq? m 'set-neighbors) (lambda (n) (set! neighbors n)))
	  ((eq? m 'get-neighbors) neighbors)
	  ((eq? m 'set-state)     (lambda (s) (set! state s)))
	  (else                   (error "bad message" m)))))


;;; blinker
;;;
;;; Construct the classic structure.

(define (blinker)
  (define m (make-machine 3 life-cell))
  (((cell m 0 1) 'set-state) #t)
  (((cell m 1 1) 'set-state) #t)
  (((cell m 2 1) 'set-state) #t)
  m)


;;; random-start
;;;
;;; Construct a random structure and let it evolve.  See the info
;;; entry on the unusual "named-LET" usage.a

(define (random-start)
  (define size 10)
  (define m    (make-machine size life-cell))
  (define n    20)                           ; number of cells starting alive
  (let loop ((i 0))
    (cond ((< i n)
	   (((cell m (random size) (random size)) 'set-state) #t)
	   (loop (inc i)))))
  m)



;;; Let's make a blinker!
;;;

(define b (blinker))

(clock b 5)

;;; Cycle 0
;;; . . . 
;;; @ @ @ 
;;; . . . 

;;; Cycle 1
;;; . @ . 
;;; . @ . 
;;; . @ . 

;;; Cycle 2
;;; . . . 
;;; @ @ @ 
;;; . . . 

;;; Cycle 3
;;; . @ . 
;;; . @ . 
;;; . @ . 

;;; Cycle 4
;;; . . . 
;;; @ @ @ 
;;; . . . 

;;; Cycle 5
;;; . @ . 
;;; . @ . 
;;; . @ . 

;Value: #t



;;; And one of these, too!  (The output below has been re-edited to
;;; fit in fewer pages.  Normally, each clock cycle would appear one
;;; below the next, as for the six cycles above.)

(define r (random-start))

(clock r 10)

;;; Cycle 0               ;;; Cycle 1               ;;; Cycle 2
;;; @ . @ . . . . @ . @   ;;; . . . . . . . . @ .   ;;; . . . . . . . . @ @ 
;;; . . . . . . . . @ .   ;;; . . . . . . . . @ @   ;;; . . . . . . . @ . . 
;;; . . . . . @ . . . @   ;;; . . . . . . . . @ @   ;;; . . . . . . . . @ @ 
;;; . . . . . . . . . @   ;;; . . . . . . . . . .   ;;; . . @ . . . . . . . 
;;; . . @ . . . . . . .   ;;; . @ @ @ . . . . . .   ;;; . @ . @ . . . . . . 
;;; . @ @ . @ . . . . .   ;;; . @ @ . . . . . . .   ;;; @ . . . @ . @ . . . 
;;; @ . . @ . . @ . . .   ;;; . @ @ @ . @ @ @ . .   ;;; . @ . @ . @ . . @ . 
;;; . . . . . . @ @ . .   ;;; . . . . . . @ @ @ .   ;;; . . @ . . @ . . . . 
;;; . . . . . . . . @ @   ;;; . . . . . . . @ @ .   ;;; . . . . . . @ . @ . 
;;; . . . . . . . . . .   ;;; . . . . . . . . . .   ;;; . . . . . . . . . . 

;;; Cycle 3               ;;; Cycle 4               ;;; Cycle 5
;;; . . . . . . . . @ .   ;;; . . . . . . . . . .   ;;; . . . . . . . . . . 
;;; . . . . . . . @ . .   ;;; . . . . . . . @ @ .   ;;; . . . . . . . . . . 
;;; . . . . . . . . @ .   ;;; . . . . . . . . . .   ;;; . . @ . . . . . . . 
;;; . . @ . . . . . . .   ;;; . @ @ @ . . . . . .   ;;; . @ @ . . . . . . . 
;;; . @ @ @ . . . . . .   ;;; @ . . . . . . . . .   ;;; @ . @ . . . . . . . 
;;; @ @ . @ @ @ . . . .   ;;; @ . . . . @ @ . . .   ;;; @ @ . . . . @ . . . 
;;; . @ @ @ . @ @ . . .   ;;; @ . . . . . . @ . .   ;;; @ . . . . @ . @ . . 
;;; . . @ . @ @ @ @ . .   ;;; . @ @ . @ . . @ . .   ;;; . @ . . . @ . @ . . 
;;; . . . . . . . . . .   ;;; . . . . . @ @ . . .   ;;; . . . . . @ @ . . . 
;;; . . . . . . . . . .   ;;; . . . . . . . . . .   ;;; . . . . . . . . . . 

;;; Cycle 6               ;;; Cycle 7               ;;; Cycle 8
;;; . . . . . . . . . .   ;;; . . . . . . . . . .   ;;; . . . . . . . . . . 
;;; . . . . . . . . . .   ;;; . . . . . . . . . .   ;;; . . @ . . . . . . . 
;;; . @ @ . . . . . . .   ;;; . @ @ @ . . . . . .   ;;; . . @ @ . . . . . . 
;;; . . @ @ . . . . . .   ;;; . . . @ . . . . . .   ;;; . @ . . @ . . . . . 
;;; @ . @ . . . . . . .   ;;; . . @ @ . . . . . .   ;;; . . @ @ . . . . . . 
;;; @ . . . . . @ . . .   ;;; @ . . . . . @ . . .   ;;; . . . @ @ @ @ . . . 
;;; @ . . . . @ . @ . .   ;;; . . . . @ @ . @ . .   ;;; . . . . @ @ . @ . . 
;;; . . . . @ @ . @ . .   ;;; . . . . @ . . @ . .   ;;; . . . @ . . . @ . . 
;;; . . . . . @ @ . . .   ;;; . . . . @ @ @ . . .   ;;; . . . . @ @ @ . . . 
;;; . . . . . . . . . .   ;;; . . . . . . . . . .   ;;; . . . . . @ . . . . 

;;; Cycle 9               ;;; Cycle 10
;;; . . . . . . . . . .   ;;; . . . . . . . . . . 
;;; . . @ @ . . . . . .   ;;; . @ . @ . . . . . . 
;;; . @ @ @ . . . . . .   ;;; . @ . . @ . . . . . 
;;; . @ . . @ . . . . .   ;;; . @ . . . . . . . . 
;;; . . @ . . . . . . .   ;;; . @ @ @ . . . . . . 
;;; . . @ . . . @ . . .   ;;; . . . . . . . . . . 
;;; . . . . . . . @ . .   ;;; . . . . . . @ @ . . 
;;; . . . @ . . . @ . .   ;;; . . . . @ @ . @ . . 
;;; . . . . @ @ @ . . .   ;;; . . . @ . . . @ . . 
;;; . . . . @ @ @ . . .   ;;; . . . . @ . @ . . . 

;Value: #t

;;;
;;; end.