Mercurial > hg > indyvon

view src/kryshen/indyvon/layers.clj @ 43:7d67064f0880

find changesets by author, revision, files, or words in the commit message
More layers.
author Mikhail Kryshen <mikhail@kryshen.net>
date Mon, 12 Jul 2010 03:52:21 +0400
parents d3e3c43df1cd
children 064b21604f74
line source
1 ;;
2 ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6
7 (ns kryshen.indyvon.layers
8 (:use kryshen.indyvon.core)
9 (:import (kryshen.indyvon.core Size Location)
10 (java.awt Font Cursor)
11 (java.awt.font FontRenderContext TextLayout)))
12
13 ;; Define as macro to avoid unnecessary calculation of inner and outer
14 ;; sizes in the first case.
15 (defmacro align-xy [inner outer align first center last]
16 `(case ~align
17 ~first 0
18 ~center (/ (- ~outer ~inner) 2)
19 ~last (- ~outer ~inner)))
20
21 (defmacro align-x [inner outer align]
22 `(align-xy ~inner ~outer ~align :left :center :right))
23
24 (defmacro align-y [inner outer align]
25 `(align-xy ~inner ~outer ~align :top :center :bottom))
26
27 (defmacro decorate-layer [layer & render-tail]
28 `(reify
29 Layer
30 (render! ~@render-tail)
31 (layer-size [t#] (layer-size ~layer))
32 Anchored
33 (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
34
35 (defn padding
36 ([content pad]
37 (padding content pad pad pad pad))
38 ([content top left bottom right]
39 (if (== 0 top left bottom right)
40 content
41 (reify
42 Layer
43 (render! [l]
44 (draw! content
45 left top
46 (- (:width *bounds*) left right)
47 (- (:height *bounds*) top bottom)))
48 (layer-size [l]
49 (let [s (layer-size content)]
50 (Size. (+ (:width s) left right)
51 (+ (:height s) top bottom))))))))
52
53 (defn border
54 "Decorate layer with a border."
55 ([content]
56 (border content 1))
57 ([content width]
58 (border content width 0))
59 ([content width gap]
60 (let [layer (padding content (+ width gap))]
61 (decorate-layer layer [_]
62 (let [w (:width *bounds*)
63 h (:height *bounds*)]
64 (with-color (:border-color *theme*)
65 (doseq [i (range 0 width)]
66 (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))))
67 (render! layer))))))
68
69 (defn panel
70 "Opaque layer using theme's alt-back-color."
71 ([content]
72 (panel content 0))
73 ([content gap]
74 (let [layer (padding content gap)]
75 (decorate-layer layer [_]
76 (with-color (:alt-back-color *theme*)
77 (.fillRect *graphics* 0 0
78 (:width *bounds*) (:height *bounds*)))
79 (render! layer)))))
80
81 (defn- re-split [^java.util.regex.Pattern re s]
82 (seq (.split re s)))
83
84 (defn- layout-text [lines ^Font font ^FontRenderContext font-context]
85 (map #(TextLayout. ^String % font font-context) lines))
86
87 (defn- text-width [layouts]
88 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
89
90 (defn- text-height [layouts]
91 (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
92 (.getDescent tl)
93 (.getLeading tl)))
94 0 layouts))
95
96 (defn text-layer
97 "Creates a layer to display multiline text."
98 ([text]
99 (text-layer text :left :top))
100 ([text h-align v-align]
101 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
102 (reify Layer
103 (render! [layer]
104 (let [w (:width *bounds*)
105 h (:height *bounds*)
106 font (.getFont *graphics*)
107 layouts (layout-text lines font *font-context*)
108 y (align-y (text-height layouts) h v-align)]
109 (loop [layouts layouts, y y]
110 (when-first [^TextLayout layout layouts]
111 (let [ascent (.getAscent layout)
112 lh (+ ascent (.getDescent layout) (.getLeading layout))
113 x (align-x (.getAdvance layout) w h-align)]
114 (.draw layout *graphics* x (+ y ascent))
115 (recur (next layouts) (+ y lh)))))))
116 (layer-size [layer]
117 (let [layouts (layout-text lines (:font *theme*) *font-context*)
118 width (text-width layouts)
119 height (text-height layouts)]
120 (Size. width height)))))))
121
122 (defn viewport
123 "Creates scrollable viewport layer."
124 ([content] (viewport content :left :top))
125 ([content h-align v-align]
126 (let [x (ref 0)
127 y (ref 0)
128 fix-x (ref 0)
129 fix-y (ref 0)
130 last-width (ref 0)
131 last-height (ref 0)]
132 (reify
133 Layer
134 (render! [layer]
135 (with-handlers layer
136 (let [anchor (anchor content h-align v-align)
137 width (:width *bounds*)
138 height (:height *bounds*)]
139 (dosync
140 (alter x + (align-x width @last-width h-align))
141 (alter y + (align-y height @last-height v-align))
142 (ref-set last-width width)
143 (ref-set last-height height))
144 (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
145 (:mouse-pressed e
146 (dosync
147 (ref-set fix-x (:x-on-screen e))
148 (ref-set fix-y (:y-on-screen e)))
149 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
150 (:mouse-released e
151 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
152 (:mouse-dragged e
153 (dosync
154 (alter x + (- @fix-x (:x-on-screen e)))
155 (alter y + (- @fix-y (:y-on-screen e)))
156 (ref-set fix-x (:x-on-screen e))
157 (ref-set fix-y (:y-on-screen e)))
158 (*update*))))
159 (layer-size [layer] (layer-size content))))))
160
161 ;;
162 ;; Layer context decorators.
163 ;;
164
165 (defmacro handler [layer & handlers]
166 `(decorate-layer ~layer [t#]
167 (with-handlers t#
168 (render! ~layer)
169 ~@handlers)))
170
171 (defn theme [layer & map-or-keyvals]
172 (let [theme (if (== (count map-or-keyvals) 1)
173 map-or-keyvals
174 (apply array-map map-or-keyvals))]
175 (reify
176 Layer
177 (render! [t]
178 (with-theme* theme render! layer))
179 (layer-size [t]
180 (with-theme* theme layer-size layer))
181 Anchored
182 (anchor [t xa ya]
183 (with-theme* theme anchor layer xa ya)))))