(ql:quickload "lispbuilder-sdl") ;(asdf:operate 'asdf:load-op :lispbuilder-sdl) (defvar *grid-width* 100) (defvar *grid-height* 100) (defvar *map* nil) (defvar *new-map* nil) (defvar *x*) (defvar *y*) (defvar *neighbors*) (defvar *cur-neighbor*) (defvar *cur-cell*) (defvar *run* nil) (defvar *tmp-cell* nil) (defstruct cell alive screen-x screen-y map-x map-y) (defun create-cell (x y) (make-cell :screen-x (+ 5 (* x 10)) :screen-y (+ 5 (* y 10)) :map-x x :map-y y)) (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 () (format *query-io* "~%~%~a~%" (first *posix-argv*)) (fill-map) (sdl:with-init () (sdl:window (* *grid-width* 10) (* *grid-height* 10) :title-caption "carnifex") (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) (mouse-click (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))