[graphic-forms-cvs] r158 - trunk/src/demos/unblocked

[junrue at common-lisp.net]

Author: junrue
Date: Sat Jun 24 21:46:36 2006
New Revision: 158

Modified:
   trunk/src/demos/unblocked/unblocked-model.lisp
   trunk/src/demos/unblocked/unblocked-window.lisp
Log:
implemented game restart in UnBlocked

Modified: trunk/src/demos/unblocked/unblocked-model.lisp
==============================================================================
--- trunk/src/demos/unblocked/unblocked-model.lisp	(original)
+++ trunk/src/demos/unblocked/unblocked-model.lisp	Sat Jun 24 21:46:36 2006
@@ -48,6 +48,13 @@
         for level from 1
         finally (return level)))
 
+(defun revise-tiles (active-tiles orig-tiles shape-data)
+  (if shape-data
+    (loop with tmp = (clone-tiles active-tiles)
+          for pnt in shape-data do (set-tile tmp pnt 0)
+          finally (return (collapse-tiles tmp)))
+    orig-tiles))
+
 (cells:defmodel unblocked-game-model ()
   ((level
     :accessor level
@@ -59,29 +66,29 @@
    (shape-data
     :accessor shape-data
     :initform (cells:c-in nil))
-   (tiles
-    :accessor tiles
-    :initform (cells:c? (let ((data (^shape-data)))
-                          (cond
-                            ((null cells:.cache)
-                               (collapse-tiles (init-tiles +horz-tile-count+
-                                                           +vert-tile-count+
-                                                           (1- +max-tile-kinds+))))
-                            (data
-                               (loop with tmp = (clone-tiles cells:.cache)
-                                     for pnt in data do (set-tile tmp pnt 0)
-                                     finally (return (collapse-tiles tmp))))
-                            (t
-                               cells:.cache)))))))
+   (original-tiles
+    :accessor original-tiles
+    :initarg :original-tiles
+    :initform (cells:c-in (collapse-tiles (init-tiles +horz-tile-count+
+                                                      +vert-tile-count+
+                                                      (1- +max-tile-kinds+)))))
+   (active-tiles
+    :accessor active-tiles
+    :initform (cells:c? (revise-tiles cells:.cache (^original-tiles) (^shape-data))))))
 
 (defvar *game* (make-instance 'unblocked-game-model))
 
-(defun reset-game ()
+(defun new-game ()
   (cells:cells-reset)
   (setf *game* (make-instance 'unblocked-game-model)))
 
+(defun restart-game ()
+  (let ((saved-tiles (original-tiles *game*)))
+    (cells:cells-reset)
+    (setf *game* (make-instance 'unblocked-game-model :original-tiles saved-tiles))))
+
 (defun game-tiles ()
-  (tiles *game*))
+  (active-tiles *game*))
 
 (defun game-shape-data (pnts)
   (setf (shape-data *game*) pnts))
@@ -102,5 +109,5 @@
 (cells:defobserver score ((self unblocked-game-model))
   (update-panel (get-scoreboard-panel)))
 
-(cells:defobserver tiles ((self unblocked-game-model))
+(cells:defobserver active-tiles ((self unblocked-game-model))
   (update-panel (get-tiles-panel)))

Modified: trunk/src/demos/unblocked/unblocked-window.lisp
==============================================================================
--- trunk/src/demos/unblocked/unblocked-window.lisp	(original)
+++ trunk/src/demos/unblocked/unblocked-window.lisp	Sat Jun 24 21:46:36 2006
@@ -52,16 +52,15 @@
 
 (defun new-unblocked (disp item time rect)
   (declare (ignore disp item time rect))
-  (reset-game)
-  (let ((tiles-disp (gfw:dispatcher *tiles-panel*))
-        (scoreboard-disp (gfw:dispatcher *scoreboard-panel*)))
-    (update-buffer scoreboard-disp)
-    (update-buffer tiles-disp)
-    (gfw:redraw *scoreboard-panel*)
-    (gfw:redraw *tiles-panel*)))
+  (new-game)
+  (update-panel *scoreboard-panel*)
+  (update-panel *tiles-panel*))
 
 (defun restart-unblocked (disp item time rect)
-  (declare (ignore disp item time rect)))
+  (declare (ignore disp item time rect))
+  (restart-game)
+  (update-panel *scoreboard-panel*)
+  (update-panel *tiles-panel*))
 
 (defun reveal-unblocked (disp item time rect)
   (declare (ignore disp item time rect)))