Mercurial > hg > indyvon
changeset 106:f42e2b9e1ad9
Removed Anchored protocol, "layer-size" function in Layer replaced with "geometry" which returns a structure describing both layer size and anchor point.
Indyvon now requires Clojure 1.3.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Wed, 21 Sep 2011 02:27:11 +0300 |
parents | 24e98602b37e |
children | 5fdb0bb99f75 |
files | README.rst README.ru project.clj src/net/kryshen/indyvon/async.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 | 8 files changed, 209 insertions(+), 144 deletions(-) [+] |
line diff
1.1 --- a/README.rst Tue May 24 18:43:49 2011 +0400 1.2 +++ b/README.rst Wed Sep 21 02:27:11 2011 +0300 1.3 @@ -11,7 +11,7 @@ 1.4 (defprotocol Layer 1.5 (render! [layer] 1.6 "Draws the layer.") 1.7 - (layer-size [layer] 1.8 + (geometry [layer] 1.9 "Returns preferred size for the layer.")) 1.10 1.11 Layer functions are called in the Layer context which is defined by
2.1 --- a/README.ru Tue May 24 18:43:49 2011 +0400 2.2 +++ b/README.ru Wed Sep 21 02:27:11 2011 +0300 2.3 @@ -15,7 +15,7 @@ 2.4 (слой), который содержит всего две функции: 2.5 2.6 render! — отрисовка, 2.7 - layer-size — получение предпочтительного размера элемента. 2.8 + geometry — получение предпочтительных размеров элемента. 2.9 2.10 Слой, в отличии от обычных компонентов интерфейса или элементов графов 2.11 сцены в системах визуализации, не имеет состояния (координаты, размер,
3.1 --- a/project.clj Tue May 24 18:43:49 2011 +0400 3.2 +++ b/project.clj Wed Sep 21 02:27:11 2011 +0300 3.3 @@ -1,9 +1,8 @@ 3.4 (defproject indyvon "1.0.0-SNAPSHOT" 3.5 :description "INteractive DYnamic VisualizatiON library" 3.6 ;;:warn-on-reflection true 3.7 - :dependencies [[org.clojure/clojure "1.2.1"] 3.8 + :dependencies [[org.clojure/clojure "1.3.0-RC0"] 3.9 [com.google.guava/guava "r09"]] 3.10 - :dev-dependencies [[swank-clojure "1.3.1"]] 3.11 ;;:aot [net.kryshen.indyvon.core 3.12 ;; net.kryshen.indyvon.async 3.13 ;; net.kryshen.indyvon.layers
4.1 --- a/src/net/kryshen/indyvon/async.clj Tue May 24 18:43:49 2011 +0400 4.2 +++ b/src/net/kryshen/indyvon/async.clj Wed Sep 21 02:27:11 2011 +0300 4.3 @@ -22,7 +22,6 @@ 4.4 (:use 4.5 net.kryshen.indyvon.core) 4.6 (:import 4.7 - (net.kryshen.indyvon.core Size Location) 4.8 java.awt.GraphicsConfiguration 4.9 (java.awt Image AlphaComposite Transparency) 4.10 (java.awt.image BufferedImage) 4.11 @@ -146,8 +145,8 @@ 4.12 (draw-offscreen-async layer)) 4.13 (with-buffer layer :front [b] 4.14 (.drawImage *graphics* ^Image (:image b) 0 0 nil))) 4.15 - (layer-size [layer] 4.16 - (Size. width height))) 4.17 + (geometry [layer] 4.18 + (->Size width height))) 4.19 4.20 (defn- create-thread-factory [priority] 4.21 (reify
5.1 --- a/src/net/kryshen/indyvon/component.clj Tue May 24 18:43:49 2011 +0400 5.2 +++ b/src/net/kryshen/indyvon/component.clj Wed Sep 21 02:27:11 2011 +0300 5.3 @@ -22,7 +22,6 @@ 5.4 (:use 5.5 net.kryshen.indyvon.core) 5.6 (:import 5.7 - (net.kryshen.indyvon.core Size Bounds) 5.8 (java.awt Graphics Component Dimension Color) 5.9 (java.awt.geom Rectangle2D$Double) 5.10 (javax.swing JFrame JPanel JOptionPane))) 5.11 @@ -49,8 +48,8 @@ 5.12 (draw-root! layer g (.width size) (.height size) 5.13 event-dispatcher this))) 5.14 (getPreferredSize [] 5.15 - (let [s (root-size layer (font-context this) this)] 5.16 - (Dimension. (:width s) (:height s)))))] 5.17 + (let [geom (root-geometry layer (font-context this) this)] 5.18 + (Dimension. (width geom) (height geom)))))] 5.19 (.setBackground panel (:back-color *theme*)) 5.20 (add-observer panel layer (fn [w _] 5.21 ;; Use the first observer argument
6.1 --- a/src/net/kryshen/indyvon/core.clj Tue May 24 18:43:49 2011 +0400 6.2 +++ b/src/net/kryshen/indyvon/core.clj Wed Sep 21 02:27:11 2011 +0300 6.3 @@ -93,18 +93,88 @@ 6.4 6.5 (def ^{:dynamic true} *theme* (default-theme)) 6.6 6.7 -(defrecord Location [x y]) 6.8 -(defrecord Size [width height]) 6.9 -(defrecord Bounds [x y width height]) 6.10 - 6.11 ;; 6.12 ;; Core protocols and types 6.13 ;; 6.14 6.15 (defprotocol Layer 6.16 "Basic UI element." 6.17 - (render! [this]) 6.18 - (layer-size [this])) 6.19 + (render! [layer] 6.20 + "Draws layer in the current *graphics* context.") 6.21 + (geometry [layer] 6.22 + "Returns the preferred layer Geometry.")) 6.23 + 6.24 +(defprotocol Geometry 6.25 + "Describes geometry of a Layer. Prefer using the available 6.26 + implementations (Size, FixedGeometry and NestedGeometry) over 6.27 + extending this protocol directly as it is likely to be changed in 6.28 + the future versions." 6.29 + (width [geom] [geom height]) 6.30 + (height [geom] [geom width]) 6.31 + (anchor-x [geom h-align width] 6.32 + "Returns the x coordinate of the anchor point for the specified 6.33 + horizontal alignment and width, h-align could be :left, :center 6.34 + or :right.") 6.35 + (anchor-y [geom v-align height] 6.36 + "Returns the y coordinate of the anchor point for the specified 6.37 + vertical alignment and height, v-align could be :top, :center 6.38 + or :bottom.")) 6.39 + 6.40 +(defrecord Size [width height] 6.41 + Geometry 6.42 + (width [_] width) 6.43 + (width [_ _] width) 6.44 + (height [_] height) 6.45 + (height [_ _] height) 6.46 + (anchor-x [_ h-align width] 6.47 + (case h-align 6.48 + :left 0 6.49 + :center (/ width 2) 6.50 + :right width)) 6.51 + (anchor-y [_ v-align height] 6.52 + (case v-align 6.53 + :top 0 6.54 + :center (/ height 2) 6.55 + :bottom height))) 6.56 + 6.57 +(defrecord FixedGeometry [ax ay width height] 6.58 + Geometry 6.59 + (width [_] width) 6.60 + (width [_ _] width) 6.61 + (height [_] height) 6.62 + (height [_ _] height) 6.63 + (anchor-x [_ _ _] ax) 6.64 + (anchor-y [_ _ _] ay)) 6.65 + 6.66 +(defrecord NestedGeometry [geometry top left bottom right] 6.67 + Geometry 6.68 + (width [_] 6.69 + (+ left right (width geometry))) 6.70 + (width [_ h] 6.71 + (+ left right (width geometry (- h top bottom)))) 6.72 + (height [_] 6.73 + (+ top bottom (height geometry))) 6.74 + (height [_ w] 6.75 + (+ top bottom (height geometry (- w left right)))) 6.76 + (anchor-x [_ h-align w] 6.77 + (+ left (anchor-x geometry h-align (- w left right)))) 6.78 + (anchor-y [_ v-align h] 6.79 + (+ top (anchor-y geometry v-align (- h top bottom))))) 6.80 + 6.81 +(defrecord ScaledGeometry [geometry sx sy] 6.82 + Geometry 6.83 + (width [_] 6.84 + (* sx (width geometry))) 6.85 + (width [_ h] 6.86 + (* sx (width geometry (/ h sy)))) 6.87 + (height [_] 6.88 + (* sy (height geometry))) 6.89 + (height [_ w] 6.90 + (* sy (height geometry (/ w sx)))) 6.91 + (anchor-x [_ h-align w] 6.92 + (* sx (anchor-x geometry h-align (/ w sx)))) 6.93 + (anchor-y [_ v-align h] 6.94 + (* sy (anchor-y geometry v-align (/ h sy))))) 6.95 6.96 ;; TODO: modifiers 6.97 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button 6.98 @@ -128,33 +198,6 @@ 6.99 "Returns true if the specified handle received the :mouse-entered 6.100 event and have not yet received :mouse-exited.")) 6.101 6.102 -(defprotocol Anchored 6.103 - "Provide anchor point for Layers. Used by viewport." 6.104 - (anchor [this h-align v-align] 6.105 - "Anchor point: [x y], h-align could be :left, :center or :right, 6.106 - v-align is :top, :center or :bottom")) 6.107 - 6.108 -(defn default-anchor [layer h-align v-align] 6.109 - (if (and (= h-align :left) 6.110 - (= v-align :top)) 6.111 - (Location. 0 0) 6.112 - (let [size (layer-size layer)] 6.113 - (Location. 6.114 - (case h-align 6.115 - :left 0 6.116 - :center (/ (:width size) 2) 6.117 - :right (:width size)) 6.118 - (case v-align 6.119 - :top 0 6.120 - :center (/ (:height size) 2) 6.121 - :bottom (:height size)))))) 6.122 - 6.123 -;; Default implementation of Anchored for any Layer. 6.124 -(extend-protocol Anchored 6.125 - net.kryshen.indyvon.core.Layer 6.126 - (anchor [this h-align v-align] 6.127 - (default-anchor this h-align v-align))) 6.128 - 6.129 (defn- assoc-cons [m key val] 6.130 (->> (get m key) (cons val) (assoc m key))) 6.131 6.132 @@ -408,8 +451,8 @@ 6.133 ([layer x y] 6.134 (draw! layer x y true)) 6.135 ([layer x y clip?] 6.136 - (let [size (layer-size layer)] 6.137 - (draw! layer x y (:width size) (:height size) clip?))) 6.138 + (let [geom (geometry layer)] 6.139 + (draw! layer x y (width geom) (height geom) clip?))) 6.140 ([layer x y width height] 6.141 (draw! layer x y width height true)) 6.142 ([layer x y width height clip?] 6.143 @@ -417,15 +460,23 @@ 6.144 (with-bounds* x y width height render! layer) 6.145 (with-bounds-noclip* x y width height render! layer)))) 6.146 6.147 -(defn draw-anchored! 6.148 +(defn draw-aligned! 6.149 "Draws layer. Location is relative to the layer's anchor point for 6.150 the specified alignment." 6.151 ([layer h-align v-align x y] 6.152 - (let [anchor (anchor layer h-align v-align)] 6.153 - (draw! layer (- x (:x anchor)) (- y (:y anchor))))) 6.154 + (let [geom (geometry layer) 6.155 + w (width geom) 6.156 + h (height geom)] 6.157 + (draw! layer 6.158 + (- x (anchor-x geom h-align w)) 6.159 + (- y (anchor-y geom v-align h)) 6.160 + w h))) 6.161 ([layer h-align v-align x y w h] 6.162 - (let [anchor (anchor layer h-align v-align)] 6.163 - (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h)))) 6.164 + (let [geom (geometry layer)] 6.165 + (draw! layer 6.166 + (- x (anchor-x geom h-align w)) 6.167 + (- y (anchor-y geom v-align h)) 6.168 + w h)))) 6.169 6.170 (defn draw-root! 6.171 "Draws the root layer." 6.172 @@ -468,14 +519,14 @@ 6.173 (remove-observers tmp-watcher) 6.174 (commit event-dispatcher))))))) 6.175 6.176 -(defn root-size 6.177 +(defn root-geometry 6.178 ([layer font-context] 6.179 - (root-size layer font-context nil)) 6.180 + (root-geometry layer font-context nil)) 6.181 ([layer font-context target] 6.182 (binding [*root* layer 6.183 *target* target 6.184 *font-context* font-context] 6.185 - (layer-size layer)))) 6.186 + (geometry layer)))) 6.187 6.188 ;; 6.189 ;; Event handling.
7.1 --- a/src/net/kryshen/indyvon/demo.clj Tue May 24 18:43:49 2011 +0400 7.2 +++ b/src/net/kryshen/indyvon/demo.clj Wed Sep 21 02:27:11 2011 +0300 7.3 @@ -23,7 +23,6 @@ 7.4 (:use 7.5 (net.kryshen.indyvon core layers component)) 7.6 (:import 7.7 - (net.kryshen.indyvon.core Size) 7.8 (java.awt Color) 7.9 (javax.swing JFrame))) 7.10 7.11 @@ -121,10 +120,10 @@ 7.12 (:mouse-pressed _ (repaint)) 7.13 (:mouse-released _ (repaint)) 7.14 (:mouse-clicked _ (apply callback args)))) 7.15 - (layer-size [button] 7.16 - (let [face-size (layer-size face)] 7.17 - (Size. (+ (:width face-size) shadow-offset) 7.18 - (+ (:height face-size) shadow-offset)))))))) 7.19 + (geometry [button] 7.20 + (let [face-geom (geometry face)] 7.21 + (->Size (+ (width face-geom) shadow-offset) 7.22 + (+ (height face-geom) shadow-offset)))))))) 7.23 7.24 (def button1 (animated-button (label "Animated button 1") 7.25 println "Animated button 1 clicked")) 7.26 @@ -147,8 +146,8 @@ 7.27 (println e)) 7.28 (:mouse-moved e 7.29 (println e)))) 7.30 - (layer-size [layer] 7.31 - (Size. 30 20)))) 7.32 + (geometry [layer] 7.33 + (->Size 30 20)))) 7.34 7.35 (def test-layer1b (border test-layer1 2 3)) 7.36 7.37 @@ -162,8 +161,8 @@ 7.38 (with-rotate 0.5 0 0 7.39 (draw! test-layer1b 30 25)) 7.40 (draw! test-layer1 55 5)) 7.41 - (layer-size [layer] 7.42 - (Size. 70 65)))) 7.43 + (geometry [layer] 7.44 + (->Size 70 65)))) 7.45 7.46 (def test-layer2m (miniature test-layer2 30 30)) 7.47 7.48 @@ -191,8 +190,8 @@ 7.49 (draw-button! :button 7.50 (label "Immediate button" :center :center) 7.51 #(println "Button clicked!")))) 7.52 - (layer-size [layer] 7.53 - (Size. 400 300)))) 7.54 + (geometry [layer] 7.55 + (->Size 400 300)))) 7.56 7.57 ;; Main viewport 7.58 (def vp (viewport root)) 7.59 @@ -205,7 +204,7 @@ 7.60 (fps-layer 7.61 (decorate-layer vp [_] 7.62 (draw! vp) 7.63 - (draw-anchored! 7.64 + (draw-aligned! 7.65 (label (str "Drag mouse to pan," \newline 7.66 "use mouse wheel to zoom.")) 7.67 :left :bottom 5 (- *height* 5))
8.1 --- a/src/net/kryshen/indyvon/layers.clj Tue May 24 18:43:49 2011 +0400 8.2 +++ b/src/net/kryshen/indyvon/layers.clj Wed Sep 21 02:27:11 2011 +0300 8.3 @@ -22,7 +22,6 @@ 8.4 (:use 8.5 (net.kryshen.indyvon core async)) 8.6 (:import 8.7 - (net.kryshen.indyvon.core Size Location) 8.8 (java.lang.ref SoftReference) 8.9 (java.awt Font Cursor Image Toolkit Point) 8.10 java.awt.image.ImageObserver 8.11 @@ -47,14 +46,13 @@ 8.12 `(align-xy ~inner ~outer ~align :top :center :bottom)) 8.13 8.14 (defmacro decorate-layer 8.15 - "Decorate Layer and Anchored replacing render! implementation." 8.16 + "Decorate Layer replacing render! implementation." 8.17 [layer & render-tail] 8.18 - `(reify 8.19 - Layer 8.20 - (render! ~@render-tail) 8.21 - (layer-size [t#] (layer-size ~layer)) 8.22 - Anchored 8.23 - (anchor [t# xa# ya#] (anchor ~layer xa# ya#)))) 8.24 + `(let [layer# ~layer] 8.25 + (reify 8.26 + Layer 8.27 + (render! ~@render-tail) 8.28 + (geometry [t#] (geometry layer#))))) 8.29 8.30 (defn padding 8.31 "Decorates layer adding padding." 8.32 @@ -70,10 +68,8 @@ 8.33 left top 8.34 (- *width* left right) 8.35 (- *height* top bottom))) 8.36 - (layer-size [l] 8.37 - (let [s (layer-size content)] 8.38 - (Size. (+ (:width s) left right) 8.39 - (+ (:height s) top bottom)))))))) 8.40 + (geometry [l] 8.41 + (->NestedGeometry (geometry content) top left bottom right)))))) 8.42 8.43 (defn border 8.44 "Decorate layer with a border." 8.45 @@ -110,7 +106,6 @@ 8.46 shadow-x (+ x-offset x) 8.47 shadow-y (+ y-offset y)] 8.48 (reify 8.49 - ;; TODO: Anchored 8.50 Layer 8.51 (render! [_] 8.52 (let [w (- *width* abs-x) 8.53 @@ -118,10 +113,9 @@ 8.54 (with-color :shadow-color 8.55 (.fillRect *graphics* shadow-x shadow-y w h)) 8.56 (draw! content x y w h))) 8.57 - (layer-size [_] 8.58 - (let [s (layer-size content)] 8.59 - (Size. (+ (:width s) abs-x) 8.60 - (+ (:height s) abs-y)))))))) 8.61 + (geometry [_] 8.62 + (->NestedGeometry (geometry content) 8.63 + y x shadow-y shadow-x)))))) 8.64 8.65 (defn panel 8.66 "Opaque layer using theme's alt-back-color." 8.67 @@ -141,17 +135,17 @@ 8.68 (reify 8.69 Layer 8.70 (render! [_] 8.71 - (let [widths (map #(:width (layer-size %)) contents) 8.72 + (let [widths (map #(width (geometry %)) contents) 8.73 xs (cons 0 (reductions + widths)) 8.74 widths-sum (last xs) 8.75 scale (/ *width* widths-sum)] 8.76 (doseq [[c w x] (map vector contents widths xs)] 8.77 (draw! c x 0 w *height*)))) 8.78 - (layer-size [_] 8.79 - (reduce #(Size. (+ (:width %1) (:width %2)) 8.80 - (max (:height %1) (:height %2))) 8.81 - (Size. 0 0) 8.82 - (map layer-size contents))))) 8.83 + (geometry [_] 8.84 + (reduce #(->Size (+ (width %1) (width %2)) 8.85 + (max (height %1) (height %2))) 8.86 + (->Size 0 0) 8.87 + (map geometry contents))))) 8.88 8.89 (defn vbox 8.90 "Creates layer that draws the specified content layers placing them 8.91 @@ -160,17 +154,17 @@ 8.92 (reify 8.93 Layer 8.94 (render! [_] 8.95 - (let [heights (map #(:height (layer-size %)) contents) 8.96 + (let [heights (map #(height (geometry %)) contents) 8.97 ys (cons 0 (reductions + heights)) 8.98 heights-sum (last ys) 8.99 scale (/ *height* heights-sum)] 8.100 (doseq [[c h y] (map vector contents heights ys)] 8.101 (draw! c 0 y *width* h)))) 8.102 - (layer-size [_] 8.103 - (reduce #(Size. (max (:width %1) (:width %2)) 8.104 - (+ (:height %1) (:height %2))) 8.105 - (Size. 0 0) 8.106 - (map layer-size contents))))) 8.107 + (geometry [_] 8.108 + (reduce #(->Size (max (width %1) (width %2)) 8.109 + (+ (height %1) (height %2))) 8.110 + (->Size 0 0) 8.111 + (map geometry contents))))) 8.112 8.113 (defn- re-split [^java.util.regex.Pattern re s] 8.114 (seq (.split re s))) 8.115 @@ -223,11 +217,11 @@ 8.116 x (align-x (.getAdvance layout) w h-align)] 8.117 (.draw layout *graphics* x (+ y ascent)) 8.118 (recur (next layouts) (+ y lh))))))) 8.119 - (layer-size [layer] 8.120 + (geometry [layer] 8.121 (let [layouts (layout-text lines (:font *theme*) *font-context*) 8.122 - width (text-width layouts) 8.123 - height (text-height layouts)] 8.124 - (Size. width height))))))) 8.125 + w (text-width layouts) 8.126 + h (text-height layouts)] 8.127 + (->Size w h))))))) 8.128 8.129 (defn- ^ImageObserver image-observer [layer] 8.130 (reify 8.131 @@ -250,13 +244,13 @@ 8.132 (render! [layer] 8.133 (repaint-on-update layer) 8.134 (.drawImage *graphics* image 0 0 (image-observer layer))) 8.135 - (layer-size [layer] 8.136 + (geometry [layer] 8.137 (let [observer (image-observer layer) 8.138 width (.getWidth image observer) 8.139 height (.getHeight image observer) 8.140 width (if (pos? width) width 1) 8.141 height (if (pos? height) height 1)] 8.142 - (Size. width height)))))) 8.143 + (->Size width height)))))) 8.144 8.145 (def ^{:dynamic true} *miniature-thread-priority* 2) 8.146 8.147 @@ -268,24 +262,23 @@ 8.148 (defn miniature 8.149 "Creates layer that asynchronously renders view of the content 8.150 scaled to the specified size." 8.151 - [content width height] 8.152 + [content mw mh] 8.153 (async-layer 8.154 (reify 8.155 Layer 8.156 (render! [this] 8.157 - (let [size (layer-size content) 8.158 - s (scaling (:width size) (:height size) width height)] 8.159 + (let [geom (geometry content) 8.160 + cw (width geom) 8.161 + ch (height geom) 8.162 + s (scaling cw ch mw mh)] 8.163 (.scale *graphics* s s) 8.164 (draw! content 8.165 - (align-x (:width size) (/ width s) :center) 8.166 - (align-y (:height size) (/ height s) :center) 8.167 - (:width size) (:height size)))) 8.168 - (layer-size [this] 8.169 - (Size. width height))) 8.170 - ;; (let [size (layer-size content) 8.171 - ;; s (scaling (:width size) (:height size) width height)] 8.172 - ;; (Size. (* (:width size) s) (* (:height size) s))))) 8.173 - width height *miniature-thread-priority*)) 8.174 + (align-x cw (/ mw s) :center) 8.175 + (align-y ch (/ mh s) :center) 8.176 + cw ch))) 8.177 + (geometry [_] 8.178 + (->Size mw mh))) 8.179 + mw mh *miniature-thread-priority*)) 8.180 8.181 ;;(defn- translate [^AffineTransform transform ^double x ^double y] 8.182 ;; (doto ^AffineTransform (.clone transform) 8.183 @@ -309,17 +302,22 @@ 8.184 ;; State (refs) 8.185 transform 8.186 fix-x fix-y 8.187 - last-width last-height last-anchor] 8.188 + last-width last-height 8.189 + last-anchor-x last-anchor-y] 8.190 Layer 8.191 (render! [layer] 8.192 (repaint-on-update layer) 8.193 (with-handlers layer 8.194 - (let [anchor (anchor content h-align v-align)] 8.195 + (let [geom (geometry content) 8.196 + cw (width geom) 8.197 + ch (height geom) 8.198 + ax (anchor-x geom h-align cw) 8.199 + ay (anchor-y geom v-align ch)] 8.200 (dosync 8.201 (let [ax1 (align-x @last-width *width* h-align) 8.202 ay1 (align-y @last-height *height* v-align) 8.203 - ax2 (- (:x @last-anchor) (:x anchor)) 8.204 - ay2 (- (:y @last-anchor) (:y anchor))] 8.205 + ax2 (- @last-anchor-x ax) 8.206 + ay2 (- @last-anchor-y ay)] 8.207 (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2)) 8.208 (ref-set transform 8.209 (doto (AffineTransform/getTranslateInstance ax1 ay1) 8.210 @@ -327,10 +325,11 @@ 8.211 (.translate ax2 ay2))))) 8.212 (ref-set last-width *width*) 8.213 (ref-set last-height *height*) 8.214 - (ref-set last-anchor anchor)) 8.215 + (ref-set last-anchor-x ax) 8.216 + (ref-set last-anchor-y ay)) 8.217 ;; TODO: notify observers when size changes. 8.218 (with-transform @transform 8.219 - (draw! content 0 0 false))) 8.220 + (draw! content 0 0 cw ch false))) 8.221 (:mouse-pressed e 8.222 (dosync 8.223 (ref-set fix-x (:x-on-screen e)) 8.224 @@ -364,8 +363,8 @@ 8.225 *viewport-max-scale*) 8.226 (ref-set transform scaled)))) 8.227 (update layer)))) 8.228 - (layer-size [layer] 8.229 - (layer-size content))) 8.230 + (geometry [_] 8.231 + (geometry content))) 8.232 8.233 (defn viewport 8.234 "Creates scrollable viewport layer." 8.235 @@ -376,31 +375,32 @@ 8.236 (ref (AffineTransform.)) ; transform 8.237 (ref 0) (ref 0) ; fix-x fix-y 8.238 (ref 0) (ref 0) ; last-width last-height 8.239 - (ref (Location. 0 0))))) ; last-anchor 8.240 + (ref 0) (ref 0)))) ; last-anchor-x last-anchor-y 8.241 8.242 (defn reset-viewport [viewport] 8.243 (dosync 8.244 (ref-set (:last-width viewport) 0) 8.245 (ref-set (:last-height viewport) 0) 8.246 - (ref-set (:last-anchor viewport) (Location. 0 0)) 8.247 + (ref-set (:last-anchor-x viewport) 0) 8.248 + (ref-set (:last-anchor-y viewport) 0) 8.249 (ref-set (:transform viewport) (AffineTransform.))) 8.250 (update viewport)) 8.251 8.252 (defn viewport-miniature 8.253 "Creates miniature view of the viewport's contents." 8.254 - [viewport width height] 8.255 - (let [miniature (miniature (:content viewport) width height)] 8.256 + [viewport m-width m-height] 8.257 + (let [miniature (miniature (:content viewport) m-width m-height)] 8.258 (decorate-layer miniature [l] 8.259 (repaint-on-update viewport) 8.260 - (let [size (layer-size (:content viewport)) 8.261 - s (scaling (:width size) (:height size) width height) 8.262 + (let [geom (geometry (:content viewport)) 8.263 + s (scaling (width geom) (height geom) m-width m-height) 8.264 [vp-tr w h] (dosync 8.265 [@(:transform viewport) 8.266 @(:last-width viewport) 8.267 @(:last-height viewport)]) 8.268 vp-inverse (.createInverse ^AffineTransform vp-tr) 8.269 - ox (align-x (:width size) (/ width s) :center) 8.270 - oy (align-y (:height size) (/ height s) :center) 8.271 + ox (align-x (width geom) (/ m-width s) :center) 8.272 + oy (align-y (height geom) (/ m-height s) :center) 8.273 transform (doto (AffineTransform.) 8.274 (.scale s s) 8.275 (.translate ox oy) 8.276 @@ -437,15 +437,10 @@ 8.277 (repaint-on-update l) 8.278 (if-let [layer @layer-ref] 8.279 (render! layer))) 8.280 - (layer-size [_] 8.281 + (geometry [_] 8.282 (if-let [layer @layer-ref] 8.283 - (layer-size layer) 8.284 - (Size. 1 1))) 8.285 - Anchored 8.286 - (anchor [_ x-align y-align] 8.287 - (if-let [layer @layer-ref] 8.288 - (anchor layer x-align y-align) 8.289 - (Location. 0 0))))] 8.290 + (geometry layer) 8.291 + (->Size 1 1))))] 8.292 (add-watch layer-ref l (fn [_ _ _ _] (update l))) 8.293 l)) 8.294 8.295 @@ -467,16 +462,12 @@ 8.296 (apply array-map map-or-keyvals))] 8.297 (reify 8.298 Layer 8.299 - (render! [t] 8.300 + (render! [_] 8.301 (with-theme theme 8.302 (render! layer))) 8.303 - (layer-size [t] 8.304 + (geometry [_] 8.305 (with-theme theme 8.306 - (layer-size layer))) 8.307 - Anchored 8.308 - (anchor [t xa ya] 8.309 - (with-theme theme 8.310 - (anchor layer xa ya)))))) 8.311 + (geometry layer)))))) 8.312 8.313 (defn hinted [layer & map-or-keyvals] 8.314 (let [hints (if (== (count map-or-keyvals) 1) 8.315 @@ -553,7 +544,17 @@ 8.316 ([layer transform x y w h] 8.317 (let [p (to-graphics-coords transform x y)] 8.318 (draw! layer (.x p) (.y p) w h)))) 8.319 - 8.320 + 8.321 +(defn- draw-relative-aligned! 8.322 + [layer transform h-align v-align x y] 8.323 + (let [geom (geometry layer) 8.324 + w (width geom) 8.325 + h (height geom) 8.326 + p (to-graphics-coords transform x y) 8.327 + x (- (.x p) (anchor-x geom h-align w)) 8.328 + y (- (.y p) (anchor-y geom v-align h))] 8.329 + (draw! layer x y w h))) 8.330 + 8.331 (defn overlay! 8.332 "Draws layer in the overlayer context above the other layers." 8.333 ([layer] 8.334 @@ -563,6 +564,11 @@ 8.335 ([layer x y w h] 8.336 (overlay* draw-relative! layer (.getTransform *graphics*) x y w h))) 8.337 8.338 +(defn overlay-aligned! [layer h-align v-align x y] 8.339 + (overlay* draw-relative-aligned! 8.340 + layer (.getTransform *graphics*) 8.341 + h-align v-align x y)) 8.342 + 8.343 (defn overlayer 8.344 [content] 8.345 (decorate-layer content [_] 8.346 @@ -570,3 +576,15 @@ 8.347 (render! content) 8.348 (doseq [f *above*] 8.349 (f))))) 8.350 + 8.351 +(defn overlayer* 8.352 + [content] 8.353 + (decorate-layer content [_] 8.354 + (binding [*above* []] 8.355 + (render! content) 8.356 + (loop [above *above*] 8.357 + (when (seq above) 8.358 + (var-set #'*above* []) 8.359 + (doseq [f above] 8.360 + (f)) 8.361 + (recur *above*))))))