Mercurial > hg > indyvon
view src/net/kryshen/indyvon/layers.clj @ 70:b2f6c78413d3
Viewport miniature.
With-color macro accepts keyword identifying color in theme.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Sun, 29 Aug 2010 18:33:41 +0400 |
| parents | 9b511fe09867 |
| children | 59e1810c0278 |
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 async))
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)
16 (java.awt.font FontRenderContext TextLayout)))
18 ;; Define as macro to avoid unnecessary calculation of inner and outer
19 ;; sizes in the first case.
20 (defmacro align-xy [inner outer align first center last]
21 `(case ~align
22 ~first 0
23 ~center (/ (- ~outer ~inner) 2)
24 ~last (- ~outer ~inner)))
26 (defmacro align-x [inner outer align]
27 `(align-xy ~inner ~outer ~align :left :center :right))
29 (defmacro align-y [inner outer align]
30 `(align-xy ~inner ~outer ~align :top :center :bottom))
32 (defmacro decorate-layer
33 "Decorate Layer and Anchored replacing render! implementation."
34 [layer & render-tail]
35 `(reify
36 Layer
37 (render! ~@render-tail)
38 (layer-size [t#] (layer-size ~layer))
39 Anchored
40 (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
42 (defn padding
43 "Decorates layer adding padding."
44 ([content pad]
45 (padding content pad pad pad pad))
46 ([content top left bottom right]
47 (if (== 0 top left bottom right)
48 content
49 (reify
50 Layer
51 (render! [l]
52 (draw! content
53 left top
54 (- *width* left right)
55 (- *height* top bottom)))
56 (layer-size [l]
57 (let [s (layer-size content)]
58 (Size. (+ (:width s) left right)
59 (+ (:height s) top bottom))))))))
61 (defn border
62 "Decorate layer with a border."
63 ([content]
64 (border content 1))
65 ([content width]
66 (border content width 0))
67 ([content width gap]
68 (let [layer (padding content (+ width gap))]
69 (decorate-layer layer [_]
70 (with-color :border-color
71 (doseq [i (range 0 width)]
72 (.drawRect *graphics* i i
73 (- *width* 1 i i)
74 (- *height* 1 i i))))
75 (render! layer)))))
77 (defn panel
78 "Opaque layer using theme's alt-back-color."
79 ([content]
80 (panel content 0))
81 ([content gap]
82 (let [layer (padding content gap)]
83 (decorate-layer layer [_]
84 (with-color :alt-back-color
85 (.fillRect *graphics* 0 0 *width* *height*))
86 (render! layer)))))
88 (defn- re-split [^java.util.regex.Pattern re s]
89 (seq (.split re s)))
91 (def text-layout-cache (atom {}))
93 (defn- get-text-layout
94 [^String line ^Font font ^FontRenderContext font-context]
95 (let [key [line font font-context]]
96 (or (if-let [^SoftReference softref (@text-layout-cache key)]
97 (.get softref)
98 (do (swap! text-layout-cache dissoc key)
99 false))
100 (let [layout (TextLayout. line font font-context)]
101 ;;(println "text-layout-cache miss" line)
102 (swap! text-layout-cache assoc key (SoftReference. layout))
103 layout))))
105 (defn- layout-text
106 [lines ^Font font ^FontRenderContext font-context]
107 (map #(get-text-layout % font font-context) lines))
108 ;;(map #(TextLayout. ^String % font font-context) lines))
110 (defn- text-width [layouts]
111 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
113 (defn- text-height [layouts]
114 (reduce (fn [w ^TextLayout tl]
115 (+ w (.getAscent tl)
116 (.getDescent tl)
117 (.getLeading tl)))
118 0 layouts))
120 (defn text-layer
121 "Creates a layer to display multiline text."
122 ([text]
123 (text-layer text :left :top))
124 ([text h-align v-align]
125 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
126 (reify Layer
127 (render! [layer]
128 (let [w *width*
129 h *height*
130 font (.getFont *graphics*)
131 layouts (layout-text lines font *font-context*)
132 y (align-y (text-height layouts) h v-align)]
133 (loop [layouts layouts, y y]
134 (when-first [^TextLayout layout layouts]
135 (let [ascent (.getAscent layout)
136 lh (+ ascent (.getDescent layout) (.getLeading layout))
137 x (align-x (.getAdvance layout) w h-align)]
138 (.draw layout *graphics* x (+ y ascent))
139 (recur (next layouts) (+ y lh)))))))
140 (layer-size [layer]
141 (let [layouts (layout-text lines (:font *theme*) *font-context*)
142 width (text-width layouts)
143 height (text-height layouts)]
144 (Size. width height)))))))
146 (defn- ^ImageObserver image-observer [layer]
147 (reify
148 ImageObserver
149 (imageUpdate [this img infoflags x y width height]
150 (update layer)
151 (zero? (bit-and infoflags
152 (bit-or ImageObserver/ALLBITS
153 ImageObserver/ABORT))))))
155 (defn image-layer
156 [image-or-uri]
157 (let [^Image image (if (isa? image-or-uri Image)
158 image-or-uri
159 (.getImage (Toolkit/getDefaultToolkit)
160 ^java.net.URL image-or-uri))]
161 (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
162 (reify
163 Layer
164 (render! [layer]
165 (repaint-on-update layer)
166 (.drawImage *graphics* image 0 0 (image-observer layer)))
167 (layer-size [layer]
168 (let [observer (image-observer layer)
169 width (.getWidth image observer)
170 height (.getHeight image observer)
171 width (if (pos? width) width 1)
172 height (if (pos? height) height 1)]
173 (Size. width height))))))
175 (defn miniature
176 "Creates layer that asynchronously renders view of the content
177 scaled to the specified size."
178 [content width height]
179 (async-layer
180 (reify
181 Layer
182 (render! [this]
183 (let [size (layer-size content)
184 sx (/ width (:width size))
185 sy (/ height (:height size))]
186 (.scale *graphics* sx sy)
187 (draw! content 0 0 (:width size) (:height size))))
188 (layer-size [this]
189 (Size. width height)))
190 width height))
192 (defrecord Viewport [content h-align v-align
193 ;; state (refs)
194 x y fix-x fix-y last-width last-height]
195 Layer
196 (render! [layer]
197 (repaint-on-update layer)
198 (with-handlers layer
199 (let [anchor (anchor content h-align v-align)]
200 (dosync
201 (alter x + (align-x *width* @last-width h-align))
202 (alter y + (align-y *height* @last-height v-align))
203 (ref-set last-width *width*)
204 (ref-set last-height *height*))
205 ;; TODO: notify observers when size changes.
206 (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
207 (:mouse-pressed e
208 (dosync
209 (ref-set fix-x (:x-on-screen e))
210 (ref-set fix-y (:y-on-screen e)))
211 (when *target*
212 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
213 (:mouse-released e
214 (when *target*
215 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
216 (:mouse-dragged e
217 (dosync
218 (alter x + (- @fix-x (:x-on-screen e)))
219 (alter y + (- @fix-y (:y-on-screen e)))
220 (ref-set fix-x (:x-on-screen e))
221 (ref-set fix-y (:y-on-screen e)))
222 (update layer))))
223 (layer-size [layer]
224 (layer-size content)))
226 (defn viewport
227 "Creates scrollable viewport layer."
228 ([content] (viewport content :left :top))
229 ([content h-align v-align]
230 (Viewport. content h-align v-align
231 (ref 0) (ref 0) ; x y
232 (ref 0) (ref 0) ; fix-x fix-y
233 (ref 0) (ref 0)))) ; last-width last-height
235 (defn- viewport-visible-bounds
236 [viewport]
237 (dosync
238 [@(:x viewport) @(:y viewport)
239 @(:last-width viewport) @(:last-height viewport)]))
241 (defn viewport-miniature
242 "Creates miniature view of the viewport's contents."
243 [viewport width height]
244 (miniature
245 (decorate-layer (:content viewport) [_]
246 (repaint-on-update viewport)
247 (let [[x y w h] (viewport-visible-bounds viewport)]
248 (with-color :alt-back-color
249 (.fillRect *graphics* 0 0 *width* *height*))
250 (with-color :back-color
251 (.fillRect *graphics* x y w h))
252 (draw! (:content viewport))
253 (with-color :border-color
254 (.drawRect *graphics* x y w h))))
255 width height))
257 ;;
258 ;; Layer context decorators.
259 ;;
261 (defmacro handler [layer & handlers]
262 "Decorate layer to handle events."
263 `(let [layer# ~layer]
264 (decorate-layer layer# [t#]
265 (with-handlers t#
266 (render! layer#)
267 ~@handlers))))
269 (defn theme [layer & map-or-keyvals]
270 (let [theme (if (== (count map-or-keyvals) 1)
271 map-or-keyvals
272 (apply array-map map-or-keyvals))]
273 (reify
274 Layer
275 (render! [t]
276 (with-theme theme
277 (render! layer)))
278 (layer-size [t]
279 (with-theme theme
280 (layer-size layer)))
281 Anchored
282 (anchor [t xa ya]
283 (with-theme theme
284 (anchor layer xa ya))))))