diff options
| -rw-r--r-- | examples/13-menus.lisp | 20 | ||||
| -rw-r--r-- | gui/menus.lisp | 27 | ||||
| -rw-r--r-- | src/application.lisp | 8 | ||||
| -rw-r--r-- | src/events/event-handler.lisp | 3 | ||||
| -rw-r--r-- | src/events/listener.lisp | 6 | ||||
| -rw-r--r-- | src/package.lisp | 6 |
6 files changed, 41 insertions, 29 deletions
diff --git a/examples/13-menus.lisp b/examples/13-menus.lisp index d1c5668..2c797f3 100644 --- a/examples/13-menus.lisp +++ b/examples/13-menus.lisp @@ -9,11 +9,23 @@ (defclass menus-demo (ww::application) ()) (defclass numbered-image (ww::image) - ((n :initarg :num :reader num))) + ((n :initarg :num :reader num) + (menu :initarg :menu :accessor item-menu))) + +(defmethod ww::add-menu-item :after ((menu ww::menu) (item numbered-image)) + (setf (item-menu item) menu)) (ww:defhandler item-clicked (ww::on-mousedown (img) - (format t "~a was clicked~%" (num img)))) + (ww::remove-menu-item (item-menu img) img))) + +(ww::defhandler indicate-focus + (ww::on-focus (img) + (format t "~a got focus~%" (num img)))) + +(ww::defhandler indicate-blur + (ww::on-blur (img) + (format t "~a lost focus~%" (num img)))) (defmethod ww::boot ((app menus-demo)) (let ((vscroller @@ -27,7 +39,9 @@ :num i :texture (ww:get-asset "Fezghoul.png")) do - (ww::add-handler img #'item-clicked) + (ww:add-handler img #'item-clicked) + (ww:add-handler img #'indicate-blur) + (ww:add-handler img #'indicate-focus) (ww::add-menu-item vscroller img)) (ww:add-unit vscroller) (ww:refocus-on vscroller))) diff --git a/gui/menus.lisp b/gui/menus.lisp index 0e51aba..77ce56f 100644 --- a/gui/menus.lisp +++ b/gui/menus.lisp @@ -22,13 +22,8 @@ (focus (when (slot-boundp menu 'focus) (unless (eq new-value (slot-value menu 'focus)) - (fire-blur-event-on (slot-value menu 'focus))))))) - -(defmethod (setf closer-mop:slot-value-using-class ) :after - (new-value class (menu menu) slot) - (case (closer-mop:slot-definition-name slot) - (focus - (fire-focus-event-on new-value)))) + (fire-blur-event-on (slot-value menu 'focus)) + (fire-focus-event-on new-value)))))) (macrolet ((def-menu-accessors (&rest accessor-names) @@ -56,20 +51,30 @@ (dolist (o (menu-items menu)) (drop-unit o))) +(defconstant +menu-mouseover-tag+ "menu-mouseover-tag") + (defgeneric add-menu-item (menu item)) (defmethod add-menu-item ((menu menu) item) (setf (unit-region item) (unit-region menu) (focusablep item) nil) ; so that event handling here doesn't steal menu focus + (add-handler + item + (on-mousemotion () + :tag +menu-mouseover-tag+ + (setf (menu-focus menu) item))) (setf (menu-items menu) (nconc (menu-items menu) (list item))) (when (unit-in-scene-p menu) (add-unit item))) -(defun remove-menu-item (menu item) +(defgeneric remove-menu-item (menu item)) + +(defmethod remove-menu-item ((menu menu) item) (when (member item (menu-items menu)) (setf (unit-region item) *application*) (setf (menu-items menu) (delete item (menu-items menu))) + (remove-handler item :mousemotion :tag +menu-mouseover-tag+) (drop-unit item))) (defmethod render ((menu menu)) @@ -105,6 +110,12 @@ (y item) (- (+ (y vs) (height vs) (vert-scroll vs)) (vscroller-items-height vs)))) +(defun refresh-vscroller (vs) + (setf (vert-scroll vs) (vert-scroll vs))) + +(defmethod remove-menu-item :after ((vs vscroller) item) + (refresh-vscroller vs)) + (defmethod initialize-instance :after ((vscroller vscroller) &key) (add-handler vscroller #'vscroller-scroll)) diff --git a/src/application.lisp b/src/application.lisp index 4073a15..5b6e9ad 100644 --- a/src/application.lisp +++ b/src/application.lisp @@ -71,22 +71,20 @@ (focus (when (slot-boundp app 'focus) (unless (eq new-value (slot-value app 'focus)) - (fire-blur-event-on (slot-value app 'focus))))))) + (fire-blur-event-on (slot-value app 'focus)) + (fire-focus-event-on new-value)))))) (defmethod (setf closer-mop:slot-value-using-class) :after (new-value class (app application) slot) (case (closer-mop:slot-definition-name slot) ((scale width height) (set-projection app)) - (focus - (fire-focus-event-on new-value)) (fps (setf (slot-value app 'frame-wait) (/ 1.0 new-value))))) (defparameter +listener-table-slot-names+ '(keydown-table keyup-table mousedown-table mouseup-table mousemotion-table - focus-table blur-table perframe-table after-added-table before-added-table - before-dropped-table)) + focus-table blur-table perframe-table)) (defmethod cleanup ((app application)) (loop for asset being the hash-value of (application-assets app) diff --git a/src/events/event-handler.lisp b/src/events/event-handler.lisp index a88f63d..e9a26cd 100644 --- a/src/events/event-handler.lisp +++ b/src/events/event-handler.lisp @@ -262,6 +262,7 @@ can be redefined using this form to support interactive development." " `(make-instance 'event-handler + :tag ,(get-tag-from-handler-body body) :event-type 'wheelwork::mousewheel :handler-function (lambda (,(intern (symbol-name target)) @@ -273,7 +274,7 @@ can be redefined using this form to support interactive development." ,(intern (symbol-name horiz)) ,(intern (symbol-name vert)) ,(intern (symbol-name dir)))) - ,@body))) + ,@(get-body-from-handler-body body)))) (defmacro on-blur ((&optional (target 'target)) &body body) diff --git a/src/events/listener.lisp b/src/events/listener.lisp index 366465a..e66afe2 100644 --- a/src/events/listener.lisp +++ b/src/events/listener.lisp @@ -12,9 +12,6 @@ focus blur perframe - after-added - before-added - before-dropped :r :with :type (or null event-handler) :std nil) (keydown-table keyup-table @@ -25,9 +22,6 @@ focus-table blur-table perframe-table - after-added-table - before-added-table - before-dropped-table :static :std (make-hash-table :synchronized t) :doc "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if diff --git a/src/package.lisp b/src/package.lisp index 7a07726..22cb797 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -47,9 +47,6 @@ ;; Event Handler API #:add-handler #:defhandler - #:on-after-added - #:on-before-added - #:on-before-dropped #:on-blur #:on-focus #:on-keydown @@ -62,9 +59,6 @@ ;; Event Names, useful for dropping whole classes of events from a ;; unit - #:after-added - #:before-added - #:before-dropped #:blur #:focus #:keydown |