view src/net/kryshen/indyvon/layers.clj @ 65:fd1bcb67bc32

New mechanism for layers to trigger repaints.
author Mikhail Kryshen <mikhail@kryshen.net>
date Fri, 27 Aug 2010 01:24:31 +0400
parents 44a7acf60c16
children a1999c1f7289
line source
1 ;;
2 ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
7 (ns net.kryshen.indyvon.layers
8 "Implementations of Layer protocol."
9 (:use
10 net.kryshen.indyvon.core)
11 (:import
12 (net.kryshen.indyvon.core Size Location)
13 (java.lang.ref SoftReference)
14 (java.awt Font Cursor Image Toolkit)
15 (java.awt.image ImageObserver BufferedImage)
16 (java.awt.font FontRenderContext TextLayout)
17 (java.util.concurrent ThreadPoolExecutor
18 ThreadPoolExecutor$DiscardOldestPolicy
19 ArrayBlockingQueue TimeUnit)))
21 ;; Define as macro to avoid unnecessary calculation of inner and outer
22 ;; sizes in the first case.
23 (defmacro align-xy [inner outer align first center last]
24 `(case ~align
25 ~first 0
26 ~center (/ (- ~outer ~inner) 2)
27 ~last (- ~outer ~inner)))
29 (defmacro align-x [inner outer align]
30 `(align-xy ~inner ~outer ~align :left :center :right))
32 (defmacro align-y [inner outer align]
33 `(align-xy ~inner ~outer ~align :top :center :bottom))
35 (defmacro decorate-layer
36 "Decorate Layer and Anchored replacing render! implementation."
37 [layer & render-tail]
38 `(reify
39 Layer
40 (render! ~@render-tail)
41 (layer-size [t#] (layer-size ~layer))
42 Anchored
43 (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
45 (defn padding
46 "Decorates layer adding padding."
47 ([content pad]
48 (padding content pad pad pad pad))
49 ([content top left bottom right]
50 (if (== 0 top left bottom right)
51 content
52 (reify
53 Layer
54 (render! [l]
55 (draw! content
56 left top
57 (- *width* left right)
58 (- *height* top bottom)))
59 (layer-size [l]
60 (let [s (layer-size content)]
61 (Size. (+ (:width s) left right)
62 (+ (:height s) top bottom))))))))
64 (defn border
65 "Decorate layer with a border."
66 ([content]
67 (border content 1))
68 ([content width]
69 (border content width 0))
70 ([content width gap]
71 (let [layer (padding content (+ width gap))]
72 (decorate-layer layer [_]
73 (with-color (:border-color *theme*)
74 (doseq [i (range 0 width)]
75 (.drawRect *graphics* i i
76 (- *width* 1 i i)
77 (- *height* 1 i i))))
78 (render! layer)))))
80 (defn panel
81 "Opaque layer using theme's alt-back-color."
82 ([content]
83 (panel content 0))
84 ([content gap]
85 (let [layer (padding content gap)]
86 (decorate-layer layer [_]
87 (with-color (:alt-back-color *theme*)
88 (.fillRect *graphics* 0 0 *width* *height*))
89 (render! layer)))))
91 (defn- re-split [^java.util.regex.Pattern re s]
92 (seq (.split re s)))
94 (def text-layout-cache (atom {}))
96 (defn- get-text-layout
97 [^String line ^Font font ^FontRenderContext font-context]
98 (let [key [line font font-context]]
99 (or (if-let [^SoftReference softref (@text-layout-cache key)]
100 (.get softref)
101 (do (swap! text-layout-cache dissoc key)
102 false))
103 (let [layout (TextLayout. line font font-context)]
104 ;;(println "text-layout-cache miss" line)
105 (swap! text-layout-cache assoc key (SoftReference. layout))
106 layout))))
108 (defn- layout-text
109 [lines ^Font font ^FontRenderContext font-context]
110 (map #(get-text-layout % font font-context) lines))
111 ;;(map #(TextLayout. ^String % font font-context) lines))
113 (defn- text-width [layouts]
114 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
116 (defn- text-height [layouts]
117 (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
118 (.getDescent tl)
119 (.getLeading tl)))
120 0 layouts))
122 (defn text-layer
123 "Creates a layer to display multiline text."
124 ([text]
125 (text-layer text :left :top))
126 ([text h-align v-align]
127 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
128 (reify Layer
129 (render! [layer]
130 (let [w *width*
131 h *height*
132 font (.getFont *graphics*)
133 layouts (layout-text lines font *font-context*)
134 y (align-y (text-height layouts) h v-align)]
135 (loop [layouts layouts, y y]
136 (when-first [^TextLayout layout layouts]
137 (let [ascent (.getAscent layout)
138 lh (+ ascent (.getDescent layout) (.getLeading layout))
139 x (align-x (.getAdvance layout) w h-align)]
140 (.draw layout *graphics* x (+ y ascent))
141 (recur (next layouts) (+ y lh)))))))
142 (layer-size [layer]
143 (let [layouts (layout-text lines (:font *theme*) *font-context*)
144 width (text-width layouts)
145 height (text-height layouts)]
146 (Size. width height)))))))
148 (defn- ^ImageObserver image-observer [layer]
149 (reify
150 ImageObserver
151 (imageUpdate [this img infoflags x y width height]
152 (update layer)
153 (zero? (bit-and infoflags
154 (bit-or ImageObserver/ALLBITS
155 ImageObserver/ABORT))))))
157 (defn image-layer
158 [image-or-uri]
159 (let [^Image image (if (isa? image-or-uri Image)
160 image-or-uri
161 (.getImage (Toolkit/getDefaultToolkit)
162 ^java.net.URL image-or-uri))]
163 (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
164 (reify
165 Layer
166 (render! [layer]
167 (repaint-on-update layer)
168 (.drawImage *graphics* image 0 0 (image-observer layer)))
169 (layer-size [layer]
170 (let [observer (image-observer layer)
171 width (.getWidth image observer)
172 height (.getHeight image observer)
173 width (if (pos? width) width 1)
174 height (if (pos? height) height 1)]
175 (Size. width height))))))
177 (defn- create-buffer [async-layer]
178 (BufferedImage. (:width async-layer) (:height async-layer)
179 BufferedImage/TYPE_INT_ARGB))
181 (defn- draw-offscreen [async-layer]
182 ;;(Thread/sleep 3000)
183 (let [buffers (:buffers async-layer)
184 ^Image b (dosync
185 (let [b (peek @buffers)]
186 (alter buffers pop)
187 b))]
188 (try
189 ;; TODO: use operational event dispatcher.
190 (draw-root! (:content async-layer)
191 (.getGraphics b)
192 (:width async-layer)
193 (:height async-layer)
194 dummy-event-dispatcher)
195 (finally
196 (dosync
197 (alter buffers conj b)
198 (ref-set (:updated async-layer) true))))
199 (update async-layer)))
201 (defn- draw-offscreen-async [async-layer]
202 (.execute ^ThreadPoolExecutor (:executor async-layer)
203 #(draw-offscreen async-layer)))
205 (defrecord AsyncLayer [content width height executor buffers updated]
206 Layer
207 (render! [layer]
208 (repaint-on-update layer)
209 (add-context-observer content (fn [_] (draw-offscreen-async layer)))
210 (when-not @buffers
211 ;; TODO: dynamic size, recreate buffers when size increases.
212 (let [new-buffers [(create-buffer layer) (create-buffer layer)]]
213 (dosync
214 (ref-set buffers new-buffers)))
215 (draw-offscreen-async layer))
216 (let [buffer (dosync
217 (if @updated
218 (let [b (peek @buffers)]
219 (alter buffers pop)
220 (ref-set updated false)
221 b)
222 (let [b (first @buffers)]
223 (alter buffers subvec 1)
224 b)))]
225 (.drawImage *graphics* ^Image buffer 0 0 nil)
226 (dosync
227 (alter buffers #(vec (cons buffer %))))))
228 (layer-size [layer]
229 (Size. width height)))
231 (defn async-layer
232 "Creates layer that draws the content asynchroniously in an
233 offscreen buffer."
234 [content width height]
235 (AsyncLayer. content width height
236 (ThreadPoolExecutor.
237 (int 1) (int 1)
238 (long 0) TimeUnit/SECONDS
239 (ArrayBlockingQueue. 1)
240 (ThreadPoolExecutor$DiscardOldestPolicy.))
241 (ref nil)
242 (ref false)))
244 (defn miniature
245 "Creates layer that asynchroniously renders view of the content
246 scaled to the specified size."
247 [content width height]
248 (async-layer
249 (reify
250 Layer
251 (render! [this]
252 (let [size (layer-size content)
253 sx (/ width (:width size))
254 sy (/ height (:height size))]
255 (.scale *graphics* sx sy)
256 (draw! content 0 0 (:width size) (:height size))))
257 (layer-size [this]
258 (Size. width height)))
259 width height))
261 (defn viewport
262 "Creates scrollable viewport layer."
263 ([content] (viewport content :left :top))
264 ([content h-align v-align]
265 (let [x (ref 0)
266 y (ref 0)
267 fix-x (ref 0)
268 fix-y (ref 0)
269 last-width (ref 0)
270 last-height (ref 0)]
271 (reify
272 Layer
273 (render! [layer]
274 (with-handlers layer
275 (let [anchor (anchor content h-align v-align)]
276 (dosync
277 (alter x + (align-x *width* @last-width h-align))
278 (alter y + (align-y *height* @last-height v-align))
279 (ref-set last-width *width*)
280 (ref-set last-height *height*))
281 (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
282 (:mouse-pressed e
283 (dosync
284 (ref-set fix-x (:x-on-screen e))
285 (ref-set fix-y (:y-on-screen e)))
286 (when *target*
287 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
288 (:mouse-released e
289 (when *target*
290 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
291 (:mouse-dragged e
292 (dosync
293 (alter x + (- @fix-x (:x-on-screen e)))
294 (alter y + (- @fix-y (:y-on-screen e)))
295 (ref-set fix-x (:x-on-screen e))
296 (ref-set fix-y (:y-on-screen e)))
297 (repaint))))
298 (layer-size [layer] (layer-size content))))))
300 ;;
301 ;; Layer context decorators.
302 ;;
304 (defmacro handler [layer & handlers]
305 "Decorate layer to handle events."
306 `(let [layer# ~layer]
307 (decorate-layer layer# [t#]
308 (with-handlers t#
309 (render! layer#)
310 ~@handlers))))
312 (defn theme [layer & map-or-keyvals]
313 (let [theme (if (== (count map-or-keyvals) 1)
314 map-or-keyvals
315 (apply array-map map-or-keyvals))]
316 (reify
317 Layer
318 (render! [t]
319 (with-theme theme
320 (render! layer)))
321 (layer-size [t]
322 (with-theme theme
323 (layer-size layer)))
324 Anchored
325 (anchor [t xa ya]
326 (with-theme theme
327 (anchor layer xa ya))))))