Author: junrue Date: Sun Apr 1 00:30:17 2007 New Revision: 454
Modified: branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-controller.lisp branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp Log: implemented text and (setf text) for status-bar; unblocked now displays shape count and points scored via status-bar messages
Modified: branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-controller.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-controller.lisp (original) +++ branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-controller.lisp Sun Apr 1 00:30:17 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; unblocked-controller.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -37,11 +37,13 @@
(defun ctrl-start-game () (model-new) + (update-status-bar "Ready.") (update-panel (get-scoreboard-panel)) (update-panel (get-tiles-panel)))
(defun ctrl-restart-game () (model-rollback) + (update-status-bar "Ready.") (update-panel (get-scoreboard-panel)) (update-panel (get-tiles-panel)))
@@ -82,10 +84,17 @@ (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)) - (let ((prev-level (model-level))) + (let ((prev-level (model-level)) + (orig-score (score-of *game*))) (update-model-score shape-pnts) + (update-status-bar (format nil + "Removed ~d tiles for ~d points." + (length shape-pnts) + (- (score-of *game*) orig-score))) (if (> (model-level) prev-level) - (regenerate-model-tiles) + (progn + (regenerate-model-tiles) + (update-status-bar "Ready.")) (update-model-tiles shape-pnts)) (update-panel (get-scoreboard-panel)) (update-panel (get-tiles-panel)))
Modified: branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp (original) +++ branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp Sun Apr 1 00:30:17 2007 @@ -61,6 +61,10 @@ (update-buffer (gfw:dispatcher panel)) (gfw:redraw panel))
+(defun update-status-bar (msg) + (if *unblocked-win* + (setf (gfw:text (gfw:status-bar-of *unblocked-win*)) msg))) + (defun reveal-unblocked (disp item) (declare (ignore disp item)) (ctrl-reveal-move)) @@ -129,7 +133,8 @@
(new-unblocked nil nil) (let ((*default-pathname-defaults* (parse-namestring gfsys::*unblocked-dir*))) - (setf (gfw:image *unblocked-win*) (make-instance 'gfg:icon-bundle :file (merge-pathnames "unblocked.ico")))) + (setf (gfw:image *unblocked-win*) + (make-instance 'gfg:icon-bundle :file (merge-pathnames "unblocked.ico")))) (gfw:show *unblocked-win* t)))
(defun unblocked ()
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp Sun Apr 1 00:30:17 2007 @@ -127,3 +127,9 @@ (widths (stb-get-border-widths self))) (gfs:make-size :width 0 :height (+ (gfs:size-height tmp-size) (* (second widths) 2) 1)))) + +(defmethod text ((sbar status-bar)) + (stb-get-text sbar 0)) + +(defmethod (setf text) (str (sbar status-bar)) + (stb-set-text sbar str))