changeset 21:a70609bad3a4

Simpler event dispatching.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sat, 19 Jun 2010 04:27:29 +0400
parents 357bdd7d0550
children dc81033d4122
files src/indyvon/component.clj src/indyvon/event.clj
diffstat 2 files changed, 60 insertions(+), 88 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Fri Jun 18 04:39:56 2010 +0400
+++ b/src/indyvon/component.clj	Sat Jun 19 04:27:29 2010 +0400
@@ -49,32 +49,44 @@
 (comment
   (do 
     (def frame (JFrame. "Test"))
+    
+    (defn handler [context event]
+      (println (:layer context) (.paramString event)))
+      
     (def layer1
          (reify Layer
           (render! [this context g]
-             (register-context context)
+             (mouse-handler context handler)
              (.setColor g Color/RED)
              (.fillRect g 0 0 (:width context) (:height context)))
-          (size [this context] [30 20])))
+          (size [this context] [30 20])
+          (toString [this] "layer1")))
+    
     (def layer1b (border-layer layer1 2 3))
+    
     (def layer2
          (reify Layer
           (render! [this context g]
-             (register-context context)
+             (mouse-handler context handler)
              (.setColor g Color/YELLOW)
              (.fillRect g 0 0 (:width context) (:height context))
              (draw! context layer1b g 10 5)
              (draw! context layer1 g 55 5))
-          (size [this context] [70 65])))
+          (size [this context] [70 65])
+          (toString [this] "layer2")))
+    
     (def layer3
          (border-layer (text-layer "Sample\ntext" :right :bottom)))
+    
     (def layer
          (reify Layer
           (render! [this context g]
              (.drawLine g 0 0 (:width context) (:height context))
              (draw! context layer2 g 15 20)
              (draw! context layer3 g 100 100 80 50))
-          (size [this context] [400 300])))
+          (size [this context] [400 300])
+          (toString [this] "layer")))
+    
     (doto frame
       (.addWindowListener
        (proxy [java.awt.event.WindowAdapter] []
@@ -82,20 +94,5 @@
       (.. (getContentPane) (add (make-jpanel layer)))
       (.pack)
       (.setVisible true))
-
-    (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	Fri Jun 18 04:39:56 2010 +0400
+++ b/src/indyvon/event.clj	Sat Jun 19 04:27:29 2010 +0400
@@ -9,54 +9,18 @@
   (: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))
-
-(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)))))
-
-(defn dispatch-event [context event]
-  (doseq [listener (listeners (.getID event) (:layer context))]
-    (listener context event)))
-
 (defprotocol EventDispatcher
   (listen! [this component])
-  (register [this context])
+  (register-mouse-handler [this context handler])
   (commit [this])
   (hovered? [this layer])
   (picked? [this layer]))
 
-(defn register-context [context]
-  (register (:dispatcher context) context))
+(defn mouse-handler [context handler & args]
+  "The supplied handler function will be invoked with context, event
+   and additional args when mouse event occurs on the context."
+  (let [handler (if args #(apply handler %1 %2 args) handler)]
+    (register-mouse-handler (:dispatcher context) context handler)))
 
 (defn- registered-parent
   "Returns first context parent registered for event processing."
@@ -70,7 +34,7 @@
 (defn- add-context
   [context-tree context]
   (let [parent (registered-parent context-tree context)]
-    (assoc context-tree parent (conj (context-tree parent) context)
+    (assoc context-tree parent (cons context (context-tree parent))
            context nil)))
 
 (defn- inside?
@@ -108,19 +72,23 @@
     (getXOnScreen [] (.getXOnScreen event))
     (getYOnScreen [] (.getYOnScreen event))))
 
+(defn- dispatch-event [handlers context event]
+  ((handlers context) context event))
+
 (defn- translate-and-dispatch
-  ([contexts event]
-     (translate-and-dispatch contexts event (.getID event)))
-  ([contexts event id]
+  ([contexts handlers event]
+     (translate-and-dispatch contexts handlers event (.getID event)))
+  ([contexts handlers event id]
   (doseq [context contexts]
     (dispatch-event
+     handlers
      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
   currently are under cursor."
-  [hovered context-tree event]
+  [hovered context-tree handlers event]
   (let [x (.getX event)
         y (.getY event)
         hovered2 (under-cursor context-tree x y)
@@ -128,34 +96,39 @@
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
         moved (remove-all hovered2 entered pred)]
-    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
-    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
-    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
+    (translate-and-dispatch
+     exited handlers event MouseEvent/MOUSE_EXITED)
+    (translate-and-dispatch
+     entered handlers event MouseEvent/MOUSE_ENTERED)
+    (translate-and-dispatch
+     moved handlers event MouseEvent/MOUSE_MOVED)
     hovered2))
 
 (defn- dispatch-mouse-motion
-  [hovered-ref context-tree event]
+  [hovered-ref context-tree handlers event]
   (dosync
-   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
+   (alter hovered-ref dispatch-mouse-motion* context-tree handlers event)))
 
 (defn- dispatch-mouse-button*
   "Dispatches mouse button events. Returns a new set of contexts which
   currently are picked with a pressed button."
-  [picked hovered context-tree event]
-  (translate-and-dispatch hovered event)
+  [picked hovered handlers event]
+  (translate-and-dispatch hovered handlers event)
   (if (= (.getID event) MouseEvent/MOUSE_PRESSED)
     hovered
     nil))
-  
+
 (defn- dispatch-mouse-button
-  [picked-ref hovered-ref context-tree event]
+  [picked-ref hovered-ref handlers event]
   (dosync
    (alter picked-ref dispatch-mouse-button*
-          @hovered-ref context-tree event)))
+          @hovered-ref handlers event)))
 
 (defn make-event-dispatcher []
   (let [context-tree-r (ref {}) ; register
+        handlers-r (ref {})     ;
         context-tree (ref {})   ; dispatch
+        handlers (ref {})       ;
         hovered (ref '())
         picked (ref '())]
     (reify
@@ -164,27 +137,29 @@
         (doto component
           (.addMouseListener this)
           (.addMouseMotionListener this)))
-     (register [this context]
-        (dosync (alter context-tree-r add-context context)))
+     (register-mouse-handler [this context handler]
+        (dosync (alter context-tree-r add-context context)
+                (alter handlers-r assoc context handler)))
      (commit [this]
         (dosync (ref-set context-tree @context-tree-r)
-                (ref-set context-tree-r {})))
+                (ref-set context-tree-r {})
+                (ref-set handlers @handlers-r)
+                (ref-set handlers-r {})))
      (picked? [this layer] false)
      (hovered? [this layer] false)
      MouseListener
      (mouseEntered [this event]
-        (dispatch-mouse-motion hovered context-tree event))
+        (dispatch-mouse-motion hovered context-tree handlers event))
      (mouseExited [this event]
-        (dispatch-mouse-motion hovered context-tree event))
+        (dispatch-mouse-motion hovered context-tree handlers event))
      (mouseClicked [this event]
-        (dispatch-mouse-button picked hovered context-tree event))
+        (dispatch-mouse-button picked hovered handlers event))
      (mousePressed [this event]
-        (dispatch-mouse-button picked hovered context-tree event))
+        (dispatch-mouse-button picked hovered handlers  event))
      (mouseReleased [this event]
-        (dispatch-mouse-button picked hovered context-tree event))
+        (dispatch-mouse-button picked hovered handlers event))
      MouseMotionListener
      (mouseDragged [this event]
-        (translate-and-dispatch @picked event))
+        (translate-and-dispatch @picked handlers event))
      (mouseMoved [this event]
-        (dispatch-mouse-motion hovered context-tree event)))))
-
+        (dispatch-mouse-motion hovered context-tree handlers event)))))