1.1 --- a/src/indyvon/component.clj	Wed Jul 07 03:10:22 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Wed Jul 07 04:14:21 2010 +0400
     1.3 @@ -34,7 +34,7 @@
     1.4  
     1.5  (defn make-jpanel
     1.6    ([layer]
     1.7 -     (make-jpanel layer (make-event-dispatcher)))
     1.8 +     (make-jpanel layer (root-event-dispatcher)))
     1.9    ([layer event-dispatcher]
    1.10       (let [context (default-context)
    1.11             context (assoc context :dispatcher event-dispatcher)

     2.1 --- a/src/indyvon/core.clj	Wed Jul 07 03:10:22 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Wed Jul 07 04:14:21 2010 +0400
     2.3 @@ -21,19 +21,19 @@
     2.4  
     2.5  (defprotocol EventDispatcher
     2.6    (listen! [this component]
     2.7 -           "Listen for events on the specified AWT Component.")
     2.8 -  (register [this context handle handlers]
     2.9 -            "Returns new context associated with the specified event
    2.10 -            handlers (an event-id -> handler-fn map). Handle is used
    2.11 -            to match the contexts between commits.")
    2.12 +     "Listen for events on the specified AWT Component.")
    2.13 +  (create-dispatcher [this context handle handlers]
    2.14 +     "Returns new event dispatcher associated with the specified event
    2.15 +      handlers (an event-id -> handler-fn map). Handle is used to
    2.16 +      match the contexts between commits.")
    2.17    (commit [this]
    2.18 -          "Apply the registered handlers for event processing."))
    2.19 +     "Apply the registered handlers for event processing."))
    2.20  
    2.21  (defprotocol Anchored
    2.22    "Provide anchor point for Layers. Used by viewport."
    2.23    (anchor [this context h-align v-align]
    2.24 -          "Anchor point: [x y], h-align could be :left, :center
    2.25 -           or :right, v-align is :top, :center or :bottom"))
    2.26 +     "Anchor point: [x y], h-align could be :left, :center or :right,
    2.27 +      v-align is :top, :center or :bottom"))
    2.28  
    2.29  ;; Default implementation of Anchored for any Layer.
    2.30  (extend-protocol Anchored
    2.31 @@ -59,10 +59,10 @@
    2.32    (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    2.33    
    2.34  (defrecord LayerContext [x y width height update-fn font-context
    2.35 -                         theme target dispatcher node])
    2.36 +                         theme target event-dispatcher])
    2.37  
    2.38  (defn default-context []
    2.39 -  (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil nil))
    2.40 +  (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil))
    2.41  
    2.42  (defn update [context]
    2.43    ((:update-fn context)))
    2.44 @@ -116,13 +116,15 @@
    2.45          context (or context binding)]
    2.46      `(let [context# ~context
    2.47             ~binding
    2.48 -           (register (:dispatcher context#) context# handle
    2.49 -                     ~(reduce (fn [m spec]
    2.50 -                                (assoc m (first spec)
    2.51 -                                       `(fn [~(second spec)]
    2.52 -                                          ~@(nnext spec)))) {}
    2.53 -                                          (butlast specs)))]
    2.54 -       ~(last specs))))
    2.55 +           (assoc context# :event-dispatcher
    2.56 +             (create-dispatcher (:event-dispatcher context#)
    2.57 +               context# handle
    2.58 +               ~(reduce (fn [m spec]
    2.59 +                          (assoc m (first spec)
    2.60 +                                 `(fn [~(second spec)]
    2.61 +                                    ~@(nnext spec)))) {}
    2.62 +                                    (butlast specs))))]
    2.63 +           ~(last specs))))
    2.64  
    2.65  ;;
    2.66  ;; EventDispatcher implementation
    2.67 @@ -137,10 +139,17 @@
    2.68        java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
    2.69        java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
    2.70  
    2.71 -(defrecord DispatcherNode [handle handlers parent x y width height])
    2.72 +(defrecord DispatcherNode [handle handlers parent x y width height]
    2.73 +  EventDispatcher
    2.74 +  (listen! [this component]
    2.75 +     (listen! parent component))
    2.76 +  (create-dispatcher [this context handle handlers]
    2.77 +     (create-dispatcher parent context handle handlers))
    2.78 +  (commit [this]
    2.79 +     (commit parent)))
    2.80  
    2.81 -(defn- make-node [c handle handlers]
    2.82 -  (DispatcherNode. handle handlers (:node c)
    2.83 +(defn- make-node [parent c handle handlers]
    2.84 +  (DispatcherNode. handle handlers parent
    2.85                     (:x c) (:y c) (:width c) (:height c)))
    2.86  
    2.87  (defn- assoc-cons [m key val]
    2.88 @@ -222,7 +231,7 @@
    2.89    (dosync
    2.90     (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
    2.91  
    2.92 -(defn make-event-dispatcher []
    2.93 +(defn root-event-dispatcher []
    2.94    (let [tree-r (ref {})   ; register
    2.95          tree (ref {})     ; dispatch
    2.96          hovered (ref '())
    2.97 @@ -233,10 +242,10 @@
    2.98          (doto component
    2.99            (.addMouseListener this)
   2.100            (.addMouseMotionListener this)))
   2.101 -     (register [this context handle handlers]
   2.102 -        (let [node (make-node context handle handlers)]
   2.103 +     (create-dispatcher [this context handle handlers]
   2.104 +        (let [node (make-node this context handle handlers)]
   2.105            (dosync (alter tree-r add-node node))
   2.106 -          (assoc context :node node)))
   2.107 +          node))
   2.108       (commit [this]
   2.109          (dosync (ref-set tree @tree-r)
   2.110                  (ref-set tree-r {})))