Mercurial > hg > indyvon
changeset 101:9874107e3e96
Clojure 1.3 compatibility, mouse wheel support, scalable viewport, additional layer implementations.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Wed, 18 May 2011 20:50:49 +0400 |
| parents | f8c8abb84e99 |
| children | fd8fb8a3ff5a |
| files | project.clj src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/layers.clj |
| diffstat | 5 files changed, 362 insertions(+), 107 deletions(-) [+] |
line wrap: on
line diff
--- a/project.clj Wed May 18 19:05:11 2011 +0400 +++ b/project.clj Wed May 18 20:50:49 2011 +0400 @@ -3,7 +3,7 @@ ;;:warn-on-reflection true :dependencies [[org.clojure/clojure "1.2.1"] [com.google.guava/guava "r09"]] - :dev-dependencies [[swank-clojure/swank-clojure "1.3.1"]] + :dev-dependencies [[swank-clojure "1.3.1"]] ;;:aot [net.kryshen.indyvon.core ;; net.kryshen.indyvon.async ;; net.kryshen.indyvon.layers
--- a/src/net/kryshen/indyvon/component.clj Wed May 18 19:05:11 2011 +0400 +++ b/src/net/kryshen/indyvon/component.clj Wed May 18 20:50:49 2011 +0400 @@ -1,5 +1,5 @@ ;; -;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net> +;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;; @@ -25,12 +25,18 @@ (net.kryshen.indyvon.core Size Bounds) (java.awt Graphics Component Dimension Color) (java.awt.geom Rectangle2D$Double) - (javax.swing JFrame JPanel))) + (javax.swing JFrame JPanel JOptionPane))) -(defn- font-context [^Component component] +(defn font-context [^Component component] (.getFontRenderContext (.getFontMetrics component (.getFont component)))) -(defn make-jpanel +(defmacro with-component [component & body] + `(let [c# ~component] + (binding [*target* c# + *font-context* (font-context c#)] + ~@body))) + +(defn ^JPanel make-jpanel ([layer] (make-jpanel layer (root-event-dispatcher))) ([layer event-dispatcher] @@ -59,3 +65,6 @@ (doto (JFrame. title) (.. (getContentPane) (add (make-jpanel layer))) (.pack))) + +(defn message [m] + (JOptionPane/showMessageDialog *target* m))
--- a/src/net/kryshen/indyvon/core.clj Wed May 18 19:05:11 2011 +0400 +++ b/src/net/kryshen/indyvon/core.clj Wed May 18 20:50:49 2011 +0400 @@ -21,7 +21,8 @@ (:import (java.awt Graphics2D RenderingHints Component Color Font Shape) (java.awt.geom AffineTransform Point2D$Double Rectangle2D$Double Area) - (java.awt.event MouseListener MouseMotionListener) + (java.awt.event MouseListener MouseMotionListener + MouseWheelListener MouseWheelEvent) (java.awt.font FontRenderContext) java.util.concurrent.ConcurrentMap com.google.common.collect.MapMaker)) @@ -30,48 +31,67 @@ ;; Layer context ;; -(def ^Graphics2D *graphics*) +(def ^{:dynamic true + :tag Graphics2D} + *graphics*) -(def ^FontRenderContext *font-context*) +(def ^{:dynamic true + :tag FontRenderContext} + *font-context*) -(def ^{:tag Component +(def ^{:dynamic true + :tag Component :doc "Target AWT component, may be nil if drawing off-screen."} - *target*) + *target*) -(def ^{:doc "Width of the rendering area."} - *width*) +(def ^{:dynamic true + :doc "Width of the rendering area."} + *width*) -(def ^{:doc "Height of the rendering area."} - *height*) +(def ^{:dynamic true + :doc "Height of the rendering area."} + *height*) -(def ^Shape *clip*) +(def ^{:dynamic true + :tag Shape} + *clip*) -(def ^{:doc "The root (background) layer of the scene."} - *root*) +(def ^{:dynamic true + :doc "The root (background) layer of the scene."} + *root*) -(def ^{:doc "Time in nanoseconds when the rendering of the current +(def ^{:dynamic true + :doc "Time in nanoseconds when the rendering of the current frame starts."} - *time*) + *time*) -(def *event-dispatcher*) +(def ^{:dynamic true} + *event-dispatcher*) -(def ^{:tag AffineTransform +(def ^{:dynamic true + :tag AffineTransform :doc "Initial transform associated with the graphics context."} - *initial-transform*) + *initial-transform*) -(def ^{:tag AffineTransform +(def ^{:dynamic true + :tag AffineTransform :doc "Inversion of the initial transform associated with the graphics context."} - *inverse-initial-transform*) + *inverse-initial-transform*) -(defrecord Theme [fore-color back-color alt-back-color border-color font]) +(defrecord Theme [fore-color back-color alt-back-color border-color + shadow-color font]) ;; REMIND: use system colors, see java.awt.SystemColor. (defn default-theme [] - (Theme. Color/BLACK Color/WHITE Color/LIGHT_GRAY - Color/BLUE (Font. "Sans" Font/PLAIN 12))) + (Theme. Color/BLACK + Color/WHITE + (Color. 0xC8 0xD2 0xD8) + (Color. 0 0 0xC8) + (Color. 0x44 0x44 0x44) + (Font. "Sans" Font/PLAIN 12))) -(def *theme* (default-theme)) +(def ^{:dynamic true} *theme* (default-theme)) (defrecord Location [x y]) (defrecord Size [width height]) @@ -87,12 +107,13 @@ (layer-size [this])) ;; TODO: modifiers -(defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) +(defrecord MouseEvent [id when x y x-on-screen y-on-screen button + wheel-rotation]) ;; TODO: KeyEvent (defprotocol EventDispatcher - (listen! [this ^Component component] + (listen! [this component] "Listen for events on the specified AWT Component.") (create-dispatcher [this handle handlers] "Returns new event dispatcher associated with the specified event @@ -275,16 +296,28 @@ ([] (apply-theme *graphics* *theme*)) ([^Graphics2D graphics theme] - (doto graphics - (.setColor (:fore-color theme)) - (.setFont (:font theme))))) + (doto graphics + (.setColor (:fore-color theme)) + (.setFont (:font theme))))) (defn- ^Graphics2D create-graphics ([] - (create-graphics 0 0 *width* *height*)) + (apply-theme (.create *graphics*) *theme*)) ([x y w h] (apply-theme (.create *graphics* x y w h) *theme*))) +(defn- with-bounds-noclip* + [x y w h f & args] + (let [graphics (create-graphics)] + (try + (.translate graphics (int x) (int y)) + (binding [*width* w + *height* h + *graphics* graphics] + (apply f args)) + (finally + (.dispose graphics))))) + (defn with-bounds* [x y w h f & args] (when-let [clip (clip x y w h)] @@ -320,6 +353,23 @@ (finally (.setColor *graphics* old-color#)))))) +(defn with-hints* + [hints f & args] + (if hints + (let [g *graphics* + old (.getRenderingHints g)] + (try + (.addRenderingHints g hints) + (binding [*font-context* (.getFontRenderContext g)] + (apply f args)) + (finally + (.setRenderingHints g old)))) + (apply f args))) + +(defmacro with-hints + [hints & body] + `(with-hints ~hints (fn [] ~@body))) + ;; TODO: constructor for AffineTransform. ;; (transform :scale 0.3 0.5 ;; :translate 5 10 @@ -337,6 +387,15 @@ `(let [transform# (AffineTransform/getRotateInstance ~theta ~ax ~ay)] (with-transform transform# ~@body))) +(defmacro with-translate [x y & body] + `(let [x# ~x + y# ~y] + (try + (.translate *graphics* x# y#) + ~@body + (finally + (.translate *graphics* (- x#) (- y#)))))) + (defn draw! "Draws layer." ([layer] @@ -347,10 +406,16 @@ (finally (.dispose graphics))))) ([layer x y] + (draw! layer x y true)) + ([layer x y clip?] (let [size (layer-size layer)] - (draw! layer x y (:width size) (:height size)))) + (draw! layer x y (:width size) (:height size) clip?))) ([layer x y width height] - (with-bounds* x y width height render! layer))) + (draw! layer x y width height true)) + ([layer x y width height clip?] + (if clip? + (with-bounds* x y width height render! layer) + (with-bounds-noclip* x y width height render! layer)))) (defn draw-anchored! "Draws layer. Location is relative to the layer's anchor point for @@ -367,6 +432,18 @@ ([layer graphics width height event-dispatcher] (draw-root! layer graphics width height event-dispatcher nil)) ([layer ^Graphics2D graphics width height event-dispatcher target] + ;; (.setRenderingHint graphics + ;; RenderingHints/KEY_INTERPOLATION + ;; RenderingHints/VALUE_INTERPOLATION_BILINEAR) + ;; (.setRenderingHint graphics + ;; RenderingHints/KEY_ALPHA_INTERPOLATION + ;; RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY) + ;; (.setRenderingHint graphics + ;; RenderingHints/KEY_ANTIALIASING + ;; RenderingHints/VALUE_ANTIALIAS_ON) + ;; (.setRenderingHint graphics + ;; RenderingHints/KEY_TEXT_ANTIALIASING + ;; RenderingHints/VALUE_TEXT_ANTIALIAS_ON) (binding [*root* layer *target* target *graphics* graphics @@ -379,15 +456,6 @@ *height* height *clip* (Rectangle2D$Double. 0 0 width height) *time* (System/nanoTime)] - ;; (.setRenderingHint graphics - ;; RenderingHints/KEY_INTERPOLATION - ;; RenderingHints/VALUE_INTERPOLATION_BILINEAR) - ;; (.setRenderingHint graphics - ;; RenderingHints/KEY_ALPHA_INTERPOLATION - ;; RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY) - ;; (.setRenderingHint graphics - ;; RenderingHints/KEY_ANTIALIASING - ;; RenderingHints/VALUE_ANTIALIAS_ON) (apply-theme) (let [tmp-watcher (Object.)] ;; Keep current context observers until the rendering is @@ -438,7 +506,6 @@ (defn hovered? [handle] (handle-hovered? *event-dispatcher* handle)) - ;; ;; EventDispatcher implementation ;; @@ -450,7 +517,8 @@ java.awt.event.MouseEvent/MOUSE_EXITED :mouse-exited java.awt.event.MouseEvent/MOUSE_MOVED :mouse-moved java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed - java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) + java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released + java.awt.event.MouseEvent/MOUSE_WHEEL :mouse-wheel}) (def dummy-event-dispatcher (reify @@ -484,6 +552,9 @@ (defn- add-node [tree node] (assoc-cons tree (:parent node) node)) +(defn- nodes [tree] + (apply concat (vals tree))) + (defn- under-cursor "Returns a vector of child nodes under cursor." [x y tree node] @@ -496,22 +567,26 @@ (defn- translate-mouse-event [^java.awt.event.MouseEvent event ^AffineTransform tr id] - (let [[x y] (transform-point tr (.getX event) (.getY event))] + (let [[x y] (transform-point tr (.getX event) (.getY event)) + rotation (if (instance? MouseWheelEvent event) + (.getWheelRotation ^MouseWheelEvent event) + nil)] (MouseEvent. id (.getWhen event) x y (.getXOnScreen event) (.getYOnScreen event) - (.getButton event)))) + (.getButton event) + rotation))) (defn- translate-and-dispatch ([nodes first-only ^java.awt.event.MouseEvent event] (translate-and-dispatch nodes first-only - event (awt-events (.getID event)))) + event (awt-events (.getID event)))) ([nodes first-only event id] (if-let [node (first nodes)] (if-let [handler (get (:handlers node) id)] (do - (with-bindings* (:bindings node) - handler - (translate-mouse-event event (:transform node) id)) + (let [translated (translate-mouse-event event (:transform node) id)] + (with-bindings* (:bindings node) + handler translated)) (if-not first-only (recur (rest nodes) false event id))) (recur (rest nodes) first-only event id))))) @@ -556,14 +631,17 @@ (reify EventDispatcher (listen! [this component] - (doto component + (doto ^Component component (.addMouseListener this) + (.addMouseWheelListener this) (.addMouseMotionListener this))) (create-dispatcher [this handle handlers] (let [node (make-node handle handlers)] (dosync (alter tree-r add-node node)) node)) (commit [this] + ;; TODO: retain contexts that do not intersect graphics + ;; clipping area in tree. (dosync (ref-set tree @tree-r) (ref-set tree-r {}))) (handle-picked? [this handle] @@ -581,6 +659,9 @@ (dispatch-mouse-button picked hovered event)) (mouseReleased [this event] (dispatch-mouse-button picked hovered event)) + MouseWheelListener + (mouseWheelMoved [this event] + (dispatch-mouse-button picked hovered event)) MouseMotionListener (mouseDragged [this event] (translate-and-dispatch @picked true event))
--- a/src/net/kryshen/indyvon/demo.clj Wed May 18 19:05:11 2011 +0400 +++ b/src/net/kryshen/indyvon/demo.clj Wed May 18 20:50:49 2011 +0400 @@ -1,5 +1,5 @@ ;; -;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net> +;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;;
--- a/src/net/kryshen/indyvon/layers.clj Wed May 18 19:05:11 2011 +0400 +++ b/src/net/kryshen/indyvon/layers.clj Wed May 18 20:50:49 2011 +0400 @@ -24,8 +24,9 @@ (:import (net.kryshen.indyvon.core Size Location) (java.lang.ref SoftReference) - (java.awt Font Cursor Image Toolkit) - (java.awt.image ImageObserver) + (java.awt Font Cursor Image Toolkit Point) + java.awt.image.ImageObserver + (java.awt.geom AffineTransform Point2D$Double) (java.awt.font FontRenderContext TextLayout))) ;; Define as macro to avoid unnecessary calculation of inner and outer @@ -87,6 +88,32 @@ (- *height* 1 i i)))) (render! layer))))) +;; TODO: opacity and blur. +(defn shadow + "Add shadow to content layer." + ([content] + (shadow content 1 1)) + ([content x-offset y-offset] + (let [x (if (neg? x-offset) (- x-offset) 0) + y (if (neg? y-offset) (- y-offset) 0) + abs-x (if (neg? x-offset) (- x-offset) x-offset) + abs-y (if (neg? y-offset) (- y-offset) y-offset) + shadow-x (+ x-offset x) + shadow-y (+ y-offset y)] + (reify + ;; TODO: Anchored + Layer + (render! [_] + (let [w (- *width* abs-x) + h (- *height* abs-y)] + (with-color :shadow-color + (.fillRect *graphics* shadow-x shadow-y w h)) + (draw! content x y w h))) + (layer-size [_] + (let [s (layer-size content)] + (Size. (+ (:width s) abs-x) + (+ (:height s) abs-y)))))))) + (defn panel "Opaque layer using theme's alt-back-color." ([content] @@ -105,20 +132,41 @@ (reify Layer (render! [_] - ;; TODO: distribute space proportionally. - (let [w (/ *width* (count contents))] - (doseq [[i c] (map-indexed vector contents)] - (draw! c (* i w) 0 w *height*)))) + (let [widths (map #(:width (layer-size %)) contents) + xs (cons 0 (reductions + widths)) + widths-sum (last xs) + scale (/ *width* widths-sum)] + (doseq [[c w x] (map vector contents widths xs)] + (draw! c x 0 w *height*)))) (layer-size [_] (reduce #(Size. (+ (:width %1) (:width %2)) (max (:height %1) (:height %2))) (Size. 0 0) (map layer-size contents))))) +(defn vbox + "Creates layer that draws the specified content layers placing them + vertically." + [& contents] + (reify + Layer + (render! [_] + (let [heights (map #(:height (layer-size %)) contents) + ys (cons 0 (reductions + heights)) + heights-sum (last ys) + scale (/ *height* heights-sum)] + (doseq [[c h y] (map vector contents heights ys)] + (draw! c 0 y *width* h)))) + (layer-size [_] + (reduce #(Size. (max (:width %1) (:width %2)) + (+ (:height %1) (:height %2))) + (Size. 0 0) + (map layer-size contents))))) + (defn- re-split [^java.util.regex.Pattern re s] (seq (.split re s))) -(def text-layout-cache (atom {})) +(def ^:private text-layout-cache (atom {})) (defn- get-text-layout [^String line ^Font font ^FontRenderContext font-context] @@ -152,7 +200,7 @@ ([text] (label text :left :top)) ([text h-align v-align] - (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)] + (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" (str text))] (reify Layer (render! [layer] (let [w *width* @@ -184,7 +232,7 @@ (defn image-layer [image-or-uri] - (let [^Image image (if (isa? image-or-uri Image) + (let [^Image image (if (instance? Image image-or-uri) image-or-uri (.getImage (Toolkit/getDefaultToolkit) ^java.net.URL image-or-uri))] @@ -202,13 +250,13 @@ height (if (pos? height) height 1)] (Size. width height)))))) -(def *miniature-thread-priority* 2) +(def ^{:dynamic true} *miniature-thread-priority* 2) (defn- scaling [width height max-width max-height] (min (/ max-width width) (/ max-height height))) - + (defn miniature "Creates layer that asynchronously renders view of the content scaled to the specified size." @@ -231,25 +279,50 @@ ;; (Size. (* (:width size) s) (* (:height size) s))))) width height *miniature-thread-priority*)) +;;(defn- translate [^AffineTransform transform ^double x ^double y] +;; (doto ^AffineTransform (.clone transform) +;; (.translate x y))) + +(defn- scale [^AffineTransform transform ^double sx ^double sy] + (doto ^AffineTransform (.clone transform) + (.scale sx sy))) + +(defn- pre-translate [^AffineTransform transform ^double x ^double y] + (if (== 0.0 x y) + transform + (doto (AffineTransform/getTranslateInstance x y) + (.concatenate transform)))) + +(def ^{:dynamic true} *viewport-scaling-step* (double 3/4)) +(def ^{:dynamic true} *viewport-min-scale* 1E-6) +(def ^{:dynamic true} *viewport-max-scale* 1E6) + (defrecord Viewport [content h-align v-align ;; State (refs) - ;; TODO: group into data structures. - x y fix-x fix-y last-width last-height - vp-x vp-y] + transform + fix-x fix-y + last-width last-height last-anchor] Layer (render! [layer] (repaint-on-update layer) (with-handlers layer (let [anchor (anchor content h-align v-align)] (dosync - (alter x + (align-x *width* @last-width h-align)) - (alter y + (align-y *height* @last-height v-align)) + (let [ax1 (align-x @last-width *width* h-align) + ay1 (align-y @last-height *height* v-align) + ax2 (- (:x @last-anchor) (:x anchor)) + ay2 (- (:y @last-anchor) (:y anchor))] + (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2)) + (ref-set transform + (doto (AffineTransform/getTranslateInstance ax1 ay1) + (.concatenate @transform) + (.translate ax2 ay2))))) (ref-set last-width *width*) (ref-set last-height *height*) - (ref-set vp-x (+ @x (:x anchor))) - (ref-set vp-y (+ @y (:y anchor)))) + (ref-set last-anchor anchor)) ;; TODO: notify observers when size changes. - (draw! content (- @vp-x) (- @vp-y))) + (with-transform @transform + (draw! content 0 0 false))) (:mouse-pressed e (dosync (ref-set fix-x (:x-on-screen e)) @@ -261,29 +334,49 @@ (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))) (:mouse-dragged e (dosync - (alter x + (- @fix-x (:x-on-screen e))) - (alter y + (- @fix-y (:y-on-screen e))) + (alter transform pre-translate + (- (:x-on-screen e) @fix-x) + (- (:y-on-screen e) @fix-y)) (ref-set fix-x (:x-on-screen e)) (ref-set fix-y (:y-on-screen e))) + (update layer)) + (:mouse-wheel e + (dosync + (let [s (Math/pow *viewport-scaling-step* (:wheel-rotation e)) + x (- (:x e) (* (:x e) s)) + y (- (:y e) (* (:y e) s)) + scaled (doto (AffineTransform/getTranslateInstance x y) + (.scale s s) + (.concatenate @transform)) + sx (.getScaleX scaled) + sy (.getScaleY scaled)] + (if (<= *viewport-min-scale* + (min sx sy) + (max sx sy) + *viewport-max-scale*) + (ref-set transform scaled)))) (update layer)))) (layer-size [layer] (layer-size content))) (defn viewport "Creates scrollable viewport layer." - ([content] (viewport content :left :top)) + ([content] + (viewport content :left :top)) ([content h-align v-align] (Viewport. content h-align v-align - (ref 0) (ref 0) ; x y - (ref 0) (ref 0) ; fix-x fix-y - (ref 0) (ref 0) ; last-width last-height - (ref 0) (ref 0)))) ; vp-x vp-y + (ref (AffineTransform.)) ; transform + (ref 0) (ref 0) ; fix-x fix-y + (ref 0) (ref 0) ; last-width last-height + (ref (Location. 0 0))))) ; last-anchor -(defn- viewport-visible-bounds - [vp] +(defn reset-viewport [viewport] (dosync - [@(:vp-x vp) @(:vp-y vp) - @(:last-width vp) @(:last-height vp)])) + (ref-set (:last-width viewport) 0) + (ref-set (:last-height viewport) 0) + (ref-set (:last-anchor viewport) (Location. 0 0)) + (ref-set (:transform viewport) (AffineTransform.))) + (update viewport)) (defn viewport-miniature "Creates miniature view of the viewport's contents." @@ -293,36 +386,60 @@ (repaint-on-update viewport) (let [size (layer-size (:content viewport)) s (scaling (:width size) (:height size) width height) - [x y w h] (viewport-visible-bounds viewport) + [vp-tr w h] (dosync + [@(:transform viewport) + @(:last-width viewport) + @(:last-height viewport)]) + vp-inverse (.createInverse ^AffineTransform vp-tr) ox (align-x (:width size) (/ width s) :center) oy (align-y (:height size) (/ height s) :center) - sx (* (+ x ox) s) - sy (* (+ y oy) s) - sw (* w s) - sh (* h s) + transform (doto (AffineTransform.) + (.scale s s) + (.translate ox oy) + (.concatenate vp-inverse)) move-vp (fn [x y] (dosync - (ref-set (:x viewport) - (- (/ x s) - (/ w 2) - ox - (- @(:vp-x viewport) @(:x viewport)))) - (ref-set (:y viewport) - (- (/ y s) - (/ h 2) - oy - (- @(:vp-y viewport) @(:y viewport))))) + (let [x (- (/ x s) ox) + y (- (/ y s) oy) + [x y] (transform-point @(:transform viewport) + x y) + x (- x (/ @(:last-width viewport) 2)) + y (- y (/ @(:last-height viewport) 2))] + (alter (:transform viewport) + pre-translate (- x) (- y)))) (update viewport))] (with-color :alt-back-color (.fillRect *graphics* 0 0 *width* *height*)) - (with-color :back-color - (.fillRect *graphics* sx sy sw sh)) + (with-transform transform + (with-color :back-color + (.fillRect *graphics* 0 0 w h))) (with-handlers l (draw! miniature) (:mouse-pressed e (move-vp (:x e) (:y e))) (:mouse-dragged e (move-vp (:x e) (:y e)))) - (with-color :border-color - (.drawRect *graphics* sx sy sw sh)))))) + (with-transform transform + (with-color :border-color + (.drawRect *graphics* 0 0 w h))))))) + +(defn ref-layer + [layer-ref] + (let [l (reify + Layer + (render! [l] + (repaint-on-update l) + (if-let [layer @layer-ref] + (render! layer))) + (layer-size [_] + (if-let [layer @layer-ref] + (layer-size layer) + (Size. 1 1))) + Anchored + (anchor [_ x-align y-align] + (if-let [layer @layer-ref] + (anchor layer x-align y-align) + (Location. 0 0))))] + (add-watch layer-ref l (fn [_ _ _ _] (update l))) + l)) ;; ;; Layer context decorators. @@ -336,9 +453,9 @@ (render! layer#) ~@handlers)))) -(defn theme [layer & map-or-keyvals] +(defn themed [layer & map-or-keyvals] (let [theme (if (== (count map-or-keyvals) 1) - map-or-keyvals + (first map-or-keyvals) (apply array-map map-or-keyvals))] (reify Layer @@ -353,11 +470,18 @@ (with-theme theme (anchor layer xa ya)))))) +(defn hinted [layer & map-or-keyvals] + (let [hints (if (== (count map-or-keyvals) 1) + (first map-or-keyvals) + (apply array-map map-or-keyvals))] + (decorate-layer layer [_] + (with-hints* hints render! layer)))) + ;; ;; Measuring time ;; -(def *interval*) +(def ^{:dynamic true} *interval*) (defn interval-layer "Creates layer that measures time between repaints ant draws it's @@ -397,3 +521,44 @@ (ref-set prev-time *time*)))) (ref-set prev-time *time*)) @display))))) + +;; +;; Overlayer. +;; + +(def ^{:private true :dynamic true} *above*) + +(defn- overlay* [f & args] + (var-set #'*above* (conj *above* (apply partial f args)))) + +(defn- ^Point to-graphics-coords + [^AffineTransform transform x y] + (let [p (Point. x y)] + (.transform transform p p) + (.transform (.createInverse (.getTransform *graphics*)) p p) + p)) + +(defn- draw-relative! + ([layer transform x y] + (let [p (to-graphics-coords transform x y)] + (draw! layer (.x p) (.y p)))) + ([layer transform x y w h] + (let [p (to-graphics-coords transform x y)] + (draw! layer (.x p) (.y p) w h)))) + +(defn overlay! + "Draws layer in the overlayer context above the other layers." + ([layer] + (overlay* draw-relative! layer (.getTransform *graphics*) 0 0)) + ([layer x y] + (overlay* draw-relative! layer (.getTransform *graphics*) x y)) + ([layer x y w h] + (overlay* draw-relative! layer (.getTransform *graphics*) x y w h))) + +(defn overlayer + [content] + (decorate-layer content [_] + (binding [*above* []] + (render! content) + (doseq [f *above*] + (f)))))