Skip to content

Instantly share code, notes, and snippets.



Last active Nov 15, 2015
What would you like to do?
./lifegame.ros *width* *height* *wait-time*
#|-*- 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)
(defun next-state (pos field)
(let ((state (length (nintersection (neighbors pos) field :test #'equal))))
(if (livep pos field)
(cond ((or (= state 2)
(= state 3))
((or (<= state 1)
(>= state 4))
(if (= state 3)
(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)
(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)))))
(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)
(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)
(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)
(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)))

This comment has been minimized.

Copy link
Owner Author

@takoeight0821 takoeight0821 commented Nov 14, 2015

Land of Lispの10章を参考に、Lifegameを作った。

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment