Mercurial > hg > indyvon
changeset 5:74f1f265c3d9
Context record replaced bindings.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Thu, 10 Jun 2010 05:35:56 +0400 |
parents | 0771180bf7c2 |
children | 5a858158cd9e |
files | src/indyvon/core.clj |
diffstat | 1 files changed, 66 insertions(+), 73 deletions(-) [+] |
line diff
1.1 --- a/src/indyvon/core.clj Thu Jun 10 02:54:35 2010 +0400 1.2 +++ b/src/indyvon/core.clj Thu Jun 10 05:35:56 2010 +0400 1.3 @@ -3,26 +3,14 @@ 1.4 (java.awt.event MouseAdapter MouseMotionAdapter 1.5 MouseListener MouseMotionListener))) 1.6 1.7 -(def ^{:private true} *rx* 0) 1.8 -(def ^{:private true} *ry* 0) 1.9 - 1.10 -(def *graphics*) 1.11 - 1.12 -(def *width*) 1.13 -(def *height*) 1.14 - 1.15 -(def *lag*) 1.16 - 1.17 -(def *update-fn*) 1.18 - 1.19 (defprotocol Layer 1.20 - (render! [this]) 1.21 - (size [this]) 1.22 - (anchor [this])) 1.23 + (render! [this context]) 1.24 + (size [this context]) 1.25 + (anchor [this context])) 1.26 1.27 (defmacro reify-layer [& fns] 1.28 - (let [method-map {'size [['_] [0 0]] 1.29 - 'anchor [['_] [0 0]]} 1.30 + (let [method-map {'size [['_ '_] [0 0]] 1.31 + 'anchor [['_ '_] [0 0]]} 1.32 method-map (loop [fns fns 1.33 mm method-map] 1.34 (if-let [form (first fns)] 1.35 @@ -41,76 +29,82 @@ 1.36 1.37 (defn render-layer! 1.38 "Render layer in a new graphics context." 1.39 - ([layer] 1.40 - (render-layer! layer 0 0 *width* *height*)) 1.41 - ([layer x y] 1.42 - (render-layer! layer x y true)) 1.43 - ([layer x y clip] 1.44 - (let [s (size layer)] 1.45 - (render-layer! layer x y (.width s) (.height s) clip))) 1.46 - ([layer x y w h] 1.47 - (render-layer! layer x y w h true)) 1.48 - ([layer x y w h clip] 1.49 - (binding [*graphics* (make-graphics *graphics* x y w h clip) 1.50 - *rx* (+ *rx* x) 1.51 - *ry* (+ *ry* y) 1.52 - *width* w 1.53 - *height* h] 1.54 - (render! layer)))) 1.55 + ([context layer] 1.56 + (render-layer! context layer 0 0 *width* *height*)) 1.57 + ([context layer x y] 1.58 + (render-layer! context layer x y true)) 1.59 + ([context layer x y clip] 1.60 + (let [s (size layer context)] 1.61 + (render-layer! context layer x y (.width s) (.height s) clip))) 1.62 + ([context layer x y w h] 1.63 + (render-layer! context layer x y w h true)) 1.64 + ([context layer x y w h clip] 1.65 + (render! layer 1.66 + (assoc context 1.67 + :prev context 1.68 + :graphics (make-graphics (:graphics context) 1.69 + x y w h clip) 1.70 + :rx (+ (:rx context) x) 1.71 + :ry (+ (:ry context) y) 1.72 + :width w 1.73 + :height h)))) 1.74 1.75 ;; 1.76 ;; Event handling 1.77 ;; 1.78 +;; LayerContext сам реализует EventDispatcher. 1.79 +;; Дерево диспетчеров-контекстов. 1.80 +;; Передача события от корня. 1.81 +;; 1.82 1.83 (defmulti handle-layer-event 1.84 - (fn [layer event] 1.85 + (fn [layer context event] 1.86 [layer (.getID event)])) 1.87 1.88 -(defmethod handle-layer-event :default [layer event] 1.89 - false) 1.90 +(defmethod handle-layer-event :default [layer context event]) 1.91 1.92 (defprotocol EventDispatcher 1.93 (register [this layer]) 1.94 - (commit [this]) 1.95 - (dispatch [this event])) 1.96 + (commit [this])) 1.97 1.98 -;;(defrecord LayerContextState [hovered contexts]) 1.99 - 1.100 -(defrecord LayerContext [layer rx ry width height update-fn]) 1.101 - 1.102 -;; LayerContext сам реализует EventDispatcher. 1.103 -;; Дерево диспетчеров-контекстов. 1.104 -;; Передача события от корня. 1.105 +(defrecord LayerContext [prev rx ry width height update-fn dispatcher]) 1.106 1.107 (defn make-event-dispatcher [] 1.108 - (let [contexts-r (ref []) ; register 1.109 - contexts (ref []) ; dispatch 1.110 - hovered (ref []) 1.111 - picked (ref [])] 1.112 + (let [tree (ref {})] 1.113 (reify 1.114 EventDispatcher 1.115 - (register [this layer] 1.116 - (dosync 1.117 - (alter contexts-r conj 1.118 - (LayerContext. layer *rx* *ry* 1.119 - *width* *height* 1.120 - *update-fn*)))) 1.121 - (commit [this] 1.122 - (dosync (ref-set contexts @contexts-r) 1.123 - (ref-set contexts-r []))) 1.124 - (dispatch [this event] 1.125 - (println "dispatch" this event) 1.126 - ;; TODO 1.127 - ) 1.128 - MouseListener 1.129 - (mouseClicked [this event]) 1.130 - (mouseEntered [this event]) 1.131 - (mouseExited [this event]) 1.132 - (mousePressed [this event]) 1.133 - (mouseReleased [this event]) 1.134 - MouseMotionListener 1.135 - (mouseDragged [this event]) 1.136 - (mouseMoved [this event])))) 1.137 + (register [this layer]) 1.138 + (commit [this])))) 1.139 + 1.140 +;; (defn make-event-dispatcher [] 1.141 +;; (let [contexts-r (ref []) ; register 1.142 +;; contexts (ref []) ; dispatch 1.143 +;; hovered (ref []) 1.144 +;; picked (ref [])] 1.145 +;; (reify 1.146 +;; EventDispatcher 1.147 +;; (register [this layer] 1.148 +;; (dosync 1.149 +;; (alter contexts-r conj 1.150 +;; (LayerContext. layer *rx* *ry* 1.151 +;; *width* *height* 1.152 +;; *update-fn*)))) 1.153 +;; (commit [this] 1.154 +;; (dosync (ref-set contexts @contexts-r) 1.155 +;; (ref-set contexts-r []))) 1.156 +;; (dispatch [this event] 1.157 +;; (println "dispatch" this event) 1.158 +;; ;; TODO 1.159 +;; ) 1.160 +;; MouseListener 1.161 +;; (mouseClicked [this event]) 1.162 +;; (mouseEntered [this event]) 1.163 +;; (mouseExited [this event]) 1.164 +;; (mousePressed [this event]) 1.165 +;; (mouseReleased [this event]) 1.166 +;; MouseMotionListener 1.167 +;; (mouseDragged [this event]) 1.168 +;; (mouseMoved [this event])))) 1.169 1.170 ;; 1.171 ;; Connection to AWT. 1.172 @@ -154,8 +148,7 @@ 1.173 (getPreferredSize [] 1.174 (let [s (size layer)] 1.175 (Dimension. (s 0) (s 1)))) 1.176 - (processEvent [event] 1.177 - (dispatch event-dispatcher event))) 1.178 + (processEvent [event])) 1.179 ;; No way to call protected final evenbleEvents even in gen-class, 1.180 ;; have to use the following hack: 1.181 (.addMouseListener (proxy [MouseAdapter] []))