Mercurial > hg > indyvon
changeset 22:dc81033d4122
Layers should satisfy MouseHandler protocol to recieve mouse events.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Sat, 19 Jun 2010 06:50:24 +0400 |
| parents | a70609bad3a4 |
| children | bbe95838fe77 |
| files | src/indyvon/component.clj src/indyvon/core.clj src/indyvon/event.clj |
| diffstat | 3 files changed, 98 insertions(+), 79 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/component.clj Sat Jun 19 04:27:29 2010 +0400 +++ b/src/indyvon/component.clj Sat Jun 19 06:50:24 2010 +0400 @@ -5,8 +5,8 @@ ;; (ns indyvon.component - (:use indyvon.core - indyvon.event) + (:use indyvon.core) + (:require (indyvon [event :as event])) (:import (java.awt Component Dimension Color) (java.awt.event MouseEvent) (javax.swing JFrame JPanel))) @@ -21,6 +21,7 @@ context (assoc context :font-context (.getFontRenderContext graphics) :update-fn #(.repaint component))] + (.clearRect graphics 0 0 width height) (draw! context layer graphics 0 0 width height false)) (commit (:dispatcher context))) @@ -32,7 +33,7 @@ (defn make-jpanel ([layer] - (make-jpanel layer (make-event-dispatcher))) + (make-jpanel layer (event/make-event-dispatcher))) ([layer event-dispatcher] (let [context (default-context) context (assoc context :dispatcher event-dispatcher) @@ -47,45 +48,73 @@ panel))) (comment - (do + (do (def frame (JFrame. "Test")) - (defn handler [context event] + (defn handler [event context] (println (:layer context) (.paramString event))) (def layer1 - (reify Layer + (reify + Layer (render! [this context g] - (mouse-handler context handler) (.setColor g Color/RED) (.fillRect g 0 0 (:width context) (:height context))) (size [this context] [30 20]) - (toString [this] "layer1"))) + MouseHandler + (handle-mouse [this context event] + (println "layer1" (.paramString event))))) (def layer1b (border-layer layer1 2 3)) (def layer2 - (reify Layer + (reify + Layer (render! [this context g] - (mouse-handler context handler) (.setColor g Color/YELLOW) (.fillRect g 0 0 (:width context) (:height context)) (draw! context layer1b g 10 5) (draw! context layer1 g 55 5)) (size [this context] [70 65]) - (toString [this] "layer2"))) + MouseHandler + (handle-mouse [this context event] + (println "layer2" (.paramString event))))) (def layer3 - (border-layer (text-layer "Sample\ntext" :right :bottom))) + (border-layer (text-layer "Sample\ntext" :right :center))) + + (defn fps-layer [fps] + (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5)) + + (def fps + (let [update-interval 0.1 + frames (ref 0) + last (ref 0) + fl (ref (fps-layer 0.0))] + (reify + Layer + (render! [this c g] + (draw! c @fl g) + (dosync + (alter frames + 1) + (let [time (System/currentTimeMillis) + elapsed (/ (- time @last) 1000.0)] + (when (> elapsed update-interval) + (ref-set fl (fps-layer (/ @frames elapsed))) + (ref-set frames 0) + (ref-set last time))))) + (size [this c] (size @fl c))))) (def layer (reify Layer - (render! [this context g] + (render! [this context g] + ;;(update context) + (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED])) (.drawLine g 0 0 (:width context) (:height context)) (draw! context layer2 g 15 20) - (draw! context layer3 g 100 100 80 50)) - (size [this context] [400 300]) - (toString [this] "layer"))) + (draw! context layer3 g 100 100 80 50) + (draw! context fps g)) + (size [this context] [400 300]))) (doto frame (.addWindowListener
--- a/src/indyvon/core.clj Sat Jun 19 04:27:29 2010 +0400 +++ b/src/indyvon/core.clj Sat Jun 19 06:50:24 2010 +0400 @@ -9,9 +9,21 @@ (java.awt.font FontRenderContext TextLayout))) (defprotocol Layer + "Basic UI element." (render! [this context graphics]) (size [this context])) +(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])) + (defrecord Theme [fore-color back-color border-color font]) (defn default-theme [] @@ -23,6 +35,9 @@ (defn default-context [] (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme))) +(defn update [context] + ((:update-fn context))) + (defn- make-graphics [graphics x y w h clip] (if clip (.create graphics x y w h) @@ -49,18 +64,18 @@ (draw! context layer graphics x y w h true)) ([context layer graphics x y w h clip] - (let [graphics (make-graphics graphics x y w h clip) + (let [context (assoc context + :layer layer + :parent context + :x (+ (:x context) x) + :y (+ (:y context) y) + :width w + :height h) + graphics (make-graphics graphics x y w h clip) graphics (apply-theme graphics (:theme context))] (try - (render! layer - (assoc context - :layer layer - :parent context - :x (+ (:x context) x) - :y (+ (:y context) y) - :width w - :height h) - graphics) + (register (:dispatcher context) context) + (render! layer context graphics) (finally (.dispose graphics))))))
--- a/src/indyvon/event.clj Sat Jun 19 04:27:29 2010 +0400 +++ b/src/indyvon/event.clj Sat Jun 19 06:50:24 2010 +0400 @@ -9,19 +9,6 @@ (:import (java.awt.event MouseEvent MouseListener MouseMotionListener) java.lang.ref.WeakReference)) -(defprotocol EventDispatcher - (listen! [this component]) - (register-mouse-handler [this context handler]) - (commit [this]) - (hovered? [this layer]) - (picked? [this layer])) - -(defn mouse-handler [context handler & args] - "The supplied handler function will be invoked with context, event - and additional args when mouse event occurs on the context." - (let [handler (if args #(apply handler %1 %2 args) handler)] - (register-mouse-handler (:dispatcher context) context handler))) - (defn- registered-parent "Returns first context parent registered for event processing." [context-tree context] @@ -72,23 +59,19 @@ (getXOnScreen [] (.getXOnScreen event)) (getYOnScreen [] (.getYOnScreen event)))) -(defn- dispatch-event [handlers context event] - ((handlers context) context event)) - (defn- translate-and-dispatch - ([contexts handlers event] - (translate-and-dispatch contexts handlers event (.getID event))) - ([contexts handlers event id] - (doseq [context contexts] - (dispatch-event - handlers - context - (translate-mouse-event event (:x context) (:y context) id))))) + ([contexts event] + (translate-and-dispatch contexts event (.getID event))) + ([contexts event id] + (doseq [context contexts] + (handle-mouse + (:layer context) context + (translate-mouse-event event (:x context) (:y context) id))))) (defn- dispatch-mouse-motion* "Dispatches mouse motion events. Returns a new set of contexts which currently are under cursor." - [hovered context-tree handlers event] + [hovered context-tree event] (let [x (.getX event) y (.getY event) hovered2 (under-cursor context-tree x y) @@ -96,39 +79,33 @@ exited (remove-all hovered hovered2 pred) entered (remove-all hovered2 hovered pred) moved (remove-all hovered2 entered pred)] - (translate-and-dispatch - exited handlers event MouseEvent/MOUSE_EXITED) - (translate-and-dispatch - entered handlers event MouseEvent/MOUSE_ENTERED) - (translate-and-dispatch - moved handlers event MouseEvent/MOUSE_MOVED) + (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED) + (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED) + (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED) hovered2)) (defn- dispatch-mouse-motion - [hovered-ref context-tree handlers event] + [hovered-ref context-tree event] (dosync - (alter hovered-ref dispatch-mouse-motion* context-tree handlers event))) + (alter hovered-ref dispatch-mouse-motion* context-tree event))) (defn- dispatch-mouse-button* "Dispatches mouse button events. Returns a new set of contexts which currently are picked with a pressed button." - [picked hovered handlers event] - (translate-and-dispatch hovered handlers event) + [picked hovered event] + (translate-and-dispatch hovered event) (if (= (.getID event) MouseEvent/MOUSE_PRESSED) hovered nil)) (defn- dispatch-mouse-button - [picked-ref hovered-ref handlers event] + [picked-ref hovered-ref event] (dosync - (alter picked-ref dispatch-mouse-button* - @hovered-ref handlers event))) + (alter picked-ref dispatch-mouse-button* @hovered-ref event))) (defn make-event-dispatcher [] (let [context-tree-r (ref {}) ; register - handlers-r (ref {}) ; context-tree (ref {}) ; dispatch - handlers (ref {}) ; hovered (ref '()) picked (ref '())] (reify @@ -137,29 +114,27 @@ (doto component (.addMouseListener this) (.addMouseMotionListener this))) - (register-mouse-handler [this context handler] - (dosync (alter context-tree-r add-context context) - (alter handlers-r assoc context handler))) + (register [this context] + (when (satisfies? MouseHandler (:layer context)) + (dosync (alter context-tree-r add-context context)))) (commit [this] (dosync (ref-set context-tree @context-tree-r) - (ref-set context-tree-r {}) - (ref-set handlers @handlers-r) - (ref-set handlers-r {}))) + (ref-set context-tree-r {}))) (picked? [this layer] false) (hovered? [this layer] false) MouseListener (mouseEntered [this event] - (dispatch-mouse-motion hovered context-tree handlers event)) + (dispatch-mouse-motion hovered @context-tree event)) (mouseExited [this event] - (dispatch-mouse-motion hovered context-tree handlers event)) + (dispatch-mouse-motion hovered @context-tree event)) (mouseClicked [this event] - (dispatch-mouse-button picked hovered handlers event)) + (dispatch-mouse-button picked hovered event)) (mousePressed [this event] - (dispatch-mouse-button picked hovered handlers event)) + (dispatch-mouse-button picked hovered event)) (mouseReleased [this event] - (dispatch-mouse-button picked hovered handlers event)) + (dispatch-mouse-button picked hovered event)) MouseMotionListener (mouseDragged [this event] - (translate-and-dispatch @picked handlers event)) + (translate-and-dispatch @picked event)) (mouseMoved [this event] - (dispatch-mouse-motion hovered context-tree handlers event))))) + (dispatch-mouse-motion hovered @context-tree event)))))