Mercurial > hg > indyvon
changeset 29:4cb70c5a6e0d
Event handlers are registered using listen macro instead of implementing a protocol.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Tue, 06 Jul 2010 06:05:28 +0400 |
parents | 1237f7555029 |
children | a8821f4b5ade |
files | src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj |
diffstat | 3 files changed, 133 insertions(+), 111 deletions(-) [+] |
line diff
1.1 --- a/src/indyvon/component.clj Mon Jun 21 04:00:45 2010 +0400 1.2 +++ b/src/indyvon/component.clj Tue Jul 06 06:05:28 2010 +0400 1.3 @@ -6,7 +6,8 @@ 1.4 1.5 (ns indyvon.component 1.6 (:use indyvon.core indyvon.layers) 1.7 - (:import (java.awt Component Dimension Color) 1.8 + (:import (indyvon.core Size Location) 1.9 + (java.awt Component Dimension Color) 1.10 (javax.swing JFrame JPanel))) 1.11 1.12 (defn- font-context [component] 1.13 @@ -29,7 +30,7 @@ 1.14 :target component 1.15 :font-context (font-context component)) 1.16 s (size layer context)] 1.17 - (Dimension. (s 0) (s 1)))) 1.18 + (Dimension. (:width s) (:height s)))) 1.19 1.20 (defn make-jpanel 1.21 ([layer] 1.22 @@ -57,10 +58,7 @@ 1.23 (render! [this context g] 1.24 (.setColor g Color/RED) 1.25 (.fillRect g 0 0 (:width context) (:height context))) 1.26 - (size [this context] [30 20]) 1.27 - MouseHandler 1.28 - (handle-mouse [this context event] 1.29 - (println "layer1" event)))) 1.30 + (size [this context] (Size. 30 20)))) 1.31 1.32 (def layer1b (border-layer layer1 2 3)) 1.33 1.34 @@ -72,10 +70,7 @@ 1.35 (.fillRect g 0 0 (:width context) (:height context)) 1.36 (draw! layer1b context g 10 5) 1.37 (draw! layer1 context g 55 5)) 1.38 - (size [this context] [70 65]) 1.39 - MouseHandler 1.40 - (handle-mouse [this context event] 1.41 - (println "layer2" event)))) 1.42 + (size [this context] (Size. 70 65)))) 1.43 1.44 (def layer3 1.45 (border-layer (text-layer "Sample\ntext" :right :center))) 1.46 @@ -111,7 +106,7 @@ 1.47 (draw! layer2 context g 15 20) 1.48 (draw! layer3 context g 100 100 80 50) 1.49 (draw! fps context g)) 1.50 - (size [this context] [400 300]))) 1.51 + (size [this context] (Size. 400 300)))) 1.52 1.53 (doto frame 1.54 (.addWindowListener
2.1 --- a/src/indyvon/core.clj Mon Jun 21 04:00:45 2010 +0400 2.2 +++ b/src/indyvon/core.clj Tue Jul 06 06:05:28 2010 +0400 2.3 @@ -13,19 +13,16 @@ 2.4 (render! [this context graphics]) 2.5 (size [this context])) 2.6 2.7 +(defrecord Location [x y]) 2.8 +(defrecord Size [width height]) 2.9 + 2.10 ;; TODO: modifiers 2.11 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) 2.12 2.13 -(defprotocol MouseHandler 2.14 - "Layers that also satisfy this protocol will recieve mouse events." 2.15 - (handle-mouse [this context event])) 2.16 - 2.17 (defprotocol EventDispatcher 2.18 (listen! [this component]) 2.19 - (register [this context]) 2.20 - (commit [this]) 2.21 - (hovered? [this layer]) 2.22 - (picked? [this layer])) 2.23 + (register [this context handlers]) 2.24 + (commit [this])) 2.25 2.26 (defprotocol Anchored 2.27 "Provide anchor point for Layers. Used by viewport." 2.28 @@ -39,16 +36,17 @@ 2.29 (anchor [this context h-align v-align] 2.30 (if (and (= h-align :left) 2.31 (= v-align :top)) 2.32 - [0 0] 2.33 + (Location. 0 0) 2.34 (let [size (size this context)] 2.35 - [(case h-align 2.36 - :top 0 2.37 - :center (/ (size 0) 2) 2.38 - :right (size 0)) 2.39 + (Location. 2.40 + (case h-align 2.41 + :top 0 2.42 + :center (/ (:width size) 2) 2.43 + :right (:width size)) 2.44 (case v-align 2.45 - :left 0 2.46 - :center (/ (size 1) 2) 2.47 - :bottom (size 1))])))) 2.48 + :left 0 2.49 + :center (/ (:height size) 2) 2.50 + :bottom (:height size))))))) 2.51 2.52 (defrecord Theme [fore-color back-color border-color font]) 2.53 2.54 @@ -85,7 +83,7 @@ 2.55 ([layer context graphics x y clip] 2.56 (let [s (size layer context)] 2.57 (draw! layer context graphics 2.58 - x y (s 0) (s 1) clip))) 2.59 + x y (:width s) (:height s) clip))) 2.60 ([layer context graphics x y w h] 2.61 (draw! layer context graphics 2.62 x y w h true)) 2.63 @@ -100,11 +98,23 @@ 2.64 graphics (make-graphics graphics x y w h clip) 2.65 graphics (apply-theme graphics (:theme context))] 2.66 (try 2.67 - (register (:dispatcher context) context) 2.68 (render! layer context graphics) 2.69 (finally 2.70 (.dispose graphics)))))) 2.71 2.72 +(defn listen* [context & handlers] 2.73 + (register (:dispatcher context) context (apply array-map handlers))) 2.74 + 2.75 +;; (listen context 2.76 +;; (:mouse-entered e (println e)) 2.77 +;; (:mouse-exited e (println e))) 2.78 +(defmacro listen [context & specs] 2.79 + `(register (:dispatcher ~context) ~context 2.80 + ~(reduce #(assoc %1 2.81 + (first %2) 2.82 + `(fn [~(second %2)] ~@(nnext %2))) 2.83 + {} specs))) 2.84 + 2.85 ;; 2.86 ;; EventDispatcher implementation 2.87 ;; 2.88 @@ -118,25 +128,38 @@ 2.89 java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed 2.90 java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) 2.91 2.92 +(defrecord DispatcherNode [layer x y width height handlers children]) 2.93 + 2.94 +(defrecord DispatcherRootNode [children]) 2.95 + 2.96 +(defn- make-node [c handlers] 2.97 + (DispatcherNode. (:layer c) (:x c) (:y c) (:width c) (:height c) 2.98 + handlers nil)) 2.99 + 2.100 +(defn- add-child [node child] 2.101 + (assoc node :children (cons child (:children node)))) 2.102 + 2.103 (defn- registered-parent 2.104 "Returns first context parent registered for event processing." 2.105 - [context-tree context] 2.106 + [tree context] 2.107 (let [parent (:parent context)] 2.108 (cond 2.109 (nil? parent) nil 2.110 - (contains? context-tree parent) parent 2.111 - :default (recur context-tree parent)))) 2.112 + (contains? tree parent) parent 2.113 + :default (recur tree parent)))) 2.114 2.115 (defn- add-context 2.116 - [context-tree context] 2.117 - (let [parent (registered-parent context-tree context)] 2.118 - (assoc context-tree parent (cons context (context-tree parent)) 2.119 - context nil))) 2.120 + [tree context handlers] 2.121 + (let [parent (registered-parent tree context) 2.122 + node (make-node context handlers)] 2.123 + (assoc tree 2.124 + parent (add-child (tree parent) node) 2.125 + context node))) 2.126 2.127 (defn- inside? 2.128 - ([x y context] 2.129 - (inside? x y (:x context) (:y context) 2.130 - (:width context) (:height context))) 2.131 + ([x y node] 2.132 + (inside? x y (:x node) (:y node) 2.133 + (:width node) (:height node))) 2.134 ([px py x y w h] 2.135 (and (>= px x) 2.136 (>= py y) 2.137 @@ -144,30 +167,15 @@ 2.138 (< py (+ y h))))) 2.139 2.140 (defn- under-cursor 2.141 - "Returns a sequence of contexts under cursor." 2.142 - ([context-tree x y] 2.143 - (under-cursor context-tree x y nil)) 2.144 - ([context-tree x y context] 2.145 - (some #(if (inside? x y %) 2.146 - (conj (under-cursor context-tree x y %) %)) 2.147 - (context-tree context)))) 2.148 + "Returns a sequence of child nodes under cursor." 2.149 + [x y node] 2.150 + (some #(if (inside? x y %) 2.151 + (conj (under-cursor x y %) %)) 2.152 + (:children node))) 2.153 2.154 (defn- remove-all [coll1 coll2 pred] 2.155 (filter #(not (some (partial pred %) coll2)) coll1)) 2.156 2.157 -;; (defn- translate-mouse-event 2.158 -;; [event x y id] 2.159 -;; (proxy [MouseEvent] [(.getComponent event) 2.160 -;; id 2.161 -;; (.getWhen event) 2.162 -;; (.getModifiers event) 2.163 -;; (- (.getX event) x) 2.164 -;; (- (.getY event) y) 2.165 -;; (.getClickCount event) 2.166 -;; (.isPopupTrigger event)] 2.167 -;; (getXOnScreen [] (.getXOnScreen event)) 2.168 -;; (getYOnScreen [] (.getYOnScreen event)))) 2.169 - 2.170 (defn- translate-mouse-event 2.171 [event x y id] 2.172 (MouseEvent. id (.getWhen event) 2.173 @@ -176,22 +184,22 @@ 2.174 (.getButton event))) 2.175 2.176 (defn- translate-and-dispatch 2.177 - ([contexts event] 2.178 - (translate-and-dispatch contexts event (awt-events (.getID event)))) 2.179 - ([contexts event id] 2.180 - (doseq [context contexts] 2.181 - (handle-mouse 2.182 - (:layer context) context 2.183 - (translate-mouse-event event (:x context) (:y context) id))) 2.184 + ([nodes event] 2.185 + (translate-and-dispatch nodes event (awt-events (.getID event)))) 2.186 + ([nodes event id] 2.187 + (doseq [node nodes] 2.188 + (when-let [handler (get (:handlers node) id)] 2.189 + (handler 2.190 + (translate-mouse-event event (:x node) (:y node) id)))) 2.191 id)) 2.192 2.193 (defn- dispatch-mouse-motion* 2.194 - "Dispatches mouse motion events. Returns a new set of contexts which 2.195 + "Dispatches mouse motion events. Returns a new set of nodes which 2.196 currently are under cursor." 2.197 - [hovered context-tree event] 2.198 + [hovered tree event] 2.199 (let [x (.getX event) 2.200 y (.getY event) 2.201 - hovered2 (under-cursor context-tree x y) 2.202 + hovered2 (under-cursor x y (get tree nil)) 2.203 pred #(= (:layer %1) (:layer %2)) 2.204 exited (remove-all hovered hovered2 pred) 2.205 entered (remove-all hovered2 hovered pred) 2.206 @@ -202,12 +210,12 @@ 2.207 hovered2)) 2.208 2.209 (defn- dispatch-mouse-motion 2.210 - [hovered-ref context-tree event] 2.211 + [hovered-ref tree event] 2.212 (dosync 2.213 - (alter hovered-ref dispatch-mouse-motion* context-tree event))) 2.214 + (alter hovered-ref dispatch-mouse-motion* tree event))) 2.215 2.216 (defn- dispatch-mouse-button* 2.217 - "Dispatches mouse button events. Returns a new set of contexts which 2.218 + "Dispatches mouse button events. Returns a new set of nodes which 2.219 currently are picked with a pressed button." 2.220 [picked hovered event] 2.221 (if (= (translate-and-dispatch hovered event) :mouse-pressed) 2.222 @@ -220,8 +228,9 @@ 2.223 (alter picked-ref dispatch-mouse-button* @hovered-ref event))) 2.224 2.225 (defn make-event-dispatcher [] 2.226 - (let [context-tree-r (ref {}) ; register 2.227 - context-tree (ref {}) ; dispatch 2.228 + (let [tree-i {nil (DispatcherRootNode. nil)} ; initial 2.229 + tree-r (ref tree-i) ; register 2.230 + tree (ref tree-i) ; dispatch 2.231 hovered (ref '()) 2.232 picked (ref '())] 2.233 (reify 2.234 @@ -230,19 +239,16 @@ 2.235 (doto component 2.236 (.addMouseListener this) 2.237 (.addMouseMotionListener this))) 2.238 - (register [this context] 2.239 - (when (satisfies? MouseHandler (:layer context)) 2.240 - (dosync (alter context-tree-r add-context context)))) 2.241 + (register [this context handlers] 2.242 + (dosync (alter tree-r add-context context handlers))) 2.243 (commit [this] 2.244 - (dosync (ref-set context-tree @context-tree-r) 2.245 - (ref-set context-tree-r {}))) 2.246 - (picked? [this layer] false) 2.247 - (hovered? [this layer] false) 2.248 + (dosync (ref-set tree @tree-r) 2.249 + (ref-set tree-r tree-i))) 2.250 MouseListener 2.251 (mouseEntered [this event] 2.252 - (dispatch-mouse-motion hovered @context-tree event)) 2.253 + (dispatch-mouse-motion hovered @tree event)) 2.254 (mouseExited [this event] 2.255 - (dispatch-mouse-motion hovered @context-tree event)) 2.256 + (dispatch-mouse-motion hovered @tree event)) 2.257 (mouseClicked [this event] 2.258 (dispatch-mouse-button picked hovered event)) 2.259 (mousePressed [this event] 2.260 @@ -253,4 +259,29 @@ 2.261 (mouseDragged [this event] 2.262 (translate-and-dispatch @picked event)) 2.263 (mouseMoved [this event] 2.264 - (dispatch-mouse-motion hovered @context-tree event))))) 2.265 + (dispatch-mouse-motion hovered @tree event))))) 2.266 + 2.267 +;; 2.268 +;; ИДЕИ: 2.269 +;; 2.270 +;; Контекст: биндинги или запись? 2.271 +;; 2.272 +;; Установка обработчиков (в контексте слоя): 2.273 +;; 2.274 +;; (listen 2.275 +;; (:mouse-entered e 2.276 +;; ...) 2.277 +;; (:mouse-exited e 2.278 +;; ...)) 2.279 +;; 2.280 +;; Не надо IMGUI. 2.281 +;; Построение сцены путем декорирования слоев: 2.282 +;; 2.283 +;; (listener 2.284 +;; (:action e (println e)) 2.285 +;; (:mouse-dragged e (println e)) 2.286 +;; (theme :font "Helvetica-14" 2.287 +;; (vbox 2.288 +;; (button (text-layer "Button 1")) 2.289 +;; (button (text-layer "Button 2"))))) 2.290 +;;
3.1 --- a/src/indyvon/layers.clj Mon Jun 21 04:00:45 2010 +0400 3.2 +++ b/src/indyvon/layers.clj Tue Jul 06 06:05:28 2010 +0400 3.3 @@ -6,7 +6,8 @@ 3.4 3.5 (ns indyvon.layers 3.6 (:use indyvon.core) 3.7 - (:import (java.awt Cursor) 3.8 + (:import (indyvon.core Size Location) 3.9 + (java.awt Cursor) 3.10 (java.awt.font FontRenderContext TextLayout))) 3.11 3.12 ;; Define as macro to avoid unnecessary calculation of inner and outer 3.13 @@ -42,8 +43,8 @@ 3.14 (- h offset offset)))) 3.15 (size [l c] 3.16 (let [s (size content c)] 3.17 - [(+ (s 0) offset offset) 3.18 - (+ (s 1) offset offset)])))))) 3.19 + (Size. (+ (:width s) offset offset) 3.20 + (+ (:height s) offset offset)))))))) 3.21 3.22 (defn- re-split [re s] 3.23 (seq (.split re s))) 3.24 @@ -85,7 +86,7 @@ 3.25 (:font-context c)) 3.26 width (text-width layouts) 3.27 height (text-height layouts)] 3.28 - [width height])))))) 3.29 + (Size. width height))))))) 3.30 3.31 (defn viewport 3.32 "Creates scrollable viewport layer." 3.33 @@ -100,6 +101,21 @@ 3.34 (reify 3.35 Layer 3.36 (render! [layer c g] 3.37 + (listen c 3.38 + (:mouse-pressed e 3.39 + (dosync 3.40 + (ref-set fix-x (:x-on-screen e)) 3.41 + (ref-set fix-y (:y-on-screen e))) 3.42 + (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c)))) 3.43 + (:mouse-released e 3.44 + (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))) 3.45 + (:mouse-dragged e 3.46 + (dosync 3.47 + (alter x + (- @fix-x (:x-on-screen e))) 3.48 + (alter y + (- @fix-y (:y-on-screen e))) 3.49 + (ref-set fix-x (:x-on-screen e)) 3.50 + (ref-set fix-y (:y-on-screen e))) 3.51 + (update c))) 3.52 (let [anchor (anchor content c h-align v-align) 3.53 width (:width c) 3.54 height (:height c)] 3.55 @@ -109,26 +125,6 @@ 3.56 (ref-set last-width width) 3.57 (ref-set last-height height)) 3.58 (draw! content c g 3.59 - (- 0 @x (anchor 0)) 3.60 - (- 0 @y (anchor 1))))) 3.61 - (size [layer c] (size content c)) 3.62 - MouseHandler 3.63 - (handle-mouse [layer c e] 3.64 - (case (:id e) 3.65 - :mouse-pressed 3.66 - (do 3.67 - (dosync 3.68 - (ref-set fix-x (:x-on-screen e)) 3.69 - (ref-set fix-y (:y-on-screen e))) 3.70 - (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c)))) 3.71 - :mouse-released 3.72 - (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))) 3.73 - :mouse-dragged 3.74 - (do 3.75 - (dosync 3.76 - (alter x + (- @fix-x (:x-on-screen e))) 3.77 - (alter y + (- @fix-y (:y-on-screen e))) 3.78 - (ref-set fix-x (:x-on-screen e)) 3.79 - (ref-set fix-y (:y-on-screen e))) 3.80 - (update c)) 3.81 - nil)))))) 3.82 + (- 0 @x (:x anchor)) 3.83 + (- 0 @y (:y anchor))))) 3.84 + (size [layer c] (size content c))))))