changeset 101:9874107e3e96

Clojure 1.3 compatibility, mouse wheel support, scalable viewport, additional layer implementations.
author Mikhail Kryshen <mikhail@kryshen.net>
date Wed, 18 May 2011 20:50:49 +0400
parents f8c8abb84e99
children fd8fb8a3ff5a
files project.clj src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/layers.clj
diffstat 5 files changed, 362 insertions(+), 107 deletions(-) [+]
line diff
     1.1 --- a/project.clj	Wed May 18 19:05:11 2011 +0400
     1.2 +++ b/project.clj	Wed May 18 20:50:49 2011 +0400
     1.3 @@ -3,7 +3,7 @@
     1.4    ;;:warn-on-reflection true
     1.5    :dependencies [[org.clojure/clojure "1.2.1"]
     1.6                   [com.google.guava/guava "r09"]]
     1.7 -  :dev-dependencies [[swank-clojure/swank-clojure "1.3.1"]]
     1.8 +  :dev-dependencies [[swank-clojure "1.3.1"]]
     1.9    ;;:aot [net.kryshen.indyvon.core
    1.10    ;;      net.kryshen.indyvon.async
    1.11    ;;      net.kryshen.indyvon.layers
     2.1 --- a/src/net/kryshen/indyvon/component.clj	Wed May 18 19:05:11 2011 +0400
     2.2 +++ b/src/net/kryshen/indyvon/component.clj	Wed May 18 20:50:49 2011 +0400
     2.3 @@ -1,5 +1,5 @@
     2.4  ;;
     2.5 -;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net>
     2.6 +;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
     2.7  ;;
     2.8  ;; This file is part of Indyvon.
     2.9  ;;
    2.10 @@ -25,12 +25,18 @@
    2.11     (net.kryshen.indyvon.core Size Bounds)
    2.12     (java.awt Graphics Component Dimension Color)
    2.13     (java.awt.geom Rectangle2D$Double)
    2.14 -   (javax.swing JFrame JPanel)))
    2.15 +   (javax.swing JFrame JPanel JOptionPane)))
    2.16  
    2.17 -(defn- font-context [^Component component]
    2.18 +(defn font-context [^Component component]
    2.19    (.getFontRenderContext (.getFontMetrics component (.getFont component))))
    2.20  
    2.21 -(defn make-jpanel
    2.22 +(defmacro with-component [component & body]
    2.23 +  `(let [c# ~component]
    2.24 +     (binding [*target* c#
    2.25 +               *font-context* (font-context c#)]
    2.26 +       ~@body)))
    2.27 +
    2.28 +(defn ^JPanel make-jpanel
    2.29    ([layer]
    2.30       (make-jpanel layer (root-event-dispatcher)))
    2.31    ([layer event-dispatcher]
    2.32 @@ -59,3 +65,6 @@
    2.33    (doto (JFrame. title)
    2.34      (.. (getContentPane) (add (make-jpanel layer)))
    2.35      (.pack)))
    2.36 +
    2.37 +(defn message [m]
    2.38 +  (JOptionPane/showMessageDialog *target* m))
     3.1 --- a/src/net/kryshen/indyvon/core.clj	Wed May 18 19:05:11 2011 +0400
     3.2 +++ b/src/net/kryshen/indyvon/core.clj	Wed May 18 20:50:49 2011 +0400
     3.3 @@ -21,7 +21,8 @@
     3.4    (:import
     3.5     (java.awt Graphics2D RenderingHints Component Color Font Shape)
     3.6     (java.awt.geom AffineTransform Point2D$Double Rectangle2D$Double Area)
     3.7 -   (java.awt.event MouseListener MouseMotionListener)
     3.8 +   (java.awt.event MouseListener MouseMotionListener
     3.9 +                   MouseWheelListener MouseWheelEvent)
    3.10     (java.awt.font FontRenderContext)
    3.11     java.util.concurrent.ConcurrentMap
    3.12     com.google.common.collect.MapMaker))
    3.13 @@ -30,48 +31,67 @@
    3.14  ;; Layer context
    3.15  ;;
    3.16  
    3.17 -(def ^Graphics2D *graphics*)
    3.18 +(def ^{:dynamic true
    3.19 +       :tag Graphics2D}
    3.20 +  *graphics*)
    3.21  
    3.22 -(def ^FontRenderContext *font-context*)
    3.23 +(def ^{:dynamic true
    3.24 +       :tag FontRenderContext}
    3.25 +  *font-context*)
    3.26  
    3.27 -(def ^{:tag Component
    3.28 +(def ^{:dynamic true
    3.29 +       :tag Component
    3.30         :doc "Target AWT component, may be nil if drawing off-screen."}
    3.31 -     *target*)
    3.32 +  *target*)
    3.33  
    3.34 -(def ^{:doc "Width of the rendering area."}
    3.35 -     *width*)
    3.36 +(def ^{:dynamic true
    3.37 +       :doc "Width of the rendering area."}
    3.38 +  *width*)
    3.39  
    3.40 -(def ^{:doc "Height of the rendering area."}
    3.41 -     *height*)
    3.42 +(def ^{:dynamic true
    3.43 +       :doc "Height of the rendering area."}
    3.44 +  *height*)
    3.45  
    3.46 -(def ^Shape *clip*)
    3.47 +(def ^{:dynamic true
    3.48 +       :tag Shape}
    3.49 +  *clip*)
    3.50  
    3.51 -(def ^{:doc "The root (background) layer of the scene."}
    3.52 -     *root*)
    3.53 +(def ^{:dynamic true
    3.54 +       :doc "The root (background) layer of the scene."}
    3.55 +  *root*)
    3.56  
    3.57 -(def ^{:doc "Time in nanoseconds when the rendering of the current
    3.58 +(def ^{:dynamic true
    3.59 +       :doc "Time in nanoseconds when the rendering of the current
    3.60               frame starts."}
    3.61 -     *time*)
    3.62 +  *time*)
    3.63  
    3.64 -(def *event-dispatcher*)
    3.65 +(def ^{:dynamic true}
    3.66 +  *event-dispatcher*)
    3.67  
    3.68 -(def ^{:tag AffineTransform
    3.69 +(def ^{:dynamic true
    3.70 +       :tag AffineTransform
    3.71         :doc "Initial transform associated with the graphics context."}
    3.72 -     *initial-transform*)
    3.73 +  *initial-transform*)
    3.74  
    3.75 -(def ^{:tag AffineTransform
    3.76 +(def ^{:dynamic true
    3.77 +       :tag AffineTransform
    3.78         :doc "Inversion of the initial transform associated with
    3.79              the graphics context."}
    3.80 -     *inverse-initial-transform*)
    3.81 +  *inverse-initial-transform*)
    3.82  
    3.83 -(defrecord Theme [fore-color back-color alt-back-color border-color font])
    3.84 +(defrecord Theme [fore-color back-color alt-back-color border-color
    3.85 +                  shadow-color font])
    3.86  
    3.87  ;; REMIND: use system colors, see java.awt.SystemColor.
    3.88  (defn default-theme []
    3.89 -  (Theme. Color/BLACK Color/WHITE Color/LIGHT_GRAY
    3.90 -          Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    3.91 +  (Theme. Color/BLACK
    3.92 +          Color/WHITE
    3.93 +          (Color. 0xC8 0xD2 0xD8)
    3.94 +          (Color. 0 0 0xC8)
    3.95 +          (Color. 0x44 0x44 0x44)
    3.96 +          (Font. "Sans" Font/PLAIN 12)))
    3.97  
    3.98 -(def *theme* (default-theme))
    3.99 +(def ^{:dynamic true} *theme* (default-theme))
   3.100  
   3.101  (defrecord Location [x y])
   3.102  (defrecord Size [width height])
   3.103 @@ -87,12 +107,13 @@
   3.104    (layer-size [this]))
   3.105  
   3.106  ;; TODO: modifiers
   3.107 -(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
   3.108 +(defrecord MouseEvent [id when x y x-on-screen y-on-screen button
   3.109 +                       wheel-rotation])
   3.110  
   3.111  ;; TODO: KeyEvent
   3.112  
   3.113  (defprotocol EventDispatcher
   3.114 -  (listen! [this ^Component component]
   3.115 +  (listen! [this component]
   3.116       "Listen for events on the specified AWT Component.")
   3.117    (create-dispatcher [this handle handlers]
   3.118       "Returns new event dispatcher associated with the specified event
   3.119 @@ -275,16 +296,28 @@
   3.120    ([]
   3.121       (apply-theme *graphics* *theme*))
   3.122    ([^Graphics2D graphics theme]
   3.123 -  (doto graphics
   3.124 -    (.setColor (:fore-color theme))
   3.125 -    (.setFont (:font theme)))))
   3.126 +     (doto graphics
   3.127 +       (.setColor (:fore-color theme))
   3.128 +       (.setFont (:font theme)))))
   3.129  
   3.130  (defn- ^Graphics2D create-graphics
   3.131    ([]
   3.132 -     (create-graphics 0 0 *width* *height*))
   3.133 +     (apply-theme (.create *graphics*) *theme*))
   3.134    ([x y w h]
   3.135       (apply-theme (.create *graphics* x y w h) *theme*)))
   3.136  
   3.137 +(defn- with-bounds-noclip*
   3.138 +  [x y w h f & args]
   3.139 +  (let [graphics (create-graphics)]
   3.140 +    (try
   3.141 +      (.translate graphics (int x) (int y))
   3.142 +      (binding [*width* w
   3.143 +                *height* h
   3.144 +                *graphics* graphics]
   3.145 +        (apply f args))
   3.146 +      (finally
   3.147 +       (.dispose graphics)))))
   3.148 +
   3.149  (defn with-bounds*
   3.150    [x y w h f & args]
   3.151    (when-let [clip (clip x y w h)]
   3.152 @@ -320,6 +353,23 @@
   3.153           (finally
   3.154            (.setColor *graphics* old-color#))))))
   3.155  
   3.156 +(defn with-hints*
   3.157 +  [hints f & args]
   3.158 +  (if hints
   3.159 +    (let [g *graphics*
   3.160 +          old (.getRenderingHints g)]
   3.161 +      (try
   3.162 +        (.addRenderingHints g hints)
   3.163 +        (binding [*font-context* (.getFontRenderContext g)]
   3.164 +          (apply f args))
   3.165 +        (finally
   3.166 +         (.setRenderingHints g old))))
   3.167 +    (apply f args)))
   3.168 +
   3.169 +(defmacro with-hints
   3.170 +  [hints & body]
   3.171 +  `(with-hints ~hints (fn [] ~@body)))
   3.172 +
   3.173  ;; TODO: constructor for AffineTransform.
   3.174  ;; (transform :scale 0.3 0.5
   3.175  ;;            :translate 5 10
   3.176 @@ -337,6 +387,15 @@
   3.177    `(let [transform# (AffineTransform/getRotateInstance ~theta ~ax ~ay)]
   3.178       (with-transform transform# ~@body)))
   3.179  
   3.180 +(defmacro with-translate [x y & body]
   3.181 +  `(let [x# ~x
   3.182 +         y# ~y]
   3.183 +     (try
   3.184 +       (.translate *graphics* x# y#)
   3.185 +       ~@body
   3.186 +       (finally
   3.187 +        (.translate *graphics* (- x#) (- y#))))))
   3.188 +
   3.189  (defn draw!
   3.190    "Draws layer."
   3.191    ([layer]
   3.192 @@ -347,10 +406,16 @@
   3.193           (finally
   3.194            (.dispose graphics)))))
   3.195    ([layer x y]
   3.196 +     (draw! layer x y true))
   3.197 +  ([layer x y clip?]
   3.198       (let [size (layer-size layer)]
   3.199 -       (draw! layer x y (:width size) (:height size))))
   3.200 +       (draw! layer x y (:width size) (:height size) clip?)))
   3.201    ([layer x y width height]
   3.202 -     (with-bounds* x y width height render! layer)))
   3.203 +     (draw! layer x y width height true))
   3.204 +  ([layer x y width height clip?]
   3.205 +     (if clip?
   3.206 +       (with-bounds* x y width height render! layer)
   3.207 +       (with-bounds-noclip* x y width height render! layer))))
   3.208  
   3.209  (defn draw-anchored!
   3.210    "Draws layer. Location is relative to the layer's anchor point for
   3.211 @@ -367,6 +432,18 @@
   3.212    ([layer graphics width height event-dispatcher]
   3.213       (draw-root! layer graphics width height event-dispatcher nil))
   3.214    ([layer ^Graphics2D graphics width height event-dispatcher target]
   3.215 +     ;; (.setRenderingHint graphics
   3.216 +     ;;                    RenderingHints/KEY_INTERPOLATION
   3.217 +     ;;                    RenderingHints/VALUE_INTERPOLATION_BILINEAR)
   3.218 +     ;; (.setRenderingHint graphics
   3.219 +     ;;                    RenderingHints/KEY_ALPHA_INTERPOLATION
   3.220 +     ;;                    RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
   3.221 +     ;; (.setRenderingHint graphics
   3.222 +     ;;                    RenderingHints/KEY_ANTIALIASING
   3.223 +     ;;                    RenderingHints/VALUE_ANTIALIAS_ON)
   3.224 +     ;; (.setRenderingHint graphics
   3.225 +     ;;                    RenderingHints/KEY_TEXT_ANTIALIASING
   3.226 +     ;;                    RenderingHints/VALUE_TEXT_ANTIALIAS_ON)
   3.227       (binding [*root* layer
   3.228                 *target* target
   3.229                 *graphics* graphics
   3.230 @@ -379,15 +456,6 @@
   3.231                 *height* height
   3.232                 *clip* (Rectangle2D$Double. 0 0 width height)
   3.233                 *time* (System/nanoTime)]
   3.234 -       ;; (.setRenderingHint graphics
   3.235 -       ;;                    RenderingHints/KEY_INTERPOLATION
   3.236 -       ;;                    RenderingHints/VALUE_INTERPOLATION_BILINEAR)
   3.237 -       ;; (.setRenderingHint graphics
   3.238 -       ;;                    RenderingHints/KEY_ALPHA_INTERPOLATION
   3.239 -       ;;                    RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
   3.240 -       ;; (.setRenderingHint graphics
   3.241 -       ;;                    RenderingHints/KEY_ANTIALIASING
   3.242 -       ;;                    RenderingHints/VALUE_ANTIALIAS_ON)
   3.243         (apply-theme)
   3.244         (let [tmp-watcher (Object.)]
   3.245           ;; Keep current context observers until the rendering is
   3.246 @@ -438,7 +506,6 @@
   3.247  (defn hovered? [handle]
   3.248    (handle-hovered? *event-dispatcher* handle))
   3.249  
   3.250 -
   3.251  ;;
   3.252  ;; EventDispatcher implementation
   3.253  ;;
   3.254 @@ -450,7 +517,8 @@
   3.255        java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
   3.256        java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
   3.257        java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
   3.258 -      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
   3.259 +      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released
   3.260 +      java.awt.event.MouseEvent/MOUSE_WHEEL    :mouse-wheel})
   3.261  
   3.262  (def dummy-event-dispatcher
   3.263       (reify
   3.264 @@ -484,6 +552,9 @@
   3.265  (defn- add-node [tree node]
   3.266    (assoc-cons tree (:parent node) node))
   3.267  
   3.268 +(defn- nodes [tree]
   3.269 +  (apply concat (vals tree)))
   3.270 +
   3.271  (defn- under-cursor
   3.272    "Returns a vector of child nodes under cursor."
   3.273    [x y tree node]
   3.274 @@ -496,22 +567,26 @@
   3.275  
   3.276  (defn- translate-mouse-event [^java.awt.event.MouseEvent event
   3.277                                ^AffineTransform tr id]
   3.278 -  (let [[x y] (transform-point tr (.getX event) (.getY event))]
   3.279 +  (let [[x y] (transform-point tr (.getX event) (.getY event))
   3.280 +        rotation (if (instance? MouseWheelEvent event)
   3.281 +                   (.getWheelRotation ^MouseWheelEvent event)
   3.282 +                   nil)]
   3.283      (MouseEvent. id (.getWhen event) x y
   3.284                   (.getXOnScreen event) (.getYOnScreen event)
   3.285 -                 (.getButton event))))
   3.286 +                 (.getButton event)
   3.287 +                 rotation)))
   3.288  
   3.289  (defn- translate-and-dispatch
   3.290    ([nodes first-only ^java.awt.event.MouseEvent event]
   3.291       (translate-and-dispatch nodes first-only
   3.292 -       event (awt-events (.getID event))))
   3.293 +                             event (awt-events (.getID event))))
   3.294    ([nodes first-only event id]
   3.295       (if-let [node (first nodes)]
   3.296         (if-let [handler (get (:handlers node) id)]
   3.297           (do
   3.298 -           (with-bindings* (:bindings node)
   3.299 -             handler
   3.300 -             (translate-mouse-event event (:transform node) id))
   3.301 +           (let [translated (translate-mouse-event event (:transform node) id)]
   3.302 +             (with-bindings* (:bindings node)
   3.303 +               handler translated))
   3.304             (if-not first-only
   3.305               (recur (rest nodes) false event id)))
   3.306           (recur (rest nodes) first-only event id)))))
   3.307 @@ -556,14 +631,17 @@
   3.308      (reify
   3.309       EventDispatcher
   3.310       (listen! [this component]
   3.311 -       (doto component
   3.312 +       (doto ^Component component
   3.313           (.addMouseListener this)
   3.314 +         (.addMouseWheelListener this)
   3.315           (.addMouseMotionListener this)))
   3.316       (create-dispatcher [this handle handlers]
   3.317         (let [node (make-node handle handlers)]
   3.318           (dosync (alter tree-r add-node node))
   3.319           node))
   3.320       (commit [this]
   3.321 +       ;; TODO: retain contexts that do not intersect graphics
   3.322 +       ;; clipping area in tree.
   3.323         (dosync (ref-set tree @tree-r)
   3.324                 (ref-set tree-r {})))
   3.325       (handle-picked? [this handle]
   3.326 @@ -581,6 +659,9 @@
   3.327         (dispatch-mouse-button picked hovered event))
   3.328       (mouseReleased [this event]
   3.329         (dispatch-mouse-button picked hovered event))
   3.330 +     MouseWheelListener
   3.331 +     (mouseWheelMoved [this event]
   3.332 +       (dispatch-mouse-button picked hovered event))
   3.333       MouseMotionListener
   3.334       (mouseDragged [this event]
   3.335         (translate-and-dispatch @picked true event))
     4.1 --- a/src/net/kryshen/indyvon/demo.clj	Wed May 18 19:05:11 2011 +0400
     4.2 +++ b/src/net/kryshen/indyvon/demo.clj	Wed May 18 20:50:49 2011 +0400
     4.3 @@ -1,5 +1,5 @@
     4.4  ;;
     4.5 -;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net>
     4.6 +;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
     4.7  ;;
     4.8  ;; This file is part of Indyvon.
     4.9  ;;
     5.1 --- a/src/net/kryshen/indyvon/layers.clj	Wed May 18 19:05:11 2011 +0400
     5.2 +++ b/src/net/kryshen/indyvon/layers.clj	Wed May 18 20:50:49 2011 +0400
     5.3 @@ -24,8 +24,9 @@
     5.4    (:import
     5.5     (net.kryshen.indyvon.core Size Location)
     5.6     (java.lang.ref SoftReference)
     5.7 -   (java.awt Font Cursor Image Toolkit)
     5.8 -   (java.awt.image ImageObserver)
     5.9 +   (java.awt Font Cursor Image Toolkit Point)
    5.10 +   java.awt.image.ImageObserver
    5.11 +   (java.awt.geom AffineTransform Point2D$Double)
    5.12     (java.awt.font FontRenderContext TextLayout)))
    5.13    
    5.14  ;; Define as macro to avoid unnecessary calculation of inner and outer
    5.15 @@ -87,6 +88,32 @@
    5.16                          (- *height* 1 i i))))
    5.17           (render! layer)))))
    5.18  
    5.19 +;; TODO: opacity and blur.
    5.20 +(defn shadow
    5.21 +  "Add shadow to content layer."
    5.22 +  ([content]
    5.23 +     (shadow content 1 1))
    5.24 +  ([content x-offset y-offset]
    5.25 +     (let [x (if (neg? x-offset) (- x-offset) 0)
    5.26 +           y (if (neg? y-offset) (- y-offset) 0)
    5.27 +           abs-x (if (neg? x-offset) (- x-offset) x-offset)
    5.28 +           abs-y (if (neg? y-offset) (- y-offset) y-offset)
    5.29 +           shadow-x (+ x-offset x)
    5.30 +           shadow-y (+ y-offset y)]
    5.31 +       (reify
    5.32 +        ;; TODO: Anchored
    5.33 +        Layer
    5.34 +        (render! [_]
    5.35 +          (let [w (- *width* abs-x)
    5.36 +                h (- *height* abs-y)]
    5.37 +            (with-color :shadow-color
    5.38 +              (.fillRect *graphics* shadow-x shadow-y w h))
    5.39 +            (draw! content x y w h)))
    5.40 +        (layer-size [_]
    5.41 +          (let [s (layer-size content)]
    5.42 +            (Size. (+ (:width s) abs-x)
    5.43 +                   (+ (:height s) abs-y))))))))
    5.44 +
    5.45  (defn panel
    5.46    "Opaque layer using theme's alt-back-color."
    5.47    ([content]
    5.48 @@ -105,20 +132,41 @@
    5.49    (reify
    5.50     Layer
    5.51     (render! [_]
    5.52 -     ;; TODO: distribute space proportionally.
    5.53 -     (let [w (/ *width* (count contents))]
    5.54 -       (doseq [[i c] (map-indexed vector contents)]
    5.55 -         (draw! c (* i w) 0 w *height*))))
    5.56 +     (let [widths (map #(:width (layer-size %)) contents)
    5.57 +           xs (cons 0 (reductions + widths))
    5.58 +           widths-sum (last xs)
    5.59 +           scale (/ *width* widths-sum)]
    5.60 +       (doseq [[c w x] (map vector contents widths xs)]
    5.61 +         (draw! c x 0 w *height*))))
    5.62     (layer-size [_]
    5.63       (reduce #(Size. (+ (:width %1) (:width %2))
    5.64                       (max (:height %1) (:height %2)))
    5.65               (Size. 0 0)
    5.66               (map layer-size contents)))))
    5.67  
    5.68 +(defn vbox
    5.69 +  "Creates layer that draws the specified content layers placing them
    5.70 +   vertically."
    5.71 +  [& contents]
    5.72 +  (reify
    5.73 +   Layer
    5.74 +   (render! [_]
    5.75 +     (let [heights (map #(:height (layer-size %)) contents)
    5.76 +           ys (cons 0 (reductions + heights))
    5.77 +           heights-sum (last ys)
    5.78 +           scale (/ *height* heights-sum)]
    5.79 +       (doseq [[c h y] (map vector contents heights ys)]
    5.80 +         (draw! c 0 y *width* h))))
    5.81 +   (layer-size [_]
    5.82 +     (reduce #(Size. (max (:width %1) (:width %2))
    5.83 +                     (+ (:height %1) (:height %2)))
    5.84 +             (Size. 0 0)
    5.85 +             (map layer-size contents)))))
    5.86 +
    5.87  (defn- re-split [^java.util.regex.Pattern re s]
    5.88    (seq (.split re s)))
    5.89  
    5.90 -(def text-layout-cache (atom {}))
    5.91 +(def ^:private text-layout-cache (atom {}))
    5.92  
    5.93  (defn- get-text-layout
    5.94    [^String line ^Font font ^FontRenderContext font-context]
    5.95 @@ -152,7 +200,7 @@
    5.96    ([text]
    5.97       (label text :left :top))
    5.98    ([text h-align v-align]
    5.99 -     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
   5.100 +     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" (str text))]
   5.101         (reify Layer
   5.102          (render! [layer]
   5.103            (let [w *width*
   5.104 @@ -184,7 +232,7 @@
   5.105  
   5.106  (defn image-layer
   5.107    [image-or-uri]
   5.108 -  (let [^Image image (if (isa? image-or-uri Image)
   5.109 +  (let [^Image image (if (instance? Image image-or-uri)
   5.110                         image-or-uri
   5.111                         (.getImage (Toolkit/getDefaultToolkit)
   5.112                                    ^java.net.URL image-or-uri))]
   5.113 @@ -202,13 +250,13 @@
   5.114               height (if (pos? height) height 1)]
   5.115           (Size. width height))))))
   5.116  
   5.117 -(def *miniature-thread-priority* 2)
   5.118 +(def ^{:dynamic true} *miniature-thread-priority* 2)
   5.119  
   5.120  (defn- scaling
   5.121    [width height max-width max-height]
   5.122    (min (/ max-width width)
   5.123         (/ max-height height)))
   5.124 -  
   5.125 +
   5.126  (defn miniature
   5.127    "Creates layer that asynchronously renders view of the content
   5.128    scaled to the specified size."
   5.129 @@ -231,25 +279,50 @@
   5.130        ;; (Size. (* (:width size) s) (* (:height size) s)))))
   5.131     width height *miniature-thread-priority*))
   5.132  
   5.133 +;;(defn- translate [^AffineTransform transform ^double x ^double y]
   5.134 +;;  (doto ^AffineTransform (.clone transform)
   5.135 +;;        (.translate x y)))
   5.136 +
   5.137 +(defn- scale [^AffineTransform transform ^double sx ^double sy]
   5.138 +    (doto ^AffineTransform (.clone transform)
   5.139 +        (.scale sx sy)))
   5.140 +
   5.141 +(defn- pre-translate [^AffineTransform transform ^double x ^double y]
   5.142 +  (if (== 0.0 x y)
   5.143 +    transform
   5.144 +    (doto (AffineTransform/getTranslateInstance x y)
   5.145 +      (.concatenate transform))))
   5.146 +
   5.147 +(def ^{:dynamic true} *viewport-scaling-step* (double 3/4))
   5.148 +(def ^{:dynamic true} *viewport-min-scale* 1E-6)
   5.149 +(def ^{:dynamic true} *viewport-max-scale* 1E6)
   5.150 +
   5.151  (defrecord Viewport [content h-align v-align
   5.152                       ;; State (refs)
   5.153 -                     ;; TODO: group into data structures.
   5.154 -                     x y fix-x fix-y last-width last-height
   5.155 -                     vp-x vp-y]
   5.156 +                     transform
   5.157 +                     fix-x fix-y
   5.158 +                     last-width last-height last-anchor]
   5.159    Layer
   5.160    (render! [layer]
   5.161      (repaint-on-update layer)
   5.162      (with-handlers layer
   5.163        (let [anchor (anchor content h-align v-align)]
   5.164          (dosync
   5.165 -         (alter x + (align-x *width* @last-width h-align))
   5.166 -         (alter y + (align-y *height* @last-height v-align))
   5.167 +         (let [ax1 (align-x @last-width *width* h-align)
   5.168 +               ay1 (align-y @last-height *height* v-align)
   5.169 +               ax2 (- (:x @last-anchor) (:x anchor))
   5.170 +               ay2 (- (:y @last-anchor) (:y anchor))]
   5.171 +           (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2))
   5.172 +             (ref-set transform
   5.173 +                      (doto (AffineTransform/getTranslateInstance ax1 ay1)
   5.174 +                        (.concatenate @transform)
   5.175 +                        (.translate ax2 ay2)))))
   5.176           (ref-set last-width *width*)
   5.177           (ref-set last-height *height*)
   5.178 -         (ref-set vp-x (+ @x (:x anchor)))
   5.179 -         (ref-set vp-y (+ @y (:y anchor))))
   5.180 +         (ref-set last-anchor anchor))
   5.181          ;; TODO: notify observers when size changes.
   5.182 -        (draw! content (- @vp-x) (- @vp-y)))
   5.183 +        (with-transform @transform
   5.184 +          (draw! content 0 0 false)))
   5.185        (:mouse-pressed e
   5.186         (dosync
   5.187          (ref-set fix-x (:x-on-screen e))
   5.188 @@ -261,29 +334,49 @@
   5.189           (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
   5.190        (:mouse-dragged e
   5.191         (dosync
   5.192 -        (alter x + (- @fix-x (:x-on-screen e)))
   5.193 -        (alter y + (- @fix-y (:y-on-screen e)))
   5.194 +        (alter transform pre-translate
   5.195 +               (- (:x-on-screen e) @fix-x)
   5.196 +               (- (:y-on-screen e) @fix-y))
   5.197          (ref-set fix-x (:x-on-screen e))
   5.198          (ref-set fix-y (:y-on-screen e)))
   5.199 +       (update layer))
   5.200 +      (:mouse-wheel e
   5.201 +       (dosync
   5.202 +        (let [s (Math/pow *viewport-scaling-step* (:wheel-rotation e))
   5.203 +              x (- (:x e) (* (:x e) s))
   5.204 +              y (- (:y e) (* (:y e) s))
   5.205 +              scaled (doto (AffineTransform/getTranslateInstance x y)
   5.206 +                       (.scale s s)
   5.207 +                       (.concatenate @transform))
   5.208 +              sx (.getScaleX scaled)
   5.209 +              sy (.getScaleY scaled)]
   5.210 +          (if (<= *viewport-min-scale*
   5.211 +                  (min sx sy)
   5.212 +                  (max sx sy)
   5.213 +                  *viewport-max-scale*)
   5.214 +            (ref-set transform scaled))))
   5.215         (update layer))))
   5.216    (layer-size [layer]
   5.217      (layer-size content)))
   5.218  
   5.219  (defn viewport
   5.220    "Creates scrollable viewport layer."
   5.221 -  ([content] (viewport content :left :top))
   5.222 +  ([content]
   5.223 +     (viewport content :left :top))
   5.224    ([content h-align v-align]
   5.225       (Viewport. content h-align v-align
   5.226 -                (ref 0) (ref 0)    ; x y
   5.227 -                (ref 0) (ref 0)    ; fix-x fix-y
   5.228 -                (ref 0) (ref 0)    ; last-width last-height
   5.229 -                (ref 0) (ref 0)))) ; vp-x vp-y
   5.230 +                (ref (AffineTransform.)) ; transform
   5.231 +                (ref 0) (ref 0)          ; fix-x fix-y
   5.232 +                (ref 0) (ref 0)          ; last-width last-height
   5.233 +                (ref (Location. 0 0))))) ; last-anchor
   5.234  
   5.235 -(defn- viewport-visible-bounds
   5.236 -  [vp]
   5.237 +(defn reset-viewport [viewport]
   5.238    (dosync
   5.239 -   [@(:vp-x vp) @(:vp-y vp)
   5.240 -    @(:last-width vp) @(:last-height vp)]))
   5.241 +   (ref-set (:last-width viewport) 0)
   5.242 +   (ref-set (:last-height viewport) 0)
   5.243 +   (ref-set (:last-anchor viewport) (Location. 0 0))
   5.244 +   (ref-set (:transform viewport) (AffineTransform.)))
   5.245 +  (update viewport))
   5.246  
   5.247  (defn viewport-miniature
   5.248    "Creates miniature view of the viewport's contents."
   5.249 @@ -293,36 +386,60 @@
   5.250        (repaint-on-update viewport)
   5.251        (let [size (layer-size (:content viewport))
   5.252              s (scaling (:width size) (:height size) width height)
   5.253 -            [x y w h] (viewport-visible-bounds viewport)
   5.254 +            [vp-tr w h] (dosync
   5.255 +                         [@(:transform viewport)
   5.256 +                          @(:last-width viewport)
   5.257 +                          @(:last-height viewport)])
   5.258 +            vp-inverse (.createInverse ^AffineTransform vp-tr)
   5.259              ox (align-x (:width size) (/ width s) :center)
   5.260              oy (align-y (:height size) (/ height s) :center)
   5.261 -            sx (* (+ x ox) s)
   5.262 -            sy (* (+ y oy) s)
   5.263 -            sw (* w s)
   5.264 -            sh (* h s)
   5.265 +            transform (doto (AffineTransform.)
   5.266 +                        (.scale s s)
   5.267 +                        (.translate ox oy)
   5.268 +                        (.concatenate vp-inverse))
   5.269              move-vp (fn [x y]
   5.270                        (dosync
   5.271 -                       (ref-set (:x viewport)
   5.272 -                                (- (/ x s)
   5.273 -                                   (/ w 2)
   5.274 -                                   ox
   5.275 -                                   (- @(:vp-x viewport) @(:x viewport))))
   5.276 -                       (ref-set (:y viewport)
   5.277 -                                (- (/ y s)
   5.278 -                                   (/ h 2)
   5.279 -                                   oy
   5.280 -                                   (- @(:vp-y viewport) @(:y viewport)))))
   5.281 +                       (let [x (- (/ x s) ox)
   5.282 +                             y (- (/ y s) oy)
   5.283 +                             [x y] (transform-point @(:transform viewport)
   5.284 +                                                    x y)
   5.285 +                             x (- x (/ @(:last-width viewport) 2))
   5.286 +                             y (- y (/ @(:last-height viewport) 2))]
   5.287 +                         (alter (:transform viewport)
   5.288 +                                pre-translate (- x) (- y))))
   5.289                        (update viewport))]
   5.290          (with-color :alt-back-color
   5.291            (.fillRect *graphics* 0 0 *width* *height*))
   5.292 -        (with-color :back-color
   5.293 -          (.fillRect *graphics* sx sy sw sh))
   5.294 +        (with-transform transform
   5.295 +          (with-color :back-color
   5.296 +            (.fillRect *graphics* 0 0 w h)))
   5.297          (with-handlers l
   5.298            (draw! miniature)
   5.299            (:mouse-pressed e (move-vp (:x e) (:y e)))
   5.300            (:mouse-dragged e (move-vp (:x e) (:y e))))
   5.301 -        (with-color :border-color
   5.302 -          (.drawRect *graphics* sx sy sw sh))))))
   5.303 +        (with-transform transform
   5.304 +          (with-color :border-color
   5.305 +            (.drawRect *graphics* 0 0 w h)))))))
   5.306 +
   5.307 +(defn ref-layer
   5.308 +  [layer-ref]
   5.309 +  (let [l (reify
   5.310 +           Layer
   5.311 +           (render! [l]
   5.312 +             (repaint-on-update l)
   5.313 +             (if-let [layer @layer-ref]
   5.314 +               (render! layer)))
   5.315 +           (layer-size [_]
   5.316 +             (if-let [layer @layer-ref]
   5.317 +               (layer-size layer)
   5.318 +               (Size. 1 1)))
   5.319 +           Anchored
   5.320 +           (anchor [_ x-align y-align]
   5.321 +             (if-let [layer @layer-ref]
   5.322 +               (anchor layer x-align y-align)
   5.323 +               (Location. 0 0))))]
   5.324 +    (add-watch layer-ref l (fn [_ _ _ _] (update l)))
   5.325 +    l))
   5.326  
   5.327  ;;
   5.328  ;; Layer context decorators.
   5.329 @@ -336,9 +453,9 @@
   5.330           (render! layer#)
   5.331           ~@handlers))))
   5.332  
   5.333 -(defn theme [layer & map-or-keyvals]
   5.334 +(defn themed [layer & map-or-keyvals]
   5.335    (let [theme (if (== (count map-or-keyvals) 1)
   5.336 -                map-or-keyvals
   5.337 +                (first map-or-keyvals)
   5.338                  (apply array-map map-or-keyvals))]
   5.339      (reify
   5.340       Layer
   5.341 @@ -353,11 +470,18 @@
   5.342         (with-theme theme
   5.343           (anchor layer xa ya))))))
   5.344  
   5.345 +(defn hinted [layer & map-or-keyvals]
   5.346 +  (let [hints (if (== (count map-or-keyvals) 1)
   5.347 +                (first map-or-keyvals)
   5.348 +                (apply array-map map-or-keyvals))]
   5.349 +    (decorate-layer layer [_]
   5.350 +      (with-hints* hints render! layer))))
   5.351 +
   5.352  ;;
   5.353  ;; Measuring time
   5.354  ;;
   5.355  
   5.356 -(def *interval*)
   5.357 +(def ^{:dynamic true} *interval*)
   5.358  
   5.359  (defn interval-layer
   5.360    "Creates layer that measures time between repaints ant draws it's
   5.361 @@ -397,3 +521,44 @@
   5.362                  (ref-set prev-time *time*))))
   5.363            (ref-set prev-time *time*))
   5.364          @display)))))
   5.365 +
   5.366 +;;
   5.367 +;; Overlayer.
   5.368 +;;
   5.369 +
   5.370 +(def ^{:private true :dynamic true} *above*)
   5.371 +
   5.372 +(defn- overlay* [f & args]
   5.373 +  (var-set #'*above* (conj *above* (apply partial f args))))
   5.374 +
   5.375 +(defn- ^Point to-graphics-coords
   5.376 +  [^AffineTransform transform x y]
   5.377 +  (let [p (Point. x y)]
   5.378 +    (.transform transform p p)
   5.379 +    (.transform (.createInverse (.getTransform *graphics*)) p p)
   5.380 +    p))
   5.381 +
   5.382 +(defn- draw-relative!
   5.383 +  ([layer transform x y]
   5.384 +     (let [p (to-graphics-coords transform x y)]
   5.385 +       (draw! layer (.x p) (.y p))))
   5.386 +  ([layer transform x y w h]
   5.387 +     (let [p (to-graphics-coords transform x y)]
   5.388 +       (draw! layer (.x p) (.y p) w h))))
   5.389 + 
   5.390 +(defn overlay!
   5.391 +  "Draws layer in the overlayer context above the other layers."
   5.392 +  ([layer]
   5.393 +     (overlay* draw-relative! layer (.getTransform *graphics*) 0 0))
   5.394 +  ([layer x y]
   5.395 +     (overlay* draw-relative! layer (.getTransform *graphics*) x y))
   5.396 +  ([layer x y w h]
   5.397 +     (overlay* draw-relative! layer (.getTransform *graphics*) x y w h)))
   5.398 +
   5.399 +(defn overlayer
   5.400 +  [content]
   5.401 +  (decorate-layer content [_]
   5.402 +    (binding [*above* []]
   5.403 +      (render! content)
   5.404 +      (doseq [f *above*]
   5.405 +        (f)))))