Mercurial > hg > indyvon

view src/indyvon/core.clj @ 16:0fda22fc53d2

find changesets by author, revision, files, or words in the commit message
Remove anchor from Layer protocol. More function text layout calculation.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 17 Jun 2010 05:20:37 +0400
parents 87bd822aa815
children 740b9d2bbc45
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
15 (defrecord Theme [fore-color back-color border-color font])
16
17 (defn default-theme []
18 (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
19
20 (defrecord LayerContext
21 [layer parent x y width height update-fn dispatcher font-context theme])
22
23 (defn default-context []
24 (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
25
26 (defn- make-graphics [graphics x y w h clip]
27 (if clip
28 (.create graphics x y w h)
29 (doto (.create graphics)
30 (.translate x y))))
31
32 (defn- apply-theme [graphics theme]
33 (doto graphics
34 (.setColor (:fore-color theme))
35 (.setFont (:font theme))))
36
37 (defn draw!
38 "Render layer in a new graphics context."
39 ([context layer graphics]
40 (draw! context layer graphics
41 0 0 (:width context) (:height context)))
42 ([context layer graphics x y]
43 (draw! context layer graphics x y true))
44 ([context layer graphics x y clip]
45 (let [s (size layer context)]
46 (draw! context layer graphics
47 x y (s 0) (s 1) clip)))
48 ([context layer graphics x y w h]
49 (draw! context layer graphics
50 x y w h true))
51 ([context layer graphics x y w h clip]
52 (let [graphics (make-graphics graphics x y w h clip)
53 graphics (apply-theme graphics (:theme context))]
54 (try
55 (render! layer
56 (assoc context
57 :layer layer
58 :parent context
59 :x (+ (:x context) x)
60 :y (+ (:y context) y)
61 :width w
62 :height h)
63 graphics)
64 (finally
65 (.dispose graphics))))))
66
67 ;;
68 ;; Layer implementations.
69 ;;
70
71 (defn border-layer
72 "Decorate layer with a border."
73 ([content]
74 (border-layer content 1))
75 ([content width]
76 (border-layer content width 0))
77 ([content width gap]
78 (let [offset (+ width gap)]
79 (reify Layer
80 (render! [l c g]
81 (let [w (:width c)
82 h (:height c)]
83 (.setColor g (-> c :theme :border-color))
84 (doseq [i (range 0 width)]
85 (.drawRect g i i (- w 1 i i) (- h 1 i i)))
86 (draw! c content g offset offset (- w offset offset)
87 (- h offset offset))))
88 (size [l c]
89 (let [s (size content c)]
90 [(+ (s 0) offset offset)
91 (+ (s 1) offset offset)]))))))
92
93 (defn- re-split [re s]
94 (seq (.split re s)))
95
96 (defn- layout-text [lines font font-context]
97 (map #(TextLayout. % font font-context) lines))
98
99 (defn- text-width [layouts]
100 (reduce #(max %1 (.getAdvance %2)) 0 layouts))
101
102 (defn- text-height [layouts]
103 (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
104 0 layouts))
105
106 (defn text-layer
107 "Creates a layer to display multiline text."
108 ([text]
109 (text-layer text :left :top))
110 ([text h-align v-align]
111 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
112 (reify Layer
113 (render! [l c g]
114 (let [w (:width c)
115 h (:height c)
116 font (.getFont g)
117 font-context (:font-context c)
118 layouts (layout-text lines font font-context)
119 y (case v-align
120 :top 0
121 :center (/ (- h (text-height layouts)) 2)
122 :bottom (- h (text-height layouts)))]
123 (loop [layouts layouts, y y]
124 (when-first [layout layouts]
125 (let [ascent (.getAscent layout)
126 lh (+ ascent (.getDescent layout) (.getLeading layout))
127 x (case h-align
128 :left 0
129 :center (/ (- w (.getAdvance layout)) 2)
130 :right (- w (.getAdvance layout)))]
131 (.draw layout g x (+ y ascent))
132 (recur (next layouts) (+ y lh)))))))
133 (size [l c]
134 (let [layouts (layout-text lines
135 (-> c :theme :font)
136 (:font-context c))
137 width (text-width layouts)
138 height (text-height layouts)]
139 [width height]))))))