(defstruct (world (:print-function
(lambda (s d o)
(declare (ignore d))
(format s "#<world: ~D>" (world-numdots world)))))
size
current
numdots
next
(xmin 1000000)
(xmax -1)
(ymin 1000000)
(ymax -1))
(defun setnext (world i j)
(let* ((current (world-current world))
(next (world-next world))
(neighbors (count-neighbors current i j)))
(if (zerop (bit current i j))
(cond ((not (= neighbors 3))
(setf (bit next i j) 0))
(t (setf (bit next i j) 1)
(incf (world-numdots world))))
(cond ((or (= neighbors 2)
(= neighbors 3))
(setf (bit next i j) 1))
(t (setf (bit next i j) 0)
(decf (world-numdots world)))))
(unless (zerop (bit next i j))
(when (< i (world-xmin world)) (setf (world-xmin world) i))
(when (> i (world-xmax world)) (setf (world-xmax world) i))
(when (< j (world-ymin world)) (setf (world-ymin world) j))
(when (> j (world-ymax world)) (setf (world-ymax world) j)))))
(defun count-neighbors (array i j)
(+ (bit array (1- i) (1- j))
(bit array i (1- j))
(bit array (1+ i) (1- j))
(bit array (1- i) j)
(bit array (1+ i) j)
(bit array (1- i) (1+ j))
(bit array i (1+ j))
(bit array (1+ i) (1+ j))))
(defun next-cycle (world)
(let* ((lim (world-size world))
(current (world-current world))
(next (world-next world))
(xlb (max 1 (1- (world-xmin world))))
(xub (min (- lim 2) (1+ (world-xmax world))))
(ylb (max 1 (1- (world-ymin world))))
(yub (min (- lim 2) (1+ (world-ymax world)))))
(dotimes (i (1+ (- xub xlb)))
(dotimes (j (1+ (- yub ylb)))
(setnext world (+ i xlb) (+ j ylb))))
(dotimes (y lim)
(dotimes (x lim)
(setf (bit current x y) (bit next x y))))))
(defun print-world (world generations)
(let ((lim (world-size world))
(current (world-current world)))
(dotimes (y lim)
(dotimes (x lim)
(if (zerop (bit current y x))
(princ " ")
(princ "*")))
(terpri))
(format t "~&~d Generations, ~d Organisms."
generations (world-numdots world))))
(defun propagate (world cycles)
(print-world world cycles)
(do ()
((zerop (world-numdots world))
(format t "~2&POPULATION 0 ... ~d generations" cycles))
(next-cycle world)
(incf cycles)
(print-world world cycles)))
(defun life (source)
(let* ((size (length (car source)))
(life (make-world
:size size
:current (make-array (list size size) :element-type "bit
:initial-contents source)
:next (make-array (list size size) :element-type "bit
:initial-element 0)
:numdots 0)))
(dotimes (i size)
(dotimes (j size)
(unless (zerop (bit (world-current life) i j))
(incf (world-numdots life))
(when (< i (world-xmin life)) (setf (world-xmin life) i))
(when (> i (world-xmax life)) (setf (world-xmax life) i))
(when (< j (world-ymin life)) (setf (world-ymin life) j))
(when (> j (world-ymax life)) (setf (world-ymax life) j)))))
(propagate life 0)))
...::::::..
.::::... ...::::.
.^:. .. .:^:
^^ .^^!~!!~~~^:. :^.
~. :77~7^!~^^^^^^:^^ ~:
~. .7^::~^^:^^^^^^^^~~ ~.
:^ !7::: :::^^^^!~~~!~ :^
^: ^75?7: ^?5~~^!~~^^~~ ~
:^ ^~~^~: .~!::.~?^^^~~ .~
~. :^ :~^ 7~!~~7. ~.
.~. ^^ ^: :J!^^^7^ ^:
.^: :^: ...:^^J~~^~! .^:
:^: ~^.:... ^7^~^~! .^^.
.!7~~^~:~^7^^~^~7!^
.^!!!~!~~!~7! ~^~^^~.
:~:^^:~^^^^~^^^!.~:7^
^^!^!~:^7.::~:^~7~~:.
~^!.^.~:!.!~::^~~::!!.
^^^!^:!7..~!^^^^:^^~!.~.
! : !.^.!:7^^~^~~^!.^..!
7^^:?^::7~!:.~:.~ .:.^~!^
^::^.^:~.^:!..:.:^^~~^^^!.
~:!^.:7~:~^7~^~^^^^^^^~.~
~^^~^^^.:7~?^:~:^~ ~.^.^:
:^: :7~~~^!~:.^.:: . .:!
:~~~^^.^!~:^:. ..:^^^~^
:!^!^~!7 !7^^^~:^^ ~.
~:~!~^7. !~7~ :^ :^ ~
^: !:^!:.!^.!7:.^::^:~
^:.^ !^^! ^~^7^:::..:^
^:~. :^!.~ ~::^:!:. :^.
~^^ ^^7.:~.! ~ ^:.::.:^:.
:!^ ~~.7^~^!::^ ~ .::^~.
.:^~^: :!^ !.~::~.~ !
:~~^:..~::^^~^~ ^..!^~^!
!~7!. :~!~:..?! ~ ^:^^:~
:7 7: !!~7. !.:^ ~ ~ ~.
. !.^~ ~!^~:~^^.:^
.^~^~^~!^:^^
:^^:^.~:?^^:
:^.~.~.~.!^
~ ^::^ ~ !
.^~ ^..~ ^:.^.
:^^^~ .~ ^^ ^:.:::.....::
:^^^^^!: :^ :^..:::::::::!:
:^:^:^:^^!: .^:.:::::::::^~^
^::^.^.^:^:.^:..:::::::^~~~.
~:.~ ~.:^ ~ .:::::^^^^^:
^^ ~ :^ ~ :^
! .~ ^: ~ .~ we are
.~ .^ ^^ ^: ^: always
! ~ ~ ~. ^^. searching for
^^ :^ :~ ^: .:::... an answer
^^ :^ .^: .^:....~^
:^::^:.:::..:^~^.
.::^~~^:^~^:.
...