changeset 40:a96dfbfd6d4e

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 diff
     1.1 --- a/src/kryshen/indyvon/core.clj	Fri Jul 09 11:42:58 2010 +0400
     1.2 +++ b/src/kryshen/indyvon/core.clj	Sat Jul 10 03:04:47 2010 +0400
     1.3 @@ -6,7 +6,7 @@
     1.4  
     1.5  (ns kryshen.indyvon.core
     1.6    (:import
     1.7 -   (java.awt Graphics2D Component Color Font)
     1.8 +   (java.awt Graphics2D Component Color Font AWTEvent)
     1.9     (java.awt.event MouseListener MouseMotionListener)
    1.10     (java.awt.font FontRenderContext)))
    1.11  
    1.12 @@ -222,8 +222,8 @@
    1.13  
    1.14  (defn- translate-and-dispatch
    1.15    ([nodes first-only ^java.awt.event.MouseEvent event]
    1.16 -     (translate-and-dispatch
    1.17 -      nodes first-only event (awt-events (.getID event))))
    1.18 +     (translate-and-dispatch nodes first-only
    1.19 +       event (awt-events (.getID event))))
    1.20    ([nodes first-only event id]
    1.21       (if-let [node (first nodes)]
    1.22         (if-let [handler (get (:handlers node) id)]
    1.23 @@ -231,46 +231,35 @@
    1.24             (with-bindings* (:bindings node)
    1.25               handler
    1.26               (translate-mouse-event event
    1.27 -              (-> node :bounds :x) (-> node :bounds :y) id))
    1.28 -           (if first-only
    1.29 -             id
    1.30 +               (-> node :bounds :x) (-> node :bounds :y) id))
    1.31 +           (if-not first-only
    1.32               (recur (rest nodes) false event id)))
    1.33 -         (recur (rest nodes) first-only event id))
    1.34 -         id)))
    1.35 +         (recur (rest nodes) first-only event id)))))
    1.36  
    1.37 -(defn- dispatch-mouse-motion*
    1.38 -  "Dispatches mouse motion events. Returns a new set of nodes which
    1.39 -  currently are under cursor."
    1.40 -  [hovered tree root ^java.awt.event.MouseEvent event]
    1.41 +(defn- dispatch-mouse-motion
    1.42 +  "Dispatches mouse motion events."
    1.43 +  [hovered-ref tree root ^java.awt.event.MouseEvent event]
    1.44    (let [x (.getX event)
    1.45          y (.getY event)
    1.46 -        hovered2 (under-cursor x y tree root)
    1.47 +        [hovered hovered2] (dosync
    1.48 +                            [@hovered-ref
    1.49 +                             (ref-set hovered-ref
    1.50 +                                      (under-cursor x y tree root))])
    1.51          pred #(= (:handle %1) (:handle %2))
    1.52          exited (remove-all hovered hovered2 pred)
    1.53          entered (remove-all hovered2 hovered pred)
    1.54          moved (remove-all hovered2 entered pred)]
    1.55      (translate-and-dispatch exited false event :mouse-exited)
    1.56      (translate-and-dispatch entered false event :mouse-entered)
    1.57 -    (translate-and-dispatch moved true event :mouse-moved)
    1.58 -    hovered2))
    1.59 -
    1.60 -(defn- dispatch-mouse-motion
    1.61 -  [hovered-ref tree root event]
    1.62 -  (dosync
    1.63 -   (alter hovered-ref dispatch-mouse-motion* tree root event)))
    1.64 -
    1.65 -(defn- dispatch-mouse-button*
    1.66 -  "Dispatches mouse button events. Returns a new set of nodes which
    1.67 -  currently are picked with a pressed button."
    1.68 -  [picked hovered event]
    1.69 -  (if (= (translate-and-dispatch hovered true event) :mouse-pressed)
    1.70 -    hovered
    1.71 -    nil))
    1.72 +    (translate-and-dispatch moved true event :mouse-moved)))
    1.73  
    1.74  (defn- dispatch-mouse-button
    1.75 -  [picked-ref hovered-ref event]
    1.76 -  (dosync
    1.77 -   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
    1.78 +  [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
    1.79 +  (let [id (awt-events (.getID event))
    1.80 +        hovered (if (= id :mouse-pressed)
    1.81 +                  (dosync (ref-set picked-ref @hovered-ref))
    1.82 +                  @hovered-ref)]
    1.83 +    (translate-and-dispatch hovered true event id)))
    1.84  
    1.85  (defn root-event-dispatcher []
    1.86    (let [tree-r (ref {})   ; register