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*))))))