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*))
graphic-forms-cvs@common-lisp.net