Mercurial > hg > indyvon
changeset 29:4cb70c5a6e0d
Event handlers are registered using listen macro instead of implementing a protocol.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Tue, 06 Jul 2010 06:05:28 +0400 |
| parents | 1237f7555029 |
| children | a8821f4b5ade |
| files | src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj |
| diffstat | 3 files changed, 133 insertions(+), 111 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/component.clj Mon Jun 21 04:00:45 2010 +0400 +++ b/src/indyvon/component.clj Tue Jul 06 06:05:28 2010 +0400 @@ -6,7 +6,8 @@ (ns indyvon.component (:use indyvon.core indyvon.layers) - (:import (java.awt Component Dimension Color) + (:import (indyvon.core Size Location) + (java.awt Component Dimension Color) (javax.swing JFrame JPanel))) (defn- font-context [component] @@ -29,7 +30,7 @@ :target component :font-context (font-context component)) s (size layer context)] - (Dimension. (s 0) (s 1)))) + (Dimension. (:width s) (:height s)))) (defn make-jpanel ([layer] @@ -57,10 +58,7 @@ (render! [this context g] (.setColor g Color/RED) (.fillRect g 0 0 (:width context) (:height context))) - (size [this context] [30 20]) - MouseHandler - (handle-mouse [this context event] - (println "layer1" event)))) + (size [this context] (Size. 30 20)))) (def layer1b (border-layer layer1 2 3)) @@ -72,10 +70,7 @@ (.fillRect g 0 0 (:width context) (:height context)) (draw! layer1b context g 10 5) (draw! layer1 context g 55 5)) - (size [this context] [70 65]) - MouseHandler - (handle-mouse [this context event] - (println "layer2" event)))) + (size [this context] (Size. 70 65)))) (def layer3 (border-layer (text-layer "Sample\ntext" :right :center))) @@ -111,7 +106,7 @@ (draw! layer2 context g 15 20) (draw! layer3 context g 100 100 80 50) (draw! fps context g)) - (size [this context] [400 300]))) + (size [this context] (Size. 400 300)))) (doto frame (.addWindowListener
--- a/src/indyvon/core.clj Mon Jun 21 04:00:45 2010 +0400 +++ b/src/indyvon/core.clj Tue Jul 06 06:05:28 2010 +0400 @@ -13,19 +13,16 @@ (render! [this context graphics]) (size [this context])) +(defrecord Location [x y]) +(defrecord Size [width height]) + ;; TODO: modifiers (defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) -(defprotocol MouseHandler - "Layers that also satisfy this protocol will recieve mouse events." - (handle-mouse [this context event])) - (defprotocol EventDispatcher (listen! [this component]) - (register [this context]) - (commit [this]) - (hovered? [this layer]) - (picked? [this layer])) + (register [this context handlers]) + (commit [this])) (defprotocol Anchored "Provide anchor point for Layers. Used by viewport." @@ -39,16 +36,17 @@ (anchor [this context h-align v-align] (if (and (= h-align :left) (= v-align :top)) - [0 0] + (Location. 0 0) (let [size (size this context)] - [(case h-align - :top 0 - :center (/ (size 0) 2) - :right (size 0)) + (Location. + (case h-align + :top 0 + :center (/ (:width size) 2) + :right (:width size)) (case v-align - :left 0 - :center (/ (size 1) 2) - :bottom (size 1))])))) + :left 0 + :center (/ (:height size) 2) + :bottom (:height size))))))) (defrecord Theme [fore-color back-color border-color font]) @@ -85,7 +83,7 @@ ([layer context graphics x y clip] (let [s (size layer context)] (draw! layer context graphics - x y (s 0) (s 1) clip))) + x y (:width s) (:height s) clip))) ([layer context graphics x y w h] (draw! layer context graphics x y w h true)) @@ -100,11 +98,23 @@ graphics (make-graphics graphics x y w h clip) graphics (apply-theme graphics (:theme context))] (try - (register (:dispatcher context) context) (render! layer context graphics) (finally (.dispose graphics)))))) +(defn listen* [context & handlers] + (register (:dispatcher context) context (apply array-map handlers))) + +;; (listen context +;; (:mouse-entered e (println e)) +;; (:mouse-exited e (println e))) +(defmacro listen [context & specs] + `(register (:dispatcher ~context) ~context + ~(reduce #(assoc %1 + (first %2) + `(fn [~(second %2)] ~@(nnext %2))) + {} specs))) + ;; ;; EventDispatcher implementation ;; @@ -118,25 +128,38 @@ java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) +(defrecord DispatcherNode [layer x y width height handlers children]) + +(defrecord DispatcherRootNode [children]) + +(defn- make-node [c handlers] + (DispatcherNode. (:layer c) (:x c) (:y c) (:width c) (:height c) + handlers nil)) + +(defn- add-child [node child] + (assoc node :children (cons child (:children node)))) + (defn- registered-parent "Returns first context parent registered for event processing." - [context-tree context] + [tree context] (let [parent (:parent context)] (cond (nil? parent) nil - (contains? context-tree parent) parent - :default (recur context-tree parent)))) + (contains? tree parent) parent + :default (recur tree parent)))) (defn- add-context - [context-tree context] - (let [parent (registered-parent context-tree context)] - (assoc context-tree parent (cons context (context-tree parent)) - context nil))) + [tree context handlers] + (let [parent (registered-parent tree context) + node (make-node context handlers)] + (assoc tree + parent (add-child (tree parent) node) + context node))) (defn- inside? - ([x y context] - (inside? x y (:x context) (:y context) - (:width context) (:height context))) + ([x y node] + (inside? x y (:x node) (:y node) + (:width node) (:height node))) ([px py x y w h] (and (>= px x) (>= py y) @@ -144,30 +167,15 @@ (< 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)))) + "Returns a sequence of child nodes under cursor." + [x y node] + (some #(if (inside? x y %) + (conj (under-cursor x y %) %)) + (:children node))) (defn- remove-all [coll1 coll2 pred] (filter #(not (some (partial pred %) coll2)) coll1)) -;; (defn- translate-mouse-event -;; [event x y id] -;; (proxy [MouseEvent] [(.getComponent event) -;; id -;; (.getWhen event) -;; (.getModifiers event) -;; (- (.getX event) x) -;; (- (.getY event) y) -;; (.getClickCount event) -;; (.isPopupTrigger event)] -;; (getXOnScreen [] (.getXOnScreen event)) -;; (getYOnScreen [] (.getYOnScreen event)))) - (defn- translate-mouse-event [event x y id] (MouseEvent. id (.getWhen event) @@ -176,22 +184,22 @@ (.getButton event))) (defn- translate-and-dispatch - ([contexts event] - (translate-and-dispatch contexts event (awt-events (.getID event)))) - ([contexts event id] - (doseq [context contexts] - (handle-mouse - (:layer context) context - (translate-mouse-event event (:x context) (:y context) id))) + ([nodes event] + (translate-and-dispatch nodes event (awt-events (.getID event)))) + ([nodes event id] + (doseq [node nodes] + (when-let [handler (get (:handlers node) id)] + (handler + (translate-mouse-event event (:x node) (:y node) id)))) id)) (defn- dispatch-mouse-motion* - "Dispatches mouse motion events. Returns a new set of contexts which + "Dispatches mouse motion events. Returns a new set of nodes which currently are under cursor." - [hovered context-tree event] + [hovered tree event] (let [x (.getX event) y (.getY event) - hovered2 (under-cursor context-tree x y) + hovered2 (under-cursor x y (get tree nil)) pred #(= (:layer %1) (:layer %2)) exited (remove-all hovered hovered2 pred) entered (remove-all hovered2 hovered pred) @@ -202,12 +210,12 @@ hovered2)) (defn- dispatch-mouse-motion - [hovered-ref context-tree event] + [hovered-ref tree event] (dosync - (alter hovered-ref dispatch-mouse-motion* context-tree event))) + (alter hovered-ref dispatch-mouse-motion* tree event))) (defn- dispatch-mouse-button* - "Dispatches mouse button events. Returns a new set of contexts which + "Dispatches mouse button events. Returns a new set of nodes which currently are picked with a pressed button." [picked hovered event] (if (= (translate-and-dispatch hovered event) :mouse-pressed) @@ -220,8 +228,9 @@ (alter picked-ref dispatch-mouse-button* @hovered-ref event))) (defn make-event-dispatcher [] - (let [context-tree-r (ref {}) ; register - context-tree (ref {}) ; dispatch + (let [tree-i {nil (DispatcherRootNode. nil)} ; initial + tree-r (ref tree-i) ; register + tree (ref tree-i) ; dispatch hovered (ref '()) picked (ref '())] (reify @@ -230,19 +239,16 @@ (doto component (.addMouseListener this) (.addMouseMotionListener this))) - (register [this context] - (when (satisfies? MouseHandler (:layer context)) - (dosync (alter context-tree-r add-context context)))) + (register [this context handlers] + (dosync (alter tree-r add-context context handlers))) (commit [this] - (dosync (ref-set context-tree @context-tree-r) - (ref-set context-tree-r {}))) - (picked? [this layer] false) - (hovered? [this layer] false) + (dosync (ref-set tree @tree-r) + (ref-set tree-r tree-i))) MouseListener (mouseEntered [this event] - (dispatch-mouse-motion hovered @context-tree event)) + (dispatch-mouse-motion hovered @tree event)) (mouseExited [this event] - (dispatch-mouse-motion hovered @context-tree event)) + (dispatch-mouse-motion hovered @tree event)) (mouseClicked [this event] (dispatch-mouse-button picked hovered event)) (mousePressed [this event] @@ -253,4 +259,29 @@ (mouseDragged [this event] (translate-and-dispatch @picked event)) (mouseMoved [this event] - (dispatch-mouse-motion hovered @context-tree event))))) + (dispatch-mouse-motion hovered @tree event))))) + +;; +;; ИДЕИ: +;; +;; Контекст: биндинги или запись? +;; +;; Установка обработчиков (в контексте слоя): +;; +;; (listen +;; (:mouse-entered e +;; ...) +;; (:mouse-exited e +;; ...)) +;; +;; Не надо IMGUI. +;; Построение сцены путем декорирования слоев: +;; +;; (listener +;; (:action e (println e)) +;; (:mouse-dragged e (println e)) +;; (theme :font "Helvetica-14" +;; (vbox +;; (button (text-layer "Button 1")) +;; (button (text-layer "Button 2"))))) +;;
--- a/src/indyvon/layers.clj Mon Jun 21 04:00:45 2010 +0400 +++ b/src/indyvon/layers.clj Tue Jul 06 06:05:28 2010 +0400 @@ -6,7 +6,8 @@ (ns indyvon.layers (:use indyvon.core) - (:import (java.awt Cursor) + (:import (indyvon.core Size Location) + (java.awt Cursor) (java.awt.font FontRenderContext TextLayout))) ;; Define as macro to avoid unnecessary calculation of inner and outer @@ -42,8 +43,8 @@ (- h offset offset)))) (size [l c] (let [s (size content c)] - [(+ (s 0) offset offset) - (+ (s 1) offset offset)])))))) + (Size. (+ (:width s) offset offset) + (+ (:height s) offset offset)))))))) (defn- re-split [re s] (seq (.split re s))) @@ -85,7 +86,7 @@ (:font-context c)) width (text-width layouts) height (text-height layouts)] - [width height])))))) + (Size. width height))))))) (defn viewport "Creates scrollable viewport layer." @@ -100,6 +101,21 @@ (reify Layer (render! [layer c g] + (listen c + (:mouse-pressed e + (dosync + (ref-set fix-x (:x-on-screen e)) + (ref-set fix-y (:y-on-screen e))) + (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c)))) + (:mouse-released e + (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))) + (:mouse-dragged e + (dosync + (alter x + (- @fix-x (:x-on-screen e))) + (alter y + (- @fix-y (:y-on-screen e))) + (ref-set fix-x (:x-on-screen e)) + (ref-set fix-y (:y-on-screen e))) + (update c))) (let [anchor (anchor content c h-align v-align) width (:width c) height (:height c)] @@ -109,26 +125,6 @@ (ref-set last-width width) (ref-set last-height height)) (draw! content c g - (- 0 @x (anchor 0)) - (- 0 @y (anchor 1))))) - (size [layer c] (size content c)) - MouseHandler - (handle-mouse [layer c e] - (case (:id e) - :mouse-pressed - (do - (dosync - (ref-set fix-x (:x-on-screen e)) - (ref-set fix-y (:y-on-screen e))) - (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c)))) - :mouse-released - (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))) - :mouse-dragged - (do - (dosync - (alter x + (- @fix-x (:x-on-screen e))) - (alter y + (- @fix-y (:y-on-screen e))) - (ref-set fix-x (:x-on-screen e)) - (ref-set fix-y (:y-on-screen e))) - (update c)) - nil)))))) + (- 0 @x (:x anchor)) + (- 0 @y (:y anchor))))) + (size [layer c] (size content c))))))