Mercurial > hg > indyvon
changeset 8:c53ec3052ae7
Dispatching mouse motion events.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Sat, 12 Jun 2010 06:06:41 +0400 |
parents | f6d10a68b01d |
children | 160e9ec945a2 |
files | src/indyvon/core.clj |
diffstat | 1 files changed, 97 insertions(+), 22 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/core.clj Fri Jun 11 22:58:23 2010 +0400 +++ b/src/indyvon/core.clj Sat Jun 12 06:06:41 2010 +0400 @@ -1,6 +1,7 @@ (ns indyvon.core - (:import (java.awt Dimension Point Component Graphics2D AWTEvent) - (java.awt.event MouseAdapter MouseMotionAdapter + (:require (clojure [set :as s])) + (:import (java.awt Dimension Point Component Graphics2D Color AWTEvent) + (java.awt.event MouseEvent MouseAdapter MouseMotionAdapter MouseListener MouseMotionListener))) (defprotocol Layer @@ -42,7 +43,7 @@ ([context layer graphics x y clip] (let [s (size layer context)] (render-layer! context layer graphics - x y (.width s) (.height s) clip))) + x y (s 0) (s 1) clip))) ([context layer graphics x y w h] (render-layer! context layer graphics x y w h true)) @@ -90,6 +91,11 @@ (contains? context-tree parent) parent :default (recur context-tree parent)))) +(defn- register-context + [context-tree context] + (assoc-conj + context-tree (registered-parent context-tree context) context)) + (defn- inside? ([x y context] (inside? x y (:x context) (:y context) @@ -109,17 +115,64 @@ (conj (under-cursor context-tree x y %) %)) (context-tree context)))) +(defn- remove-all [coll1 coll2 pred] + (filter #(not (some (partial pred %) coll2)) coll1)) + +(defn- translate-mouse-event + [#^MouseEvent event x y id] + (proxy [MouseEvent] [(.getComponent event) + id + (.getWhen event) + (.getModifiers event) + (- (.getX event) x) + (- (.getY event) y) + (.getClickCount event) + (.isPopupTrigger event)] + (getXOnScreen [] + (.getXOnScreen event)) + (getYOnScreen [] + (.getYOnScreen event)))) + +(defn- translate-and-dispatch + ([contexts event] + (translate-and-dispatch contexts event (.getID event))) + ([contexts event id] + (doseq [c contexts] + (handle-layer-event + (:layer c) + c + (translate-mouse-event event (:x c) (:y c) id))))) + +(defn- dispatch-mouse-motion* + "Dispatches mouse motion events. Returns a new set of contexts which + currently are under cursor." + [hovered context-tree #^MouseEvent event] + (let [x (.getX event) + y (.getY event) + hovered2 (under-cursor context-tree x y) + pred #(= (:layer %1) (:layer %2)) + exited (remove-all hovered hovered2 pred) + entered (remove-all hovered2 hovered pred) + moved (remove-all hovered2 entered pred)] + (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED) + (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED) + (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED) + hovered2)) + +(defn- dispatch-mouse-motion + [hovered-ref context-tree #^MouseEvent event] + (dosync + (alter hovered-ref dispatch-mouse-motion* context-tree event))) + (defn make-event-dispatcher [] (let [context-tree-r (ref {}) ; register context-tree (ref {}) ; dispatch - hovered (ref []) - picked (ref [])] + hovered (ref '()) + picked (ref '())] (reify EventDispatcher (register [this context] - (dosync - (alter context-tree-r assoc-conj - (registered-parent context) context))) + (dosync (alter context-tree-r register-context context))) (commit [this] (dosync (ref-set context-tree @context-tree-r) (ref-set context-tree-r {}))) @@ -127,13 +180,17 @@ (hovered? [this layer] false) MouseListener (mouseClicked [this event]) - (mouseEntered [this event]) - (mouseExited [this event]) + (mouseEntered [this event] + (dispatch-mouse-motion hovered context-tree event)) + (mouseExited [this event] + (dispatch-mouse-motion hovered context-tree event)) (mousePressed [this event]) (mouseReleased [this event]) MouseMotionListener - (mouseDragged [this event]) - (mouseMoved [this event])))) + (mouseDragged [this event] + (translate-and-dispatch @picked event)) + (mouseMoved [this event] + (dispatch-mouse-motion hovered context-tree event))))) ;; ;; Connection to AWT. @@ -154,25 +211,33 @@ width (.width size) height (.height size) context (assoc (default-context) + :dispatcher event-dispatcher :update-fn (make-update-fn this))] - (render-layer! context layer g 0 0 width height false))) + (render-layer! context layer g 0 0 width height false)) + (commit event-dispatcher)) (getPreferredSize [] (let [s (size layer nil)] ;; TODO: supply context - (Dimension. (s 0) (s 1)))) - (processEvent [event])) - ;; No way to call protected final evenbleEvents even in gen-class, - ;; have to use the following hack: - (.addMouseListener (proxy [MouseAdapter] [])) - (.addMouseMotionListener (proxy [MouseMotionAdapter] []))))) + (Dimension. (s 0) (s 1))))) + (.addMouseListener event-dispatcher) + (.addMouseMotionListener event-dispatcher)))) (comment (do (def frame (java.awt.Frame. "Test")) + (def layer1 + (reify-layer + (render! [this context g] + (register (:dispatcher context) context) + (.setColor g Color/BLUE) + (.fillRect g 0 0 50 30)) + (size [this context] [50 30]))) (def layer (reify-layer - (render! [this] - (.fillRect *graphics* 10 10 40 40)) - (size [this] [100 100]))) + (render! [this context g] + (register (:dispatcher context) context) + (.drawLine g 0 0 (:width context) (:height context)) + (render-layer! context layer1 g 15 20)) + (size [this context] [100 100]))) (doto frame (.addWindowListener (proxy [java.awt.event.WindowAdapter] [] @@ -180,5 +245,15 @@ (.add (make-component layer)) (.pack) (.setVisible true)) + + (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED] + [layer context event] + (println "ENTERED")) + (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED] + [layer context event] + (println "EXITED")) + (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED] + [layer context event] + (println "MOVED")) ) ) \ No newline at end of file