Mercurial > hg > indyvon

view src/kryshen/indyvon/layers.clj @ 36:5413b188d112

find changesets by author, revision, files, or words in the commit message
Rename namespaces: indyvon to kryshen.indyvon.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 08 Jul 2010 07:03:24 +0400
parents
children d2fb660ca49f
line source
1 ;;
2 ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6
7 (ns kryshen.indyvon.layers
8 (:use kryshen.indyvon.core)
9 (:import (kryshen.indyvon.core Size Location)
10 (java.awt Font 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 opts]
37 (let [w (:width *bounds*)
38 h (:height *bounds*)]
39 (.setColor *graphics* (:border-color *theme*))
40 (doseq [i (range 0 width)]
41 (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i)))
42 (apply draw! content
43 [offset offset (- w offset offset) (- h offset offset)]
44 opts)))
45 (size [l opts]
46 (let [s (size content opts)]
47 (Size. (+ (:width s) offset offset)
48 (+ (:height s) offset offset))))))))
49
50 (defn- re-split [^java.util.regex.Pattern re s]
51 (seq (.split re s)))
52
53 (defn- layout-text [lines ^Font font ^FontRenderContext font-context]
54 (map #(TextLayout. ^String % font font-context) lines))
55
56 (defn- text-width [layouts]
57 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
58
59 (defn- text-height [layouts]
60 (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
61 (.getDescent tl)
62 (.getLeading tl)))
63 0 layouts))
64
65 (defn text-layer
66 "Creates a layer to display multiline text."
67 ([text]
68 (text-layer text :left :top))
69 ([text h-align v-align]
70 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
71 (reify Layer
72 (render! [layer opts]
73 (let [w (:width *bounds*)
74 h (:height *bounds*)
75 font (.getFont *graphics*)
76 layouts (layout-text lines font *font-context*)
77 y (align-y (text-height layouts) h v-align)]
78 (loop [layouts layouts, y y]
79 (when-first [^TextLayout layout layouts]
80 (let [ascent (.getAscent layout)
81 lh (+ ascent (.getDescent layout) (.getLeading layout))
82 x (align-x (.getAdvance layout) w h-align)]
83 (.draw layout *graphics* x (+ y ascent))
84 (recur (next layouts) (+ y lh)))))))
85 (size [layer opts]
86 (let [layouts (layout-text lines (:font *theme*) *font-context*)
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 opts]
104 (with-handlers layer
105 (let [anchor (anchor content h-align v-align opts)
106 width (:width *bounds*)
107 height (:height *bounds*)]
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 (apply draw! content
114 [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts))
115 (:mouse-pressed e
116 (dosync
117 (ref-set fix-x (:x-on-screen e))
118 (ref-set fix-y (:y-on-screen e)))
119 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
120 (:mouse-released e
121 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
122 (:mouse-dragged e
123 (dosync
124 (alter x + (- @fix-x (:x-on-screen e)))
125 (alter y + (- @fix-y (:y-on-screen e)))
126 (ref-set fix-x (:x-on-screen e))
127 (ref-set fix-y (:y-on-screen e)))
128 (*update*))))
129 (size [layer opts] (size content opts))))))