Author: junrue Date: Mon Jun 26 08:30:24 2006 New Revision: 162
Modified: trunk/docs/manual/api.texinfo trunk/src/demos/unblocked/tiles-panel.lisp trunk/src/packages.lisp trunk/src/uitoolkit/widgets/window.lisp Log: implemented and documented capture-mouse/release-mouse functions
Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Mon Jun 26 08:30:24 2006 @@ -813,6 +813,17 @@ widget must be a @ref{button} and is typically labelled @emph{Cancel}. @end deffn
+@anchor{capture-mouse} +@deffn Function capture-mouse self +Enables the @ref{window} identified by @code{self} to receive mouse +input events even when the mouse pointer is outside of the bounds +of @code{self}. Only one window at a time can capture the mouse. This +function is primarily intended for use with a window in the foreground; +background windows may still capture the mouse, but only mouse move +events will be received and those only when the mouse hotspot is within +the visible portions of such a window. @xref{release-mouse}. +@end deffn + @anchor{center-on-owner} @deffn GenericFunction center-on-owner self Position @code{self} such that it is centrally located relative to its @@ -1031,6 +1042,12 @@ Causes the entire bounds of the object to be marked as needing to be redrawn @end deffn
+@anchor{release-mouse} +@deffn Function release-mouse +Clears the mouse capture state to restore normal mouse input processing. +@xref{capture-mouse}. +@end deffn + @anchor{show} @deffn GenericFunction show self flag Causes the object to be visible or hidden on the screen, but not
Modified: trunk/src/demos/unblocked/tiles-panel.lisp ============================================================================== --- trunk/src/demos/unblocked/tiles-panel.lisp (original) +++ trunk/src/demos/unblocked/tiles-panel.lisp Mon Jun 26 08:30:24 2006 @@ -110,19 +110,19 @@ (if (and (eql button :left-button) (> tile-kind 0)) (shape-tiles tiles tile-pnt tmp-table)) (when (> (hash-table-count tmp-table) 1) + (gfw:capture-mouse panel) (setf (shape-kind-of self) tile-kind) (setf (shape-pnts-of self) (shape-tile-points tmp-table)) (draw-tiles-directly panel (shape-pnts-of self) +max-tile-kinds+))))
(defmethod gfw:event-mouse-up ((self tiles-panel-events) panel time point button) (declare (ignore time)) + (gfw:release-mouse) (let ((tile-pnt (window->tiles point)) (shape-pnts (shape-pnts-of self))) - (if (and (eql button :left-button) - shape-pnts - (find tile-pnt shape-pnts :test #'eql-point)) - (game-shape-data shape-pnts) - (if shape-pnts + (when (and (eql button :left-button) shape-pnts) + (if (and tile-pnt (find tile-pnt shape-pnts :test #'eql-point)) + (game-shape-data shape-pnts) (draw-tiles-directly panel shape-pnts (shape-kind-of self))))) (setf (shape-kind-of self) 0) (setf (shape-pnts-of self) nil))
Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Mon Jun 26 08:30:24 2006 @@ -318,6 +318,7 @@ #:background-pattern #:border-width #:bottom-margin-of + #:capture-mouse #:caret #:center-on-owner #:center-on-parent @@ -441,6 +442,7 @@ #:primary-p #:redraw #:redrawing-p + #:release-mouse #:remove-all #:remove-item #:remove-span
Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Mon Jun 26 08:30:24 2006 @@ -141,6 +141,16 @@ retval (error 'gfs::win32-error :detail "register-class failed")))))))
+(defun capture-mouse (self) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) + (unless (typep self 'window) + (error 'gfs:toolkit-error :detail "capture-mouse is restricted to window subclasses")) + (gfs::set-capture (gfs:handle self))) + +(defun release-mouse () + (gfs::release-capture)) + (eval-when (:compile-toplevel :load-toplevel :execute) (defmacro with-children ((win var) &body body) (let ((hwnd (gensym)))