Mercurial > hg > indyvon
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)))