some changes
This commit is contained in:
Gregory Tertyshny
parent
0bda960f26
commit
041f1f1af5
1 changed files with 196 additions and 129 deletions
325
sdl-test.cl
325
sdl-test.cl
|
|
@ -5,118 +5,182 @@
|
|||
(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)
|
||||
;(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))
|
||||
(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 ()
|
||||
(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*))))
|
||||
(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 ()
|
||||
(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*))))
|
||||
(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 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 kill (cell)
|
||||
; (setf (getf cell :alive) nil)
|
||||
; (setf (getf cell :was-alive) t))
|
||||
;
|
||||
;(defun reanimate (cell)
|
||||
; (setf (getfcell :alive) t))
|
||||
|
||||
(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 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 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 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 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 (cell)
|
||||
)
|
||||
|
||||
(defun check-cell (x y)
|
||||
(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
|
||||
|
|
@ -153,24 +217,24 @@
|
|||
; (progn
|
||||
; (check-bottom)
|
||||
; (return-from check-cell)))
|
||||
(main-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 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)
|
||||
|
|
@ -186,21 +250,24 @@
|
|||
; (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 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)
|
||||
; (print-map)
|
||||
(sdl:with-init ()
|
||||
(sdl:window (* *grid-width* 10) (* *grid-height* 10) :title-caption "carnifex")
|
||||
(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 ()
|
||||
|
|
@ -214,10 +281,10 @@
|
|||
(:idle ()
|
||||
(sdl:clear-display sdl:*black*)
|
||||
(when (sdl:mouse-left-p)
|
||||
(mouse-click (sdl:mouse-x) (sdl:mouse-y)))
|
||||
(set-cell (sdl:mouse-x) (sdl:mouse-y)))
|
||||
(render-map)
|
||||
(if *run*
|
||||
(check-map))
|
||||
; (if *run*
|
||||
; (check-map))
|
||||
(sdl:update-display)))))
|
||||
|
||||
(sb-int:with-float-traps-masked
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue