Mercurial > hg > indyvon
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