DouKaku?

;;;
;; dokaku 126
;;

(defclass board ()
  ((width :accessor board-width :initarg :w)
   (height :accessor board-height :initarg :h)
   (cells :accessor board-cells :initarg :cells)))

(defmethod print-object ((board board) stream)
  (print-unreadable-object (board stream)
    (format stream "board~%")
    (loop for y from 0 below (board-height board)
    do
      (loop for x from 0 below (board-width board)
          do
        (format stream "~a" (if (cell board x y) "X" ".")))
      (format stream "~%"))))

(defun make-board (w h)
  "constructor"
  (make-instance 'board :w w :h h :cells (make-array (list w h) :initial-element nil)))

(defun make-random-board (w h)
  (let ((board (make-board w h)))
    (loop for y from 0 below (board-height board)
    do
      (loop for x from 0 below (board-width board)
          do
        (setf (cell board x y) (< (random 10) 3))))
    board))

(defmethod cell ((board board) x y)
  "accessor"
  (aref (board-cells board) (mod x (board-width board)) (mod y (board-height board))))

;; (setf (cell board x y) value) 
(defsetf cell (board x y) (value)
  `(setf (aref (board-cells ,board) (mod ,x (board-width ,board))
           (mod ,y (board-height ,board))) ,value))

(defmethod cell-neighbours ((board board) x y)
  (list (cell board (1- x) (1- y))
    (cell board x (1- y))
    (cell board (1+ x) (1- y))
    (cell board (1- x) y)
    (cell board (1+ x) y)
    (cell board (1- x) (1+ y))
    (cell board x (1+ y))
    (cell board (1+ x) (1+ y))))

(defmethod cell-survivep ((board board) x y)
  (let ((c (cell board x y))
    (n (count-if #'identity (cell-neighbours board x y))))
    (cond
     ((and (not c) (= n 3)) t) ;; born
     ((and c (or (= n 3) (= n 2))) t) ;; keep
     (t nil)))) ;; die

(defmethod update ((board board))
  (let ((next
     (loop for y from 0 below (board-height board)
         append
           (loop for x from 0 below (board-width board)
           collect (list x y (cell-survivep board x y))))))
    (loop for elt in next
    do
      (destructuring-bind (x y v) elt
        (setf (cell board x y) v))))
  board)

(defun make-blinker ()
  (let ((b (make-board 10 10)))
    (setf (cell b 1 0) t
      (cell b 1 1) t
      (cell b 1 2) t)
    b))

(defun make-glider ()
  (let ((b (make-board 10 10)))
    (setf (cell b 1 0) t
      (cell b 0 1) t
      (cell b 0 2) t
      (cell b 1 2) t
      (cell b 2 2) t)
    b))

(defpackage :doukaku-126 (:use :cl :*lisp))
(in-package :doukaku-126)
(*cold-boot :initial-dimensions '(10 10))

(defconstant +alive+ 1)
(defconstant +dead+ 0)

(defun grid10 (x y)
  (grid (mod x 10) (mod y 10)))

(defun get-env (grid x y)
  (values (pref grid (grid x y))
          (count +alive+
                 (list (pref grid (grid10 (1- x) (1- y)))
                       (pref grid (grid10 x (1- y)))
                       (pref grid (grid10 (1+ x) (1- y)))
                       (pref grid (grid10 (1- x) y))
                       (pref grid (grid10 (1+ x) y))
                       (pref grid (grid10 (1- x) (1+ y)))
                       (pref grid (grid10 x (1+ y)))
                       (pref grid (grid10 (1+ x) (1+ y)))))))

(defun gen-next (cur)
  (*let ((next +dead+))
    (loop :for x :from 0 :to 9 
          :do (loop :for y :from 0 :to 9 
                    :do (multiple-value-bind (self env) (get-env cur x y)
                          (cond ((and (eql +dead+ self) (= 3 env)) 
                                 (*setf (pref next (grid x y)) +alive+))
                                ((and (= +alive+ self) (<= 2 env 3))
                                 (*setf (pref next (grid x y)) +alive+))        
                                ('T (*setf (pref next (grid x y)) +dead+))))))
    next))

;; グライダーを作る
(defun make-glider ()
  (*let ((g +dead+))
    (*setf (pref g (grid 1 0)) +alive+
           (pref g (grid 0 1)) +alive+
           (pref g (grid 0 2)) +alive+
           (pref g (grid 1 2)) +alive+
           (pref g (grid 2 2)) +alive+)
    g))

;; 初期値をグライダーにしてループ 
(loop :for gen = (make-glider) then (gen-next gen)
      :do (ppp gen :mode :grid)
      :unless (y-or-n-p) :do (return))

(defpackage :doukaku-126 (:use :cl :*lisp))
(in-package :doukaku-126)
(*cold-boot :initial-dimensions '(10 10))

(defconstant +alive+ 1)
(defconstant +dead+ 0)

(defun gen-next!! (pvar)
  (let ((env (count!! +alive+
              (vector!!
               (news!! pvar -1 -1) (news!! pvar -1  0) (news!! pvar -1  1)
               (news!! pvar  0 -1) (news!! pvar  0  1) 
               (news!! pvar  1 -1) (news!! pvar  1  0) (news!! pvar  1  1)))))
    (cond!! ((and!! (eql!! +dead+ pvar) (=!! env 3)) +alive+)
            ((and!! (eql!! +alive+ pvar) (<=!! 2 env 3)) +alive+)
            (t!! +dead+))))

;; 実行例(初期値をランダムに設定してループ表示):
(loop :for gen = (truncate!! (random!! 10) 5) :then (gen-next!! gen)
      :do (ppp gen) 
      :unless (y-or-n-p) :do (return))