Mercurial > hg > indyvon

view src/kryshen/indyvon/layers.clj @ 37:d2fb660ca49f

find changesets by author, revision, files, or words in the commit message
Remove "opts" argument from Layer methods.
author Mikhail Kryshen <mikhail@kryshen.net>
date Fri, 09 Jul 2010 01:08:45 +0400
parents 5413b188d112
children 930c088e1367
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]
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 (draw! content
43 offset offset (- w offset offset) (- h offset offset))))
44 (size [l]
45 (let [s (size content)]
46 (Size. (+ (:width s) offset offset)
47 (+ (:height s) offset offset))))))))
48
49 (defn- re-split [^java.util.regex.Pattern re s]
50 (seq (.split re s)))
51
52 (defn- layout-text [lines ^Font font ^FontRenderContext font-context]
53 (map #(TextLayout. ^String % font font-context) lines))
54
55 (defn- text-width [layouts]
56 (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
57
58 (defn- text-height [layouts]
59 (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
60 (.getDescent tl)
61 (.getLeading tl)))
62 0 layouts))
63
64 (defn text-layer
65 "Creates a layer to display multiline text."
66 ([text]
67 (text-layer text :left :top))
68 ([text h-align v-align]
69 (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
70 (reify Layer
71 (render! [layer]
72 (let [w (:width *bounds*)
73 h (:height *bounds*)
74 font (.getFont *graphics*)
75 layouts (layout-text lines font *font-context*)
76 y (align-y (text-height layouts) h v-align)]
77 (loop [layouts layouts, y y]
78 (when-first [^TextLayout layout layouts]
79 (let [ascent (.getAscent layout)
80 lh (+ ascent (.getDescent layout) (.getLeading layout))
81 x (align-x (.getAdvance layout) w h-align)]
82 (.draw layout *graphics* x (+ y ascent))
83 (recur (next layouts) (+ y lh)))))))
84 (size [layer]
85 (let [layouts (layout-text lines (:font *theme*) *font-context*)
86 width (text-width layouts)
87 height (text-height layouts)]
88 (Size. width height)))))))
89
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]
103 (with-handlers layer
104 (let [anchor (anchor content h-align v-align)
105 width (:width *bounds*)
106 height (:height *bounds*)]
107 (dosync
108 (alter x + (align-x width @last-width h-align))
109 (alter y + (align-y height @last-height v-align))
110 (ref-set last-width width)
111 (ref-set last-height height))
112 (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
113 (:mouse-pressed e
114 (dosync
115 (ref-set fix-x (:x-on-screen e))
116 (ref-set fix-y (:y-on-screen e)))
117 (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
118 (:mouse-released e
119 (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
120 (:mouse-dragged e
121 (dosync
122 (alter x + (- @fix-x (:x-on-screen e)))
123 (alter y + (- @fix-y (:y-on-screen e)))
124 (ref-set fix-x (:x-on-screen e))
125 (ref-set fix-y (:y-on-screen e)))
126 (*update*))))
127 (size [layer] (size content))))))