Mercurial > hg > indyvon
changeset 134:16643a84b9e4
Refactored the event dispatcher. Update hover states at every commit.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Tue, 24 Apr 2012 18:51:37 +0400 |
parents | 2c2e4c639311 |
children | 7eddb035d9c4 |
files | src/net/kryshen/indyvon/core.clj |
diffstat | 1 files changed, 78 insertions(+), 59 deletions(-) [+] |
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/core.clj Tue Apr 24 18:49:06 2012 +0400 +++ b/src/net/kryshen/indyvon/core.clj Tue Apr 24 18:51:37 2012 +0400 @@ -615,7 +615,7 @@ (defn- under-cursor "Returns a vector of child nodes under cursor." - [x y tree node] + [^long x ^long y tree node] (some #(if (and (:clip %) (.contains ^Shape (:clip %) x y)) (conj (vec (under-cursor x y tree %)) %)) @@ -652,26 +652,40 @@ (recur (rest nodes) false event id))) (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- dispatch-mouse-motion - "Dispatches mouse motion events." - [hovered-ref tree root ^java.awt.event.MouseEvent event] - (let [x (.getX event) - y (.getY event) - [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)] + [dispatcher source-event] + (when-let [[exited entered moved event] (process-mouse-position + dispatcher source-event)] (translate-and-dispatch exited false event :mouse-exited) (translate-and-dispatch entered false event :mouse-entered) - (translate-and-dispatch moved true event :mouse-moved))) + (when source-event + (translate-and-dispatch moved true event :mouse-moved)))) (defn- dispatch-mouse-button - [picked-ref hovered-ref ^java.awt.event.MouseEvent event] - (let [id (awt-events (.getID event)) + [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 @@ -684,50 +698,55 @@ @hovered-ref)] (translate-and-dispatch nodes true event id))) +(defrecord RootEventDispatcher [tree-r ; register + tree ; dispatch + hovered + picked + last-motion] + EventDispatcher + (listen! [dispatcher component] + (doto ^Component component + (.addMouseListener dispatcher) + (.addMouseWheelListener dispatcher) + (.addMouseMotionListener dispatcher))) + (create-dispatcher [dispatcher handle handlers] + (let [node (make-node handle handlers)] + (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)) + (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)) + (mouseExited [dispatcher event] + (dispatch-mouse-motion dispatcher event)) + (mouseClicked [dispatcher event] + (dispatch-mouse-button dispatcher event)) + (mousePressed [dispatcher event] + (dispatch-mouse-button dispatcher event)) + (mouseReleased [dispatcher event] + (dispatch-mouse-button dispatcher event)) + MouseWheelListener + (mouseWheelMoved [dispatcher event] + (dispatch-mouse-button dispatcher event)) + MouseMotionListener + (mouseDragged [dispatcher event] + (translate-and-dispatch @picked true event)) + (mouseMoved [dispatcher event] + (dispatch-mouse-motion dispatcher event))) + (defn root-event-dispatcher [] - (let [tree-r (ref {}) ; register - tree (ref {}) ; dispatch - hovered (ref '()) - picked (ref '())] - (reify - EventDispatcher - (listen! [this component] - (doto ^Component component - (.addMouseListener this) - (.addMouseWheelListener this) - (.addMouseMotionListener this))) - (create-dispatcher [this handle handlers] - (let [node (make-node handle handlers)] - (dosync (alter tree-r add-node node)) - node)) - (commit [this] - ;; TODO: retain contexts that do not intersect graphics - ;; clipping area in tree. - (dosync (ref-set tree @tree-r) - (ref-set tree-r {}))) - (handle-picked? [this handle] - (some #(= handle (:handle %)) @picked)) - (handle-hovered? [this handle] - (some #(= handle (:handle %)) @hovered)) - MouseListener - (mouseEntered [this event] - (dispatch-mouse-motion hovered @tree this event)) - (mouseExited [this event] - (dispatch-mouse-motion hovered @tree this event)) - (mouseClicked [this event] - (dispatch-mouse-button picked hovered event)) - (mousePressed [this event] - (dispatch-mouse-button picked hovered event)) - (mouseReleased [this event] - (dispatch-mouse-button picked hovered event)) - MouseWheelListener - (mouseWheelMoved [this event] - (dispatch-mouse-button picked hovered event)) - MouseMotionListener - (mouseDragged [this event] - (translate-and-dispatch @picked true event)) - (mouseMoved [this event] - (dispatch-mouse-motion hovered @tree this event))))) + (->RootEventDispatcher (ref {}) (ref {}) (ref '()) (ref '()) (ref nil))) ;; ;; Scene