1.1 --- a/src/net/kryshen/indyvon/async.clj	Mon Apr 07 14:24:16 2014 +0400
     1.2 +++ b/src/net/kryshen/indyvon/async.clj	Mon Apr 07 15:23:58 2014 +0400
     1.3 @@ -1,5 +1,5 @@
     1.4  ;;
     1.5 -;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
     1.6 +;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net>
     1.7  ;;
     1.8  ;; This file is part of Indyvon.
     1.9  ;;
    1.10 @@ -40,15 +40,15 @@
    1.11  ;;   :free
    1.12  ;;      not in use
    1.13  
    1.14 -(defn- create-image [async-layer ^GraphicsConfiguration device-conf]
    1.15 +(defn- create-image [async-view ^GraphicsConfiguration device-conf]
    1.16    ;; TODO: support different image types.
    1.17    (.createCompatibleImage device-conf
    1.18 -                          (:width async-layer)
    1.19 -                          (:height async-layer)
    1.20 +                          (:width async-view)
    1.21 +                          (:height async-view)
    1.22                            Transparency/TRANSLUCENT))
    1.23  
    1.24 -(defn- create-buffer [async-layer device-conf]
    1.25 -  (Buffer. (Object.) (create-image async-layer device-conf) 0 :free))
    1.26 +(defn- create-buffer [async-view device-conf]
    1.27 +  (Buffer. (Object.) (create-image async-view device-conf) 0 :free))
    1.28  
    1.29  (defn- find-buffer
    1.30    "Find a buffer with the one of the specified states given
    1.31 @@ -110,40 +110,40 @@
    1.32         (finally
    1.33          (release-buffer al# ~name)))))
    1.34  
    1.35 -(defn- draw-offscreen [async-layer]
    1.36 +(defn- draw-offscreen [async-view]
    1.37    ;;(Thread/sleep 1000)
    1.38 -  (with-buffer async-layer :back [b]
    1.39 +  (with-buffer async-view :back [b]
    1.40      (let [g (.createGraphics ^BufferedImage (:image b))]
    1.41        ;; Clear the buffer.
    1.42        (.setComposite g AlphaComposite/Clear)
    1.43 -      (.fillRect g 0 0 (:width async-layer) (:height async-layer))
    1.44 +      (.fillRect g 0 0 (:width async-view) (:height async-view))
    1.45        (.setComposite g AlphaComposite/Src)
    1.46 -      (draw-scene! (:scene async-layer)
    1.47 +      (draw-scene! (:scene async-view)
    1.48                     g
    1.49 -                   (:width async-layer)
    1.50 -                   (:height async-layer)))
    1.51 -    (update async-layer)))
    1.52 +                   (:width async-view)
    1.53 +                   (:height async-view)))
    1.54 +    (update async-view)))
    1.55  
    1.56 -(defn- draw-offscreen-async [async-layer]
    1.57 -  (.execute ^ThreadPoolExecutor (:executor async-layer)
    1.58 -            #(draw-offscreen async-layer)))
    1.59 +(defn- draw-offscreen-async [async-view]
    1.60 +  (.execute ^ThreadPoolExecutor (:executor async-view)
    1.61 +            #(draw-offscreen async-view)))
    1.62  
    1.63 -(defrecord AsyncLayer [scene width height executor buffers]
    1.64 -  Layer
    1.65 -  (render! [layer]
    1.66 -    (repaint-on-update layer)
    1.67 -    (add-context-observer scene (fn [_ _] (draw-offscreen-async layer)))
    1.68 +(defrecord AsyncView [scene width height executor buffers]
    1.69 +  View
    1.70 +  (render! [view]
    1.71 +    (repaint-on-update view)
    1.72 +    (add-context-observer scene (fn [_ _] (draw-offscreen-async view)))
    1.73      (when-not @buffers
    1.74        ;; TODO: dynamic size, recreate buffers when size increases.
    1.75        (let [device-conf (.getDeviceConfiguration *graphics*)
    1.76              new-buffers (repeatedly 2
    1.77 -                          (partial create-buffer layer device-conf))]
    1.78 +                          (partial create-buffer view device-conf))]
    1.79          (dosync
    1.80           (ref-set buffers new-buffers)))
    1.81 -      (draw-offscreen-async layer))
    1.82 -    (with-buffer layer :front [b]
    1.83 +      (draw-offscreen-async view))
    1.84 +    (with-buffer view :front [b]
    1.85        (.drawImage *graphics* ^Image (:image b) 0 0 nil)))
    1.86 -  (geometry [layer]
    1.87 +  (geometry [view]
    1.88      (->Size width height)))
    1.89  
    1.90  (defn- create-thread-factory [priority]
    1.91 @@ -164,15 +164,15 @@
    1.92           (ThreadPoolExecutor$DiscardOldestPolicy.))
    1.93      (.setThreadFactory (create-thread-factory priority))))
    1.94  
    1.95 -(defn async-layer 
    1.96 -  "Creates layer that draws the content asynchronously using
    1.97 +(defn async-view 
    1.98 +  "Creates a View that draws the content asynchronously using an
    1.99     offscreen buffer."
   1.100    ([content width height]
   1.101 -     (async-layer content width height nil))
   1.102 +     (async-view content width height nil))
   1.103    ([content width height priority]
   1.104       ;; TODO: use operational event dispatcher.
   1.105 -     (->AsyncLayer (make-scene content)
   1.106 -                   width
   1.107 -                   height
   1.108 -                   (create-executor priority)
   1.109 -                   (ref nil))))
   1.110 +     (->AsyncView (make-scene content)
   1.111 +                  width
   1.112 +                  height
   1.113 +                  (create-executor priority)
   1.114 +                  (ref nil))))

     2.1 --- a/src/net/kryshen/indyvon/component.clj	Mon Apr 07 14:24:16 2014 +0400
     2.2 +++ b/src/net/kryshen/indyvon/component.clj	Mon Apr 07 15:23:58 2014 +0400
     2.3 @@ -1,5 +1,5 @@
     2.4  ;;
     2.5 -;; Copyright 2010, 2011, 2012 Mikhail Kryshen <mikhail@kryshen.net>
     2.6 +;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net>
     2.7  ;;
     2.8  ;; This file is part of Indyvon.
     2.9  ;;
    2.10 @@ -38,12 +38,12 @@
    2.11      (Dimension. (width geom) (height geom))))
    2.12  
    2.13  (defn ^JPanel make-jpanel
    2.14 -  ([layer]
    2.15 -     (make-jpanel layer (root-event-dispatcher)))
    2.16 -  ([layer event-dispatcher]
    2.17 +  ([view]
    2.18 +     (make-jpanel view (root-event-dispatcher)))
    2.19 +  ([view event-dispatcher]
    2.20       (let [panel (proxy [JPanel] [])
    2.21             scene (make-scene
    2.22 -                  layer event-dispatcher panel
    2.23 +                  view event-dispatcher panel
    2.24                    (.getDesktopProperty (java.awt.Toolkit/getDefaultToolkit)
    2.25                                         "awt.font.desktophints"))]
    2.26         (update-proxy
    2.27 @@ -60,9 +60,9 @@
    2.28         (listen! event-dispatcher panel)
    2.29         panel)))
    2.30  
    2.31 -(defn ^JFrame make-jframe [^String title layer]
    2.32 +(defn ^JFrame make-jframe [^String title view]
    2.33    (doto (JFrame. title)
    2.34 -    (.. (getContentPane) (add (make-jpanel layer)))
    2.35 +    (.. (getContentPane) (add (make-jpanel view)))
    2.36      (.pack)))
    2.37  
    2.38  (defn message [m]

     3.1 --- a/src/net/kryshen/indyvon/core.clj	Mon Apr 07 14:24:16 2014 +0400
     3.2 +++ b/src/net/kryshen/indyvon/core.clj	Mon Apr 07 15:23:58 2014 +0400
     3.3 @@ -1,5 +1,5 @@
     3.4  ;;
     3.5 -;; Copyright 2010, 2011, 2012, 2013 Mikhail Kryshen <mikhail@kryshen.net>
     3.6 +;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net>
     3.7  ;;
     3.8  ;; This file is part of Indyvon.
     3.9  ;;
    3.10 @@ -29,7 +29,7 @@
    3.11     com.google.common.collect.MapMaker))
    3.12  
    3.13  ;;
    3.14 -;; Layer context
    3.15 +;; View context
    3.16  ;;
    3.17  
    3.18  (def ^:dynamic ^Graphics2D *graphics*)
    3.19 @@ -89,15 +89,15 @@
    3.20  ;; Core protocols and types
    3.21  ;;
    3.22  
    3.23 -(defprotocol Layer
    3.24 +(defprotocol View
    3.25    "Basic UI element."
    3.26 -  (render! [layer]
    3.27 -    "Draws layer in the current *graphics* context.")
    3.28 -  (geometry [layer]
    3.29 -    "Returns the preferred layer Geometry."))
    3.30 +  (render! [view]
    3.31 +    "Draws the view in the current *graphics* context.")
    3.32 +  (geometry [view]
    3.33 +    "Returns the preferred Geometry for the view."))
    3.34  
    3.35  (defprotocol Geometry
    3.36 -  "Describes geometry of a Layer. Prefer using the available
    3.37 +  "Describes geometry of a View.  Prefer using the available
    3.38    implementations (Size, FixedGeometry and NestedGeometry) over
    3.39    extending this protocol directly as it is likely to be changed in
    3.40    the future versions."
    3.41 @@ -234,7 +234,7 @@
    3.42  
    3.43  ;;
    3.44  ;; Observers
    3.45 -;; The mechanism used by layers to request repaints
    3.46 +;; The mechanism used by views to request repaints
    3.47  ;;
    3.48  
    3.49  (def ^ConcurrentMap observers
    3.50 @@ -318,24 +318,24 @@
    3.51  ;;
    3.52  
    3.53  (defn ^FontRenderContext font-context
    3.54 -  "Returns FontRenderContext for the current Layer context."
    3.55 +  "Returns FontRenderContext for the current view context."
    3.56    []
    3.57    (if (bound? (var *graphics*))
    3.58      (.getFontRenderContext *graphics*)
    3.59      *font-context*))
    3.60  
    3.61  (defn ^AffineTransform relative-transform
    3.62 -  "Returns AffineTransform: layer context -> AWT component."
    3.63 +  "Returns AffineTransform: view context -> AWT component."
    3.64    []
    3.65    (let [tr (.getTransform *graphics*)]
    3.66      (.preConcatenate tr *inverse-initial-transform*)
    3.67      tr))
    3.68  
    3.69  (defn ^AffineTransform inverse-relative-transform
    3.70 -  "Returns AffineTransform: AWT component -> layer context."
    3.71 +  "Returns AffineTransform: AWT component -> view context."
    3.72    []
    3.73    (let [tr (.getTransform *graphics*)]
    3.74 -    (.invert tr)                          ; absolute -> layer
    3.75 +    (.invert tr)                          ; absolute -> view
    3.76      (.concatenate tr *initial-transform*) ; component -> absolute
    3.77      tr))
    3.78  
    3.79 @@ -502,40 +502,40 @@
    3.80          (.translate g# (- x#) (- y#))))))
    3.81  
    3.82  (defn draw!
    3.83 -  "Draws layer."
    3.84 -  ([layer]
    3.85 +  "Draws the View."
    3.86 +  ([view]
    3.87       (let [graphics (create-graphics)]
    3.88         (try
    3.89           (binding [*graphics* graphics]
    3.90 -           (render! layer))
    3.91 +           (render! view))
    3.92           (finally
    3.93            (.dispose graphics)))))
    3.94 -  ([layer x y]
    3.95 -     (draw! layer x y true))
    3.96 -  ([layer x y clip?]
    3.97 -     (let [geom (geometry layer)]
    3.98 -       (draw! layer x y (width geom) (height geom) clip?)))
    3.99 -  ([layer x y width height]
   3.100 -     (draw! layer x y width height true))
   3.101 -  ([layer x y width height clip?]
   3.102 +  ([view x y]
   3.103 +     (draw! view x y true))
   3.104 +  ([view x y clip?]
   3.105 +     (let [geom (geometry view)]
   3.106 +       (draw! view x y (width geom) (height geom) clip?)))
   3.107 +  ([view x y width height]
   3.108 +     (draw! view x y width height true))
   3.109 +  ([view x y width height clip?]
   3.110       (if clip?
   3.111 -       (with-bounds* x y width height render! layer)
   3.112 -       (with-bounds-noclip* x y width height render! layer))))
   3.113 +       (with-bounds* x y width height render! view)
   3.114 +       (with-bounds-noclip* x y width height render! view))))
   3.115  
   3.116  (defn draw-aligned!
   3.117 -  "Draws layer. Location is relative to the layer's anchor point for
   3.118 -   the specified alignment."
   3.119 -  ([layer h-align v-align x y]
   3.120 -     (let [geom (geometry layer)
   3.121 +  "Draws the View.  Location is relative to the view's anchor point
   3.122 +   for the specified alignment."
   3.123 +  ([view h-align v-align x y]
   3.124 +     (let [geom (geometry view)
   3.125             w (width geom)
   3.126             h (height geom)]
   3.127 -       (draw! layer
   3.128 +       (draw! view
   3.129                (- x (anchor-x geom h-align w))
   3.130                (- y (anchor-y geom v-align h))
   3.131                w h)))
   3.132 -  ([layer h-align v-align x y w h]
   3.133 -     (let [geom (geometry layer)]
   3.134 -       (draw! layer
   3.135 +  ([view h-align v-align x y w h]
   3.136 +     (let [geom (geometry view)]
   3.137 +       (draw! view
   3.138                (- x (anchor-x geom h-align w))
   3.139                (- y (anchor-y geom v-align h))
   3.140                w h))))
   3.141 @@ -792,7 +792,7 @@
   3.142  ;; Scene
   3.143  ;;
   3.144  
   3.145 -(defrecord Scene [layer
   3.146 +(defrecord Scene [view
   3.147                    event-dispatcher
   3.148                    component
   3.149                    rendering-hints
   3.150 @@ -807,15 +807,15 @@
   3.151     RenderingHints/VALUE_FRACTIONALMETRICS_DEFAULT})
   3.152  
   3.153  (defn make-scene
   3.154 -  ([layer]
   3.155 -     (make-scene layer dummy-event-dispatcher nil))
   3.156 -  ([layer event-dispatcher]
   3.157 -     (make-scene layer event-dispatcher nil))
   3.158 -  ([layer event-dispatcher ^Component component]
   3.159 -     (make-scene layer event-dispatcher component nil))
   3.160 -  ([layer event-dispatcher ^Component component hints]
   3.161 +  ([view]
   3.162 +     (make-scene view dummy-event-dispatcher nil))
   3.163 +  ([view event-dispatcher]
   3.164 +     (make-scene view event-dispatcher nil))
   3.165 +  ([view event-dispatcher ^Component component]
   3.166 +     (make-scene view event-dispatcher component nil))
   3.167 +  ([view event-dispatcher ^Component component hints]
   3.168       (let [hints (merge default-rendering-hints hints)]
   3.169 -       (->Scene layer
   3.170 +       (->Scene view
   3.171                  event-dispatcher
   3.172                  component
   3.173                  hints
   3.174 @@ -853,7 +853,7 @@
   3.175        ;; appear in both groups until tmp-watcher is removed.
   3.176        (replace-observers-watcher scene tmp-watcher)
   3.177        (try
   3.178 -        (render! (:layer scene))
   3.179 +        (render! (:view scene))
   3.180          (finally
   3.181           (remove-observers tmp-watcher)
   3.182           (commit (:event-dispatcher scene)))))))
   3.183 @@ -874,7 +874,7 @@
   3.184  (defn scene-geometry [scene]
   3.185    (binding [*scene* scene
   3.186              *font-context* (scene-font-context scene)]
   3.187 -    (geometry (:layer scene))))
   3.188 +    (geometry (:view scene))))
   3.189  
   3.190  (defn set-cursor! [^Cursor cursor]
   3.191    (when-let [^Component component (:component *scene*)]

     4.1 --- a/src/net/kryshen/indyvon/demo.clj	Mon Apr 07 14:24:16 2014 +0400
     4.2 +++ b/src/net/kryshen/indyvon/demo.clj	Mon Apr 07 15:23:58 2014 +0400
     4.3 @@ -21,14 +21,14 @@
     4.4    "Indyvon demo and experiments."
     4.5    (:gen-class)
     4.6    (:use
     4.7 -   (net.kryshen.indyvon core layers viewport component))
     4.8 +   (net.kryshen.indyvon core views viewport component))
     4.9    (:import
    4.10     (java.awt Color)
    4.11     (javax.swing JFrame)))
    4.12  
    4.13  (defn draw-button!
    4.14 -  "Draws button immediately (but uses callback for button action
    4.15 -   unlike IMGUI)."
    4.16 +  "Draws a button immediately (but uses callback for the action unlike
    4.17 +   IMGUI)."
    4.18    [id content callback & args]
    4.19    (with-handlers id
    4.20      (let [shadow-offset 2
    4.21 @@ -65,8 +65,8 @@
    4.22        (Color. (aget rgb 0) (aget rgb 1) (aget rgb 2) (aget rgb 3)))))
    4.23  
    4.24  (defn animate
    4.25 -  "Changes atom value according to specified range, speed, and current
    4.26 -   frame interval. Invokes repaint if change happens."
    4.27 +  "Changes the value of atom according to the specified range, speed,
    4.28 +   and current frame interval.  Invokes repaint if change happens."
    4.29    [atom from to speed]
    4.30    (let [prev @atom
    4.31          state (cond
    4.32 @@ -83,7 +83,7 @@
    4.33           val))))
    4.34  
    4.35  (defn animated-button
    4.36 -  "Create animated button layer."
    4.37 +  "Creates an animated button."
    4.38    [content callback & args]
    4.39    (let [padding 4
    4.40          border-width 1
    4.41 @@ -91,9 +91,9 @@
    4.42          face (border content padding border-width)
    4.43          highlight (atom 0)
    4.44          animation-speed (atom 0)]
    4.45 -    (interval-layer
    4.46 +    (interval-view
    4.47       (reify
    4.48 -      Layer
    4.49 +      View
    4.50        (render! [button]
    4.51          (with-handlers button
    4.52            (let [hovered (hovered? button)
    4.53 @@ -132,12 +132,12 @@
    4.54  (def button2 (animated-button (label "Animated button 2")
    4.55                                println "Animated button 2 clicked"))
    4.56  
    4.57 -(def test-layer1
    4.58 +(def test-view1
    4.59    (reify
    4.60 -   Layer
    4.61 -   (render! [layer]
    4.62 -     (with-handlers layer
    4.63 -       (with-color (if (hovered? layer) Color/ORANGE Color/RED)
    4.64 +   View
    4.65 +   (render! [view]
    4.66 +     (with-handlers view
    4.67 +       (with-color (if (hovered? view) Color/ORANGE Color/RED)
    4.68           (.fillRect *graphics* 0 0 *width* *height*))
    4.69         (:mouse-entered e
    4.70          (repaint)
    4.71 @@ -147,32 +147,32 @@
    4.72          (println e))
    4.73         (:mouse-moved e
    4.74          (println e))))
    4.75 -   (geometry [layer]
    4.76 +   (geometry [view]
    4.77       (->Size 30 20))))
    4.78  
    4.79 -(def test-layer1b (border test-layer1 2 3))
    4.80 +(def test-view1b (border test-view1 2 3))
    4.81  
    4.82 -(def test-layer2
    4.83 +(def test-view2
    4.84    (reify
    4.85 -   Layer
    4.86 -   (render! [layer]
    4.87 +   View
    4.88 +   (render! [view]
    4.89       (doto *graphics*
    4.90         (.setColor Color/YELLOW)
    4.91         (.fillRect 0 0 *width* *height*))
    4.92       (with-rotate 0.5 0 0
    4.93 -       (draw! test-layer1b 30 25))
    4.94 -     (draw! test-layer1 55 5))
    4.95 -   (geometry [layer]
    4.96 +       (draw! test-view1b 30 25))
    4.97 +     (draw! test-view1 55 5))
    4.98 +   (geometry [view]
    4.99       (->Size 70 65))))
   4.100  
   4.101 -(def test-layer2m (miniature test-layer2 30 30))
   4.102 +(def test-view2m (miniature test-view2 30 30))
   4.103  
   4.104 -(def test-layer3 (border (label "Sample\ntext" :right :bottom)))
   4.105 +(def test-view3 (border (label "Sample\ntext" :right :bottom)))
   4.106  
   4.107  (def root
   4.108    (reify
   4.109 -   Layer
   4.110 -   (render! [layer]
   4.111 +   View
   4.112 +   (render! [view]
   4.113       ;;(repaint)
   4.114       (doto *graphics*
   4.115         (.drawLine 0 0 *width* *height*)
   4.116 @@ -180,9 +180,9 @@
   4.117         ;; Random color to see when repaint happens.
   4.118         (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
   4.119         (.fillOval 5 5 20 20))
   4.120 -     (draw! test-layer2 30 20)
   4.121 -     (draw! test-layer2m 120 50)
   4.122 -     (draw! test-layer3 100 100 80 50)
   4.123 +     (draw! test-view2 30 20)
   4.124 +     (draw! test-view2m 120 50)
   4.125 +     (draw! test-view3 100 100 80 50)
   4.126       (draw! button1 50 160)
   4.127       (with-rotate (/ Math/PI 6) 250 200
   4.128         (draw! button1 210 140))
   4.129 @@ -191,7 +191,7 @@
   4.130         (draw-button! :button
   4.131          (label "Immediate button" :center :center)
   4.132          #(println "Button clicked!"))))
   4.133 -   (geometry [layer]
   4.134 +   (geometry [view]
   4.135       (->Size 400 300))))
   4.136  
   4.137  ;; Main viewport
   4.138 @@ -202,8 +202,8 @@
   4.139  
   4.140  ;; Main scene
   4.141  (def scene
   4.142 -  (fps-layer
   4.143 -   (decorate-layer vp [_]
   4.144 +  (fps-view
   4.145 +   (decorate-view vp [_]
   4.146       (draw! vp)
   4.147       (draw-aligned!
   4.148        (label (str "Drag mouse to pan," \newline
   4.149 @@ -211,8 +211,8 @@
   4.150        :left :bottom 5 (- *height* 5))
   4.151       (draw! vp-miniature (- *width* 105) 5))))
   4.152  
   4.153 -(defn show-frame [layer]
   4.154 -  (doto (make-jframe "Test" layer)
   4.155 +(defn show-frame [view]
   4.156 +  (doto (make-jframe "Test" view)
   4.157      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
   4.158      (.setVisible true)))
   4.159  

     5.1 --- a/src/net/kryshen/indyvon/layers.clj	Mon Apr 07 14:24:16 2014 +0400
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,408 +0,0 @@
     5.4 -;;
     5.5 -;; Copyright 2010, 2011, 2012, 2013 Mikhail Kryshen <mikhail@kryshen.net>
     5.6 -;;
     5.7 -;; This file is part of Indyvon.
     5.8 -;;
     5.9 -;; Indyvon is free software: you can redistribute it and/or modify it
    5.10 -;; under the terms of the GNU Lesser General Public License version 3
    5.11 -;; only, as published by the Free Software Foundation.
    5.12 -;;
    5.13 -;; Indyvon is distributed in the hope that it will be useful, but
    5.14 -;; WITHOUT ANY WARRANTY; without even the implied warranty of
    5.15 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    5.16 -;; Lesser General Public License for more details.
    5.17 -;;
    5.18 -;; You should have received a copy of the GNU Lesser General Public
    5.19 -;; License along with Indyvon.  If not, see
    5.20 -;; <http://www.gnu.org/licenses/>.
    5.21 -;;
    5.22 -
    5.23 -(ns net.kryshen.indyvon.layers
    5.24 -  "Implementations of Layer protocol."
    5.25 -  (:use
    5.26 -   (net.kryshen.indyvon core async))
    5.27 -  (:import
    5.28 -   (java.awt Font Image Toolkit)
    5.29 -   java.awt.image.ImageObserver
    5.30 -   (java.awt.geom Area AffineTransform Rectangle2D$Double Point2D
    5.31 -                  Point2D$Double)
    5.32 -   (java.awt.font FontRenderContext TextLayout)
    5.33 -   java.util.concurrent.TimeUnit
    5.34 -   (com.google.common.cache Cache CacheBuilder CacheLoader)))
    5.35 -
    5.36 -(defmacro decorate-layer
    5.37 -  "Decorate Layer replacing render! implementation."
    5.38 -  [layer & render-tail]
    5.39 -  `(let [layer# ~layer]
    5.40 -     (reify
    5.41 -       Layer
    5.42 -       (render! ~@render-tail)
    5.43 -       (geometry [t#] (geometry layer#)))))
    5.44 -
    5.45 -(defrecord Empty []
    5.46 -  Layer
    5.47 -  (render! [_])
    5.48 -  (geometry [_]
    5.49 -    (->Size 0 0)))
    5.50 -
    5.51 -(def empty-layer (->Empty))
    5.52 -
    5.53 -;; TODO: change argument order for decorators, content should be the
    5.54 -;; last.
    5.55 -
    5.56 -(defn padding
    5.57 -  "Decorates layer adding padding."
    5.58 -  ([content pad]
    5.59 -     (padding content pad pad pad pad))
    5.60 -  ([content top left bottom right]
    5.61 -     (if (== 0 top left bottom right)
    5.62 -       content
    5.63 -       (reify
    5.64 -        Layer
    5.65 -        (render! [l]
    5.66 -           (draw! content
    5.67 -                  left top
    5.68 -                  (- *width* left right)
    5.69 -                  (- *height* top bottom)
    5.70 -                  false))
    5.71 -        (geometry [l]
    5.72 -          (->NestedGeometry (geometry content) top left bottom right))))))
    5.73 -
    5.74 -(defn border
    5.75 -  "Decorate layer with a border."
    5.76 -  ([content]
    5.77 -     (border content 1))
    5.78 -  ([content thikness]
    5.79 -     (border content thikness 0))
    5.80 -  ([content thikness gap]
    5.81 -     (let [layer (padding content (+ thikness gap))
    5.82 -           t (double thikness)]
    5.83 -       (decorate-layer layer [_]
    5.84 -         (render! layer)
    5.85 -         (with-color :border-color
    5.86 -           (let [w (double *width*)
    5.87 -                 h (double *height*)
    5.88 -                 outer (Area. (Rectangle2D$Double. 0.0 0.0 w h))
    5.89 -                 inner (Area. (Rectangle2D$Double. t t (- w t t) (- h t t)))]
    5.90 -             (.subtract outer inner)
    5.91 -             (.fill *graphics* outer)))))))
    5.92 -
    5.93 -;; TODO: opacity and blur.
    5.94 -(defn shadow
    5.95 -  "Add shadow to content layer."
    5.96 -  ([content]
    5.97 -     (shadow content 1 1))
    5.98 -  ([content x-offset y-offset]
    5.99 -     (let [x (if (neg? x-offset) (- x-offset) 0)
   5.100 -           y (if (neg? y-offset) (- y-offset) 0)
   5.101 -           abs-x (if (neg? x-offset) (- x-offset) x-offset)
   5.102 -           abs-y (if (neg? y-offset) (- y-offset) y-offset)
   5.103 -           shadow-x (+ x-offset x)
   5.104 -           shadow-y (+ y-offset y)]
   5.105 -       (reify
   5.106 -        Layer
   5.107 -        (render! [_]
   5.108 -          (let [w (- *width* abs-x)
   5.109 -                h (- *height* abs-y)]
   5.110 -            (with-color :shadow-color
   5.111 -              (.fillRect *graphics* shadow-x shadow-y w h))
   5.112 -            (draw! content x y w h)))
   5.113 -        (geometry [_]
   5.114 -          (->NestedGeometry (geometry content)
   5.115 -                            y x shadow-y shadow-x))))))
   5.116 -
   5.117 -(defn panel
   5.118 -  "Opaque layer using theme's alt-back-color or a custom background color."
   5.119 -  ([content]
   5.120 -     (panel :alt-back-color content))
   5.121 -  ([back-color content]
   5.122 -     (decorate-layer content [_]
   5.123 -       (with-color back-color
   5.124 -         (.fill *graphics* (Rectangle2D$Double. 0.0 0.0 *width* *height*)))
   5.125 -       (render! content))))
   5.126 -
   5.127 -(defn hbox
   5.128 -  "Creates layer that draws the specified content layers placing them
   5.129 -   horizontally."
   5.130 -  [& contents]
   5.131 -  (reify
   5.132 -   Layer
   5.133 -   (render! [_]
   5.134 -     (let [widths (map #(width (geometry %)) contents)
   5.135 -           xs (cons 0 (reductions + widths))
   5.136 -           widths-sum (last xs)
   5.137 -           scale (/ *width* widths-sum)]
   5.138 -       (doseq [[c w x] (map vector contents widths xs)]
   5.139 -         (draw! c x 0 w *height*))))
   5.140 -   (geometry [_]
   5.141 -     (reduce #(->Size (+ (width %1) (width %2))
   5.142 -                      (max (height %1) (height %2)))
   5.143 -             (->Size 0 0)
   5.144 -             (map geometry contents)))))
   5.145 -
   5.146 -(defn vbox
   5.147 -  "Creates layer that draws the specified content layers placing them
   5.148 -   vertically."
   5.149 -  [& contents]
   5.150 -  (reify
   5.151 -   Layer
   5.152 -   (render! [_]
   5.153 -     (let [heights (map #(height (geometry %)) contents)
   5.154 -           ys (cons 0 (reductions + heights))
   5.155 -           heights-sum (last ys)
   5.156 -           scale (/ *height* heights-sum)]
   5.157 -       (doseq [[c h y] (map vector contents heights ys)]
   5.158 -         (draw! c 0 y *width* h))))
   5.159 -   (geometry [_]
   5.160 -     (reduce #(->Size (max (width %1) (width %2))
   5.161 -                      (+ (height %1) (height %2)))
   5.162 -             (->Size 0 0)
   5.163 -             (map geometry contents)))))
   5.164 -
   5.165 -(defn- re-split [^java.util.regex.Pattern re s]
   5.166 -  (seq (.split re s)))
   5.167 -
   5.168 -(def ^:private ^Cache text-layout-cache
   5.169 -  (-> (CacheBuilder/newBuilder)
   5.170 -      (.softValues)
   5.171 -      (.expireAfterAccess (long 1) TimeUnit/SECONDS)
   5.172 -      (.build)))
   5.173 -
   5.174 -(defn- get-text-layout
   5.175 -  [^String line ^Font font ^FontRenderContext font-context]
   5.176 -  (.get text-layout-cache [line font font-context]
   5.177 -        #(TextLayout. line font font-context)))
   5.178 -
   5.179 -(defn- layout-text
   5.180 -  [lines font font-context]
   5.181 -  (map #(get-text-layout % font font-context) lines))
   5.182 -
   5.183 -(defn- text-width [layouts]
   5.184 -  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
   5.185 -
   5.186 -(defn- text-height [layouts]
   5.187 -  (reduce (fn [w ^TextLayout tl]
   5.188 -            (+ w (.getAscent tl)
   5.189 -               (.getDescent tl)
   5.190 -               (.getLeading tl)))
   5.191 -          0 layouts))
   5.192 -
   5.193 -(defn label
   5.194 -  "Creates a layer to display multiline text."
   5.195 -  ([text]
   5.196 -     (label text :left :top))
   5.197 -  ([text h-align v-align]
   5.198 -     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" (str text))]
   5.199 -       (reify Layer
   5.200 -        (render! [layer]
   5.201 -          (let [w *width*
   5.202 -                h *height*
   5.203 -                font (.getFont *graphics*)
   5.204 -                layouts (layout-text lines font (font-context))
   5.205 -                y (align-y v-align (text-height layouts) h)]
   5.206 -            (loop [layouts layouts, y y]
   5.207 -              (when-first [^TextLayout layout layouts]
   5.208 -                (let [ascent (.getAscent layout)
   5.209 -                      lh (+ ascent (.getDescent layout) (.getLeading layout))
   5.210 -                      x (align-x h-align (.getAdvance layout) w)]
   5.211 -                  (.draw layout *graphics* x (+ y ascent))
   5.212 -                  (recur (next layouts) (+ y lh)))))))
   5.213 -        (geometry [layer]
   5.214 -          (let [layouts (layout-text lines (:font *theme*) (font-context))
   5.215 -                w (text-width layouts)
   5.216 -                h (text-height layouts)]
   5.217 -            (->Size w h)))))))
   5.218 -
   5.219 -(defn- ^ImageObserver image-observer [layer]
   5.220 -  (reify
   5.221 -   ImageObserver
   5.222 -   (imageUpdate [this img infoflags x y width height]
   5.223 -     (update layer)
   5.224 -     (zero? (bit-and infoflags
   5.225 -                     (bit-or ImageObserver/ALLBITS
   5.226 -                             ImageObserver/ABORT))))))
   5.227 -
   5.228 -(defn image-layer
   5.229 -  [image-or-uri]
   5.230 -  (let [^Image image (if (instance? Image image-or-uri)
   5.231 -                       image-or-uri
   5.232 -                       (.getImage (Toolkit/getDefaultToolkit)
   5.233 -                                  ^java.net.URL image-or-uri))]
   5.234 -    (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
   5.235 -    (reify
   5.236 -     Layer
   5.237 -     (render! [layer]
   5.238 -       (repaint-on-update layer)
   5.239 -       (.drawImage *graphics* image 0 0 (image-observer layer)))
   5.240 -     (geometry [layer]
   5.241 -       (let [observer (image-observer layer)
   5.242 -             width (.getWidth image observer)
   5.243 -             height (.getHeight image observer)
   5.244 -             width (if (pos? width) width 1)
   5.245 -             height (if (pos? height) height 1)]
   5.246 -         (->Size width height))))))
   5.247 -
   5.248 -(def ^:dynamic *miniature-thread-priority* 2)
   5.249 -
   5.250 -(defn ref-layer
   5.251 -  [layer-ref]
   5.252 -  (let [l (reify
   5.253 -           Layer
   5.254 -           (render! [l]
   5.255 -             (repaint-on-update l)
   5.256 -             (if-let [layer @layer-ref]
   5.257 -               (render! layer)))
   5.258 -           (geometry [_]
   5.259 -             (if-let [layer @layer-ref]
   5.260 -               (geometry layer)
   5.261 -               (->Size 1 1))))]
   5.262 -    (add-watch layer-ref l (fn [_ _ _ _] (update l)))
   5.263 -    l))
   5.264 -
   5.265 -;;
   5.266 -;; Layer context decorators.
   5.267 -;;
   5.268 -
   5.269 -(defmacro handler [layer & handlers]
   5.270 -  "Decorate layer to handle events."
   5.271 -  `(let [layer# ~layer]
   5.272 -     (decorate-layer layer# [t#]
   5.273 -       (with-handlers t#
   5.274 -         (render! layer#)
   5.275 -         ~@handlers))))
   5.276 -
   5.277 -(defn themed [layer & map-or-keyvals]
   5.278 -  (let [theme (if (== (count map-or-keyvals) 1)
   5.279 -                (first map-or-keyvals)
   5.280 -                (apply array-map map-or-keyvals))]
   5.281 -    (reify
   5.282 -     Layer
   5.283 -     (render! [_]
   5.284 -       (with-theme theme
   5.285 -         (render! layer)))
   5.286 -     (geometry [_]
   5.287 -       (with-theme theme
   5.288 -         (geometry layer))))))
   5.289 -
   5.290 -(defn hinted [layer & map-or-keyvals]
   5.291 -  (let [hints (if (== (count map-or-keyvals) 1)
   5.292 -                (first map-or-keyvals)
   5.293 -                (apply array-map map-or-keyvals))]
   5.294 -    (decorate-layer layer [_]
   5.295 -      (with-hints* hints render! layer))))
   5.296 -
   5.297 -;;
   5.298 -;; Measuring time
   5.299 -;;
   5.300 -
   5.301 -(def ^:dynamic *interval*)
   5.302 -
   5.303 -(defn interval-layer
   5.304 -  "Creates layer that measures time between repaints ant draws it's
   5.305 -   content with the *interval* var bound to the measured time."
   5.306 -  [content]
   5.307 -  (let [last-time (atom nil)]
   5.308 -    (decorate-layer content [_]
   5.309 -      (compare-and-set! last-time nil *time*)
   5.310 -      (let [lt @last-time]
   5.311 -        (binding [*interval* (if (compare-and-set! last-time lt *time*)
   5.312 -                               (- *time* lt)
   5.313 -                               0)] ; already measured on parallel thread
   5.314 -          (render! content))))))
   5.315 -
   5.316 -(defn- fps-label [text]
   5.317 -  (padding (label text :right :bottom) 5))
   5.318 -
   5.319 -(defn fps-layer
   5.320 -  "Creates layer that draws content and displays
   5.321 -   the frames per seconds rate." 
   5.322 -  [content]
   5.323 -  (let [update-interval 2E8 ; 0.2 s in nanoseconds
   5.324 -        frames (ref 0)
   5.325 -        prev-time (ref nil)
   5.326 -        display (ref (fps-label "fps n/a"))]
   5.327 -    (decorate-layer content [_]
   5.328 -      (draw! content)
   5.329 -      (draw!
   5.330 -       (dosync
   5.331 -        (alter frames inc)
   5.332 -        (if @prev-time
   5.333 -          (let [elapsed (- *time* @prev-time)]
   5.334 -            (when (> elapsed update-interval)
   5.335 -              (let [fps (/ @frames (/ elapsed 1E9))]
   5.336 -                (ref-set display (fps-label (format "%.1f" fps)))
   5.337 -                (ref-set frames 0)
   5.338 -                (ref-set prev-time *time*))))
   5.339 -          (ref-set prev-time *time*))
   5.340 -        @display)))))
   5.341 -
   5.342 -;;
   5.343 -;; Overlayer.
   5.344 -;;
   5.345 -
   5.346 -(def ^:private ^:dynamic *above*)
   5.347 -
   5.348 -(defn- overlay* [f & args]
   5.349 -  (var-set #'*above* (conj *above* (apply partial f args))))
   5.350 -
   5.351 -(defn- ^Point2D to-graphics-coords
   5.352 -  [^AffineTransform transform x y]
   5.353 -  (let [p (Point2D$Double. x y)]
   5.354 -    (.transform transform p p)
   5.355 -    (.transform (.createInverse (.getTransform *graphics*)) p p)
   5.356 -    p))
   5.357 -
   5.358 -(defn- draw-relative!
   5.359 -  ([layer transform x y]
   5.360 -     (let [p (to-graphics-coords transform x y)]
   5.361 -       (draw! layer (.getX p) (.getY p))))
   5.362 -  ([layer transform x y w h]
   5.363 -     (let [p (to-graphics-coords transform x y)]
   5.364 -       (draw! layer (.getX p) (.getY p) w h))))
   5.365 -
   5.366 -(defn- draw-relative-aligned!
   5.367 -  [layer transform h-align v-align x y]
   5.368 -  (let [geom (geometry layer)
   5.369 -        w (width geom)
   5.370 -        h (height geom)
   5.371 -        p (to-graphics-coords transform x y)
   5.372 -        x (- (.getX p) (anchor-x geom h-align w))
   5.373 -        y (- (.getY p) (anchor-y geom v-align h))]
   5.374 -    (draw! layer x y w h)))
   5.375 -
   5.376 -(defn overlay!
   5.377 -  "Draws layer in the overlayer context above the other layers."
   5.378 -  ([layer]
   5.379 -     (overlay* draw-relative! layer (.getTransform *graphics*) 0 0))
   5.380 -  ([layer x y]
   5.381 -     (overlay* draw-relative! layer (.getTransform *graphics*) x y))
   5.382 -  ([layer x y w h]
   5.383 -     (overlay* draw-relative! layer (.getTransform *graphics*) x y w h)))
   5.384 -
   5.385 -(defn overlay-aligned! [layer h-align v-align x y]
   5.386 -  (overlay* draw-relative-aligned!
   5.387 -            layer (.getTransform *graphics*)
   5.388 -            h-align v-align x y))
   5.389 -
   5.390 -(defn with-overlays* [rec? f & args]
   5.391 -  (binding [*above* []]
   5.392 -    (apply f args)
   5.393 -    (if rec?
   5.394 -      (loop [above *above*]
   5.395 -        (when (seq above)
   5.396 -          (var-set #'*above* [])
   5.397 -          (doseq [f above]
   5.398 -            (f))
   5.399 -          (recur *above*)))
   5.400 -      (doseq [of *above*]
   5.401 -        (of)))))
   5.402 -
   5.403 -(defmacro with-overlays [rec? & body]
   5.404 -  `(with-overlays* ~rec? (fn [] ~@body)))
   5.405 -
   5.406 -(defn overlayer
   5.407 -  ([content]
   5.408 -     (overlayer content true))
   5.409 -  ([content rec?]
   5.410 -     (decorate-layer content [_]
   5.411 -       (with-overlays* rec? render! content))))

     6.1 --- a/src/net/kryshen/indyvon/viewport.clj	Mon Apr 07 14:24:16 2014 +0400
     6.2 +++ b/src/net/kryshen/indyvon/viewport.clj	Mon Apr 07 15:23:58 2014 +0400
     6.3 @@ -1,5 +1,5 @@
     6.4  ;;
     6.5 -;; Copyright 2010, 2011, 2012, 2013 Mikhail Kryshen <mikhail@kryshen.net>
     6.6 +;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net>
     6.7  ;;
     6.8  ;; This file is part of Indyvon.
     6.9  ;;
    6.10 @@ -20,7 +20,7 @@
    6.11  (ns net.kryshen.indyvon.viewport
    6.12    "Scrollable viewport and miniature."
    6.13    (:use
    6.14 -   (net.kryshen.indyvon core async layers))
    6.15 +   (net.kryshen.indyvon core async views))
    6.16    (:import
    6.17     java.awt.Cursor
    6.18     java.awt.geom.AffineTransform))
    6.19 @@ -80,15 +80,15 @@
    6.20        :transform transform)))
    6.21  
    6.22  (defrecord Viewport [content h-align v-align state]
    6.23 -  Layer
    6.24 -  (render! [layer]
    6.25 -    (repaint-on-update layer)
    6.26 -    (with-handlers layer
    6.27 +  View
    6.28 +  (render! [view]
    6.29 +    (repaint-on-update view)
    6.30 +    (with-handlers view
    6.31        (let [geom (geometry content)
    6.32              new-state (swap! state update-viewport geom h-align v-align)
    6.33              transform (:transform new-state)]
    6.34          ;; TODO: notify observers when size changes.
    6.35 -        (binding [*viewport* layer
    6.36 +        (binding [*viewport* view
    6.37                    *viewport-transform* transform]
    6.38            (with-transform transform
    6.39              (draw! content 0 0 (width geom) (height geom) false))))
    6.40 @@ -109,10 +109,10 @@
    6.41                                (- (:y-on-screen e) (:fix-y s)))
    6.42                    :fix-x (:x-on-screen e)
    6.43                    :fix-y (:y-on-screen e))))
    6.44 -       (update layer))
    6.45 +       (update view))
    6.46        (:mouse-wheel e
    6.47         (scale-viewport!
    6.48 -        layer
    6.49 +        view
    6.50          (Math/pow *viewport-scaling-step* (:wheel-rotation e))
    6.51          true (:x e) (:y e)))))
    6.52    (geometry [_]
    6.53 @@ -126,7 +126,7 @@
    6.54     0 0))
    6.55  
    6.56  (defn viewport
    6.57 -  "Creates scrollable viewport layer."
    6.58 +  "Creates scrollable viewport view."
    6.59    ([content]
    6.60       (viewport content :left :top))
    6.61    ([content h-align v-align]
    6.62 @@ -175,12 +175,12 @@
    6.63         (/ max-height height)))
    6.64  
    6.65  (defn miniature
    6.66 -  "Creates layer that asynchronously renders view of the content
    6.67 -  scaled to the specified size."
    6.68 +  "Creates a view that asynchronously renders the content view scaled to
    6.69 +  the specified size."
    6.70    [content mw mh]
    6.71 -  (async-layer
    6.72 +  (async-view
    6.73     (reify
    6.74 -    Layer
    6.75 +    View
    6.76      (render! [this]
    6.77        (let [geom (geometry content)
    6.78              cw (width geom)
    6.79 @@ -199,7 +199,7 @@
    6.80    "Creates miniature view of the viewport's contents."
    6.81    [viewport m-width m-height]
    6.82    (let [miniature (miniature (:content viewport) m-width m-height)]
    6.83 -    (decorate-layer miniature [l]
    6.84 +    (decorate-view miniature [l]
    6.85        (repaint-on-update viewport)
    6.86        (let [geom (geometry (:content viewport))
    6.87              s (scaling (width geom) (height geom) m-width m-height)

     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/net/kryshen/indyvon/views.clj	Mon Apr 07 15:23:58 2014 +0400
     7.3 @@ -0,0 +1,409 @@
     7.4 +;;
     7.5 +;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net>
     7.6 +;;
     7.7 +;; This file is part of Indyvon.
     7.8 +;;
     7.9 +;; Indyvon is free software: you can redistribute it and/or modify it
    7.10 +;; under the terms of the GNU Lesser General Public License version 3
    7.11 +;; only, as published by the Free Software Foundation.
    7.12 +;;
    7.13 +;; Indyvon is distributed in the hope that it will be useful, but
    7.14 +;; WITHOUT ANY WARRANTY; without even the implied warranty of
    7.15 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    7.16 +;; Lesser General Public License for more details.
    7.17 +;;
    7.18 +;; You should have received a copy of the GNU Lesser General Public
    7.19 +;; License along with Indyvon.  If not, see
    7.20 +;; <http://www.gnu.org/licenses/>.
    7.21 +;;
    7.22 +
    7.23 +(ns net.kryshen.indyvon.views
    7.24 +  "Implementations of the View protocol."
    7.25 +  (:use
    7.26 +   (net.kryshen.indyvon core async))
    7.27 +  (:import
    7.28 +   (java.awt Font Image Toolkit)
    7.29 +   java.awt.image.ImageObserver
    7.30 +   (java.awt.geom Area AffineTransform Rectangle2D$Double Point2D
    7.31 +                  Point2D$Double)
    7.32 +   (java.awt.font FontRenderContext TextLayout)
    7.33 +   java.util.concurrent.TimeUnit
    7.34 +   (com.google.common.cache Cache CacheBuilder CacheLoader)))
    7.35 +
    7.36 +(defmacro decorate-view
    7.37 +  "Decorate the view replacing render! implementation."
    7.38 +  [view & render-tail]
    7.39 +  `(let [view# ~view]
    7.40 +     (reify
    7.41 +       View
    7.42 +       (render! ~@render-tail)
    7.43 +       (geometry [t#] (geometry view#)))))
    7.44 +
    7.45 +(defrecord Empty []
    7.46 +  View
    7.47 +  (render! [_])
    7.48 +  (geometry [_]
    7.49 +    (->Size 0 0)))
    7.50 +
    7.51 +(def empty-view (->Empty))
    7.52 +
    7.53 +;; TODO: change argument order for decorators, content should be the
    7.54 +;; last.
    7.55 +
    7.56 +(defn padding
    7.57 +  "Adds padding to the content view."
    7.58 +  ([content pad]
    7.59 +     (padding content pad pad pad pad))
    7.60 +  ([content top left bottom right]
    7.61 +     (if (== 0 top left bottom right)
    7.62 +       content
    7.63 +       (reify
    7.64 +        View
    7.65 +        (render! [l]
    7.66 +           (draw! content
    7.67 +                  left top
    7.68 +                  (- *width* left right)
    7.69 +                  (- *height* top bottom)
    7.70 +                  false))
    7.71 +        (geometry [l]
    7.72 +          (->NestedGeometry (geometry content) top left bottom right))))))
    7.73 +
    7.74 +(defn border
    7.75 +  "Adds a border to the content view."
    7.76 +  ([content]
    7.77 +     (border content 1))
    7.78 +  ([content thikness]
    7.79 +     (border content thikness 0))
    7.80 +  ([content thikness gap]
    7.81 +     (let [view (padding content (+ thikness gap))
    7.82 +           t (double thikness)]
    7.83 +       (decorate-view view [_]
    7.84 +         (render! view)
    7.85 +         (with-color :border-color
    7.86 +           (let [w (double *width*)
    7.87 +                 h (double *height*)
    7.88 +                 outer (Area. (Rectangle2D$Double. 0.0 0.0 w h))
    7.89 +                 inner (Area. (Rectangle2D$Double. t t (- w t t) (- h t t)))]
    7.90 +             (.subtract outer inner)
    7.91 +             (.fill *graphics* outer)))))))
    7.92 +
    7.93 +;; TODO: opacity and blur.
    7.94 +(defn shadow
    7.95 +  "Adds a shadow to the content view."
    7.96 +  ([content]
    7.97 +     (shadow content 1 1))
    7.98 +  ([content x-offset y-offset]
    7.99 +     (let [x (if (neg? x-offset) (- x-offset) 0)
   7.100 +           y (if (neg? y-offset) (- y-offset) 0)
   7.101 +           abs-x (if (neg? x-offset) (- x-offset) x-offset)
   7.102 +           abs-y (if (neg? y-offset) (- y-offset) y-offset)
   7.103 +           shadow-x (+ x-offset x)
   7.104 +           shadow-y (+ y-offset y)]
   7.105 +       (reify
   7.106 +        View
   7.107 +        (render! [_]
   7.108 +          (let [w (- *width* abs-x)
   7.109 +                h (- *height* abs-y)]
   7.110 +            (with-color :shadow-color
   7.111 +              (.fillRect *graphics* shadow-x shadow-y w h))
   7.112 +            (draw! content x y w h)))
   7.113 +        (geometry [_]
   7.114 +          (->NestedGeometry (geometry content)
   7.115 +                            y x shadow-y shadow-x))))))
   7.116 +
   7.117 +(defn panel
   7.118 +  "An opaque view using theme's alt-back-color or a custom background
   7.119 +  color."
   7.120 +  ([content]
   7.121 +     (panel :alt-back-color content))
   7.122 +  ([back-color content]
   7.123 +     (decorate-view content [_]
   7.124 +       (with-color back-color
   7.125 +         (.fill *graphics* (Rectangle2D$Double. 0.0 0.0 *width* *height*)))
   7.126 +       (render! content))))
   7.127 +
   7.128 +(defn hbox
   7.129 +  "Creates a view that draws the specified content views placing them
   7.130 +   horizontally."
   7.131 +  [& contents]
   7.132 +  (reify
   7.133 +   View
   7.134 +   (render! [_]
   7.135 +     (let [widths (map #(width (geometry %)) contents)
   7.136 +           xs (cons 0 (reductions + widths))
   7.137 +           widths-sum (last xs)
   7.138 +           scale (/ *width* widths-sum)]
   7.139 +       (doseq [[c w x] (map vector contents widths xs)]
   7.140 +         (draw! c x 0 w *height*))))
   7.141 +   (geometry [_]
   7.142 +     (reduce #(->Size (+ (width %1) (width %2))
   7.143 +                      (max (height %1) (height %2)))
   7.144 +             (->Size 0 0)
   7.145 +             (map geometry contents)))))
   7.146 +
   7.147 +(defn vbox
   7.148 +  "Creates a view that draws the specified content views placing them
   7.149 +   vertically."
   7.150 +  [& contents]
   7.151 +  (reify
   7.152 +   View
   7.153 +   (render! [_]
   7.154 +     (let [heights (map #(height (geometry %)) contents)
   7.155 +           ys (cons 0 (reductions + heights))
   7.156 +           heights-sum (last ys)
   7.157 +           scale (/ *height* heights-sum)]
   7.158 +       (doseq [[c h y] (map vector contents heights ys)]
   7.159 +         (draw! c 0 y *width* h))))
   7.160 +   (geometry [_]
   7.161 +     (reduce #(->Size (max (width %1) (width %2))
   7.162 +                      (+ (height %1) (height %2)))
   7.163 +             (->Size 0 0)
   7.164 +             (map geometry contents)))))
   7.165 +
   7.166 +(defn- re-split [^java.util.regex.Pattern re s]
   7.167 +  (seq (.split re s)))
   7.168 +
   7.169 +(def ^:private ^Cache text-layout-cache
   7.170 +  (-> (CacheBuilder/newBuilder)
   7.171 +      (.softValues)
   7.172 +      (.expireAfterAccess (long 1) TimeUnit/SECONDS)
   7.173 +      (.build)))
   7.174 +
   7.175 +(defn- get-text-layout
   7.176 +  [^String line ^Font font ^FontRenderContext font-context]
   7.177 +  (.get text-layout-cache [line font font-context]
   7.178 +        #(TextLayout. line font font-context)))
   7.179 +
   7.180 +(defn- layout-text
   7.181 +  [lines font font-context]
   7.182 +  (map #(get-text-layout % font font-context) lines))
   7.183 +
   7.184 +(defn- text-width [layouts]
   7.185 +  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
   7.186 +
   7.187 +(defn- text-height [layouts]
   7.188 +  (reduce (fn [w ^TextLayout tl]
   7.189 +            (+ w (.getAscent tl)
   7.190 +               (.getDescent tl)
   7.191 +               (.getLeading tl)))
   7.192 +          0 layouts))
   7.193 +
   7.194 +(defn label
   7.195 +  "Creates a view to display multiline text."
   7.196 +  ([text]
   7.197 +     (label text :left :top))
   7.198 +  ([text h-align v-align]
   7.199 +     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" (str text))]
   7.200 +       (reify View
   7.201 +        (render! [view]
   7.202 +          (let [w *width*
   7.203 +                h *height*
   7.204 +                font (.getFont *graphics*)
   7.205 +                layouts (layout-text lines font (font-context))
   7.206 +                y (align-y v-align (text-height layouts) h)]
   7.207 +            (loop [layouts layouts, y y]
   7.208 +              (when-first [^TextLayout layout layouts]
   7.209 +                (let [ascent (.getAscent layout)
   7.210 +                      lh (+ ascent (.getDescent layout) (.getLeading layout))
   7.211 +                      x (align-x h-align (.getAdvance layout) w)]
   7.212 +                  (.draw layout *graphics* x (+ y ascent))
   7.213 +                  (recur (next layouts) (+ y lh)))))))
   7.214 +        (geometry [view]
   7.215 +          (let [layouts (layout-text lines (:font *theme*) (font-context))
   7.216 +                w (text-width layouts)
   7.217 +                h (text-height layouts)]
   7.218 +            (->Size w h)))))))
   7.219 +
   7.220 +(defn- ^ImageObserver image-observer [view]
   7.221 +  (reify
   7.222 +   ImageObserver
   7.223 +   (imageUpdate [this img infoflags x y width height]
   7.224 +     (update view)
   7.225 +     (zero? (bit-and infoflags
   7.226 +                     (bit-or ImageObserver/ALLBITS
   7.227 +                             ImageObserver/ABORT))))))
   7.228 +
   7.229 +(defn image-view
   7.230 +  [image-or-uri]
   7.231 +  (let [^Image image (if (instance? Image image-or-uri)
   7.232 +                       image-or-uri
   7.233 +                       (.getImage (Toolkit/getDefaultToolkit)
   7.234 +                                  ^java.net.URL image-or-uri))]
   7.235 +    (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
   7.236 +    (reify
   7.237 +     View
   7.238 +     (render! [view]
   7.239 +       (repaint-on-update view)
   7.240 +       (.drawImage *graphics* image 0 0 (image-observer view)))
   7.241 +     (geometry [view]
   7.242 +       (let [observer (image-observer view)
   7.243 +             width (.getWidth image observer)
   7.244 +             height (.getHeight image observer)
   7.245 +             width (if (pos? width) width 1)
   7.246 +             height (if (pos? height) height 1)]
   7.247 +         (->Size width height))))))
   7.248 +
   7.249 +(def ^:dynamic *miniature-thread-priority* 2)
   7.250 +
   7.251 +(defn ref-view
   7.252 +  [view-ref]
   7.253 +  (let [l (reify
   7.254 +           View
   7.255 +           (render! [l]
   7.256 +             (repaint-on-update l)
   7.257 +             (if-let [view @view-ref]
   7.258 +               (render! view)))
   7.259 +           (geometry [_]
   7.260 +             (if-let [view @view-ref]
   7.261 +               (geometry view)
   7.262 +               (->Size 1 1))))]
   7.263 +    (add-watch view-ref l (fn [_ _ _ _] (update l)))
   7.264 +    l))
   7.265 +
   7.266 +;;
   7.267 +;; View context decorators
   7.268 +;;
   7.269 +
   7.270 +(defmacro handler [view & handlers]
   7.271 +  "Adds event handling to the view."
   7.272 +  `(let [view# ~view]
   7.273 +     (decorate-view view# [t#]
   7.274 +       (with-handlers t#
   7.275 +         (render! view#)
   7.276 +         ~@handlers))))
   7.277 +
   7.278 +(defn themed [view & map-or-keyvals]
   7.279 +  (let [theme (if (== (count map-or-keyvals) 1)
   7.280 +                (first map-or-keyvals)
   7.281 +                (apply array-map map-or-keyvals))]
   7.282 +    (reify
   7.283 +     View
   7.284 +     (render! [_]
   7.285 +       (with-theme theme
   7.286 +         (render! view)))
   7.287 +     (geometry [_]
   7.288 +       (with-theme theme
   7.289 +         (geometry view))))))
   7.290 +
   7.291 +(defn hinted [view & map-or-keyvals]
   7.292 +  (let [hints (if (== (count map-or-keyvals) 1)
   7.293 +                (first map-or-keyvals)
   7.294 +                (apply array-map map-or-keyvals))]
   7.295 +    (decorate-view view [_]
   7.296 +      (with-hints* hints render! view))))
   7.297 +
   7.298 +;;
   7.299 +;; Measuring time
   7.300 +;;
   7.301 +
   7.302 +(def ^:dynamic *interval*)
   7.303 +
   7.304 +(defn interval-view
   7.305 +  "Creates a view that measures time between repaints ant draws it's
   7.306 +  content with the *interval* var bound to the measured time."
   7.307 +  [content]
   7.308 +  (let [last-time (atom nil)]
   7.309 +    (decorate-view content [_]
   7.310 +      (compare-and-set! last-time nil *time*)
   7.311 +      (let [lt @last-time]
   7.312 +        (binding [*interval* (if (compare-and-set! last-time lt *time*)
   7.313 +                               (- *time* lt)
   7.314 +                               0)] ; already measured on parallel thread
   7.315 +          (render! content))))))
   7.316 +
   7.317 +(defn- fps-label [text]
   7.318 +  (padding (label text :right :bottom) 5))
   7.319 +
   7.320 +(defn fps-view
   7.321 +  "Creates a view that draws content and displays the
   7.322 +  frames per second rate."
   7.323 +  [content]
   7.324 +  (let [update-interval 2E8 ; 0.2 s in nanoseconds
   7.325 +        frames (ref 0)
   7.326 +        prev-time (ref nil)
   7.327 +        display (ref (fps-label "fps n/a"))]
   7.328 +    (decorate-view content [_]
   7.329 +      (draw! content)
   7.330 +      (draw!
   7.331 +       (dosync
   7.332 +        (alter frames inc)
   7.333 +        (if @prev-time
   7.334 +          (let [elapsed (- *time* @prev-time)]
   7.335 +            (when (> elapsed update-interval)
   7.336 +              (let [fps (/ @frames (/ elapsed 1E9))]
   7.337 +                (ref-set display (fps-label (format "%.1f" fps)))
   7.338 +                (ref-set frames 0)
   7.339 +                (ref-set prev-time *time*))))
   7.340 +          (ref-set prev-time *time*))
   7.341 +        @display)))))
   7.342 +
   7.343 +;;
   7.344 +;; Overlays
   7.345 +;;
   7.346 +
   7.347 +(def ^:private ^:dynamic *above*)
   7.348 +
   7.349 +(defn- overlay* [f & args]
   7.350 +  (var-set #'*above* (conj *above* (apply partial f args))))
   7.351 +
   7.352 +(defn- ^Point2D to-graphics-coords
   7.353 +  [^AffineTransform transform x y]
   7.354 +  (let [p (Point2D$Double. x y)]
   7.355 +    (.transform transform p p)
   7.356 +    (.transform (.createInverse (.getTransform *graphics*)) p p)
   7.357 +    p))
   7.358 +
   7.359 +(defn- draw-relative!
   7.360 +  ([view transform x y]
   7.361 +     (let [p (to-graphics-coords transform x y)]
   7.362 +       (draw! view (.getX p) (.getY p))))
   7.363 +  ([view transform x y w h]
   7.364 +     (let [p (to-graphics-coords transform x y)]
   7.365 +       (draw! view (.getX p) (.getY p) w h))))
   7.366 +
   7.367 +(defn- draw-relative-aligned!
   7.368 +  [view transform h-align v-align x y]
   7.369 +  (let [geom (geometry view)
   7.370 +        w (width geom)
   7.371 +        h (height geom)
   7.372 +        p (to-graphics-coords transform x y)
   7.373 +        x (- (.getX p) (anchor-x geom h-align w))
   7.374 +        y (- (.getY p) (anchor-y geom v-align h))]
   7.375 +    (draw! view x y w h)))
   7.376 +
   7.377 +(defn overlay!
   7.378 +  "Draws view in the overlay context above the other views."
   7.379 +  ([view]
   7.380 +     (overlay* draw-relative! view (.getTransform *graphics*) 0 0))
   7.381 +  ([view x y]
   7.382 +     (overlay* draw-relative! view (.getTransform *graphics*) x y))
   7.383 +  ([view x y w h]
   7.384 +     (overlay* draw-relative! view (.getTransform *graphics*) x y w h)))
   7.385 +
   7.386 +(defn overlay-aligned! [view h-align v-align x y]
   7.387 +  (overlay* draw-relative-aligned!
   7.388 +            view (.getTransform *graphics*)
   7.389 +            h-align v-align x y))
   7.390 +
   7.391 +(defn with-overlays* [rec? f & args]
   7.392 +  (binding [*above* []]
   7.393 +    (apply f args)
   7.394 +    (if rec?
   7.395 +      (loop [above *above*]
   7.396 +        (when (seq above)
   7.397 +          (var-set #'*above* [])
   7.398 +          (doseq [f above]
   7.399 +            (f))
   7.400 +          (recur *above*)))
   7.401 +      (doseq [of *above*]
   7.402 +        (of)))))
   7.403 +
   7.404 +(defmacro with-overlays [rec? & body]
   7.405 +  `(with-overlays* ~rec? (fn [] ~@body)))
   7.406 +
   7.407 +(defn layered
   7.408 +  ([content]
   7.409 +     (layered content true))
   7.410 +  ([content rec?]
   7.411 +     (decorate-view content [_]
   7.412 +       (with-overlays* rec? render! content))))