aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/interactive/interactive.lisp
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/interactive/interactive.lisp
parent099c3f927c11fe7ae4d12933d6f72abc0b53e973 (diff)
[structure] renamed some asd modules
Diffstat (limited to 'src/interactive/interactive.lisp')
-rw-r--r--src/interactive/interactive.lisp56
1 files changed, 56 insertions, 0 deletions
diff --git a/src/interactive/interactive.lisp b/src/interactive/interactive.lisp
new file mode 100644
index 0000000..a8fa7fd
--- /dev/null
+++ b/src/interactive/interactive.lisp
@@ -0,0 +1,56 @@
+;;;; interactive.lisp
+
+(in-package #:wheelwork)
+
+(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))))