diff options
Diffstat (limited to 'src/events')
| -rw-r--r-- | src/events/listener-and-interactive.lisp | 108 | ||||
| -rw-r--r-- | src/events/listener.lisp | 56 |
2 files changed, 56 insertions, 108 deletions
diff --git a/src/events/listener-and-interactive.lisp b/src/events/listener-and-interactive.lisp deleted file mode 100644 index e5bdce3..0000000 --- a/src/events/listener-and-interactive.lisp +++ /dev/null @@ -1,108 +0,0 @@ -;;;; listener.lisp - -(in-package #:wheelwork) - -(defclass/std listener () - ((keydown - keyup - mousedown - mouseup - mousemotion - mousewheel - focus - blur - perframe - after-added - before-added - before-dropped - :r :with :type (or null event-handler) :std nil) - (keydown-table - keyup-table - mousedown-table - mouseup-table - mousemotion-table - mousewheel-table - 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 - handler is defined for unit.")) - (:documentation "Event handlers per object. The static hash tables - are keyed by UNIT and hold Event-Handler instances.")) - -(defun listener-table-for (listener event-type) - (ecase event-type - (keydown (keydown-table listener)) - (keyup (keyup-table listener)) - (mousedown (mousewheel-table listener)) - (mouseup (mouseup-table listener)) - (mousemotion (mousemotion-table listener)) - (mousewheel (mousewheel-table listener)) - (focus (focus-table listener)) - (blur (blur-table listener)) - (perframe (perframe-table listener)) - (after-added (after-added-table listener)) - (before-added (before-added-table listener)) - (after-dropped (after-dropped-table listener)) - (before-dropped (before-dropped-table listener)))) - -(defun should-listen-for-p (event-type app) - (plusp (hash-table-count (listener-table-for (listener app) event-type)))) - -(defclass/std interactive () - ((listener :type (or null listener) :std nil :a) - (focusablep :std t :doc "Whether or not this object can receive application focus.")) - (:documentation "Supplies an object with a listener slot.")) - -(defun add-handler (interactive handler) - (when (null (listener interactive)) - (setf (listener interactive) (make-instance 'listener))) - (pushnew handler (slot-value (listener interactive) (event-type handler)) :test #'eq) - (setf - (gethash interactive (listener-table-for (listener interactive) (event-type handler))) - t)) - - -(defun remove-handler (interactive handler-or-event-type) - "Handler can be an instance of EVENT-HANDLER or can be a symbol - whose name is an event type. If is an event handler, only that - handler will be removed. If it is an event type, all events of that - type name are removed from the object." - (when (listener interactive) - (let ((event-type (etypecase handler-or-event-type - (keyword (intern (symbol-name handler-or-event-type) :wheelwork)) - (symbol (intern (symbol-name handler-or-event-type) :wheelwork)) - (event-handler (event-type handler-or-event-type))))) - (setf (slot-value (listener interactive) event-type) - (if (symbolp handler-or-event-type) - ;; remove everything if a symbol - nil - ;; delete just the handler - (delete handler-or-event-type - (slot-value (listener interactive) event-type) - :test #'eq))) - ;; remove from from the global table unless any listeners remain on this event - (unless (slot-value (listener interactive) event-type) - (remhash interactive (listener-table-for (listener interactive) event-type)))))) - - -(defmethod drop-unit :before ((unit interactive)) - (when (unit-container unit) - (when-let (handlers (get-handlers-for unit 'before-dropped)) - (dolist (handler handlers) - (funcall handler unit))))) - -(defmethod add-unit :before ((container container) (unit interactive)) - (when-let (handlers (get-handlers-for unit 'before-added)) - (dolist (handler handlers) - (funcall handler container unit)))) - -(defmethod add-unit :after ((container container) (unit interactive)) - (when-let (handlers (get-handlers-for unit 'after-added)) - (dolist (handler handlers) - (funcall handler container unit)))) diff --git a/src/events/listener.lisp b/src/events/listener.lisp new file mode 100644 index 0000000..3e195ff --- /dev/null +++ b/src/events/listener.lisp @@ -0,0 +1,56 @@ +;;;; listener.lisp + +(in-package #:wheelwork) + +(defclass/std listener () + ((keydown + keyup + mousedown + mouseup + mousemotion + mousewheel + focus + blur + perframe + after-added + before-added + before-dropped + :r :with :type (or null event-handler) :std nil) + (keydown-table + keyup-table + mousedown-table + mouseup-table + mousemotion-table + mousewheel-table + 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 + handler is defined for unit.")) + (:documentation "Event handlers per object. The static hash tables + are keyed by UNIT and hold Event-Handler instances.")) + +(defun listener-table-for (listener event-type) + (ecase event-type + (keydown (keydown-table listener)) + (keyup (keyup-table listener)) + (mousedown (mousewheel-table listener)) + (mouseup (mouseup-table listener)) + (mousemotion (mousemotion-table listener)) + (mousewheel (mousewheel-table listener)) + (focus (focus-table listener)) + (blur (blur-table listener)) + (perframe (perframe-table listener)) + (after-added (after-added-table listener)) + (before-added (before-added-table listener)) + (after-dropped (after-dropped-table listener)) + (before-dropped (before-dropped-table listener)))) + +(defun should-listen-for-p (event-type app) + (plusp (hash-table-count (listener-table-for (listener app) event-type)))) + |