Mercurial > hg > indyvon
changeset 135:7eddb035d9c4
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 diff
1.1 --- a/src/net/kryshen/indyvon/core.clj Tue Apr 24 18:51:37 2012 +0400 1.2 +++ b/src/net/kryshen/indyvon/core.clj Thu Apr 26 19:23:04 2012 +0400 1.3 @@ -615,15 +615,12 @@ 1.4 1.5 (defn- under-cursor 1.6 "Returns a vector of child nodes under cursor." 1.7 - [^long x ^long y tree node] 1.8 + [node tree ^long x ^long y] 1.9 (some #(if (and (:clip %) 1.10 (.contains ^Shape (:clip %) x y)) 1.11 - (conj (vec (under-cursor x y tree %)) %)) 1.12 + (conj (vec (under-cursor % tree x y)) %)) 1.13 (get tree node))) 1.14 1.15 -(defn- remove-all [coll1 coll2 pred] 1.16 - (filter #(not (some (partial pred %) coll2)) coll1)) 1.17 - 1.18 (defn- translate-mouse-event [^java.awt.event.MouseEvent event 1.19 ^AffineTransform tr id] 1.20 (let [[x y] (inverse-transform-point tr (.getX event) (.getY event)) 1.21 @@ -643,65 +640,86 @@ 1.22 event (awt-events (.getID event)))) 1.23 ([nodes first-only event id] 1.24 (if-let [node (first nodes)] 1.25 - (if-let [handler (get (:handlers node) id)] 1.26 - (do 1.27 - (let [translated (translate-mouse-event event (:transform node) id)] 1.28 + (let [handlers (:handlers node) 1.29 + handler (get handlers id)] 1.30 + (if handler 1.31 + (do 1.32 (with-bindings* (:bindings node) 1.33 - handler translated)) 1.34 - (if-not first-only 1.35 - (recur (rest nodes) false event id))) 1.36 - (recur (rest nodes) first-only event id))))) 1.37 + handler 1.38 + (translate-mouse-event event (:transform node) id)) 1.39 + (when-not first-only 1.40 + (recur (rest nodes) false event id))) 1.41 + (when-not (and (= id :mouse-dragged) 1.42 + (or (contains? handlers :mouse-pressed) 1.43 + (contains? handlers :mouse-released))) 1.44 + (recur (rest nodes) first-only event id))))))) 1.45 1.46 -(defn- process-mouse-position 1.47 - [dispatcher event] 1.48 - (dosync 1.49 - (let [{hovered-ref :hovered 1.50 - last-ref :last-motion 1.51 - tree-ref :tree} dispatcher 1.52 - ^java.awt.event.MouseEvent event (or event @last-ref)] 1.53 - (when event 1.54 - (let [x (.getX event) 1.55 - y (.getY event) 1.56 - old-hovered @hovered-ref 1.57 - hovered (under-cursor x y @tree-ref dispatcher) 1.58 - pred #(= (:handle %1) (:handle %2)) 1.59 - exited (remove-all old-hovered hovered pred) 1.60 - entered (remove-all hovered old-hovered pred) 1.61 - moved (remove-all hovered entered pred)] 1.62 - (ref-set hovered-ref hovered) 1.63 - (ref-set last-ref event) 1.64 - [exited entered moved event]))))) 1.65 +(defn- process-mouse-event 1.66 + [dispatcher ^java.awt.event.MouseEvent source-event] 1.67 + (let [{active-ref :active 1.68 + hovered-ref :hovered 1.69 + picked-ref :picked 1.70 + last-ref :last-motion 1.71 + tree-ref :tree} dispatcher 1.72 + pressed (and source-event 1.73 + (== (.getID source-event) 1.74 + java.awt.event.MouseEvent/MOUSE_PRESSED)) 1.75 + released (and source-event 1.76 + (== (.getID source-event) 1.77 + java.awt.event.MouseEvent/MOUSE_RELEASED)) 1.78 + ^java.awt.event.MouseEvent last-event @last-ref 1.79 + ^java.awt.event.MouseEvent event (or source-event last-event)] 1.80 + (when event 1.81 + (let [x (.getX event) 1.82 + y (.getY event) 1.83 + active @active-ref 1.84 + active (if (and active 1.85 + source-event 1.86 + (== (.getX last-event) x) 1.87 + (== (.getY last-event) y)) 1.88 + active 1.89 + (ref-set active-ref 1.90 + (under-cursor dispatcher @tree-ref x y))) 1.91 + acted (cond 1.92 + pressed (ref-set picked-ref active) 1.93 + released (let [picked @picked-ref] 1.94 + (ref-set picked-ref nil) 1.95 + picked) 1.96 + :else active) 1.97 + picked (seq @picked-ref) 1.98 + pred #(= (:handle %1) (:handle %2)) 1.99 + hovered (if picked 1.100 + (filter #(some (partial pred %) picked) active) 1.101 + active) 1.102 + remove-all (fn [c1 c2] 1.103 + (filter #(not (some (partial pred %) c2)) c1)) 1.104 + old-hovered @hovered-ref 1.105 + exited (remove-all old-hovered hovered) 1.106 + entered (remove-all hovered old-hovered) 1.107 + moved (or picked (remove-all hovered entered))] 1.108 + (ref-set hovered-ref hovered) 1.109 + (ref-set last-ref event) 1.110 + [exited entered moved acted event])))) 1.111 1.112 -(defn- dispatch-mouse-motion 1.113 - [dispatcher source-event] 1.114 - (when-let [[exited entered moved event] (process-mouse-position 1.115 - dispatcher source-event)] 1.116 +(defn- dispatch-mouse-event 1.117 + [dispatcher source-event button?] 1.118 + (when-let [[exited 1.119 + entered 1.120 + moved 1.121 + acted 1.122 + event] (dosync (process-mouse-event dispatcher source-event))] 1.123 + (when button? 1.124 + (translate-and-dispatch acted true event)) 1.125 (translate-and-dispatch exited false event :mouse-exited) 1.126 (translate-and-dispatch entered false event :mouse-entered) 1.127 - (when source-event 1.128 - (translate-and-dispatch moved true event :mouse-moved)))) 1.129 + (when-not button? 1.130 + (translate-and-dispatch moved true source-event)))) 1.131 1.132 -(defn- dispatch-mouse-button 1.133 - [dispatcher ^java.awt.event.MouseEvent event] 1.134 - (let [{picked-ref :picked 1.135 - hovered-ref :hovered} dispatcher 1.136 - id (awt-events (.getID event)) 1.137 - nodes (case id 1.138 - :mouse-pressed 1.139 - (dosync 1.140 - (ref-set picked-ref @hovered-ref)) 1.141 - :mouse-released 1.142 - (dosync 1.143 - (let [picked @picked-ref] 1.144 - (ref-set picked-ref nil) 1.145 - picked)) 1.146 - @hovered-ref)] 1.147 - (translate-and-dispatch nodes true event id))) 1.148 - 1.149 -(defrecord RootEventDispatcher [tree-r ; register 1.150 - tree ; dispatch 1.151 - hovered 1.152 - picked 1.153 +(defrecord RootEventDispatcher [tree-r ;; register 1.154 + tree ;; dispatch 1.155 + active ;; nodes under cursor 1.156 + hovered ;; mouse entered 1.157 + picked ;; mouse pressed 1.158 last-motion] 1.159 EventDispatcher 1.160 (listen! [dispatcher component] 1.161 @@ -714,39 +732,49 @@ 1.162 (dosync (alter tree-r add-node node)) 1.163 node)) 1.164 (commit [dispatcher] 1.165 - ;; TODO: retain contexts that do not intersect graphics 1.166 - ;; clipping area in tree. 1.167 - (dosync (ref-set tree @tree-r) 1.168 - (ref-set tree-r {})) 1.169 - ;; Send mouse entered and exited events if necessary due to 1.170 - ;; updated layout. 1.171 - (dispatch-mouse-motion dispatcher nil)) 1.172 + (let [[exited 1.173 + entered 1.174 + _ _ 1.175 + event] (dosync 1.176 + ;; TODO: retain contexts that do 1.177 + ;; not intersect graphics 1.178 + ;; clipping area in tree. 1.179 + (ref-set tree @tree-r) 1.180 + (ref-set tree-r {}) 1.181 + (process-mouse-event dispatcher nil))] 1.182 + ;; Send mouse entered and exited events if necessary due to 1.183 + ;; updated layout. 1.184 + (translate-and-dispatch exited false event :mouse-exited) 1.185 + (translate-and-dispatch entered false event :mouse-entered))) 1.186 (handle-picked? [dispatcher handle] 1.187 (some #(= handle (:handle %)) @picked)) 1.188 (handle-hovered? [dispatcher handle] 1.189 (some #(= handle (:handle %)) @hovered)) 1.190 MouseListener 1.191 (mouseEntered [dispatcher event] 1.192 - (dispatch-mouse-motion dispatcher event)) 1.193 + (dispatch-mouse-event dispatcher event false)) 1.194 (mouseExited [dispatcher event] 1.195 - (dispatch-mouse-motion dispatcher event)) 1.196 + (dispatch-mouse-event dispatcher event false)) 1.197 (mouseClicked [dispatcher event] 1.198 - (dispatch-mouse-button dispatcher event)) 1.199 + (dispatch-mouse-event dispatcher event true)) 1.200 (mousePressed [dispatcher event] 1.201 - (dispatch-mouse-button dispatcher event)) 1.202 + (dispatch-mouse-event dispatcher event true)) 1.203 (mouseReleased [dispatcher event] 1.204 - (dispatch-mouse-button dispatcher event)) 1.205 + (dispatch-mouse-event dispatcher event true)) 1.206 MouseWheelListener 1.207 (mouseWheelMoved [dispatcher event] 1.208 - (dispatch-mouse-button dispatcher event)) 1.209 + (dispatch-mouse-event dispatcher event true)) 1.210 MouseMotionListener 1.211 (mouseDragged [dispatcher event] 1.212 - (translate-and-dispatch @picked true event)) 1.213 + (dispatch-mouse-event dispatcher event false)) 1.214 (mouseMoved [dispatcher event] 1.215 - (dispatch-mouse-motion dispatcher event))) 1.216 + (dispatch-mouse-event dispatcher event false))) 1.217 1.218 (defn root-event-dispatcher [] 1.219 - (->RootEventDispatcher (ref {}) (ref {}) (ref '()) (ref '()) (ref nil))) 1.220 + (->RootEventDispatcher 1.221 + (ref {}) (ref {}) ;; trees 1.222 + (ref nil) (ref nil) (ref nil) ;; node states 1.223 + (ref nil))) ;; last event 1.224 1.225 ;; 1.226 ;; Scene