Mercurial > hg > indyvon

changeset 19:43f0d78057a9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New event dispatching code that uses weak references to allow listened layers to be garbage-collected.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 17 Jun 2010 20:59:22 +0400
parents 740b9d2bbc45
children 357bdd7d0550
files src/indyvon/component.clj src/indyvon/event.clj
diffstat 2 files changed, 57 insertions(+), 31 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Thu Jun 17 18:54:22 2010 +0400
+++ b/src/indyvon/component.clj	Thu Jun 17 20:59:22 2010 +0400
@@ -83,26 +83,19 @@
       (.pack)
       (.setVisible true))
 
-    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED]
-      [layer context event]
-      (println "1 ENTERED"))
-    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED]
-      [layer context event]
-      (println "1 EXITED"))
-    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED]
-      [layer context event]
-      (println "1 MOVED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_ENTERED]
-      [layer context event]
-      (println "2 ENTERED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_EXITED]
-      [layer context event]
-      (println "2 EXITED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_MOVED]
-      [layer context event]
-      (println "2 MOVED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_DRAGGED]
-      [layer context event]
-      (println "2 DRAGGED"))
+    (add-listener layer1 MouseEvent/MOUSE_ENTERED
+                  (fn [context event] (println "1 ENTERED")))
+    (add-listener layer1 MouseEvent/MOUSE_EXITED
+                  (fn [context event] (println "1 EXITED")))
+    (add-listener layer1 MouseEvent/MOUSE_MOVED
+                  (fn [context event] (println "1 MOVED")))
+    (add-listener layer2 MouseEvent/MOUSE_ENTERED
+                  (fn [context event] (println "2 ENTERED")))
+    (add-listener layer2 MouseEvent/MOUSE_EXITED
+                  (fn [context event] (println "2 EXITED")))
+    (add-listener layer2 MouseEvent/MOUSE_MOVED
+                  (fn [context event] (println "2 MOVED")))
+    (add-listener layer2 MouseEvent/MOUSE_DRAGGED
+                  (fn [context event] (println "2 DRAGGED")))
     )
   )
--- a/src/indyvon/event.clj	Thu Jun 17 18:54:22 2010 +0400
+++ b/src/indyvon/event.clj	Thu Jun 17 20:59:22 2010 +0400
@@ -6,13 +6,47 @@
 
 (ns indyvon.event
   (:use indyvon.core)
-  (:import (java.awt.event MouseEvent MouseListener MouseMotionListener)))
+  (:import (java.awt.event MouseEvent MouseListener MouseMotionListener)
+           java.lang.ref.WeakReference))
+
+;; map event-id -> [layer-weak-ref1 fn1, layer-weak-ref2 fn2...]
+(def listeners-map (ref {}))
+
+(defn- assoc-conj [map key & vals]
+  (assoc map key (apply conj (vec (get map key)) vals)))
+
+(defn add-listener
+  "The supplied function will be invoked with context, event and
+  additional args when an event with the specified id occurs on the
+  specified layer."
+  [layer event-id f & args]
+  (let [f (if args #(apply f %1 %2 args) f)]
+    (dosync
+     (alter listeners-map assoc-conj event-id (WeakReference. layer) f))
+    nil))
 
-(defmulti handle-layer-event 
-  (fn [layer context event]
-    [layer (.getID event)]))
+(defn- listeners
+  "Returns list of listener fns for event and target-layer. Listeners
+  for garbage-collected layers are removed."
+  [event-id target-layer]
+  (dosync
+   (loop [ref-vec (@listeners-map event-id) cleared-ref-vec [] listeners []]
+     (if-let [layer-ref (first ref-vec)]
+       (if-let [layer (.get layer-ref)]
+         (let [lfn (second ref-vec)]
+           (recur (nnext ref-vec)
+                  (conj cleared-ref-vec layer-ref lfn)
+                  (if (= layer target-layer)
+                    (conj listeners lfn)
+                    listeners)))
+         (recur (nnext ref-vec) cleared-ref-vec listeners))
+       (do
+         (alter listeners-map assoc event-id cleared-ref-vec)
+         listeners)))))
 
-(defmethod handle-layer-event :default [layer context event])
+(defn dispatch-event [context event]
+  (doseq [listener (listeners (.getID event) (:layer context))]
+    (listener context event)))
 
 (defprotocol EventDispatcher
   (listen! [this component])
@@ -78,11 +112,10 @@
   ([contexts event]
      (translate-and-dispatch contexts event (.getID event)))
   ([contexts event id]
-  (doseq [c contexts]
-    (handle-layer-event
-     (:layer c)
-     c
-     (translate-mouse-event event (:x c) (:y c) id)))))
+  (doseq [context contexts]
+    (dispatch-event
+     context
+     (translate-mouse-event event (:x context) (:y context) id)))))
 
 (defn- dispatch-mouse-motion*
   "Dispatches mouse motion events. Returns a new set of contexts which