1.1 --- a/src/indyvon/component.clj	Fri Jun 18 04:39:56 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Sat Jun 19 04:27:29 2010 +0400
     1.3 @@ -49,32 +49,44 @@
     1.4  (comment
     1.5    (do 
     1.6      (def frame (JFrame. "Test"))
     1.7 +    
     1.8 +    (defn handler [context event]
     1.9 +      (println (:layer context) (.paramString event)))
    1.10 +      
    1.11      (def layer1
    1.12           (reify Layer
    1.13            (render! [this context g]
    1.14 -             (register-context context)
    1.15 +             (mouse-handler context handler)
    1.16               (.setColor g Color/RED)
    1.17               (.fillRect g 0 0 (:width context) (:height context)))
    1.18 -          (size [this context] [30 20])))
    1.19 +          (size [this context] [30 20])
    1.20 +          (toString [this] "layer1")))
    1.21 +    
    1.22      (def layer1b (border-layer layer1 2 3))
    1.23 +    
    1.24      (def layer2
    1.25           (reify Layer
    1.26            (render! [this context g]
    1.27 -             (register-context context)
    1.28 +             (mouse-handler context handler)
    1.29               (.setColor g Color/YELLOW)
    1.30               (.fillRect g 0 0 (:width context) (:height context))
    1.31               (draw! context layer1b g 10 5)
    1.32               (draw! context layer1 g 55 5))
    1.33 -          (size [this context] [70 65])))
    1.34 +          (size [this context] [70 65])
    1.35 +          (toString [this] "layer2")))
    1.36 +    
    1.37      (def layer3
    1.38           (border-layer (text-layer "Sample\ntext" :right :bottom)))
    1.39 +    
    1.40      (def layer
    1.41           (reify Layer
    1.42            (render! [this context g]
    1.43               (.drawLine g 0 0 (:width context) (:height context))
    1.44               (draw! context layer2 g 15 20)
    1.45               (draw! context layer3 g 100 100 80 50))
    1.46 -          (size [this context] [400 300])))
    1.47 +          (size [this context] [400 300])
    1.48 +          (toString [this] "layer")))
    1.49 +    
    1.50      (doto frame
    1.51        (.addWindowListener
    1.52         (proxy [java.awt.event.WindowAdapter] []
    1.53 @@ -82,20 +94,5 @@
    1.54        (.. (getContentPane) (add (make-jpanel layer)))
    1.55        (.pack)
    1.56        (.setVisible true))
    1.57 -
    1.58 -    (add-listener layer1 MouseEvent/MOUSE_ENTERED
    1.59 -                  (fn [context event] (println "1 ENTERED")))
    1.60 -    (add-listener layer1 MouseEvent/MOUSE_EXITED
    1.61 -                  (fn [context event] (println "1 EXITED")))
    1.62 -    (add-listener layer1 MouseEvent/MOUSE_MOVED
    1.63 -                  (fn [context event] (println "1 MOVED")))
    1.64 -    (add-listener layer2 MouseEvent/MOUSE_ENTERED
    1.65 -                  (fn [context event] (println "2 ENTERED")))
    1.66 -    (add-listener layer2 MouseEvent/MOUSE_EXITED
    1.67 -                  (fn [context event] (println "2 EXITED")))
    1.68 -    (add-listener layer2 MouseEvent/MOUSE_MOVED
    1.69 -                  (fn [context event] (println "2 MOVED")))
    1.70 -    (add-listener layer2 MouseEvent/MOUSE_DRAGGED
    1.71 -                  (fn [context event] (println "2 DRAGGED")))
    1.72      )
    1.73    )

     2.1 --- a/src/indyvon/event.clj	Fri Jun 18 04:39:56 2010 +0400
     2.2 +++ b/src/indyvon/event.clj	Sat Jun 19 04:27:29 2010 +0400
     2.3 @@ -9,54 +9,18 @@
     2.4    (:import (java.awt.event MouseEvent MouseListener MouseMotionListener)
     2.5             java.lang.ref.WeakReference))
     2.6  
     2.7 -;; map event-id -> [layer-weak-ref1 fn1, layer-weak-ref2 fn2...]
     2.8 -(def listeners-map (ref {}))
     2.9 -
    2.10 -(defn- assoc-conj [map key & vals]
    2.11 -  (assoc map key (apply conj (vec (get map key)) vals)))
    2.12 -
    2.13 -(defn add-listener
    2.14 -  "The supplied function will be invoked with context, event and
    2.15 -  additional args when an event with the specified id occurs on the
    2.16 -  specified layer."
    2.17 -  [layer event-id f & args]
    2.18 -  (let [f (if args #(apply f %1 %2 args) f)]
    2.19 -    (dosync
    2.20 -     (alter listeners-map assoc-conj event-id (WeakReference. layer) f))
    2.21 -    nil))
    2.22 -
    2.23 -(defn- listeners
    2.24 -  "Returns list of listener fns for event and target-layer. Listeners
    2.25 -  for garbage-collected layers are removed."
    2.26 -  [event-id target-layer]
    2.27 -  (dosync
    2.28 -   (loop [ref-vec (@listeners-map event-id) cleared-ref-vec [] listeners []]
    2.29 -     (if-let [layer-ref (first ref-vec)]
    2.30 -       (if-let [layer (.get layer-ref)]
    2.31 -         (let [lfn (second ref-vec)]
    2.32 -           (recur (nnext ref-vec)
    2.33 -                  (conj cleared-ref-vec layer-ref lfn)
    2.34 -                  (if (= layer target-layer)
    2.35 -                    (conj listeners lfn)
    2.36 -                    listeners)))
    2.37 -         (recur (nnext ref-vec) cleared-ref-vec listeners))
    2.38 -       (do
    2.39 -         (alter listeners-map assoc event-id cleared-ref-vec)
    2.40 -         listeners)))))
    2.41 -
    2.42 -(defn dispatch-event [context event]
    2.43 -  (doseq [listener (listeners (.getID event) (:layer context))]
    2.44 -    (listener context event)))
    2.45 -
    2.46  (defprotocol EventDispatcher
    2.47    (listen! [this component])
    2.48 -  (register [this context])
    2.49 +  (register-mouse-handler [this context handler])
    2.50    (commit [this])
    2.51    (hovered? [this layer])
    2.52    (picked? [this layer]))
    2.53  
    2.54 -(defn register-context [context]
    2.55 -  (register (:dispatcher context) context))
    2.56 +(defn mouse-handler [context handler & args]
    2.57 +  "The supplied handler function will be invoked with context, event
    2.58 +   and additional args when mouse event occurs on the context."
    2.59 +  (let [handler (if args #(apply handler %1 %2 args) handler)]
    2.60 +    (register-mouse-handler (:dispatcher context) context handler)))
    2.61  
    2.62  (defn- registered-parent
    2.63    "Returns first context parent registered for event processing."
    2.64 @@ -70,7 +34,7 @@
    2.65  (defn- add-context
    2.66    [context-tree context]
    2.67    (let [parent (registered-parent context-tree context)]
    2.68 -    (assoc context-tree parent (conj (context-tree parent) context)
    2.69 +    (assoc context-tree parent (cons context (context-tree parent))
    2.70             context nil)))
    2.71  
    2.72  (defn- inside?
    2.73 @@ -108,19 +72,23 @@
    2.74      (getXOnScreen [] (.getXOnScreen event))
    2.75      (getYOnScreen [] (.getYOnScreen event))))
    2.76  
    2.77 +(defn- dispatch-event [handlers context event]
    2.78 +  ((handlers context) context event))
    2.79 +
    2.80  (defn- translate-and-dispatch
    2.81 -  ([contexts event]
    2.82 -     (translate-and-dispatch contexts event (.getID event)))
    2.83 -  ([contexts event id]
    2.84 +  ([contexts handlers event]
    2.85 +     (translate-and-dispatch contexts handlers event (.getID event)))
    2.86 +  ([contexts handlers event id]
    2.87    (doseq [context contexts]
    2.88      (dispatch-event
    2.89 +     handlers
    2.90       context
    2.91       (translate-mouse-event event (:x context) (:y context) id)))))
    2.92  
    2.93  (defn- dispatch-mouse-motion*
    2.94    "Dispatches mouse motion events. Returns a new set of contexts which
    2.95    currently are under cursor."
    2.96 -  [hovered context-tree event]
    2.97 +  [hovered context-tree handlers event]
    2.98    (let [x (.getX event)
    2.99          y (.getY event)
   2.100          hovered2 (under-cursor context-tree x y)
   2.101 @@ -128,34 +96,39 @@
   2.102          exited (remove-all hovered hovered2 pred)
   2.103          entered (remove-all hovered2 hovered pred)
   2.104          moved (remove-all hovered2 entered pred)]
   2.105 -    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
   2.106 -    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
   2.107 -    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
   2.108 +    (translate-and-dispatch
   2.109 +     exited handlers event MouseEvent/MOUSE_EXITED)
   2.110 +    (translate-and-dispatch
   2.111 +     entered handlers event MouseEvent/MOUSE_ENTERED)
   2.112 +    (translate-and-dispatch
   2.113 +     moved handlers event MouseEvent/MOUSE_MOVED)
   2.114      hovered2))
   2.115  
   2.116  (defn- dispatch-mouse-motion
   2.117 -  [hovered-ref context-tree event]
   2.118 +  [hovered-ref context-tree handlers event]
   2.119    (dosync
   2.120 -   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
   2.121 +   (alter hovered-ref dispatch-mouse-motion* context-tree handlers event)))
   2.122  
   2.123  (defn- dispatch-mouse-button*
   2.124    "Dispatches mouse button events. Returns a new set of contexts which
   2.125    currently are picked with a pressed button."
   2.126 -  [picked hovered context-tree event]
   2.127 -  (translate-and-dispatch hovered event)
   2.128 +  [picked hovered handlers event]
   2.129 +  (translate-and-dispatch hovered handlers event)
   2.130    (if (= (.getID event) MouseEvent/MOUSE_PRESSED)
   2.131      hovered
   2.132      nil))
   2.133 -  
   2.134 +
   2.135  (defn- dispatch-mouse-button
   2.136 -  [picked-ref hovered-ref context-tree event]
   2.137 +  [picked-ref hovered-ref handlers event]
   2.138    (dosync
   2.139     (alter picked-ref dispatch-mouse-button*
   2.140 -          @hovered-ref context-tree event)))
   2.141 +          @hovered-ref handlers event)))
   2.142  
   2.143  (defn make-event-dispatcher []
   2.144    (let [context-tree-r (ref {}) ; register
   2.145 +        handlers-r (ref {})     ;
   2.146          context-tree (ref {})   ; dispatch
   2.147 +        handlers (ref {})       ;
   2.148          hovered (ref '())
   2.149          picked (ref '())]
   2.150      (reify
   2.151 @@ -164,27 +137,29 @@
   2.152          (doto component
   2.153            (.addMouseListener this)
   2.154            (.addMouseMotionListener this)))
   2.155 -     (register [this context]
   2.156 -        (dosync (alter context-tree-r add-context context)))
   2.157 +     (register-mouse-handler [this context handler]
   2.158 +        (dosync (alter context-tree-r add-context context)
   2.159 +                (alter handlers-r assoc context handler)))
   2.160       (commit [this]
   2.161          (dosync (ref-set context-tree @context-tree-r)
   2.162 -                (ref-set context-tree-r {})))
   2.163 +                (ref-set context-tree-r {})
   2.164 +                (ref-set handlers @handlers-r)
   2.165 +                (ref-set handlers-r {})))
   2.166       (picked? [this layer] false)
   2.167       (hovered? [this layer] false)
   2.168       MouseListener
   2.169       (mouseEntered [this event]
   2.170 -        (dispatch-mouse-motion hovered context-tree event))
   2.171 +        (dispatch-mouse-motion hovered context-tree handlers event))
   2.172       (mouseExited [this event]
   2.173 -        (dispatch-mouse-motion hovered context-tree event))
   2.174 +        (dispatch-mouse-motion hovered context-tree handlers event))
   2.175       (mouseClicked [this event]
   2.176 -        (dispatch-mouse-button picked hovered context-tree event))
   2.177 +        (dispatch-mouse-button picked hovered handlers event))
   2.178       (mousePressed [this event]
   2.179 -        (dispatch-mouse-button picked hovered context-tree event))
   2.180 +        (dispatch-mouse-button picked hovered handlers  event))
   2.181       (mouseReleased [this event]
   2.182 -        (dispatch-mouse-button picked hovered context-tree event))
   2.183 +        (dispatch-mouse-button picked hovered handlers event))
   2.184       MouseMotionListener
   2.185       (mouseDragged [this event]
   2.186 -        (translate-and-dispatch @picked event))
   2.187 +        (translate-and-dispatch @picked handlers event))
   2.188       (mouseMoved [this event]
   2.189 -        (dispatch-mouse-motion hovered context-tree event)))))
   2.190 -
   2.191 +        (dispatch-mouse-motion hovered context-tree handlers event)))))