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))))