Mercurial > hg > indyvon

view src/indyvon/layers.clj @ 33:439f6ecee119

find changesets by author, revision, files, or words in the commit message
Include graphics into context. Event dispatcher respects clipping.
author Mikhail Kryshen <mikhail@kryshen.net>
date Wed, 07 Jul 2010 07:17:08 +0400
parents 0b3757d263db
children 6975b9a71eec
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.layers
8 (:use indyvon.core)
9 (:import (indyvon.core Size Location)
10 (java.awt 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 (defn border-layer
28 "Decorate layer with a border."
29 ([content]
30 (border-layer content 1))
31 ([content width]
32 (border-layer content width 0))
33 ([content width gap]
34 (let [offset (+ width gap)]
35 (reify Layer
36 (render! [l c]
37 (let [w (:width c)
38 h (:height c)]
39 (.setColor (graphics c) (-> c :theme :border-color))
40 (doseq [i (range 0 width)]
41 (.drawRect (graphics c) i i (- w 1 i i) (- h 1 i i)))
42 (draw! content c offset offset (- w offset offset)
43 (- h offset offset))))
44 (size [l c]
45 (let [s (size content c)]
46 (Size. (+ (:width s) offset offset)
47 (+ (:height s) offset offset))))))))
48
49 (defn- re-split [re s]
50 (seq (.split re s)))
51
52 (defn- layout-text [lines font font-context]
53 (map #(TextLayout. % font font-context) lines))
54
55 (defn- text-width [layouts]
56 (reduce #(max %1 (.getAdvance %2)) 0 layouts))
57
58 (defn- text-height [layouts]
59 (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
60 0 layouts))
61
62 (defn text-layer
63 "Creates a layer to display multiline text."
64 ([text]
65 (text-layer text :left :top))
66 ([text h-align v-align]
67 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
68 (reify Layer
69 (render! [l c]
70 (let [w (:width c)
71 h (:height c)
72 font (.getFont (graphics c))
73 font-context (:font-context c)
74 layouts (layout-text lines font font-context)
75 y (align-y (text-height layouts) h v-align)]
76 (loop [layouts layouts, y y]
77 (when-first [layout layouts]
78 (let [ascent (.getAscent layout)
79 lh (+ ascent (.getDescent layout) (.getLeading layout))
80 x (align-x (.getAdvance layout) w h-align)]
81 (.draw layout (graphics c) x (+ y ascent))
82 (recur (next layouts) (+ y lh)))))))
83 (size [l c]
84 (let [layouts (layout-text lines
85 (-> c :theme :font)
86 (:font-context c))
87 width (text-width layouts)
88 height (text-height layouts)]
89 (Size. width height)))))))
90
91 (defn viewport
92 "Creates scrollable viewport layer."
93 ([content] (viewport content :left :top))
94 ([content h-align v-align]
95 (let [x (ref 0)
96 y (ref 0)
97 fix-x (ref 0)
98 fix-y (ref 0)
99 last-width (ref 0)
100 last-height (ref 0)]
101 (reify
102 Layer
103 (render! [layer c]
104 (let-handlers layer [c]
105 (let [anchor (anchor content c h-align v-align)
106 width (:width c)
107 height (:height c)]
108 (dosync
109 (alter x + (align-x width @last-width h-align))
110 (alter y + (align-y height @last-height v-align))
111 (ref-set last-width width)
112 (ref-set last-height height))
113 (draw! content c
114 (- 0 @x (:x anchor))
115 (- 0 @y (:y anchor))))
116 (:mouse-pressed e
117 (dosync
118 (ref-set fix-x (:x-on-screen e))
119 (ref-set fix-y (:y-on-screen e)))
120 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
121 (:mouse-released e
122 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
123 (:mouse-dragged e
124 (dosync
125 (alter x + (- @fix-x (:x-on-screen e)))
126 (alter y + (- @fix-y (:y-on-screen e)))
127 (ref-set fix-x (:x-on-screen e))
128 (ref-set fix-y (:y-on-screen e)))
129 (update c))))
130 (size [layer c] (size content c))))))