Mercurial > hg > indyvon
changeset 31:8ac3a21955db
DispatcherNode implements EventDispatcher.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Wed, 07 Jul 2010 04:14:21 +0400 |
parents | a8821f4b5ade |
children | 0b3757d263db |
files | src/indyvon/component.clj src/indyvon/core.clj |
diffstat | 2 files changed, 34 insertions(+), 25 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/component.clj Wed Jul 07 03:10:22 2010 +0400 +++ b/src/indyvon/component.clj Wed Jul 07 04:14:21 2010 +0400 @@ -34,7 +34,7 @@ (defn make-jpanel ([layer] - (make-jpanel layer (make-event-dispatcher))) + (make-jpanel layer (root-event-dispatcher))) ([layer event-dispatcher] (let [context (default-context) context (assoc context :dispatcher event-dispatcher)
--- a/src/indyvon/core.clj Wed Jul 07 03:10:22 2010 +0400 +++ b/src/indyvon/core.clj Wed Jul 07 04:14:21 2010 +0400 @@ -21,19 +21,19 @@ (defprotocol EventDispatcher (listen! [this component] - "Listen for events on the specified AWT Component.") - (register [this context handle handlers] - "Returns new context associated with the specified event - handlers (an event-id -> handler-fn map). Handle is used - to match the contexts between commits.") + "Listen for events on the specified AWT Component.") + (create-dispatcher [this context handle handlers] + "Returns new event dispatcher associated with the specified event + handlers (an event-id -> handler-fn map). Handle is used to + match the contexts between commits.") (commit [this] - "Apply the registered handlers for event processing.")) + "Apply the registered handlers for event processing.")) (defprotocol Anchored "Provide anchor point for Layers. Used by viewport." (anchor [this context h-align v-align] - "Anchor point: [x y], h-align could be :left, :center - or :right, v-align is :top, :center or :bottom")) + "Anchor point: [x y], h-align could be :left, :center or :right, + v-align is :top, :center or :bottom")) ;; Default implementation of Anchored for any Layer. (extend-protocol Anchored @@ -59,10 +59,10 @@ (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12))) (defrecord LayerContext [x y width height update-fn font-context - theme target dispatcher node]) + theme target event-dispatcher]) (defn default-context [] - (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil nil)) + (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil)) (defn update [context] ((:update-fn context))) @@ -116,13 +116,15 @@ context (or context binding)] `(let [context# ~context ~binding - (register (:dispatcher context#) context# handle - ~(reduce (fn [m spec] - (assoc m (first spec) - `(fn [~(second spec)] - ~@(nnext spec)))) {} - (butlast specs)))] - ~(last specs)))) + (assoc context# :event-dispatcher + (create-dispatcher (:event-dispatcher context#) + context# handle + ~(reduce (fn [m spec] + (assoc m (first spec) + `(fn [~(second spec)] + ~@(nnext spec)))) {} + (butlast specs))))] + ~(last specs)))) ;; ;; EventDispatcher implementation @@ -137,10 +139,17 @@ java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) -(defrecord DispatcherNode [handle handlers parent x y width height]) +(defrecord DispatcherNode [handle handlers parent x y width height] + EventDispatcher + (listen! [this component] + (listen! parent component)) + (create-dispatcher [this context handle handlers] + (create-dispatcher parent context handle handlers)) + (commit [this] + (commit parent))) -(defn- make-node [c handle handlers] - (DispatcherNode. handle handlers (:node c) +(defn- make-node [parent c handle handlers] + (DispatcherNode. handle handlers parent (:x c) (:y c) (:width c) (:height c))) (defn- assoc-cons [m key val] @@ -222,7 +231,7 @@ (dosync (alter picked-ref dispatch-mouse-button* @hovered-ref event))) -(defn make-event-dispatcher [] +(defn root-event-dispatcher [] (let [tree-r (ref {}) ; register tree (ref {}) ; dispatch hovered (ref '()) @@ -233,10 +242,10 @@ (doto component (.addMouseListener this) (.addMouseMotionListener this))) - (register [this context handle handlers] - (let [node (make-node context handle handlers)] + (create-dispatcher [this context handle handlers] + (let [node (make-node this context handle handlers)] (dosync (alter tree-r add-node node)) - (assoc context :node node))) + node)) (commit [this] (dosync (ref-set tree @tree-r) (ref-set tree-r {})))