game-of-life.lisp

(defpackage game-of-life)

(defun get-neighbours (grid x y)
  (let ((result 0) (xo (- x 1))
        (yo (- y 1)))
    (dotimes (i 3)
      (dotimes (j 3)
        (let ((dx (+ xo i))
              (dy (+ yo j)))
          (when (and (array-in-bounds-p grid dx dy)
                     (not (and (= dx x) (= dy y))))
            (setf result (+ result (aref grid dx dy)))))))
    result))

(defun apply-rules (grid x y)
  (let* ((n (aref grid x y))
         (ns (get-neighbours grid x y)))
   (or (born n ns)
       (survive n ns) 0)))

(defun alivep (n) (> n 0))
(defun deadp (n) (not (alivep n)))

(defun born (n ns)
  (and (deadp n) (= ns 3) 1))

(defun survive (n ns)
  (and (alivep n)
       (or (= ns 3) (= ns 2)) 1))

(defun make-empty-grid (x y)
  (make-array (list x y) :initial-element 0))

(defun init-generation (grid coords)
  (let ((g (copy-array grid)))
    (dolist (c coords)
      (setf (aref g (car c) (cadr c)) 1))
    g))

(defun next-generation (grid)
  (let* ((g (copy-array grid))
         (dims (array-dimensions g))
         (endx (car dims))
         (endy (cadr dims)))
    (dotimes (x endx )
      (dotimes (y endy)
        (setf (aref g x y)
              (apply-rules grid x y))))
    g))

(defun copy-array (array)
  (let ((dims (array-dimensions array)))
    (adjust-array
     (make-array dims :element-type
                 (array-element-type array)
                 :displaced-to array)
     dims)))

(defun game-of-life (x y init  maxgen)
  (let* ((init-grid (init-generation
                     (make-empty-grid x y) init))
         (first-gen (next-generation init-grid)))
    (do ((g first-gen (next-generation g))
         (n 1 (1+ n))
         (hist (list init-grid)
               (cons g hist)))
        ((or (eq g init-grid)
             (eq g (cadr hist))
             (= n maxgen))
         hist))))

(defvar block 
  '((1 1) (1 2) (2 1) (2 2)))

(defvar beehive
  '((1 2) (1 3)
    (2 1) (2 4)
    (3 2) (3 3)))

(defvar blinker '((1 1) (1 2) (1 3)))

(defvar glitter
  '((1 2)
    (2 3)
    (3 1) (3 2) (3 3)))

(game-of-life 10 10 block 5)
(game-of-life 10 10 beehive 5)
(game-of-life 10 10 blinker 5)
(game-of-life 10 10 glitter 5)