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] []))