Author: junrue Date: Wed Sep 27 01:08:38 2006 New Revision: 272 Modified: trunk/src/demos/unblocked/scoreboard-panel.lisp trunk/src/demos/unblocked/unblocked-controller.lisp trunk/src/demos/unblocked/unblocked-model.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/system/user32.lisp Log: generate a new set of tiles on reaching the next level; provide a bit of feedback when asked to reveal next move Modified: trunk/src/demos/unblocked/scoreboard-panel.lisp ============================================================================== --- trunk/src/demos/unblocked/scoreboard-panel.lisp (original) +++ trunk/src/demos/unblocked/scoreboard-panel.lisp Wed Sep 27 01:08:38 2006 @@ -112,8 +112,8 @@ (unwind-protect (progn (clear-buffer self gc) - (draw-scoreboard-row gc 1 image-size label-font *score-label* value-font (game-score)) - (draw-scoreboard-row gc 0 image-size label-font *level-label* value-font (game-level)) + (draw-scoreboard-row gc 1 image-size label-font *score-label* value-font (model-score)) + (draw-scoreboard-row gc 0 image-size label-font *level-label* value-font (model-level)) (draw-scoreboard-row gc 2 image-size label-font *points-needed-label* value-font (game-points-needed))) (gfs:dispose gc)))) Modified: trunk/src/demos/unblocked/unblocked-controller.lisp ============================================================================== --- trunk/src/demos/unblocked/unblocked-controller.lisp (original) +++ trunk/src/demos/unblocked/unblocked-controller.lisp Wed Sep 27 01:08:38 2006 @@ -47,13 +47,20 @@ (defun ctrl-reveal-move () (let ((shape (find-shape (model-tiles) #'accept-shape-p))) - (when shape - (let ((shape-pnts (shape-tile-points shape)) - (timer (make-instance 'gfw:timer :initial-delay +revealed-duration+ - :delay 0 - :dispatcher (gfw:dispatcher (get-unblocked-win))))) - (draw-tiles-directly (get-tiles-panel) shape-pnts +max-tile-kinds+) - (gfw:enable timer t))))) + (cond + (shape + (let ((shape-pnts (shape-tile-points shape)) + (timer (make-instance 'gfw:timer :initial-delay +revealed-duration+ + :delay 0 + :dispatcher (gfw:dispatcher (get-unblocked-win))))) + (draw-tiles-directly (get-tiles-panel) shape-pnts +max-tile-kinds+) + (gfw:enable timer t))) + (t + (gfs::message-box (gfs:handle (get-unblocked-win)) + "There are no remaining shapes." + "Sorry!" + (logior gfs::+mb-ok+ gfs::+mb-iconinformation+) + 0))))) (defun ctrl-start-selection (shape-pnts panel point button) (let* ((tiles (model-tiles)) @@ -75,8 +82,11 @@ (let ((tile-pnt (window->tiles point))) (when (and (eql button :left-button) shape-pnts) (if (and tile-pnt (find tile-pnt shape-pnts :test #'eql-point)) - (progn - (update-model-tiles shape-pnts) + (let ((prev-level (model-level))) + (update-model-score shape-pnts) + (if (> (model-level) prev-level) + (regenerate-model-tiles) + (update-model-tiles shape-pnts)) (update-panel (get-scoreboard-panel)) (update-panel (get-tiles-panel))) (draw-tiles-directly panel shape-pnts shape-kind))))) Modified: trunk/src/demos/unblocked/unblocked-model.lisp ============================================================================== --- trunk/src/demos/unblocked/unblocked-model.lisp (original) +++ trunk/src/demos/unblocked/unblocked-model.lisp Wed Sep 27 01:08:38 2006 @@ -85,21 +85,26 @@ (defun model-tiles () (active-tiles-of *game*)) +(defun update-model-score (shape-data) + (incf (score-of *game*) (* 5 (length shape-data)))) + (defun update-model-tiles (shape-data) (setf (active-tiles-of *game*) (if shape-data (progn - (incf (score-of *game*) (* 5 (length shape-data))) (loop with tmp = (clone-tiles (active-tiles-of *game*)) for pnt in shape-data do (set-tile tmp pnt 0) finally (return (collapse-tiles tmp)))) (original-tiles-of *game*)))) -(defun game-level () +(defun regenerate-model-tiles () + (setf (active-tiles-of *game*) (compute-new-game-tiles))) + +(defun model-level () (lookup-level-reached (score-of *game*))) (defun game-points-needed () - (- (nth (1- (game-level)) *points-needed-table*) (score-of *game*))) + (- (nth (1- (model-level)) *points-needed-table*) (score-of *game*))) -(defun game-score () +(defun model-score () (score-of *game*)) Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Wed Sep 27 01:08:38 2006 @@ -597,6 +597,38 @@ (defconstant +lr-copyfromresource+ #x4000) (defconstant +lr-shared+ #x8000) +(defconstant +mb-ok+ #x00000000) +(defconstant +mb-okcancel+ #x00000001) +(defconstant +mb-abortretryignore+ #x00000002) +(defconstant +mb-yesnocancel+ #x00000003) +(defconstant +mb-yesno+ #x00000004) +(defconstant +mb-retrycancel+ #x00000005) +(defconstant +mb-canceltrycontinue+ #x00000006) +(defconstant +mb-iconhand+ #x00000010) +(defconstant +mb-iconquestion+ #x00000020) +(defconstant +mb-iconexclamation+ #x00000030) +(defconstant +mb-iconasterisk+ #x00000040) +(defconstant +mb-usericon+ #x00000080) +(defconstant +mb-iconwarning+ #x00000030) +(defconstant +mb-iconerror+ #x00000010) +(defconstant +mb-iconinformation+ #x00000040) +(defconstant +mb-iconstop+ #x00000010) +(defconstant +mb-defbutton1+ #x00000000) +(defconstant +mb-defbutton2+ #x00000100) +(defconstant +mb-defbutton3+ #x00000200) +(defconstant +mb-defbutton4+ #x00000300) +(defconstant +mb-applmodal+ #x00000000) +(defconstant +mb-systemmodal+ #x00001000) +(defconstant +mb-taskmodal+ #x00002000) +(defconstant +mb-help+ #x00004000) +(defconstant +mb-nofocus+ #x00008000) +(defconstant +mb-setforeground+ #x00010000) +(defconstant +mb-default-desktop-only+ #x00020000) +(defconstant +mb-topmost+ #x00040000) +(defconstant +mb-right+ #x00080000) +(defconstant +mb-rtlreading+ #x00100000) +(defconstant +mb-service-notification+ #x00200000) + (defconstant +mf-bycommand+ #x00000000) (defconstant +mf-byposition+ #x00000400) Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Wed Sep 27 01:08:38 2006 @@ -570,6 +570,15 @@ (type UINT)) (defcfun + ("MessageBoxExA" message-box) + INT + (hwnd HANDLE) + (text :string) + (caption :string) + (type UINT) + (langid WORD)) + +(defcfun ("MonitorFromWindow" monitor-from-window) HANDLE (hwnd HANDLE)