Mercurial > hg > indyvon

view src/indyvon/core.clj @ 14:0a2fafca72d8

find changesets by author, revision, files, or words in the commit message
Border layer decorator. Font render context. Manual identation for reify and proxy.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 15 Jun 2010 04:35:57 +0400
parents c6009a144727
children 87bd822aa815
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
10 (defprotocol Layer
11 (render! [this context graphics])
12 (size [this context])
13 (anchor [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- spec-map
27 ([specs]
28 (spec-map {} specs))
29 ([mm specs]
30 (if-let [form (first specs)]
31 (recur (conj mm [(first form) (next form)])
32 (next specs))
33 mm)))
34
35 (defn- merge-specs [s1 s2]
36 (for [spec (spec-map (spec-map s1) s2)]
37 (cons (first spec) (second spec))))
38
39 (defmacro reify-layer [& specs]
40 `(reify Layer ~@(merge-specs
41 '((size [_ _] [0 0])
42 (anchor [_ _] [0 0]))
43 specs)))
44
45 (defn- make-graphics [graphics x y w h clip]
46 (if clip
47 (.create graphics x y w h)
48 (doto (.create graphics)
49 (.translate x y))))
50
51 (defn- apply-theme [graphics theme]
52 (doto graphics
53 (.setColor (:fore-color theme))
54 (.setFont (:font theme))))
55
56 (defn draw!
57 "Render layer in a new graphics context."
58 ([context layer graphics]
59 (draw! context layer graphics
60 0 0 (:width context) (:height context)))
61 ([context layer graphics x y]
62 (draw! context layer graphics x y true))
63 ([context layer graphics x y clip]
64 (let [s (size layer context)]
65 (draw! context layer graphics
66 x y (s 0) (s 1) clip)))
67 ([context layer graphics x y w h]
68 (draw! context layer graphics
69 x y w h true))
70 ([context layer graphics x y w h clip]
71 (let [graphics (make-graphics graphics x y w h clip)]
72 (try
73 (render! layer
74 (assoc context
75 :layer layer
76 :parent context
77 :x (+ (:x context) x)
78 :y (+ (:y context) y)
79 :width w
80 :height h)
81 graphics)
82 (finally
83 (.dispose graphics))))))
84
85 (defmacro decorate-layer [layer & specs]
86 `(let [layer# ~layer]
87 (reify Layer ~@(merge-specs
88 `((~'render! [l# c# g#] (draw! c# layer# g#))
89 (~'size [l# c#] (size layer# c#))
90 (~'anchor [l# c#] (anchor layer# c#)))
91 specs))))
92
93 ;;
94 ;; Layer implementations.
95 ;;
96
97 (defn border-layer
98 "Decorate layer with a border."
99 ([content]
100 (border-layer content 1))
101 ([content width]
102 (border-layer content width 0))
103 ([content width gap]
104 (let [offset (+ width gap)]
105 (reify-layer
106 (render! [l c g]
107 (let [w (:width c)
108 h (:height c)]
109 (.setColor g (-> c :theme :border-color))
110 (doseq [i (range 0 width)]
111 (.drawRect g i i (- w 1 i i) (- h 1 i i)))
112 (draw! c content g offset offset (- w offset offset)
113 (- h offset offset))))
114 (size [l c]
115 (let [s (size content c)]
116 [(+ (s 0) offset offset)
117 (+ (s 1) offset offset)]))
118 (anchor [l c]
119 (let [a (anchor content c)]
120 [(+ (a 0) offset)
121 (+ (a 1) offset)]))))))
122
123 ;; (defn text-layer
124 ;; ([text]
125 ;; (text :left :top))
126 ;; ([text h-align v-align]
127 ;; (let [newline #"\\r\\n|\\n|\\r|\\u0085|\\u2028|\\u2029"]
128 ;; (reify-layer))))