1.1 --- a/README.rst	Tue May 24 18:43:49 2011 +0400
     1.2 +++ b/README.rst	Wed Sep 21 02:27:11 2011 +0300
     1.3 @@ -11,7 +11,7 @@
     1.4    (defprotocol Layer
     1.5      (render! [layer]
     1.6        "Draws the layer.")
     1.7 -    (layer-size [layer]
     1.8 +    (geometry [layer]
     1.9        "Returns preferred size for the layer."))
    1.10  
    1.11  Layer functions are called in the Layer context which is defined by

     2.1 --- a/README.ru	Tue May 24 18:43:49 2011 +0400
     2.2 +++ b/README.ru	Wed Sep 21 02:27:11 2011 +0300
     2.3 @@ -15,7 +15,7 @@
     2.4  (слой), который содержит всего две функции:
     2.5  
     2.6    render! — отрисовка,
     2.7 -  layer-size — получение предпочтительного размера элемента.
     2.8 +  geometry — получение предпочтительных размеров элемента.
     2.9  
    2.10  Слой, в отличии от обычных компонентов интерфейса или элементов графов
    2.11  сцены в системах визуализации, не имеет состояния (координаты, размер,

     3.1 --- a/project.clj	Tue May 24 18:43:49 2011 +0400
     3.2 +++ b/project.clj	Wed Sep 21 02:27:11 2011 +0300
     3.3 @@ -1,9 +1,8 @@
     3.4  (defproject indyvon "1.0.0-SNAPSHOT"
     3.5    :description "INteractive DYnamic VisualizatiON library"
     3.6    ;;:warn-on-reflection true
     3.7 -  :dependencies [[org.clojure/clojure "1.2.1"]
     3.8 +  :dependencies [[org.clojure/clojure "1.3.0-RC0"]
     3.9                   [com.google.guava/guava "r09"]]
    3.10 -  :dev-dependencies [[swank-clojure "1.3.1"]]
    3.11    ;;:aot [net.kryshen.indyvon.core
    3.12    ;;      net.kryshen.indyvon.async
    3.13    ;;      net.kryshen.indyvon.layers

     4.1 --- a/src/net/kryshen/indyvon/async.clj	Tue May 24 18:43:49 2011 +0400
     4.2 +++ b/src/net/kryshen/indyvon/async.clj	Wed Sep 21 02:27:11 2011 +0300
     4.3 @@ -22,7 +22,6 @@
     4.4    (:use
     4.5     net.kryshen.indyvon.core)
     4.6    (:import
     4.7 -   (net.kryshen.indyvon.core Size Location)
     4.8     java.awt.GraphicsConfiguration
     4.9     (java.awt Image AlphaComposite Transparency)
    4.10     (java.awt.image BufferedImage)
    4.11 @@ -146,8 +145,8 @@
    4.12        (draw-offscreen-async layer))
    4.13      (with-buffer layer :front [b]
    4.14        (.drawImage *graphics* ^Image (:image b) 0 0 nil)))
    4.15 -  (layer-size [layer]
    4.16 -    (Size. width height)))
    4.17 +  (geometry [layer]
    4.18 +    (->Size width height)))
    4.19  
    4.20  (defn- create-thread-factory [priority]
    4.21    (reify

     5.1 --- a/src/net/kryshen/indyvon/component.clj	Tue May 24 18:43:49 2011 +0400
     5.2 +++ b/src/net/kryshen/indyvon/component.clj	Wed Sep 21 02:27:11 2011 +0300
     5.3 @@ -22,7 +22,6 @@
     5.4    (:use
     5.5     net.kryshen.indyvon.core)
     5.6    (:import
     5.7 -   (net.kryshen.indyvon.core Size Bounds)
     5.8     (java.awt Graphics Component Dimension Color)
     5.9     (java.awt.geom Rectangle2D$Double)
    5.10     (javax.swing JFrame JPanel JOptionPane)))
    5.11 @@ -49,8 +48,8 @@
    5.12                   (draw-root! layer g (.width size) (.height size)
    5.13                               event-dispatcher this)))
    5.14               (getPreferredSize []
    5.15 -               (let [s (root-size layer (font-context this) this)]
    5.16 -                 (Dimension. (:width s) (:height s)))))]
    5.17 +               (let [geom (root-geometry layer (font-context this) this)]
    5.18 +                 (Dimension. (width geom) (height geom)))))]
    5.19         (.setBackground panel (:back-color *theme*))
    5.20         (add-observer panel layer (fn [w _]
    5.21                                     ;; Use the first observer argument

     6.1 --- a/src/net/kryshen/indyvon/core.clj	Tue May 24 18:43:49 2011 +0400
     6.2 +++ b/src/net/kryshen/indyvon/core.clj	Wed Sep 21 02:27:11 2011 +0300
     6.3 @@ -93,18 +93,88 @@
     6.4  
     6.5  (def ^{:dynamic true} *theme* (default-theme))
     6.6  
     6.7 -(defrecord Location [x y])
     6.8 -(defrecord Size [width height])
     6.9 -(defrecord Bounds [x y width height])
    6.10 -
    6.11  ;;
    6.12  ;; Core protocols and types
    6.13  ;;
    6.14  
    6.15  (defprotocol Layer
    6.16    "Basic UI element."
    6.17 -  (render! [this])
    6.18 -  (layer-size [this]))
    6.19 +  (render! [layer]
    6.20 +    "Draws layer in the current *graphics* context.")
    6.21 +  (geometry [layer]
    6.22 +    "Returns the preferred layer Geometry."))
    6.23 +
    6.24 +(defprotocol Geometry
    6.25 +  "Describes geometry of a Layer. Prefer using the available
    6.26 +  implementations (Size, FixedGeometry and NestedGeometry) over
    6.27 +  extending this protocol directly as it is likely to be changed in
    6.28 +  the future versions."
    6.29 +  (width [geom] [geom height])
    6.30 +  (height [geom] [geom width])
    6.31 +  (anchor-x [geom h-align width]
    6.32 +    "Returns the x coordinate of the anchor point for the specified
    6.33 +     horizontal alignment and width, h-align could be :left, :center
    6.34 +     or :right.")
    6.35 +  (anchor-y [geom v-align height]
    6.36 +    "Returns the y coordinate of the anchor point for the specified
    6.37 +    vertical alignment and height, v-align could be :top, :center
    6.38 +    or :bottom."))
    6.39 +
    6.40 +(defrecord Size [width height]
    6.41 +  Geometry
    6.42 +  (width  [_] width)
    6.43 +  (width [_ _] width)
    6.44 +  (height [_] height)
    6.45 +  (height [_ _] height)
    6.46 +  (anchor-x [_ h-align width]
    6.47 +    (case h-align
    6.48 +      :left 0
    6.49 +      :center (/ width 2)
    6.50 +      :right width))
    6.51 +  (anchor-y [_ v-align height]
    6.52 +    (case v-align
    6.53 +      :top 0
    6.54 +      :center (/ height 2)
    6.55 +      :bottom height)))
    6.56 +
    6.57 +(defrecord FixedGeometry [ax ay width height]
    6.58 +  Geometry
    6.59 +  (width  [_] width)
    6.60 +  (width [_ _] width)
    6.61 +  (height [_] height)
    6.62 +  (height [_ _] height)
    6.63 +  (anchor-x [_ _ _] ax)
    6.64 +  (anchor-y [_ _ _] ay))
    6.65 +
    6.66 +(defrecord NestedGeometry [geometry top left bottom right]
    6.67 +  Geometry
    6.68 +  (width  [_]
    6.69 +    (+ left right (width geometry)))
    6.70 +  (width [_ h]
    6.71 +    (+ left right (width geometry (- h top bottom))))
    6.72 +  (height [_]
    6.73 +    (+ top bottom (height geometry)))
    6.74 +  (height [_ w]
    6.75 +    (+ top bottom (height geometry (- w left right))))
    6.76 +  (anchor-x [_ h-align w]
    6.77 +    (+ left (anchor-x geometry h-align (- w left right))))
    6.78 +  (anchor-y [_ v-align h]
    6.79 +    (+ top (anchor-y geometry v-align (- h top bottom)))))
    6.80 +
    6.81 +(defrecord ScaledGeometry [geometry sx sy]
    6.82 +  Geometry
    6.83 +  (width  [_]
    6.84 +    (* sx (width geometry)))
    6.85 +  (width [_ h]
    6.86 +    (* sx (width geometry (/ h sy))))
    6.87 +  (height [_]
    6.88 +    (* sy (height geometry)))
    6.89 +  (height [_ w]
    6.90 +    (* sy (height geometry (/ w sx))))
    6.91 +  (anchor-x [_ h-align w]
    6.92 +    (* sx (anchor-x geometry h-align (/ w sx))))
    6.93 +  (anchor-y [_ v-align h]
    6.94 +    (* sy (anchor-y geometry v-align (/ h sy)))))
    6.95  
    6.96  ;; TODO: modifiers
    6.97  (defrecord MouseEvent [id when x y x-on-screen y-on-screen button
    6.98 @@ -128,33 +198,6 @@
    6.99       "Returns true if the specified handle received the :mouse-entered
   6.100        event and have not yet received :mouse-exited."))
   6.101  
   6.102 -(defprotocol Anchored
   6.103 -  "Provide anchor point for Layers. Used by viewport."
   6.104 -  (anchor [this h-align v-align]
   6.105 -     "Anchor point: [x y], h-align could be :left, :center or :right,
   6.106 -      v-align is :top, :center or :bottom"))
   6.107 -
   6.108 -(defn default-anchor [layer h-align v-align]
   6.109 -  (if (and (= h-align :left)
   6.110 -           (= v-align :top))
   6.111 -    (Location. 0 0)
   6.112 -    (let [size (layer-size layer)]
   6.113 -      (Location.
   6.114 -       (case h-align
   6.115 -             :left 0
   6.116 -             :center (/ (:width size) 2)
   6.117 -             :right (:width size))
   6.118 -       (case v-align
   6.119 -             :top 0
   6.120 -             :center (/ (:height size) 2)
   6.121 -             :bottom (:height size))))))
   6.122 -
   6.123 -;; Default implementation of Anchored for any Layer.
   6.124 -(extend-protocol Anchored
   6.125 -  net.kryshen.indyvon.core.Layer
   6.126 -  (anchor [this h-align v-align]
   6.127 -    (default-anchor this h-align v-align)))
   6.128 -
   6.129  (defn- assoc-cons [m key val]
   6.130    (->> (get m key) (cons val) (assoc m key)))
   6.131  
   6.132 @@ -408,8 +451,8 @@
   6.133    ([layer x y]
   6.134       (draw! layer x y true))
   6.135    ([layer x y clip?]
   6.136 -     (let [size (layer-size layer)]
   6.137 -       (draw! layer x y (:width size) (:height size) clip?)))
   6.138 +     (let [geom (geometry layer)]
   6.139 +       (draw! layer x y (width geom) (height geom) clip?)))
   6.140    ([layer x y width height]
   6.141       (draw! layer x y width height true))
   6.142    ([layer x y width height clip?]
   6.143 @@ -417,15 +460,23 @@
   6.144         (with-bounds* x y width height render! layer)
   6.145         (with-bounds-noclip* x y width height render! layer))))
   6.146  
   6.147 -(defn draw-anchored!
   6.148 +(defn draw-aligned!
   6.149    "Draws layer. Location is relative to the layer's anchor point for
   6.150     the specified alignment."
   6.151    ([layer h-align v-align x y]
   6.152 -     (let [anchor (anchor layer h-align v-align)]
   6.153 -       (draw! layer (- x (:x anchor)) (- y (:y anchor)))))
   6.154 +     (let [geom (geometry layer)
   6.155 +           w (width geom)
   6.156 +           h (height geom)]
   6.157 +       (draw! layer
   6.158 +              (- x (anchor-x geom h-align w))
   6.159 +              (- y (anchor-y geom v-align h))
   6.160 +              w h)))
   6.161    ([layer h-align v-align x y w h]
   6.162 -     (let [anchor (anchor layer h-align v-align)]
   6.163 -       (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h))))
   6.164 +     (let [geom (geometry layer)]
   6.165 +       (draw! layer
   6.166 +              (- x (anchor-x geom h-align w))
   6.167 +              (- y (anchor-y geom v-align h))
   6.168 +              w h))))
   6.169  
   6.170  (defn draw-root!
   6.171    "Draws the root layer."
   6.172 @@ -468,14 +519,14 @@
   6.173              (remove-observers tmp-watcher)
   6.174              (commit event-dispatcher)))))))
   6.175  
   6.176 -(defn root-size
   6.177 +(defn root-geometry
   6.178    ([layer font-context]
   6.179 -     (root-size layer font-context nil))
   6.180 +     (root-geometry layer font-context nil))
   6.181    ([layer font-context target]
   6.182       (binding [*root* layer
   6.183                 *target* target
   6.184                 *font-context* font-context]
   6.185 -       (layer-size layer))))
   6.186 +       (geometry layer))))
   6.187  
   6.188  ;;
   6.189  ;; Event handling.

     7.1 --- a/src/net/kryshen/indyvon/demo.clj	Tue May 24 18:43:49 2011 +0400
     7.2 +++ b/src/net/kryshen/indyvon/demo.clj	Wed Sep 21 02:27:11 2011 +0300
     7.3 @@ -23,7 +23,6 @@
     7.4    (:use
     7.5     (net.kryshen.indyvon core layers component))
     7.6    (:import
     7.7 -   (net.kryshen.indyvon.core Size)
     7.8     (java.awt Color)
     7.9     (javax.swing JFrame)))
    7.10  
    7.11 @@ -121,10 +120,10 @@
    7.12            (:mouse-pressed _ (repaint))
    7.13            (:mouse-released _ (repaint))
    7.14            (:mouse-clicked _ (apply callback args))))
    7.15 -     (layer-size [button]
    7.16 -       (let [face-size (layer-size face)]
    7.17 -         (Size. (+ (:width face-size) shadow-offset)
    7.18 -                (+ (:height face-size) shadow-offset))))))))
    7.19 +     (geometry [button]
    7.20 +       (let [face-geom (geometry face)]
    7.21 +         (->Size (+ (width face-geom) shadow-offset)
    7.22 +                 (+ (height face-geom) shadow-offset))))))))
    7.23  
    7.24  (def button1 (animated-button (label "Animated button 1")
    7.25                                println "Animated button 1 clicked"))
    7.26 @@ -147,8 +146,8 @@
    7.27          (println e))
    7.28         (:mouse-moved e
    7.29          (println e))))
    7.30 -   (layer-size [layer]
    7.31 -     (Size. 30 20))))
    7.32 +   (geometry [layer]
    7.33 +     (->Size 30 20))))
    7.34  
    7.35  (def test-layer1b (border test-layer1 2 3))
    7.36  
    7.37 @@ -162,8 +161,8 @@
    7.38       (with-rotate 0.5 0 0
    7.39         (draw! test-layer1b 30 25))
    7.40       (draw! test-layer1 55 5))
    7.41 -   (layer-size [layer]
    7.42 -     (Size. 70 65))))
    7.43 +   (geometry [layer]
    7.44 +     (->Size 70 65))))
    7.45  
    7.46  (def test-layer2m (miniature test-layer2 30 30))
    7.47  
    7.48 @@ -191,8 +190,8 @@
    7.49         (draw-button! :button
    7.50          (label "Immediate button" :center :center)
    7.51          #(println "Button clicked!"))))
    7.52 -   (layer-size [layer]
    7.53 -     (Size. 400 300))))
    7.54 +   (geometry [layer]
    7.55 +     (->Size 400 300))))
    7.56  
    7.57  ;; Main viewport
    7.58  (def vp (viewport root))
    7.59 @@ -205,7 +204,7 @@
    7.60    (fps-layer
    7.61     (decorate-layer vp [_]
    7.62       (draw! vp)
    7.63 -     (draw-anchored!
    7.64 +     (draw-aligned!
    7.65        (label (str "Drag mouse to pan," \newline
    7.66                    "use mouse wheel to zoom."))
    7.67        :left :bottom 5 (- *height* 5))

     8.1 --- a/src/net/kryshen/indyvon/layers.clj	Tue May 24 18:43:49 2011 +0400
     8.2 +++ b/src/net/kryshen/indyvon/layers.clj	Wed Sep 21 02:27:11 2011 +0300
     8.3 @@ -22,7 +22,6 @@
     8.4    (:use
     8.5     (net.kryshen.indyvon core async))
     8.6    (:import
     8.7 -   (net.kryshen.indyvon.core Size Location)
     8.8     (java.lang.ref SoftReference)
     8.9     (java.awt Font Cursor Image Toolkit Point)
    8.10     java.awt.image.ImageObserver
    8.11 @@ -47,14 +46,13 @@
    8.12    `(align-xy ~inner ~outer ~align :top :center :bottom))
    8.13  
    8.14  (defmacro decorate-layer
    8.15 -  "Decorate Layer and Anchored replacing render! implementation."
    8.16 +  "Decorate Layer replacing render! implementation."
    8.17    [layer & render-tail]
    8.18 -  `(reify
    8.19 -    Layer
    8.20 -    (render! ~@render-tail)
    8.21 -    (layer-size [t#] (layer-size ~layer))
    8.22 -    Anchored
    8.23 -    (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
    8.24 +  `(let [layer# ~layer]
    8.25 +     (reify
    8.26 +       Layer
    8.27 +       (render! ~@render-tail)
    8.28 +       (geometry [t#] (geometry layer#)))))
    8.29  
    8.30  (defn padding
    8.31    "Decorates layer adding padding."
    8.32 @@ -70,10 +68,8 @@
    8.33                    left top
    8.34                    (- *width* left right)
    8.35                    (- *height* top bottom)))
    8.36 -        (layer-size [l]
    8.37 -           (let [s (layer-size content)]
    8.38 -             (Size. (+ (:width s) left right)
    8.39 -                    (+ (:height s) top bottom))))))))
    8.40 +        (geometry [l]
    8.41 +          (->NestedGeometry (geometry content) top left bottom right))))))
    8.42  
    8.43  (defn border
    8.44    "Decorate layer with a border."
    8.45 @@ -110,7 +106,6 @@
    8.46             shadow-x (+ x-offset x)
    8.47             shadow-y (+ y-offset y)]
    8.48         (reify
    8.49 -        ;; TODO: Anchored
    8.50          Layer
    8.51          (render! [_]
    8.52            (let [w (- *width* abs-x)
    8.53 @@ -118,10 +113,9 @@
    8.54              (with-color :shadow-color
    8.55                (.fillRect *graphics* shadow-x shadow-y w h))
    8.56              (draw! content x y w h)))
    8.57 -        (layer-size [_]
    8.58 -          (let [s (layer-size content)]
    8.59 -            (Size. (+ (:width s) abs-x)
    8.60 -                   (+ (:height s) abs-y))))))))
    8.61 +        (geometry [_]
    8.62 +          (->NestedGeometry (geometry content)
    8.63 +                            y x shadow-y shadow-x))))))
    8.64  
    8.65  (defn panel
    8.66    "Opaque layer using theme's alt-back-color."
    8.67 @@ -141,17 +135,17 @@
    8.68    (reify
    8.69     Layer
    8.70     (render! [_]
    8.71 -     (let [widths (map #(:width (layer-size %)) contents)
    8.72 +     (let [widths (map #(width (geometry %)) contents)
    8.73             xs (cons 0 (reductions + widths))
    8.74             widths-sum (last xs)
    8.75             scale (/ *width* widths-sum)]
    8.76         (doseq [[c w x] (map vector contents widths xs)]
    8.77           (draw! c x 0 w *height*))))
    8.78 -   (layer-size [_]
    8.79 -     (reduce #(Size. (+ (:width %1) (:width %2))
    8.80 -                     (max (:height %1) (:height %2)))
    8.81 -             (Size. 0 0)
    8.82 -             (map layer-size contents)))))
    8.83 +   (geometry [_]
    8.84 +     (reduce #(->Size (+ (width %1) (width %2))
    8.85 +                      (max (height %1) (height %2)))
    8.86 +             (->Size 0 0)
    8.87 +             (map geometry contents)))))
    8.88  
    8.89  (defn vbox
    8.90    "Creates layer that draws the specified content layers placing them
    8.91 @@ -160,17 +154,17 @@
    8.92    (reify
    8.93     Layer
    8.94     (render! [_]
    8.95 -     (let [heights (map #(:height (layer-size %)) contents)
    8.96 +     (let [heights (map #(height (geometry %)) contents)
    8.97             ys (cons 0 (reductions + heights))
    8.98             heights-sum (last ys)
    8.99             scale (/ *height* heights-sum)]
   8.100         (doseq [[c h y] (map vector contents heights ys)]
   8.101           (draw! c 0 y *width* h))))
   8.102 -   (layer-size [_]
   8.103 -     (reduce #(Size. (max (:width %1) (:width %2))
   8.104 -                     (+ (:height %1) (:height %2)))
   8.105 -             (Size. 0 0)
   8.106 -             (map layer-size contents)))))
   8.107 +   (geometry [_]
   8.108 +     (reduce #(->Size (max (width %1) (width %2))
   8.109 +                      (+ (height %1) (height %2)))
   8.110 +             (->Size 0 0)
   8.111 +             (map geometry contents)))))
   8.112  
   8.113  (defn- re-split [^java.util.regex.Pattern re s]
   8.114    (seq (.split re s)))
   8.115 @@ -223,11 +217,11 @@
   8.116                        x (align-x (.getAdvance layout) w h-align)]
   8.117                    (.draw layout *graphics* x (+ y ascent))
   8.118                    (recur (next layouts) (+ y lh)))))))
   8.119 -        (layer-size [layer]
   8.120 +        (geometry [layer]
   8.121            (let [layouts (layout-text lines (:font *theme*) *font-context*)
   8.122 -                width (text-width layouts)
   8.123 -                height (text-height layouts)]
   8.124 -            (Size. width height)))))))
   8.125 +                w (text-width layouts)
   8.126 +                h (text-height layouts)]
   8.127 +            (->Size w h)))))))
   8.128  
   8.129  (defn- ^ImageObserver image-observer [layer]
   8.130    (reify
   8.131 @@ -250,13 +244,13 @@
   8.132       (render! [layer]
   8.133         (repaint-on-update layer)
   8.134         (.drawImage *graphics* image 0 0 (image-observer layer)))
   8.135 -     (layer-size [layer]
   8.136 +     (geometry [layer]
   8.137         (let [observer (image-observer layer)
   8.138               width (.getWidth image observer)
   8.139               height (.getHeight image observer)
   8.140               width (if (pos? width) width 1)
   8.141               height (if (pos? height) height 1)]
   8.142 -         (Size. width height))))))
   8.143 +         (->Size width height))))))
   8.144  
   8.145  (def ^{:dynamic true} *miniature-thread-priority* 2)
   8.146  
   8.147 @@ -268,24 +262,23 @@
   8.148  (defn miniature
   8.149    "Creates layer that asynchronously renders view of the content
   8.150    scaled to the specified size."
   8.151 -  [content width height]
   8.152 +  [content mw mh]
   8.153    (async-layer
   8.154     (reify
   8.155      Layer
   8.156      (render! [this]
   8.157 -      (let [size (layer-size content)
   8.158 -            s (scaling (:width size) (:height size) width height)]
   8.159 +      (let [geom (geometry content)
   8.160 +            cw (width geom)
   8.161 +            ch (height geom)
   8.162 +            s (scaling cw ch mw mh)]
   8.163          (.scale *graphics* s s)
   8.164          (draw! content
   8.165 -               (align-x (:width size) (/ width s) :center)
   8.166 -               (align-y (:height size) (/ height s) :center)
   8.167 -               (:width size) (:height size))))
   8.168 -    (layer-size [this]
   8.169 -      (Size. width height)))
   8.170 -      ;; (let [size (layer-size content)
   8.171 -      ;;       s (scaling (:width size) (:height size) width height)]  
   8.172 -      ;; (Size. (* (:width size) s) (* (:height size) s)))))
   8.173 -   width height *miniature-thread-priority*))
   8.174 +               (align-x cw (/ mw s) :center)
   8.175 +               (align-y ch (/ mh s) :center)
   8.176 +               cw ch)))
   8.177 +    (geometry [_]
   8.178 +      (->Size mw mh)))
   8.179 +   mw mh *miniature-thread-priority*))
   8.180  
   8.181  ;;(defn- translate [^AffineTransform transform ^double x ^double y]
   8.182  ;;  (doto ^AffineTransform (.clone transform)
   8.183 @@ -309,17 +302,22 @@
   8.184                       ;; State (refs)
   8.185                       transform
   8.186                       fix-x fix-y
   8.187 -                     last-width last-height last-anchor]
   8.188 +                     last-width last-height
   8.189 +                     last-anchor-x last-anchor-y]
   8.190    Layer
   8.191    (render! [layer]
   8.192      (repaint-on-update layer)
   8.193      (with-handlers layer
   8.194 -      (let [anchor (anchor content h-align v-align)]
   8.195 +      (let [geom (geometry content)
   8.196 +            cw (width geom)
   8.197 +            ch (height geom)
   8.198 +            ax (anchor-x geom h-align cw)
   8.199 +            ay (anchor-y geom v-align ch)]
   8.200          (dosync
   8.201           (let [ax1 (align-x @last-width *width* h-align)
   8.202                 ay1 (align-y @last-height *height* v-align)
   8.203 -               ax2 (- (:x @last-anchor) (:x anchor))
   8.204 -               ay2 (- (:y @last-anchor) (:y anchor))]
   8.205 +               ax2 (- @last-anchor-x ax)
   8.206 +               ay2 (- @last-anchor-y ay)]
   8.207             (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2))
   8.208               (ref-set transform
   8.209                        (doto (AffineTransform/getTranslateInstance ax1 ay1)
   8.210 @@ -327,10 +325,11 @@
   8.211                          (.translate ax2 ay2)))))
   8.212           (ref-set last-width *width*)
   8.213           (ref-set last-height *height*)
   8.214 -         (ref-set last-anchor anchor))
   8.215 +         (ref-set last-anchor-x ax)
   8.216 +         (ref-set last-anchor-y ay))
   8.217          ;; TODO: notify observers when size changes.
   8.218          (with-transform @transform
   8.219 -          (draw! content 0 0 false)))
   8.220 +          (draw! content 0 0 cw ch false)))
   8.221        (:mouse-pressed e
   8.222         (dosync
   8.223          (ref-set fix-x (:x-on-screen e))
   8.224 @@ -364,8 +363,8 @@
   8.225                    *viewport-max-scale*)
   8.226              (ref-set transform scaled))))
   8.227         (update layer))))
   8.228 -  (layer-size [layer]
   8.229 -    (layer-size content)))
   8.230 +  (geometry [_]
   8.231 +    (geometry content)))
   8.232  
   8.233  (defn viewport
   8.234    "Creates scrollable viewport layer."
   8.235 @@ -376,31 +375,32 @@
   8.236                  (ref (AffineTransform.)) ; transform
   8.237                  (ref 0) (ref 0)          ; fix-x fix-y
   8.238                  (ref 0) (ref 0)          ; last-width last-height
   8.239 -                (ref (Location. 0 0))))) ; last-anchor
   8.240 +                (ref 0) (ref 0))))       ; last-anchor-x last-anchor-y
   8.241  
   8.242  (defn reset-viewport [viewport]
   8.243    (dosync
   8.244     (ref-set (:last-width viewport) 0)
   8.245     (ref-set (:last-height viewport) 0)
   8.246 -   (ref-set (:last-anchor viewport) (Location. 0 0))
   8.247 +   (ref-set (:last-anchor-x viewport) 0)
   8.248 +   (ref-set (:last-anchor-y viewport) 0)
   8.249     (ref-set (:transform viewport) (AffineTransform.)))
   8.250    (update viewport))
   8.251  
   8.252  (defn viewport-miniature
   8.253    "Creates miniature view of the viewport's contents."
   8.254 -  [viewport width height]
   8.255 -  (let [miniature (miniature (:content viewport) width height)]
   8.256 +  [viewport m-width m-height]
   8.257 +  (let [miniature (miniature (:content viewport) m-width m-height)]
   8.258      (decorate-layer miniature [l]
   8.259        (repaint-on-update viewport)
   8.260 -      (let [size (layer-size (:content viewport))
   8.261 -            s (scaling (:width size) (:height size) width height)
   8.262 +      (let [geom (geometry (:content viewport))
   8.263 +            s (scaling (width geom) (height geom) m-width m-height)
   8.264              [vp-tr w h] (dosync
   8.265                           [@(:transform viewport)
   8.266                            @(:last-width viewport)
   8.267                            @(:last-height viewport)])
   8.268              vp-inverse (.createInverse ^AffineTransform vp-tr)
   8.269 -            ox (align-x (:width size) (/ width s) :center)
   8.270 -            oy (align-y (:height size) (/ height s) :center)
   8.271 +            ox (align-x (width geom) (/ m-width s) :center)
   8.272 +            oy (align-y (height geom) (/ m-height s) :center)
   8.273              transform (doto (AffineTransform.)
   8.274                          (.scale s s)
   8.275                          (.translate ox oy)
   8.276 @@ -437,15 +437,10 @@
   8.277               (repaint-on-update l)
   8.278               (if-let [layer @layer-ref]
   8.279                 (render! layer)))
   8.280 -           (layer-size [_]
   8.281 +           (geometry [_]
   8.282               (if-let [layer @layer-ref]
   8.283 -               (layer-size layer)
   8.284 -               (Size. 1 1)))
   8.285 -           Anchored
   8.286 -           (anchor [_ x-align y-align]
   8.287 -             (if-let [layer @layer-ref]
   8.288 -               (anchor layer x-align y-align)
   8.289 -               (Location. 0 0))))]
   8.290 +               (geometry layer)
   8.291 +               (->Size 1 1))))]
   8.292      (add-watch layer-ref l (fn [_ _ _ _] (update l)))
   8.293      l))
   8.294  
   8.295 @@ -467,16 +462,12 @@
   8.296                  (apply array-map map-or-keyvals))]
   8.297      (reify
   8.298       Layer
   8.299 -     (render! [t]
   8.300 +     (render! [_]
   8.301         (with-theme theme
   8.302           (render! layer)))
   8.303 -     (layer-size [t]
   8.304 +     (geometry [_]
   8.305         (with-theme theme
   8.306 -         (layer-size layer)))
   8.307 -     Anchored
   8.308 -     (anchor [t xa ya]
   8.309 -       (with-theme theme
   8.310 -         (anchor layer xa ya))))))
   8.311 +         (geometry layer))))))
   8.312  
   8.313  (defn hinted [layer & map-or-keyvals]
   8.314    (let [hints (if (== (count map-or-keyvals) 1)
   8.315 @@ -553,7 +544,17 @@
   8.316    ([layer transform x y w h]
   8.317       (let [p (to-graphics-coords transform x y)]
   8.318         (draw! layer (.x p) (.y p) w h))))
   8.319 - 
   8.320 +
   8.321 +(defn- draw-relative-aligned!
   8.322 +  [layer transform h-align v-align x y]
   8.323 +  (let [geom (geometry layer)
   8.324 +        w (width geom)
   8.325 +        h (height geom)
   8.326 +        p (to-graphics-coords transform x y)
   8.327 +        x (- (.x p) (anchor-x geom h-align w))
   8.328 +        y (- (.y p) (anchor-y geom v-align h))]
   8.329 +    (draw! layer x y w h)))
   8.330 +
   8.331  (defn overlay!
   8.332    "Draws layer in the overlayer context above the other layers."
   8.333    ([layer]
   8.334 @@ -563,6 +564,11 @@
   8.335    ([layer x y w h]
   8.336       (overlay* draw-relative! layer (.getTransform *graphics*) x y w h)))
   8.337  
   8.338 +(defn overlay-aligned! [layer h-align v-align x y]
   8.339 +  (overlay* draw-relative-aligned!
   8.340 +            layer (.getTransform *graphics*)
   8.341 +            h-align v-align x y))
   8.342 +
   8.343  (defn overlayer
   8.344    [content]
   8.345    (decorate-layer content [_]
   8.346 @@ -570,3 +576,15 @@
   8.347        (render! content)
   8.348        (doseq [f *above*]
   8.349          (f)))))
   8.350 +
   8.351 +(defn overlayer*
   8.352 +  [content]
   8.353 +  (decorate-layer content [_]
   8.354 +    (binding [*above* []]
   8.355 +      (render! content)
   8.356 +      (loop [above *above*]
   8.357 +        (when (seq above)
   8.358 +          (var-set #'*above* [])
   8.359 +          (doseq [f above]
   8.360 +            (f))
   8.361 +          (recur *above*))))))