changeset 7:f6d10a68b01d

Find layer contexts under mouse cursor.
author Mikhail Kryshen <mikhail@kryshen.net>
date Fri, 11 Jun 2010 22:58:23 +0400
parents 5a858158cd9e
children c53ec3052ae7
files src/indyvon/core.clj
diffstat 1 files changed, 37 insertions(+), 53 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/core.clj	Fri Jun 11 04:31:27 2010 +0400
+++ b/src/indyvon/core.clj	Fri Jun 11 22:58:23 2010 +0400
@@ -8,7 +8,7 @@
   (size [this context])
   (anchor [this context]))
 
-(defrecord LayerContext [layer parent rx ry width height update-fn dispatcher])
+(defrecord LayerContext [layer parent x y width height update-fn dispatcher])
 
 (defn default-context []
   (LayerContext. nil nil 0 0 0 0 nil nil))
@@ -53,8 +53,8 @@
                   (assoc context
                     :layer layer
                     :parent context
-                    :rx (+ (:rx context) x)
-                    :ry (+ (:ry context) y)
+                    :x (+ (:x context) x)
+                    :y (+ (:y context) y)
                     :width w
                     :height h)
                   graphics)
@@ -73,7 +73,9 @@
 
 (defprotocol EventDispatcher
   (register [this context])
-  (commit [this]))
+  (commit [this])
+  (hovered? [this layer])
+  (picked? [this layer]))
 
 (defn- assoc-conj [vmap key val]
   "Add val to the sequence associated with key in vmap."
@@ -88,6 +90,25 @@
      (contains? context-tree parent) parent
      :default (recur context-tree parent))))
 
+(defn- inside?
+  ([x y context]
+     (inside? x y (:x context) (:y context)
+              (:width context) (:height context)))
+  ([px py x y w h]
+     (and (>= px x)
+          (>= py y)
+          (< px (+ x w))
+          (< py (+ y h)))))
+
+(defn- under-cursor
+  "Returns a sequence of contexts under cursor."
+  ([context-tree x y]
+     (under-cursor context-tree x y nil))
+  ([context-tree x y context]
+     (some #(if (inside? x y %)
+              (conj (under-cursor context-tree x y %) %))
+           (context-tree context))))
+
 (defn make-event-dispatcher []
   (let [context-tree-r (ref {}) ; register
         context-tree (ref {})   ; dispatch
@@ -101,37 +122,18 @@
                        (registered-parent context) context)))
      (commit [this]
              (dosync (ref-set context-tree @context-tree-r)
-                     (ref-set context-tree-r {}))))))
-
-;; (defn make-event-dispatcher []
-;;   (let [contexts-r (ref []) ; register
-;;         contexts (ref [])   ; dispatch
-;;         hovered (ref [])
-;;         picked (ref [])]
-;;     (reify
-;;      EventDispatcher
-;;      (register [this layer]
-;;                (dosync
-;;                 (alter contexts-r conj
-;;                        (LayerContext. layer *rx* *ry*
-;;                                       *width* *height*
-;;                                       *update-fn*))))
-;;      (commit [this]
-;;              (dosync (ref-set contexts @contexts-r)
-;;                      (ref-set contexts-r [])))
-;;      (dispatch [this event]
-;;                (println "dispatch" this event)
-;;                ;; TODO
-;;                )
-;;      MouseListener
-;;      (mouseClicked [this event])
-;;      (mouseEntered [this event])
-;;      (mouseExited [this event])
-;;      (mousePressed [this event])
-;;      (mouseReleased [this event])
-;;      MouseMotionListener
-;;      (mouseDragged [this event])
-;;      (mouseMoved [this event]))))
+                     (ref-set context-tree-r {})))
+     (picked? [this layer] false)
+     (hovered? [this layer] false)
+     MouseListener
+     (mouseClicked [this event])
+     (mouseEntered [this event])
+     (mouseExited [this event])
+     (mousePressed [this event])
+     (mouseReleased [this event])
+     MouseMotionListener
+     (mouseDragged [this event])
+     (mouseMoved [this event]))))
 
 ;;
 ;; Connection to AWT.
@@ -140,24 +142,6 @@
 (defn- make-update-fn [component]
   (fn [] (.repaint component)))
 
-;; (defn make-component [layer]
-;;   (proxy [Component] []
-;;     (update [g] (.paint this g))
-;;     (paint [g]
-;;            (let [insets (.getInsets this)
-;;                  top (.top insets)
-;;                  left (.left insets)
-;;                  bottom (.bottom insets)
-;;                  right (.right insets)
-;;                  size (.getSize this)
-;;                  width (- (.width size) left right)
-;;                  height (- (.height size) top bottom)]
-;;              (binding [*graphics* g
-;;                        *update-fn* (make-update-fn this)]
-;;                (render-layer! layer top left width height false))))
-;;     (getPreferredSize []
-;;                       (size layer))))
-
 (defn make-component
   ([layer]
      (make-component layer (make-event-dispatcher)))