Mercurial > hg > indyvon
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)))))