./lifegame.ros *width* *height* *wait-time*

lifegame.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(defparameter *width* 0)
(defparameter *height* 0)

(defun neighbors (pos)
  (let ((x (car pos))
        (y (cdr pos)))
    (list (cons (1- x) (1- y)) (cons x (1- y)) (cons (1+ x) (1- y))
          (cons (1- x) y)                      (cons (1+ x) y)
          (cons (1- x) (1+ y)) (cons x (1+ y)) (cons (1+ x) (1+ y)))))

(defun livep (pos field)
  (if (member pos field :test #'equal)
      pos
      nil))

(defun next-state (pos field)
  (let ((state (length (nintersection (neighbors pos) field :test #'equal))))
    (if (livep pos field)
        (cond ((or (= state 2)
                   (= state 3))
               pos)
              ((or (<= state 1)
                   (>= state 4))
               nil))
        (if (= state 3)
            pos
            nil))))

(defun random-genarate (width height field)
  (dotimes (x (* 5 (+ width height)))
    (let ((pos (cons (random width) (random height))))
      (push pos field)))
  (remove-duplicates field :test #'equal))

(defun draw-field (field)
  (loop for y
          below *height*
        do (progn (fresh-line)
                  (princ "|")
                  (loop for x
                          below *width*
                        do (princ (if (livep (cons x y) field)
                                      #\*
                                      #\Space)))
                  (princ "|"))))


(defun full-field (width height)
  (let ((f nil))
    (loop for x below width
          do (setq f (nconc f
                            (loop for y below height
                                  collect (cons x y)))))
    f))

(defun update-field (field)
  (if (null field)
      (setq field (random-genarate *width* *height* field)))
  (setq field (mapcar (lambda (pos)
                        (next-state pos field))
                      (full-field *width* *height*)))
  (setq field (remove-if #'null field))
  (delete-duplicates field :test #'equal))


(defparameter *generation* 0)

(defun main-loop (field wait)
  (draw-field field)
  (fresh-line)
  (let ((str (read-line)))
    (cond ((string= str "quit") (setf *generation* 0))
          (t (let ((x (parse-integer str :junk-allowed t)))
               (if x
                   (loop for i
                           below x
                         do (progn (draw-field field)
                                   (fresh-line)
                                   (setq field (update-field field))
                                   (sleep wait)))
                   (setq field (update-field field)))
               (main-loop field wait))))))

(defun loop-without-console (field times)
  (loop for i
          below times
        do (progn (draw-field field)
                  (fresh-line)
                  (terpri)
                  (setq field (update-field field)))))

(defun main (&optional (width "80") (height "24") (wait "0.1") &rest argv)
  (declare (ignorable argv))
  (defparameter *world* (random-genarate *width* *height*  nil))
  (setq *width* (- (parse-integer width) 2))
  (setq *height* (1- (parse-integer height)))
  (main-loop *world* (read-from-string wait)))

Land of Lispの10章を参考に、Lifegameを作った。
_width_及び_height_は環境に合わせて調整する。