1.1 --- a/src/net/kryshen/indyvon/layers.clj	Tue Apr 24 18:47:31 2012 +0400
     1.2 +++ b/src/net/kryshen/indyvon/layers.clj	Tue Apr 24 18:49:06 2012 +0400
     1.3 @@ -130,7 +130,9 @@
     1.4    ([content]
     1.5       (panel content 0))
     1.6    ([content gap]
     1.7 -     (let [layer (padding content gap)]
     1.8 +     (panel content gap gap gap gap))
     1.9 +  ([content top left bottom right]
    1.10 +     (let [layer (padding content top left bottom right)]
    1.11         (decorate-layer layer [_]
    1.12           (with-color :alt-back-color
    1.13             (.fill *graphics* (Rectangle2D$Double. 0.0 0.0 *width* *height*)))
    1.14 @@ -304,6 +306,8 @@
    1.15  (def ^:dynamic *viewport-min-scale* 1E-6)
    1.16  (def ^:dynamic *viewport-max-scale* 1E6)
    1.17  
    1.18 +(declare scale-viewport)
    1.19 +
    1.20  (defrecord Viewport [content h-align v-align
    1.21                       ;; State (refs)
    1.22                       transform
    1.23 @@ -352,21 +356,10 @@
    1.24          (ref-set fix-y (:y-on-screen e)))
    1.25         (update layer))
    1.26        (:mouse-wheel e
    1.27 -       (dosync
    1.28 -        (let [s (Math/pow *viewport-scaling-step* (:wheel-rotation e))
    1.29 -              x (- (:x e) (* (:x e) s))
    1.30 -              y (- (:y e) (* (:y e) s))
    1.31 -              scaled (doto (AffineTransform/getTranslateInstance x y)
    1.32 -                       (.scale s s)
    1.33 -                       (.concatenate @transform))
    1.34 -              sx (.getScaleX scaled)
    1.35 -              sy (.getScaleY scaled)]
    1.36 -          (if (<= *viewport-min-scale*
    1.37 -                  (min sx sy)
    1.38 -                  (max sx sy)
    1.39 -                  *viewport-max-scale*)
    1.40 -            (ref-set transform scaled))))
    1.41 -       (update layer))))
    1.42 +       (scale-viewport
    1.43 +        layer
    1.44 +        (Math/pow *viewport-scaling-step* (:wheel-rotation e))
    1.45 +        true (:x e) (:y e)))))
    1.46    (geometry [_]
    1.47      (geometry content)))
    1.48  
    1.49 @@ -381,6 +374,32 @@
    1.50                  (ref 0) (ref 0)          ; last-width last-height
    1.51                  (ref 0) (ref 0))))       ; last-anchor-x last-anchor-y
    1.52  
    1.53 +(defn scale-viewport
    1.54 +  ([viewport s]
    1.55 +     (scale-viewport viewport s true))
    1.56 +  ([viewport s relative?]
    1.57 +     (scale-viewport viewport s relative? nil nil))
    1.58 +  ([viewport s relative? x y]
    1.59 +     (dosync
    1.60 +      (let [^AffineTransform tr @(:transform viewport)
    1.61 +            sx (if relative? s (/ s (.getScaleX tr)))
    1.62 +            sy (if relative? s (/ s (.getScaleY tr)))
    1.63 +            x (or x (align-x 0 @(:last-width viewport) (:h-align viewport)))
    1.64 +            y (or y (align-y 0 @(:last-height viewport) (:v-align viewport)))
    1.65 +            x (- x (* x sx))
    1.66 +            y (- y (* y sy))
    1.67 +            scaled (doto (AffineTransform/getTranslateInstance x y)
    1.68 +                     (.scale sx sy)
    1.69 +                     (.concatenate tr))
    1.70 +            sx (.getScaleX scaled)
    1.71 +            sy (.getScaleY scaled)]
    1.72 +        (if (<= *viewport-min-scale*
    1.73 +                (min sx sy)
    1.74 +                (max sx sy)
    1.75 +                *viewport-max-scale*)
    1.76 +          (ref-set (:transform viewport) scaled))))
    1.77 +     (update viewport)))
    1.78 +
    1.79  (defn reset-viewport [viewport]
    1.80    (dosync
    1.81     (ref-set (:last-width viewport) 0)