Mercurial > hg > indyvon
changeset 33:439f6ecee119
Include graphics into context.
Event dispatcher respects clipping.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Wed, 07 Jul 2010 07:17:08 +0400 |
| parents | 0b3757d263db |
| children | 6975b9a71eec |
| files | src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj |
| diffstat | 3 files changed, 111 insertions(+), 82 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/component.clj Wed Jul 07 05:57:49 2010 +0400 +++ b/src/indyvon/component.clj Wed Jul 07 07:17:08 2010 +0400 @@ -19,11 +19,17 @@ width (.width size) height (.height size) context (assoc context + :x 0 + :y 0 + :width width + :height height + :clip (indyvon.core.Bounds. 0 0 width height) :target component + :graphics graphics :font-context (.getFontRenderContext graphics) :update-fn #(.repaint component))] (.clearRect graphics 0 0 width height) - (draw! layer context graphics 0 0 width height false)) + (draw! layer context)) (commit (:event-dispatcher context))) (defn preferred-size [component layer context] @@ -56,9 +62,14 @@ (def layer1 (reify Layer - (render! [this context g] - (.setColor g Color/RED) - (.fillRect g 0 0 (:width context) (:height context))) + (render! [this context] + (let-handlers this [context] + (doto (graphics context) + (.setColor Color/RED) + (.fillRect 0 0 (:width context) (:height context))) + (:mouse-entered e (println e)) + (:mouse-exited e (println e)) + (:mouse-moved e (println e)))) (size [this context] (Size. 30 20)))) (def layer1b (border-layer layer1 2 3)) @@ -66,11 +77,12 @@ (def layer2 (reify Layer - (render! [this context g] - (.setColor g Color/YELLOW) - (.fillRect g 0 0 (:width context) (:height context)) - (draw! layer1b context g 10 5) - (draw! layer1 context g 55 5)) + (render! [this context] + (doto (graphics context) + (.setColor Color/YELLOW) + (.fillRect 0 0 (:width context) (:height context))) + (draw! layer1b context 10 5) + (draw! layer1 context 55 5)) (size [this context] (Size. 70 65)))) (def layer3 @@ -86,8 +98,8 @@ fl (ref (fps-layer 0.0))] (reify Layer - (render! [this c g] - (draw! @fl c g) + (render! [this c] + (draw! @fl c) (dosync (alter frames + 1) (let [time (System/currentTimeMillis) @@ -100,13 +112,14 @@ (def layer (reify Layer - (render! [this context g] + (render! [this context] (update context) - (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED])) - (.drawLine g 0 0 (:width context) (:height context)) - (draw! layer2 context g 15 20) - (draw! layer3 context g 100 100 80 50) - (draw! fps context g)) + (doto (graphics context) + (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED])) + (.drawLine 0 0 (:width context) (:height context))) + (draw! layer2 context 15 20) + (draw! layer3 context 100 100 80 50) + (draw! fps context)) (size [this context] (Size. 400 300)))) (doto frame
--- a/src/indyvon/core.clj Wed Jul 07 05:57:49 2010 +0400 +++ b/src/indyvon/core.clj Wed Jul 07 07:17:08 2010 +0400 @@ -5,16 +5,17 @@ ;; (ns indyvon.core - (:import (java.awt Graphics Component Color Font) + (:import (java.awt Graphics2D Component Color Font) (java.awt.event MouseListener MouseMotionListener))) (defprotocol Layer "Basic UI element." - (render! [this context graphics]) + (render! [this context]) (size [this context])) (defrecord Location [x y]) (defrecord Size [width height]) +(defrecord Bounds [x y width height]) ;; TODO: modifiers (defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) @@ -58,53 +59,68 @@ (defn default-theme [] (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12))) -(defrecord LayerContext [x y width height update-fn font-context - theme target event-dispatcher]) +(defrecord LayerContext [x y width height clip + update-fn font-context theme + target event-dispatcher]) (defn default-context [] - (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil)) + (LayerContext. 0 0 0 0 nil nil nil (default-theme) nil nil)) (defn update [context] ((:update-fn context))) -(defn- ^Graphics make-graphics [^Graphics graphics x y w h clip] - (if clip - (.create graphics x y w h) - (doto (.create graphics) - (.translate x y)))) +(defn ^Graphics2D graphics + "Get AWT Graphics2D from context." + [context] + (:graphics context)) -(defn- ^Graphics apply-theme [^Graphics graphics theme] +(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h] + (.create graphics x y w h)) + +(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme] (doto graphics (.setColor (:fore-color theme)) (.setFont (:font theme)))) +(defn intersect [bounds x y w h] + (let [x12 (+ x w) + y12 (+ y h) + x21 (:x bounds) + y21 (:y bounds) + x22 (+ x21 (:width bounds)) + y22 (+ y21 (:height bounds)) + x1 (max x x21) + y1 (max y y21) + x2 (min x12 x22) + y2 (min y12 y22)] + (Bounds. x1 y1 (- x2 x1) (- y2 y1)))) + +(defn translate [context x y w h] + (let [ax (+ (:x context) x) + ay (+ (:y context) y)] + (assoc context + :x (+ (:x context) x) + :y (+ (:y context) y) + :width w + :height h + :clip (intersect (:clip context) ax ay w h) + :graphics (apply-theme + (make-graphics (:graphics context) x y w h) + (:theme context))))) + (defn draw! "Render layer in a new graphics context." - ([layer context graphics] - (render! layer context graphics)) - ([layer context graphics x y] - (draw! layer context graphics x y true)) - ([layer context graphics x y clip] + ([layer context] + (render! layer context)) + ([layer context x y] (let [s (size layer context)] - (draw! layer context graphics - x y (:width s) (:height s) clip))) - ([layer context graphics x y w h] - (draw! layer context graphics - x y w h true)) - ([layer context 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))] + (draw! layer context x y (:width s) (:height s)))) + ([layer context x y w h] + (let [context (translate context x y w h)] (try - (render! layer context graphics) + (render! layer context) (finally - (.dispose graphics)))))) + (.dispose (:graphics context))))))) (defn add-handlers [context handle handlers] "Returns new context with the specified event handlers." @@ -113,9 +129,9 @@ (create-dispatcher (:event-dispatcher context) context handle handlers))) -(defmacro let-handlers [handle bindings & specs] +(defmacro let-handlers [handle bindings form & specs] "bindings => [binding-form context] or [context-symbol] - specs => (:event-id name & handler-body)* form + specs => (:event-id name & handler-body)* Execute form with the specified event handlers." (let [[binding context] bindings @@ -127,8 +143,8 @@ (assoc m (first spec) `(fn [~(second spec)] ~@(nnext spec)))) {} - (butlast specs)))] - ~(last specs)))) + specs))] + ~form))) ;; ;; EventDispatcher implementation @@ -143,7 +159,7 @@ java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) -(defrecord DispatcherNode [handle handlers parent x y width height] +(defrecord DispatcherNode [handle handlers parent bounds] EventDispatcher (listen! [this component] (listen! parent component)) @@ -153,8 +169,7 @@ (commit parent))) (defn- make-node [c handle handlers] - (DispatcherNode. handle handlers (:event-dispatcher c) - (:x c) (:y c) (:width c) (:height c))) + (DispatcherNode. handle handlers (:event-dispatcher c) (:clip c))) (defn- assoc-cons [m key val] (assoc m key (cons val (get m key)))) @@ -163,9 +178,9 @@ (assoc-cons tree (:parent node) node)) (defn- inside? - ([x y node] - (inside? x y (:x node) (:y node) - (:width node) (:height node))) + ([x y bounds] + (inside? x y (:x bounds) (:y bounds) + (:width bounds) (:height bounds))) ([px py x y w h] (and (>= px x) (>= py y) @@ -175,7 +190,7 @@ (defn- under-cursor "Returns a sequence of child nodes under cursor." [x y tree node] - (some #(if (inside? x y %) + (some #(if (inside? x y (:bounds %)) (conj (under-cursor x y tree %) %)) (get tree node))) @@ -195,7 +210,8 @@ (doseq [node nodes] (when-let [handler (get (:handlers node) id)] (handler - (translate-mouse-event event (:x node) (:y node) id)))) + (translate-mouse-event event + (-> node :bounds :x) (-> node :bounds :y) id)))) id)) (defn- dispatch-mouse-motion*
--- a/src/indyvon/layers.clj Wed Jul 07 05:57:49 2010 +0400 +++ b/src/indyvon/layers.clj Wed Jul 07 07:17:08 2010 +0400 @@ -33,13 +33,13 @@ ([content width gap] (let [offset (+ width gap)] (reify Layer - (render! [l c g] + (render! [l c] (let [w (:width c) h (:height c)] - (.setColor g (-> c :theme :border-color)) + (.setColor (graphics c) (-> c :theme :border-color)) (doseq [i (range 0 width)] - (.drawRect g i i (- w 1 i i) (- h 1 i i))) - (draw! content c g offset offset (- w offset offset) + (.drawRect (graphics c) i i (- w 1 i i) (- h 1 i i))) + (draw! content c offset offset (- w offset offset) (- h offset offset)))) (size [l c] (let [s (size content c)] @@ -66,10 +66,10 @@ ([text h-align v-align] (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)] (reify Layer - (render! [l c g] + (render! [l c] (let [w (:width c) h (:height c) - font (.getFont g) + font (.getFont (graphics c)) font-context (:font-context c) layouts (layout-text lines font font-context) y (align-y (text-height layouts) h v-align)] @@ -78,7 +78,7 @@ (let [ascent (.getAscent layout) lh (+ ascent (.getDescent layout) (.getLeading layout)) x (align-x (.getAdvance layout) w h-align)] - (.draw layout g x (+ y ascent)) + (.draw layout (graphics c) x (+ y ascent)) (recur (next layouts) (+ y lh))))))) (size [l c] (let [layouts (layout-text lines @@ -100,8 +100,19 @@ last-height (ref 0)] (reify Layer - (render! [layer c g] + (render! [layer c] (let-handlers layer [c] + (let [anchor (anchor content c h-align v-align) + width (:width c) + height (:height c)] + (dosync + (alter x + (align-x width @last-width h-align)) + (alter y + (align-y height @last-height v-align)) + (ref-set last-width width) + (ref-set last-height height)) + (draw! content c + (- 0 @x (:x anchor)) + (- 0 @y (:y anchor)))) (:mouse-pressed e (dosync (ref-set fix-x (:x-on-screen e)) @@ -115,16 +126,5 @@ (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)] - (dosync - (alter x + (align-x width @last-width h-align)) - (alter y + (align-y height @last-height v-align)) - (ref-set last-width width) - (ref-set last-height height)) - (draw! content c g - (- 0 @x (:x anchor)) - (- 0 @y (:y anchor)))))) + (update c)))) (size [layer c] (size content c))))))