Mercurial > hg > indyvon

changeset 135:7eddb035d9c4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Further refactoring of the event dispatcher.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 26 Apr 2012 19:23:04 +0400
parents 16643a84b9e4
children 1a5fd362114d
files src/net/kryshen/indyvon/core.clj
diffstat 1 files changed, 102 insertions(+), 74 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/core.clj	Tue Apr 24 18:51:37 2012 +0400
+++ b/src/net/kryshen/indyvon/core.clj	Thu Apr 26 19:23:04 2012 +0400
@@ -615,15 +615,12 @@
 
 (defn- under-cursor
   "Returns a vector of child nodes under cursor."
-  [^long x ^long y tree node]
+  [node tree ^long x ^long y]
   (some #(if (and (:clip %)
                   (.contains ^Shape (:clip %) x y))
-           (conj (vec (under-cursor x y tree %)) %))
+           (conj (vec (under-cursor % tree x y)) %))
         (get tree node)))
 
-(defn- remove-all [coll1 coll2 pred]
-  (filter #(not (some (partial pred %) coll2)) coll1))
-
 (defn- translate-mouse-event [^java.awt.event.MouseEvent event
                               ^AffineTransform tr id]
   (let [[x y] (inverse-transform-point tr (.getX event) (.getY event))
@@ -643,65 +640,86 @@
                              event (awt-events (.getID event))))
   ([nodes first-only event id]
      (if-let [node (first nodes)]
-       (if-let [handler (get (:handlers node) id)]
-         (do
-           (let [translated (translate-mouse-event event (:transform node) id)]
+       (let [handlers (:handlers node)
+             handler (get handlers id)]
+         (if handler
+           (do
              (with-bindings* (:bindings node)
-               handler translated))
-           (if-not first-only
-             (recur (rest nodes) false event id)))
-         (recur (rest nodes) first-only event id)))))
+               handler
+               (translate-mouse-event event (:transform node) id))
+             (when-not first-only
+               (recur (rest nodes) false event id)))
+           (when-not (and (= id :mouse-dragged)
+                          (or (contains? handlers :mouse-pressed)
+                              (contains? handlers :mouse-released)))
+             (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- process-mouse-event
+  [dispatcher ^java.awt.event.MouseEvent source-event]
+  (let [{active-ref :active
+         hovered-ref :hovered
+         picked-ref :picked
+         last-ref :last-motion
+         tree-ref :tree} dispatcher
+         pressed (and source-event
+                      (== (.getID source-event)
+                          java.awt.event.MouseEvent/MOUSE_PRESSED))
+         released (and source-event
+                       (== (.getID source-event)
+                           java.awt.event.MouseEvent/MOUSE_RELEASED))
+         ^java.awt.event.MouseEvent last-event @last-ref
+         ^java.awt.event.MouseEvent event (or source-event last-event)]
+    (when event
+      (let [x (.getX event)
+            y (.getY event)
+            active @active-ref
+            active (if (and active
+                            source-event
+                            (== (.getX last-event) x)
+                            (== (.getY last-event) y))
+                     active
+                     (ref-set active-ref
+                              (under-cursor dispatcher @tree-ref x y)))
+            acted (cond
+                   pressed (ref-set picked-ref active)
+                   released (let [picked @picked-ref]
+                              (ref-set picked-ref nil)
+                              picked)
+                   :else active)
+            picked (seq @picked-ref)
+            pred #(= (:handle %1) (:handle %2))
+            hovered (if picked
+                      (filter #(some (partial pred %) picked) active)
+                      active)
+            remove-all (fn [c1 c2]
+                         (filter #(not (some (partial pred %) c2)) c1))
+            old-hovered @hovered-ref
+            exited (remove-all old-hovered hovered)
+            entered (remove-all hovered old-hovered)
+            moved (or picked (remove-all hovered entered))]
+        (ref-set hovered-ref hovered)
+        (ref-set last-ref event)
+        [exited entered moved acted event]))))
 
-(defn- dispatch-mouse-motion
-  [dispatcher source-event]
-  (when-let [[exited entered moved event] (process-mouse-position
-                                           dispatcher source-event)]
+(defn- dispatch-mouse-event
+  [dispatcher source-event button?]
+  (when-let [[exited
+              entered
+              moved
+              acted
+              event] (dosync (process-mouse-event dispatcher source-event))]
+    (when button?
+      (translate-and-dispatch acted true event))
     (translate-and-dispatch exited false event :mouse-exited)
     (translate-and-dispatch entered false event :mouse-entered)
-    (when source-event
-      (translate-and-dispatch moved true event :mouse-moved))))
+    (when-not button?
+      (translate-and-dispatch moved true source-event))))
 
-(defn- dispatch-mouse-button
-  [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
-                (ref-set picked-ref @hovered-ref))
-               :mouse-released
-               (dosync
-                (let [picked @picked-ref]
-                  (ref-set picked-ref nil)
-                  picked))
-               @hovered-ref)]
-    (translate-and-dispatch nodes true event id)))
-
-(defrecord RootEventDispatcher [tree-r ; register
-                                tree   ; dispatch
-                                hovered
-                                picked
+(defrecord RootEventDispatcher [tree-r  ;; register
+                                tree    ;; dispatch
+                                active  ;; nodes under cursor
+                                hovered ;; mouse entered
+                                picked  ;; mouse pressed
                                 last-motion]
   EventDispatcher
   (listen! [dispatcher component]
@@ -714,39 +732,49 @@
       (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))
+    (let [[exited
+           entered
+           _ _
+           event] (dosync
+                   ;; TODO: retain contexts that do
+                   ;; not intersect graphics
+                   ;; clipping area in tree.
+                   (ref-set tree @tree-r)
+                   (ref-set tree-r {})
+                   (process-mouse-event dispatcher nil))]
+      ;; Send mouse entered and exited events if necessary due to
+      ;; updated layout.
+      (translate-and-dispatch exited false event :mouse-exited)
+      (translate-and-dispatch entered false event :mouse-entered)))
   (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))
+    (dispatch-mouse-event dispatcher event false))
   (mouseExited [dispatcher event]
-    (dispatch-mouse-motion dispatcher event))
+    (dispatch-mouse-event dispatcher event false))
   (mouseClicked [dispatcher event]
-    (dispatch-mouse-button dispatcher event))
+    (dispatch-mouse-event dispatcher event true))
   (mousePressed [dispatcher event]
-    (dispatch-mouse-button dispatcher event))
+    (dispatch-mouse-event dispatcher event true))
   (mouseReleased [dispatcher event]
-    (dispatch-mouse-button dispatcher event))
+    (dispatch-mouse-event dispatcher event true))
   MouseWheelListener
   (mouseWheelMoved [dispatcher event]
-    (dispatch-mouse-button dispatcher event))
+    (dispatch-mouse-event dispatcher event true))
   MouseMotionListener
   (mouseDragged [dispatcher event]
-    (translate-and-dispatch @picked true event))
+    (dispatch-mouse-event dispatcher event false))
   (mouseMoved [dispatcher event]
-    (dispatch-mouse-motion dispatcher event)))
+    (dispatch-mouse-event dispatcher event false)))
 
 (defn root-event-dispatcher []
-  (->RootEventDispatcher (ref {}) (ref {}) (ref '()) (ref '()) (ref nil)))
+  (->RootEventDispatcher
+   (ref {}) (ref {})             ;; trees
+   (ref nil) (ref nil) (ref nil) ;; node states
+   (ref nil)))                   ;; last event
 
 ;;
 ;; Scene