Mercurial > hg > indyvon
changeset 30:a8821f4b5ade
Event dispatcher creates new context.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Wed, 07 Jul 2010 03:10:22 +0400 |
parents | 4cb70c5a6e0d |
children | 8ac3a21955db |
files | src/indyvon/core.clj |
diffstat | 1 files changed, 49 insertions(+), 53 deletions(-) [+] |
line diff
1.1 --- a/src/indyvon/core.clj Tue Jul 06 06:05:28 2010 +0400 1.2 +++ b/src/indyvon/core.clj Wed Jul 07 03:10:22 2010 +0400 1.3 @@ -20,9 +20,14 @@ 1.4 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) 1.5 1.6 (defprotocol EventDispatcher 1.7 - (listen! [this component]) 1.8 - (register [this context handlers]) 1.9 - (commit [this])) 1.10 + (listen! [this component] 1.11 + "Listen for events on the specified AWT Component.") 1.12 + (register [this context handle handlers] 1.13 + "Returns new context associated with the specified event 1.14 + handlers (an event-id -> handler-fn map). Handle is used 1.15 + to match the contexts between commits.") 1.16 + (commit [this] 1.17 + "Apply the registered handlers for event processing.")) 1.18 1.19 (defprotocol Anchored 1.20 "Provide anchor point for Layers. Used by viewport." 1.21 @@ -53,11 +58,11 @@ 1.22 (defn default-theme [] 1.23 (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12))) 1.24 1.25 -(defrecord LayerContext [layer parent x y width height update-fn 1.26 - dispatcher font-context theme target]) 1.27 +(defrecord LayerContext [x y width height update-fn font-context 1.28 + theme target dispatcher node]) 1.29 1.30 (defn default-context [] 1.31 - (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil)) 1.32 + (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil nil)) 1.33 1.34 (defn update [context] 1.35 ((:update-fn context))) 1.36 @@ -102,18 +107,22 @@ 1.37 (finally 1.38 (.dispose graphics)))))) 1.39 1.40 -(defn listen* [context & handlers] 1.41 - (register (:dispatcher context) context (apply array-map handlers))) 1.42 +(defmacro handlers [handle bindings & specs] 1.43 + "bindings => binding-form context 1.44 + specs => (:event-id name & handler-body)* form 1.45 1.46 -;; (listen context 1.47 -;; (:mouse-entered e (println e)) 1.48 -;; (:mouse-exited e (println e))) 1.49 -(defmacro listen [context & specs] 1.50 - `(register (:dispatcher ~context) ~context 1.51 - ~(reduce #(assoc %1 1.52 - (first %2) 1.53 - `(fn [~(second %2)] ~@(nnext %2))) 1.54 - {} specs))) 1.55 + Execute form with the specified event handlers." 1.56 + (let [[binding context] bindings 1.57 + context (or context binding)] 1.58 + `(let [context# ~context 1.59 + ~binding 1.60 + (register (:dispatcher context#) context# handle 1.61 + ~(reduce (fn [m spec] 1.62 + (assoc m (first spec) 1.63 + `(fn [~(second spec)] 1.64 + ~@(nnext spec)))) {} 1.65 + (butlast specs)))] 1.66 + ~(last specs)))) 1.67 1.68 ;; 1.69 ;; EventDispatcher implementation 1.70 @@ -128,33 +137,17 @@ 1.71 java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed 1.72 java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) 1.73 1.74 -(defrecord DispatcherNode [layer x y width height handlers children]) 1.75 +(defrecord DispatcherNode [handle handlers parent x y width height]) 1.76 1.77 -(defrecord DispatcherRootNode [children]) 1.78 +(defn- make-node [c handle handlers] 1.79 + (DispatcherNode. handle handlers (:node c) 1.80 + (:x c) (:y c) (:width c) (:height c))) 1.81 1.82 -(defn- make-node [c handlers] 1.83 - (DispatcherNode. (:layer c) (:x c) (:y c) (:width c) (:height c) 1.84 - handlers nil)) 1.85 +(defn- assoc-cons [m key val] 1.86 + (assoc m key (cons val (get m key)))) 1.87 1.88 -(defn- add-child [node child] 1.89 - (assoc node :children (cons child (:children node)))) 1.90 - 1.91 -(defn- registered-parent 1.92 - "Returns first context parent registered for event processing." 1.93 - [tree context] 1.94 - (let [parent (:parent context)] 1.95 - (cond 1.96 - (nil? parent) nil 1.97 - (contains? tree parent) parent 1.98 - :default (recur tree parent)))) 1.99 - 1.100 -(defn- add-context 1.101 - [tree context handlers] 1.102 - (let [parent (registered-parent tree context) 1.103 - node (make-node context handlers)] 1.104 - (assoc tree 1.105 - parent (add-child (tree parent) node) 1.106 - context node))) 1.107 +(defn- add-node [tree node] 1.108 + (assoc-cons tree (:parent node) node)) 1.109 1.110 (defn- inside? 1.111 ([x y node] 1.112 @@ -168,10 +161,12 @@ 1.113 1.114 (defn- under-cursor 1.115 "Returns a sequence of child nodes under cursor." 1.116 - [x y node] 1.117 - (some #(if (inside? x y %) 1.118 - (conj (under-cursor x y %) %)) 1.119 - (:children node))) 1.120 + ([x y tree] 1.121 + (under-cursor x y tree nil)) 1.122 + ([x y tree node] 1.123 + (some #(if (inside? x y %) 1.124 + (conj (under-cursor x y %) %)) 1.125 + (get tree node)))) 1.126 1.127 (defn- remove-all [coll1 coll2 pred] 1.128 (filter #(not (some (partial pred %) coll2)) coll1)) 1.129 @@ -199,8 +194,8 @@ 1.130 [hovered tree event] 1.131 (let [x (.getX event) 1.132 y (.getY event) 1.133 - hovered2 (under-cursor x y (get tree nil)) 1.134 - pred #(= (:layer %1) (:layer %2)) 1.135 + hovered2 (under-cursor x y tree) 1.136 + pred #(= (:handle %1) (:handle %2)) 1.137 exited (remove-all hovered hovered2 pred) 1.138 entered (remove-all hovered2 hovered pred) 1.139 moved (remove-all hovered2 entered pred)] 1.140 @@ -228,9 +223,8 @@ 1.141 (alter picked-ref dispatch-mouse-button* @hovered-ref event))) 1.142 1.143 (defn make-event-dispatcher [] 1.144 - (let [tree-i {nil (DispatcherRootNode. nil)} ; initial 1.145 - tree-r (ref tree-i) ; register 1.146 - tree (ref tree-i) ; dispatch 1.147 + (let [tree-r (ref {}) ; register 1.148 + tree (ref {}) ; dispatch 1.149 hovered (ref '()) 1.150 picked (ref '())] 1.151 (reify 1.152 @@ -239,11 +233,13 @@ 1.153 (doto component 1.154 (.addMouseListener this) 1.155 (.addMouseMotionListener this))) 1.156 - (register [this context handlers] 1.157 - (dosync (alter tree-r add-context context handlers))) 1.158 + (register [this context handle handlers] 1.159 + (let [node (make-node context handle handlers)] 1.160 + (dosync (alter tree-r add-node node)) 1.161 + (assoc context :node node))) 1.162 (commit [this] 1.163 (dosync (ref-set tree @tree-r) 1.164 - (ref-set tree-r tree-i))) 1.165 + (ref-set tree-r {}))) 1.166 MouseListener 1.167 (mouseEntered [this event] 1.168 (dispatch-mouse-motion hovered @tree event))