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

[junrue at common-lisp.net]

Author: junrue
Date: Sat May  6 18:59:15 2006
New Revision: 119

Modified:
   trunk/src/demos/unblocked/tiles.lisp
   trunk/src/demos/unblocked/unblocked-model.lisp
Log:
minor cleanup and refactoring of unblocked game model

Modified: trunk/src/demos/unblocked/tiles.lisp
==============================================================================
--- trunk/src/demos/unblocked/tiles.lisp	(original)
+++ trunk/src/demos/unblocked/tiles.lisp	Sat May  6 18:59:15 2006
@@ -119,7 +119,8 @@
 (defun collapse-tiles (tiles)
   (let ((size (size-tiles tiles)))
     (dotimes (i (gfs:size-width size))
-      (setf (aref tiles i) (collapse-column (aref tiles i))))))
+      (setf (aref tiles i) (collapse-column (aref tiles i)))))
+  tiles)
 
 (defun clone-tiles (orig-tiles)
   (let* ((width (gfs:size-width (size-tiles orig-tiles)))

Modified: trunk/src/demos/unblocked/unblocked-model.lisp
==============================================================================
--- trunk/src/demos/unblocked/unblocked-model.lisp	(original)
+++ trunk/src/demos/unblocked/unblocked-model.lisp	Sat May  6 18:59:15 2006
@@ -36,48 +36,44 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant +max-tile-kinds+   6)
   (defconstant +horz-tile-count+ 17)
-  (defconstant +vert-tile-count+ 12))
+  (defconstant +vert-tile-count+ 12)
+  (defconstant +max-levels+      21))
 
-(defun factorial (n)
-  (if (zerop n)
-    1
-    (* n (factorial (1- n)))))
+(defvar *points-needed-table* (loop for level from 1 to +max-levels+
+                                    collect (* 250 level level)))
+
+(defun lookup-level-reached (score)
+  (let ((level 1))
+    (loop for entry in *points-needed-table*
+          until (> entry score)
+          do (incf level))
+    level))
 
 (cells:defmodel unblocked-game-model ()
   ((level
     :accessor level
-    :initform (cells:c? (let* ((lvl (if cells:.cache cells:.cache 1))
-                               (pnts-needed (* 20 (factorial lvl))))
-                          (if (>= (^score) pnts-needed)
-                            (1+ lvl)
-                            lvl))))
+    :initform (cells:c? (lookup-level-reached (^score))))
    (score
     :accessor score
-    :initform (cells:c? (+ (if cells:.cache cells:.cache 0)
+    :initform (cells:c? (+ (or cells:.cache 0)
                            (* 5 (length (^shape-data))))))
-   (points-needed
-    :accessor points-needed
-    :initform (cells:c? (* 20 (factorial (^level)))))
    (shape-data
     :accessor shape-data
     :initform (cells:c-in nil))
    (tiles
     :accessor tiles
-    :initform (cells:c? (let ((tmp nil)
-                              (data (^shape-data)))
-                          (if (null cells:.cache)
-                            (progn
-                              (setf tmp (init-tiles +horz-tile-count+
-                                                    +vert-tile-count+
-                                                    (1- +max-tile-kinds+)))
-                              (collapse-tiles tmp))
-                            (if data
-                              (progn
-                                (setf tmp (clone-tiles cells:.cache))
-                                (loop for pnt in data do (set-tile tmp pnt 0))
-                                (collapse-tiles tmp))
-                              (setf tmp cells:.cache)))
-                          tmp)))))
+    :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
+                               (let ((tmp (clone-tiles cells:.cache)))
+                                 (loop for pnt in data do (set-tile tmp pnt 0))
+                                 (collapse-tiles tmp)))
+                            (t
+                               cells:.cache)))))))
 
 (defvar *game* (make-instance 'unblocked-game-model))
 
@@ -95,7 +91,7 @@
   (level *game*))
 
 (defun game-points-needed ()
-  (- (points-needed *game*) (score *game*)))
+  (- (nth (1- (level *game*)) *points-needed-table*) (score *game*)))
 
 (defun game-score ()
   (score *game*))