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, 71 insertions(+), 78 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/core.clj Thu Jun 10 02:54:35 2010 +0400 +++ b/src/indyvon/core.clj Thu Jun 10 05:35:56 2010 +0400 @@ -3,26 +3,14 @@ (java.awt.event MouseAdapter MouseMotionAdapter MouseListener MouseMotionListener))) -(def ^{:private true} *rx* 0) -(def ^{:private true} *ry* 0) - -(def *graphics*) - -(def *width*) -(def *height*) - -(def *lag*) - -(def *update-fn*) - (defprotocol Layer - (render! [this]) - (size [this]) - (anchor [this])) + (render! [this context]) + (size [this context]) + (anchor [this context])) (defmacro reify-layer [& fns] - (let [method-map {'size [['_] [0 0]] - 'anchor [['_] [0 0]]} + (let [method-map {'size [['_ '_] [0 0]] + 'anchor [['_ '_] [0 0]]} method-map (loop [fns fns mm method-map] (if-let [form (first fns)] @@ -41,76 +29,82 @@ (defn render-layer! "Render layer in a new graphics context." - ([layer] - (render-layer! layer 0 0 *width* *height*)) - ([layer x y] - (render-layer! layer x y true)) - ([layer x y clip] - (let [s (size layer)] - (render-layer! layer x y (.width s) (.height s) clip))) - ([layer x y w h] - (render-layer! layer x y w h true)) - ([layer x y w h clip] - (binding [*graphics* (make-graphics *graphics* x y w h clip) - *rx* (+ *rx* x) - *ry* (+ *ry* y) - *width* w - *height* h] - (render! layer)))) + ([context layer] + (render-layer! context layer 0 0 *width* *height*)) + ([context layer x y] + (render-layer! context layer x y true)) + ([context layer x y clip] + (let [s (size layer context)] + (render-layer! context layer x y (.width s) (.height s) clip))) + ([context layer x y w h] + (render-layer! context layer x y w h true)) + ([context layer x y w h clip] + (render! layer + (assoc context + :prev context + :graphics (make-graphics (:graphics context) + x y w h clip) + :rx (+ (:rx context) x) + :ry (+ (:ry context) y) + :width w + :height h)))) ;; ;; Event handling ;; - -(defmulti handle-layer-event - (fn [layer event] - [layer (.getID event)])) - -(defmethod handle-layer-event :default [layer event] - false) - -(defprotocol EventDispatcher - (register [this layer]) - (commit [this]) - (dispatch [this event])) - -;;(defrecord LayerContextState [hovered contexts]) - -(defrecord LayerContext [layer rx ry width height update-fn]) - ;; LayerContext сам реализует EventDispatcher. ;; Дерево диспетчеров-контекстов. ;; Передача события от корня. +;; + +(defmulti handle-layer-event + (fn [layer context event] + [layer (.getID event)])) + +(defmethod handle-layer-event :default [layer context event]) + +(defprotocol EventDispatcher + (register [this layer]) + (commit [this])) + +(defrecord LayerContext [prev rx ry width height update-fn dispatcher]) (defn make-event-dispatcher [] - (let [contexts-r (ref []) ; register - contexts (ref []) ; dispatch - hovered (ref []) - picked (ref [])] + (let [tree (ref {})] (reify EventDispatcher - (register [this layer] - (dosync - (alter contexts-r conj - (LayerContext. layer *rx* *ry* - *width* *height* - *update-fn*)))) - (commit [this] - (dosync (ref-set contexts @contexts-r) - (ref-set contexts-r []))) - (dispatch [this event] - (println "dispatch" this event) - ;; TODO - ) - MouseListener - (mouseClicked [this event]) - (mouseEntered [this event]) - (mouseExited [this event]) - (mousePressed [this event]) - (mouseReleased [this event]) - MouseMotionListener - (mouseDragged [this event]) - (mouseMoved [this event])))) + (register [this layer]) + (commit [this])))) + +;; (defn make-event-dispatcher [] +;; (let [contexts-r (ref []) ; register +;; contexts (ref []) ; dispatch +;; hovered (ref []) +;; picked (ref [])] +;; (reify +;; EventDispatcher +;; (register [this layer] +;; (dosync +;; (alter contexts-r conj +;; (LayerContext. layer *rx* *ry* +;; *width* *height* +;; *update-fn*)))) +;; (commit [this] +;; (dosync (ref-set contexts @contexts-r) +;; (ref-set contexts-r []))) +;; (dispatch [this event] +;; (println "dispatch" this event) +;; ;; TODO +;; ) +;; MouseListener +;; (mouseClicked [this event]) +;; (mouseEntered [this event]) +;; (mouseExited [this event]) +;; (mousePressed [this event]) +;; (mouseReleased [this event]) +;; MouseMotionListener +;; (mouseDragged [this event]) +;; (mouseMoved [this event])))) ;; ;; Connection to AWT. @@ -154,8 +148,7 @@ (getPreferredSize [] (let [s (size layer)] (Dimension. (s 0) (s 1)))) - (processEvent [event] - (dispatch event-dispatcher event))) + (processEvent [event])) ;; No way to call protected final evenbleEvents even in gen-class, ;; have to use the following hack: (.addMouseListener (proxy [MouseAdapter] []))