Mercurial > hg > indyvon
view src/net/kryshen/indyvon/layers.clj @ 49:ca728127d605
Use conventional namespace/package name.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Thu, 29 Jul 2010 01:08:34 +0400 |
| parents | |
| children | 409b1b16053d |
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 (:use
9 net.kryshen.indyvon.core)
10 (:import
11 (net.kryshen.indyvon.core Size Location)
12 (java.lang.ref SoftReference)
13 (java.awt Font Cursor Image Toolkit)
14 (java.awt.image ImageObserver)
15 (java.awt.font FontRenderContext TextLayout)))
17 ;; Define as macro to avoid unnecessary calculation of inner and outer
18 ;; sizes in the first case.
19 (defmacro align-xy [inner outer align first center last]
20 `(case ~align
21 ~first 0
22 ~center (/ (- ~outer ~inner) 2)
23 ~last (- ~outer ~inner)))
25 (defmacro align-x [inner outer align]
26 `(align-xy ~inner ~outer ~align :left :center :right))
28 (defmacro align-y [inner outer align]
29 `(align-xy ~inner ~outer ~align :top :center :bottom))
31 (defmacro decorate-layer [layer & render-tail]
32 `(reify
33 Layer
34 (render! ~@render-tail)
35 (layer-size [t#] (layer-size ~layer))
36 Anchored
37 (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
39 (defn padding
40 ([content pad]
41 (padding content pad pad pad pad))
42 ([content top left bottom right]
43 (if (== 0 top left bottom right)
44 content
45 (reify
46 Layer
47 (render! [l]
48 (draw! content
49 left top
50 (- (:width *bounds*) left right)
51 (- (:height *bounds*) top bottom)))
52 (layer-size [l]
53 (let [s (layer-size content)]
54 (Size. (+ (:width s) left right)
55 (+ (:height s) top bottom))))))))
57 (defn border
58 "Decorate layer with a border."
59 ([content]
60 (border content 1))
61 ([content width]
62 (border content width 0))
63 ([content width gap]
64 (let [layer (padding content (+ width gap))]
65 (decorate-layer layer [_]
66 (let [w (:width *bounds*)
67 h (:height *bounds*)]
68 (with-color (:border-color *theme*)
69 (doseq [i (range 0 width)]
70 (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))))
71 (render! layer))))))
73 (defn panel
74 "Opaque layer using theme's alt-back-color."
75 ([content]
76 (panel content 0))
77 ([content gap]
78 (let [layer (padding content gap)]
79 (decorate-layer layer [_]
80 (with-color (:alt-back-color *theme*)
81 (.fillRect *graphics* 0 0
82 (:width *bounds*) (:height *bounds*)))
83 (render! layer)))))
85 (defn- re-split [^java.util.regex.Pattern re s]
86 (seq (.split re s)))
88 (def text-layout-cache (atom {}))
90 (defn- get-text-layout
91 [^String line ^Font font ^FontRenderContext font-context]
92 (let [key [line font font-context]]
93 (or (if-let [^SoftReference softref (@text-layout-cache key)]
94 (.get softref)
95 (do (swap! text-layout-cache dissoc key)
96 false))
97 (let [layout (TextLayout. line font font-context)]
98 ;;(println "text-layout-cache miss" line)
99 (swap! text-layout-cache assoc key (SoftReference. layout))
100 layout))))
102 (defn- layout-text
103 [lines ^Font font ^FontRenderContext font-context]
104 (map #(get-text-layout % font font-context) lines))
105 ;;(map #(TextLayout. ^String % font font-context) lines))
107 (defn- text-width [layouts]
108 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
110 (defn- text-height [layouts]
111 (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
112 (.getDescent tl)
113 (.getLeading tl)))
114 0 layouts))
116 (defn text-layer
117 "Creates a layer to display multiline text."
118 ([text]
119 (text-layer text :left :top))
120 ([text h-align v-align]
121 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
122 (reify Layer
123 (render! [layer]
124 (let [w (:width *bounds*)
125 h (:height *bounds*)
126 font (.getFont *graphics*)
127 layouts (layout-text lines font *font-context*)
128 y (align-y (text-height layouts) h v-align)]
129 (loop [layouts layouts, y y]
130 (when-first [^TextLayout layout layouts]
131 (let [ascent (.getAscent layout)
132 lh (+ ascent (.getDescent layout) (.getLeading layout))
133 x (align-x (.getAdvance layout) w h-align)]
134 (.draw layout *graphics* x (+ y ascent))
135 (recur (next layouts) (+ y lh)))))))
136 (layer-size [layer]
137 (let [layouts (layout-text lines (:font *theme*) *font-context*)
138 width (text-width layouts)
139 height (text-height layouts)]
140 (Size. width height)))))))
142 (defn- image-observer [update-fn]
143 (reify
144 ImageObserver
145 (imageUpdate [this img infoflags x y width height]
146 (update-fn)
147 (zero? (bit-and infoflags
148 (bit-or ImageObserver/ALLBITS
149 ImageObserver/ABORT))))))
151 (defn image-layer
152 [image-or-uri]
153 (let [^Image image (if (isa? image-or-uri Image)
154 image-or-uri
155 (.getImage (Toolkit/getDefaultToolkit)
156 ^java.net.URL image-or-uri))]
157 (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
158 (reify
159 Layer
160 (render! [layer]
161 (.drawImage *graphics* image 0 0
162 ^ImageObserver (image-observer *update*)))
163 (layer-size [layer]
164 (let [observer (image-observer *update*)
165 width (.getWidth image observer)
166 height (.getHeight image observer)
167 width (if (pos? width) width 1)
168 height (if (pos? height) height 1)]
169 (Size. width height))))))
171 (defn viewport
172 "Creates scrollable viewport layer."
173 ([content] (viewport content :left :top))
174 ([content h-align v-align]
175 (let [x (ref 0)
176 y (ref 0)
177 fix-x (ref 0)
178 fix-y (ref 0)
179 last-width (ref 0)
180 last-height (ref 0)]
181 (reify
182 Layer
183 (render! [layer]
184 (with-handlers layer
185 (let [anchor (anchor content h-align v-align)
186 width (:width *bounds*)
187 height (:height *bounds*)]
188 (dosync
189 (alter x + (align-x width @last-width h-align))
190 (alter y + (align-y height @last-height v-align))
191 (ref-set last-width width)
192 (ref-set last-height height))
193 (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
194 (:mouse-pressed e
195 (dosync
196 (ref-set fix-x (:x-on-screen e))
197 (ref-set fix-y (:y-on-screen e)))
198 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
199 (:mouse-released e
200 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
201 (:mouse-dragged e
202 (dosync
203 (alter x + (- @fix-x (:x-on-screen e)))
204 (alter y + (- @fix-y (:y-on-screen e)))
205 (ref-set fix-x (:x-on-screen e))
206 (ref-set fix-y (:y-on-screen e)))
207 (*update*))))
208 (layer-size [layer] (layer-size content))))))
210 ;;
211 ;; Layer context decorators.
212 ;;
214 (defmacro handler [layer & handlers]
215 `(let [layer# ~layer]
216 (decorate-layer layer# [t#]
217 (with-handlers t#
218 (render! layer#)
219 ~@handlers))))
221 (defn theme [layer & map-or-keyvals]
222 (let [theme (if (== (count map-or-keyvals) 1)
223 map-or-keyvals
224 (apply array-map map-or-keyvals))]
225 (reify
226 Layer
227 (render! [t]
228 (with-theme theme
229 (render! layer)))
230 (layer-size [t]
231 (with-theme theme
232 (layer-size layer)))
233 Anchored
234 (anchor [t xa ya]
235 (with-theme theme
236 (anchor layer xa ya))))))