1.1 --- a/src/net/kryshen/indyvon/demo.clj	Mon Jan 07 19:51:21 2013 +0400
     1.2 +++ b/src/net/kryshen/indyvon/demo.clj	Mon Jan 07 19:52:23 2013 +0400
     1.3 @@ -1,5 +1,5 @@
     1.4  ;;
     1.5 -;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
     1.6 +;; Copyright 2010, 2011, 2012 Mikhail Kryshen <mikhail@kryshen.net>
     1.7  ;;
     1.8  ;; This file is part of Indyvon.
     1.9  ;;
    1.10 @@ -21,7 +21,7 @@
    1.11    "Indyvon demo and experiments."
    1.12    (:gen-class)
    1.13    (:use
    1.14 -   (net.kryshen.indyvon core layers component))
    1.15 +   (net.kryshen.indyvon core layers viewport component))
    1.16    (:import
    1.17     (java.awt Color)
    1.18     (javax.swing JFrame)))

     2.1 --- a/src/net/kryshen/indyvon/layers.clj	Mon Jan 07 19:51:21 2013 +0400
     2.2 +++ b/src/net/kryshen/indyvon/layers.clj	Mon Jan 07 19:52:23 2013 +0400
     2.3 @@ -22,11 +22,10 @@
     2.4    (:use
     2.5     (net.kryshen.indyvon core async))
     2.6    (:import
     2.7 -   (java.lang.ref SoftReference)
     2.8 -   (java.awt Font Cursor Image Toolkit Point)
     2.9 +   (java.awt Font Image Toolkit)
    2.10     java.awt.image.ImageObserver
    2.11 -   (java.awt.geom AffineTransform Rectangle2D$Double Point2D$Double
    2.12 -                  Path2D Path2D$Double)
    2.13 +   (java.awt.geom Area AffineTransform Rectangle2D$Double Point2D
    2.14 +                  Point2D$Double)
    2.15     (java.awt.font FontRenderContext TextLayout)
    2.16     java.util.concurrent.TimeUnit
    2.17     (com.google.common.cache Cache CacheBuilder CacheLoader)))
    2.18 @@ -94,12 +93,10 @@
    2.19           (with-color :border-color
    2.20             (let [w (double *width*)
    2.21                   h (double *height*)
    2.22 -                 outer (Rectangle2D$Double. 0.0 0.0 w h)
    2.23 -                 inner (Rectangle2D$Double. t t (- w t t) (- h t t))]
    2.24 -             (.fill *graphics*
    2.25 -                    (doto (Path2D$Double. Path2D/WIND_EVEN_ODD)
    2.26 -                      (.append outer false)
    2.27 -                      (.append inner false)))))))))
    2.28 +                 outer (Area. (Rectangle2D$Double. 0.0 0.0 w h))
    2.29 +                 inner (Area. (Rectangle2D$Double. t t (- w t t) (- h t t)))]
    2.30 +             (.subtract outer inner)
    2.31 +             (.fill *graphics* outer)))))))
    2.32  
    2.33  ;; TODO: opacity and blur.
    2.34  (defn shadow
    2.35 @@ -261,196 +258,6 @@
    2.36  
    2.37  (def ^:dynamic *miniature-thread-priority* 2)
    2.38  
    2.39 -(defn- scaling
    2.40 -  [width height max-width max-height]
    2.41 -  (min (/ max-width width)
    2.42 -       (/ max-height height)))
    2.43 -
    2.44 -(defn miniature
    2.45 -  "Creates layer that asynchronously renders view of the content
    2.46 -  scaled to the specified size."
    2.47 -  [content mw mh]
    2.48 -  (async-layer
    2.49 -   (reify
    2.50 -    Layer
    2.51 -    (render! [this]
    2.52 -      (let [geom (geometry content)
    2.53 -            cw (width geom)
    2.54 -            ch (height geom)
    2.55 -            s (scaling cw ch mw mh)]
    2.56 -        (.scale *graphics* s s)
    2.57 -        (draw! content
    2.58 -               (align-x cw (/ mw s) :center)
    2.59 -               (align-y ch (/ mh s) :center)
    2.60 -               cw ch)))
    2.61 -    (geometry [_]
    2.62 -      (->Size mw mh)))
    2.63 -   mw mh *miniature-thread-priority*))
    2.64 -
    2.65 -;;(defn- translate [^AffineTransform transform ^double x ^double y]
    2.66 -;;  (doto ^AffineTransform (.clone transform)
    2.67 -;;        (.translate x y)))
    2.68 -
    2.69 -(defn- scale [^AffineTransform transform ^double sx ^double sy]
    2.70 -    (doto ^AffineTransform (.clone transform)
    2.71 -        (.scale sx sy)))
    2.72 -
    2.73 -(defn- pre-translate [^AffineTransform transform ^double x ^double y]
    2.74 -  (if (== 0.0 x y)
    2.75 -    transform
    2.76 -    (doto (AffineTransform/getTranslateInstance x y)
    2.77 -      (.concatenate transform))))
    2.78 -
    2.79 -(def ^:dynamic *viewport-scaling-step* (double 3/4))
    2.80 -(def ^:dynamic *viewport-min-scale* 1E-6)
    2.81 -(def ^:dynamic *viewport-max-scale* 1E6)
    2.82 -
    2.83 -(declare scale-viewport)
    2.84 -
    2.85 -(defrecord Viewport [content h-align v-align
    2.86 -                     ;; State (refs)
    2.87 -                     transform
    2.88 -                     fix-x fix-y
    2.89 -                     last-width last-height
    2.90 -                     last-anchor-x last-anchor-y]
    2.91 -  Layer
    2.92 -  (render! [layer]
    2.93 -    (repaint-on-update layer)
    2.94 -    (with-handlers layer
    2.95 -      (let [geom (geometry content)
    2.96 -            cw (width geom)
    2.97 -            ch (height geom)
    2.98 -            ax (anchor-x geom h-align cw)
    2.99 -            ay (anchor-y geom v-align ch)]
   2.100 -        (dosync
   2.101 -         (let [ax1 (align-x @last-width *width* h-align)
   2.102 -               ay1 (align-y @last-height *height* v-align)
   2.103 -               ax2 (- @last-anchor-x ax)
   2.104 -               ay2 (- @last-anchor-y ay)]
   2.105 -           (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2))
   2.106 -             (ref-set transform
   2.107 -                      (doto (AffineTransform/getTranslateInstance ax1 ay1)
   2.108 -                        (.concatenate @transform)
   2.109 -                        (.translate ax2 ay2)))))
   2.110 -         (ref-set last-width *width*)
   2.111 -         (ref-set last-height *height*)
   2.112 -         (ref-set last-anchor-x ax)
   2.113 -         (ref-set last-anchor-y ay))
   2.114 -        ;; TODO: notify observers when size changes.
   2.115 -        (with-transform @transform
   2.116 -          (draw! content 0 0 cw ch false)))
   2.117 -      (:mouse-pressed e
   2.118 -       (dosync
   2.119 -        (ref-set fix-x (:x-on-screen e))
   2.120 -        (ref-set fix-y (:y-on-screen e)))
   2.121 -       (set-cursor! (Cursor. Cursor/MOVE_CURSOR)))
   2.122 -      (:mouse-released e
   2.123 -       (set-cursor! (Cursor. Cursor/DEFAULT_CURSOR)))
   2.124 -      (:mouse-dragged e
   2.125 -       (dosync
   2.126 -        (alter transform pre-translate
   2.127 -               (- (:x-on-screen e) @fix-x)
   2.128 -               (- (:y-on-screen e) @fix-y))
   2.129 -        (ref-set fix-x (:x-on-screen e))
   2.130 -        (ref-set fix-y (:y-on-screen e)))
   2.131 -       (update layer))
   2.132 -      (:mouse-wheel e
   2.133 -       (scale-viewport
   2.134 -        layer
   2.135 -        (Math/pow *viewport-scaling-step* (:wheel-rotation e))
   2.136 -        true (:x e) (:y e)))))
   2.137 -  (geometry [_]
   2.138 -    (geometry content)))
   2.139 -
   2.140 -(defn viewport
   2.141 -  "Creates scrollable viewport layer."
   2.142 -  ([content]
   2.143 -     (viewport content :left :top))
   2.144 -  ([content h-align v-align]
   2.145 -     (Viewport. content h-align v-align
   2.146 -                (ref (AffineTransform.)) ; transform
   2.147 -                (ref 0) (ref 0)          ; fix-x fix-y
   2.148 -                (ref 0) (ref 0)          ; last-width last-height
   2.149 -                (ref 0) (ref 0))))       ; last-anchor-x last-anchor-y
   2.150 -
   2.151 -(defn scale-viewport
   2.152 -  ([viewport s]
   2.153 -     (scale-viewport viewport s true))
   2.154 -  ([viewport s relative?]
   2.155 -     (scale-viewport viewport s relative? nil nil))
   2.156 -  ([viewport s relative? x y]
   2.157 -     (dosync
   2.158 -      (let [^AffineTransform tr @(:transform viewport)
   2.159 -            sx (if relative? s (/ s (.getScaleX tr)))
   2.160 -            sy (if relative? s (/ s (.getScaleY tr)))
   2.161 -            x (or x (align-x 0 @(:last-width viewport) (:h-align viewport)))
   2.162 -            y (or y (align-y 0 @(:last-height viewport) (:v-align viewport)))
   2.163 -            x (- x (* x sx))
   2.164 -            y (- y (* y sy))
   2.165 -            scaled (doto (AffineTransform/getTranslateInstance x y)
   2.166 -                     (.scale sx sy)
   2.167 -                     (.concatenate tr))
   2.168 -            sx (.getScaleX scaled)
   2.169 -            sy (.getScaleY scaled)]
   2.170 -        (if (<= *viewport-min-scale*
   2.171 -                (min sx sy)
   2.172 -                (max sx sy)
   2.173 -                *viewport-max-scale*)
   2.174 -          (ref-set (:transform viewport) scaled))))
   2.175 -     (update viewport)))
   2.176 -
   2.177 -(defn reset-viewport [viewport]
   2.178 -  (dosync
   2.179 -   (ref-set (:last-width viewport) 0)
   2.180 -   (ref-set (:last-height viewport) 0)
   2.181 -   (ref-set (:last-anchor-x viewport) 0)
   2.182 -   (ref-set (:last-anchor-y viewport) 0)
   2.183 -   (ref-set (:transform viewport) (AffineTransform.)))
   2.184 -  (update viewport))
   2.185 -
   2.186 -(defn viewport-miniature
   2.187 -  "Creates miniature view of the viewport's contents."
   2.188 -  [viewport m-width m-height]
   2.189 -  (let [miniature (miniature (:content viewport) m-width m-height)]
   2.190 -    (decorate-layer miniature [l]
   2.191 -      (repaint-on-update viewport)
   2.192 -      (let [geom (geometry (:content viewport))
   2.193 -            s (scaling (width geom) (height geom) m-width m-height)
   2.194 -            [vp-tr w h] (dosync
   2.195 -                         [@(:transform viewport)
   2.196 -                          @(:last-width viewport)
   2.197 -                          @(:last-height viewport)])
   2.198 -            vp-inverse (.createInverse ^AffineTransform vp-tr)
   2.199 -            ox (align-x (width geom) (/ m-width s) :center)
   2.200 -            oy (align-y (height geom) (/ m-height s) :center)
   2.201 -            transform (doto (AffineTransform.)
   2.202 -                        (.scale s s)
   2.203 -                        (.translate ox oy)
   2.204 -                        (.concatenate vp-inverse))
   2.205 -            move-vp (fn [x y]
   2.206 -                      (dosync
   2.207 -                       (let [x (- (/ x s) ox)
   2.208 -                             y (- (/ y s) oy)
   2.209 -                             [x y] (transform-point @(:transform viewport)
   2.210 -                                                    x y)
   2.211 -                             x (- x (/ @(:last-width viewport) 2))
   2.212 -                             y (- y (/ @(:last-height viewport) 2))]
   2.213 -                         (alter (:transform viewport)
   2.214 -                                pre-translate (- x) (- y))))
   2.215 -                      (update viewport))]
   2.216 -        (with-color :alt-back-color
   2.217 -          (.fillRect *graphics* 0 0 *width* *height*))
   2.218 -        (with-transform transform
   2.219 -          (with-color :back-color
   2.220 -            (.fillRect *graphics* 0 0 w h)))
   2.221 -        (with-handlers l
   2.222 -          (draw! miniature)
   2.223 -          (:mouse-pressed e (move-vp (:x e) (:y e)))
   2.224 -          (:mouse-dragged e (move-vp (:x e) (:y e))))
   2.225 -        (with-transform transform
   2.226 -          (with-color :border-color
   2.227 -            (.drawRect *graphics* 0 0 w h)))))))
   2.228 -
   2.229  (defn ref-layer
   2.230    [layer-ref]
   2.231    (let [l (reify
   2.232 @@ -552,9 +359,9 @@
   2.233  (defn- overlay* [f & args]
   2.234    (var-set #'*above* (conj *above* (apply partial f args))))
   2.235  
   2.236 -(defn- ^Point to-graphics-coords
   2.237 +(defn- ^Point2D to-graphics-coords
   2.238    [^AffineTransform transform x y]
   2.239 -  (let [p (Point. x y)]
   2.240 +  (let [p (Point2D$Double. x y)]
   2.241      (.transform transform p p)
   2.242      (.transform (.createInverse (.getTransform *graphics*)) p p)
   2.243      p))
   2.244 @@ -562,10 +369,10 @@
   2.245  (defn- draw-relative!
   2.246    ([layer transform x y]
   2.247       (let [p (to-graphics-coords transform x y)]
   2.248 -       (draw! layer (.x p) (.y p))))
   2.249 +       (draw! layer (.getX p) (.getY p))))
   2.250    ([layer transform x y w h]
   2.251       (let [p (to-graphics-coords transform x y)]
   2.252 -       (draw! layer (.x p) (.y p) w h))))
   2.253 +       (draw! layer (.getX p) (.getY p) w h))))
   2.254  
   2.255  (defn- draw-relative-aligned!
   2.256    [layer transform h-align v-align x y]
   2.257 @@ -573,8 +380,8 @@
   2.258          w (width geom)
   2.259          h (height geom)
   2.260          p (to-graphics-coords transform x y)
   2.261 -        x (- (.x p) (anchor-x geom h-align w))
   2.262 -        y (- (.y p) (anchor-y geom v-align h))]
   2.263 +        x (- (.getX p) (anchor-x geom h-align w))
   2.264 +        y (- (.getY p) (anchor-y geom v-align h))]
   2.265      (draw! layer x y w h)))
   2.266  
   2.267  (defn overlay!
   2.268 @@ -591,22 +398,25 @@
   2.269              layer (.getTransform *graphics*)
   2.270              h-align v-align x y))
   2.271  
   2.272 -(defn overlayer
   2.273 -  [content]
   2.274 -  (decorate-layer content [_]
   2.275 -    (binding [*above* []]
   2.276 -      (render! content)
   2.277 -      (doseq [f *above*]
   2.278 -        (f)))))
   2.279 -
   2.280 -(defn overlayer*
   2.281 -  [content]
   2.282 -  (decorate-layer content [_]
   2.283 -    (binding [*above* []]
   2.284 -      (render! content)
   2.285 +(defn with-overlays* [rec? f & args]
   2.286 +  (binding [*above* []]
   2.287 +    (apply f args)
   2.288 +    (if rec?
   2.289        (loop [above *above*]
   2.290          (when (seq above)
   2.291            (var-set #'*above* [])
   2.292            (doseq [f above]
   2.293              (f))
   2.294 -          (recur *above*))))))
   2.295 +          (recur *above*)))
   2.296 +      (doseq [of *above*]
   2.297 +        (of)))))
   2.298 +
   2.299 +(defmacro with-overlays [rec? & body]
   2.300 +  `(with-overlays* ~rec? (fn [] ~@body)))
   2.301 +
   2.302 +(defn overlayer
   2.303 +  ([content]
   2.304 +     (overlayer content true))
   2.305 +  ([content rec?]
   2.306 +     (decorate-layer content [_]
   2.307 +       (with-overlays* rec? render! content))))

     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/net/kryshen/indyvon/viewport.clj	Mon Jan 07 19:52:23 2013 +0400
     3.3 @@ -0,0 +1,238 @@
     3.4 +;;
     3.5 +;; Copyright 2010, 2011, 2012 Mikhail Kryshen <mikhail@kryshen.net>
     3.6 +;;
     3.7 +;; This file is part of Indyvon.
     3.8 +;;
     3.9 +;; Indyvon is free software: you can redistribute it and/or modify it
    3.10 +;; under the terms of the GNU Lesser General Public License version 3
    3.11 +;; only, as published by the Free Software Foundation.
    3.12 +;;
    3.13 +;; Indyvon is distributed in the hope that it will be useful, but
    3.14 +;; WITHOUT ANY WARRANTY; without even the implied warranty of
    3.15 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    3.16 +;; Lesser General Public License for more details.
    3.17 +;;
    3.18 +;; You should have received a copy of the GNU Lesser General Public
    3.19 +;; License along with Indyvon.  If not, see
    3.20 +;; <http://www.gnu.org/licenses/>.
    3.21 +;;
    3.22 +
    3.23 +(ns net.kryshen.indyvon.viewport
    3.24 +  "Scrollable viewport and miniature."
    3.25 +  (:use
    3.26 +   (net.kryshen.indyvon core async layers))
    3.27 +  (:import
    3.28 +   java.awt.Cursor
    3.29 +   java.awt.geom.AffineTransform))
    3.30 +  
    3.31 +;;(defn- translate [^AffineTransform transform ^double x ^double y]
    3.32 +;;  (doto ^AffineTransform (.clone transform)
    3.33 +;;        (.translate x y)))
    3.34 +
    3.35 +(defn- scale [^AffineTransform transform ^double sx ^double sy]
    3.36 +    (doto ^AffineTransform (.clone transform)
    3.37 +        (.scale sx sy)))
    3.38 +
    3.39 +(defn- pre-translate [^AffineTransform transform ^double x ^double y]
    3.40 +  (if (== 0.0 x y)
    3.41 +    transform
    3.42 +    (doto (AffineTransform/getTranslateInstance x y)
    3.43 +      (.concatenate transform))))
    3.44 +
    3.45 +(def ^:dynamic *viewport-scaling-step* (double 3/4))
    3.46 +(def ^:dynamic *viewport-min-scale* 1E-6)
    3.47 +(def ^:dynamic *viewport-max-scale* 1E6)
    3.48 +
    3.49 +(def ^:dynamic *viewport* nil)
    3.50 +(def ^:dynamic ^AffineTransform *viewport-transform*)
    3.51 +
    3.52 +(declare scale-viewport!)
    3.53 +
    3.54 +(defrecord ViewportState [transform
    3.55 +                          fix-x fix-y
    3.56 +                          last-width last-height
    3.57 +                          last-anchor-x last-anchor-y])
    3.58 +
    3.59 +(defn- update-viewport [state content-geom h-align v-align]
    3.60 +  (let [w *width*
    3.61 +        h *height*
    3.62 +        cw (width content-geom)
    3.63 +        ch (height content-geom)
    3.64 +        ax (anchor-x content-geom h-align cw)
    3.65 +        ay (anchor-y content-geom v-align ch)
    3.66 +        ax1 (align-x (:last-width state) w h-align)
    3.67 +        ay1 (align-y (:last-height state) h v-align)
    3.68 +        ax2 (- (:last-anchor-x state) ax)
    3.69 +        ay2 (- (:last-anchor-y state) ay)
    3.70 +        transform (:transform state)
    3.71 +        transform (if (and (zero? ax1) (zero? ay1)
    3.72 +                           (zero? ax2) (zero? ay2))
    3.73 +                    transform
    3.74 +                    (doto
    3.75 +                        (AffineTransform/getTranslateInstance ax1 ay1)
    3.76 +                      (.concatenate transform)
    3.77 +                      (.translate ax2 ay2)))]
    3.78 +    (assoc state
    3.79 +      :last-width w
    3.80 +      :last-height h
    3.81 +      :last-anchor-x ax
    3.82 +      :last-anchor-y ay
    3.83 +      :transform transform)))
    3.84 +
    3.85 +(defrecord Viewport [content h-align v-align state]
    3.86 +  Layer
    3.87 +  (render! [layer]
    3.88 +    (repaint-on-update layer)
    3.89 +    (with-handlers layer
    3.90 +      (let [geom (geometry content)
    3.91 +            new-state (swap! state update-viewport geom h-align v-align)
    3.92 +            transform (:transform new-state)]
    3.93 +        ;; TODO: notify observers when size changes.
    3.94 +        (binding [*viewport* layer
    3.95 +                  *viewport-transform* transform]
    3.96 +          (with-transform transform
    3.97 +            (draw! content 0 0 (width geom) (height geom) false))))
    3.98 +      (:mouse-pressed e
    3.99 +       (swap! state assoc
   3.100 +              :fix-x (:x-on-screen e)
   3.101 +              :fix-y (:y-on-screen e))
   3.102 +       (set-cursor! (Cursor. Cursor/MOVE_CURSOR)))
   3.103 +      (:mouse-released e
   3.104 +       (set-cursor! (Cursor. Cursor/DEFAULT_CURSOR)))
   3.105 +      (:mouse-dragged e
   3.106 +       (swap! state
   3.107 +              (fn [s]
   3.108 +                (assoc s
   3.109 +                  :transform (pre-translate
   3.110 +                              (:transform s)
   3.111 +                              (- (:x-on-screen e) (:fix-x s))
   3.112 +                              (- (:y-on-screen e) (:fix-y s)))
   3.113 +                  :fix-x (:x-on-screen e)
   3.114 +                  :fix-y (:y-on-screen e))))
   3.115 +       (update layer))
   3.116 +      (:mouse-wheel e
   3.117 +       (scale-viewport!
   3.118 +        layer
   3.119 +        (Math/pow *viewport-scaling-step* (:wheel-rotation e))
   3.120 +        true (:x e) (:y e)))))
   3.121 +  (geometry [_]
   3.122 +    (geometry content)))
   3.123 +
   3.124 +(def ^:private viewport-initial-state
   3.125 +  (->ViewportState
   3.126 +   (AffineTransform.) ; transform
   3.127 +   0 0                ; fix-x fix-y
   3.128 +   0 0                ; last-width last-height
   3.129 +   0 0))
   3.130 +
   3.131 +(defn viewport
   3.132 +  "Creates scrollable viewport layer."
   3.133 +  ([content]
   3.134 +     (viewport content :left :top))
   3.135 +  ([content h-align v-align]
   3.136 +     (->Viewport content h-align v-align (atom viewport-initial-state))))
   3.137 +
   3.138 +(defn- scale-viewport [state vp s relative? x y]
   3.139 +  (let [^AffineTransform tr (:transform state)
   3.140 +        sx (if relative? s (/ s (.getScaleX tr)))
   3.141 +        sy (if relative? s (/ s (.getScaleY tr)))
   3.142 +        x (or x (align-x 0 (:last-width state) (:h-align vp)))
   3.143 +        y (or y (align-y 0 (:last-height state) (:v-align vp)))
   3.144 +        x (- x (* x sx))
   3.145 +        y (- y (* y sy))
   3.146 +        scaled (doto (AffineTransform/getTranslateInstance x y)
   3.147 +                 (.scale sx sy)
   3.148 +                 (.concatenate tr))
   3.149 +        sx (.getScaleX scaled)
   3.150 +        sy (.getScaleY scaled)]
   3.151 +    (if (<= *viewport-min-scale*
   3.152 +            (min sx sy)
   3.153 +            (max sx sy)
   3.154 +            *viewport-max-scale*)
   3.155 +      (assoc state
   3.156 +        :transform scaled)
   3.157 +      state)))
   3.158 +
   3.159 +(defn scale-viewport!
   3.160 +  ([viewport s]
   3.161 +     (scale-viewport! viewport s true))
   3.162 +  ([viewport s relative?]
   3.163 +     (scale-viewport! viewport s relative? nil nil))
   3.164 +  ([viewport s relative? x y]
   3.165 +     (swap! (:state viewport) scale-viewport viewport s relative? x y)
   3.166 +     (update viewport)))
   3.167 +
   3.168 +(defn reset-viewport! [viewport]
   3.169 +  (reset! (:state viewport) viewport-initial-state)
   3.170 +  (update viewport))
   3.171 +
   3.172 +(defn ^AffineTransform viewport-transform [viewport]
   3.173 +  (:transform @(:state viewport)))
   3.174 +
   3.175 +(defn- scaling
   3.176 +  [width height max-width max-height]
   3.177 +  (min (/ max-width width)
   3.178 +       (/ max-height height)))
   3.179 +
   3.180 +(defn miniature
   3.181 +  "Creates layer that asynchronously renders view of the content
   3.182 +  scaled to the specified size."
   3.183 +  [content mw mh]
   3.184 +  (async-layer
   3.185 +   (reify
   3.186 +    Layer
   3.187 +    (render! [this]
   3.188 +      (let [geom (geometry content)
   3.189 +            cw (width geom)
   3.190 +            ch (height geom)
   3.191 +            s (scaling cw ch mw mh)]
   3.192 +        (.scale *graphics* s s)
   3.193 +        (draw! content
   3.194 +               (align-x cw (/ mw s) :center)
   3.195 +               (align-y ch (/ mh s) :center)
   3.196 +               cw ch)))
   3.197 +    (geometry [_]
   3.198 +      (->Size mw mh)))
   3.199 +   mw mh *miniature-thread-priority*))
   3.200 +
   3.201 +(defn viewport-miniature
   3.202 +  "Creates miniature view of the viewport's contents."
   3.203 +  [viewport m-width m-height]
   3.204 +  (let [miniature (miniature (:content viewport) m-width m-height)]
   3.205 +    (decorate-layer miniature [l]
   3.206 +      (repaint-on-update viewport)
   3.207 +      (let [geom (geometry (:content viewport))
   3.208 +            s (scaling (width geom) (height geom) m-width m-height)
   3.209 +            vp-state @(:state viewport)
   3.210 +            {:keys [transform last-width last-height]} @(:state viewport)
   3.211 +            ox (align-x (width geom) (/ m-width s) :center)
   3.212 +            oy (align-y (height geom) (/ m-height s) :center)
   3.213 +            inverse (.createInverse ^AffineTransform transform)
   3.214 +            transform (doto (AffineTransform.)
   3.215 +                        (.scale s s)
   3.216 +                        (.translate ox oy)
   3.217 +                        (.concatenate inverse))
   3.218 +            move-vp (fn [state x y]
   3.219 +                      (let [x (- (/ x s) ox)
   3.220 +                            y (- (/ y s) oy)
   3.221 +                            tr (:transform state)
   3.222 +                            [x y] (transform-point tr x y)
   3.223 +                            x (- x (/ (:last-width state) 2))
   3.224 +                            y (- y (/ (:last-height state) 2))]
   3.225 +                        (assoc state
   3.226 +                          :transform (pre-translate tr (- x) (- y)))))
   3.227 +            move-vp! (fn [x y]
   3.228 +                       (swap! (:state viewport) move-vp x y)
   3.229 +                       (update viewport))]
   3.230 +        (with-color :alt-back-color
   3.231 +          (.fillRect *graphics* 0 0 *width* *height*))
   3.232 +        (with-transform transform
   3.233 +          (with-color :back-color
   3.234 +            (.fillRect *graphics* 0 0 last-width last-height)))
   3.235 +        (with-handlers l
   3.236 +          (draw! miniature)
   3.237 +          (:mouse-pressed e (move-vp! (:x e) (:y e)))
   3.238 +          (:mouse-dragged e (move-vp! (:x e) (:y e))))
   3.239 +        (with-transform transform
   3.240 +          (with-color :border-color
   3.241 +            (.drawRect *graphics* 0 0 last-width last-height)))))))