;;; -*- Mode:LISP; Package: (CA :use LISP); Readtable:CL; Base:10 -*-



(defvar *current*)
(defvar *next*)
(defvar *width*)
(defvar *height*)

(defun generation ()
  (dotimes (y *height*)
    (dotimes (x *width*)
      


(defvar *address* 0)

(defvar *x*)
(defvar *y*)
(defvar *array*)

(defmacro center ()
  `(si:ar-2-reverse *current* *x* *y*))

(defmacro north ()
  `(si:ar-2-reverse *current* *x* (1- *y*)))

(defmacro south ()
  `(si:ar-2-reverse *current* *x* (1+ *y*)))

(defmacro east ()
  `(si:ar-2-reverse *current* (1+ *x*) *y*))

(defmacro west ()
  `(si:ar-2-reverse *current* (1- *x*) *y*))

(defmacro n-west ()
  `(si:ar-2-reverse *current* (1- *x*) (1- *y*)))

(defmacro n-east ()
  `(si:ar-2-reverse *current* (1+ *x*) (1- *y*)))

(defmacro s-west ()
  `(si:ar-2-reverse *current* (1- *x*) (1+ *y*)))

(defmacro s-east ()
  `(si:ar-2-reverse *current* (1+ *x*) (1+ *y*)))


(defmacro do-binary (vars &body body)
  (if (null vars)
      `(PROGN ,@body)
    `(DOTIMES (,(car vars) 2)
       (DO-BINARY ,(cdr vars) ,@body))))

(defvar center)

(defvar north)
(defvar south)
(defvar east)
(defvar west)

(defvar n-west)
(defvar n-east)
(defvar s-west)
(defvar s-east)

(defvar *make-address-function*)
(defvar *make-table-function*)

(defun make-address ()
  (funcall *make-address-function*))

(defun make-table (f)
  (funcall *make-table-function* f))

(defmacro %make-address (&rest bits)
  (do ((bits bits (cdr bits))
       (n (1- (length bits)) (1- n))
       (form 0 `(DPB ,(car bits) (BYTE 1 ,n) ,form)))
      ((null bits) form)))
       
(defun make-moore-neighborhood-address ()
  (%make-address n-west north  n-east
	         west   center east
	         s-west south  s-east))

(defun get-moore-neighborhood-address ()
  (%make-address (n-west) (north)  (n-east)
		 (west)   (center) (east)
		 (s-west) (south)  (s-east)))
  
(defun make-moore-neighborhood-table (f) 
  (do-binary (n-west north  n-east
	      west   center east
	      s-west south  s-east)
     (funcall f)))

  
(defun use-moore-neighborhood ()
  (setq *make-address-function* #'make-moore-neighborhood-address)
  (setq *make-table-function*   #'make-moore-neighborhood-table))

(defconstant address-lines 12)
(defvar *plane-0-table* (make-array (expt 2 address-lines) :element-type '(unsigned-byte 1)))

(defun >plane-0 (value)
  (setf (aref *plane-0-table* (make-address))
	value))
  




(defun 8sum ()
  (+ n-west north  n-east
     west          east
     s-west south  s-east))


(defun 1-out-of-8 ()
  (>plane-0
    (if (= 1 (8sum))
	1
      center)))