Mercurial > hg > indyvon
changeset 110:f3dedece38f3
Merged.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Mon, 10 Oct 2011 01:58:35 +0300 |
parents | 5bb50e6661af (diff) 491152048c89 (current diff) |
children | 441fe457fc2b |
files | src/net/kryshen/indyvon/async.clj src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/layers.clj |
diffstat | 8 files changed, 240 insertions(+), 187 deletions(-) [+] |
line wrap: on
line diff
--- a/README.rst Thu May 19 20:10:45 2011 +0400 +++ b/README.rst Mon Oct 10 01:58:35 2011 +0300 @@ -11,7 +11,7 @@ (defprotocol Layer (render! [layer] "Draws the layer.") - (layer-size [layer] + (geometry [layer] "Returns preferred size for the layer.")) Layer functions are called in the Layer context which is defined by
--- a/README.ru Thu May 19 20:10:45 2011 +0400 +++ b/README.ru Mon Oct 10 01:58:35 2011 +0300 @@ -15,7 +15,7 @@ (слой), который содержит всего две функции: render! — отрисовка, - layer-size — получение предпочтительного размера элемента. + geometry — получение предпочтительных размеров элемента. Слой, в отличии от обычных компонентов интерфейса или элементов графов сцены в системах визуализации, не имеет состояния (координаты, размер,
--- a/project.clj Thu May 19 20:10:45 2011 +0400 +++ b/project.clj Mon Oct 10 01:58:35 2011 +0300 @@ -1,9 +1,9 @@ -(defproject indyvon "1.0.0-SNAPSHOT" - :description "INteractive DYnamic VisualizatiON library" +(defproject indyvon "0.0.1" + :description "INteractive DYnamic VisualizatiON: an experimental GUI library" + :url "https://bitbucket.org/kryshen/indyvon" ;;:warn-on-reflection true - :dependencies [[org.clojure/clojure "1.2.1"] - [com.google.guava/guava "r09"]] - :dev-dependencies [[swank-clojure "1.3.1"]] + :dependencies [[org.clojure/clojure "1.3.0"] + [com.google.guava/guava "10.0"]] ;;:aot [net.kryshen.indyvon.core ;; net.kryshen.indyvon.async ;; net.kryshen.indyvon.layers
--- a/src/net/kryshen/indyvon/async.clj Thu May 19 20:10:45 2011 +0400 +++ b/src/net/kryshen/indyvon/async.clj Mon Oct 10 01:58:35 2011 +0300 @@ -22,7 +22,6 @@ (:use net.kryshen.indyvon.core) (:import - (net.kryshen.indyvon.core Size Location) java.awt.GraphicsConfiguration (java.awt Image AlphaComposite Transparency) (java.awt.image BufferedImage) @@ -144,8 +143,8 @@ (draw-offscreen-async layer)) (with-buffer layer :front [b] (.drawImage *graphics* ^Image (:image b) 0 0 nil))) - (layer-size [layer] - (Size. width height))) + (geometry [layer] + (->Size width height))) (defn- create-thread-factory [priority] (reify @@ -172,8 +171,8 @@ (async-layer content width height nil)) ([content width height priority] ;; TODO: use operational event dispatcher. - (AsyncLayer. (make-scene content) - width - height - (create-executor priority) - (ref nil)))) + (->AsyncLayer (make-scene content) + width + height + (create-executor priority) + (ref nil))))
--- a/src/net/kryshen/indyvon/component.clj Thu May 19 20:10:45 2011 +0400 +++ b/src/net/kryshen/indyvon/component.clj Mon Oct 10 01:58:35 2011 +0300 @@ -22,7 +22,6 @@ (:use net.kryshen.indyvon.core) (:import - (net.kryshen.indyvon.core Size Bounds) (java.awt Graphics Component Dimension Color) (java.awt.geom Rectangle2D$Double) (javax.swing JFrame JPanel JOptionPane))) @@ -30,12 +29,6 @@ (defn font-context [^Component component] (.getFontRenderContext (.getFontMetrics component (.getFont component)))) -(defmacro with-component [component & body] - `(let [c# ~component] - (binding [*target* c# - *font-context* (font-context c#)] - ~@body))) - (defn- paint-component [^Component c ^Graphics g scene] (let [size (.getSize c)] (.setColor g (:back-color *theme*)) @@ -43,8 +36,8 @@ (draw-scene! scene g (.width size) (.height size)))) (defn- preferred-size [^Component c scene] - (let [s (scene-size scene (font-context c))] - (Dimension. (:width s) (:height s)))) + (let [geom (scene-geometry scene (font-context c))] + (Dimension. (width geom) (height geom)))) (defn ^JPanel make-jpanel ([layer] @@ -72,4 +65,4 @@ (.pack))) (defn message [m] - (JOptionPane/showMessageDialog *target* m)) + (JOptionPane/showMessageDialog (:component *scene*) m))
--- a/src/net/kryshen/indyvon/core.clj Thu May 19 20:10:45 2011 +0400 +++ b/src/net/kryshen/indyvon/core.clj Mon Oct 10 01:58:35 2011 +0300 @@ -41,11 +41,6 @@ *font-context*) (def ^{:dynamic true - :tag Component - :doc "Target AWT component, may be nil if drawing off-screen."} - *target*) - -(def ^{:dynamic true :doc "Width of the rendering area."} *width*) @@ -94,18 +89,88 @@ (def ^{:dynamic true} *theme* (default-theme)) -(defrecord Location [x y]) -(defrecord Size [width height]) -(defrecord Bounds [x y width height]) - ;; ;; Core protocols and types ;; (defprotocol Layer "Basic UI element." - (render! [this]) - (layer-size [this])) + (render! [layer] + "Draws layer in the current *graphics* context.") + (geometry [layer] + "Returns the preferred layer Geometry.")) + +(defprotocol Geometry + "Describes geometry of a Layer. Prefer using the available + implementations (Size, FixedGeometry and NestedGeometry) over + extending this protocol directly as it is likely to be changed in + the future versions." + (width [geom] [geom height]) + (height [geom] [geom width]) + (anchor-x [geom h-align width] + "Returns the x coordinate of the anchor point for the specified + horizontal alignment and width, h-align could be :left, :center + or :right.") + (anchor-y [geom v-align height] + "Returns the y coordinate of the anchor point for the specified + vertical alignment and height, v-align could be :top, :center + or :bottom.")) + +(defrecord Size [width height] + Geometry + (width [_] width) + (width [_ _] width) + (height [_] height) + (height [_ _] height) + (anchor-x [_ h-align width] + (case h-align + :left 0 + :center (/ width 2) + :right width)) + (anchor-y [_ v-align height] + (case v-align + :top 0 + :center (/ height 2) + :bottom height))) + +(defrecord FixedGeometry [ax ay width height] + Geometry + (width [_] width) + (width [_ _] width) + (height [_] height) + (height [_ _] height) + (anchor-x [_ _ _] ax) + (anchor-y [_ _ _] ay)) + +(defrecord NestedGeometry [geometry top left bottom right] + Geometry + (width [_] + (+ left right (width geometry))) + (width [_ h] + (+ left right (width geometry (- h top bottom)))) + (height [_] + (+ top bottom (height geometry))) + (height [_ w] + (+ top bottom (height geometry (- w left right)))) + (anchor-x [_ h-align w] + (+ left (anchor-x geometry h-align (- w left right)))) + (anchor-y [_ v-align h] + (+ top (anchor-y geometry v-align (- h top bottom))))) + +(defrecord ScaledGeometry [geometry sx sy] + Geometry + (width [_] + (* sx (width geometry))) + (width [_ h] + (* sx (width geometry (/ h sy)))) + (height [_] + (* sy (height geometry))) + (height [_ w] + (* sy (height geometry (/ w sx)))) + (anchor-x [_ h-align w] + (* sx (anchor-x geometry h-align (/ w sx)))) + (anchor-y [_ v-align h] + (* sy (anchor-y geometry v-align (/ h sy))))) ;; TODO: modifiers (defrecord MouseEvent [id when x y x-on-screen y-on-screen button @@ -129,33 +194,6 @@ "Returns true if the specified handle received the :mouse-entered event and have not yet received :mouse-exited.")) -(defprotocol Anchored - "Provide anchor point for Layers. Used by viewport." - (anchor [this h-align v-align] - "Anchor point: [x y], h-align could be :left, :center or :right, - v-align is :top, :center or :bottom")) - -(defn default-anchor [layer h-align v-align] - (if (and (= h-align :left) - (= v-align :top)) - (Location. 0 0) - (let [size (layer-size layer)] - (Location. - (case h-align - :left 0 - :center (/ (:width size) 2) - :right (:width size)) - (case v-align - :top 0 - :center (/ (:height size) 2) - :bottom (:height size)))))) - -;; Default implementation of Anchored for any Layer. -(extend-protocol Anchored - net.kryshen.indyvon.core.Layer - (anchor [this h-align v-align] - (default-anchor this h-align v-align))) - (defn- assoc-cons [m key val] (->> (get m key) (cons val) (assoc m key))) @@ -238,14 +276,14 @@ ;; Rendering ;; -(defn relative-transform +(defn ^AffineTransform relative-transform "Returns AffineTransform: layer context -> AWT component." [] (let [tr (.getTransform *graphics*)] (.preConcatenate tr *inverse-initial-transform*) tr)) -(defn inverse-relative-transform +(defn ^AffineTransform inverse-relative-transform "Returns AffineTransform: AWT component -> layer context." [] (let [tr (.getTransform *graphics*)] @@ -408,8 +446,8 @@ ([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) clip?))) + (let [geom (geometry layer)] + (draw! layer x y (width geom) (height geom) clip?))) ([layer x y width height] (draw! layer x y width height true)) ([layer x y width height clip?] @@ -417,15 +455,23 @@ (with-bounds* x y width height render! layer) (with-bounds-noclip* x y width height render! layer)))) -(defn draw-anchored! +(defn draw-aligned! "Draws layer. Location is relative to the layer's anchor point for the specified alignment." ([layer h-align v-align x y] - (let [anchor (anchor layer h-align v-align)] - (draw! layer (- x (:x anchor)) (- y (:y anchor))))) + (let [geom (geometry layer) + w (width geom) + h (height geom)] + (draw! layer + (- x (anchor-x geom h-align w)) + (- y (anchor-y geom v-align h)) + w h))) ([layer h-align v-align x y w h] - (let [anchor (anchor layer h-align v-align)] - (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h)))) + (let [geom (geometry layer)] + (draw! layer + (- x (anchor-x geom h-align w)) + (- y (anchor-y geom v-align h)) + w h)))) ;; ;; Event handling. @@ -471,13 +517,12 @@ java.awt.event.MouseEvent/MOUSE_WHEEL :mouse-wheel}) (def dummy-event-dispatcher - (reify - EventDispatcher - (listen! [this component]) - (create-dispatcher [this handle handlers] this) - (commit [this]) - (handle-picked? [this handle]) - (handle-hovered? [this handle]))) + (reify EventDispatcher + (listen! [_ _]) + (create-dispatcher [this _ _] this) + (commit [_]) + (handle-picked? [_ _]) + (handle-hovered? [_ _]))) (defrecord DispatcherNode [handle handlers parent ^Shape clip ^AffineTransform transform @@ -630,7 +675,7 @@ ([layer event-dispatcher] (make-scene layer event-dispatcher nil)) ([layer event-dispatcher component] - (Scene. layer event-dispatcher component))) + (->Scene layer event-dispatcher component))) (defn draw-scene! [scene ^Graphics2D graphics width height] @@ -670,10 +715,10 @@ (remove-observers tmp-watcher) (commit (:event-dispatcher scene))))))) -(defn scene-size [scene font-context] +(defn scene-geometry [scene font-context] (binding [*scene* scene *font-context* font-context] - (layer-size (:layer scene)))) + (geometry (:layer scene)))) (defn set-cursor! [^Cursor cursor] (when-let [^Component component (:component *scene*)]
--- a/src/net/kryshen/indyvon/demo.clj Thu May 19 20:10:45 2011 +0400 +++ b/src/net/kryshen/indyvon/demo.clj Mon Oct 10 01:58:35 2011 +0300 @@ -23,7 +23,6 @@ (:use (net.kryshen.indyvon core layers component)) (:import - (net.kryshen.indyvon.core Size) (java.awt Color) (javax.swing JFrame))) @@ -121,10 +120,10 @@ (:mouse-pressed _ (repaint)) (:mouse-released _ (repaint)) (:mouse-clicked _ (apply callback args)))) - (layer-size [button] - (let [face-size (layer-size face)] - (Size. (+ (:width face-size) shadow-offset) - (+ (:height face-size) shadow-offset)))))))) + (geometry [button] + (let [face-geom (geometry face)] + (->Size (+ (width face-geom) shadow-offset) + (+ (height face-geom) shadow-offset)))))))) (def button1 (animated-button (label "Animated button 1") println "Animated button 1 clicked")) @@ -147,8 +146,8 @@ (println e)) (:mouse-moved e (println e)))) - (layer-size [layer] - (Size. 30 20)))) + (geometry [layer] + (->Size 30 20)))) (def test-layer1b (border test-layer1 2 3)) @@ -162,8 +161,8 @@ (with-rotate 0.5 0 0 (draw! test-layer1b 30 25)) (draw! test-layer1 55 5)) - (layer-size [layer] - (Size. 70 65)))) + (geometry [layer] + (->Size 70 65)))) (def test-layer2m (miniature test-layer2 30 30)) @@ -191,8 +190,8 @@ (draw-button! :button (label "Immediate button" :center :center) #(println "Button clicked!")))) - (layer-size [layer] - (Size. 400 300)))) + (geometry [layer] + (->Size 400 300)))) ;; Main viewport (def vp (viewport root)) @@ -205,7 +204,7 @@ (fps-layer (decorate-layer vp [_] (draw! vp) - (draw-anchored! + (draw-aligned! (label (str "Drag mouse to pan," \newline "use mouse wheel to zoom.")) :left :bottom 5 (- *height* 5))
--- a/src/net/kryshen/indyvon/layers.clj Thu May 19 20:10:45 2011 +0400 +++ b/src/net/kryshen/indyvon/layers.clj Mon Oct 10 01:58:35 2011 +0300 @@ -22,12 +22,13 @@ (:use (net.kryshen.indyvon core async)) (:import - (net.kryshen.indyvon.core Size Location) (java.lang.ref SoftReference) (java.awt Font Cursor Image Toolkit Point) java.awt.image.ImageObserver (java.awt.geom AffineTransform Point2D$Double) - (java.awt.font FontRenderContext TextLayout))) + (java.awt.font FontRenderContext TextLayout) + java.util.concurrent.TimeUnit + (com.google.common.cache Cache CacheBuilder CacheLoader))) ;; Define as macro to avoid unnecessary calculation of inner and outer ;; sizes in the first case. @@ -44,14 +45,13 @@ `(align-xy ~inner ~outer ~align :top :center :bottom)) (defmacro decorate-layer - "Decorate Layer and Anchored replacing render! implementation." + "Decorate Layer replacing render! implementation." [layer & render-tail] - `(reify - Layer - (render! ~@render-tail) - (layer-size [t#] (layer-size ~layer)) - Anchored - (anchor [t# xa# ya#] (anchor ~layer xa# ya#)))) + `(let [layer# ~layer] + (reify + Layer + (render! ~@render-tail) + (geometry [t#] (geometry layer#))))) (defn padding "Decorates layer adding padding." @@ -67,10 +67,8 @@ left top (- *width* left right) (- *height* top bottom))) - (layer-size [l] - (let [s (layer-size content)] - (Size. (+ (:width s) left right) - (+ (:height s) top bottom)))))))) + (geometry [l] + (->NestedGeometry (geometry content) top left bottom right)))))) (defn border "Decorate layer with a border." @@ -107,7 +105,6 @@ shadow-x (+ x-offset x) shadow-y (+ y-offset y)] (reify - ;; TODO: Anchored Layer (render! [_] (let [w (- *width* abs-x) @@ -115,10 +112,9 @@ (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)))))))) + (geometry [_] + (->NestedGeometry (geometry content) + y x shadow-y shadow-x)))))) (defn panel "Opaque layer using theme's alt-back-color." @@ -138,17 +134,17 @@ (reify Layer (render! [_] - (let [widths (map #(:width (layer-size %)) contents) + (let [widths (map #(width (geometry %)) 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))))) + (geometry [_] + (reduce #(->Size (+ (width %1) (width %2)) + (max (height %1) (height %2))) + (->Size 0 0) + (map geometry contents))))) (defn vbox "Creates layer that draws the specified content layers placing them @@ -157,39 +153,36 @@ (reify Layer (render! [_] - (let [heights (map #(:height (layer-size %)) contents) + (let [heights (map #(height (geometry %)) 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))))) + (geometry [_] + (reduce #(->Size (max (width %1) (width %2)) + (+ (height %1) (height %2))) + (->Size 0 0) + (map geometry contents))))) (defn- re-split [^java.util.regex.Pattern re s] (seq (.split re s))) -(def ^:private text-layout-cache (atom {})) +(def ^:private ^Cache text-layout-cache + (-> (CacheBuilder/newBuilder) + (.softValues) + (.expireAfterAccess (long 1) TimeUnit/SECONDS) + (.build + (proxy [CacheLoader] [] + (load [[^String s ^Font f ^FontRenderContext frc]] + (TextLayout. s f frc)))))) -(defn- get-text-layout - [^String line ^Font font ^FontRenderContext font-context] - (let [key [line font font-context]] - (or (if-let [^SoftReference softref (@text-layout-cache key)] - (.get softref) - (do (swap! text-layout-cache dissoc key) - false)) - (let [layout (TextLayout. line font font-context)] - ;;(println "text-layout-cache miss" line) - (swap! text-layout-cache assoc key (SoftReference. layout)) - layout)))) +(defn- get-text-layout [line font font-context] + (.get text-layout-cache [line font font-context])) (defn- layout-text [lines ^Font font ^FontRenderContext font-context] (map #(get-text-layout % font font-context) lines)) - ;;(map #(TextLayout. ^String % font font-context) lines)) (defn- text-width [layouts] (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts)) @@ -221,11 +214,11 @@ x (align-x (.getAdvance layout) w h-align)] (.draw layout *graphics* x (+ y ascent)) (recur (next layouts) (+ y lh))))))) - (layer-size [layer] + (geometry [layer] (let [layouts (layout-text lines (:font *theme*) *font-context*) - width (text-width layouts) - height (text-height layouts)] - (Size. width height))))))) + w (text-width layouts) + h (text-height layouts)] + (->Size w h))))))) (defn- ^ImageObserver image-observer [layer] (reify @@ -248,13 +241,13 @@ (render! [layer] (repaint-on-update layer) (.drawImage *graphics* image 0 0 (image-observer layer))) - (layer-size [layer] + (geometry [layer] (let [observer (image-observer layer) width (.getWidth image observer) height (.getHeight image observer) width (if (pos? width) width 1) height (if (pos? height) height 1)] - (Size. width height)))))) + (->Size width height)))))) (def ^{:dynamic true} *miniature-thread-priority* 2) @@ -266,24 +259,23 @@ (defn miniature "Creates layer that asynchronously renders view of the content scaled to the specified size." - [content width height] + [content mw mh] (async-layer (reify Layer (render! [this] - (let [size (layer-size content) - s (scaling (:width size) (:height size) width height)] + (let [geom (geometry content) + cw (width geom) + ch (height geom) + s (scaling cw ch mw mh)] (.scale *graphics* s s) (draw! content - (align-x (:width size) (/ width s) :center) - (align-y (:height size) (/ height s) :center) - (:width size) (:height size)))) - (layer-size [this] - (Size. width height))) - ;; (let [size (layer-size content) - ;; s (scaling (:width size) (:height size) width height)] - ;; (Size. (* (:width size) s) (* (:height size) s))))) - width height *miniature-thread-priority*)) + (align-x cw (/ mw s) :center) + (align-y ch (/ mh s) :center) + cw ch))) + (geometry [_] + (->Size mw mh))) + mw mh *miniature-thread-priority*)) ;;(defn- translate [^AffineTransform transform ^double x ^double y] ;; (doto ^AffineTransform (.clone transform) @@ -307,17 +299,22 @@ ;; State (refs) transform fix-x fix-y - last-width last-height last-anchor] + last-width last-height + last-anchor-x last-anchor-y] Layer (render! [layer] (repaint-on-update layer) (with-handlers layer - (let [anchor (anchor content h-align v-align)] + (let [geom (geometry content) + cw (width geom) + ch (height geom) + ax (anchor-x geom h-align cw) + ay (anchor-y geom v-align ch)] (dosync (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))] + ax2 (- @last-anchor-x ax) + ay2 (- @last-anchor-y ay)] (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2)) (ref-set transform (doto (AffineTransform/getTranslateInstance ax1 ay1) @@ -325,10 +322,11 @@ (.translate ax2 ay2))))) (ref-set last-width *width*) (ref-set last-height *height*) - (ref-set last-anchor anchor)) + (ref-set last-anchor-x ax) + (ref-set last-anchor-y ay)) ;; TODO: notify observers when size changes. (with-transform @transform - (draw! content 0 0 false))) + (draw! content 0 0 cw ch false))) (:mouse-pressed e (dosync (ref-set fix-x (:x-on-screen e)) @@ -360,8 +358,8 @@ *viewport-max-scale*) (ref-set transform scaled)))) (update layer)))) - (layer-size [layer] - (layer-size content))) + (geometry [_] + (geometry content))) (defn viewport "Creates scrollable viewport layer." @@ -372,31 +370,32 @@ (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 + (ref 0) (ref 0)))) ; last-anchor-x last-anchor-y (defn reset-viewport [viewport] (dosync (ref-set (:last-width viewport) 0) (ref-set (:last-height viewport) 0) - (ref-set (:last-anchor viewport) (Location. 0 0)) + (ref-set (:last-anchor-x viewport) 0) + (ref-set (:last-anchor-y viewport) 0) (ref-set (:transform viewport) (AffineTransform.))) (update viewport)) (defn viewport-miniature "Creates miniature view of the viewport's contents." - [viewport width height] - (let [miniature (miniature (:content viewport) width height)] + [viewport m-width m-height] + (let [miniature (miniature (:content viewport) m-width m-height)] (decorate-layer miniature [l] (repaint-on-update viewport) - (let [size (layer-size (:content viewport)) - s (scaling (:width size) (:height size) width height) + (let [geom (geometry (:content viewport)) + s (scaling (width geom) (height geom) m-width m-height) [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) + ox (align-x (width geom) (/ m-width s) :center) + oy (align-y (height geom) (/ m-height s) :center) transform (doto (AffineTransform.) (.scale s s) (.translate ox oy) @@ -433,15 +432,10 @@ (repaint-on-update l) (if-let [layer @layer-ref] (render! layer))) - (layer-size [_] + (geometry [_] (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))))] + (geometry layer) + (->Size 1 1))))] (add-watch layer-ref l (fn [_ _ _ _] (update l))) l)) @@ -463,16 +457,12 @@ (apply array-map map-or-keyvals))] (reify Layer - (render! [t] + (render! [_] (with-theme theme (render! layer))) - (layer-size [t] + (geometry [_] (with-theme theme - (layer-size layer))) - Anchored - (anchor [t xa ya] - (with-theme theme - (anchor layer xa ya)))))) + (geometry layer)))))) (defn hinted [layer & map-or-keyvals] (let [hints (if (== (count map-or-keyvals) 1) @@ -549,7 +539,17 @@ ([layer transform x y w h] (let [p (to-graphics-coords transform x y)] (draw! layer (.x p) (.y p) w h)))) - + +(defn- draw-relative-aligned! + [layer transform h-align v-align x y] + (let [geom (geometry layer) + w (width geom) + h (height geom) + p (to-graphics-coords transform x y) + x (- (.x p) (anchor-x geom h-align w)) + y (- (.y p) (anchor-y geom v-align h))] + (draw! layer x y w h))) + (defn overlay! "Draws layer in the overlayer context above the other layers." ([layer] @@ -559,6 +559,11 @@ ([layer x y w h] (overlay* draw-relative! layer (.getTransform *graphics*) x y w h))) +(defn overlay-aligned! [layer h-align v-align x y] + (overlay* draw-relative-aligned! + layer (.getTransform *graphics*) + h-align v-align x y)) + (defn overlayer [content] (decorate-layer content [_] @@ -566,3 +571,15 @@ (render! content) (doseq [f *above*] (f))))) + +(defn overlayer* + [content] + (decorate-layer content [_] + (binding [*above* []] + (render! content) + (loop [above *above*] + (when (seq above) + (var-set #'*above* []) + (doseq [f above] + (f)) + (recur *above*))))))