diff --git a/life.sh b/life.sh new file mode 100755 index 0000000..d744318 --- /dev/null +++ b/life.sh @@ -0,0 +1,2 @@ +#!/bin/bash +sbcl --noinform --load sdl-test.cl --non-interactive diff --git a/sdl-test.cl b/sdl-test.cl index 5336d36..653f61d 100644 --- a/sdl-test.cl +++ b/sdl-test.cl @@ -1,19 +1,14 @@ (ql:quickload "lispbuilder-sdl") ;(asdf:operate 'asdf:load-op :lispbuilder-sdl) -(defvar *grid-width* 100) -(defvar *grid-height* 100) +(defvar *grid-width* 3) +(defvar *grid-height* 3) (defvar *map* nil) +(defvar *map-copy* nil) +(defvar *next-generation* 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)) @@ -58,19 +53,19 @@ (defun render-map () (dolist (cell *map*) (cond - ((getf cell :was-alive) - (render-cell cell sdl:*white*)) ((getf cell :alive) (render-cell cell sdl:*green*)) + ((getf cell :was-alive) + (render-cell cell sdl:*white*)) (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 kill (cell) + (setf (getf cell :alive) nil) + (setf (getf cell :was-alive) t)) + +(defun reanimate (cell) + (setf (getf cell :alive) t)) (defun mouse-intersect (mouse-x mouse-y cell) (and (<= mouse-x (+ (getf cell :screen-x) 5)) @@ -78,21 +73,152 @@ (<= mouse-y (+ (getf cell :screen-y) 5)) (>= mouse-y (- (getf cell :screen-y) 5)))) -(defun set-cell (mouse-x mouse-y) +(defun mouse-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 get-cell (x y) + (copy-list (nth (+ (* y *grid-width*) x) *map-copy*))) + +(defun is-alive (cell) + (getf cell :alive)) + +(defun get-cell-x (cell) + (getf cell :map-x)) + +(defun get-cell-y (cell) + (getf cell :map-y)) + +(defun main-check (cell) + (let ((x (get-cell-x cell)) + (y (get-cell-y cell)) + (new-cell (copy-list cell)) + (neighbors 0)) + (if (is-alive (get-cell (+ x 1) y)) + (progn + (setf neighbors (incf neighbors)) + (format t + "right cell:~%x:~ay:~a~%~%" + (getf (get-cell (+ x 1) y) :map-x) + (getf (get-cell (+ x 1) y) :map-y)))) + (if (is-alive (get-cell (+ x 1) (+ y 1))) + (progn + (setf neighbors (incf neighbors)) + (format t + "right bottom cell:~%x:~ay:~a~%~%" + (getf (get-cell (+ x 1) (+ y 1)) :map-x) + (getf (get-cell (+ x 1) (+ y 1)) :map-y)))) + (if (is-alive (get-cell x (+ y 1))) + (progn + (setf neighbors (incf neighbors)) + (format t + "right bottom cell:~%x:~ay:~a~%~%" + (getf (get-cell x (+ y 1)) :map-x) + (getf (get-cell x (+ y 1)) :map-y)))) + (if (is-alive (get-cell (- x 1) (+ y 1))) + (progn + (setf neighbors (incf neighbors)) + (format t + "middle bottom cell:~%x:~ay:~a~%~%" + (getf (get-cell (- x 1) (+ y 1)) :map-x) + (getf (get-cell (- x 1) (+ y 1)) :map-y)))) + (if (is-alive (get-cell (- x 1) y)) + (progn + (setf neighbors (incf neighbors)) + (format t + "left cell:~%x:~ay:~a~%~%" + (getf (get-cell (- x 1) y) :map-x) + (getf (get-cell (- x 1) y) :map-y)))) + (if (is-alive (get-cell (- x 1) (- y 1))) + (progn + (setf neighbors (incf neighbors)) + (format t + "left bottom cell:~%x:~ay:~a~%~%" + (getf (get-cell (- x 1) (- y 1)) :map-x) + (getf (get-cell (- x 1) (- y 1)) :map-y)))) + (if (is-alive (get-cell x (- y 1))) + (setf neighbors (incf neighbors))) + (if (is-alive (get-cell (+ x 1) (- y 1))) + (setf neighbors (incf neighbors))) + ;(cond + ; ((getf new-cell :alive) + ; (if (or (<= neighbors 1) + ; (>= neighbors 4)) + ; (kill new-cell)) + ; (format t + ; "x:~a y:~a~%~%" + ; (get-cell-x new-cell) + ; (get-cell-y new-cell))) + ; (t + ; (if (= neighbors 3) + ; (reanimate new-cell)))) + (if (is-alive new-cell) + (format t "neighbors:~a~%" neighbors)) + (push new-cell *next-generation*))) + +(defun check-top-left-corner (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-top-right-corner (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-bottom-left-corner (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-bottom-right-corner (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-top (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-bottom (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-left (cell) + (push (copy-list cell) *next-generation*)) + +(defun check-right (cell) + (push (copy-list cell) *next-generation*)) + (defun check-cell (cell) - ) + (cond + ((and + (= (get-cell-x cell) 0) + (= (get-cell-y cell) 0)) + (check-top-left-corner cell)) + ((and + (= (get-cell-x cell) (- *grid-width* 1)) + (= (get-cell-y cell) 0)) + (check-top-right-corner cell)) + ((and + (= (get-cell-x cell) 0) + (= (get-cell-y cell) (- *grid-height* 1))) + (check-bottom-left-corner cell)) + ((and + (= (get-cell-x cell) (- *grid-width* 1)) + (= (get-cell-y cell) (- *grid-height* 1))) + (check-bottom-right-corner cell)) + ((= (get-cell-y cell) 0) + (check-top cell)) + ((= (get-cell-y cell) (- *grid-height* 1)) + (check-bottom cell)) + ((= (get-cell-x cell) 0) + (check-left cell)) + ((= (get-cell-x cell) (- *grid-width* 1)) + (check-right cell)) + (t + (main-check cell)))) (defun next-generation () - (setf *db* - (mapcar - #'check-cell - *db*))) + (setf *map-copy* *map*) + (dolist (cell *map*) + (check-cell cell)) + (setf *map* *next-generation*) + (setf *next-generation* nil) + (setf *map-copy* nil)) ;(defun fill-map () ; (setf *x* 0) @@ -268,20 +394,25 @@ (+ (* *grid-width* 10) 1) (+ (* *grid-height* 10) 1) :title-caption "the Game of Life") + (setf (sdl:frame-rate) 60) + (sdl:DISABLE-KEY-REPEAT) (sdl:with-events () (:quit-event () T) (:key-down-event () (when (sdl:key-down-p :sdl-key-escape) (sdl:push-quit-event)) - (when + ;(when + ; (sdl:key-down-p :sdl-key-enter) + ; (setf *run* (not *run*))) + (when (sdl:key-down-p :sdl-key-space) - (setf *run* (not *run*)))) - + (next-generation))) + (:idle () (sdl:clear-display sdl:*black*) (when (sdl:mouse-left-p) - (set-cell (sdl:mouse-x) (sdl:mouse-y))) + (mouse-set-cell (sdl:mouse-x) (sdl:mouse-y))) (render-map) ; (if *run* ; (check-map))