view src/net/kryshen/indyvon/layers.clj @ 99:ad09a826ebaf

Repaint viewport miniature when the viewport updates.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 15 Mar 2011 05:03:42 +0300
parents fbedad9bd6de
children 9874107e3e96
line source
1 ;;
2 ;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6 ;; Indyvon is free software: you can redistribute it and/or modify it
7 ;; under the terms of the GNU Lesser General Public License version 3
8 ;; only, as published by the Free Software Foundation.
9 ;;
10 ;; Indyvon is distributed in the hope that it will be useful, but
11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
14 ;;
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with Indyvon. If not, see
17 ;; <http://www.gnu.org/licenses/>.
18 ;;
20 (ns net.kryshen.indyvon.layers
21 "Implementations of Layer protocol."
22 (:use
23 (net.kryshen.indyvon core async))
24 (:import
25 (net.kryshen.indyvon.core Size Location)
26 (java.lang.ref SoftReference)
27 (java.awt Font Cursor Image Toolkit)
28 (java.awt.image ImageObserver)
29 (java.awt.font FontRenderContext TextLayout)))
31 ;; Define as macro to avoid unnecessary calculation of inner and outer
32 ;; sizes in the first case.
33 (defmacro align-xy [inner outer align first center last]
34 `(case ~align
35 ~first 0
36 ~center (/ (- ~outer ~inner) 2)
37 ~last (- ~outer ~inner)))
39 (defmacro align-x [inner outer align]
40 `(align-xy ~inner ~outer ~align :left :center :right))
42 (defmacro align-y [inner outer align]
43 `(align-xy ~inner ~outer ~align :top :center :bottom))
45 (defmacro decorate-layer
46 "Decorate Layer and Anchored replacing render! implementation."
47 [layer & render-tail]
48 `(reify
49 Layer
50 (render! ~@render-tail)
51 (layer-size [t#] (layer-size ~layer))
52 Anchored
53 (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
55 (defn padding
56 "Decorates layer adding padding."
57 ([content pad]
58 (padding content pad pad pad pad))
59 ([content top left bottom right]
60 (if (== 0 top left bottom right)
61 content
62 (reify
63 Layer
64 (render! [l]
65 (draw! content
66 left top
67 (- *width* left right)
68 (- *height* top bottom)))
69 (layer-size [l]
70 (let [s (layer-size content)]
71 (Size. (+ (:width s) left right)
72 (+ (:height s) top bottom))))))))
74 (defn border
75 "Decorate layer with a border."
76 ([content]
77 (border content 1))
78 ([content width]
79 (border content width 0))
80 ([content width gap]
81 (let [layer (padding content (+ width gap))]
82 (decorate-layer layer [_]
83 (with-color :border-color
84 (doseq [i (range 0 width)]
85 (.drawRect *graphics* i i
86 (- *width* 1 i i)
87 (- *height* 1 i i))))
88 (render! layer)))))
90 (defn panel
91 "Opaque layer using theme's alt-back-color."
92 ([content]
93 (panel content 0))
94 ([content gap]
95 (let [layer (padding content gap)]
96 (decorate-layer layer [_]
97 (with-color :alt-back-color
98 (.fillRect *graphics* 0 0 *width* *height*))
99 (render! layer)))))
101 (defn hbox
102 "Creates layer that draws the specified content layers placing them
103 horizontally."
104 [& contents]
105 (reify
106 Layer
107 (render! [_]
108 ;; TODO: distribute space proportionally.
109 (let [w (/ *width* (count contents))]
110 (doseq [[i c] (map-indexed vector contents)]
111 (draw! c (* i w) 0 w *height*))))
112 (layer-size [_]
113 (reduce #(Size. (+ (:width %1) (:width %2))
114 (max (:height %1) (:height %2)))
115 (Size. 0 0)
116 (map layer-size contents)))))
118 (defn- re-split [^java.util.regex.Pattern re s]
119 (seq (.split re s)))
121 (def text-layout-cache (atom {}))
123 (defn- get-text-layout
124 [^String line ^Font font ^FontRenderContext font-context]
125 (let [key [line font font-context]]
126 (or (if-let [^SoftReference softref (@text-layout-cache key)]
127 (.get softref)
128 (do (swap! text-layout-cache dissoc key)
129 false))
130 (let [layout (TextLayout. line font font-context)]
131 ;;(println "text-layout-cache miss" line)
132 (swap! text-layout-cache assoc key (SoftReference. layout))
133 layout))))
135 (defn- layout-text
136 [lines ^Font font ^FontRenderContext font-context]
137 (map #(get-text-layout % font font-context) lines))
138 ;;(map #(TextLayout. ^String % font font-context) lines))
140 (defn- text-width [layouts]
141 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
143 (defn- text-height [layouts]
144 (reduce (fn [w ^TextLayout tl]
145 (+ w (.getAscent tl)
146 (.getDescent tl)
147 (.getLeading tl)))
148 0 layouts))
150 (defn label
151 "Creates a layer to display multiline text."
152 ([text]
153 (label text :left :top))
154 ([text h-align v-align]
155 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
156 (reify Layer
157 (render! [layer]
158 (let [w *width*
159 h *height*
160 font (.getFont *graphics*)
161 layouts (layout-text lines font *font-context*)
162 y (align-y (text-height layouts) h v-align)]
163 (loop [layouts layouts, y y]
164 (when-first [^TextLayout layout layouts]
165 (let [ascent (.getAscent layout)
166 lh (+ ascent (.getDescent layout) (.getLeading layout))
167 x (align-x (.getAdvance layout) w h-align)]
168 (.draw layout *graphics* x (+ y ascent))
169 (recur (next layouts) (+ y lh)))))))
170 (layer-size [layer]
171 (let [layouts (layout-text lines (:font *theme*) *font-context*)
172 width (text-width layouts)
173 height (text-height layouts)]
174 (Size. width height)))))))
176 (defn- ^ImageObserver image-observer [layer]
177 (reify
178 ImageObserver
179 (imageUpdate [this img infoflags x y width height]
180 (update layer)
181 (zero? (bit-and infoflags
182 (bit-or ImageObserver/ALLBITS
183 ImageObserver/ABORT))))))
185 (defn image-layer
186 [image-or-uri]
187 (let [^Image image (if (isa? image-or-uri Image)
188 image-or-uri
189 (.getImage (Toolkit/getDefaultToolkit)
190 ^java.net.URL image-or-uri))]
191 (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
192 (reify
193 Layer
194 (render! [layer]
195 (repaint-on-update layer)
196 (.drawImage *graphics* image 0 0 (image-observer layer)))
197 (layer-size [layer]
198 (let [observer (image-observer layer)
199 width (.getWidth image observer)
200 height (.getHeight image observer)
201 width (if (pos? width) width 1)
202 height (if (pos? height) height 1)]
203 (Size. width height))))))
205 (def *miniature-thread-priority* 2)
207 (defn- scaling
208 [width height max-width max-height]
209 (min (/ max-width width)
210 (/ max-height height)))
212 (defn miniature
213 "Creates layer that asynchronously renders view of the content
214 scaled to the specified size."
215 [content width height]
216 (async-layer
217 (reify
218 Layer
219 (render! [this]
220 (let [size (layer-size content)
221 s (scaling (:width size) (:height size) width height)]
222 (.scale *graphics* s s)
223 (draw! content
224 (align-x (:width size) (/ width s) :center)
225 (align-y (:height size) (/ height s) :center)
226 (:width size) (:height size))))
227 (layer-size [this]
228 (Size. width height)))
229 ;; (let [size (layer-size content)
230 ;; s (scaling (:width size) (:height size) width height)]
231 ;; (Size. (* (:width size) s) (* (:height size) s)))))
232 width height *miniature-thread-priority*))
234 (defrecord Viewport [content h-align v-align
235 ;; State (refs)
236 ;; TODO: group into data structures.
237 x y fix-x fix-y last-width last-height
238 vp-x vp-y]
239 Layer
240 (render! [layer]
241 (repaint-on-update layer)
242 (with-handlers layer
243 (let [anchor (anchor content h-align v-align)]
244 (dosync
245 (alter x + (align-x *width* @last-width h-align))
246 (alter y + (align-y *height* @last-height v-align))
247 (ref-set last-width *width*)
248 (ref-set last-height *height*)
249 (ref-set vp-x (+ @x (:x anchor)))
250 (ref-set vp-y (+ @y (:y anchor))))
251 ;; TODO: notify observers when size changes.
252 (draw! content (- @vp-x) (- @vp-y)))
253 (:mouse-pressed e
254 (dosync
255 (ref-set fix-x (:x-on-screen e))
256 (ref-set fix-y (:y-on-screen e)))
257 (when *target*
258 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
259 (:mouse-released e
260 (when *target*
261 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
262 (:mouse-dragged e
263 (dosync
264 (alter x + (- @fix-x (:x-on-screen e)))
265 (alter y + (- @fix-y (:y-on-screen e)))
266 (ref-set fix-x (:x-on-screen e))
267 (ref-set fix-y (:y-on-screen e)))
268 (update layer))))
269 (layer-size [layer]
270 (layer-size content)))
272 (defn viewport
273 "Creates scrollable viewport layer."
274 ([content] (viewport content :left :top))
275 ([content h-align v-align]
276 (Viewport. content h-align v-align
277 (ref 0) (ref 0) ; x y
278 (ref 0) (ref 0) ; fix-x fix-y
279 (ref 0) (ref 0) ; last-width last-height
280 (ref 0) (ref 0)))) ; vp-x vp-y
282 (defn- viewport-visible-bounds
283 [vp]
284 (dosync
285 [@(:vp-x vp) @(:vp-y vp)
286 @(:last-width vp) @(:last-height vp)]))
288 (defn viewport-miniature
289 "Creates miniature view of the viewport's contents."
290 [viewport width height]
291 (let [miniature (miniature (:content viewport) width height)]
292 (decorate-layer miniature [l]
293 (repaint-on-update viewport)
294 (let [size (layer-size (:content viewport))
295 s (scaling (:width size) (:height size) width height)
296 [x y w h] (viewport-visible-bounds viewport)
297 ox (align-x (:width size) (/ width s) :center)
298 oy (align-y (:height size) (/ height s) :center)
299 sx (* (+ x ox) s)
300 sy (* (+ y oy) s)
301 sw (* w s)
302 sh (* h s)
303 move-vp (fn [x y]
304 (dosync
305 (ref-set (:x viewport)
306 (- (/ x s)
307 (/ w 2)
308 ox
309 (- @(:vp-x viewport) @(:x viewport))))
310 (ref-set (:y viewport)
311 (- (/ y s)
312 (/ h 2)
313 oy
314 (- @(:vp-y viewport) @(:y viewport)))))
315 (update viewport))]
316 (with-color :alt-back-color
317 (.fillRect *graphics* 0 0 *width* *height*))
318 (with-color :back-color
319 (.fillRect *graphics* sx sy sw sh))
320 (with-handlers l
321 (draw! miniature)
322 (:mouse-pressed e (move-vp (:x e) (:y e)))
323 (:mouse-dragged e (move-vp (:x e) (:y e))))
324 (with-color :border-color
325 (.drawRect *graphics* sx sy sw sh))))))
327 ;;
328 ;; Layer context decorators.
329 ;;
331 (defmacro handler [layer & handlers]
332 "Decorate layer to handle events."
333 `(let [layer# ~layer]
334 (decorate-layer layer# [t#]
335 (with-handlers t#
336 (render! layer#)
337 ~@handlers))))
339 (defn theme [layer & map-or-keyvals]
340 (let [theme (if (== (count map-or-keyvals) 1)
341 map-or-keyvals
342 (apply array-map map-or-keyvals))]
343 (reify
344 Layer
345 (render! [t]
346 (with-theme theme
347 (render! layer)))
348 (layer-size [t]
349 (with-theme theme
350 (layer-size layer)))
351 Anchored
352 (anchor [t xa ya]
353 (with-theme theme
354 (anchor layer xa ya))))))
356 ;;
357 ;; Measuring time
358 ;;
360 (def *interval*)
362 (defn interval-layer
363 "Creates layer that measures time between repaints ant draws it's
364 content with the *interval* var bound to the measured time."
365 [content]
366 (let [last-time (atom nil)]
367 (decorate-layer content [_]
368 (compare-and-set! last-time nil *time*)
369 (let [lt @last-time]
370 (binding [*interval* (if (compare-and-set! last-time lt *time*)
371 (- *time* lt)
372 0)] ; already measured on parallel thread
373 (render! content))))))
375 (defn- fps-label [text]
376 (padding (label text :right :bottom) 5))
378 (defn fps-layer
379 "Creates layer that draws content and displays
380 the frames per seconds rate."
381 [content]
382 (let [update-interval 2E8 ; 0.2 s in nanoseconds
383 frames (ref 0)
384 prev-time (ref nil)
385 display (ref (fps-label "fps n/a"))]
386 (decorate-layer content [_]
387 (draw! content)
388 (draw!
389 (dosync
390 (alter frames inc)
391 (if @prev-time
392 (let [elapsed (- *time* @prev-time)]
393 (when (> elapsed update-interval)
394 (let [fps (/ @frames (/ elapsed 1E9))]
395 (ref-set display (fps-label (format "%.1f" fps)))
396 (ref-set frames 0)
397 (ref-set prev-time *time*))))
398 (ref-set prev-time *time*))
399 @display)))))