1.1 --- a/src/net/kryshen/indyvon/core.clj	Tue Apr 24 18:49:06 2012 +0400
     1.2 +++ b/src/net/kryshen/indyvon/core.clj	Tue Apr 24 18:51:37 2012 +0400
     1.3 @@ -615,7 +615,7 @@
     1.4  
     1.5  (defn- under-cursor
     1.6    "Returns a vector of child nodes under cursor."
     1.7 -  [x y tree node]
     1.8 +  [^long x ^long y tree node]
     1.9    (some #(if (and (:clip %)
    1.10                    (.contains ^Shape (:clip %) x y))
    1.11             (conj (vec (under-cursor x y tree %)) %))
    1.12 @@ -652,26 +652,40 @@
    1.13               (recur (rest nodes) false event id)))
    1.14           (recur (rest nodes) first-only event id)))))
    1.15  
    1.16 +(defn- process-mouse-position
    1.17 +  [dispatcher event]
    1.18 +  (dosync
    1.19 +   (let [{hovered-ref :hovered
    1.20 +          last-ref :last-motion
    1.21 +          tree-ref :tree} dispatcher
    1.22 +         ^java.awt.event.MouseEvent event (or event @last-ref)]
    1.23 +     (when event
    1.24 +       (let [x (.getX event)
    1.25 +             y (.getY event)
    1.26 +             old-hovered @hovered-ref
    1.27 +             hovered (under-cursor x y @tree-ref dispatcher)
    1.28 +             pred #(= (:handle %1) (:handle %2))
    1.29 +             exited (remove-all old-hovered hovered pred)
    1.30 +             entered (remove-all hovered old-hovered pred)
    1.31 +             moved (remove-all hovered entered pred)]
    1.32 +         (ref-set hovered-ref hovered)
    1.33 +         (ref-set last-ref event)
    1.34 +         [exited entered moved event])))))
    1.35 +
    1.36  (defn- dispatch-mouse-motion
    1.37 -  "Dispatches mouse motion events."
    1.38 -  [hovered-ref tree root ^java.awt.event.MouseEvent event]
    1.39 -  (let [x (.getX event)
    1.40 -        y (.getY event)
    1.41 -        [hovered hovered2] (dosync
    1.42 -                            [@hovered-ref
    1.43 -                             (ref-set hovered-ref
    1.44 -                                      (under-cursor x y tree root))])
    1.45 -        pred #(= (:handle %1) (:handle %2))
    1.46 -        exited (remove-all hovered hovered2 pred)
    1.47 -        entered (remove-all hovered2 hovered pred)
    1.48 -        moved (remove-all hovered2 entered pred)]
    1.49 +  [dispatcher source-event]
    1.50 +  (when-let [[exited entered moved event] (process-mouse-position
    1.51 +                                           dispatcher source-event)]
    1.52      (translate-and-dispatch exited false event :mouse-exited)
    1.53      (translate-and-dispatch entered false event :mouse-entered)
    1.54 -    (translate-and-dispatch moved true event :mouse-moved)))
    1.55 +    (when source-event
    1.56 +      (translate-and-dispatch moved true event :mouse-moved))))
    1.57  
    1.58  (defn- dispatch-mouse-button
    1.59 -  [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
    1.60 -  (let [id (awt-events (.getID event))
    1.61 +  [dispatcher ^java.awt.event.MouseEvent event]
    1.62 +  (let [{picked-ref :picked
    1.63 +         hovered-ref :hovered} dispatcher
    1.64 +        id (awt-events (.getID event))
    1.65          nodes (case id
    1.66                 :mouse-pressed
    1.67                 (dosync
    1.68 @@ -684,50 +698,55 @@
    1.69                 @hovered-ref)]
    1.70      (translate-and-dispatch nodes true event id)))
    1.71  
    1.72 +(defrecord RootEventDispatcher [tree-r ; register
    1.73 +                                tree   ; dispatch
    1.74 +                                hovered
    1.75 +                                picked
    1.76 +                                last-motion]
    1.77 +  EventDispatcher
    1.78 +  (listen! [dispatcher component]
    1.79 +    (doto ^Component component
    1.80 +          (.addMouseListener dispatcher)
    1.81 +          (.addMouseWheelListener dispatcher)
    1.82 +          (.addMouseMotionListener dispatcher)))
    1.83 +  (create-dispatcher [dispatcher handle handlers]
    1.84 +    (let [node (make-node handle handlers)]
    1.85 +      (dosync (alter tree-r add-node node))
    1.86 +      node))
    1.87 +  (commit [dispatcher]
    1.88 +    ;; TODO: retain contexts that do not intersect graphics
    1.89 +    ;; clipping area in tree.
    1.90 +    (dosync (ref-set tree @tree-r)
    1.91 +            (ref-set tree-r {}))
    1.92 +    ;; Send mouse entered and exited events if necessary due to
    1.93 +    ;; updated layout.
    1.94 +    (dispatch-mouse-motion dispatcher nil))
    1.95 +  (handle-picked? [dispatcher handle]
    1.96 +    (some #(= handle (:handle %)) @picked))
    1.97 +  (handle-hovered? [dispatcher handle]
    1.98 +    (some #(= handle (:handle %)) @hovered))
    1.99 +  MouseListener
   1.100 +  (mouseEntered [dispatcher event]
   1.101 +    (dispatch-mouse-motion dispatcher event))
   1.102 +  (mouseExited [dispatcher event]
   1.103 +    (dispatch-mouse-motion dispatcher event))
   1.104 +  (mouseClicked [dispatcher event]
   1.105 +    (dispatch-mouse-button dispatcher event))
   1.106 +  (mousePressed [dispatcher event]
   1.107 +    (dispatch-mouse-button dispatcher event))
   1.108 +  (mouseReleased [dispatcher event]
   1.109 +    (dispatch-mouse-button dispatcher event))
   1.110 +  MouseWheelListener
   1.111 +  (mouseWheelMoved [dispatcher event]
   1.112 +    (dispatch-mouse-button dispatcher event))
   1.113 +  MouseMotionListener
   1.114 +  (mouseDragged [dispatcher event]
   1.115 +    (translate-and-dispatch @picked true event))
   1.116 +  (mouseMoved [dispatcher event]
   1.117 +    (dispatch-mouse-motion dispatcher event)))
   1.118 +
   1.119  (defn root-event-dispatcher []
   1.120 -  (let [tree-r (ref {})   ; register
   1.121 -        tree (ref {})     ; dispatch
   1.122 -        hovered (ref '())
   1.123 -        picked (ref '())]
   1.124 -    (reify
   1.125 -     EventDispatcher
   1.126 -     (listen! [this component]
   1.127 -       (doto ^Component component
   1.128 -         (.addMouseListener this)
   1.129 -         (.addMouseWheelListener this)
   1.130 -         (.addMouseMotionListener this)))
   1.131 -     (create-dispatcher [this handle handlers]
   1.132 -       (let [node (make-node handle handlers)]
   1.133 -         (dosync (alter tree-r add-node node))
   1.134 -         node))
   1.135 -     (commit [this]
   1.136 -       ;; TODO: retain contexts that do not intersect graphics
   1.137 -       ;; clipping area in tree.
   1.138 -       (dosync (ref-set tree @tree-r)
   1.139 -               (ref-set tree-r {})))
   1.140 -     (handle-picked? [this handle]
   1.141 -       (some #(= handle (:handle %)) @picked))
   1.142 -     (handle-hovered? [this handle]
   1.143 -       (some #(= handle (:handle %)) @hovered))
   1.144 -     MouseListener
   1.145 -     (mouseEntered [this event]
   1.146 -       (dispatch-mouse-motion hovered @tree this event))
   1.147 -     (mouseExited [this event]
   1.148 -       (dispatch-mouse-motion hovered @tree this event))
   1.149 -     (mouseClicked [this event]
   1.150 -       (dispatch-mouse-button picked hovered event))
   1.151 -     (mousePressed [this event]
   1.152 -       (dispatch-mouse-button picked hovered event))
   1.153 -     (mouseReleased [this event]
   1.154 -       (dispatch-mouse-button picked hovered event))
   1.155 -     MouseWheelListener
   1.156 -     (mouseWheelMoved [this event]
   1.157 -       (dispatch-mouse-button picked hovered event))
   1.158 -     MouseMotionListener
   1.159 -     (mouseDragged [this event]
   1.160 -       (translate-and-dispatch @picked true event))
   1.161 -     (mouseMoved [this event]
   1.162 -       (dispatch-mouse-motion hovered @tree this event)))))
   1.163 +  (->RootEventDispatcher (ref {}) (ref {}) (ref '()) (ref '()) (ref nil)))
   1.164  
   1.165  ;;
   1.166  ;; Scene