some logic
This commit is contained in:
parent
041f1f1af5
commit
1a7d554165
2 changed files with 160 additions and 27 deletions
2
life.sh
Executable file
2
life.sh
Executable file
|
@ -0,0 +1,2 @@
|
||||||
|
#!/bin/bash
|
||||||
|
sbcl --noinform --load sdl-test.cl --non-interactive
|
185
sdl-test.cl
185
sdl-test.cl
|
@ -1,19 +1,14 @@
|
||||||
(ql:quickload "lispbuilder-sdl")
|
(ql:quickload "lispbuilder-sdl")
|
||||||
;(asdf:operate 'asdf:load-op :lispbuilder-sdl)
|
;(asdf:operate 'asdf:load-op :lispbuilder-sdl)
|
||||||
|
|
||||||
(defvar *grid-width* 100)
|
(defvar *grid-width* 3)
|
||||||
(defvar *grid-height* 100)
|
(defvar *grid-height* 3)
|
||||||
|
|
||||||
(defvar *map* nil)
|
(defvar *map* nil)
|
||||||
|
(defvar *map-copy* nil)
|
||||||
|
(defvar *next-generation* nil)
|
||||||
(defvar *run* nil)
|
(defvar *run* nil)
|
||||||
|
|
||||||
;(defstruct cell
|
|
||||||
; alive
|
|
||||||
; screen-x
|
|
||||||
; screen-y
|
|
||||||
; map-x
|
|
||||||
; map-y)
|
|
||||||
|
|
||||||
(defun create-cell (x y)
|
(defun create-cell (x y)
|
||||||
(list :screen-x (+ 5 (* x 10))
|
(list :screen-x (+ 5 (* x 10))
|
||||||
:screen-y (+ 5 (* y 10))
|
:screen-y (+ 5 (* y 10))
|
||||||
|
@ -58,19 +53,19 @@
|
||||||
(defun render-map ()
|
(defun render-map ()
|
||||||
(dolist (cell *map*)
|
(dolist (cell *map*)
|
||||||
(cond
|
(cond
|
||||||
((getf cell :was-alive)
|
|
||||||
(render-cell cell sdl:*white*))
|
|
||||||
((getf cell :alive)
|
((getf cell :alive)
|
||||||
(render-cell cell sdl:*green*))
|
(render-cell cell sdl:*green*))
|
||||||
|
((getf cell :was-alive)
|
||||||
|
(render-cell cell sdl:*white*))
|
||||||
(t
|
(t
|
||||||
(render-cell cell sdl:*red*)))))
|
(render-cell cell sdl:*red*)))))
|
||||||
|
|
||||||
;(defun kill (cell)
|
(defun kill (cell)
|
||||||
; (setf (getf cell :alive) nil)
|
(setf (getf cell :alive) nil)
|
||||||
; (setf (getf cell :was-alive) t))
|
(setf (getf cell :was-alive) t))
|
||||||
;
|
|
||||||
;(defun reanimate (cell)
|
(defun reanimate (cell)
|
||||||
; (setf (getfcell :alive) t))
|
(setf (getf cell :alive) t))
|
||||||
|
|
||||||
(defun mouse-intersect (mouse-x mouse-y cell)
|
(defun mouse-intersect (mouse-x mouse-y cell)
|
||||||
(and (<= mouse-x (+ (getf cell :screen-x) 5))
|
(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))
|
||||||
(>= 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*)
|
(dolist (cell *map*)
|
||||||
(if (mouse-intersect mouse-x mouse-y cell)
|
(if (mouse-intersect mouse-x mouse-y cell)
|
||||||
(progn
|
(progn
|
||||||
(setf (getf cell :alive) (not (getf cell :alive)))
|
(setf (getf cell :alive) (not (getf cell :alive)))
|
||||||
(return)))))
|
(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)
|
(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 ()
|
(defun next-generation ()
|
||||||
(setf *db*
|
(setf *map-copy* *map*)
|
||||||
(mapcar
|
(dolist (cell *map*)
|
||||||
#'check-cell
|
(check-cell cell))
|
||||||
*db*)))
|
(setf *map* *next-generation*)
|
||||||
|
(setf *next-generation* nil)
|
||||||
|
(setf *map-copy* nil))
|
||||||
|
|
||||||
;(defun fill-map ()
|
;(defun fill-map ()
|
||||||
; (setf *x* 0)
|
; (setf *x* 0)
|
||||||
|
@ -268,20 +394,25 @@
|
||||||
(+ (* *grid-width* 10) 1)
|
(+ (* *grid-width* 10) 1)
|
||||||
(+ (* *grid-height* 10) 1)
|
(+ (* *grid-height* 10) 1)
|
||||||
:title-caption "the Game of Life")
|
:title-caption "the Game of Life")
|
||||||
|
(setf (sdl:frame-rate) 60)
|
||||||
|
(sdl:DISABLE-KEY-REPEAT)
|
||||||
(sdl:with-events ()
|
(sdl:with-events ()
|
||||||
(:quit-event () T)
|
(:quit-event () T)
|
||||||
(:key-down-event ()
|
(:key-down-event ()
|
||||||
(when
|
(when
|
||||||
(sdl:key-down-p :sdl-key-escape)
|
(sdl:key-down-p :sdl-key-escape)
|
||||||
(sdl:push-quit-event))
|
(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)
|
(sdl:key-down-p :sdl-key-space)
|
||||||
(setf *run* (not *run*))))
|
(next-generation)))
|
||||||
|
|
||||||
(:idle ()
|
(:idle ()
|
||||||
(sdl:clear-display sdl:*black*)
|
(sdl:clear-display sdl:*black*)
|
||||||
(when (sdl:mouse-left-p)
|
(when (sdl:mouse-left-p)
|
||||||
(set-cell (sdl:mouse-x) (sdl:mouse-y)))
|
(mouse-set-cell (sdl:mouse-x) (sdl:mouse-y)))
|
||||||
(render-map)
|
(render-map)
|
||||||
; (if *run*
|
; (if *run*
|
||||||
; (check-map))
|
; (check-map))
|
||||||
|
|
Loading…
Add table
Reference in a new issue