changeset 134:16643a84b9e4

Refactored the event dispatcher. Update hover states at every commit.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 24 Apr 2012 18:51:37 +0400
parents 2c2e4c639311
children 7eddb035d9c4
files src/net/kryshen/indyvon/core.clj
diffstat 1 files changed, 78 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/core.clj	Tue Apr 24 18:49:06 2012 +0400
+++ b/src/net/kryshen/indyvon/core.clj	Tue Apr 24 18:51:37 2012 +0400
@@ -615,7 +615,7 @@
 
 (defn- under-cursor
   "Returns a vector of child nodes under cursor."
-  [x y tree node]
+  [^long x ^long y tree node]
   (some #(if (and (:clip %)
                   (.contains ^Shape (:clip %) x y))
            (conj (vec (under-cursor x y tree %)) %))
@@ -652,26 +652,40 @@
              (recur (rest nodes) false event id)))
          (recur (rest nodes) first-only event id)))))
 
+(defn- process-mouse-position
+  [dispatcher event]
+  (dosync
+   (let [{hovered-ref :hovered
+          last-ref :last-motion
+          tree-ref :tree} dispatcher
+         ^java.awt.event.MouseEvent event (or event @last-ref)]
+     (when event
+       (let [x (.getX event)
+             y (.getY event)
+             old-hovered @hovered-ref
+             hovered (under-cursor x y @tree-ref dispatcher)
+             pred #(= (:handle %1) (:handle %2))
+             exited (remove-all old-hovered hovered pred)
+             entered (remove-all hovered old-hovered pred)
+             moved (remove-all hovered entered pred)]
+         (ref-set hovered-ref hovered)
+         (ref-set last-ref event)
+         [exited entered moved event])))))
+
 (defn- dispatch-mouse-motion
-  "Dispatches mouse motion events."
-  [hovered-ref tree root ^java.awt.event.MouseEvent event]
-  (let [x (.getX event)
-        y (.getY event)
-        [hovered hovered2] (dosync
-                            [@hovered-ref
-                             (ref-set hovered-ref
-                                      (under-cursor x y tree root))])
-        pred #(= (:handle %1) (:handle %2))
-        exited (remove-all hovered hovered2 pred)
-        entered (remove-all hovered2 hovered pred)
-        moved (remove-all hovered2 entered pred)]
+  [dispatcher source-event]
+  (when-let [[exited entered moved event] (process-mouse-position
+                                           dispatcher source-event)]
     (translate-and-dispatch exited false event :mouse-exited)
     (translate-and-dispatch entered false event :mouse-entered)
-    (translate-and-dispatch moved true event :mouse-moved)))
+    (when source-event
+      (translate-and-dispatch moved true event :mouse-moved))))
 
 (defn- dispatch-mouse-button
-  [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
-  (let [id (awt-events (.getID event))
+  [dispatcher ^java.awt.event.MouseEvent event]
+  (let [{picked-ref :picked
+         hovered-ref :hovered} dispatcher
+        id (awt-events (.getID event))
         nodes (case id
                :mouse-pressed
                (dosync
@@ -684,50 +698,55 @@
                @hovered-ref)]
     (translate-and-dispatch nodes true event id)))
 
+(defrecord RootEventDispatcher [tree-r ; register
+                                tree   ; dispatch
+                                hovered
+                                picked
+                                last-motion]
+  EventDispatcher
+  (listen! [dispatcher component]
+    (doto ^Component component
+          (.addMouseListener dispatcher)
+          (.addMouseWheelListener dispatcher)
+          (.addMouseMotionListener dispatcher)))
+  (create-dispatcher [dispatcher handle handlers]
+    (let [node (make-node handle handlers)]
+      (dosync (alter tree-r add-node node))
+      node))
+  (commit [dispatcher]
+    ;; TODO: retain contexts that do not intersect graphics
+    ;; clipping area in tree.
+    (dosync (ref-set tree @tree-r)
+            (ref-set tree-r {}))
+    ;; Send mouse entered and exited events if necessary due to
+    ;; updated layout.
+    (dispatch-mouse-motion dispatcher nil))
+  (handle-picked? [dispatcher handle]
+    (some #(= handle (:handle %)) @picked))
+  (handle-hovered? [dispatcher handle]
+    (some #(= handle (:handle %)) @hovered))
+  MouseListener
+  (mouseEntered [dispatcher event]
+    (dispatch-mouse-motion dispatcher event))
+  (mouseExited [dispatcher event]
+    (dispatch-mouse-motion dispatcher event))
+  (mouseClicked [dispatcher event]
+    (dispatch-mouse-button dispatcher event))
+  (mousePressed [dispatcher event]
+    (dispatch-mouse-button dispatcher event))
+  (mouseReleased [dispatcher event]
+    (dispatch-mouse-button dispatcher event))
+  MouseWheelListener
+  (mouseWheelMoved [dispatcher event]
+    (dispatch-mouse-button dispatcher event))
+  MouseMotionListener
+  (mouseDragged [dispatcher event]
+    (translate-and-dispatch @picked true event))
+  (mouseMoved [dispatcher event]
+    (dispatch-mouse-motion dispatcher event)))
+
 (defn root-event-dispatcher []
-  (let [tree-r (ref {})   ; register
-        tree (ref {})     ; dispatch
-        hovered (ref '())
-        picked (ref '())]
-    (reify
-     EventDispatcher
-     (listen! [this component]
-       (doto ^Component component
-         (.addMouseListener this)
-         (.addMouseWheelListener this)
-         (.addMouseMotionListener this)))
-     (create-dispatcher [this handle handlers]
-       (let [node (make-node handle handlers)]
-         (dosync (alter tree-r add-node node))
-         node))
-     (commit [this]
-       ;; TODO: retain contexts that do not intersect graphics
-       ;; clipping area in tree.
-       (dosync (ref-set tree @tree-r)
-               (ref-set tree-r {})))
-     (handle-picked? [this handle]
-       (some #(= handle (:handle %)) @picked))
-     (handle-hovered? [this handle]
-       (some #(= handle (:handle %)) @hovered))
-     MouseListener
-     (mouseEntered [this event]
-       (dispatch-mouse-motion hovered @tree this event))
-     (mouseExited [this event]
-       (dispatch-mouse-motion hovered @tree this event))
-     (mouseClicked [this event]
-       (dispatch-mouse-button picked hovered event))
-     (mousePressed [this event]
-       (dispatch-mouse-button picked hovered event))
-     (mouseReleased [this event]
-       (dispatch-mouse-button picked hovered event))
-     MouseWheelListener
-     (mouseWheelMoved [this event]
-       (dispatch-mouse-button picked hovered event))
-     MouseMotionListener
-     (mouseDragged [this event]
-       (translate-and-dispatch @picked true event))
-     (mouseMoved [this event]
-       (dispatch-mouse-motion hovered @tree this event)))))
+  (->RootEventDispatcher (ref {}) (ref {}) (ref '()) (ref '()) (ref nil)))
 
 ;;
 ;; Scene