Mercurial > hg > indyvon
view src/indyvon/layers.clj @ 26:1237f7555029
Rearranged namespaces.
Mouse events represented by a record.
Added alignment args to anchor.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Mon, 21 Jun 2010 04:00:45 +0400 |
| parents | |
| children | 4cb70c5a6e0d |
line source
1 ;;
2 ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
7 (ns indyvon.layers
8 (:use indyvon.core)
9 (:import (java.awt Cursor)
10 (java.awt.font FontRenderContext TextLayout)))
12 ;; Define as macro to avoid unnecessary calculation of inner and outer
13 ;; sizes in the first case.
14 (defmacro align-xy [inner outer align first center last]
15 `(case ~align
16 ~first 0
17 ~center (/ (- ~outer ~inner) 2)
18 ~last (- ~outer ~inner)))
20 (defmacro align-x [inner outer align]
21 `(align-xy ~inner ~outer ~align :left :center :right))
23 (defmacro align-y [inner outer align]
24 `(align-xy ~inner ~outer ~align :top :center :bottom))
26 (defn border-layer
27 "Decorate layer with a border."
28 ([content]
29 (border-layer content 1))
30 ([content width]
31 (border-layer content width 0))
32 ([content width gap]
33 (let [offset (+ width gap)]
34 (reify Layer
35 (render! [l c g]
36 (let [w (:width c)
37 h (:height c)]
38 (.setColor g (-> c :theme :border-color))
39 (doseq [i (range 0 width)]
40 (.drawRect g i i (- w 1 i i) (- h 1 i i)))
41 (draw! content c g offset offset (- w offset offset)
42 (- h offset offset))))
43 (size [l c]
44 (let [s (size content c)]
45 [(+ (s 0) offset offset)
46 (+ (s 1) offset offset)]))))))
48 (defn- re-split [re s]
49 (seq (.split re s)))
51 (defn- layout-text [lines font font-context]
52 (map #(TextLayout. % font font-context) lines))
54 (defn- text-width [layouts]
55 (reduce #(max %1 (.getAdvance %2)) 0 layouts))
57 (defn- text-height [layouts]
58 (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
59 0 layouts))
61 (defn text-layer
62 "Creates a layer to display multiline text."
63 ([text]
64 (text-layer text :left :top))
65 ([text h-align v-align]
66 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
67 (reify Layer
68 (render! [l c g]
69 (let [w (:width c)
70 h (:height c)
71 font (.getFont g)
72 font-context (:font-context c)
73 layouts (layout-text lines font font-context)
74 y (align-y (text-height layouts) h v-align)]
75 (loop [layouts layouts, y y]
76 (when-first [layout layouts]
77 (let [ascent (.getAscent layout)
78 lh (+ ascent (.getDescent layout) (.getLeading layout))
79 x (align-x (.getAdvance layout) w h-align)]
80 (.draw layout g x (+ y ascent))
81 (recur (next layouts) (+ y lh)))))))
82 (size [l c]
83 (let [layouts (layout-text lines
84 (-> c :theme :font)
85 (:font-context c))
86 width (text-width layouts)
87 height (text-height layouts)]
88 [width height]))))))
90 (defn viewport
91 "Creates scrollable viewport layer."
92 ([content] (viewport content :left :top))
93 ([content h-align v-align]
94 (let [x (ref 0)
95 y (ref 0)
96 fix-x (ref 0)
97 fix-y (ref 0)
98 last-width (ref 0)
99 last-height (ref 0)]
100 (reify
101 Layer
102 (render! [layer c g]
103 (let [anchor (anchor content c h-align v-align)
104 width (:width c)
105 height (:height c)]
106 (dosync
107 (alter x + (align-x width @last-width h-align))
108 (alter y + (align-y height @last-height v-align))
109 (ref-set last-width width)
110 (ref-set last-height height))
111 (draw! content c g
112 (- 0 @x (anchor 0))
113 (- 0 @y (anchor 1)))))
114 (size [layer c] (size content c))
115 MouseHandler
116 (handle-mouse [layer c e]
117 (case (:id e)
118 :mouse-pressed
119 (do
120 (dosync
121 (ref-set fix-x (:x-on-screen e))
122 (ref-set fix-y (:y-on-screen e)))
123 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
124 :mouse-released
125 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))
126 :mouse-dragged
127 (do
128 (dosync
129 (alter x + (- @fix-x (:x-on-screen e)))
130 (alter y + (- @fix-y (:y-on-screen e)))
131 (ref-set fix-x (:x-on-screen e))
132 (ref-set fix-y (:y-on-screen e)))
133 (update c))
134 nil))))))