Mercurial > hg > indyvon

view src/indyvon/core.clj @ 15:87bd822aa815

find changesets by author, revision, files, or words in the commit message
Text layer.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 15 Jun 2010 06:31:11 +0400
parents 0a2fafca72d8
children 0fda22fc53d2
line source
1 ;;
2 ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6
7 (ns indyvon.core
8 (:import (java.awt Color Font)
9 (java.awt.font FontRenderContext TextLayout)))
10
11 (defprotocol Layer
12 (render! [this context graphics])
13 (size [this context])
14 (anchor [this context]))
15
16 (defrecord Theme [fore-color back-color border-color font])
17
18 (defn default-theme []
19 (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
20
21 (defrecord LayerContext
22 [layer parent x y width height update-fn dispatcher font-context theme])
23
24 (defn default-context []
25 (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
26
27 (defn- spec-map
28 ([specs]
29 (spec-map {} specs))
30 ([mm specs]
31 (if-let [form (first specs)]
32 (recur (conj mm [(first form) (next form)])
33 (next specs))
34 mm)))
35
36 (defn- merge-specs [s1 s2]
37 (for [spec (spec-map (spec-map s1) s2)]
38 (cons (first spec) (second spec))))
39
40 (defmacro reify-layer [& specs]
41 `(reify Layer ~@(merge-specs
42 '((size [_ _] [0 0])
43 (anchor [_ _] [0 0]))
44 specs)))
45
46 (defn- make-graphics [graphics x y w h clip]
47 (if clip
48 (.create graphics x y w h)
49 (doto (.create graphics)
50 (.translate x y))))
51
52 (defn- apply-theme [graphics theme]
53 (doto graphics
54 (.setColor (:fore-color theme))
55 (.setFont (:font theme))))
56
57 (defn draw!
58 "Render layer in a new graphics context."
59 ([context layer graphics]
60 (draw! context layer graphics
61 0 0 (:width context) (:height context)))
62 ([context layer graphics x y]
63 (draw! context layer graphics x y true))
64 ([context layer graphics x y clip]
65 (let [s (size layer context)]
66 (draw! context layer graphics
67 x y (s 0) (s 1) clip)))
68 ([context layer graphics x y w h]
69 (draw! context layer graphics
70 x y w h true))
71 ([context layer graphics x y w h clip]
72 (let [graphics (make-graphics graphics x y w h clip)
73 graphics (apply-theme graphics (:theme context))]
74 (try
75 (render! layer
76 (assoc context
77 :layer layer
78 :parent context
79 :x (+ (:x context) x)
80 :y (+ (:y context) y)
81 :width w
82 :height h)
83 graphics)
84 (finally
85 (.dispose graphics))))))
86
87 (defmacro decorate-layer [layer & specs]
88 `(let [layer# ~layer]
89 (reify Layer ~@(merge-specs
90 `((~'render! [l# c# g#] (draw! c# layer# g#))
91 (~'size [l# c#] (size layer# c#))
92 (~'anchor [l# c#] (anchor layer# c#)))
93 specs))))
94
95 ;;
96 ;; Layer implementations.
97 ;;
98
99 (defn border-layer
100 "Decorate layer with a border."
101 ([content]
102 (border-layer content 1))
103 ([content width]
104 (border-layer content width 0))
105 ([content width gap]
106 (let [offset (+ width gap)]
107 (reify-layer
108 (render! [l c g]
109 (let [w (:width c)
110 h (:height c)]
111 (.setColor g (-> c :theme :border-color))
112 (doseq [i (range 0 width)]
113 (.drawRect g i i (- w 1 i i) (- h 1 i i)))
114 (draw! c content g offset offset (- w offset offset)
115 (- h offset offset))))
116 (size [l c]
117 (let [s (size content c)]
118 [(+ (s 0) offset offset)
119 (+ (s 1) offset offset)]))
120 (anchor [l c]
121 (let [a (anchor content c)]
122 [(+ (a 0) offset)
123 (+ (a 1) offset)]))))))
124
125 (defn- re-split [re s]
126 (seq (.split re s)))
127
128 (defn- text-size [lines font font-context]
129 (loop [lines lines
130 width 0
131 height 0]
132 (if-let [line (first lines)]
133 (let [layout (TextLayout. line font font-context)]
134 (recur (next lines)
135 (max width (.getAdvance layout))
136 (+ height
137 (.getAscent layout)
138 (.getDescent layout)
139 (.getLeading layout))))
140 [width height])))
141
142 (defn text-layer
143 "Creates a layer to display multiline text."
144 ([text]
145 (text-layer text :left :top))
146 ([text h-align v-align]
147 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
148 (reify-layer
149 (render! [l c g]
150 (let [w (:width c)
151 h (:height c)
152 font (.getFont g)
153 font-context (:font-context c)
154 y (case v-align
155 :top 0
156 :center (/ (- h ((text-size
157 lines font font-context) 1))
158 2)
159 :bottom (- h ((text-size
160 lines font font-context) 1)))]
161 (loop [lines lines, y y]
162 (when-first [line lines]
163 (let [layout (TextLayout. line font font-context)
164 ascent (.getAscent layout)
165 lh (+ ascent (.getDescent layout) (.getLeading layout))
166 x (case h-align
167 :left 0
168 :center (/ (- w (.getAdvance layout)) 2)
169 :right (- w (.getAdvance layout)))]
170 (.draw layout g x (+ y ascent))
171 (recur (next lines) (+ y lh)))))))
172 (size [l c]
173 (text-size lines (-> c :theme :font) (:font-context c)))))))