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