Skip to content

Instantly share code, notes, and snippets.

@takoeight0821 takoeight0821/lifegame.ros
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 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
You can’t perform that action at this time.