changeset 31:8ac3a21955db

DispatcherNode implements EventDispatcher.
author Mikhail Kryshen <mikhail@kryshen.net>
date Wed, 07 Jul 2010 04:14:21 +0400
parents a8821f4b5ade
children 0b3757d263db
files src/indyvon/component.clj src/indyvon/core.clj
diffstat 2 files changed, 34 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Wed Jul 07 03:10:22 2010 +0400
+++ b/src/indyvon/component.clj	Wed Jul 07 04:14:21 2010 +0400
@@ -34,7 +34,7 @@
 
 (defn make-jpanel
   ([layer]
-     (make-jpanel layer (make-event-dispatcher)))
+     (make-jpanel layer (root-event-dispatcher)))
   ([layer event-dispatcher]
      (let [context (default-context)
            context (assoc context :dispatcher event-dispatcher)
--- a/src/indyvon/core.clj	Wed Jul 07 03:10:22 2010 +0400
+++ b/src/indyvon/core.clj	Wed Jul 07 04:14:21 2010 +0400
@@ -21,19 +21,19 @@
 
 (defprotocol EventDispatcher
   (listen! [this component]
-           "Listen for events on the specified AWT Component.")
-  (register [this context handle handlers]
-            "Returns new context associated with the specified event
-            handlers (an event-id -> handler-fn map). Handle is used
-            to match the contexts between commits.")
+     "Listen for events on the specified AWT Component.")
+  (create-dispatcher [this context handle handlers]
+     "Returns new event dispatcher associated with the specified event
+      handlers (an event-id -> handler-fn map). Handle is used to
+      match the contexts between commits.")
   (commit [this]
-          "Apply the registered handlers for event processing."))
+     "Apply the registered handlers for event processing."))
 
 (defprotocol Anchored
   "Provide anchor point for Layers. Used by viewport."
   (anchor [this context h-align v-align]
-          "Anchor point: [x y], h-align could be :left, :center
-           or :right, v-align is :top, :center or :bottom"))
+     "Anchor point: [x y], h-align could be :left, :center or :right,
+      v-align is :top, :center or :bottom"))
 
 ;; Default implementation of Anchored for any Layer.
 (extend-protocol Anchored
@@ -59,10 +59,10 @@
   (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
   
 (defrecord LayerContext [x y width height update-fn font-context
-                         theme target dispatcher node])
+                         theme target event-dispatcher])
 
 (defn default-context []
-  (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil nil))
+  (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil))
 
 (defn update [context]
   ((:update-fn context)))
@@ -116,13 +116,15 @@
         context (or context binding)]
     `(let [context# ~context
            ~binding
-           (register (:dispatcher context#) context# handle
-                     ~(reduce (fn [m spec]
-                                (assoc m (first spec)
-                                       `(fn [~(second spec)]
-                                          ~@(nnext spec)))) {}
-                                          (butlast specs)))]
-       ~(last specs))))
+           (assoc context# :event-dispatcher
+             (create-dispatcher (:event-dispatcher context#)
+               context# handle
+               ~(reduce (fn [m spec]
+                          (assoc m (first spec)
+                                 `(fn [~(second spec)]
+                                    ~@(nnext spec)))) {}
+                                    (butlast specs))))]
+           ~(last specs))))
 
 ;;
 ;; EventDispatcher implementation
@@ -137,10 +139,17 @@
       java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
       java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
 
-(defrecord DispatcherNode [handle handlers parent x y width height])
+(defrecord DispatcherNode [handle handlers parent x y width height]
+  EventDispatcher
+  (listen! [this component]
+     (listen! parent component))
+  (create-dispatcher [this context handle handlers]
+     (create-dispatcher parent context handle handlers))
+  (commit [this]
+     (commit parent)))
 
-(defn- make-node [c handle handlers]
-  (DispatcherNode. handle handlers (:node c)
+(defn- make-node [parent c handle handlers]
+  (DispatcherNode. handle handlers parent
                    (:x c) (:y c) (:width c) (:height c)))
 
 (defn- assoc-cons [m key val]
@@ -222,7 +231,7 @@
   (dosync
    (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
 
-(defn make-event-dispatcher []
+(defn root-event-dispatcher []
   (let [tree-r (ref {})   ; register
         tree (ref {})     ; dispatch
         hovered (ref '())
@@ -233,10 +242,10 @@
         (doto component
           (.addMouseListener this)
           (.addMouseMotionListener this)))
-     (register [this context handle handlers]
-        (let [node (make-node context handle handlers)]
+     (create-dispatcher [this context handle handlers]
+        (let [node (make-node this context handle handlers)]
           (dosync (alter tree-r add-node node))
-          (assoc context :node node)))
+          node))
      (commit [this]
         (dosync (ref-set tree @tree-r)
                 (ref-set tree-r {})))