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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
|
(ns jvui.sdl
"SDL3 through jolt.ffi, and nothing above it.
This is the whole foreign surface of jvui: a window, a renderer, an event
pump, textured triangles and a font. Everything else in this project —
layout, widget identity, event routing, the widgets themselves — is jolt.
Two libraries, both system libraries rather than anything this repo builds:
libSDL3 and libSDL3_ttf. Neither is dlopened until `open!` is called, so the
layout tests run on a machine with no display and no SDL at all.
Struct offsets below were taken with offsetof against /usr/include/SDL3 on
x86-64, not inferred from one struct to another's shape. SDL3's event union
is 128 bytes and its arms disagree about where the coordinates live."
(:require [jolt.ffi :as ffi]))
;; ---------------------------------------------------------------- libraries
(defonce ^:private loaded
(delay
(ffi/load-library "libSDL3.so.0")
(ffi/load-library "libSDL3_ttf.so.0")
true))
(defn ensure-loaded! [] @loaded)
;; ------------------------------------------------------------------ bindings
(ffi/defcfn init! "SDL_Init" [:ulong] :bool)
(ffi/defcfn quit! "SDL_Quit" [] :void)
(ffi/defcfn error "SDL_GetError" [] :string)
(ffi/defcfn delay-ms! "SDL_Delay" [:uint] :void)
(ffi/defcfn ticks-ns "SDL_GetTicksNS" [] :ulong)
(ffi/defcfn ^:private create-window-and-renderer "SDL_CreateWindowAndRenderer"
[:string :int :int :ulong :pointer :pointer] :bool)
(ffi/defcfn destroy-window! "SDL_DestroyWindow" [:pointer] :void)
(ffi/defcfn destroy-renderer! "SDL_DestroyRenderer" [:pointer] :void)
(ffi/defcfn ^:private raw-window-size "SDL_GetWindowSize"
[:pointer :pointer :pointer] :bool)
(ffi/defcfn ^:private raw-output-size "SDL_GetRenderOutputSize"
[:pointer :pointer :pointer] :bool)
(ffi/defcfn draw-color! "SDL_SetRenderDrawColor" [:pointer :uint8 :uint8 :uint8 :uint8] :bool)
(ffi/defcfn clear! "SDL_RenderClear" [:pointer] :bool)
(ffi/defcfn present! "SDL_RenderPresent" [:pointer] :bool)
(ffi/defcfn blend-mode! "SDL_SetRenderDrawBlendMode" [:pointer :uint] :bool)
(ffi/defcfn ^:private raw-fill-rect "SDL_RenderFillRect" [:pointer :pointer] :bool)
(ffi/defcfn ^:private raw-clip! "SDL_SetRenderClipRect" [:pointer :pointer] :bool)
(ffi/defcfn ^:private raw-poll "SDL_PollEvent" [:pointer] :bool)
(ffi/defcfn start-text-input! "SDL_StartTextInput" [:pointer] :bool)
(ffi/defcfn stop-text-input! "SDL_StopTextInput" [:pointer] :bool)
(ffi/defcfn ^:private raw-clipboard-text "SDL_GetClipboardText" [] :pointer)
(ffi/defcfn clipboard! "SDL_SetClipboardText" [:string] :bool)
(ffi/defcfn texture-from-surface "SDL_CreateTextureFromSurface" [:pointer :pointer] :pointer)
(ffi/defcfn destroy-texture! "SDL_DestroyTexture" [:pointer] :void)
(ffi/defcfn destroy-surface! "SDL_DestroySurface" [:pointer] :void)
(ffi/defcfn texture-color-mod! "SDL_SetTextureColorMod" [:pointer :uint8 :uint8 :uint8] :bool)
(ffi/defcfn texture-alpha-mod! "SDL_SetTextureAlphaMod" [:pointer :uint8] :bool)
(ffi/defcfn texture-blend-mode! "SDL_SetTextureBlendMode" [:pointer :uint] :bool)
(ffi/defcfn texture-scale-mode! "SDL_SetTextureScaleMode" [:pointer :int] :bool)
(ffi/defcfn ttf-init! "TTF_Init" [] :bool)
(ffi/defcfn ttf-quit! "TTF_Quit" [] :void)
(ffi/defcfn open-font "TTF_OpenFont" [:string :float] :pointer)
(ffi/defcfn close-font! "TTF_CloseFont" [:pointer] :void)
(ffi/defcfn font-height "TTF_GetFontHeight" [:pointer] :int)
;; A face to try for characters the main one has no glyph for. SDL_ttf keeps
;; a list of them and asks each in turn.
(ffi/defcfn add-fallback-font! "TTF_AddFallbackFont" [:pointer :pointer] :bool)
(ffi/defcfn font-has-glyph? "TTF_FontHasGlyph" [:pointer :uint] :bool)
(ffi/defcfn ^:private raw-string-size "TTF_GetStringSize"
[:pointer :string :ulong :pointer :pointer] :bool)
(ffi/defcfn ^:private raw-render-blended "TTF_RenderText_Blended"
;; SDL_Color is four bytes passed by value; on the SysV ABI a four-byte
;; aggregate of integers travels exactly as a uint32 does, so :uint is not a
;; cheat here — it is the same register, with r in the low octet.
[:pointer :string :ulong :uint] :pointer)
;; ----------------------------------------------------------------- constants
(def INIT-VIDEO 32)
(def WINDOW-RESIZABLE 32)
(def WINDOW-HIGH-DPI 8192)
(def BLEND 1)
(def SCALE-LINEAR 1)
;; SDL_EventType, from SDL_events.h. Only the arms this toolkit reads.
(def ^:private EV-QUIT 256)
(def ^:private EV-WINDOW-RESIZED 518)
(def ^:private EV-WINDOW-PIXEL-SIZE 519)
(def ^:private EV-WINDOW-CLOSE 528)
(def ^:private EV-KEY-DOWN 768)
(def ^:private EV-KEY-UP 769)
(def ^:private EV-TEXT-INPUT 771)
(def ^:private EV-MOUSE-MOTION 1024)
(def ^:private EV-MOUSE-DOWN 1025)
(def ^:private EV-MOUSE-UP 1026)
(def ^:private EV-MOUSE-WHEEL 1027)
;; Byte offsets into the 128-byte SDL_Event union. See the namespace docstring:
;; a motion event's x is at 28 and a wheel event's is at 24, and no amount of
;; staring at one of them tells you the other.
(def ^:private EVENT-SIZE 128)
(def ^:private O-MOTION-X 28) (def ^:private O-MOTION-Y 32)
(def ^:private O-BUTTON 24) (def ^:private O-BUTTON-DOWN 25)
(def ^:private O-CLICKS 26)
(def ^:private O-BUTTON-X 28) (def ^:private O-BUTTON-Y 32)
(def ^:private O-WHEEL-X 24) (def ^:private O-WHEEL-Y 28)
(def ^:private O-KEY 28) (def ^:private O-MOD 32)
(def ^:private O-REPEAT 37)
(def ^:private O-TEXT 24)
(def ^:private O-DATA1 20) (def ^:private O-DATA2 24)
;; SDL_Keycode values worth naming; the rest arrive as codepoints.
(def keycodes
{13 :return 27 :escape 8 :backspace 9 :tab 32 :space 127 :delete
1073741903 :right 1073741904 :left 1073741905 :down 1073741906 :up
1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down
;; The two keys a paste is pressed with. A letter is otherwise left as its
;; code: a field takes what it types from text events, and only the ones a
;; shortcut is built on need a name.
118 :v 1073741897 :insert})
(def ^:private MOD-SHIFT 3) (def ^:private MOD-CTRL 192)
;; -------------------------------------------------------------------- window
(defn output-size
"The renderer's size in pixels, as [w h]."
[r]
(ffi/with-alloc [w 4]
(ffi/with-alloc [h 4]
(raw-output-size r w h)
[(ffi/read w :int) (ffi/read h :int)])))
(defn window-size
"The window's size in its own units, which is what events are reported in and
is NOT the renderer's size on a display with a scale factor."
[w]
(ffi/with-alloc [a 4]
(ffi/with-alloc [b 4]
(raw-window-size w a b)
[(ffi/read a :int) (ffi/read b :int)])))
(defn open!
"Open a window and answer {:window :renderer}. Throws if SDL will not start."
[{:keys [title width height] :or {title "jvui" width 640 height 480}}]
(ensure-loaded!)
(when-not (init! INIT-VIDEO)
(throw (ex-info (str "SDL_Init: " (error)) {})))
(when-not (ttf-init!)
(throw (ex-info (str "TTF_Init: " (error)) {})))
(let [wp (ffi/alloc 8) rp (ffi/alloc 8)]
(try
(when-not (create-window-and-renderer
title width height
(bit-or WINDOW-RESIZABLE WINDOW-HIGH-DPI) wp rp)
(throw (ex-info (str "SDL_CreateWindowAndRenderer: " (error)) {})))
(let [window (ffi/read wp :pointer) renderer (ffi/read rp :pointer)]
(blend-mode! renderer BLEND)
{:window window :renderer renderer})
(finally (ffi/free wp) (ffi/free rp)))))
(defn close!
[{:keys [window renderer]}]
(when renderer (destroy-renderer! renderer))
(when window (destroy-window! window))
(ttf-quit!)
(quit!))
;; --------------------------------------------------------------------- text
(defn string-size
"[w h] of `s` in `font`, in pixels. The measurement the renderer will honour."
[font s]
(if (or (nil? font) (nil? s) (= s ""))
[0 (if font (font-height font) 0)]
(ffi/with-alloc [w 4]
(ffi/with-alloc [h 4]
(raw-string-size font s 0 w h)
[(ffi/read w :int) (ffi/read h :int)]))))
(defn render-blended
"An SDL_Surface* of `s` drawn white, for the caller to make a texture of and
tint. White because colour is a colour-mod on the texture, which means one
cached texture serves a label in every colour it is ever drawn in."
[font s]
(raw-render-blended font s 0 (unchecked-int 0xFFFFFFFF)))
;; SDL_Surface's first fields: flags(0) format(4) w(8) h(12) pitch(16) pixels(24)
(defn surface-size [surf] [(ffi/read surf :int 8) (ffi/read surf :int 12)])
;; ------------------------------------------------------------------ drawing
(defn clip!
"Restrict drawing to `rect` [x y w h], or lift the restriction when nil."
[r rect]
(if (nil? rect)
(raw-clip! r ffi/null)
(let [[x y w h] rect]
(ffi/with-alloc [p 16]
(ffi/write p :int (int x) 0)
(ffi/write p :int (int y) 4)
(ffi/write p :int (max 0 (int w)) 8)
(ffi/write p :int (max 0 (int h)) 12)
(raw-clip! r p)))))
;; ------------------------------------------------------------------- events
(defonce ^:private event-buf (delay (ffi/alloc EVENT-SIZE)))
(defn- decode [p]
(let [t (ffi/read p :int 0)]
(condp = t
EV-QUIT {:kind :quit}
EV-WINDOW-CLOSE {:kind :quit}
EV-WINDOW-RESIZED {:kind :resize :w (ffi/read p :int O-DATA1)
:h (ffi/read p :int O-DATA2)}
EV-WINDOW-PIXEL-SIZE {:kind :resize :w (ffi/read p :int O-DATA1)
:h (ffi/read p :int O-DATA2)}
EV-MOUSE-MOTION {:kind :motion
:x (ffi/read p :float O-MOTION-X)
:y (ffi/read p :float O-MOTION-Y)}
EV-MOUSE-DOWN {:kind :mouse-down
:button (ffi/read p :uint8 O-BUTTON)
:clicks (ffi/read p :uint8 O-CLICKS)
:x (ffi/read p :float O-BUTTON-X)
:y (ffi/read p :float O-BUTTON-Y)}
EV-MOUSE-UP {:kind :mouse-up
:button (ffi/read p :uint8 O-BUTTON)
:x (ffi/read p :float O-BUTTON-X)
:y (ffi/read p :float O-BUTTON-Y)}
EV-MOUSE-WHEEL {:kind :wheel
:dx (ffi/read p :float O-WHEEL-X)
:dy (ffi/read p :float O-WHEEL-Y)}
EV-KEY-DOWN (let [k (ffi/read p :uint O-KEY)
m (ffi/read p :uint16 O-MOD)]
{:kind :key-down
:key (get keycodes k k)
:shift? (pos? (bit-and m MOD-SHIFT))
:ctrl? (pos? (bit-and m MOD-CTRL))
:repeat? (not (zero? (ffi/read p :uint8 O-REPEAT)))})
EV-KEY-UP {:kind :key-up
:key (let [k (ffi/read p :uint O-KEY)] (get keycodes k k))}
EV-TEXT-INPUT (let [sp (ffi/read p :pointer O-TEXT)]
{:kind :text :text (if (ffi/null? sp) "" (ffi/ptr->string sp))})
nil)))
(defn drain!
"Every event queued since the last call, oldest first."
[]
(let [p @event-buf]
(loop [acc []]
(if (raw-poll p)
(recur (if-let [e (decode p)] (conj acc e) acc))
acc))))
(ffi/defcfn ^:private raw-texture-src "SDL_RenderTexture"
[:pointer :pointer :pointer :pointer] :bool)
(ffi/defcfn create-texture "SDL_CreateTexture" [:pointer :uint :int :int :int] :pointer)
(ffi/defcfn ^:private raw-update-texture "SDL_UpdateTexture"
[:pointer :pointer :pointer :int] :bool)
(ffi/defcfn ^:private raw-line "SDL_RenderLine"
[:pointer :float :float :float :float] :bool)
(def PIXELFORMAT-ARGB8888 372645892)
;; SDL_PIXELFORMAT_ABGR8888, which is what SDL_PIXELFORMAT_RGBA32 aliases to
;; on a little-endian machine. Named by its packed layout rather than its byte
;; order, which is the trap: a buffer whose BYTES run R,G,B,A reads as the
;; 32-bit word 0xAABBGGRR, so ABGR8888 is the one that matches it and
;; ARGB8888 — the obvious-looking choice — puts the channels through a
;; rotation and turns skin blue.
(def PIXELFORMAT-ABGR8888 376840196)
(def TEXTUREACCESS-STATIC 0)
;; STREAMING for anything uploaded every frame. STATIC textures live in
;; memory the driver expects to write rarely; a video feed at thirty a second
;; is the case the distinction exists for.
(def TEXTUREACCESS-STREAMING 1)
(defn update-texture!
"Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
[tex pixels w h]
(let [n (* w h)]
(ffi/with-alloc [p (* 4 n)]
(ffi/write-array p :int pixels)
(raw-update-texture tex ffi/null p (* 4 w)))))
;; --- the platform around the window -----------------------------------------
;; Title, display, browser, clipboard. None of it is drawing, and all of it is
;; what a client asks the toolkit for because the toolkit is the only thing
;; holding a window handle.
(ffi/defcfn set-window-title! "SDL_SetWindowTitle" [:pointer :string] :bool)
(ffi/defcfn open-url! "SDL_OpenURL" [:string] :bool)
(ffi/defcfn display-for-window "SDL_GetDisplayForWindow" [:pointer] :uint)
(ffi/defcfn ^:private raw-display-bounds "SDL_GetDisplayUsableBounds"
[:uint :pointer] :bool)
(ffi/defcfn has-clipboard-data "SDL_HasClipboardData" [:string] :bool)
(ffi/defcfn ^:private raw-clipboard-data "SDL_GetClipboardData"
[:string :pointer] :pointer)
(ffi/defcfn sdl-free! "SDL_free" [:pointer] :void)
(defn display-bounds
"[w h] of the display `window` is on, minus whatever the desktop reserves
for panels — usable bounds rather than raw, because a window sized to the
whole display is one with its bottom edge under a taskbar."
[window]
(ffi/with-alloc [r 16]
(when (raw-display-bounds (display-for-window window) r)
[(ffi/read (+ r 8) :int) (ffi/read (+ r 12) :int)])))
(defn clipboard
"The clipboard's text, or nil when it holds none.
Through a pointer rather than a `:string` return because the buffer is
SDL's to allocate and ours to free, and a converted return has already
dropped the pointer that would free it — a leak per paste. SDL answers an
empty string rather than NULL when there is no text, and that is nil here:
a paste of nothing is a different request from a paste of \"\"."
[]
(let [p (raw-clipboard-text)]
(when (and p (not (ffi/null? p)))
(try
(let [t (ffi/ptr->string p)] (when (seq t) t))
(finally (sdl-free! p))))))
(defn clipboard-data
"The clipboard's contents for `mime`, as [pointer length], or nil.
The pointer is SDL's and the caller must hand it back to `sdl-free!`."
[mime]
(ffi/with-alloc [sz 8]
(let [p (raw-clipboard-data mime sz)
n (ffi/read sz :uint64)]
(when (and p (not (ffi/null? p)) (pos? n))
[p n]))))
(ffi/defcfn img-load-texture "IMG_LoadTexture" [:pointer :string] :pointer)
(ffi/defcfn ^:private raw-texture-size "SDL_GetTextureSize"
[:pointer :pointer :pointer] :bool)
(defn texture-size
"[w h] of a texture, or nil."
[tex]
(ffi/with-alloc [w 4]
(ffi/with-alloc [h 4]
(when (raw-texture-size tex w h)
[(long (ffi/read w :float)) (long (ffi/read h :float))]))))
(defn update-texture-raw!
"Upload `h` rows of `pitch` bytes from FOREIGN memory into the whole of `tex`.
The pointer is the caller's and is read during the call and not kept. That
is the difference from `update-texture!` above, and the reason this exists:
that one takes an int-array, which means a decoded frame becomes a jolt
value on its way to the screen. At thirty frames a second and two megabytes
a frame, the copy costs more than the decode."
[tex ptr pitch]
(raw-update-texture tex ffi/null ptr pitch))
(defonce ^:private rect-a (delay (ffi/alloc 16)))
(defonce ^:private rect-b (delay (ffi/alloc 16)))
(defn- put-frect! [p [x y w h]]
(ffi/write p :float (float x) 0)
(ffi/write p :float (float y) 4)
(ffi/write p :float (float w) 8)
(ffi/write p :float (float h) 12)
p)
(defn fill-rect!
"One filled rectangle in the renderer's current draw colour.
The SDL_FRect is a scratch allocation held for the life of the process: SDL
copies out of it during the call and a fresh one per rectangle would be four
thousand allocations a frame."
[r rect]
(raw-fill-rect r (put-frect! @rect-a rect)))
(defn blit!
"Draw `src` (a sub-rectangle of `tex`, or nil for all of it) into `dst`."
[r tex src dst]
(raw-texture-src r tex
(if src (put-frect! @rect-b src) ffi/null)
(put-frect! @rect-a dst)))
(defn line! [r x0 y0 x1 y1]
(raw-line r (float x0) (float y0) (float x1) (float y1)))
(ffi/defcfn ^:private raw-read-pixels "SDL_RenderReadPixels" [:pointer :pointer] :pointer)
(ffi/defcfn ^:private raw-save-bmp "SDL_SaveBMP" [:pointer :string] :bool)
(defn save-screenshot!
"Write what the renderer last presented to `path` as a BMP.
Here for the same reason zvui's `--frames` is: so a change to a widget can be
looked at without a person sitting in front of the window."
[r path]
(let [surf (raw-read-pixels r ffi/null)]
(when-not (ffi/null? surf)
(raw-save-bmp surf path)
(destroy-surface! surf)
path)))
|