Mercurial > hg > indyvon
changeset 21:a70609bad3a4
Simpler event dispatching.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Sat, 19 Jun 2010 04:27:29 +0400 |
parents | 357bdd7d0550 |
children | dc81033d4122 |
files | src/indyvon/component.clj src/indyvon/event.clj |
diffstat | 2 files changed, 60 insertions(+), 88 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/component.clj Fri Jun 18 04:39:56 2010 +0400 +++ b/src/indyvon/component.clj Sat Jun 19 04:27:29 2010 +0400 @@ -49,32 +49,44 @@ (comment (do (def frame (JFrame. "Test")) + + (defn handler [context event] + (println (:layer context) (.paramString event))) + (def layer1 (reify Layer (render! [this context g] - (register-context context) + (mouse-handler context handler) (.setColor g Color/RED) (.fillRect g 0 0 (:width context) (:height context))) - (size [this context] [30 20]))) + (size [this context] [30 20]) + (toString [this] "layer1"))) + (def layer1b (border-layer layer1 2 3)) + (def layer2 (reify Layer (render! [this context g] - (register-context context) + (mouse-handler context handler) (.setColor g Color/YELLOW) (.fillRect g 0 0 (:width context) (:height context)) (draw! context layer1b g 10 5) (draw! context layer1 g 55 5)) - (size [this context] [70 65]))) + (size [this context] [70 65]) + (toString [this] "layer2"))) + (def layer3 (border-layer (text-layer "Sample\ntext" :right :bottom))) + (def layer (reify Layer (render! [this context g] (.drawLine g 0 0 (:width context) (:height context)) (draw! context layer2 g 15 20) (draw! context layer3 g 100 100 80 50)) - (size [this context] [400 300]))) + (size [this context] [400 300]) + (toString [this] "layer"))) + (doto frame (.addWindowListener (proxy [java.awt.event.WindowAdapter] [] @@ -82,20 +94,5 @@ (.. (getContentPane) (add (make-jpanel layer))) (.pack) (.setVisible true)) - - (add-listener layer1 MouseEvent/MOUSE_ENTERED - (fn [context event] (println "1 ENTERED"))) - (add-listener layer1 MouseEvent/MOUSE_EXITED - (fn [context event] (println "1 EXITED"))) - (add-listener layer1 MouseEvent/MOUSE_MOVED - (fn [context event] (println "1 MOVED"))) - (add-listener layer2 MouseEvent/MOUSE_ENTERED - (fn [context event] (println "2 ENTERED"))) - (add-listener layer2 MouseEvent/MOUSE_EXITED - (fn [context event] (println "2 EXITED"))) - (add-listener layer2 MouseEvent/MOUSE_MOVED - (fn [context event] (println "2 MOVED"))) - (add-listener layer2 MouseEvent/MOUSE_DRAGGED - (fn [context event] (println "2 DRAGGED"))) ) )
--- a/src/indyvon/event.clj Fri Jun 18 04:39:56 2010 +0400 +++ b/src/indyvon/event.clj Sat Jun 19 04:27:29 2010 +0400 @@ -9,54 +9,18 @@ (:import (java.awt.event MouseEvent MouseListener MouseMotionListener) java.lang.ref.WeakReference)) -;; map event-id -> [layer-weak-ref1 fn1, layer-weak-ref2 fn2...] -(def listeners-map (ref {})) - -(defn- assoc-conj [map key & vals] - (assoc map key (apply conj (vec (get map key)) vals))) - -(defn add-listener - "The supplied function will be invoked with context, event and - additional args when an event with the specified id occurs on the - specified layer." - [layer event-id f & args] - (let [f (if args #(apply f %1 %2 args) f)] - (dosync - (alter listeners-map assoc-conj event-id (WeakReference. layer) f)) - nil)) - -(defn- listeners - "Returns list of listener fns for event and target-layer. Listeners - for garbage-collected layers are removed." - [event-id target-layer] - (dosync - (loop [ref-vec (@listeners-map event-id) cleared-ref-vec [] listeners []] - (if-let [layer-ref (first ref-vec)] - (if-let [layer (.get layer-ref)] - (let [lfn (second ref-vec)] - (recur (nnext ref-vec) - (conj cleared-ref-vec layer-ref lfn) - (if (= layer target-layer) - (conj listeners lfn) - listeners))) - (recur (nnext ref-vec) cleared-ref-vec listeners)) - (do - (alter listeners-map assoc event-id cleared-ref-vec) - listeners))))) - -(defn dispatch-event [context event] - (doseq [listener (listeners (.getID event) (:layer context))] - (listener context event))) - (defprotocol EventDispatcher (listen! [this component]) - (register [this context]) + (register-mouse-handler [this context handler]) (commit [this]) (hovered? [this layer]) (picked? [this layer])) -(defn register-context [context] - (register (:dispatcher context) context)) +(defn mouse-handler [context handler & args] + "The supplied handler function will be invoked with context, event + and additional args when mouse event occurs on the context." + (let [handler (if args #(apply handler %1 %2 args) handler)] + (register-mouse-handler (:dispatcher context) context handler))) (defn- registered-parent "Returns first context parent registered for event processing." @@ -70,7 +34,7 @@ (defn- add-context [context-tree context] (let [parent (registered-parent context-tree context)] - (assoc context-tree parent (conj (context-tree parent) context) + (assoc context-tree parent (cons context (context-tree parent)) context nil))) (defn- inside? @@ -108,19 +72,23 @@ (getXOnScreen [] (.getXOnScreen event)) (getYOnScreen [] (.getYOnScreen event)))) +(defn- dispatch-event [handlers context event] + ((handlers context) context event)) + (defn- translate-and-dispatch - ([contexts event] - (translate-and-dispatch contexts event (.getID event))) - ([contexts event id] + ([contexts handlers event] + (translate-and-dispatch contexts handlers event (.getID event))) + ([contexts handlers event id] (doseq [context contexts] (dispatch-event + handlers context (translate-mouse-event event (:x context) (:y context) id))))) (defn- dispatch-mouse-motion* "Dispatches mouse motion events. Returns a new set of contexts which currently are under cursor." - [hovered context-tree event] + [hovered context-tree handlers event] (let [x (.getX event) y (.getY event) hovered2 (under-cursor context-tree x y) @@ -128,34 +96,39 @@ 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) + (translate-and-dispatch + exited handlers event MouseEvent/MOUSE_EXITED) + (translate-and-dispatch + entered handlers event MouseEvent/MOUSE_ENTERED) + (translate-and-dispatch + moved handlers event MouseEvent/MOUSE_MOVED) hovered2)) (defn- dispatch-mouse-motion - [hovered-ref context-tree event] + [hovered-ref context-tree handlers event] (dosync - (alter hovered-ref dispatch-mouse-motion* context-tree event))) + (alter hovered-ref dispatch-mouse-motion* context-tree handlers event))) (defn- dispatch-mouse-button* "Dispatches mouse button events. Returns a new set of contexts which currently are picked with a pressed button." - [picked hovered context-tree event] - (translate-and-dispatch hovered event) + [picked hovered handlers event] + (translate-and-dispatch hovered handlers event) (if (= (.getID event) MouseEvent/MOUSE_PRESSED) hovered nil)) - + (defn- dispatch-mouse-button - [picked-ref hovered-ref context-tree event] + [picked-ref hovered-ref handlers event] (dosync (alter picked-ref dispatch-mouse-button* - @hovered-ref context-tree event))) + @hovered-ref handlers event))) (defn make-event-dispatcher [] (let [context-tree-r (ref {}) ; register + handlers-r (ref {}) ; context-tree (ref {}) ; dispatch + handlers (ref {}) ; hovered (ref '()) picked (ref '())] (reify @@ -164,27 +137,29 @@ (doto component (.addMouseListener this) (.addMouseMotionListener this))) - (register [this context] - (dosync (alter context-tree-r add-context context))) + (register-mouse-handler [this context handler] + (dosync (alter context-tree-r add-context context) + (alter handlers-r assoc context handler))) (commit [this] (dosync (ref-set context-tree @context-tree-r) - (ref-set context-tree-r {}))) + (ref-set context-tree-r {}) + (ref-set handlers @handlers-r) + (ref-set handlers-r {}))) (picked? [this layer] false) (hovered? [this layer] false) MouseListener (mouseEntered [this event] - (dispatch-mouse-motion hovered context-tree event)) + (dispatch-mouse-motion hovered context-tree handlers event)) (mouseExited [this event] - (dispatch-mouse-motion hovered context-tree event)) + (dispatch-mouse-motion hovered context-tree handlers event)) (mouseClicked [this event] - (dispatch-mouse-button picked hovered context-tree event)) + (dispatch-mouse-button picked hovered handlers event)) (mousePressed [this event] - (dispatch-mouse-button picked hovered context-tree event)) + (dispatch-mouse-button picked hovered handlers event)) (mouseReleased [this event] - (dispatch-mouse-button picked hovered context-tree event)) + (dispatch-mouse-button picked hovered handlers event)) MouseMotionListener (mouseDragged [this event] - (translate-and-dispatch @picked event)) + (translate-and-dispatch @picked handlers event)) (mouseMoved [this event] - (dispatch-mouse-motion hovered context-tree event))))) - + (dispatch-mouse-motion hovered context-tree handlers event)))))