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 diff
1.1 --- a/src/indyvon/component.clj Sat Jun 19 04:27:29 2010 +0400 1.2 +++ b/src/indyvon/component.clj Sat Jun 19 06:50:24 2010 +0400 1.3 @@ -5,8 +5,8 @@ 1.4 ;; 1.5 1.6 (ns indyvon.component 1.7 - (:use indyvon.core 1.8 - indyvon.event) 1.9 + (:use indyvon.core) 1.10 + (:require (indyvon [event :as event])) 1.11 (:import (java.awt Component Dimension Color) 1.12 (java.awt.event MouseEvent) 1.13 (javax.swing JFrame JPanel))) 1.14 @@ -21,6 +21,7 @@ 1.15 context (assoc context 1.16 :font-context (.getFontRenderContext graphics) 1.17 :update-fn #(.repaint component))] 1.18 + (.clearRect graphics 0 0 width height) 1.19 (draw! context layer graphics 0 0 width height false)) 1.20 (commit (:dispatcher context))) 1.21 1.22 @@ -32,7 +33,7 @@ 1.23 1.24 (defn make-jpanel 1.25 ([layer] 1.26 - (make-jpanel layer (make-event-dispatcher))) 1.27 + (make-jpanel layer (event/make-event-dispatcher))) 1.28 ([layer event-dispatcher] 1.29 (let [context (default-context) 1.30 context (assoc context :dispatcher event-dispatcher) 1.31 @@ -47,45 +48,73 @@ 1.32 panel))) 1.33 1.34 (comment 1.35 - (do 1.36 + (do 1.37 (def frame (JFrame. "Test")) 1.38 1.39 - (defn handler [context event] 1.40 + (defn handler [event context] 1.41 (println (:layer context) (.paramString event))) 1.42 1.43 (def layer1 1.44 - (reify Layer 1.45 + (reify 1.46 + Layer 1.47 (render! [this context g] 1.48 - (mouse-handler context handler) 1.49 (.setColor g Color/RED) 1.50 (.fillRect g 0 0 (:width context) (:height context))) 1.51 (size [this context] [30 20]) 1.52 - (toString [this] "layer1"))) 1.53 + MouseHandler 1.54 + (handle-mouse [this context event] 1.55 + (println "layer1" (.paramString event))))) 1.56 1.57 (def layer1b (border-layer layer1 2 3)) 1.58 1.59 (def layer2 1.60 - (reify Layer 1.61 + (reify 1.62 + Layer 1.63 (render! [this context g] 1.64 - (mouse-handler context handler) 1.65 (.setColor g Color/YELLOW) 1.66 (.fillRect g 0 0 (:width context) (:height context)) 1.67 (draw! context layer1b g 10 5) 1.68 (draw! context layer1 g 55 5)) 1.69 (size [this context] [70 65]) 1.70 - (toString [this] "layer2"))) 1.71 + MouseHandler 1.72 + (handle-mouse [this context event] 1.73 + (println "layer2" (.paramString event))))) 1.74 1.75 (def layer3 1.76 - (border-layer (text-layer "Sample\ntext" :right :bottom))) 1.77 + (border-layer (text-layer "Sample\ntext" :right :center))) 1.78 + 1.79 + (defn fps-layer [fps] 1.80 + (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5)) 1.81 + 1.82 + (def fps 1.83 + (let [update-interval 0.1 1.84 + frames (ref 0) 1.85 + last (ref 0) 1.86 + fl (ref (fps-layer 0.0))] 1.87 + (reify 1.88 + Layer 1.89 + (render! [this c g] 1.90 + (draw! c @fl g) 1.91 + (dosync 1.92 + (alter frames + 1) 1.93 + (let [time (System/currentTimeMillis) 1.94 + elapsed (/ (- time @last) 1000.0)] 1.95 + (when (> elapsed update-interval) 1.96 + (ref-set fl (fps-layer (/ @frames elapsed))) 1.97 + (ref-set frames 0) 1.98 + (ref-set last time))))) 1.99 + (size [this c] (size @fl c))))) 1.100 1.101 (def layer 1.102 (reify Layer 1.103 - (render! [this context g] 1.104 + (render! [this context g] 1.105 + ;;(update context) 1.106 + (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED])) 1.107 (.drawLine g 0 0 (:width context) (:height context)) 1.108 (draw! context layer2 g 15 20) 1.109 - (draw! context layer3 g 100 100 80 50)) 1.110 - (size [this context] [400 300]) 1.111 - (toString [this] "layer"))) 1.112 + (draw! context layer3 g 100 100 80 50) 1.113 + (draw! context fps g)) 1.114 + (size [this context] [400 300]))) 1.115 1.116 (doto frame 1.117 (.addWindowListener
2.1 --- a/src/indyvon/core.clj Sat Jun 19 04:27:29 2010 +0400 2.2 +++ b/src/indyvon/core.clj Sat Jun 19 06:50:24 2010 +0400 2.3 @@ -9,9 +9,21 @@ 2.4 (java.awt.font FontRenderContext TextLayout))) 2.5 2.6 (defprotocol Layer 2.7 + "Basic UI element." 2.8 (render! [this context graphics]) 2.9 (size [this context])) 2.10 2.11 +(defprotocol MouseHandler 2.12 + "Layers that also satisfy this protocol will recieve mouse events." 2.13 + (handle-mouse [this context event])) 2.14 + 2.15 +(defprotocol EventDispatcher 2.16 + (listen! [this component]) 2.17 + (register [this context]) 2.18 + (commit [this]) 2.19 + (hovered? [this layer]) 2.20 + (picked? [this layer])) 2.21 + 2.22 (defrecord Theme [fore-color back-color border-color font]) 2.23 2.24 (defn default-theme [] 2.25 @@ -23,6 +35,9 @@ 2.26 (defn default-context [] 2.27 (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme))) 2.28 2.29 +(defn update [context] 2.30 + ((:update-fn context))) 2.31 + 2.32 (defn- make-graphics [graphics x y w h clip] 2.33 (if clip 2.34 (.create graphics x y w h) 2.35 @@ -49,18 +64,18 @@ 2.36 (draw! context layer graphics 2.37 x y w h true)) 2.38 ([context layer graphics x y w h clip] 2.39 - (let [graphics (make-graphics graphics x y w h clip) 2.40 + (let [context (assoc context 2.41 + :layer layer 2.42 + :parent context 2.43 + :x (+ (:x context) x) 2.44 + :y (+ (:y context) y) 2.45 + :width w 2.46 + :height h) 2.47 + graphics (make-graphics graphics x y w h clip) 2.48 graphics (apply-theme graphics (:theme context))] 2.49 (try 2.50 - (render! layer 2.51 - (assoc context 2.52 - :layer layer 2.53 - :parent context 2.54 - :x (+ (:x context) x) 2.55 - :y (+ (:y context) y) 2.56 - :width w 2.57 - :height h) 2.58 - graphics) 2.59 + (register (:dispatcher context) context) 2.60 + (render! layer context graphics) 2.61 (finally 2.62 (.dispose graphics)))))) 2.63
3.1 --- a/src/indyvon/event.clj Sat Jun 19 04:27:29 2010 +0400 3.2 +++ b/src/indyvon/event.clj Sat Jun 19 06:50:24 2010 +0400 3.3 @@ -9,19 +9,6 @@ 3.4 (:import (java.awt.event MouseEvent MouseListener MouseMotionListener) 3.5 java.lang.ref.WeakReference)) 3.6 3.7 -(defprotocol EventDispatcher 3.8 - (listen! [this component]) 3.9 - (register-mouse-handler [this context handler]) 3.10 - (commit [this]) 3.11 - (hovered? [this layer]) 3.12 - (picked? [this layer])) 3.13 - 3.14 -(defn mouse-handler [context handler & args] 3.15 - "The supplied handler function will be invoked with context, event 3.16 - and additional args when mouse event occurs on the context." 3.17 - (let [handler (if args #(apply handler %1 %2 args) handler)] 3.18 - (register-mouse-handler (:dispatcher context) context handler))) 3.19 - 3.20 (defn- registered-parent 3.21 "Returns first context parent registered for event processing." 3.22 [context-tree context] 3.23 @@ -72,23 +59,19 @@ 3.24 (getXOnScreen [] (.getXOnScreen event)) 3.25 (getYOnScreen [] (.getYOnScreen event)))) 3.26 3.27 -(defn- dispatch-event [handlers context event] 3.28 - ((handlers context) context event)) 3.29 - 3.30 (defn- translate-and-dispatch 3.31 - ([contexts handlers event] 3.32 - (translate-and-dispatch contexts handlers event (.getID event))) 3.33 - ([contexts handlers event id] 3.34 - (doseq [context contexts] 3.35 - (dispatch-event 3.36 - handlers 3.37 - context 3.38 - (translate-mouse-event event (:x context) (:y context) id))))) 3.39 + ([contexts event] 3.40 + (translate-and-dispatch contexts event (.getID event))) 3.41 + ([contexts event id] 3.42 + (doseq [context contexts] 3.43 + (handle-mouse 3.44 + (:layer context) context 3.45 + (translate-mouse-event event (:x context) (:y context) id))))) 3.46 3.47 (defn- dispatch-mouse-motion* 3.48 "Dispatches mouse motion events. Returns a new set of contexts which 3.49 currently are under cursor." 3.50 - [hovered context-tree handlers event] 3.51 + [hovered context-tree event] 3.52 (let [x (.getX event) 3.53 y (.getY event) 3.54 hovered2 (under-cursor context-tree x y) 3.55 @@ -96,39 +79,33 @@ 3.56 exited (remove-all hovered hovered2 pred) 3.57 entered (remove-all hovered2 hovered pred) 3.58 moved (remove-all hovered2 entered pred)] 3.59 - (translate-and-dispatch 3.60 - exited handlers event MouseEvent/MOUSE_EXITED) 3.61 - (translate-and-dispatch 3.62 - entered handlers event MouseEvent/MOUSE_ENTERED) 3.63 - (translate-and-dispatch 3.64 - moved handlers event MouseEvent/MOUSE_MOVED) 3.65 + (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED) 3.66 + (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED) 3.67 + (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED) 3.68 hovered2)) 3.69 3.70 (defn- dispatch-mouse-motion 3.71 - [hovered-ref context-tree handlers event] 3.72 + [hovered-ref context-tree event] 3.73 (dosync 3.74 - (alter hovered-ref dispatch-mouse-motion* context-tree handlers event))) 3.75 + (alter hovered-ref dispatch-mouse-motion* context-tree event))) 3.76 3.77 (defn- dispatch-mouse-button* 3.78 "Dispatches mouse button events. Returns a new set of contexts which 3.79 currently are picked with a pressed button." 3.80 - [picked hovered handlers event] 3.81 - (translate-and-dispatch hovered handlers event) 3.82 + [picked hovered event] 3.83 + (translate-and-dispatch hovered event) 3.84 (if (= (.getID event) MouseEvent/MOUSE_PRESSED) 3.85 hovered 3.86 nil)) 3.87 3.88 (defn- dispatch-mouse-button 3.89 - [picked-ref hovered-ref handlers event] 3.90 + [picked-ref hovered-ref event] 3.91 (dosync 3.92 - (alter picked-ref dispatch-mouse-button* 3.93 - @hovered-ref handlers event))) 3.94 + (alter picked-ref dispatch-mouse-button* @hovered-ref event))) 3.95 3.96 (defn make-event-dispatcher [] 3.97 (let [context-tree-r (ref {}) ; register 3.98 - handlers-r (ref {}) ; 3.99 context-tree (ref {}) ; dispatch 3.100 - handlers (ref {}) ; 3.101 hovered (ref '()) 3.102 picked (ref '())] 3.103 (reify 3.104 @@ -137,29 +114,27 @@ 3.105 (doto component 3.106 (.addMouseListener this) 3.107 (.addMouseMotionListener this))) 3.108 - (register-mouse-handler [this context handler] 3.109 - (dosync (alter context-tree-r add-context context) 3.110 - (alter handlers-r assoc context handler))) 3.111 + (register [this context] 3.112 + (when (satisfies? MouseHandler (:layer context)) 3.113 + (dosync (alter context-tree-r add-context context)))) 3.114 (commit [this] 3.115 (dosync (ref-set context-tree @context-tree-r) 3.116 - (ref-set context-tree-r {}) 3.117 - (ref-set handlers @handlers-r) 3.118 - (ref-set handlers-r {}))) 3.119 + (ref-set context-tree-r {}))) 3.120 (picked? [this layer] false) 3.121 (hovered? [this layer] false) 3.122 MouseListener 3.123 (mouseEntered [this event] 3.124 - (dispatch-mouse-motion hovered context-tree handlers event)) 3.125 + (dispatch-mouse-motion hovered @context-tree event)) 3.126 (mouseExited [this event] 3.127 - (dispatch-mouse-motion hovered context-tree handlers event)) 3.128 + (dispatch-mouse-motion hovered @context-tree event)) 3.129 (mouseClicked [this event] 3.130 - (dispatch-mouse-button picked hovered handlers event)) 3.131 + (dispatch-mouse-button picked hovered event)) 3.132 (mousePressed [this event] 3.133 - (dispatch-mouse-button picked hovered handlers event)) 3.134 + (dispatch-mouse-button picked hovered event)) 3.135 (mouseReleased [this event] 3.136 - (dispatch-mouse-button picked hovered handlers event)) 3.137 + (dispatch-mouse-button picked hovered event)) 3.138 MouseMotionListener 3.139 (mouseDragged [this event] 3.140 - (translate-and-dispatch @picked handlers event)) 3.141 + (translate-and-dispatch @picked event)) 3.142 (mouseMoved [this event] 3.143 - (dispatch-mouse-motion hovered context-tree handlers event))))) 3.144 + (dispatch-mouse-motion hovered @context-tree event)))))