1.1 --- a/src/indyvon/core.clj	Fri Jun 11 04:31:27 2010 +0400
     1.2 +++ b/src/indyvon/core.clj	Fri Jun 11 22:58:23 2010 +0400
     1.3 @@ -8,7 +8,7 @@
     1.4    (size [this context])
     1.5    (anchor [this context]))
     1.6  
     1.7 -(defrecord LayerContext [layer parent rx ry width height update-fn dispatcher])
     1.8 +(defrecord LayerContext [layer parent x y width height update-fn dispatcher])
     1.9  
    1.10  (defn default-context []
    1.11    (LayerContext. nil nil 0 0 0 0 nil nil))
    1.12 @@ -53,8 +53,8 @@
    1.13                    (assoc context
    1.14                      :layer layer
    1.15                      :parent context
    1.16 -                    :rx (+ (:rx context) x)
    1.17 -                    :ry (+ (:ry context) y)
    1.18 +                    :x (+ (:x context) x)
    1.19 +                    :y (+ (:y context) y)
    1.20                      :width w
    1.21                      :height h)
    1.22                    graphics)
    1.23 @@ -73,7 +73,9 @@
    1.24  
    1.25  (defprotocol EventDispatcher
    1.26    (register [this context])
    1.27 -  (commit [this]))
    1.28 +  (commit [this])
    1.29 +  (hovered? [this layer])
    1.30 +  (picked? [this layer]))
    1.31  
    1.32  (defn- assoc-conj [vmap key val]
    1.33    "Add val to the sequence associated with key in vmap."
    1.34 @@ -88,6 +90,25 @@
    1.35       (contains? context-tree parent) parent
    1.36       :default (recur context-tree parent))))
    1.37  
    1.38 +(defn- inside?
    1.39 +  ([x y context]
    1.40 +     (inside? x y (:x context) (:y context)
    1.41 +              (:width context) (:height context)))
    1.42 +  ([px py x y w h]
    1.43 +     (and (>= px x)
    1.44 +          (>= py y)
    1.45 +          (< px (+ x w))
    1.46 +          (< py (+ y h)))))
    1.47 +
    1.48 +(defn- under-cursor
    1.49 +  "Returns a sequence of contexts under cursor."
    1.50 +  ([context-tree x y]
    1.51 +     (under-cursor context-tree x y nil))
    1.52 +  ([context-tree x y context]
    1.53 +     (some #(if (inside? x y %)
    1.54 +              (conj (under-cursor context-tree x y %) %))
    1.55 +           (context-tree context))))
    1.56 +
    1.57  (defn make-event-dispatcher []
    1.58    (let [context-tree-r (ref {}) ; register
    1.59          context-tree (ref {})   ; dispatch
    1.60 @@ -101,37 +122,18 @@
    1.61                         (registered-parent context) context)))
    1.62       (commit [this]
    1.63               (dosync (ref-set context-tree @context-tree-r)
    1.64 -                     (ref-set context-tree-r {}))))))
    1.65 -
    1.66 -;; (defn make-event-dispatcher []
    1.67 -;;   (let [contexts-r (ref []) ; register
    1.68 -;;         contexts (ref [])   ; dispatch
    1.69 -;;         hovered (ref [])
    1.70 -;;         picked (ref [])]
    1.71 -;;     (reify
    1.72 -;;      EventDispatcher
    1.73 -;;      (register [this layer]
    1.74 -;;                (dosync
    1.75 -;;                 (alter contexts-r conj
    1.76 -;;                        (LayerContext. layer *rx* *ry*
    1.77 -;;                                       *width* *height*
    1.78 -;;                                       *update-fn*))))
    1.79 -;;      (commit [this]
    1.80 -;;              (dosync (ref-set contexts @contexts-r)
    1.81 -;;                      (ref-set contexts-r [])))
    1.82 -;;      (dispatch [this event]
    1.83 -;;                (println "dispatch" this event)
    1.84 -;;                ;; TODO
    1.85 -;;                )
    1.86 -;;      MouseListener
    1.87 -;;      (mouseClicked [this event])
    1.88 -;;      (mouseEntered [this event])
    1.89 -;;      (mouseExited [this event])
    1.90 -;;      (mousePressed [this event])
    1.91 -;;      (mouseReleased [this event])
    1.92 -;;      MouseMotionListener
    1.93 -;;      (mouseDragged [this event])
    1.94 -;;      (mouseMoved [this event]))))
    1.95 +                     (ref-set context-tree-r {})))
    1.96 +     (picked? [this layer] false)
    1.97 +     (hovered? [this layer] false)
    1.98 +     MouseListener
    1.99 +     (mouseClicked [this event])
   1.100 +     (mouseEntered [this event])
   1.101 +     (mouseExited [this event])
   1.102 +     (mousePressed [this event])
   1.103 +     (mouseReleased [this event])
   1.104 +     MouseMotionListener
   1.105 +     (mouseDragged [this event])
   1.106 +     (mouseMoved [this event]))))
   1.107  
   1.108  ;;
   1.109  ;; Connection to AWT.
   1.110 @@ -140,24 +142,6 @@
   1.111  (defn- make-update-fn [component]
   1.112    (fn [] (.repaint component)))
   1.113  
   1.114 -;; (defn make-component [layer]
   1.115 -;;   (proxy [Component] []
   1.116 -;;     (update [g] (.paint this g))
   1.117 -;;     (paint [g]
   1.118 -;;            (let [insets (.getInsets this)
   1.119 -;;                  top (.top insets)
   1.120 -;;                  left (.left insets)
   1.121 -;;                  bottom (.bottom insets)
   1.122 -;;                  right (.right insets)
   1.123 -;;                  size (.getSize this)
   1.124 -;;                  width (- (.width size) left right)
   1.125 -;;                  height (- (.height size) top bottom)]
   1.126 -;;              (binding [*graphics* g
   1.127 -;;                        *update-fn* (make-update-fn this)]
   1.128 -;;                (render-layer! layer top left width height false))))
   1.129 -;;     (getPreferredSize []
   1.130 -;;                       (size layer))))
   1.131 -
   1.132  (defn make-component
   1.133    ([layer]
   1.134       (make-component layer (make-event-dispatcher)))