1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
(ns jvui.paint
"Shapes and text, in the calls SDL is fast at.
The first version of this file batched everything into a packed
`SDL_Vertex` buffer and issued one `SDL_RenderGeometry` per frame, which is
how dvui's backends do it and is the right shape when the buffer can be
filled cheaply. It cannot be, here: `jolt.ffi/write-array` costs about
0.6 microseconds *per element*, so a few thousand vertices is six
milliseconds of frame time before SDL has drawn anything. A crossing, by
contrast, is 0.2 microseconds and a filled rectangle end to end is about
three.
So the unit is the call, not the vertex. A rectangle is one
`SDL_RenderFillRect`; text is one blit of a cached texture. Nothing here
accumulates and nothing needs flushing, which also means painter order is
simply call order and there is no batch to get wrong.
# Rounded corners without a tessellator
A rounded rectangle is three rectangles — a full-width band across the
middle and two inset bands at top and bottom — plus four blits from one
antialiased white disc uploaded at startup. The disc is white so a
colour-mod tints it, which is why one 48-pixel texture serves every corner
of every colour at every radius the UI ever asks for."
(:require [jvui.sdl :as sdl] [jvui.font :as font]))
(def ^:private DISC 48)
(def ^:private HALF (/ DISC 2))
(defn- disc-pixels
"An antialiased white disc in ARGB8888, sampled 3x3 per pixel.
Supersampled rather than computed from a distance field because it is done
once, at startup, and the edge is what the whole trick rests on."
[]
(let [px (int-array (* DISC DISC))
r (- HALF 0.5)]
(dotimes [y DISC]
(dotimes [x DISC]
(let [hits (reduce
+ (for [sy (range 3) sx (range 3)]
(let [dx (- (+ x (/ (+ sx 0.5) 3.0)) HALF)
dy (- (+ y (/ (+ sy 0.5) 3.0)) HALF)]
(if (<= (+ (* dx dx) (* dy dy)) (* r r)) 1 0))))
a (int (* 255 (/ hits 9.0)))]
(aset px (+ (* y DISC) x)
(unchecked-int (bit-or 0x00FFFFFF (bit-shift-left a 24)))))))
px))
(defn painter
"Drawing state for one window. `fonts` may be nil in a headless run."
[renderer fonts]
(let [disc (when renderer
(let [t (sdl/create-texture renderer sdl/PIXELFORMAT-ARGB8888
sdl/TEXTUREACCESS-STATIC DISC DISC)]
(sdl/update-texture! t (disc-pixels) DISC DISC)
(sdl/texture-blend-mode! t sdl/BLEND)
(sdl/texture-scale-mode! t sdl/SCALE-LINEAR)
t))]
(atom {:r renderer :fonts fonts :disc disc :clip nil :colour nil})))
(defn close! [p]
(when-let [d (:disc @p)] (sdl/destroy-texture! d))
(swap! p assoc :disc nil))
;; ------------------------------------------------------------------- state
(defn- colour!
"Set the draw colour, skipping the crossing when it is already set."
[p [r g b a]]
(when (not= [r g b a] (:colour @p))
(sdl/draw-color! (:r @p) r g b (or a 255))
(swap! p assoc :colour [r g b a])))
(defn set-clip!
[p rect]
(when (not= rect (:clip @p))
(sdl/clip! (:r @p) rect)
(swap! p assoc :clip rect)))
(defn flush!
"Nothing accumulates, so this is a no-op — kept because the frame loop reads
better with the intent spelled out, and because a future batching painter
would need it back."
[_p] nil)
;; ------------------------------------------------------------------ shapes
(defn plain-rect!
[p [x y w h] c]
(when (and (> w 0) (> h 0))
(colour! p c)
(sdl/fill-rect! (:r @p) [x y w h])))
(defn- corners!
"The four rounded corners of [x y w h] at radius `r`, blitted from the disc."
[p [x y w h] r [cr cg cb ca]]
(let [d (:disc @p)]
(when d
(sdl/texture-color-mod! d cr cg cb)
(sdl/texture-alpha-mod! d (or ca 255))
(let [rn (:r @p)]
(sdl/blit! rn d [0 0 HALF HALF] [x y r r])
(sdl/blit! rn d [HALF 0 HALF HALF] [(+ x w (- r)) y r r])
(sdl/blit! rn d [0 HALF HALF HALF] [x (+ y h (- r)) r r])
(sdl/blit! rn d [HALF HALF HALF HALF] [(+ x w (- r)) (+ y h (- r)) r r])))))
(defn round-rect!
[p [x y w h] c radius]
(let [r (max 0.0 (min (double radius) (/ w 2.0) (/ h 2.0)))]
(if (< r 1.0)
(plain-rect! p [x y w h] c)
(do (plain-rect! p [x (+ y r) w (- h (* 2 r))] c)
(plain-rect! p [(+ x r) y (- w (* 2 r)) r] c)
(plain-rect! p [(+ x r) (+ y h (- r)) (- w (* 2 r)) r] c)
(corners! p [x y w h] r c)))))
(defn rect!
"Fill `rect`, optionally rounded, optionally over a border.
The border is not a ring: it is the same rounded rectangle in the border
colour with the fill laid inside it, inset by the border width. One code
path serves a plain fill, a rounded fill and a bordered card, and nothing
here has to stroke a curve."
([p rect colour] (rect! p rect colour 0.0 nil 0.0))
([p rect colour radius] (rect! p rect colour radius nil 0.0))
([p [x y w h] colour radius border-colour border-width]
(when (and (> w 0) (> h 0))
(if (and border-colour (pos? border-width))
(let [bw (double border-width)]
(round-rect! p [x y w h] border-colour radius)
(when colour
(round-rect! p [(+ x bw) (+ y bw) (- w (* 2 bw)) (- h (* 2 bw))]
colour (max 0.0 (- radius bw)))))
(when colour (round-rect! p [x y w h] colour radius))))))
(defn frame!
"Blit a whole texture into `rect`, letterboxed to keep its shape.
Stretching to fill would be one line shorter and would make every face in
a call slightly wrong — a 16:9 camera in a square tile is the ordinary
case, not the exceptional one."
[p tex tw th [x y w h]]
(let [{:keys [r]} @p
sx (/ (double w) tw)
sy (/ (double h) th)
k (min sx sy)
dw (* tw k)
dh (* th k)]
(flush! p)
(sdl/blit! r tex nil [(+ x (/ (- w dw) 2.0)) (+ y (/ (- h dh) 2.0)) dw dh])))
(defn colour-emoji?
"Whether `s` has a colour picture to be drawn as."
[p s]
(font/colour-glyph? (:fonts @p) s))
(defn emoji!
"Draw `s` as a colour picture in `rect`. Answers whether it did — a caller
that gets false draws it as text instead."
[p s rect]
(let [{:keys [r fonts]} @p]
(if-let [[tex [tw th]] (font/colour-texture fonts r s)]
(do (frame! p tex tw th rect) true)
false)))
(defn line!
"A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case
— which in this toolkit is a checkbox tick — is a few offset hairlines,
because SDL has no thick line and a quad would need a tessellator."
[p x0 y0 x1 y1 colour width]
(cond
(= y0 y1) (plain-rect! p [(min x0 x1) (- y0 (/ width 2.0))
(Math/abs (- x1 x0)) width] colour)
(= x0 x1) (plain-rect! p [(- x0 (/ width 2.0)) (min y0 y1)
width (Math/abs (- y1 y0))] colour)
:else
(let [dx (- x1 x0) dy (- y1 y0)
len (Math/sqrt (+ (* dx dx) (* dy dy)))
nx (/ (- dy) len) ny (/ dx len)
n (max 1 (int width))]
(colour! p colour)
(dotimes [i n]
(let [o (- i (/ (dec n) 2.0))]
(sdl/line! (:r @p) (+ x0 (* nx o)) (+ y0 (* ny o))
(+ x1 (* nx o)) (+ y1 (* ny o))))))))
;; -------------------------------------------------------------------- text
(defn text!
"Draw `s` with its top-left at [x y]; answers the [w h] it occupied."
[p s x y size [cr cg cb ca]]
(let [{:keys [r fonts]} @p]
(if-let [[tex [tw th]] (font/texture fonts r s size)]
(do (sdl/texture-color-mod! tex cr cg cb)
(sdl/texture-alpha-mod! tex (or ca 255))
(sdl/blit! r tex nil [(Math/floor (double x)) (Math/floor (double y)) tw th])
[tw th])
[0 (if fonts (font/line-height fonts size) 0)])))
|
