aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/events
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-06-30 07:57:54 -0500
committerColin Okay <colin@cicadas.surf>2022-06-30 07:57:54 -0500
commit642c0c594a8abe05be1cb887110ed3e602cd0e48 (patch)
tree2f4aced5b03abb0b8e4532f2676a18f8387895f7 /src/events
parent099c3f927c11fe7ae4d12933d6f72abc0b53e973 (diff)
[structure] renamed some asd modules
Diffstat (limited to 'src/events')
-rw-r--r--src/events/listener-and-interactive.lisp108
-rw-r--r--src/events/listener.lisp56
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))))
+