(ql:quickload "lispbuilder-sdl") ;(asdf:operate 'asdf:load-op :lispbuilder-sdl) (defvar *grid-width* 100) (defvar *grid-height* 100) (defvar *map* nil) (defvar *run* nil) ;(defstruct cell ; alive ; screen-x ; screen-y ; map-x ; map-y) (defun create-cell (x y) (list :screen-x (+ 5 (* x 10)) :screen-y (+ 5 (* y 10)) :map-x x :map-y y :was-alive nil :alive nil)) (defun fill-map () (let ((x 0) (y 0)) (dotimes (int (* *grid-height* *grid-width*)) (push (create-cell x y) *map*) (setf x (incf x)) (if (= x *grid-width*) (progn (setf x 0) (setf y (incf y))))))) (defun print-map () (let ((x 0)) (dolist (cell *map*) (format t "x:~a y:~a; " (getf cell :map-x) (getf cell :map-y)) (setf x (incf x)) (if (= x *grid-width*) (progn (setf x 0) (format t "~%")))))) (defun render-cell (cell color) (sdl:draw-box (sdl:rectangle-from-midpoint-* (getf cell :screen-x) (getf cell :screen-y) 9 9) :color color)) (defun render-map () (dolist (cell *map*) (cond ((getf cell :was-alive) (render-cell cell sdl:*white*)) ((getf cell :alive) (render-cell cell sdl:*green*)) (t (render-cell cell sdl:*red*))))) ;(defun kill (cell) ; (setf (getf cell :alive) nil) ; (setf (getf cell :was-alive) t)) ; ;(defun reanimate (cell) ; (setf (getfcell :alive) t)) (defun mouse-intersect (mouse-x mouse-y cell) (and (<= mouse-x (+ (getf cell :screen-x) 5)) (>= mouse-x (- (getf cell :screen-x) 5)) (<= mouse-y (+ (getf cell :screen-y) 5)) (>= mouse-y (- (getf cell :screen-y) 5)))) (defun set-cell (mouse-x mouse-y) (dolist (cell *map*) (if (mouse-intersect mouse-x mouse-y cell) (progn (setf (getf cell :alive) (not (getf cell :alive))) (return))))) (defun check-cell (cell) ) (defun next-generation () (setf *db* (mapcar #'check-cell *db*))) ;(defun fill-map () ; (setf *x* 0) ; (setf *y* 0) ; (dotimes (int *grid-height*) ; (dotimes (int *grid-width*) ; (if (not *map*) ; (push (create-cell *x* *y*) *map*) ; (push (create-cell *x* *y*) (cdr (last *map*)))) ; (setf *x* (incf *x*)) ; (if (= *x* *grid-width*) ; (setf *x* 0))) ; (setf *y* (incf *y*)))) ;(defun render-map () ; (loop for cell1 in *map* ; do (if (cell-alive cell1) ; (sdl:draw-box ; (sdl:rectangle-from-midpoint-* ; (cell-screen-x cell1) ; (cell-screen-y cell1) ; 9 ; 9) ; :color sdl:*white*) ; (sdl:draw-box ; (sdl:rectangle-from-midpoint-* ; (cell-screen-x cell1) ; (cell-screen-y cell1) ; 9 ; 9) ; :color sdl:*red*)))) ;(defun mouse-click (mouse-x mouse-y) ; (loop for cell in *map* ; do (if (and (< mouse-x (+ 5 (cell-screen-x cell))) ; (> mouse-x (- 5 (cell-screen-x cell))) ; (< mouse-y (+ 5 (cell-screen-y cell))) ; (> mouse-y (- 5 (cell-screen-y cell)))) ; (progn ; (setf (cell-alive cell) (not (cell-alive cell))) ; (return))))) ;(defun is-alive (x y tmp-cell) ; (setq tmp-cell (nth (+ (* y *grid-width*) x) *map*)) ; (if ((tmp-cell-alive tmp-cell)) ; (return-from is-alive t) ; (return-from is-alive nil))) ; ; ;(defun check-top-left-corner (x y) ; (setf *neighbors* 0) ; (if (is-alive 1 0) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive 1 1) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive 0 1) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive 0 *map-height*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive 1 *map-height*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive *map-width* 0) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive *map-width* 1) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive *map-width* *map-height*) ; (setf *neighbors* (incf *neighbors*)))) ; ;(defun main-check (x y) ; (setf *neighbors* 0) ; (if (is-alive (+ x 1) y *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive (+ x 1) (+ y 1) *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive x (+ y 1) *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive (- x 1) (+ y 1) *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive (- x 1) y *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive (- x 1) (- y 1) *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive x (- y 1) *tmp-cell*) ; (setf *neighbors* (incf *neighbors*))) ; (if (is-alive (+ x 1) (- y 1) *tmp-cell*) ; (setf *neighbors* (incf *neighbors*)))) ;(defun check-cell (x y) ; (if (and (= x 0) ; (= y 0)) ; (progn ; (check-top-left-corner) ; (return-from check-cell))) ; (if (and (= x *map-width*) ; (= y 0)) ; (progn ; (check-top-right-corner) ; (return-from check-cell))) ; (if (and (= x 0) ; (= y *map-height*)) ; (progn ; (check-bottom-left-corner) ; (return-from check-cell))) ; (if (and (= x *map-width*) ; (= y *map-height*)) ; (progn ; (check-bottom-right-corner) ; (return-from check-cell))) ; (if (= x 0) ; (progn ; (check-top) ; (return-from check-cell))) ; (if (= y 0) ; (progn ; (check-left) ; (return-from check-cell))) ; (if (= x *map-width*) ; (progn ; (check-right) ; (return-from check-cell))) ; (if (= y *map-height*) ; (progn ; (check-bottom) ; (return-from check-cell))) ; (main-check cell)) ;(defun set-cell (cell) ; (setf *cur-cell* (nth (+ (* y *map-width*) x) *new-map*)) ; (if (and (not (is-alive x y)) ; (= *neighbors* 3)) ; (progn ; (setf (*cur-cell*-alive *cur-cell*) t) ; (return-from set-cell))) ; (if (and (is-alive x y) ; (or (= *neighbors* 2) ; (= *neighbors* 3))) ; (return-from set-cell)) ; (if (or (> *neighbors* 3) ; (< *neighbors* 2)) ; (progn ; (setf (*cur-cell*-alive *cur-cell*) nil) ; (return-from set-cell)))) ;(defun check-map () ; (setf *x* 0) ; (setf *y* 0) ; (setf *new-map* (copy-list *map*)) ; (dotimes (int *grid-height*) ; (dotimes (int *grid-widht*) ; (check-cell *x* *y*) ; (set-cell *x* *y*) ; (setf *x* (incf *x*)) ; (if (= *x* *grid-width*) ; (setf *x* 0))) ; (setf *y* (incf *y*))) ; (setf *map* *new-map*)) ;(defun check-map () ; (setf *x* 0) ; (setf *y* 0) ; (setf *new-map* (copy-list *map*)) ; (loop for cell in *map* ; do ((check-cell (cell-map-x cell) (cell-map-y cell)) ; (set-cell (cell-map-x cell) (cell-map-y cell)))) ; (setf *map* *new-map*)) (defun life () (fill-map) ; (print-map) (sdl:with-init () (sdl:window (+ (* *grid-width* 10) 1) (+ (* *grid-height* 10) 1) :title-caption "the Game of Life") (sdl:with-events () (:quit-event () T) (:key-down-event () (when (sdl:key-down-p :sdl-key-escape) (sdl:push-quit-event)) (when (sdl:key-down-p :sdl-key-space) (setf *run* (not *run*)))) (:idle () (sdl:clear-display sdl:*black*) (when (sdl:mouse-left-p) (set-cell (sdl:mouse-x) (sdl:mouse-y))) (render-map) ; (if *run* ; (check-map)) (sdl:update-display))))) (sb-int:with-float-traps-masked (:invalid :inexact :overflow) (life))