some changes

This commit is contained in:
Gregory Tertyshny 2017-05-30 21:10:32 +03:00
parent 0bda960f26
commit 041f1f1af5

View file

@ -5,118 +5,182 @@
(defvar *grid-height* 100) (defvar *grid-height* 100)
(defvar *map* nil) (defvar *map* nil)
(defvar *new-map* nil)
(defvar *x*)
(defvar *y*)
(defvar *neighbors*)
(defvar *cur-neighbor*)
(defvar *cur-cell*)
(defvar *run* nil) (defvar *run* nil)
(defvar *tmp-cell* nil)
(defstruct cell ;(defstruct cell
alive ; alive
screen-x ; screen-x
screen-y ; screen-y
map-x ; map-x
map-y) ; map-y)
(defun create-cell (x y) (defun create-cell (x y)
(make-cell :screen-x (+ 5 (* x 10)) (list :screen-x (+ 5 (* x 10))
:screen-y (+ 5 (* y 10)) :screen-y (+ 5 (* y 10))
:map-x x :map-x x
:map-y y)) :map-y y
:was-alive nil
:alive nil))
(defun fill-map () (defun fill-map ()
(setf *x* 0) (let ((x 0)
(setf *y* 0) (y 0))
(dotimes (int *grid-height*) (dotimes (int (* *grid-height* *grid-width*))
(dotimes (int *grid-width*) (push (create-cell x y) *map*)
(if (not *map*) (setf x (incf x))
(push (create-cell *x* *y*) *map*) (if (= x *grid-width*)
(push (create-cell *x* *y*) (cdr (last *map*)))) (progn
(setf *x* (incf *x*)) (setf x 0)
(if (= *x* *grid-width*) (setf y (incf y)))))))
(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 () (defun render-map ()
(loop for cell1 in *map* (dolist (cell *map*)
do (if (cell-alive cell1) (cond
(sdl:draw-box ((getf cell :was-alive)
(sdl:rectangle-from-midpoint-* (render-cell cell sdl:*white*))
(cell-screen-x cell1) ((getf cell :alive)
(cell-screen-y cell1) (render-cell cell sdl:*green*))
9 (t
9) (render-cell cell sdl:*red*)))))
: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) ;(defun kill (cell)
(loop for cell in *map* ; (setf (getf cell :alive) nil)
do (if (and (< mouse-x (+ 5 (cell-screen-x cell))) ; (setf (getf cell :was-alive) t))
(> mouse-x (- 5 (cell-screen-x cell))) ;
(< mouse-y (+ 5 (cell-screen-y cell))) ;(defun reanimate (cell)
(> mouse-y (- 5 (cell-screen-y cell)))) ; (setf (getfcell :alive) t))
(progn
(setf (cell-alive cell) (not (cell-alive cell)))
(return)))))
(defun is-alive (x y tmp-cell) (defun mouse-intersect (mouse-x mouse-y cell)
(setq tmp-cell (nth (+ (* y *grid-width*) x) *map*)) (and (<= mouse-x (+ (getf cell :screen-x) 5))
(if ((tmp-cell-alive tmp-cell)) (>= mouse-x (- (getf cell :screen-x) 5))
(return-from is-alive t) (<= mouse-y (+ (getf cell :screen-y) 5))
(return-from is-alive nil))) (>= mouse-y (- (getf cell :screen-y) 5))))
(defun check-top-left-corner (x y) (defun set-cell (mouse-x mouse-y)
(setf *neighbors* 0) (dolist (cell *map*)
(if (is-alive 1 0) (if (mouse-intersect mouse-x mouse-y cell)
(setf *neighbors* (incf *neighbors*))) (progn
(if (is-alive 1 1) (setf (getf cell :alive) (not (getf cell :alive)))
(setf *neighbors* (incf *neighbors*))) (return)))))
(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) (defun check-cell (cell)
(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) (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) ; (if (and (= x 0)
; (= y 0)) ; (= y 0))
; (progn ; (progn
@ -153,24 +217,24 @@
; (progn ; (progn
; (check-bottom) ; (check-bottom)
; (return-from check-cell))) ; (return-from check-cell)))
(main-check cell)) ; (main-check cell))
(defun set-cell (cell) ;(defun set-cell (cell)
(setf *cur-cell* (nth (+ (* y *map-width*) x) *new-map*)) ; (setf *cur-cell* (nth (+ (* y *map-width*) x) *new-map*))
(if (and (not (is-alive x y)) ; (if (and (not (is-alive x y))
(= *neighbors* 3)) ; (= *neighbors* 3))
(progn ; (progn
(setf (*cur-cell*-alive *cur-cell*) t) ; (setf (*cur-cell*-alive *cur-cell*) t)
(return-from set-cell))) ; (return-from set-cell)))
(if (and (is-alive x y) ; (if (and (is-alive x y)
(or (= *neighbors* 2) ; (or (= *neighbors* 2)
(= *neighbors* 3))) ; (= *neighbors* 3)))
(return-from set-cell)) ; (return-from set-cell))
(if (or (> *neighbors* 3) ; (if (or (> *neighbors* 3)
(< *neighbors* 2)) ; (< *neighbors* 2))
(progn ; (progn
(setf (*cur-cell*-alive *cur-cell*) nil) ; (setf (*cur-cell*-alive *cur-cell*) nil)
(return-from set-cell)))) ; (return-from set-cell))))
;(defun check-map () ;(defun check-map ()
; (setf *x* 0) ; (setf *x* 0)
@ -186,21 +250,24 @@
; (setf *y* (incf *y*))) ; (setf *y* (incf *y*)))
; (setf *map* *new-map*)) ; (setf *map* *new-map*))
(defun check-map () ;(defun check-map ()
(setf *x* 0) ; (setf *x* 0)
(setf *y* 0) ; (setf *y* 0)
(setf *new-map* (copy-list *map*)) ; (setf *new-map* (copy-list *map*))
(loop for cell in *map* ; (loop for cell in *map*
do ((check-cell (cell-map-x cell) (cell-map-y cell)) ; do ((check-cell (cell-map-x cell) (cell-map-y cell))
(set-cell (cell-map-x cell) (cell-map-y cell)))) ; (set-cell (cell-map-x cell) (cell-map-y cell))))
(setf *map* *new-map*)) ; (setf *map* *new-map*))
(defun life () (defun life ()
(format *query-io* "~%~%~a~%" (first *posix-argv*))
(fill-map) (fill-map)
; (print-map)
(sdl:with-init () (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 () (sdl:with-events ()
(:quit-event () T) (:quit-event () T)
(:key-down-event () (:key-down-event ()
@ -214,10 +281,10 @@
(:idle () (:idle ()
(sdl:clear-display sdl:*black*) (sdl:clear-display sdl:*black*)
(when (sdl:mouse-left-p) (when (sdl:mouse-left-p)
(mouse-click (sdl:mouse-x) (sdl:mouse-y))) (set-cell (sdl:mouse-x) (sdl:mouse-y)))
(render-map) (render-map)
(if *run* ; (if *run*
(check-map)) ; (check-map))
(sdl:update-display))))) (sdl:update-display)))))
(sb-int:with-float-traps-masked (sb-int:with-float-traps-masked