some logic

life.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+sbcl --noinform --load sdl-test.cl --non-interactive

sdl-test.cl

@@ -1,19 +1,14 @@
 (ql:quickload "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-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)
+(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)
   (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*
+  (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 ()
 ;  (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))