Mercurial > hg > indyvon

changeset 40:a96dfbfd6d4e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Do not call event handlers inside transaction.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sat, 10 Jul 2010 03:04:47 +0400
parents 930c088e1367
children 2475c99fbb8c
files src/kryshen/indyvon/core.clj
diffstat 1 files changed, 20 insertions(+), 31 deletions(-) [+]
line wrap: on
line diff
--- a/src/kryshen/indyvon/core.clj	Fri Jul 09 11:42:58 2010 +0400
+++ b/src/kryshen/indyvon/core.clj	Sat Jul 10 03:04:47 2010 +0400
@@ -6,7 +6,7 @@
 
 (ns kryshen.indyvon.core
   (:import
-   (java.awt Graphics2D Component Color Font)
+   (java.awt Graphics2D Component Color Font AWTEvent)
    (java.awt.event MouseListener MouseMotionListener)
    (java.awt.font FontRenderContext)))
 
@@ -222,8 +222,8 @@
 
 (defn- translate-and-dispatch
   ([nodes first-only ^java.awt.event.MouseEvent event]
-     (translate-and-dispatch
-      nodes first-only event (awt-events (.getID event))))
+     (translate-and-dispatch nodes first-only
+       event (awt-events (.getID event))))
   ([nodes first-only event id]
      (if-let [node (first nodes)]
        (if-let [handler (get (:handlers node) id)]
@@ -231,46 +231,35 @@
            (with-bindings* (:bindings node)
              handler
              (translate-mouse-event event
-              (-> node :bounds :x) (-> node :bounds :y) id))
-           (if first-only
-             id
+               (-> node :bounds :x) (-> node :bounds :y) id))
+           (if-not first-only
              (recur (rest nodes) false event id)))
-         (recur (rest nodes) first-only event id))
-         id)))
+         (recur (rest nodes) first-only event id)))))
 
-(defn- dispatch-mouse-motion*
-  "Dispatches mouse motion events. Returns a new set of nodes which
-  currently are under cursor."
-  [hovered tree root ^java.awt.event.MouseEvent 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)
-        hovered2 (under-cursor x y tree root)
+        [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)]
     (translate-and-dispatch exited false event :mouse-exited)
     (translate-and-dispatch entered false event :mouse-entered)
-    (translate-and-dispatch moved true event :mouse-moved)
-    hovered2))
-
-(defn- dispatch-mouse-motion
-  [hovered-ref tree root event]
-  (dosync
-   (alter hovered-ref dispatch-mouse-motion* tree root event)))
-
-(defn- dispatch-mouse-button*
-  "Dispatches mouse button events. Returns a new set of nodes which
-  currently are picked with a pressed button."
-  [picked hovered event]
-  (if (= (translate-and-dispatch hovered true event) :mouse-pressed)
-    hovered
-    nil))
+    (translate-and-dispatch moved true event :mouse-moved)))
 
 (defn- dispatch-mouse-button
-  [picked-ref hovered-ref event]
-  (dosync
-   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
+  [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
+  (let [id (awt-events (.getID event))
+        hovered (if (= id :mouse-pressed)
+                  (dosync (ref-set picked-ref @hovered-ref))
+                  @hovered-ref)]
+    (translate-and-dispatch hovered true event id)))
 
 (defn root-event-dispatcher []
   (let [tree-r (ref {})   ; register