rickub
Sign in Get started
nandi/jolt-nativepublic⑂ Fork 0
⑂ 109c7e4
Branches
main View all branches → View all tags →
Commits
⬇ Clone ▾
git clone https://git.rickub.com/nandi/jolt-native.git
git clone ssh://git@rickub.com/nandi/jolt-native.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

Write dvui's shape in jolt, on SDL3, with no shared object

jolt owns the tree, layout, identity, event routing and every widget; SDL owns a window, an event pump, a rectangle and a glyph. jolt.ffi binds libSDL3 and libSDL3_ttf directly, so nothing in jvui/ is compiled.

glimmer-jvui is the backend over it: thirty lines of atoms for the reconciler to patch, and a walk that calls the jvui widget each node names.

Two measurements sent the obvious implementation back. A crossing is 0.2us but ffi/write-array is 0.6us per element, so the packed SDL_Vertex buffer every dvui backend uses costs six milliseconds a frame to fill from jolt; the unit here is the call, not the vertex. And swap! is 4us, so the layout walk's per-box counters moved into a double-array, taking a label from 35us to 5us.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Veronika Winters committed 2026-09-09T22:22:49-07:00 Browse files
109c7e4 parent: 38e196f
modified README.md +2 -0
@@ -16,6 +16,8 @@ crates/vidya-core the egui semantic layer behind it (theme, widget
1616 crates/jolt-tui the same tree ABI, painted into a terminal → libjolttui.so
1717 crates/jolt-moq freeq's AV media plane → libjoltmoq.so
1818 glimmer-backends/glimmer-vidya the jolt side of libvidya: glimmer's backend
19+jvui no .so at all: dvui's shape, in jolt, on SDL3
20+glimmer-backends/glimmer-jvui glimmer's backend over jvui
1921 ```
2022
2123 All three objects land in one `target/release`, so a consumer points
@@ -16,6 +16,8 @@ crates/vidya-core the egui semantic layer behind it (theme, widget
16 crates/jolt-tui the same tree ABI, painted into a terminal → libjolttui.so16 crates/jolt-tui the same tree ABI, painted into a terminal → libjolttui.so
17 crates/jolt-moq freeq's AV media plane → libjoltmoq.so17 crates/jolt-moq freeq's AV media plane → libjoltmoq.so
18 glimmer-backends/glimmer-vidya the jolt side of libvidya: glimmer's backend18 glimmer-backends/glimmer-vidya the jolt side of libvidya: glimmer's backend
19+jvui no .so at all: dvui's shape, in jolt, on SDL3
20+glimmer-backends/glimmer-jvui glimmer's backend over jvui
19 ```21 ```
20 22
21 All three objects land in one `target/release`, so a consumer points23 All three objects land in one `target/release`, so a consumer points
modified deps.edn +10 -1
@@ -9,4 +9,13 @@
99 {:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"
1010 gfx-game "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt tictactoe'"
1111 gfx-maze "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt maze'"
12- gfx-rocks "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt asteroids'"}}
12+ gfx-rocks "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt asteroids'"
13+
14+ ;; jvui needs no nix shell: SDL3 is dlopened by name from the ambient
15+ ;; system, and nothing in that directory is compiled.
16+ jvui-counter "bash -c 'cd jvui && jolt counter'"
17+ jvui-showcase "bash -c 'cd jvui && jolt showcase'"
18+ jvui-test "bash -c 'cd jvui && jolt test'"
19+
20+ glimmer-jvui "bash -c 'cd glimmer-backends/glimmer-jvui && jolt counter'"
21+ glimmer-jvui-test "bash -c 'cd glimmer-backends/glimmer-jvui && jolt test'"}}
@@ -9,4 +9,13 @@
9 {:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"9 {:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"
10 gfx-game "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt tictactoe'"10 gfx-game "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt tictactoe'"
11 gfx-maze "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt maze'"11 gfx-maze "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt maze'"
12- gfx-rocks "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt asteroids'"}}12+ gfx-rocks "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt asteroids'"
13+
14+ ;; jvui needs no nix shell: SDL3 is dlopened by name from the ambient
15+ ;; system, and nothing in that directory is compiled.
16+ jvui-counter "bash -c 'cd jvui && jolt counter'"
17+ jvui-showcase "bash -c 'cd jvui && jolt showcase'"
18+ jvui-test "bash -c 'cd jvui && jolt test'"
19+
20+ glimmer-jvui "bash -c 'cd glimmer-backends/glimmer-jvui && jolt counter'"
21+ glimmer-jvui-test "bash -c 'cd glimmer-backends/glimmer-jvui && jolt test'"}}
added glimmer-backends/glimmer-jvui/README.md +102 -0
new file mode 100644
@@ -0,0 +1,102 @@
1+# glimmer-jvui
2+
3+The **jvui** backend for [glimmer](https://github.com/jolt-lang/glimmer), the
4+reactive GUI toolkit for [jolt](https://github.com/jolt-lang/jolt).
5+
6+glimmer owns the portable half — reactive cells, the component model, the
7+reconciler — and knows nothing about any toolkit. This project supplies the
8+other half out of [`../../jvui`](../../jvui), which is dvui's shape written in
9+jolt on SDL3. Requiring `glimmer-jvui.core` registers it, and components that
10+render as GTK widgets under
11+[glimmer-gtk](https://github.com/jolt-lang/glimmer-gtk), as egui under
12+[glimmer-vidya](../glimmer-vidya) and as text under
13+[glimmer-tui](../glimmer-tui) render here as jvui.
14+
15+```clojure
16+(ns myapp
17+ (:require [glimmer.ratom :as ra]
18+ [glimmer.core :as ui]
19+ [glimmer-jvui.core])) ; installs this backend
20+
21+(defn counter []
22+ (let [n (ra/atom 0)]
23+ (fn []
24+ [:card {}
25+ [:title {:label "Counter"}]
26+ [:label {:label (str "Count: " (ra/deref n))}]
27+ [:hbox {:spacing 8}
28+ [:button {:label "- 1" :on-click #(ra/swap! n dec)}]
29+ [:button {:label "+ 1" :kind :primary :on-click #(ra/swap! n inc)}]]])))
30+
31+(defn -main [& _] (ui/run counter {:title "myapp" :max-width 420}))
32+```
33+
34+```bash
35+jolt test # headless: no window, no SDL, no font, no display
36+jolt counter # a window
37+jolt counter --shot
38+```
39+
40+## The smallest of the four backends
41+
42+A glimmer backend usually has to supply everything a toolkit would have done
43+for it. [glimmer-gfx](../glimmer-gfx) writes its own measure, place, paint and
44+hit test, because there is nothing underneath it. [glimmer-vidya](../glimmer-vidya)
45+keeps a node arena in Rust behind a second C ABI, because egui hands a
46+reconciler nothing to hold.
47+
48+Here none of that is needed, because jvui is a toolkit rather than an ABI. What
49+is left is the one thing an immediate-mode library does not have — somewhere to
50+put a widget between frames — and it is thirty lines of atoms:
51+
52+ src/glimmer_jvui/core.clj the tree, the walk, the loop
53+
54+`create!` makes an atom, `append-child!` conjes onto a vector, and once a frame
55+`emit!` walks that tree and calls the jvui widget each node names. Layout,
56+clipping, focus, capture and painting are jvui's.
57+
58+## Three things worth knowing
59+
60+**The walk is the closure.** glimmer-vidya's README explains why its tree lives
61+in Rust: egui's `ScrollArea` and `Frame` take an `FnOnce(&mut Ui)` and keep
62+their begin/end private, so a push/pop ABI cannot scroll a page. jvui's
63+containers take a body function for the same reason — and here the recursion
64+*is* that function. `emit!` on a container hands `emit-children!` over as the
65+body and the nesting takes care of itself, which is why there is no push/pop
66+anywhere in this file.
67+
68+**Every node carries a key.** jvui identifies a widget by its parent and its
69+index among its siblings, unless it is given a `:key`, which *replaces* the
70+index. A reconciler reorders children, and an identity built on the index would
71+hand every widget after the moved one the caret, the scroll offset and the drag
72+of whichever widget used to sit at its index. So each node takes a serial
73+number at creation and passes it as its key, and identity follows the node
74+rather than its position. That is the bug class
75+[zvui](../../zig/jolt-zvui)'s README describes from the backend side, closed
76+here at the other end — and `jolt test` reorders a list and checks it.
77+
78+**A re-render is queued, never inline.** A handler fires in the middle of the
79+walk, and a ratom change would have the reconciler patch the tree while it is
80+being walked — half the frame old, half new. `:schedule` queues the work and
81+jvui's `:before` hook drains it at the top of the next frame, before anything
82+is placed.
83+
84+## What renders
85+
86+Containers: `:page` `:card` `:frame` `:vbox` `:box` `:hbox` `:scroll`.
87+Widgets: `:title` `:label` `:dim-label` `:button` `:checkbox` `:slider`
88+`:entry`/`:text-entry` `:progress` `:separator` `:spacer`/`:gap`.
89+
90+Props are the vocabulary the other backends share — `:label`/`:text`,
91+`:spacing`, `:padding`, `:margin`, `:orientation`, `:max-width`, `:kind`,
92+`:checked`, `:value`/`:min`/`:max`, `:placeholder`, `:dim`, `:size`,
93+`:on-click`, `:on-change`.
94+
95+An unknown tag is a container rather than an error, so a tree written against a
96+richer backend still shows its contents — the same bargain jolt-zvui makes.
97+
98+## Not done
99+
100+Everything jvui has not got, and nothing else: one font style, no text
101+selection, vertical scrolling only, no animation clock, no menus or dialogs.
102+`:sensitive`, `:multiline` and `:fill-height` are accepted and ignored.
new file mode 100644
@@ -0,0 +1,102 @@
1+# glimmer-jvui
2+
3+The **jvui** backend for [glimmer](https://github.com/jolt-lang/glimmer), the
4+reactive GUI toolkit for [jolt](https://github.com/jolt-lang/jolt).
5+
6+glimmer owns the portable half — reactive cells, the component model, the
7+reconciler — and knows nothing about any toolkit. This project supplies the
8+other half out of [`../../jvui`](../../jvui), which is dvui's shape written in
9+jolt on SDL3. Requiring `glimmer-jvui.core` registers it, and components that
10+render as GTK widgets under
11+[glimmer-gtk](https://github.com/jolt-lang/glimmer-gtk), as egui under
12+[glimmer-vidya](../glimmer-vidya) and as text under
13+[glimmer-tui](../glimmer-tui) render here as jvui.
14+
15+```clojure
16+(ns myapp
17+ (:require [glimmer.ratom :as ra]
18+ [glimmer.core :as ui]
19+ [glimmer-jvui.core])) ; installs this backend
20+
21+(defn counter []
22+ (let [n (ra/atom 0)]
23+ (fn []
24+ [:card {}
25+ [:title {:label "Counter"}]
26+ [:label {:label (str "Count: " (ra/deref n))}]
27+ [:hbox {:spacing 8}
28+ [:button {:label "- 1" :on-click #(ra/swap! n dec)}]
29+ [:button {:label "+ 1" :kind :primary :on-click #(ra/swap! n inc)}]]])))
30+
31+(defn -main [& _] (ui/run counter {:title "myapp" :max-width 420}))
32+```
33+
34+```bash
35+jolt test # headless: no window, no SDL, no font, no display
36+jolt counter # a window
37+jolt counter --shot
38+```
39+
40+## The smallest of the four backends
41+
42+A glimmer backend usually has to supply everything a toolkit would have done
43+for it. [glimmer-gfx](../glimmer-gfx) writes its own measure, place, paint and
44+hit test, because there is nothing underneath it. [glimmer-vidya](../glimmer-vidya)
45+keeps a node arena in Rust behind a second C ABI, because egui hands a
46+reconciler nothing to hold.
47+
48+Here none of that is needed, because jvui is a toolkit rather than an ABI. What
49+is left is the one thing an immediate-mode library does not have — somewhere to
50+put a widget between frames — and it is thirty lines of atoms:
51+
52+ src/glimmer_jvui/core.clj the tree, the walk, the loop
53+
54+`create!` makes an atom, `append-child!` conjes onto a vector, and once a frame
55+`emit!` walks that tree and calls the jvui widget each node names. Layout,
56+clipping, focus, capture and painting are jvui's.
57+
58+## Three things worth knowing
59+
60+**The walk is the closure.** glimmer-vidya's README explains why its tree lives
61+in Rust: egui's `ScrollArea` and `Frame` take an `FnOnce(&mut Ui)` and keep
62+their begin/end private, so a push/pop ABI cannot scroll a page. jvui's
63+containers take a body function for the same reason — and here the recursion
64+*is* that function. `emit!` on a container hands `emit-children!` over as the
65+body and the nesting takes care of itself, which is why there is no push/pop
66+anywhere in this file.
67+
68+**Every node carries a key.** jvui identifies a widget by its parent and its
69+index among its siblings, unless it is given a `:key`, which *replaces* the
70+index. A reconciler reorders children, and an identity built on the index would
71+hand every widget after the moved one the caret, the scroll offset and the drag
72+of whichever widget used to sit at its index. So each node takes a serial
73+number at creation and passes it as its key, and identity follows the node
74+rather than its position. That is the bug class
75+[zvui](../../zig/jolt-zvui)'s README describes from the backend side, closed
76+here at the other end — and `jolt test` reorders a list and checks it.
77+
78+**A re-render is queued, never inline.** A handler fires in the middle of the
79+walk, and a ratom change would have the reconciler patch the tree while it is
80+being walked — half the frame old, half new. `:schedule` queues the work and
81+jvui's `:before` hook drains it at the top of the next frame, before anything
82+is placed.
83+
84+## What renders
85+
86+Containers: `:page` `:card` `:frame` `:vbox` `:box` `:hbox` `:scroll`.
87+Widgets: `:title` `:label` `:dim-label` `:button` `:checkbox` `:slider`
88+`:entry`/`:text-entry` `:progress` `:separator` `:spacer`/`:gap`.
89+
90+Props are the vocabulary the other backends share — `:label`/`:text`,
91+`:spacing`, `:padding`, `:margin`, `:orientation`, `:max-width`, `:kind`,
92+`:checked`, `:value`/`:min`/`:max`, `:placeholder`, `:dim`, `:size`,
93+`:on-click`, `:on-change`.
94+
95+An unknown tag is a container rather than an error, so a tree written against a
96+richer backend still shows its contents — the same bargain jolt-zvui makes.
97+
98+## Not done
99+
100+Everything jvui has not got, and nothing else: one font style, no text
101+selection, vertical scrolling only, no animation clock, no menus or dialogs.
102+`:sensitive`, `:multiline` and `:fill-height` are accepted and ignored.
added glimmer-backends/glimmer-jvui/deps.edn +25 -0
new file mode 100644
@@ -0,0 +1,25 @@
1+{:paths ["src"]
2+
3+ ;; glimmer-jvui is a backend for glimmer, beside glimmer-vidya, glimmer-tui and
4+ ;; glimmer-gfx and against the same reconciler: glimmer owns the reactive core
5+ ;; and knows about no toolkit, and this project supplies widgets, painting and
6+ ;; the frame loop.
7+ ;;
8+ ;; It supplies them by *not* implementing them. glimmer-gfx writes its own
9+ ;; measure/place/paint/hit-test because there is nothing underneath it;
10+ ;; glimmer-vidya keeps a node arena in Rust because egui hands a reconciler
11+ ;; nothing to hold. Here the retained tree is thirty lines of atoms and the
12+ ;; walk over it emits jvui calls — jvui does the layout, the routing and the
13+ ;; painting, because it is a toolkit rather than an ABI.
14+ :deps {jolt-lang/glimmer {:git/url "https://github.com/jolt-lang/glimmer"
15+ :git/tag "v0.1.0"
16+ :git/sha "5581c331c51aff989259b9e8e92ec920fe5e6741"}
17+ jvui/jvui {:local/root "../../jvui"}}
18+
19+ :aliases {:counter {:extra-paths ["examples"]
20+ :main-opts ["-m" "glimmer-jvui.counter"]}
21+ :test {:extra-paths ["test" "examples"]
22+ :main-opts ["-m" "glimmer-jvui.tests"]}}
23+
24+ :tasks {counter "jolt -M:counter"
25+ test "jolt -M:test"}}
new file mode 100644
@@ -0,0 +1,25 @@
1+{:paths ["src"]
2+
3+ ;; glimmer-jvui is a backend for glimmer, beside glimmer-vidya, glimmer-tui and
4+ ;; glimmer-gfx and against the same reconciler: glimmer owns the reactive core
5+ ;; and knows about no toolkit, and this project supplies widgets, painting and
6+ ;; the frame loop.
7+ ;;
8+ ;; It supplies them by *not* implementing them. glimmer-gfx writes its own
9+ ;; measure/place/paint/hit-test because there is nothing underneath it;
10+ ;; glimmer-vidya keeps a node arena in Rust because egui hands a reconciler
11+ ;; nothing to hold. Here the retained tree is thirty lines of atoms and the
12+ ;; walk over it emits jvui calls — jvui does the layout, the routing and the
13+ ;; painting, because it is a toolkit rather than an ABI.
14+ :deps {jolt-lang/glimmer {:git/url "https://github.com/jolt-lang/glimmer"
15+ :git/tag "v0.1.0"
16+ :git/sha "5581c331c51aff989259b9e8e92ec920fe5e6741"}
17+ jvui/jvui {:local/root "../../jvui"}}
18+
19+ :aliases {:counter {:extra-paths ["examples"]
20+ :main-opts ["-m" "glimmer-jvui.counter"]}
21+ :test {:extra-paths ["test" "examples"]
22+ :main-opts ["-m" "glimmer-jvui.tests"]}}
23+
24+ :tasks {counter "jolt -M:counter"
25+ test "jolt -M:test"}}
added glimmer-backends/glimmer-jvui/examples/glimmer_jvui/counter.clj +34 -0
new file mode 100644
@@ -0,0 +1,34 @@
1+(ns glimmer-jvui.counter
2+ "The same component glimmer-vidya, glimmer-tui and glimmer-gfx render, with
3+ jvui underneath instead of egui, a terminal or a rasterizer."
4+ (:require [glimmer.ratom :as ra]
5+ [glimmer.core :as ui]
6+ [glimmer-jvui.core])) ; installs this backend
7+
8+(defn counter []
9+ (let [n (ra/atom 0)
10+ loud? (ra/atom false)
11+ who (ra/atom "")]
12+ (fn []
13+ [:card {}
14+ [:title {:label "Counter"}]
15+ [:label {:label (str "Count: " (ra/deref n)
16+ (when (ra/deref loud?) "!"))}]
17+ [:hbox {:spacing 8}
18+ [:button {:label "- 1" :on-click #(ra/swap! n dec)}]
19+ [:button {:label "+ 1" :kind :primary :on-click #(ra/swap! n inc)}]
20+ [:button {:label "reset" :on-click #(ra/reset! n 0)}]]
21+ [:separator {}]
22+ [:checkbox {:label "Exclaim" :checked (ra/deref loud?)
23+ :on-change #(ra/reset! loud? %)}]
24+ [:entry {:value (ra/deref who) :placeholder "your name"
25+ :on-change #(ra/reset! who %)}]
26+ [:label {:dim true
27+ :label (if (= "" (ra/deref who))
28+ "nobody yet"
29+ (str "hello, " (ra/deref who)))}]])))
30+
31+(defn -main [& args]
32+ (ui/run counter (cond-> {:title "glimmer-jvui" :max-width 420}
33+ (some #{"--shot"} args)
34+ (assoc :frames 3 :shot "/tmp/glimmer-jvui.bmp"))))
new file mode 100644
@@ -0,0 +1,34 @@
1+(ns glimmer-jvui.counter
2+ "The same component glimmer-vidya, glimmer-tui and glimmer-gfx render, with
3+ jvui underneath instead of egui, a terminal or a rasterizer."
4+ (:require [glimmer.ratom :as ra]
5+ [glimmer.core :as ui]
6+ [glimmer-jvui.core])) ; installs this backend
7+
8+(defn counter []
9+ (let [n (ra/atom 0)
10+ loud? (ra/atom false)
11+ who (ra/atom "")]
12+ (fn []
13+ [:card {}
14+ [:title {:label "Counter"}]
15+ [:label {:label (str "Count: " (ra/deref n)
16+ (when (ra/deref loud?) "!"))}]
17+ [:hbox {:spacing 8}
18+ [:button {:label "- 1" :on-click #(ra/swap! n dec)}]
19+ [:button {:label "+ 1" :kind :primary :on-click #(ra/swap! n inc)}]
20+ [:button {:label "reset" :on-click #(ra/reset! n 0)}]]
21+ [:separator {}]
22+ [:checkbox {:label "Exclaim" :checked (ra/deref loud?)
23+ :on-change #(ra/reset! loud? %)}]
24+ [:entry {:value (ra/deref who) :placeholder "your name"
25+ :on-change #(ra/reset! who %)}]
26+ [:label {:dim true
27+ :label (if (= "" (ra/deref who))
28+ "nobody yet"
29+ (str "hello, " (ra/deref who)))}]])))
30+
31+(defn -main [& args]
32+ (ui/run counter (cond-> {:title "glimmer-jvui" :max-width 420}
33+ (some #{"--shot"} args)
34+ (assoc :frames 3 :shot "/tmp/glimmer-jvui.bmp"))))
added glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +233 -0
new file mode 100644
@@ -0,0 +1,233 @@
1+(ns glimmer-jvui.core
2+ "A glimmer backend that renders through [jvui](../../../jvui).
3+
4+ glimmer owns the reactive core — ratoms, components, the reconciler — and
5+ knows nothing about any toolkit. glimmer-gtk fills that in with GtkWidgets,
6+ glimmer-vidya with a Rust node arena painted by egui, glimmer-gfx with a
7+ software rasterizer it writes itself. This fills it in with jvui, and so is
8+ the smallest of the four: everything a backend usually has to supply — the
9+ measuring, the placing, the hit testing, the painting — is already a toolkit
10+ one directory over.
11+
12+ What is left is the half an immediate-mode library does not have: a tree to
13+ hold still between frames. The reconciler needs somewhere to put a widget it
14+ created and to append a child to, and jvui's widgets draw and return within
15+ one call. So a node here is an atom of {:tag :props :children :key}, about
16+ thirty lines of it, and once a frame `emit!` walks that tree and calls the
17+ jvui widget each node names.
18+
19+ # The walk is the closure
20+
21+ glimmer-vidya's README explains why its tree lives in Rust: `ScrollArea` and
22+ `Frame` take an `FnOnce(&mut Ui)` and keep their begin/end private, so a
23+ push/pop ABI cannot scroll a page. jvui's containers take a body function
24+ for the same reason, and here the recursion *is* that function — `emit!` on
25+ a container passes `emit-children!` as the body, and the nesting takes care
26+ of itself.
27+
28+ # Why every node carries a key
29+
30+ jvui identifies a widget by its parent and its index among its siblings,
31+ unless it is given a `:key`, which replaces the index. A reconciler reorders
32+ children; an identity built on the index would hand each widget after the
33+ moved one the caret, the scroll offset and the drag of whichever widget used
34+ to sit at its index. So every node gets a serial number at creation and
35+ passes it as its key, and the identity follows the node rather than its
36+ position. That is the bug class zvui's README describes from the backend
37+ side, closed here at the other end."
38+ (:require [glimmer.backend :as b]
39+ [jvui.app :as app]
40+ [jvui.core :as c]
41+ [jvui.theme :as theme]
42+ [jvui.widgets :as w]))
43+
44+;; --- the retained tree -------------------------------------------------------
45+
46+(defonce ^:private serial (atom 0))
47+
48+(defn- create! [tag props]
49+ (atom {:tag tag :props props :children [] :key (swap! serial inc)}))
50+
51+(defn- apply-props! [_tag n props] (swap! n assoc :props props) nil)
52+(defn- append-child! [_t parent child] (swap! parent update :children conj child) nil)
53+(defn- remove-child! [_t parent child]
54+ (swap! parent update :children #(vec (remove #{child} %))) nil)
55+(defn- replace-child! [_t parent old new]
56+ (swap! parent update :children #(mapv (fn [c] (if (= c old) new c)) %)) nil)
57+(defn- reorder-child! [_t parent child sibling]
58+ (swap! parent update :children
59+ (fn [cs]
60+ (let [cs (vec (remove #{child} cs))
61+ i (if (nil? sibling) 0 (inc (.indexOf cs sibling)))]
62+ (vec (concat (subvec cs 0 i) [child] (subvec cs i))))))
63+ nil)
64+
65+;; --- props -------------------------------------------------------------------
66+
67+(defn- txt [props] (str (or (:label props) (:text props) "")))
68+
69+(defn- num [v default] (if (number? v) (double v) default))
70+
71+(defn- box-opts
72+ "The container options shared by every container tag."
73+ [props key]
74+ (cond-> {:key key
75+ :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)}
76+ (:spacing props) (assoc :spacing (num (:spacing props) 0.0))
77+ (:padding props) (assoc :padding (num (:padding props) 0.0))
78+ (:margin props) (assoc :margin (num (:margin props) 0.0))
79+ (:expand props) (assoc :expand (:expand props))))
80+
81+(defn- fire! [n k & args]
82+ (when-let [f (get (:props @n) k)] (apply f args)))
83+
84+;; --- the walk ----------------------------------------------------------------
85+
86+(def ^:dynamic *record-rects?*
87+ "When true, each node keeps the rectangle jvui gave it, under `:rect`.
88+
89+ Off in a running window, where it would be a `swap!` per node per frame for
90+ nobody's benefit. On under `render-once`, so a test can click the centre of
91+ a button the way a person would, rather than guessing at a coordinate and
92+ re-guessing every time a padding changes."
93+ false)
94+
95+(declare emit!)
96+
97+(defn- record! [n id]
98+ (when *record-rects?* (swap! n assoc :rect (c/rect-of id)))
99+ nil)
100+
101+(defn- emit-children! [n]
102+ (fn [_id _rect] (doseq [c (:children @n)] (emit! c))))
103+
104+(defn- emit!
105+ "Render one node, and through it everything below it.
106+
107+ A widget answers what the person did to it, and that answer is turned back
108+ into the callback prop the component registered — which is the whole seam
109+ between an immediate-mode toolkit and a retained, callback-shaped one."
110+ [n]
111+ (let [{:keys [tag props key]} @n
112+ s (txt props)]
113+ (case tag
114+ :page (w/page* (cond-> {:key key}
115+ (:max-width props) (assoc :max-width (:max-width props)))
116+ (emit-children! n))
117+
118+ (:card :frame) (w/card* (box-opts props key) (emit-children! n))
119+
120+ :scroll (w/scroll* (assoc (box-opts props key)
121+ :height (num (:height props) 200.0))
122+ (emit-children! n))
123+
124+ :hbox (c/box* (assoc (box-opts props key) :dir :horizontal)
125+ (emit-children! n))
126+
127+ (:vbox :box) (c/box* (box-opts props key) (emit-children! n))
128+
129+ :title (w/title s)
130+
131+ :label (if (:dim props) (w/dim-label s) (w/label s))
132+ :dim-label (w/dim-label s)
133+
134+ :button (let [id (c/next-id key)
135+ hit? (w/button s {:key key :kind (or (:kind props) :normal)})]
136+ (record! n id)
137+ (when hit? (fire! n :on-click)))
138+
139+ :checkbox (let [was (boolean (:checked props))
140+ id (c/next-id key)
141+ now (w/checkbox was s {:key key})]
142+ (record! n id)
143+ (when (not= now was) (fire! n :on-change now)))
144+
145+ :slider (let [was (num (:value props) 0.0)
146+ id (c/next-id key)
147+ now (w/slider was {:key key
148+ :min (num (:min props) 0.0)
149+ :max (num (:max props) 100.0)})]
150+ ;; == and not not=, because a component holding a long 0 must
151+ ;; not be told every frame that its slider moved to 0.0
152+ (record! n id)
153+ (when-not (== now was) (fire! n :on-change now)))
154+
155+ (:entry :text-entry)
156+ (let [was (str (or (:value props) (:text props) ""))
157+ id (c/next-id key)
158+ now (w/text-entry was {:key key :placeholder (:placeholder props)})]
159+ (record! n id)
160+ (when (not= now was) (fire! n :on-change now)))
161+
162+ :progress (w/progress (num (:value props) 0.0))
163+ :separator (w/separator)
164+ (:spacer :gap) (w/spacer {:size (num (:size props) 8.0)
165+ :expand (:expand props :none)})
166+
167+ ;; An unknown tag is a container rather than an error, so a tree written
168+ ;; against a richer backend still shows its contents here — the same
169+ ;; bargain jolt-zvui makes with the tags it does not know.
170+ (c/box* (box-opts props key) (emit-children! n)))))
171+
172+;; --- the loop ----------------------------------------------------------------
173+
174+(defonce ^:private pending (atom []))
175+
176+(defn- schedule! [work] (swap! pending conj work) nil)
177+
178+(defn- drain-pending! []
179+ (let [[ws] (reset-vals! pending [])]
180+ (doseq [w ws] (w))))
181+
182+(defn- run!
183+ "glimmer.backend's :run. Creates the root page, mounts into it, then hands the
184+ loop to jvui.
185+
186+ The reconciler's queued work is drained by jvui's `:before` hook rather than
187+ inside the walk: a re-render patches the tree, and patching a tree while it
188+ is being walked is how a frame ends up half old and half new."
189+ [opts mount-root!]
190+ (let [{:keys [title width height max-width theme frames auto-quit-ms shot]
191+ :or {title "glimmer" width 720 height 520}} opts
192+ root (create! :page (cond-> {} max-width (assoc :max-width max-width)))]
193+ (mount-root! root :page)
194+ (reset! b/loop-running? true)
195+ (try
196+ (app/run! (fn [] (emit! root))
197+ {:title title :width width :height height
198+ :theme (or theme theme/dark)
199+ :before drain-pending!
200+ :frames frames :auto-quit-ms auto-quit-ms :shot shot})
201+ (finally (reset! b/loop-running? false)))))
202+
203+;; --- registration ------------------------------------------------------------
204+
205+(def backend
206+ {:name :jvui
207+ :create! create! :apply-props! apply-props!
208+ :append-child! append-child! :remove-child! remove-child!
209+ :replace-child! replace-child! :reorder-child! reorder-child!
210+ :schedule schedule! :run run!})
211+
212+(b/register! backend)
213+
214+;; --- headless driving, for tests ---------------------------------------------
215+
216+(defn root-node
217+ "A bare root page, for mounting into without a window."
218+ [] (create! :page {}))
219+
220+(defn render-once
221+ "Walk `root` through jvui with no window, no font and no display.
222+
223+ `cx` is a `jvui.core/context`; `evs` the events that frame. Answers the
224+ context, whose `:data` is every rectangle the walk placed — which is enough
225+ for a test to assert about a layout and to click on it."
226+ ([root cx] (render-once root cx []))
227+ ([root cx evs]
228+ (drain-pending!)
229+ (swap! cx assoc :events evs)
230+ (swap! cx c/apply-input evs)
231+ (binding [*record-rects?* true]
232+ (c/frame! cx (fn [] (emit! root))))
233+ cx))
new file mode 100644
@@ -0,0 +1,233 @@
1+(ns glimmer-jvui.core
2+ "A glimmer backend that renders through [jvui](../../../jvui).
3+
4+ glimmer owns the reactive core — ratoms, components, the reconciler — and
5+ knows nothing about any toolkit. glimmer-gtk fills that in with GtkWidgets,
6+ glimmer-vidya with a Rust node arena painted by egui, glimmer-gfx with a
7+ software rasterizer it writes itself. This fills it in with jvui, and so is
8+ the smallest of the four: everything a backend usually has to supply — the
9+ measuring, the placing, the hit testing, the painting — is already a toolkit
10+ one directory over.
11+
12+ What is left is the half an immediate-mode library does not have: a tree to
13+ hold still between frames. The reconciler needs somewhere to put a widget it
14+ created and to append a child to, and jvui's widgets draw and return within
15+ one call. So a node here is an atom of {:tag :props :children :key}, about
16+ thirty lines of it, and once a frame `emit!` walks that tree and calls the
17+ jvui widget each node names.
18+
19+ # The walk is the closure
20+
21+ glimmer-vidya's README explains why its tree lives in Rust: `ScrollArea` and
22+ `Frame` take an `FnOnce(&mut Ui)` and keep their begin/end private, so a
23+ push/pop ABI cannot scroll a page. jvui's containers take a body function
24+ for the same reason, and here the recursion *is* that function — `emit!` on
25+ a container passes `emit-children!` as the body, and the nesting takes care
26+ of itself.
27+
28+ # Why every node carries a key
29+
30+ jvui identifies a widget by its parent and its index among its siblings,
31+ unless it is given a `:key`, which replaces the index. A reconciler reorders
32+ children; an identity built on the index would hand each widget after the
33+ moved one the caret, the scroll offset and the drag of whichever widget used
34+ to sit at its index. So every node gets a serial number at creation and
35+ passes it as its key, and the identity follows the node rather than its
36+ position. That is the bug class zvui's README describes from the backend
37+ side, closed here at the other end."
38+ (:require [glimmer.backend :as b]
39+ [jvui.app :as app]
40+ [jvui.core :as c]
41+ [jvui.theme :as theme]
42+ [jvui.widgets :as w]))
43+
44+;; --- the retained tree -------------------------------------------------------
45+
46+(defonce ^:private serial (atom 0))
47+
48+(defn- create! [tag props]
49+ (atom {:tag tag :props props :children [] :key (swap! serial inc)}))
50+
51+(defn- apply-props! [_tag n props] (swap! n assoc :props props) nil)
52+(defn- append-child! [_t parent child] (swap! parent update :children conj child) nil)
53+(defn- remove-child! [_t parent child]
54+ (swap! parent update :children #(vec (remove #{child} %))) nil)
55+(defn- replace-child! [_t parent old new]
56+ (swap! parent update :children #(mapv (fn [c] (if (= c old) new c)) %)) nil)
57+(defn- reorder-child! [_t parent child sibling]
58+ (swap! parent update :children
59+ (fn [cs]
60+ (let [cs (vec (remove #{child} cs))
61+ i (if (nil? sibling) 0 (inc (.indexOf cs sibling)))]
62+ (vec (concat (subvec cs 0 i) [child] (subvec cs i))))))
63+ nil)
64+
65+;; --- props -------------------------------------------------------------------
66+
67+(defn- txt [props] (str (or (:label props) (:text props) "")))
68+
69+(defn- num [v default] (if (number? v) (double v) default))
70+
71+(defn- box-opts
72+ "The container options shared by every container tag."
73+ [props key]
74+ (cond-> {:key key
75+ :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)}
76+ (:spacing props) (assoc :spacing (num (:spacing props) 0.0))
77+ (:padding props) (assoc :padding (num (:padding props) 0.0))
78+ (:margin props) (assoc :margin (num (:margin props) 0.0))
79+ (:expand props) (assoc :expand (:expand props))))
80+
81+(defn- fire! [n k & args]
82+ (when-let [f (get (:props @n) k)] (apply f args)))
83+
84+;; --- the walk ----------------------------------------------------------------
85+
86+(def ^:dynamic *record-rects?*
87+ "When true, each node keeps the rectangle jvui gave it, under `:rect`.
88+
89+ Off in a running window, where it would be a `swap!` per node per frame for
90+ nobody's benefit. On under `render-once`, so a test can click the centre of
91+ a button the way a person would, rather than guessing at a coordinate and
92+ re-guessing every time a padding changes."
93+ false)
94+
95+(declare emit!)
96+
97+(defn- record! [n id]
98+ (when *record-rects?* (swap! n assoc :rect (c/rect-of id)))
99+ nil)
100+
101+(defn- emit-children! [n]
102+ (fn [_id _rect] (doseq [c (:children @n)] (emit! c))))
103+
104+(defn- emit!
105+ "Render one node, and through it everything below it.
106+
107+ A widget answers what the person did to it, and that answer is turned back
108+ into the callback prop the component registered — which is the whole seam
109+ between an immediate-mode toolkit and a retained, callback-shaped one."
110+ [n]
111+ (let [{:keys [tag props key]} @n
112+ s (txt props)]
113+ (case tag
114+ :page (w/page* (cond-> {:key key}
115+ (:max-width props) (assoc :max-width (:max-width props)))
116+ (emit-children! n))
117+
118+ (:card :frame) (w/card* (box-opts props key) (emit-children! n))
119+
120+ :scroll (w/scroll* (assoc (box-opts props key)
121+ :height (num (:height props) 200.0))
122+ (emit-children! n))
123+
124+ :hbox (c/box* (assoc (box-opts props key) :dir :horizontal)
125+ (emit-children! n))
126+
127+ (:vbox :box) (c/box* (box-opts props key) (emit-children! n))
128+
129+ :title (w/title s)
130+
131+ :label (if (:dim props) (w/dim-label s) (w/label s))
132+ :dim-label (w/dim-label s)
133+
134+ :button (let [id (c/next-id key)
135+ hit? (w/button s {:key key :kind (or (:kind props) :normal)})]
136+ (record! n id)
137+ (when hit? (fire! n :on-click)))
138+
139+ :checkbox (let [was (boolean (:checked props))
140+ id (c/next-id key)
141+ now (w/checkbox was s {:key key})]
142+ (record! n id)
143+ (when (not= now was) (fire! n :on-change now)))
144+
145+ :slider (let [was (num (:value props) 0.0)
146+ id (c/next-id key)
147+ now (w/slider was {:key key
148+ :min (num (:min props) 0.0)
149+ :max (num (:max props) 100.0)})]
150+ ;; == and not not=, because a component holding a long 0 must
151+ ;; not be told every frame that its slider moved to 0.0
152+ (record! n id)
153+ (when-not (== now was) (fire! n :on-change now)))
154+
155+ (:entry :text-entry)
156+ (let [was (str (or (:value props) (:text props) ""))
157+ id (c/next-id key)
158+ now (w/text-entry was {:key key :placeholder (:placeholder props)})]
159+ (record! n id)
160+ (when (not= now was) (fire! n :on-change now)))
161+
162+ :progress (w/progress (num (:value props) 0.0))
163+ :separator (w/separator)
164+ (:spacer :gap) (w/spacer {:size (num (:size props) 8.0)
165+ :expand (:expand props :none)})
166+
167+ ;; An unknown tag is a container rather than an error, so a tree written
168+ ;; against a richer backend still shows its contents here — the same
169+ ;; bargain jolt-zvui makes with the tags it does not know.
170+ (c/box* (box-opts props key) (emit-children! n)))))
171+
172+;; --- the loop ----------------------------------------------------------------
173+
174+(defonce ^:private pending (atom []))
175+
176+(defn- schedule! [work] (swap! pending conj work) nil)
177+
178+(defn- drain-pending! []
179+ (let [[ws] (reset-vals! pending [])]
180+ (doseq [w ws] (w))))
181+
182+(defn- run!
183+ "glimmer.backend's :run. Creates the root page, mounts into it, then hands the
184+ loop to jvui.
185+
186+ The reconciler's queued work is drained by jvui's `:before` hook rather than
187+ inside the walk: a re-render patches the tree, and patching a tree while it
188+ is being walked is how a frame ends up half old and half new."
189+ [opts mount-root!]
190+ (let [{:keys [title width height max-width theme frames auto-quit-ms shot]
191+ :or {title "glimmer" width 720 height 520}} opts
192+ root (create! :page (cond-> {} max-width (assoc :max-width max-width)))]
193+ (mount-root! root :page)
194+ (reset! b/loop-running? true)
195+ (try
196+ (app/run! (fn [] (emit! root))
197+ {:title title :width width :height height
198+ :theme (or theme theme/dark)
199+ :before drain-pending!
200+ :frames frames :auto-quit-ms auto-quit-ms :shot shot})
201+ (finally (reset! b/loop-running? false)))))
202+
203+;; --- registration ------------------------------------------------------------
204+
205+(def backend
206+ {:name :jvui
207+ :create! create! :apply-props! apply-props!
208+ :append-child! append-child! :remove-child! remove-child!
209+ :replace-child! replace-child! :reorder-child! reorder-child!
210+ :schedule schedule! :run run!})
211+
212+(b/register! backend)
213+
214+;; --- headless driving, for tests ---------------------------------------------
215+
216+(defn root-node
217+ "A bare root page, for mounting into without a window."
218+ [] (create! :page {}))
219+
220+(defn render-once
221+ "Walk `root` through jvui with no window, no font and no display.
222+
223+ `cx` is a `jvui.core/context`; `evs` the events that frame. Answers the
224+ context, whose `:data` is every rectangle the walk placed — which is enough
225+ for a test to assert about a layout and to click on it."
226+ ([root cx] (render-once root cx []))
227+ ([root cx evs]
228+ (drain-pending!)
229+ (swap! cx assoc :events evs)
230+ (swap! cx c/apply-input evs)
231+ (binding [*record-rects?* true]
232+ (c/frame! cx (fn [] (emit! root))))
233+ cx))
added glimmer-backends/glimmer-jvui/test/glimmer_jvui/tests.clj +181 -0
new file mode 100644
@@ -0,0 +1,181 @@
1+(ns glimmer-jvui.tests
2+ "Every check here runs headless: no window, no SDL, no font, no display.
3+
4+ jvui takes its measurer as a function, so the whole stack — glimmer's
5+ reconciler, this backend's walk, jvui's layout and event routing — can be
6+ driven with a stub that says eight pixels a character. `jolt test`."
7+ (:require [glimmer.ratom :as ra]
8+ [glimmer.core :as gui]
9+ [glimmer-jvui.core :as jv]
10+ [jvui.core :as c]))
11+
12+(def ^:private failures (atom 0))
13+
14+(defn- check! [ok? msg]
15+ (when-not ok?
16+ (swap! failures inc)
17+ (println " FAIL:" msg)))
18+
19+(defn- ctx []
20+ (c/context {:size [400 300]
21+ :measure (fn [s _] [(* 8.0 (count s)) 16.0])
22+ :line-height (fn [_] 16.0)}))
23+
24+(defn- walk [n] (cons n (mapcat walk (:children @n))))
25+(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
26+(defn- labels [root]
27+ (map #(str (:label (:props @%)))
28+ (filter #(= :label (:tag @%)) (walk root))))
29+
30+(defn- centre
31+ "The middle of the rectangle jvui gave this node on the last walk."
32+ [n]
33+ (let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
34+
35+(defn- click-at [x y]
36+ [{:kind :motion :x x :y y}
37+ {:kind :mouse-down :x x :y y :button 1 :clicks 1}
38+ {:kind :mouse-up :x x :y y :button 1}])
39+
40+;; --- the reconciler reaches the backend --------------------------------------
41+
42+(def ^:private clicks (ra/atom 0))
43+(def ^:private on? (ra/atom false))
44+
45+(defn- app []
46+ [:card {}
47+ [:title {:label "Counter"}]
48+ [:label {:label (str "Count: " (ra/deref clicks))}]
49+ [:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
50+ [:checkbox {:label "loud" :checked (ra/deref on?)
51+ :on-change #(ra/reset! on? %)}]])
52+
53+(defn- check-tree! []
54+ (let [root (jv/root-node)]
55+ (gui/mount root :page [app])
56+ (check! (some? (tagged root :card)) "the reconciler built a card")
57+ (check! (some? (tagged root :button)) "and a button")
58+ (check! (some #{"Count: 0"} (labels root))
59+ "and a label that read the ratom")))
60+
61+(defn- check-walk-places-widgets! []
62+ (let [root (jv/root-node) cx (ctx)]
63+ (gui/mount root :page [app])
64+ (jv/render-once root cx)
65+ (let [placed (vals (:data @cx))
66+ card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
67+ placed))]
68+ (check! (some? card) "the walk placed a container with a rectangle")
69+ (check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
70+ (keep :rect placed))
71+ "and no rectangle came out negative"))))
72+
73+;; --- a click goes all the way round ------------------------------------------
74+
75+(defn- check-click-fires-the-handler! []
76+ (let [root (jv/root-node) cx (ctx)]
77+ (ra/reset! clicks 0)
78+ (gui/mount root :page [app])
79+ (jv/render-once root cx)
80+ (jv/render-once root cx)
81+ (let [before (ra/deref clicks)
82+ [bx by] (centre (tagged root :button))]
83+ (jv/render-once root cx (click-at bx by))
84+ (check! (= (inc before) (ra/deref clicks))
85+ (str "the click reached :on-click (" before " -> "
86+ (ra/deref clicks) ")"))
87+ (jv/render-once root cx)
88+ (check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
89+ "and the reactive re-render reached the tree"))))
90+
91+(defn- check-press-alone-is-not-a-click! []
92+ (let [root (jv/root-node) cx (ctx)]
93+ (ra/reset! clicks 0)
94+ (gui/mount root :page [app])
95+ (jv/render-once root cx)
96+ (jv/render-once root cx)
97+ (let [[bx by] (centre (tagged root :button))]
98+ (jv/render-once root cx [{:kind :motion :x bx :y by}
99+ {:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
100+ (check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
101+ (jv/render-once root cx [{:kind :motion :x 390 :y 290}
102+ {:kind :mouse-up :x 390 :y 290 :button 1}])
103+ (check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
104+
105+;; --- identity follows the node, not its index --------------------------------
106+
107+(defn- check-reorder-keeps-identity! []
108+ ;; The reason every node carries a serial as its jvui key. Render a list,
109+ ;; reorder it, and the ids the walk hands out must travel with the nodes.
110+ (let [root (jv/root-node) cx (ctx)
111+ items (ra/atom [:a :b :c])
112+ list-app (fn []
113+ (into [:vbox {}]
114+ (for [k (ra/deref items)]
115+ ^{:key k} [:button {:label (name k)}])))
116+ ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
117+ (filter #(= :button (:tag @%)) (walk root)))))]
118+ (gui/mount root :page [list-app])
119+ (jv/render-once root cx)
120+ (let [before (ids)]
121+ (ra/reset! items [:c :a :b])
122+ (jv/render-once root cx)
123+ (let [after (ids)]
124+ (check! (= 3 (count after)) "the list still has three buttons")
125+ (check! (= (get before "a") (get after "a"))
126+ "a keyed node keeps its jvui key across a reorder")
127+ (check! (= (get before "c") (get after "c"))
128+ "including the one that moved to the front")))))
129+
130+;; --- the vocabulary ----------------------------------------------------------
131+
132+(defn- check-unknown-tag-is-a-container! []
133+ (let [root (jv/root-node) cx (ctx)]
134+ (gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
135+ (jv/render-once root cx)
136+ (check! (some #{"inside"} (labels root))
137+ "an unknown tag shows its contents rather than raising")))
138+
139+(defn- check-entry-round-trips! []
140+ (let [root (jv/root-node) cx (ctx)
141+ text (ra/atom "")]
142+ (gui/mount root :page
143+ [(fn [] [:entry {:value (ra/deref text)
144+ :on-change #(ra/reset! text %)}])])
145+ (jv/render-once root cx)
146+ (let [[ex ey] (centre (tagged root :entry))]
147+ (jv/render-once root cx (click-at ex ey))) ; take focus
148+ (jv/render-once root cx [{:kind :text :text "hi"}])
149+ (check! (= "hi" (ra/deref text))
150+ (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
151+
152+(defn- check-checkbox-round-trips! []
153+ (let [root (jv/root-node) cx (ctx)]
154+ (ra/reset! on? false)
155+ (gui/mount root :page [app])
156+ (jv/render-once root cx)
157+ (jv/render-once root cx)
158+ (let [[bx by] (centre (tagged root :checkbox))]
159+ (jv/render-once root cx (click-at bx by)))
160+ (check! (true? (ra/deref on?))
161+ (str "the checkbox reached :on-change: " (ra/deref on?)))))
162+
163+;; --- runner ------------------------------------------------------------------
164+
165+(def ^:private checks
166+ [["the reconciler builds a tree" check-tree!]
167+ ["the walk places widgets" check-walk-places-widgets!]
168+ ["a click fires the handler" check-click-fires-the-handler!]
169+ ["a press alone does not" check-press-alone-is-not-a-click!]
170+ ["a reorder keeps identity" check-reorder-keeps-identity!]
171+ ["an unknown tag is a container" check-unknown-tag-is-a-container!]
172+ ["an entry round-trips" check-entry-round-trips!]
173+ ["a checkbox round-trips" check-checkbox-round-trips!]])
174+
175+(defn -main [& _]
176+ (doseq [[name f] checks]
177+ (println "-" name)
178+ (f))
179+ (if (zero? @failures)
180+ (println "\nall" (count checks) "checks passed")
181+ (do (println "\n" @failures "failed") (System/exit 1))))
new file mode 100644
@@ -0,0 +1,181 @@
1+(ns glimmer-jvui.tests
2+ "Every check here runs headless: no window, no SDL, no font, no display.
3+
4+ jvui takes its measurer as a function, so the whole stack — glimmer's
5+ reconciler, this backend's walk, jvui's layout and event routing — can be
6+ driven with a stub that says eight pixels a character. `jolt test`."
7+ (:require [glimmer.ratom :as ra]
8+ [glimmer.core :as gui]
9+ [glimmer-jvui.core :as jv]
10+ [jvui.core :as c]))
11+
12+(def ^:private failures (atom 0))
13+
14+(defn- check! [ok? msg]
15+ (when-not ok?
16+ (swap! failures inc)
17+ (println " FAIL:" msg)))
18+
19+(defn- ctx []
20+ (c/context {:size [400 300]
21+ :measure (fn [s _] [(* 8.0 (count s)) 16.0])
22+ :line-height (fn [_] 16.0)}))
23+
24+(defn- walk [n] (cons n (mapcat walk (:children @n))))
25+(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
26+(defn- labels [root]
27+ (map #(str (:label (:props @%)))
28+ (filter #(= :label (:tag @%)) (walk root))))
29+
30+(defn- centre
31+ "The middle of the rectangle jvui gave this node on the last walk."
32+ [n]
33+ (let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
34+
35+(defn- click-at [x y]
36+ [{:kind :motion :x x :y y}
37+ {:kind :mouse-down :x x :y y :button 1 :clicks 1}
38+ {:kind :mouse-up :x x :y y :button 1}])
39+
40+;; --- the reconciler reaches the backend --------------------------------------
41+
42+(def ^:private clicks (ra/atom 0))
43+(def ^:private on? (ra/atom false))
44+
45+(defn- app []
46+ [:card {}
47+ [:title {:label "Counter"}]
48+ [:label {:label (str "Count: " (ra/deref clicks))}]
49+ [:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
50+ [:checkbox {:label "loud" :checked (ra/deref on?)
51+ :on-change #(ra/reset! on? %)}]])
52+
53+(defn- check-tree! []
54+ (let [root (jv/root-node)]
55+ (gui/mount root :page [app])
56+ (check! (some? (tagged root :card)) "the reconciler built a card")
57+ (check! (some? (tagged root :button)) "and a button")
58+ (check! (some #{"Count: 0"} (labels root))
59+ "and a label that read the ratom")))
60+
61+(defn- check-walk-places-widgets! []
62+ (let [root (jv/root-node) cx (ctx)]
63+ (gui/mount root :page [app])
64+ (jv/render-once root cx)
65+ (let [placed (vals (:data @cx))
66+ card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
67+ placed))]
68+ (check! (some? card) "the walk placed a container with a rectangle")
69+ (check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
70+ (keep :rect placed))
71+ "and no rectangle came out negative"))))
72+
73+;; --- a click goes all the way round ------------------------------------------
74+
75+(defn- check-click-fires-the-handler! []
76+ (let [root (jv/root-node) cx (ctx)]
77+ (ra/reset! clicks 0)
78+ (gui/mount root :page [app])
79+ (jv/render-once root cx)
80+ (jv/render-once root cx)
81+ (let [before (ra/deref clicks)
82+ [bx by] (centre (tagged root :button))]
83+ (jv/render-once root cx (click-at bx by))
84+ (check! (= (inc before) (ra/deref clicks))
85+ (str "the click reached :on-click (" before " -> "
86+ (ra/deref clicks) ")"))
87+ (jv/render-once root cx)
88+ (check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
89+ "and the reactive re-render reached the tree"))))
90+
91+(defn- check-press-alone-is-not-a-click! []
92+ (let [root (jv/root-node) cx (ctx)]
93+ (ra/reset! clicks 0)
94+ (gui/mount root :page [app])
95+ (jv/render-once root cx)
96+ (jv/render-once root cx)
97+ (let [[bx by] (centre (tagged root :button))]
98+ (jv/render-once root cx [{:kind :motion :x bx :y by}
99+ {:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
100+ (check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
101+ (jv/render-once root cx [{:kind :motion :x 390 :y 290}
102+ {:kind :mouse-up :x 390 :y 290 :button 1}])
103+ (check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
104+
105+;; --- identity follows the node, not its index --------------------------------
106+
107+(defn- check-reorder-keeps-identity! []
108+ ;; The reason every node carries a serial as its jvui key. Render a list,
109+ ;; reorder it, and the ids the walk hands out must travel with the nodes.
110+ (let [root (jv/root-node) cx (ctx)
111+ items (ra/atom [:a :b :c])
112+ list-app (fn []
113+ (into [:vbox {}]
114+ (for [k (ra/deref items)]
115+ ^{:key k} [:button {:label (name k)}])))
116+ ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
117+ (filter #(= :button (:tag @%)) (walk root)))))]
118+ (gui/mount root :page [list-app])
119+ (jv/render-once root cx)
120+ (let [before (ids)]
121+ (ra/reset! items [:c :a :b])
122+ (jv/render-once root cx)
123+ (let [after (ids)]
124+ (check! (= 3 (count after)) "the list still has three buttons")
125+ (check! (= (get before "a") (get after "a"))
126+ "a keyed node keeps its jvui key across a reorder")
127+ (check! (= (get before "c") (get after "c"))
128+ "including the one that moved to the front")))))
129+
130+;; --- the vocabulary ----------------------------------------------------------
131+
132+(defn- check-unknown-tag-is-a-container! []
133+ (let [root (jv/root-node) cx (ctx)]
134+ (gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
135+ (jv/render-once root cx)
136+ (check! (some #{"inside"} (labels root))
137+ "an unknown tag shows its contents rather than raising")))
138+
139+(defn- check-entry-round-trips! []
140+ (let [root (jv/root-node) cx (ctx)
141+ text (ra/atom "")]
142+ (gui/mount root :page
143+ [(fn [] [:entry {:value (ra/deref text)
144+ :on-change #(ra/reset! text %)}])])
145+ (jv/render-once root cx)
146+ (let [[ex ey] (centre (tagged root :entry))]
147+ (jv/render-once root cx (click-at ex ey))) ; take focus
148+ (jv/render-once root cx [{:kind :text :text "hi"}])
149+ (check! (= "hi" (ra/deref text))
150+ (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
151+
152+(defn- check-checkbox-round-trips! []
153+ (let [root (jv/root-node) cx (ctx)]
154+ (ra/reset! on? false)
155+ (gui/mount root :page [app])
156+ (jv/render-once root cx)
157+ (jv/render-once root cx)
158+ (let [[bx by] (centre (tagged root :checkbox))]
159+ (jv/render-once root cx (click-at bx by)))
160+ (check! (true? (ra/deref on?))
161+ (str "the checkbox reached :on-change: " (ra/deref on?)))))
162+
163+;; --- runner ------------------------------------------------------------------
164+
165+(def ^:private checks
166+ [["the reconciler builds a tree" check-tree!]
167+ ["the walk places widgets" check-walk-places-widgets!]
168+ ["a click fires the handler" check-click-fires-the-handler!]
169+ ["a press alone does not" check-press-alone-is-not-a-click!]
170+ ["a reorder keeps identity" check-reorder-keeps-identity!]
171+ ["an unknown tag is a container" check-unknown-tag-is-a-container!]
172+ ["an entry round-trips" check-entry-round-trips!]
173+ ["a checkbox round-trips" check-checkbox-round-trips!]])
174+
175+(defn -main [& _]
176+ (doseq [[name f] checks]
177+ (println "-" name)
178+ (f))
179+ (if (zero? @failures)
180+ (println "\nall" (count checks) "checks passed")
181+ (do (println "\n" @failures "failed") (System/exit 1))))
added jvui/README.md +158 -0
new file mode 100644
@@ -0,0 +1,158 @@
1+# jvui
2+
3+An immediate-mode GUI toolkit in the shape of
4+[dvui](https://github.com/david-vanderson/dvui), written in **jolt**, calling
5+**SDL3** directly.
6+
7+There is no shared object here and nothing in this directory is compiled. The
8+layout, the widget identity, the event routing and every widget are jolt;
9+`jolt.ffi` binds libSDL3 and libSDL3_ttf the way [glimmer-gfx](../glimmer-backends/glimmer-gfx)
10+binds Xlib.
11+
12+```clojure
13+(ns myapp
14+ (:require [jvui.app :as app] [jvui.widgets :as w]))
15+
16+(def n (atom 0))
17+
18+(defn render []
19+ (w/page {:max-width 420}
20+ (w/card {}
21+ (w/title "Counter")
22+ (w/label (str "Count: " @n))
23+ (w/hbox {:spacing 8}
24+ (when (w/button "- 1") (swap! n dec))
25+ (when (w/button "+ 1" {:kind :primary}) (swap! n inc))))))
26+
27+(defn -main [& _] (app/run! render {:title "counter"}))
28+```
29+
30+You call a widget and what it answers is what the person did. There is no
31+widget object to hold, no handler to register and nothing to free — a button
32+that is not called this frame is not on the screen, which is what the whole
33+style is for.
34+
35+## Running
36+
37+```bash
38+jolt test # headless: no window, no display, no SDL
39+jolt counter # a window
40+jolt showcase # every widget on one page
41+jolt showcase --shot # three frames, then a BMP in /tmp
42+```
43+
44+SDL3 and SDL3_ttf are *system* libraries here, not this repo's crates, and they
45+must be ones the jolt binary can load — on a nix-built jolt the host
46+`/usr/lib` copies are a different glibc and fail before `dlopen` returns. Any
47+of the usual system faces is found automatically; `JVUI_FONT` names another.
48+
49+## Why this is not a fourth backend
50+
51+`crates/jolt-vidya`, `crates/jolt-tui` and `zig/jolt-zvui` all export the same
52+retained-tree ABI: a tree the caller mutates between frames, one call that
53+walks it, a queue of what the person did. That design puts the widget
54+vocabulary *in* the native object, which is what makes those three
55+interchangeable — and what means a new widget is a Rust or Zig change.
56+
57+jvui inverts it. jolt owns the tree, the layout and the widgets; SDL owns a
58+window, an event pump, a rectangle and a glyph. A new widget is a function in
59+[`src/jvui/widgets.clj`](src/jvui/widgets.clj), and nothing under it has to
60+know.
61+
62+ src/jvui/sdl.clj SDL3 and SDL3_ttf; the entire foreign surface
63+ src/jvui/paint.clj rectangles, rounded corners, text
64+ src/jvui/font.clj one face, some sizes, two caches
65+ src/jvui/core.clj identity, layout, event routing, the frame loop
66+ src/jvui/widgets.clj the widgets
67+ src/jvui/theme.clj colours and metrics, in one map
68+ src/jvui/app.clj open a window and drive it
69+
70+## How a one-pass layout knows a size it has not measured yet
71+
72+An immediate-mode toolkit walks the tree once and must place a container before
73+it has seen the container's children. dvui's answer, kept here, is to remember:
74+every widget stores the size it turned out to need under a stable id, and the
75+*next* frame uses that number. A leaf knows its own size at once — a label
76+measures its string — so only containers lag, and they lag exactly one frame.
77+
78+`core/frame!` closes that gap before anything reaches the screen. When a stored
79+size changes it walks again, up to three times, drawing nothing and delivering
80+no events, and only the settled pass paints. So a new page appears laid out,
81+not laid out on its second frame, and a click cannot be eaten by a pass whose
82+output was thrown away. Once the layout stops moving the extra walks stop too,
83+which is almost every frame.
84+
85+An id is a hash of its parent's id and the widget's index among its siblings —
86+or of the parent and a `:key`, which *replaces* the index rather than joining
87+it. No macro, no call-site capture. Replacing is the whole point: a list that
88+reorders gives every widget after the moved one a new index, and a key that
89+still carried the index would do nothing to stop each of them inheriting the
90+caret, the scroll offset and the drag of whichever widget used to sit there.
91+That is the bug class zvui's README describes from the other side, and
92+`jolt test` reorders a list and checks it.
93+
94+## Two numbers that decided the design
95+
96+Both were measured here, and both sent the obvious approach back.
97+
98+**A foreign call costs 0.2 µs; `ffi/write-array` costs 0.6 µs per element.**
99+The first draft of `paint.clj` batched everything into a packed `SDL_Vertex`
100+buffer and issued one `SDL_RenderGeometry` per frame, which is how dvui's own
101+backends do it. Filling that buffer from jolt costs six milliseconds for a few
102+thousand vertices — the crossing was never the problem, the copy was. So the
103+unit here is the call, not the vertex: a rectangle is one
104+`SDL_RenderFillRect` (about 3 µs end to end) and text is one blit of a cached
105+texture. A rounded rectangle is three rectangles plus four blits from a single
106+antialiased white disc uploaded at startup, tinted by colour-mod — which is
107+also why nothing here needs a tessellator.
108+
109+**`swap!` costs 4 µs.** The layout walk touches a box's running counters once
110+per widget, and with those counters living in the context map a page of a
111+hundred widgets spent most of a frame re-associng numbers no one else could
112+see. They are now a five-slot `double-array` per box: written by one walker, in
113+order, dead at the end of the frame. That one change took a label from 35 µs to
114+5 µs and the showcase page from 8.7 ms a frame to 4.4.
115+
116+What is left is honest: about 5 µs per label and 20 µs per interactive widget,
117+so a page of forty widgets is a millisecond or two of jolt per frame. The
118+showcase, with a fifty-row scroll list, is 4.4 ms. That is a toolkit, not a
119+slideshow, but it is also the ceiling — the remaining cost is `swap!` in the
120+event and state paths, and it would come down the same way the counters did.
121+
122+## Using it under glimmer
123+
124+[`../glimmer-backends/glimmer-jvui`](../glimmer-backends/glimmer-jvui) is a
125+glimmer backend over this: the reconciler's retained tree is thirty lines of
126+atoms, and a walk over it calls the widgets below. It is the smallest of
127+glimmer's four backends, because the toolkit it needs already exists here.
128+
129+## The vocabulary
130+
131+Containers, all macros over `core/box*`: `box` `vbox` `hbox` `card` `page`
132+`scroll`.
133+
134+Widgets: `label` `title` `dim-label` `button` `checkbox` `slider` `progress`
135+`text-entry` `separator` `spacer`.
136+
137+Options a container takes: `:dir` `:spacing` `:padding` `:margin` `:expand`
138+`:gravity` `:key` `:fill` `:border` `:radius` `:min-size` `:clip?` `:offset`
139+`:fixed`. `:expand` is `:none` `:horizontal` `:vertical` `:both` and
140+`:gravity` is `[gx gy]`, each 0..1, placing a widget in whatever space it did
141+not take.
142+
143+Events reaching a widget: hover, press, click, drag through capture, focus,
144+Tab and shift-Tab, typed text, the editing keys, and the wheel.
145+
146+## Not done
147+
148+* **One font, one style.** No bold, no italic, no per-run font. `font.clj`
149+ opens one face at whatever sizes are asked for.
150+* **No text selection** and no clipboard in `text-entry`, though
151+ `sdl/clipboard` and `sdl/clipboard!` are bound and waiting.
152+* **Vertical scrolling only.** `scroll` clips both axes and scrolls one.
153+* **No animation clock**, so no transitions and no cursor blink — the frame
154+ loop runs at a fixed 16 ms and does not know what time it is.
155+* **No menus, no dialogs, no floating layers.** Everything is in one
156+ painter-ordered pass, and a popup needs a second one.
157+* **`:gravity`'s cross axis is honoured; `:align` on text is `:left`
158+ `:center` `:right` and nothing else.**
new file mode 100644
@@ -0,0 +1,158 @@
1+# jvui
2+
3+An immediate-mode GUI toolkit in the shape of
4+[dvui](https://github.com/david-vanderson/dvui), written in **jolt**, calling
5+**SDL3** directly.
6+
7+There is no shared object here and nothing in this directory is compiled. The
8+layout, the widget identity, the event routing and every widget are jolt;
9+`jolt.ffi` binds libSDL3 and libSDL3_ttf the way [glimmer-gfx](../glimmer-backends/glimmer-gfx)
10+binds Xlib.
11+
12+```clojure
13+(ns myapp
14+ (:require [jvui.app :as app] [jvui.widgets :as w]))
15+
16+(def n (atom 0))
17+
18+(defn render []
19+ (w/page {:max-width 420}
20+ (w/card {}
21+ (w/title "Counter")
22+ (w/label (str "Count: " @n))
23+ (w/hbox {:spacing 8}
24+ (when (w/button "- 1") (swap! n dec))
25+ (when (w/button "+ 1" {:kind :primary}) (swap! n inc))))))
26+
27+(defn -main [& _] (app/run! render {:title "counter"}))
28+```
29+
30+You call a widget and what it answers is what the person did. There is no
31+widget object to hold, no handler to register and nothing to free — a button
32+that is not called this frame is not on the screen, which is what the whole
33+style is for.
34+
35+## Running
36+
37+```bash
38+jolt test # headless: no window, no display, no SDL
39+jolt counter # a window
40+jolt showcase # every widget on one page
41+jolt showcase --shot # three frames, then a BMP in /tmp
42+```
43+
44+SDL3 and SDL3_ttf are *system* libraries here, not this repo's crates, and they
45+must be ones the jolt binary can load — on a nix-built jolt the host
46+`/usr/lib` copies are a different glibc and fail before `dlopen` returns. Any
47+of the usual system faces is found automatically; `JVUI_FONT` names another.
48+
49+## Why this is not a fourth backend
50+
51+`crates/jolt-vidya`, `crates/jolt-tui` and `zig/jolt-zvui` all export the same
52+retained-tree ABI: a tree the caller mutates between frames, one call that
53+walks it, a queue of what the person did. That design puts the widget
54+vocabulary *in* the native object, which is what makes those three
55+interchangeable — and what means a new widget is a Rust or Zig change.
56+
57+jvui inverts it. jolt owns the tree, the layout and the widgets; SDL owns a
58+window, an event pump, a rectangle and a glyph. A new widget is a function in
59+[`src/jvui/widgets.clj`](src/jvui/widgets.clj), and nothing under it has to
60+know.
61+
62+ src/jvui/sdl.clj SDL3 and SDL3_ttf; the entire foreign surface
63+ src/jvui/paint.clj rectangles, rounded corners, text
64+ src/jvui/font.clj one face, some sizes, two caches
65+ src/jvui/core.clj identity, layout, event routing, the frame loop
66+ src/jvui/widgets.clj the widgets
67+ src/jvui/theme.clj colours and metrics, in one map
68+ src/jvui/app.clj open a window and drive it
69+
70+## How a one-pass layout knows a size it has not measured yet
71+
72+An immediate-mode toolkit walks the tree once and must place a container before
73+it has seen the container's children. dvui's answer, kept here, is to remember:
74+every widget stores the size it turned out to need under a stable id, and the
75+*next* frame uses that number. A leaf knows its own size at once — a label
76+measures its string — so only containers lag, and they lag exactly one frame.
77+
78+`core/frame!` closes that gap before anything reaches the screen. When a stored
79+size changes it walks again, up to three times, drawing nothing and delivering
80+no events, and only the settled pass paints. So a new page appears laid out,
81+not laid out on its second frame, and a click cannot be eaten by a pass whose
82+output was thrown away. Once the layout stops moving the extra walks stop too,
83+which is almost every frame.
84+
85+An id is a hash of its parent's id and the widget's index among its siblings —
86+or of the parent and a `:key`, which *replaces* the index rather than joining
87+it. No macro, no call-site capture. Replacing is the whole point: a list that
88+reorders gives every widget after the moved one a new index, and a key that
89+still carried the index would do nothing to stop each of them inheriting the
90+caret, the scroll offset and the drag of whichever widget used to sit there.
91+That is the bug class zvui's README describes from the other side, and
92+`jolt test` reorders a list and checks it.
93+
94+## Two numbers that decided the design
95+
96+Both were measured here, and both sent the obvious approach back.
97+
98+**A foreign call costs 0.2 µs; `ffi/write-array` costs 0.6 µs per element.**
99+The first draft of `paint.clj` batched everything into a packed `SDL_Vertex`
100+buffer and issued one `SDL_RenderGeometry` per frame, which is how dvui's own
101+backends do it. Filling that buffer from jolt costs six milliseconds for a few
102+thousand vertices — the crossing was never the problem, the copy was. So the
103+unit here is the call, not the vertex: a rectangle is one
104+`SDL_RenderFillRect` (about 3 µs end to end) and text is one blit of a cached
105+texture. A rounded rectangle is three rectangles plus four blits from a single
106+antialiased white disc uploaded at startup, tinted by colour-mod — which is
107+also why nothing here needs a tessellator.
108+
109+**`swap!` costs 4 µs.** The layout walk touches a box's running counters once
110+per widget, and with those counters living in the context map a page of a
111+hundred widgets spent most of a frame re-associng numbers no one else could
112+see. They are now a five-slot `double-array` per box: written by one walker, in
113+order, dead at the end of the frame. That one change took a label from 35 µs to
114+5 µs and the showcase page from 8.7 ms a frame to 4.4.
115+
116+What is left is honest: about 5 µs per label and 20 µs per interactive widget,
117+so a page of forty widgets is a millisecond or two of jolt per frame. The
118+showcase, with a fifty-row scroll list, is 4.4 ms. That is a toolkit, not a
119+slideshow, but it is also the ceiling — the remaining cost is `swap!` in the
120+event and state paths, and it would come down the same way the counters did.
121+
122+## Using it under glimmer
123+
124+[`../glimmer-backends/glimmer-jvui`](../glimmer-backends/glimmer-jvui) is a
125+glimmer backend over this: the reconciler's retained tree is thirty lines of
126+atoms, and a walk over it calls the widgets below. It is the smallest of
127+glimmer's four backends, because the toolkit it needs already exists here.
128+
129+## The vocabulary
130+
131+Containers, all macros over `core/box*`: `box` `vbox` `hbox` `card` `page`
132+`scroll`.
133+
134+Widgets: `label` `title` `dim-label` `button` `checkbox` `slider` `progress`
135+`text-entry` `separator` `spacer`.
136+
137+Options a container takes: `:dir` `:spacing` `:padding` `:margin` `:expand`
138+`:gravity` `:key` `:fill` `:border` `:radius` `:min-size` `:clip?` `:offset`
139+`:fixed`. `:expand` is `:none` `:horizontal` `:vertical` `:both` and
140+`:gravity` is `[gx gy]`, each 0..1, placing a widget in whatever space it did
141+not take.
142+
143+Events reaching a widget: hover, press, click, drag through capture, focus,
144+Tab and shift-Tab, typed text, the editing keys, and the wheel.
145+
146+## Not done
147+
148+* **One font, one style.** No bold, no italic, no per-run font. `font.clj`
149+ opens one face at whatever sizes are asked for.
150+* **No text selection** and no clipboard in `text-entry`, though
151+ `sdl/clipboard` and `sdl/clipboard!` are bound and waiting.
152+* **Vertical scrolling only.** `scroll` clips both axes and scrolls one.
153+* **No animation clock**, so no transitions and no cursor blink — the frame
154+ loop runs at a fixed 16 ms and does not know what time it is.
155+* **No menus, no dialogs, no floating layers.** Everything is in one
156+ painter-ordered pass, and a popup needs a second one.
157+* **`:gravity`'s cross axis is honoured; `:align` on text is `:left`
158+ `:center` `:right` and nothing else.**
added jvui/deps.edn +23 -0
new file mode 100644
@@ -0,0 +1,23 @@
1+{:paths ["src"]
2+
3+ ;; jvui has no dependencies. It is not a glimmer backend — there is no
4+ ;; reconciler here and no tree to patch — it is an immediate-mode toolkit in
5+ ;; the shape of dvui, written in jolt, calling SDL3 directly.
6+ ;;
7+ ;; Both libraries are *system* libraries, like glimmer-gfx's Xlib and unlike
8+ ;; this repo's own crates: they must be ones the jolt binary can load, and on
9+ ;; a nix-built jolt the host /usr/lib copies are a different glibc and fail
10+ ;; before dlopen returns. :optional so the layout tests, which open no window,
11+ ;; run on a machine with neither installed.
12+ :jolt/native [{:name "SDL3" :optional true
13+ :linux ["libSDL3.so.0"] :darwin ["libSDL3.0.dylib"]}
14+ {:name "SDL3_ttf" :optional true
15+ :linux ["libSDL3_ttf.so.0"] :darwin ["libSDL3_ttf.0.dylib"]}]
16+
17+ :aliases {:test {:extra-paths ["test"] :main-opts ["-m" "jvui.tests"]}
18+ :counter {:extra-paths ["examples"] :main-opts ["-m" "jvui.counter"]}
19+ :showcase {:extra-paths ["examples"] :main-opts ["-m" "jvui.showcase"]}}
20+
21+ :tasks {test "jolt -M:test"
22+ counter "jolt -M:counter"
23+ showcase "jolt -M:showcase"}}
new file mode 100644
@@ -0,0 +1,23 @@
1+{:paths ["src"]
2+
3+ ;; jvui has no dependencies. It is not a glimmer backend — there is no
4+ ;; reconciler here and no tree to patch — it is an immediate-mode toolkit in
5+ ;; the shape of dvui, written in jolt, calling SDL3 directly.
6+ ;;
7+ ;; Both libraries are *system* libraries, like glimmer-gfx's Xlib and unlike
8+ ;; this repo's own crates: they must be ones the jolt binary can load, and on
9+ ;; a nix-built jolt the host /usr/lib copies are a different glibc and fail
10+ ;; before dlopen returns. :optional so the layout tests, which open no window,
11+ ;; run on a machine with neither installed.
12+ :jolt/native [{:name "SDL3" :optional true
13+ :linux ["libSDL3.so.0"] :darwin ["libSDL3.0.dylib"]}
14+ {:name "SDL3_ttf" :optional true
15+ :linux ["libSDL3_ttf.so.0"] :darwin ["libSDL3_ttf.0.dylib"]}]
16+
17+ :aliases {:test {:extra-paths ["test"] :main-opts ["-m" "jvui.tests"]}
18+ :counter {:extra-paths ["examples"] :main-opts ["-m" "jvui.counter"]}
19+ :showcase {:extra-paths ["examples"] :main-opts ["-m" "jvui.showcase"]}}
20+
21+ :tasks {test "jolt -M:test"
22+ counter "jolt -M:counter"
23+ showcase "jolt -M:showcase"}}
added jvui/examples/jvui/counter.clj +25 -0
new file mode 100644
@@ -0,0 +1,25 @@
1+(ns jvui.counter
2+ "The smallest thing that shows the calling convention: state is an atom the
3+ caller owns, and a widget answers what the person did to it."
4+ (:require [jvui.app :as app]
5+ [jvui.core :as c]
6+ [jvui.widgets :as w]))
7+
8+(def n (atom 0))
9+(def loud? (atom false))
10+
11+(defn render []
12+ (w/page {:max-width 420}
13+ (w/card {}
14+ (w/title "Counter")
15+ (w/label (str "Count: " @n (when @loud? "!")))
16+ (w/hbox {:spacing 8}
17+ (when (w/button "- 1") (swap! n dec))
18+ (when (w/button "+ 1" {:kind :primary}) (swap! n inc))
19+ (when (w/button "reset") (reset! n 0)))
20+ (w/separator)
21+ (reset! loud? (w/checkbox @loud? "Exclaim")))))
22+
23+(defn -main [& args]
24+ (app/run! render (cond-> {:title "counter"}
25+ (some #{"--shot"} args) (assoc :frames 3 :shot "/tmp/jvui-counter.bmp"))))
new file mode 100644
@@ -0,0 +1,25 @@
1+(ns jvui.counter
2+ "The smallest thing that shows the calling convention: state is an atom the
3+ caller owns, and a widget answers what the person did to it."
4+ (:require [jvui.app :as app]
5+ [jvui.core :as c]
6+ [jvui.widgets :as w]))
7+
8+(def n (atom 0))
9+(def loud? (atom false))
10+
11+(defn render []
12+ (w/page {:max-width 420}
13+ (w/card {}
14+ (w/title "Counter")
15+ (w/label (str "Count: " @n (when @loud? "!")))
16+ (w/hbox {:spacing 8}
17+ (when (w/button "- 1") (swap! n dec))
18+ (when (w/button "+ 1" {:kind :primary}) (swap! n inc))
19+ (when (w/button "reset") (reset! n 0)))
20+ (w/separator)
21+ (reset! loud? (w/checkbox @loud? "Exclaim")))))
22+
23+(defn -main [& args]
24+ (app/run! render (cond-> {:title "counter"}
25+ (some #{"--shot"} args) (assoc :frames 3 :shot "/tmp/jvui-counter.bmp"))))
added jvui/examples/jvui/showcase.clj +67 -0
new file mode 100644
@@ -0,0 +1,67 @@
1+(ns jvui.showcase
2+ "Every widget jvui has, on one page, so a change to any of them can be looked
3+ at rather than reasoned about.
4+
5+ jolt showcase a window
6+ jolt showcase --shot three frames and a BMP in /tmp"
7+ (:require [jvui.app :as app]
8+ [jvui.core :as c]
9+ [jvui.theme :as theme]
10+ [jvui.widgets :as w]))
11+
12+(def state
13+ (atom {:count 0
14+ :name ""
15+ :volume 0.35
16+ :agreed? false
17+ :dark? true
18+ :rows 24}))
19+
20+(defn- controls []
21+ (w/card {}
22+ (w/title "Controls")
23+ (w/hbox {:spacing 8}
24+ (w/label (str "Count: " (:count @state)) {:expand :horizontal})
25+ (when (w/button "-") (swap! state update :count dec))
26+ (when (w/button "+" {:kind :primary}) (swap! state update :count inc)))
27+ (w/separator)
28+ (w/label "Name" {:colour (c/th :text-dim)})
29+ (swap! state assoc :name
30+ (w/text-entry (:name @state) {:placeholder "type here"}))
31+ (w/dim-label (if (= "" (:name @state))
32+ "nobody yet"
33+ (str "hello, " (:name @state))))
34+ (w/separator)
35+ (w/hbox {:spacing 8}
36+ (w/label "Volume" {:expand :none})
37+ (swap! state assoc :volume
38+ (w/slider (:volume @state) {:expand :horizontal :min 0.0 :max 1.0}))
39+ (w/label (format "%3d%%" (int (* 100 (:volume @state)))) {:expand :none}))
40+ (w/progress (:volume @state))
41+ (w/separator)
42+ (swap! state assoc :agreed? (w/checkbox (:agreed? @state) "I agree to nothing"))
43+ (swap! state assoc :dark? (w/checkbox (:dark? @state) "Dark theme"))))
44+
45+(defn- feed []
46+ (w/card {}
47+ (w/title "A viewport")
48+ (w/dim-label "the wheel scrolls it; the bar says where you are")
49+ (w/scroll {:height 160}
50+ (doseq [i (range (:rows @state))]
51+ (w/hbox {:spacing 8}
52+ (w/label (format "%02d" i) {:expand :none :colour (c/th :text-dim)})
53+ (w/label (str "row " i " — clipped by the viewport, not by luck")
54+ {:expand :horizontal}))))))
55+
56+(defn render []
57+ (swap! c/*ui* assoc :theme (if (:dark? @state) theme/dark theme/light))
58+ (w/page {:max-width 560}
59+ (controls)
60+ (feed)
61+ (w/spacer {:expand :vertical})
62+ (w/dim-label "jvui — dvui's shape, in jolt, on SDL3" {:align :center})))
63+
64+(defn -main [& args]
65+ (app/run! render (cond-> {:title "jvui showcase" :width 720 :height 620}
66+ (some #{"--shot"} args)
67+ (assoc :frames 3 :shot "/tmp/jvui-showcase.bmp"))))
new file mode 100644
@@ -0,0 +1,67 @@
1+(ns jvui.showcase
2+ "Every widget jvui has, on one page, so a change to any of them can be looked
3+ at rather than reasoned about.
4+
5+ jolt showcase a window
6+ jolt showcase --shot three frames and a BMP in /tmp"
7+ (:require [jvui.app :as app]
8+ [jvui.core :as c]
9+ [jvui.theme :as theme]
10+ [jvui.widgets :as w]))
11+
12+(def state
13+ (atom {:count 0
14+ :name ""
15+ :volume 0.35
16+ :agreed? false
17+ :dark? true
18+ :rows 24}))
19+
20+(defn- controls []
21+ (w/card {}
22+ (w/title "Controls")
23+ (w/hbox {:spacing 8}
24+ (w/label (str "Count: " (:count @state)) {:expand :horizontal})
25+ (when (w/button "-") (swap! state update :count dec))
26+ (when (w/button "+" {:kind :primary}) (swap! state update :count inc)))
27+ (w/separator)
28+ (w/label "Name" {:colour (c/th :text-dim)})
29+ (swap! state assoc :name
30+ (w/text-entry (:name @state) {:placeholder "type here"}))
31+ (w/dim-label (if (= "" (:name @state))
32+ "nobody yet"
33+ (str "hello, " (:name @state))))
34+ (w/separator)
35+ (w/hbox {:spacing 8}
36+ (w/label "Volume" {:expand :none})
37+ (swap! state assoc :volume
38+ (w/slider (:volume @state) {:expand :horizontal :min 0.0 :max 1.0}))
39+ (w/label (format "%3d%%" (int (* 100 (:volume @state)))) {:expand :none}))
40+ (w/progress (:volume @state))
41+ (w/separator)
42+ (swap! state assoc :agreed? (w/checkbox (:agreed? @state) "I agree to nothing"))
43+ (swap! state assoc :dark? (w/checkbox (:dark? @state) "Dark theme"))))
44+
45+(defn- feed []
46+ (w/card {}
47+ (w/title "A viewport")
48+ (w/dim-label "the wheel scrolls it; the bar says where you are")
49+ (w/scroll {:height 160}
50+ (doseq [i (range (:rows @state))]
51+ (w/hbox {:spacing 8}
52+ (w/label (format "%02d" i) {:expand :none :colour (c/th :text-dim)})
53+ (w/label (str "row " i " — clipped by the viewport, not by luck")
54+ {:expand :horizontal}))))))
55+
56+(defn render []
57+ (swap! c/*ui* assoc :theme (if (:dark? @state) theme/dark theme/light))
58+ (w/page {:max-width 560}
59+ (controls)
60+ (feed)
61+ (w/spacer {:expand :vertical})
62+ (w/dim-label "jvui — dvui's shape, in jolt, on SDL3" {:align :center})))
63+
64+(defn -main [& args]
65+ (app/run! render (cond-> {:title "jvui showcase" :width 720 :height 620}
66+ (some #{"--shot"} args)
67+ (assoc :frames 3 :shot "/tmp/jvui-showcase.bmp"))))
added jvui/src/jvui/app.clj +101 -0
new file mode 100644
@@ -0,0 +1,101 @@
1+(ns jvui.app
2+ "The frame loop: open a window, walk the UI once per frame, present.
3+
4+ The loop is here rather than in `jvui.core` because core does not know that
5+ SDL exists — which is what lets the layout tests walk the same widgets with
6+ no window, no font and no display."
7+ (:require [jvui.sdl :as sdl]
8+ [jvui.font :as font]
9+ [jvui.paint :as paint]
10+ [jvui.theme :as theme]
11+ [jvui.core :as c]))
12+
13+(defn context
14+ "A live context over an open window."
15+ [{:keys [renderer window size theme fonts]}]
16+ (let [painter (paint/painter renderer fonts)]
17+ (atom {:size size :theme (or theme theme/dark)
18+ :renderer renderer :window window :fonts fonts
19+ :painter painter
20+ :measure (fn [s sz] (font/size-of fonts s sz))
21+ :line-height (fn [sz] (font/line-height fonts sz))
22+ :draw? false
23+ :data {} :events [] :handled #{} :stack []
24+ :mouse [-1 -1] :mouse-down? false
25+ :focus nil :capture nil :focusables []
26+ :settled? false :quit? false})))
27+
28+(defn- scale-events
29+ "Put pointer coordinates into the same units the layout is in.
30+
31+ SDL reports events in window units and draws in pixels, and on a display
32+ with a scale factor those are not the same number. Everything above this
33+ line works in pixels, so the conversion happens once, here, rather than in
34+ every hit test."
35+ [evs sx sy]
36+ (if (and (== sx 1.0) (== sy 1.0))
37+ evs
38+ (mapv (fn [e]
39+ (cond-> e
40+ (:x e) (assoc :x (* sx (:x e)))
41+ (:y e) (assoc :y (* sy (:y e)))))
42+ evs)))
43+
44+(defn run!
45+ "Open a window and run `render` once per frame until it closes.
46+
47+ `render` is a thunk: it calls widgets, and what they answer is what the
48+ person did. Options: :title :width :height :theme :frames :auto-quit-ms.
49+
50+ :before is a thunk run once per frame, before the walk. A caller with a tree
51+ to patch — glimmer's reconciler is the one — needs somewhere to do it that is
52+ not *during* a walk of that tree, and this is it.
53+
54+ :frames and :auto-quit-ms exist for the same reason glimmer-gfx's do — so a
55+ smoke test can paint a real window and then leave, without a person in front
56+ of it."
57+ [render {:keys [title width height theme frames auto-quit-ms shot before]
58+ :or {title "jvui" width 720 height 520}}]
59+ (let [path (font/find-font)]
60+ (when-not path
61+ (throw (ex-info "no system font found; set JVUI_FONT to a .ttf" {})))
62+ (let [{:keys [window renderer] :as win} (sdl/open! {:title title
63+ :width width
64+ :height height})
65+ fonts (font/open path)
66+ ctx (context {:renderer renderer :window window :fonts fonts
67+ :size (sdl/output-size renderer)
68+ :theme (or theme theme/dark)})
69+ painter (:painter @ctx)
70+ deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
71+ (sdl/start-text-input! window)
72+ (try
73+ (loop [n 0]
74+ (let [[ow oh] (sdl/output-size renderer)
75+ [ww wh] (sdl/window-size window)
76+ evs (scale-events (sdl/drain!)
77+ (if (pos? ww) (/ (double ow) ww) 1.0)
78+ (if (pos? wh) (/ (double oh) wh) 1.0))]
79+ (swap! ctx (fn [s] (-> s (assoc :events evs)
80+ (assoc :size [ow oh]))))
81+ (swap! ctx c/apply-input evs)
82+ (when before (before))
83+ (let [[br bg bb ba] (get (:theme @ctx) :bg)]
84+ (sdl/draw-color! renderer br bg bb ba)
85+ (sdl/clear! renderer))
86+ (c/frame! ctx render)
87+ (paint/flush! painter)
88+ (sdl/clip! renderer nil)
89+ (swap! painter assoc :clip nil)
90+ (when (and shot frames (= (inc n) frames))
91+ (sdl/save-screenshot! renderer shot))
92+ (sdl/present! renderer)
93+ (sdl/delay-ms! 16)
94+ (when-not (or (:quit? @ctx)
95+ (and frames (>= (inc n) frames))
96+ (and deadline (> (System/currentTimeMillis) deadline)))
97+ (recur (inc n)))))
98+ (finally
99+ (paint/close! painter)
100+ (font/close! fonts)
101+ (sdl/close! win))))))
new file mode 100644
@@ -0,0 +1,101 @@
1+(ns jvui.app
2+ "The frame loop: open a window, walk the UI once per frame, present.
3+
4+ The loop is here rather than in `jvui.core` because core does not know that
5+ SDL exists — which is what lets the layout tests walk the same widgets with
6+ no window, no font and no display."
7+ (:require [jvui.sdl :as sdl]
8+ [jvui.font :as font]
9+ [jvui.paint :as paint]
10+ [jvui.theme :as theme]
11+ [jvui.core :as c]))
12+
13+(defn context
14+ "A live context over an open window."
15+ [{:keys [renderer window size theme fonts]}]
16+ (let [painter (paint/painter renderer fonts)]
17+ (atom {:size size :theme (or theme theme/dark)
18+ :renderer renderer :window window :fonts fonts
19+ :painter painter
20+ :measure (fn [s sz] (font/size-of fonts s sz))
21+ :line-height (fn [sz] (font/line-height fonts sz))
22+ :draw? false
23+ :data {} :events [] :handled #{} :stack []
24+ :mouse [-1 -1] :mouse-down? false
25+ :focus nil :capture nil :focusables []
26+ :settled? false :quit? false})))
27+
28+(defn- scale-events
29+ "Put pointer coordinates into the same units the layout is in.
30+
31+ SDL reports events in window units and draws in pixels, and on a display
32+ with a scale factor those are not the same number. Everything above this
33+ line works in pixels, so the conversion happens once, here, rather than in
34+ every hit test."
35+ [evs sx sy]
36+ (if (and (== sx 1.0) (== sy 1.0))
37+ evs
38+ (mapv (fn [e]
39+ (cond-> e
40+ (:x e) (assoc :x (* sx (:x e)))
41+ (:y e) (assoc :y (* sy (:y e)))))
42+ evs)))
43+
44+(defn run!
45+ "Open a window and run `render` once per frame until it closes.
46+
47+ `render` is a thunk: it calls widgets, and what they answer is what the
48+ person did. Options: :title :width :height :theme :frames :auto-quit-ms.
49+
50+ :before is a thunk run once per frame, before the walk. A caller with a tree
51+ to patch — glimmer's reconciler is the one — needs somewhere to do it that is
52+ not *during* a walk of that tree, and this is it.
53+
54+ :frames and :auto-quit-ms exist for the same reason glimmer-gfx's do — so a
55+ smoke test can paint a real window and then leave, without a person in front
56+ of it."
57+ [render {:keys [title width height theme frames auto-quit-ms shot before]
58+ :or {title "jvui" width 720 height 520}}]
59+ (let [path (font/find-font)]
60+ (when-not path
61+ (throw (ex-info "no system font found; set JVUI_FONT to a .ttf" {})))
62+ (let [{:keys [window renderer] :as win} (sdl/open! {:title title
63+ :width width
64+ :height height})
65+ fonts (font/open path)
66+ ctx (context {:renderer renderer :window window :fonts fonts
67+ :size (sdl/output-size renderer)
68+ :theme (or theme theme/dark)})
69+ painter (:painter @ctx)
70+ deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
71+ (sdl/start-text-input! window)
72+ (try
73+ (loop [n 0]
74+ (let [[ow oh] (sdl/output-size renderer)
75+ [ww wh] (sdl/window-size window)
76+ evs (scale-events (sdl/drain!)
77+ (if (pos? ww) (/ (double ow) ww) 1.0)
78+ (if (pos? wh) (/ (double oh) wh) 1.0))]
79+ (swap! ctx (fn [s] (-> s (assoc :events evs)
80+ (assoc :size [ow oh]))))
81+ (swap! ctx c/apply-input evs)
82+ (when before (before))
83+ (let [[br bg bb ba] (get (:theme @ctx) :bg)]
84+ (sdl/draw-color! renderer br bg bb ba)
85+ (sdl/clear! renderer))
86+ (c/frame! ctx render)
87+ (paint/flush! painter)
88+ (sdl/clip! renderer nil)
89+ (swap! painter assoc :clip nil)
90+ (when (and shot frames (= (inc n) frames))
91+ (sdl/save-screenshot! renderer shot))
92+ (sdl/present! renderer)
93+ (sdl/delay-ms! 16)
94+ (when-not (or (:quit? @ctx)
95+ (and frames (>= (inc n) frames))
96+ (and deadline (> (System/currentTimeMillis) deadline)))
97+ (recur (inc n)))))
98+ (finally
99+ (paint/close! painter)
100+ (font/close! fonts)
101+ (sdl/close! win))))))
added jvui/src/jvui/core.clj +499 -0
new file mode 100644
@@ -0,0 +1,499 @@
1+(ns jvui.core
2+ "The immediate-mode engine: identity, layout, event routing, the frame loop.
3+
4+ This is the part of dvui that is worth porting rather than binding. It is
5+ all arithmetic over maps, none of it touches SDL, and it is the reason the
6+ foreign surface underneath is as small as `jvui.sdl`.
7+
8+ # How a one-pass layout knows a size it has not measured yet
9+
10+ An immediate-mode toolkit walks the tree once and must place a container
11+ before it has seen the container's children. dvui's answer, kept here, is to
12+ remember: every widget stores the size it turned out to need under a stable
13+ id, and the *next* frame uses that number to place it. A leaf knows its own
14+ size at once — a label measures its string — so only containers lag, and
15+ they lag exactly one frame.
16+
17+ `frame!` closes that gap before anything reaches the screen. When a stored
18+ size changes, the walk sets `:refresh?`, and the frame is walked again, up to
19+ three times, with no drawing and no events. Only the settled pass paints. A
20+ new page therefore appears laid out, not laid out on its second frame.
21+
22+ # Identity
23+
24+ An id is a hash of its parent's id, the widget's index among its siblings,
25+ and an optional `:key`. Deterministic, needs no macro and no call-site
26+ capture — and the `:key` is the escape hatch for the case indices get wrong,
27+ which is a loop whose collection reorders. That is the same bug class the
28+ zvui README describes from the other side: reuse a slot and the new occupant
29+ inherits the cursor and the scroll position of the old one.
30+
31+ # Events
32+
33+ Events arrive as a vector for the frame and are matched to widgets as the
34+ walk reaches them, because that is when a widget's rectangle is known. A
35+ widget that takes an event marks it handled so a container behind it does
36+ not take it again. A press *captures*: the pressed widget keeps receiving
37+ the drag until release even when the pointer leaves its rectangle, which is
38+ what makes a slider survive a fast gesture."
39+ (:require [jvui.paint :as paint]
40+ [jvui.theme :as theme]
41+ [jvui.font :as font]
42+ [jvui.sdl :as sdl]))
43+
44+(def ^:dynamic *ui* nil)
45+
46+(defn ui [] @*ui*)
47+(defn upd! [f & args] (apply swap! *ui* f args))
48+
49+;; ------------------------------------------------------------------ identity
50+
51+(defn- child-id
52+ "A widget's identity: its parent's, plus its place among its siblings — or
53+ plus a `:key`, which REPLACES the index rather than joining it.
54+
55+ That is the whole point of a key. A list that reorders gives every widget
56+ after the moved one a new index, and an identity built on the index would
57+ hand each of them the caret, the scroll offset and the drag of whichever
58+ widget used to sit there. A key that still carried the index would do
59+ nothing to stop it."
60+ [parent idx key]
61+ (if (some? key)
62+ (hash [parent key])
63+ (hash [parent idx])))
64+
65+(defn data
66+ "This widget's remembered map, from the frame before."
67+ [id] (get-in (ui) [:data id] {}))
68+
69+(defn data!
70+ [id m] (upd! update-in [:data id] merge m))
71+
72+(defn state
73+ "Widget state that outlives the frame — a scroll offset, a caret, a checkbox
74+ the caller did not hand us a value for."
75+ ([id k] (state id k nil))
76+ ([id k default] (get (data id) k default)))
77+
78+(defn state! [id k v] (data! id {k v}))
79+
80+(defn rect-of
81+ "Where the widget with this id was placed on the last walk, or nil."
82+ [id] (:rect (data id)))
83+
84+(defn refresh!
85+ "Ask for another layout pass before anything is drawn."
86+ [] (upd! assoc :refresh? true))
87+
88+;; -------------------------------------------------------------------- theme
89+
90+(defn th [k] (get (:theme (ui)) k))
91+
92+;; ---------------------------------------------------------------- measuring
93+
94+(defn measure
95+ "[w h] of `s`. Goes through the same font object the renderer will use, or
96+ through the caller's stub in a headless run."
97+ ([s] (measure s (th :font-size)))
98+ ([s size] ((:measure (ui)) s size)))
99+
100+(defn line-height
101+ ([] (line-height (th :font-size)))
102+ ([size] ((:line-height (ui)) size)))
103+
104+;; ------------------------------------------------------------------ drawing
105+;;
106+;; Every draw goes through these, and they are silent on a layout pass. That is
107+;; the whole cost of running the walk three times: three walks, one paint.
108+
109+(defn drawing?
110+ "True only on the pass that paints, and only when there is something to paint
111+ into — a headless walk has no painter and every draw below is a no-op."
112+ [] (let [c (ui)] (boolean (and (:draw? c) (:painter c)))))
113+
114+(defn fill!
115+ ([rect colour] (fill! rect colour 0.0 nil 0.0))
116+ ([rect colour radius] (fill! rect colour radius nil 0.0))
117+ ([rect colour radius border bw]
118+ (when (drawing?) (paint/rect! (:painter (ui)) rect colour radius border bw))))
119+
120+(defn draw-text!
121+ [s x y size colour]
122+ (when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))
123+
124+(defn draw-line!
125+ [x0 y0 x1 y1 colour width]
126+ (when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))
127+
128+;; --------------------------------------------------------------------- rects
129+
130+(defn inside?
131+ [[x y w h] [px py]]
132+ (and (>= px x) (< px (+ x w)) (>= py y) (< py (+ y h))))
133+
134+(defn- intersect
135+ [[ax ay aw ah] [bx by bw bh]]
136+ (let [x (max ax bx) y (max ay by)
137+ r (min (+ ax aw) (+ bx bw)) b (min (+ ay ah) (+ by bh))]
138+ [x y (max 0 (- r x)) (max 0 (- b y))]))
139+
140+(defn- clip-rect [] (or (:clip (ui)) [0 0 1e9 1e9]))
141+
142+(defn visible?
143+ "Inside the current clip, so a widget scrolled out of a viewport takes no
144+ click from a pointer that is over the viewport's neighbour."
145+ [pt] (inside? (clip-rect) pt))
146+
147+;; -------------------------------------------------------------------- layout
148+
149+(defn- top [] (peek (:stack (ui))))
150+
151+;; A box's running counters — how far along the cursor is, the run of child
152+;; minimums, the widest of them, how many children there were and how many said
153+;; they would expand — live in a five-slot double-array rather than in the
154+;; context map.
155+;;
156+;; That is not a micro-optimisation, it is the difference between a toolkit and
157+;; a slideshow: `swap!` costs about four microseconds here, the walk touches
158+;; these counters once per widget, and a page of a hundred widgets was spending
159+;; most of a frame re-associng numbers into a map nobody else could see. The
160+;; counters are written by exactly one walker, in order, and are dead at the end
161+;; of the frame — which is the shape a mutable slot is actually for.
162+(def ^:private CURSOR 0)
163+(def ^:private ALONG 1)
164+(def ^:private CROSS 2)
165+(def ^:private N 3)
166+(def ^:private EXPANDERS 4)
167+
168+(defn- counters [] (double-array 5))
169+(defn- ctr [f i] (aget (:c f) i))
170+(defn- ctr+ [f i v] (aset (:c f) i (+ (aget (:c f) i) v)))
171+
172+(defn- expands?
173+ [expand axis]
174+ (case expand
175+ :both true
176+ :horizontal (= axis :horizontal)
177+ :vertical (= axis :vertical)
178+ false))
179+
180+(defn- tally!
181+ "Fold one placed child into the current box's running counts.
182+
183+ `min-along`/`min-cross` are the child's own minimums and never the size it
184+ was grown to: a box that counted the growth would report it as next frame's
185+ minimum and grow again, every frame, without bound."
186+ [advance min-along min-cross grew?]
187+ (let [f (top)]
188+ (ctr+ f CURSOR (+ advance (:spacing f)))
189+ (ctr+ f ALONG (+ min-along (if (pos? (ctr f N)) (:spacing f) 0.0)))
190+ (aset (:c f) CROSS (max (ctr f CROSS) (double min-cross)))
191+ (ctr+ f N 1.0)
192+ (when grew? (ctr+ f EXPANDERS 1.0))))
193+
194+(defn rect-for
195+ "Give a child of the current box a rectangle.
196+
197+ `min-size` is what the child says it needs; `expand` says which axes it will
198+ take more of if there is more; `gravity` [gx gy], each 0..1, places it in
199+ whatever it did not take. This is dvui's `rectFor`, and the share of extra
200+ space along the box's own axis comes from what the box counted last frame."
201+ [[mw mh] expand [gx gy]]
202+ (let [{:keys [dir rect share offset] :as f} (top)
203+ cursor (ctr f CURSOR)
204+ [rx ry rw rh] rect
205+ [ox oy] (or offset [0.0 0.0])
206+ along-axis (if (= dir :vertical) :vertical :horizontal)
207+ grow-along? (expands? expand along-axis)
208+ grow-cross? (expands? expand (if (= dir :vertical) :horizontal :vertical))]
209+ (if (= dir :vertical)
210+ (let [h (+ mh (if grow-along? share 0.0))
211+ ;; NOT clamped to the box's width. A container's own size comes from
212+ ;; what its children asked for last frame, so clamping a child to it
213+ ;; on the frame where that is still zero pins the child at zero and
214+ ;; the loop never recovers. Overflow is the honest answer; a
215+ ;; viewport clips it.
216+ w (if grow-cross? rw mw)
217+ x (+ rx ox (* gx (- rw w)))
218+ y (+ ry oy cursor)]
219+ (tally! h mh mw grow-along?)
220+ [x y w h])
221+ (let [w (+ mw (if grow-along? share 0.0))
222+ h (if grow-cross? rh mh)
223+ x (+ rx ox cursor)
224+ y (+ ry oy (* gy (- rh h)))]
225+ (tally! w mw mh grow-along?)
226+ [x y w h]))))
227+
228+(defn next-id
229+ "Claim the next id under the current box."
230+ ([] (next-id nil))
231+ ([key]
232+ (let [f (top)]
233+ (child-id (:id f) (ctr f N) key))))
234+
235+(defn- push-frame! [f] (upd! update :stack conj f))
236+(defn- pop-frame! [] (let [f (top)] (upd! update :stack pop) f))
237+
238+(defn- set-clip!
239+ [rect]
240+ (upd! assoc :clip rect)
241+ (when (drawing?) (paint/set-clip! (:painter (ui)) rect)))
242+
243+(defn box*
244+ "The container everything else is built from.
245+
246+ opts: :dir :spacing :padding :margin :expand :gravity :key :fill :border
247+ :radius :min-size :clip? :offset"
248+ [opts body]
249+ (let [{:keys [dir spacing padding margin expand gravity key fill border
250+ radius min-size clip? offset fixed]
251+ :or {dir :vertical expand :none gravity [0.0 0.0] clip? false}} opts
252+ spacing (double (or spacing 0.0))
253+ padding (double (or padding 0.0))
254+ margin (double (or margin 0.0))
255+ radius (double (or radius 0.0))
256+ id (next-id key)
257+ prev (data id)
258+ remembered (or (:min-size prev) (or min-size [0.0 0.0]))
259+ want (if min-size
260+ [(max (first min-size) (first remembered))
261+ (max (second min-size) (second remembered))]
262+ remembered)
263+ outer (rect-for [(+ (first want) (* 2 margin))
264+ (+ (second want) (* 2 margin))]
265+ expand gravity)
266+ [ox oy ow oh] outer
267+ box-rect [(+ ox margin) (+ oy margin)
268+ (- ow (* 2 margin)) (- oh (* 2 margin))]
269+ content [(+ (first box-rect) padding) (+ (second box-rect) padding)
270+ (max 0.0 (- (nth box-rect 2) (* 2 padding)))
271+ (max 0.0 (- (nth box-rect 3) (* 2 padding)))]
272+ ;; Extra space to hand out along our own axis, computed from what we
273+ ;; counted last frame: whatever the fixed children took is spoken for,
274+ ;; and the rest is split between the children that said they expand.
275+ avail (if (= dir :vertical) (nth content 3) (nth content 2))
276+ ;; `:along` from last frame is the run of the children's own minimums,
277+ ;; gaps included. Whatever the box has beyond that is the slack, split
278+ ;; between the children that said they would take it.
279+ wanted (or (:along prev) 0.0)
280+ expanders (or (:expanders prev) 0)
281+ share (if (pos? expanders)
282+ (max 0.0 (/ (- avail wanted) expanders))
283+ 0.0)
284+ outer-clip (:clip (ui))]
285+ (when (and fill (or (nil? border) (nil? (:colour border))))
286+ (fill! box-rect fill radius))
287+ (when (and border (:colour border))
288+ (fill! box-rect fill radius (:colour border) (or (:width border) 1.0)))
289+ (when clip? (set-clip! (intersect (or outer-clip content) content)))
290+ (push-frame! {:id id :dir dir :rect content :spacing spacing
291+ :share share :c (counters)
292+ :offset (or offset [0.0 0.0])})
293+ (let [result (when body (body id box-rect))
294+ f (pop-frame!)]
295+ (when clip? (set-clip! outer-clip))
296+ ;; A box measures its cross axis by its widest child and its own axis by
297+ ;; the run of them; this swap is the only place that distinction is spelled
298+ ;; out.
299+ (let [pad2 (+ (* 2 padding) (* 2 margin))
300+ computed (if (= dir :vertical)
301+ [(+ (ctr f CROSS) pad2) (+ (ctr f ALONG) pad2)]
302+ [(+ (ctr f ALONG) pad2) (+ (ctr f CROSS) pad2)])
303+ computed (if min-size
304+ [(max (first computed) (first min-size))
305+ (max (second computed) (second min-size))]
306+ computed)
307+ ;; A viewport reports the size it was given and not the size of
308+ ;; what is inside it — that difference is exactly what there is to
309+ ;; scroll, so both numbers are kept.
310+ reported (if (and fixed min-size) min-size computed)]
311+ (when (not= reported (:min-size prev)) (refresh!))
312+ (data! id {:min-size reported
313+ :content-min computed
314+ :n (ctr f N) :expanders (ctr f EXPANDERS)
315+ :along (ctr f ALONG)
316+ :rect box-rect :content (:rect f)})
317+ result))))
318+
319+(defn leaf
320+ "Place a widget that already knows its size. Answers its rectangle."
321+ ([min-size] (leaf min-size :none [0.0 0.0]))
322+ ([min-size expand gravity] (rect-for min-size expand gravity)))
323+
324+;; -------------------------------------------------------------------- events
325+
326+(defn events [] (:events (ui)))
327+
328+(defn handled? [i] (contains? (:handled (ui)) i))
329+(defn handle! [i] (upd! update :handled conj i))
330+
331+(defn- unhandled
332+ []
333+ (keep-indexed (fn [i e] (when-not (handled? i) [i e])) (events)))
334+
335+(defn focus! [id] (upd! assoc :focus id))
336+(defn focused? [id] (= id (:focus (ui))))
337+(defn capture! [id] (upd! assoc :capture id))
338+(defn captured? [id] (= id (:capture (ui))))
339+
340+(defn register-focusable!
341+ [id] (upd! update :focusables conj id))
342+
343+(defn interact!
344+ "Route the pointer to a widget occupying `rect`.
345+
346+ Answers {:hover? :pressed? :clicked? :focused?}. A press claims the widget
347+ and the claim survives the pointer leaving — a click only lands if the
348+ release is inside, which is the affordance that lets someone change their
349+ mind by sliding off a button."
350+ [id rect & [{:keys [focusable?] :or {focusable? true}}]]
351+ (when focusable? (register-focusable! id))
352+ ;; Remember where this widget was. A container's rectangle is already in its
353+ ;; data because it needs it next frame; an interactive leaf's was not kept by
354+ ;; anyone, which left the placement of every button and field unobservable
355+ ;; from outside the walk — no way for a test to click one, and no way for a
356+ ;; backend above to say where anything is.
357+ (data! id {:rect rect})
358+ (let [mouse (:mouse (ui))
359+ over? (and (inside? rect mouse) (visible? mouse))
360+ s (atom {:hover? (and over? (or (nil? (:capture (ui))) (captured? id)))
361+ :pressed? (and (captured? id) (:mouse-down? (ui)))
362+ :clicked? false
363+ :focused? (focused? id)})]
364+ (doseq [[i e] (unhandled)]
365+ (case (:kind e)
366+ :mouse-down (when (and (inside? rect [(:x e) (:y e)])
367+ (visible? [(:x e) (:y e)]))
368+ (handle! i)
369+ (capture! id)
370+ (when focusable? (focus! id))
371+ (swap! s assoc :pressed? true :focused? true))
372+ :mouse-up (when (captured? id)
373+ (handle! i)
374+ (when (inside? rect [(:x e) (:y e)])
375+ (swap! s assoc :clicked? true))
376+ (capture! nil)
377+ (swap! s assoc :pressed? false))
378+ nil))
379+ @s))
380+
381+(defn key-events
382+ "Keyboard and text events, if this widget has focus. Consumes what it hands
383+ over — a caret does not want the Tab that moves focus off it."
384+ [id]
385+ (when (focused? id)
386+ (vec (keep (fn [[i e]]
387+ (when (contains? #{:key-down :text} (:kind e))
388+ (handle! i)
389+ e))
390+ (unhandled)))))
391+
392+(defn wheel-events
393+ "Wheel events over `rect`, consumed. A scroll area asks; nothing else does."
394+ [rect]
395+ (let [mouse (:mouse (ui))]
396+ (when (and (inside? rect mouse) (visible? mouse))
397+ (vec (keep (fn [[i e]]
398+ (when (= :wheel (:kind e)) (handle! i) e))
399+ (unhandled))))))
400+
401+;; ---------------------------------------------------------------- the frame
402+
403+(defn apply-input
404+ "Fold the frame's events into the pointer state and the window size."
405+ [ctx evs]
406+ (reduce (fn [c e]
407+ (case (:kind e)
408+ :motion (assoc c :mouse [(:x e) (:y e)])
409+ :mouse-down (assoc c :mouse [(:x e) (:y e)] :mouse-down? true)
410+ :mouse-up (assoc c :mouse [(:x e) (:y e)] :mouse-down? false)
411+ :resize (assoc c :size [(:w e) (:h e)])
412+ :quit (assoc c :quit? true)
413+ c))
414+ ctx evs))
415+
416+(defn- move-focus!
417+ "Tab, and shift-Tab, over the ids the walk registered, in walk order."
418+ []
419+ (doseq [[i e] (unhandled)]
420+ (when (and (= :key-down (:kind e)) (= :tab (:key e)))
421+ (handle! i)
422+ (let [fs (:focusables (ui))
423+ n (count fs)]
424+ (when (pos? n)
425+ (let [cur (.indexOf fs (:focus (ui)))
426+ step (if (:shift? e) -1 1)
427+ nxt (if (neg? cur) 0 (mod (+ cur step) n))]
428+ (focus! (nth fs nxt))))))))
429+
430+(defn- one-pass!
431+ [ctx-atom render draw?]
432+ (swap! ctx-atom
433+ (fn [c]
434+ (assoc c :stack [] :refresh? false :focusables []
435+ :handled #{} :draw? draw?
436+ :clip nil)))
437+ (let [[w h] (:size @ctx-atom)
438+ ;; The root is a box like any other, and it remembers under id 0. It has
439+ ;; to: without last frame's counts it cannot know how much of the window
440+ ;; is left over for the children that said they would expand, and a
441+ ;; top-level `{:expand :both}` would size itself to its own contents
442+ ;; instead of to the window.
443+ prev (get-in @ctx-atom [:data 0] {})
444+ expanders (or (:expanders prev) 0)
445+ share (if (pos? expanders)
446+ (max 0.0 (/ (- h (or (:along prev) 0.0)) expanders))
447+ 0.0)
448+ root {:id 0 :dir :vertical :rect [0.0 0.0 (double w) (double h)]
449+ :spacing 0.0 :share share :c (counters) :offset [0.0 0.0]}]
450+ (swap! ctx-atom update :stack conj root)
451+ (binding [*ui* ctx-atom]
452+ (render)
453+ (when draw? (move-focus!)))
454+ (let [f (peek (:stack @ctx-atom))]
455+ (when (not= [(ctr f N) (ctr f EXPANDERS) (ctr f ALONG)]
456+ [(:n prev) (:expanders prev) (:along prev)])
457+ (swap! ctx-atom assoc :refresh? true))
458+ (swap! ctx-atom assoc-in [:data 0]
459+ {:n (ctr f N) :expanders (ctr f EXPANDERS) :along (ctr f ALONG)}))
460+ (:refresh? @ctx-atom)))
461+
462+(defn frame!
463+ "Walk `render` until the layout settles, then walk it once more and draw.
464+
465+ The settling passes see no events and paint nothing, so a click cannot be
466+ eaten by a pass whose output is thrown away.
467+
468+ They are also skipped entirely once the layout has stopped moving, which is
469+ almost every frame: a walk costs real time, and re-deriving numbers that did
470+ not change is the kind of work an immediate-mode toolkit is accused of doing
471+ and does not have to. `:settled?` goes false again the moment any widget
472+ reports a size it did not report last time."
473+ [ctx-atom render]
474+ (let [real (:events @ctx-atom)]
475+ (when-not (:settled? @ctx-atom)
476+ (loop [pass 0]
477+ (swap! ctx-atom assoc :events [])
478+ (let [again? (one-pass! ctx-atom render false)]
479+ (when (and again? (< pass 2)) (recur (inc pass)))))
480+ (swap! ctx-atom assoc :events real))
481+ (let [moved? (one-pass! ctx-atom render true)]
482+ (swap! ctx-atom assoc :settled? (not moved?))
483+ moved?)))
484+
485+(defn context
486+ "A context for a headless walk: no window, no SDL, a caller's measurer.
487+
488+ The layout tests use this, which is the point of taking `measure` as a
489+ function rather than reaching for the font cache."
490+ [{:keys [size theme measure line-height]
491+ :or {size [640 480] theme theme/dark}}]
492+ (atom {:size size :theme theme
493+ :measure (or measure (fn [s _] [(* 8.0 (count s)) 16.0]))
494+ :line-height (or line-height (fn [_] 16.0))
495+ :painter nil :draw? false
496+ :data {} :events [] :handled #{} :stack []
497+ :mouse [-1 -1] :mouse-down? false
498+ :focus nil :capture nil :focusables []
499+ :settled? false :quit? false}))
new file mode 100644
@@ -0,0 +1,499 @@
1+(ns jvui.core
2+ "The immediate-mode engine: identity, layout, event routing, the frame loop.
3+
4+ This is the part of dvui that is worth porting rather than binding. It is
5+ all arithmetic over maps, none of it touches SDL, and it is the reason the
6+ foreign surface underneath is as small as `jvui.sdl`.
7+
8+ # How a one-pass layout knows a size it has not measured yet
9+
10+ An immediate-mode toolkit walks the tree once and must place a container
11+ before it has seen the container's children. dvui's answer, kept here, is to
12+ remember: every widget stores the size it turned out to need under a stable
13+ id, and the *next* frame uses that number to place it. A leaf knows its own
14+ size at once — a label measures its string — so only containers lag, and
15+ they lag exactly one frame.
16+
17+ `frame!` closes that gap before anything reaches the screen. When a stored
18+ size changes, the walk sets `:refresh?`, and the frame is walked again, up to
19+ three times, with no drawing and no events. Only the settled pass paints. A
20+ new page therefore appears laid out, not laid out on its second frame.
21+
22+ # Identity
23+
24+ An id is a hash of its parent's id, the widget's index among its siblings,
25+ and an optional `:key`. Deterministic, needs no macro and no call-site
26+ capture — and the `:key` is the escape hatch for the case indices get wrong,
27+ which is a loop whose collection reorders. That is the same bug class the
28+ zvui README describes from the other side: reuse a slot and the new occupant
29+ inherits the cursor and the scroll position of the old one.
30+
31+ # Events
32+
33+ Events arrive as a vector for the frame and are matched to widgets as the
34+ walk reaches them, because that is when a widget's rectangle is known. A
35+ widget that takes an event marks it handled so a container behind it does
36+ not take it again. A press *captures*: the pressed widget keeps receiving
37+ the drag until release even when the pointer leaves its rectangle, which is
38+ what makes a slider survive a fast gesture."
39+ (:require [jvui.paint :as paint]
40+ [jvui.theme :as theme]
41+ [jvui.font :as font]
42+ [jvui.sdl :as sdl]))
43+
44+(def ^:dynamic *ui* nil)
45+
46+(defn ui [] @*ui*)
47+(defn upd! [f & args] (apply swap! *ui* f args))
48+
49+;; ------------------------------------------------------------------ identity
50+
51+(defn- child-id
52+ "A widget's identity: its parent's, plus its place among its siblings — or
53+ plus a `:key`, which REPLACES the index rather than joining it.
54+
55+ That is the whole point of a key. A list that reorders gives every widget
56+ after the moved one a new index, and an identity built on the index would
57+ hand each of them the caret, the scroll offset and the drag of whichever
58+ widget used to sit there. A key that still carried the index would do
59+ nothing to stop it."
60+ [parent idx key]
61+ (if (some? key)
62+ (hash [parent key])
63+ (hash [parent idx])))
64+
65+(defn data
66+ "This widget's remembered map, from the frame before."
67+ [id] (get-in (ui) [:data id] {}))
68+
69+(defn data!
70+ [id m] (upd! update-in [:data id] merge m))
71+
72+(defn state
73+ "Widget state that outlives the frame — a scroll offset, a caret, a checkbox
74+ the caller did not hand us a value for."
75+ ([id k] (state id k nil))
76+ ([id k default] (get (data id) k default)))
77+
78+(defn state! [id k v] (data! id {k v}))
79+
80+(defn rect-of
81+ "Where the widget with this id was placed on the last walk, or nil."
82+ [id] (:rect (data id)))
83+
84+(defn refresh!
85+ "Ask for another layout pass before anything is drawn."
86+ [] (upd! assoc :refresh? true))
87+
88+;; -------------------------------------------------------------------- theme
89+
90+(defn th [k] (get (:theme (ui)) k))
91+
92+;; ---------------------------------------------------------------- measuring
93+
94+(defn measure
95+ "[w h] of `s`. Goes through the same font object the renderer will use, or
96+ through the caller's stub in a headless run."
97+ ([s] (measure s (th :font-size)))
98+ ([s size] ((:measure (ui)) s size)))
99+
100+(defn line-height
101+ ([] (line-height (th :font-size)))
102+ ([size] ((:line-height (ui)) size)))
103+
104+;; ------------------------------------------------------------------ drawing
105+;;
106+;; Every draw goes through these, and they are silent on a layout pass. That is
107+;; the whole cost of running the walk three times: three walks, one paint.
108+
109+(defn drawing?
110+ "True only on the pass that paints, and only when there is something to paint
111+ into — a headless walk has no painter and every draw below is a no-op."
112+ [] (let [c (ui)] (boolean (and (:draw? c) (:painter c)))))
113+
114+(defn fill!
115+ ([rect colour] (fill! rect colour 0.0 nil 0.0))
116+ ([rect colour radius] (fill! rect colour radius nil 0.0))
117+ ([rect colour radius border bw]
118+ (when (drawing?) (paint/rect! (:painter (ui)) rect colour radius border bw))))
119+
120+(defn draw-text!
121+ [s x y size colour]
122+ (when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))
123+
124+(defn draw-line!
125+ [x0 y0 x1 y1 colour width]
126+ (when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))
127+
128+;; --------------------------------------------------------------------- rects
129+
130+(defn inside?
131+ [[x y w h] [px py]]
132+ (and (>= px x) (< px (+ x w)) (>= py y) (< py (+ y h))))
133+
134+(defn- intersect
135+ [[ax ay aw ah] [bx by bw bh]]
136+ (let [x (max ax bx) y (max ay by)
137+ r (min (+ ax aw) (+ bx bw)) b (min (+ ay ah) (+ by bh))]
138+ [x y (max 0 (- r x)) (max 0 (- b y))]))
139+
140+(defn- clip-rect [] (or (:clip (ui)) [0 0 1e9 1e9]))
141+
142+(defn visible?
143+ "Inside the current clip, so a widget scrolled out of a viewport takes no
144+ click from a pointer that is over the viewport's neighbour."
145+ [pt] (inside? (clip-rect) pt))
146+
147+;; -------------------------------------------------------------------- layout
148+
149+(defn- top [] (peek (:stack (ui))))
150+
151+;; A box's running counters — how far along the cursor is, the run of child
152+;; minimums, the widest of them, how many children there were and how many said
153+;; they would expand — live in a five-slot double-array rather than in the
154+;; context map.
155+;;
156+;; That is not a micro-optimisation, it is the difference between a toolkit and
157+;; a slideshow: `swap!` costs about four microseconds here, the walk touches
158+;; these counters once per widget, and a page of a hundred widgets was spending
159+;; most of a frame re-associng numbers into a map nobody else could see. The
160+;; counters are written by exactly one walker, in order, and are dead at the end
161+;; of the frame — which is the shape a mutable slot is actually for.
162+(def ^:private CURSOR 0)
163+(def ^:private ALONG 1)
164+(def ^:private CROSS 2)
165+(def ^:private N 3)
166+(def ^:private EXPANDERS 4)
167+
168+(defn- counters [] (double-array 5))
169+(defn- ctr [f i] (aget (:c f) i))
170+(defn- ctr+ [f i v] (aset (:c f) i (+ (aget (:c f) i) v)))
171+
172+(defn- expands?
173+ [expand axis]
174+ (case expand
175+ :both true
176+ :horizontal (= axis :horizontal)
177+ :vertical (= axis :vertical)
178+ false))
179+
180+(defn- tally!
181+ "Fold one placed child into the current box's running counts.
182+
183+ `min-along`/`min-cross` are the child's own minimums and never the size it
184+ was grown to: a box that counted the growth would report it as next frame's
185+ minimum and grow again, every frame, without bound."
186+ [advance min-along min-cross grew?]
187+ (let [f (top)]
188+ (ctr+ f CURSOR (+ advance (:spacing f)))
189+ (ctr+ f ALONG (+ min-along (if (pos? (ctr f N)) (:spacing f) 0.0)))
190+ (aset (:c f) CROSS (max (ctr f CROSS) (double min-cross)))
191+ (ctr+ f N 1.0)
192+ (when grew? (ctr+ f EXPANDERS 1.0))))
193+
194+(defn rect-for
195+ "Give a child of the current box a rectangle.
196+
197+ `min-size` is what the child says it needs; `expand` says which axes it will
198+ take more of if there is more; `gravity` [gx gy], each 0..1, places it in
199+ whatever it did not take. This is dvui's `rectFor`, and the share of extra
200+ space along the box's own axis comes from what the box counted last frame."
201+ [[mw mh] expand [gx gy]]
202+ (let [{:keys [dir rect share offset] :as f} (top)
203+ cursor (ctr f CURSOR)
204+ [rx ry rw rh] rect
205+ [ox oy] (or offset [0.0 0.0])
206+ along-axis (if (= dir :vertical) :vertical :horizontal)
207+ grow-along? (expands? expand along-axis)
208+ grow-cross? (expands? expand (if (= dir :vertical) :horizontal :vertical))]
209+ (if (= dir :vertical)
210+ (let [h (+ mh (if grow-along? share 0.0))
211+ ;; NOT clamped to the box's width. A container's own size comes from
212+ ;; what its children asked for last frame, so clamping a child to it
213+ ;; on the frame where that is still zero pins the child at zero and
214+ ;; the loop never recovers. Overflow is the honest answer; a
215+ ;; viewport clips it.
216+ w (if grow-cross? rw mw)
217+ x (+ rx ox (* gx (- rw w)))
218+ y (+ ry oy cursor)]
219+ (tally! h mh mw grow-along?)
220+ [x y w h])
221+ (let [w (+ mw (if grow-along? share 0.0))
222+ h (if grow-cross? rh mh)
223+ x (+ rx ox cursor)
224+ y (+ ry oy (* gy (- rh h)))]
225+ (tally! w mw mh grow-along?)
226+ [x y w h]))))
227+
228+(defn next-id
229+ "Claim the next id under the current box."
230+ ([] (next-id nil))
231+ ([key]
232+ (let [f (top)]
233+ (child-id (:id f) (ctr f N) key))))
234+
235+(defn- push-frame! [f] (upd! update :stack conj f))
236+(defn- pop-frame! [] (let [f (top)] (upd! update :stack pop) f))
237+
238+(defn- set-clip!
239+ [rect]
240+ (upd! assoc :clip rect)
241+ (when (drawing?) (paint/set-clip! (:painter (ui)) rect)))
242+
243+(defn box*
244+ "The container everything else is built from.
245+
246+ opts: :dir :spacing :padding :margin :expand :gravity :key :fill :border
247+ :radius :min-size :clip? :offset"
248+ [opts body]
249+ (let [{:keys [dir spacing padding margin expand gravity key fill border
250+ radius min-size clip? offset fixed]
251+ :or {dir :vertical expand :none gravity [0.0 0.0] clip? false}} opts
252+ spacing (double (or spacing 0.0))
253+ padding (double (or padding 0.0))
254+ margin (double (or margin 0.0))
255+ radius (double (or radius 0.0))
256+ id (next-id key)
257+ prev (data id)
258+ remembered (or (:min-size prev) (or min-size [0.0 0.0]))
259+ want (if min-size
260+ [(max (first min-size) (first remembered))
261+ (max (second min-size) (second remembered))]
262+ remembered)
263+ outer (rect-for [(+ (first want) (* 2 margin))
264+ (+ (second want) (* 2 margin))]
265+ expand gravity)
266+ [ox oy ow oh] outer
267+ box-rect [(+ ox margin) (+ oy margin)
268+ (- ow (* 2 margin)) (- oh (* 2 margin))]
269+ content [(+ (first box-rect) padding) (+ (second box-rect) padding)
270+ (max 0.0 (- (nth box-rect 2) (* 2 padding)))
271+ (max 0.0 (- (nth box-rect 3) (* 2 padding)))]
272+ ;; Extra space to hand out along our own axis, computed from what we
273+ ;; counted last frame: whatever the fixed children took is spoken for,
274+ ;; and the rest is split between the children that said they expand.
275+ avail (if (= dir :vertical) (nth content 3) (nth content 2))
276+ ;; `:along` from last frame is the run of the children's own minimums,
277+ ;; gaps included. Whatever the box has beyond that is the slack, split
278+ ;; between the children that said they would take it.
279+ wanted (or (:along prev) 0.0)
280+ expanders (or (:expanders prev) 0)
281+ share (if (pos? expanders)
282+ (max 0.0 (/ (- avail wanted) expanders))
283+ 0.0)
284+ outer-clip (:clip (ui))]
285+ (when (and fill (or (nil? border) (nil? (:colour border))))
286+ (fill! box-rect fill radius))
287+ (when (and border (:colour border))
288+ (fill! box-rect fill radius (:colour border) (or (:width border) 1.0)))
289+ (when clip? (set-clip! (intersect (or outer-clip content) content)))
290+ (push-frame! {:id id :dir dir :rect content :spacing spacing
291+ :share share :c (counters)
292+ :offset (or offset [0.0 0.0])})
293+ (let [result (when body (body id box-rect))
294+ f (pop-frame!)]
295+ (when clip? (set-clip! outer-clip))
296+ ;; A box measures its cross axis by its widest child and its own axis by
297+ ;; the run of them; this swap is the only place that distinction is spelled
298+ ;; out.
299+ (let [pad2 (+ (* 2 padding) (* 2 margin))
300+ computed (if (= dir :vertical)
301+ [(+ (ctr f CROSS) pad2) (+ (ctr f ALONG) pad2)]
302+ [(+ (ctr f ALONG) pad2) (+ (ctr f CROSS) pad2)])
303+ computed (if min-size
304+ [(max (first computed) (first min-size))
305+ (max (second computed) (second min-size))]
306+ computed)
307+ ;; A viewport reports the size it was given and not the size of
308+ ;; what is inside it — that difference is exactly what there is to
309+ ;; scroll, so both numbers are kept.
310+ reported (if (and fixed min-size) min-size computed)]
311+ (when (not= reported (:min-size prev)) (refresh!))
312+ (data! id {:min-size reported
313+ :content-min computed
314+ :n (ctr f N) :expanders (ctr f EXPANDERS)
315+ :along (ctr f ALONG)
316+ :rect box-rect :content (:rect f)})
317+ result))))
318+
319+(defn leaf
320+ "Place a widget that already knows its size. Answers its rectangle."
321+ ([min-size] (leaf min-size :none [0.0 0.0]))
322+ ([min-size expand gravity] (rect-for min-size expand gravity)))
323+
324+;; -------------------------------------------------------------------- events
325+
326+(defn events [] (:events (ui)))
327+
328+(defn handled? [i] (contains? (:handled (ui)) i))
329+(defn handle! [i] (upd! update :handled conj i))
330+
331+(defn- unhandled
332+ []
333+ (keep-indexed (fn [i e] (when-not (handled? i) [i e])) (events)))
334+
335+(defn focus! [id] (upd! assoc :focus id))
336+(defn focused? [id] (= id (:focus (ui))))
337+(defn capture! [id] (upd! assoc :capture id))
338+(defn captured? [id] (= id (:capture (ui))))
339+
340+(defn register-focusable!
341+ [id] (upd! update :focusables conj id))
342+
343+(defn interact!
344+ "Route the pointer to a widget occupying `rect`.
345+
346+ Answers {:hover? :pressed? :clicked? :focused?}. A press claims the widget
347+ and the claim survives the pointer leaving — a click only lands if the
348+ release is inside, which is the affordance that lets someone change their
349+ mind by sliding off a button."
350+ [id rect & [{:keys [focusable?] :or {focusable? true}}]]
351+ (when focusable? (register-focusable! id))
352+ ;; Remember where this widget was. A container's rectangle is already in its
353+ ;; data because it needs it next frame; an interactive leaf's was not kept by
354+ ;; anyone, which left the placement of every button and field unobservable
355+ ;; from outside the walk — no way for a test to click one, and no way for a
356+ ;; backend above to say where anything is.
357+ (data! id {:rect rect})
358+ (let [mouse (:mouse (ui))
359+ over? (and (inside? rect mouse) (visible? mouse))
360+ s (atom {:hover? (and over? (or (nil? (:capture (ui))) (captured? id)))
361+ :pressed? (and (captured? id) (:mouse-down? (ui)))
362+ :clicked? false
363+ :focused? (focused? id)})]
364+ (doseq [[i e] (unhandled)]
365+ (case (:kind e)
366+ :mouse-down (when (and (inside? rect [(:x e) (:y e)])
367+ (visible? [(:x e) (:y e)]))
368+ (handle! i)
369+ (capture! id)
370+ (when focusable? (focus! id))
371+ (swap! s assoc :pressed? true :focused? true))
372+ :mouse-up (when (captured? id)
373+ (handle! i)
374+ (when (inside? rect [(:x e) (:y e)])
375+ (swap! s assoc :clicked? true))
376+ (capture! nil)
377+ (swap! s assoc :pressed? false))
378+ nil))
379+ @s))
380+
381+(defn key-events
382+ "Keyboard and text events, if this widget has focus. Consumes what it hands
383+ over — a caret does not want the Tab that moves focus off it."
384+ [id]
385+ (when (focused? id)
386+ (vec (keep (fn [[i e]]
387+ (when (contains? #{:key-down :text} (:kind e))
388+ (handle! i)
389+ e))
390+ (unhandled)))))
391+
392+(defn wheel-events
393+ "Wheel events over `rect`, consumed. A scroll area asks; nothing else does."
394+ [rect]
395+ (let [mouse (:mouse (ui))]
396+ (when (and (inside? rect mouse) (visible? mouse))
397+ (vec (keep (fn [[i e]]
398+ (when (= :wheel (:kind e)) (handle! i) e))
399+ (unhandled))))))
400+
401+;; ---------------------------------------------------------------- the frame
402+
403+(defn apply-input
404+ "Fold the frame's events into the pointer state and the window size."
405+ [ctx evs]
406+ (reduce (fn [c e]
407+ (case (:kind e)
408+ :motion (assoc c :mouse [(:x e) (:y e)])
409+ :mouse-down (assoc c :mouse [(:x e) (:y e)] :mouse-down? true)
410+ :mouse-up (assoc c :mouse [(:x e) (:y e)] :mouse-down? false)
411+ :resize (assoc c :size [(:w e) (:h e)])
412+ :quit (assoc c :quit? true)
413+ c))
414+ ctx evs))
415+
416+(defn- move-focus!
417+ "Tab, and shift-Tab, over the ids the walk registered, in walk order."
418+ []
419+ (doseq [[i e] (unhandled)]
420+ (when (and (= :key-down (:kind e)) (= :tab (:key e)))
421+ (handle! i)
422+ (let [fs (:focusables (ui))
423+ n (count fs)]
424+ (when (pos? n)
425+ (let [cur (.indexOf fs (:focus (ui)))
426+ step (if (:shift? e) -1 1)
427+ nxt (if (neg? cur) 0 (mod (+ cur step) n))]
428+ (focus! (nth fs nxt))))))))
429+
430+(defn- one-pass!
431+ [ctx-atom render draw?]
432+ (swap! ctx-atom
433+ (fn [c]
434+ (assoc c :stack [] :refresh? false :focusables []
435+ :handled #{} :draw? draw?
436+ :clip nil)))
437+ (let [[w h] (:size @ctx-atom)
438+ ;; The root is a box like any other, and it remembers under id 0. It has
439+ ;; to: without last frame's counts it cannot know how much of the window
440+ ;; is left over for the children that said they would expand, and a
441+ ;; top-level `{:expand :both}` would size itself to its own contents
442+ ;; instead of to the window.
443+ prev (get-in @ctx-atom [:data 0] {})
444+ expanders (or (:expanders prev) 0)
445+ share (if (pos? expanders)
446+ (max 0.0 (/ (- h (or (:along prev) 0.0)) expanders))
447+ 0.0)
448+ root {:id 0 :dir :vertical :rect [0.0 0.0 (double w) (double h)]
449+ :spacing 0.0 :share share :c (counters) :offset [0.0 0.0]}]
450+ (swap! ctx-atom update :stack conj root)
451+ (binding [*ui* ctx-atom]
452+ (render)
453+ (when draw? (move-focus!)))
454+ (let [f (peek (:stack @ctx-atom))]
455+ (when (not= [(ctr f N) (ctr f EXPANDERS) (ctr f ALONG)]
456+ [(:n prev) (:expanders prev) (:along prev)])
457+ (swap! ctx-atom assoc :refresh? true))
458+ (swap! ctx-atom assoc-in [:data 0]
459+ {:n (ctr f N) :expanders (ctr f EXPANDERS) :along (ctr f ALONG)}))
460+ (:refresh? @ctx-atom)))
461+
462+(defn frame!
463+ "Walk `render` until the layout settles, then walk it once more and draw.
464+
465+ The settling passes see no events and paint nothing, so a click cannot be
466+ eaten by a pass whose output is thrown away.
467+
468+ They are also skipped entirely once the layout has stopped moving, which is
469+ almost every frame: a walk costs real time, and re-deriving numbers that did
470+ not change is the kind of work an immediate-mode toolkit is accused of doing
471+ and does not have to. `:settled?` goes false again the moment any widget
472+ reports a size it did not report last time."
473+ [ctx-atom render]
474+ (let [real (:events @ctx-atom)]
475+ (when-not (:settled? @ctx-atom)
476+ (loop [pass 0]
477+ (swap! ctx-atom assoc :events [])
478+ (let [again? (one-pass! ctx-atom render false)]
479+ (when (and again? (< pass 2)) (recur (inc pass)))))
480+ (swap! ctx-atom assoc :events real))
481+ (let [moved? (one-pass! ctx-atom render true)]
482+ (swap! ctx-atom assoc :settled? (not moved?))
483+ moved?)))
484+
485+(defn context
486+ "A context for a headless walk: no window, no SDL, a caller's measurer.
487+
488+ The layout tests use this, which is the point of taking `measure` as a
489+ function rather than reaching for the font cache."
490+ [{:keys [size theme measure line-height]
491+ :or {size [640 480] theme theme/dark}}]
492+ (atom {:size size :theme theme
493+ :measure (or measure (fn [s _] [(* 8.0 (count s)) 16.0]))
494+ :line-height (or line-height (fn [_] 16.0))
495+ :painter nil :draw? false
496+ :data {} :events [] :handled #{} :stack []
497+ :mouse [-1 -1] :mouse-down? false
498+ :focus nil :capture nil :focusables []
499+ :settled? false :quit? false}))
added jvui/src/jvui/font.clj +84 -0
new file mode 100644
@@ -0,0 +1,84 @@
1+(ns jvui.font
2+ "One font, opened at a handful of sizes, plus the two caches that make text
3+ affordable: a measurement cache and a texture cache.
4+
5+ dvui keeps a glyph atlas and lays out runs itself. This does less and gets
6+ the same two properties that matter to a layout engine above it:
7+
8+ * **Measurement and rendering are the same code.** `size-of` and `texture`
9+ both go through SDL_ttf on the same font object, so a centred label is
10+ centred. A measurement that disagrees with the renderer by a pixel makes
11+ every layout subtly wrong and is invisible until it is maddening.
12+ * **A string costs its first frame only.** The texture is white and tinted
13+ with a colour-mod at draw time, so one cached texture serves a label in
14+ every colour it is ever drawn in, and a static page uploads nothing at all
15+ after its first frame."
16+ (:require [jvui.sdl :as sdl]))
17+
18+(def ^:private candidates
19+ ["/usr/share/fonts/noto/NotoSans-Regular.ttf"
20+ "/usr/share/fonts/TTF/DejaVuSans.ttf"
21+ "/usr/share/fonts/dejavu/DejaVuSans.ttf"
22+ "/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf"
23+ "/usr/share/fonts/liberation/LiberationSans-Regular.ttf"
24+ "/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf"
25+ "/System/Library/Fonts/Helvetica.ttc"])
26+
27+(defn find-font
28+ "The first of the usual system faces that exists, or nil.
29+
30+ A path in JVUI_FONT wins, because a caller who cares about the face should
31+ not have to care about this list."
32+ []
33+ (or (System/getenv "JVUI_FONT")
34+ (first (filter #(.exists (java.io.File. %)) candidates))))
35+
36+(defn- ffi-null? [p] (or (nil? p) (and (number? p) (zero? p))))
37+
38+(defn open
39+ "A font cache over `path`. Sizes are opened lazily and kept."
40+ [path]
41+ (atom {:path path :faces {} :sizes {} :textures {}}))
42+
43+(defn- face
44+ [cache size]
45+ (let [k (int size)]
46+ (or (get-in @cache [:faces k])
47+ (let [f (sdl/open-font (:path @cache) (float size))]
48+ (when (or (nil? f) (and (number? f) (zero? f)))
49+ (throw (ex-info (str "TTF_OpenFont " (:path @cache) ": " (sdl/error)) {})))
50+ (swap! cache assoc-in [:faces k] f)
51+ f))))
52+
53+(defn line-height [cache size] (sdl/font-height (face cache size)))
54+
55+(defn size-of
56+ "[w h] of `s` at `size`, memoized. The number layout runs on."
57+ [cache s size]
58+ (let [k [(int size) s]]
59+ (or (get-in @cache [:sizes k])
60+ (let [wh (sdl/string-size (face cache size) s)]
61+ (swap! cache assoc-in [:sizes k] wh)
62+ wh))))
63+
64+(defn texture
65+ "A white SDL texture of `s` at `size`, cached. nil for the empty string."
66+ [cache renderer s size]
67+ (when (and s (not= s ""))
68+ (let [k [(int size) s]]
69+ (or (get-in @cache [:textures k])
70+ (let [surf (sdl/render-blended (face cache size) s)]
71+ (when-not (or (nil? surf) (ffi-null? surf))
72+ (let [tex (sdl/texture-from-surface renderer surf)
73+ wh (sdl/surface-size surf)]
74+ (sdl/destroy-surface! surf)
75+ (sdl/texture-blend-mode! tex sdl/BLEND)
76+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR)
77+ (swap! cache assoc-in [:textures k] [tex wh])
78+ [tex wh])))))))
79+
80+(defn close!
81+ [cache]
82+ (doseq [[_ [tex _]] (:textures @cache)] (sdl/destroy-texture! tex))
83+ (doseq [[_ f] (:faces @cache)] (sdl/close-font! f))
84+ (reset! cache {:path (:path @cache) :faces {} :sizes {} :textures {}}))
new file mode 100644
@@ -0,0 +1,84 @@
1+(ns jvui.font
2+ "One font, opened at a handful of sizes, plus the two caches that make text
3+ affordable: a measurement cache and a texture cache.
4+
5+ dvui keeps a glyph atlas and lays out runs itself. This does less and gets
6+ the same two properties that matter to a layout engine above it:
7+
8+ * **Measurement and rendering are the same code.** `size-of` and `texture`
9+ both go through SDL_ttf on the same font object, so a centred label is
10+ centred. A measurement that disagrees with the renderer by a pixel makes
11+ every layout subtly wrong and is invisible until it is maddening.
12+ * **A string costs its first frame only.** The texture is white and tinted
13+ with a colour-mod at draw time, so one cached texture serves a label in
14+ every colour it is ever drawn in, and a static page uploads nothing at all
15+ after its first frame."
16+ (:require [jvui.sdl :as sdl]))
17+
18+(def ^:private candidates
19+ ["/usr/share/fonts/noto/NotoSans-Regular.ttf"
20+ "/usr/share/fonts/TTF/DejaVuSans.ttf"
21+ "/usr/share/fonts/dejavu/DejaVuSans.ttf"
22+ "/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf"
23+ "/usr/share/fonts/liberation/LiberationSans-Regular.ttf"
24+ "/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf"
25+ "/System/Library/Fonts/Helvetica.ttc"])
26+
27+(defn find-font
28+ "The first of the usual system faces that exists, or nil.
29+
30+ A path in JVUI_FONT wins, because a caller who cares about the face should
31+ not have to care about this list."
32+ []
33+ (or (System/getenv "JVUI_FONT")
34+ (first (filter #(.exists (java.io.File. %)) candidates))))
35+
36+(defn- ffi-null? [p] (or (nil? p) (and (number? p) (zero? p))))
37+
38+(defn open
39+ "A font cache over `path`. Sizes are opened lazily and kept."
40+ [path]
41+ (atom {:path path :faces {} :sizes {} :textures {}}))
42+
43+(defn- face
44+ [cache size]
45+ (let [k (int size)]
46+ (or (get-in @cache [:faces k])
47+ (let [f (sdl/open-font (:path @cache) (float size))]
48+ (when (or (nil? f) (and (number? f) (zero? f)))
49+ (throw (ex-info (str "TTF_OpenFont " (:path @cache) ": " (sdl/error)) {})))
50+ (swap! cache assoc-in [:faces k] f)
51+ f))))
52+
53+(defn line-height [cache size] (sdl/font-height (face cache size)))
54+
55+(defn size-of
56+ "[w h] of `s` at `size`, memoized. The number layout runs on."
57+ [cache s size]
58+ (let [k [(int size) s]]
59+ (or (get-in @cache [:sizes k])
60+ (let [wh (sdl/string-size (face cache size) s)]
61+ (swap! cache assoc-in [:sizes k] wh)
62+ wh))))
63+
64+(defn texture
65+ "A white SDL texture of `s` at `size`, cached. nil for the empty string."
66+ [cache renderer s size]
67+ (when (and s (not= s ""))
68+ (let [k [(int size) s]]
69+ (or (get-in @cache [:textures k])
70+ (let [surf (sdl/render-blended (face cache size) s)]
71+ (when-not (or (nil? surf) (ffi-null? surf))
72+ (let [tex (sdl/texture-from-surface renderer surf)
73+ wh (sdl/surface-size surf)]
74+ (sdl/destroy-surface! surf)
75+ (sdl/texture-blend-mode! tex sdl/BLEND)
76+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR)
77+ (swap! cache assoc-in [:textures k] [tex wh])
78+ [tex wh])))))))
79+
80+(defn close!
81+ [cache]
82+ (doseq [[_ [tex _]] (:textures @cache)] (sdl/destroy-texture! tex))
83+ (doseq [[_ f] (:faces @cache)] (sdl/close-font! f))
84+ (reset! cache {:path (:path @cache) :faces {} :sizes {} :textures {}}))
added jvui/src/jvui/paint.clj +169 -0
new file mode 100644
@@ -0,0 +1,169 @@
1+(ns jvui.paint
2+ "Shapes and text, in the calls SDL is fast at.
3+
4+ The first version of this file batched everything into a packed
5+ `SDL_Vertex` buffer and issued one `SDL_RenderGeometry` per frame, which is
6+ how dvui's backends do it and is the right shape when the buffer can be
7+ filled cheaply. It cannot be, here: `jolt.ffi/write-array` costs about
8+ 0.6 microseconds *per element*, so a few thousand vertices is six
9+ milliseconds of frame time before SDL has drawn anything. A crossing, by
10+ contrast, is 0.2 microseconds and a filled rectangle end to end is about
11+ three.
12+
13+ So the unit is the call, not the vertex. A rectangle is one
14+ `SDL_RenderFillRect`; text is one blit of a cached texture. Nothing here
15+ accumulates and nothing needs flushing, which also means painter order is
16+ simply call order and there is no batch to get wrong.
17+
18+ # Rounded corners without a tessellator
19+
20+ A rounded rectangle is three rectangles — a full-width band across the
21+ middle and two inset bands at top and bottom — plus four blits from one
22+ antialiased white disc uploaded at startup. The disc is white so a
23+ colour-mod tints it, which is why one 48-pixel texture serves every corner
24+ of every colour at every radius the UI ever asks for."
25+ (:require [jvui.sdl :as sdl] [jvui.font :as font]))
26+
27+(def ^:private DISC 48)
28+(def ^:private HALF (/ DISC 2))
29+
30+(defn- disc-pixels
31+ "An antialiased white disc in ARGB8888, sampled 3x3 per pixel.
32+
33+ Supersampled rather than computed from a distance field because it is done
34+ once, at startup, and the edge is what the whole trick rests on."
35+ []
36+ (let [px (int-array (* DISC DISC))
37+ r (- HALF 0.5)]
38+ (dotimes [y DISC]
39+ (dotimes [x DISC]
40+ (let [hits (reduce
41+ + (for [sy (range 3) sx (range 3)]
42+ (let [dx (- (+ x (/ (+ sx 0.5) 3.0)) HALF)
43+ dy (- (+ y (/ (+ sy 0.5) 3.0)) HALF)]
44+ (if (<= (+ (* dx dx) (* dy dy)) (* r r)) 1 0))))
45+ a (int (* 255 (/ hits 9.0)))]
46+ (aset px (+ (* y DISC) x)
47+ (unchecked-int (bit-or 0x00FFFFFF (bit-shift-left a 24)))))))
48+ px))
49+
50+(defn painter
51+ "Drawing state for one window. `fonts` may be nil in a headless run."
52+ [renderer fonts]
53+ (let [disc (when renderer
54+ (let [t (sdl/create-texture renderer sdl/PIXELFORMAT-ARGB8888
55+ sdl/TEXTUREACCESS-STATIC DISC DISC)]
56+ (sdl/update-texture! t (disc-pixels) DISC DISC)
57+ (sdl/texture-blend-mode! t sdl/BLEND)
58+ (sdl/texture-scale-mode! t sdl/SCALE-LINEAR)
59+ t))]
60+ (atom {:r renderer :fonts fonts :disc disc :clip nil :colour nil})))
61+
62+(defn close! [p]
63+ (when-let [d (:disc @p)] (sdl/destroy-texture! d))
64+ (swap! p assoc :disc nil))
65+
66+;; ------------------------------------------------------------------- state
67+
68+(defn- colour!
69+ "Set the draw colour, skipping the crossing when it is already set."
70+ [p [r g b a]]
71+ (when (not= [r g b a] (:colour @p))
72+ (sdl/draw-color! (:r @p) r g b (or a 255))
73+ (swap! p assoc :colour [r g b a])))
74+
75+(defn set-clip!
76+ [p rect]
77+ (when (not= rect (:clip @p))
78+ (sdl/clip! (:r @p) rect)
79+ (swap! p assoc :clip rect)))
80+
81+(defn flush!
82+ "Nothing accumulates, so this is a no-op — kept because the frame loop reads
83+ better with the intent spelled out, and because a future batching painter
84+ would need it back."
85+ [_p] nil)
86+
87+;; ------------------------------------------------------------------ shapes
88+
89+(defn plain-rect!
90+ [p [x y w h] c]
91+ (when (and (> w 0) (> h 0))
92+ (colour! p c)
93+ (sdl/fill-rect! (:r @p) [x y w h])))
94+
95+(defn- corners!
96+ "The four rounded corners of [x y w h] at radius `r`, blitted from the disc."
97+ [p [x y w h] r [cr cg cb ca]]
98+ (let [d (:disc @p)]
99+ (when d
100+ (sdl/texture-color-mod! d cr cg cb)
101+ (sdl/texture-alpha-mod! d (or ca 255))
102+ (let [rn (:r @p)]
103+ (sdl/blit! rn d [0 0 HALF HALF] [x y r r])
104+ (sdl/blit! rn d [HALF 0 HALF HALF] [(+ x w (- r)) y r r])
105+ (sdl/blit! rn d [0 HALF HALF HALF] [x (+ y h (- r)) r r])
106+ (sdl/blit! rn d [HALF HALF HALF HALF] [(+ x w (- r)) (+ y h (- r)) r r])))))
107+
108+(defn round-rect!
109+ [p [x y w h] c radius]
110+ (let [r (max 0.0 (min (double radius) (/ w 2.0) (/ h 2.0)))]
111+ (if (< r 1.0)
112+ (plain-rect! p [x y w h] c)
113+ (do (plain-rect! p [x (+ y r) w (- h (* 2 r))] c)
114+ (plain-rect! p [(+ x r) y (- w (* 2 r)) r] c)
115+ (plain-rect! p [(+ x r) (+ y h (- r)) (- w (* 2 r)) r] c)
116+ (corners! p [x y w h] r c)))))
117+
118+(defn rect!
119+ "Fill `rect`, optionally rounded, optionally over a border.
120+
121+ The border is not a ring: it is the same rounded rectangle in the border
122+ colour with the fill laid inside it, inset by the border width. One code
123+ path serves a plain fill, a rounded fill and a bordered card, and nothing
124+ here has to stroke a curve."
125+ ([p rect colour] (rect! p rect colour 0.0 nil 0.0))
126+ ([p rect colour radius] (rect! p rect colour radius nil 0.0))
127+ ([p [x y w h] colour radius border-colour border-width]
128+ (when (and (> w 0) (> h 0))
129+ (if (and border-colour (pos? border-width))
130+ (let [bw (double border-width)]
131+ (round-rect! p [x y w h] border-colour radius)
132+ (when colour
133+ (round-rect! p [(+ x bw) (+ y bw) (- w (* 2 bw)) (- h (* 2 bw))]
134+ colour (max 0.0 (- radius bw)))))
135+ (when colour (round-rect! p [x y w h] colour radius))))))
136+
137+(defn line!
138+ "A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case
139+ — which in this toolkit is a checkbox tick — is a few offset hairlines,
140+ because SDL has no thick line and a quad would need a tessellator."
141+ [p x0 y0 x1 y1 colour width]
142+ (cond
143+ (= y0 y1) (plain-rect! p [(min x0 x1) (- y0 (/ width 2.0))
144+ (Math/abs (- x1 x0)) width] colour)
145+ (= x0 x1) (plain-rect! p [(- x0 (/ width 2.0)) (min y0 y1)
146+ width (Math/abs (- y1 y0))] colour)
147+ :else
148+ (let [dx (- x1 x0) dy (- y1 y0)
149+ len (Math/sqrt (+ (* dx dx) (* dy dy)))
150+ nx (/ (- dy) len) ny (/ dx len)
151+ n (max 1 (int width))]
152+ (colour! p colour)
153+ (dotimes [i n]
154+ (let [o (- i (/ (dec n) 2.0))]
155+ (sdl/line! (:r @p) (+ x0 (* nx o)) (+ y0 (* ny o))
156+ (+ x1 (* nx o)) (+ y1 (* ny o))))))))
157+
158+;; -------------------------------------------------------------------- text
159+
160+(defn text!
161+ "Draw `s` with its top-left at [x y]; answers the [w h] it occupied."
162+ [p s x y size [cr cg cb ca]]
163+ (let [{:keys [r fonts]} @p]
164+ (if-let [[tex [tw th]] (font/texture fonts r s size)]
165+ (do (sdl/texture-color-mod! tex cr cg cb)
166+ (sdl/texture-alpha-mod! tex (or ca 255))
167+ (sdl/blit! r tex nil [(Math/floor (double x)) (Math/floor (double y)) tw th])
168+ [tw th])
169+ [0 (if fonts (font/line-height fonts size) 0)])))
new file mode 100644
@@ -0,0 +1,169 @@
1+(ns jvui.paint
2+ "Shapes and text, in the calls SDL is fast at.
3+
4+ The first version of this file batched everything into a packed
5+ `SDL_Vertex` buffer and issued one `SDL_RenderGeometry` per frame, which is
6+ how dvui's backends do it and is the right shape when the buffer can be
7+ filled cheaply. It cannot be, here: `jolt.ffi/write-array` costs about
8+ 0.6 microseconds *per element*, so a few thousand vertices is six
9+ milliseconds of frame time before SDL has drawn anything. A crossing, by
10+ contrast, is 0.2 microseconds and a filled rectangle end to end is about
11+ three.
12+
13+ So the unit is the call, not the vertex. A rectangle is one
14+ `SDL_RenderFillRect`; text is one blit of a cached texture. Nothing here
15+ accumulates and nothing needs flushing, which also means painter order is
16+ simply call order and there is no batch to get wrong.
17+
18+ # Rounded corners without a tessellator
19+
20+ A rounded rectangle is three rectangles — a full-width band across the
21+ middle and two inset bands at top and bottom — plus four blits from one
22+ antialiased white disc uploaded at startup. The disc is white so a
23+ colour-mod tints it, which is why one 48-pixel texture serves every corner
24+ of every colour at every radius the UI ever asks for."
25+ (:require [jvui.sdl :as sdl] [jvui.font :as font]))
26+
27+(def ^:private DISC 48)
28+(def ^:private HALF (/ DISC 2))
29+
30+(defn- disc-pixels
31+ "An antialiased white disc in ARGB8888, sampled 3x3 per pixel.
32+
33+ Supersampled rather than computed from a distance field because it is done
34+ once, at startup, and the edge is what the whole trick rests on."
35+ []
36+ (let [px (int-array (* DISC DISC))
37+ r (- HALF 0.5)]
38+ (dotimes [y DISC]
39+ (dotimes [x DISC]
40+ (let [hits (reduce
41+ + (for [sy (range 3) sx (range 3)]
42+ (let [dx (- (+ x (/ (+ sx 0.5) 3.0)) HALF)
43+ dy (- (+ y (/ (+ sy 0.5) 3.0)) HALF)]
44+ (if (<= (+ (* dx dx) (* dy dy)) (* r r)) 1 0))))
45+ a (int (* 255 (/ hits 9.0)))]
46+ (aset px (+ (* y DISC) x)
47+ (unchecked-int (bit-or 0x00FFFFFF (bit-shift-left a 24)))))))
48+ px))
49+
50+(defn painter
51+ "Drawing state for one window. `fonts` may be nil in a headless run."
52+ [renderer fonts]
53+ (let [disc (when renderer
54+ (let [t (sdl/create-texture renderer sdl/PIXELFORMAT-ARGB8888
55+ sdl/TEXTUREACCESS-STATIC DISC DISC)]
56+ (sdl/update-texture! t (disc-pixels) DISC DISC)
57+ (sdl/texture-blend-mode! t sdl/BLEND)
58+ (sdl/texture-scale-mode! t sdl/SCALE-LINEAR)
59+ t))]
60+ (atom {:r renderer :fonts fonts :disc disc :clip nil :colour nil})))
61+
62+(defn close! [p]
63+ (when-let [d (:disc @p)] (sdl/destroy-texture! d))
64+ (swap! p assoc :disc nil))
65+
66+;; ------------------------------------------------------------------- state
67+
68+(defn- colour!
69+ "Set the draw colour, skipping the crossing when it is already set."
70+ [p [r g b a]]
71+ (when (not= [r g b a] (:colour @p))
72+ (sdl/draw-color! (:r @p) r g b (or a 255))
73+ (swap! p assoc :colour [r g b a])))
74+
75+(defn set-clip!
76+ [p rect]
77+ (when (not= rect (:clip @p))
78+ (sdl/clip! (:r @p) rect)
79+ (swap! p assoc :clip rect)))
80+
81+(defn flush!
82+ "Nothing accumulates, so this is a no-op — kept because the frame loop reads
83+ better with the intent spelled out, and because a future batching painter
84+ would need it back."
85+ [_p] nil)
86+
87+;; ------------------------------------------------------------------ shapes
88+
89+(defn plain-rect!
90+ [p [x y w h] c]
91+ (when (and (> w 0) (> h 0))
92+ (colour! p c)
93+ (sdl/fill-rect! (:r @p) [x y w h])))
94+
95+(defn- corners!
96+ "The four rounded corners of [x y w h] at radius `r`, blitted from the disc."
97+ [p [x y w h] r [cr cg cb ca]]
98+ (let [d (:disc @p)]
99+ (when d
100+ (sdl/texture-color-mod! d cr cg cb)
101+ (sdl/texture-alpha-mod! d (or ca 255))
102+ (let [rn (:r @p)]
103+ (sdl/blit! rn d [0 0 HALF HALF] [x y r r])
104+ (sdl/blit! rn d [HALF 0 HALF HALF] [(+ x w (- r)) y r r])
105+ (sdl/blit! rn d [0 HALF HALF HALF] [x (+ y h (- r)) r r])
106+ (sdl/blit! rn d [HALF HALF HALF HALF] [(+ x w (- r)) (+ y h (- r)) r r])))))
107+
108+(defn round-rect!
109+ [p [x y w h] c radius]
110+ (let [r (max 0.0 (min (double radius) (/ w 2.0) (/ h 2.0)))]
111+ (if (< r 1.0)
112+ (plain-rect! p [x y w h] c)
113+ (do (plain-rect! p [x (+ y r) w (- h (* 2 r))] c)
114+ (plain-rect! p [(+ x r) y (- w (* 2 r)) r] c)
115+ (plain-rect! p [(+ x r) (+ y h (- r)) (- w (* 2 r)) r] c)
116+ (corners! p [x y w h] r c)))))
117+
118+(defn rect!
119+ "Fill `rect`, optionally rounded, optionally over a border.
120+
121+ The border is not a ring: it is the same rounded rectangle in the border
122+ colour with the fill laid inside it, inset by the border width. One code
123+ path serves a plain fill, a rounded fill and a bordered card, and nothing
124+ here has to stroke a curve."
125+ ([p rect colour] (rect! p rect colour 0.0 nil 0.0))
126+ ([p rect colour radius] (rect! p rect colour radius nil 0.0))
127+ ([p [x y w h] colour radius border-colour border-width]
128+ (when (and (> w 0) (> h 0))
129+ (if (and border-colour (pos? border-width))
130+ (let [bw (double border-width)]
131+ (round-rect! p [x y w h] border-colour radius)
132+ (when colour
133+ (round-rect! p [(+ x bw) (+ y bw) (- w (* 2 bw)) (- h (* 2 bw))]
134+ colour (max 0.0 (- radius bw)))))
135+ (when colour (round-rect! p [x y w h] colour radius))))))
136+
137+(defn line!
138+ "A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case
139+ — which in this toolkit is a checkbox tick — is a few offset hairlines,
140+ because SDL has no thick line and a quad would need a tessellator."
141+ [p x0 y0 x1 y1 colour width]
142+ (cond
143+ (= y0 y1) (plain-rect! p [(min x0 x1) (- y0 (/ width 2.0))
144+ (Math/abs (- x1 x0)) width] colour)
145+ (= x0 x1) (plain-rect! p [(- x0 (/ width 2.0)) (min y0 y1)
146+ width (Math/abs (- y1 y0))] colour)
147+ :else
148+ (let [dx (- x1 x0) dy (- y1 y0)
149+ len (Math/sqrt (+ (* dx dx) (* dy dy)))
150+ nx (/ (- dy) len) ny (/ dx len)
151+ n (max 1 (int width))]
152+ (colour! p colour)
153+ (dotimes [i n]
154+ (let [o (- i (/ (dec n) 2.0))]
155+ (sdl/line! (:r @p) (+ x0 (* nx o)) (+ y0 (* ny o))
156+ (+ x1 (* nx o)) (+ y1 (* ny o))))))))
157+
158+;; -------------------------------------------------------------------- text
159+
160+(defn text!
161+ "Draw `s` with its top-left at [x y]; answers the [w h] it occupied."
162+ [p s x y size [cr cg cb ca]]
163+ (let [{:keys [r fonts]} @p]
164+ (if-let [[tex [tw th]] (font/texture fonts r s size)]
165+ (do (sdl/texture-color-mod! tex cr cg cb)
166+ (sdl/texture-alpha-mod! tex (or ca 255))
167+ (sdl/blit! r tex nil [(Math/floor (double x)) (Math/floor (double y)) tw th])
168+ [tw th])
169+ [0 (if fonts (font/line-height fonts size) 0)])))
added jvui/src/jvui/sdl.clj +314 -0
new file mode 100644
@@ -0,0 +1,314 @@
1+(ns jvui.sdl
2+ "SDL3 through jolt.ffi, and nothing above it.
3+
4+ This is the whole foreign surface of jvui: a window, a renderer, an event
5+ pump, textured triangles and a font. Everything else in this project —
6+ layout, widget identity, event routing, the widgets themselves — is jolt.
7+
8+ Two libraries, both system libraries rather than anything this repo builds:
9+ libSDL3 and libSDL3_ttf. Neither is dlopened until `open!` is called, so the
10+ layout tests run on a machine with no display and no SDL at all.
11+
12+ Struct offsets below were taken with offsetof against /usr/include/SDL3 on
13+ x86-64, not inferred from one struct to another's shape. SDL3's event union
14+ is 128 bytes and its arms disagree about where the coordinates live."
15+ (:require [jolt.ffi :as ffi]))
16+
17+;; ---------------------------------------------------------------- libraries
18+
19+(defonce ^:private loaded
20+ (delay
21+ (ffi/load-library "libSDL3.so.0")
22+ (ffi/load-library "libSDL3_ttf.so.0")
23+ true))
24+
25+(defn ensure-loaded! [] @loaded)
26+
27+;; ------------------------------------------------------------------ bindings
28+
29+(ffi/defcfn init! "SDL_Init" [:ulong] :bool)
30+(ffi/defcfn quit! "SDL_Quit" [] :void)
31+(ffi/defcfn error "SDL_GetError" [] :string)
32+(ffi/defcfn delay-ms! "SDL_Delay" [:uint] :void)
33+(ffi/defcfn ticks-ns "SDL_GetTicksNS" [] :ulong)
34+
35+(ffi/defcfn ^:private create-window-and-renderer "SDL_CreateWindowAndRenderer"
36+ [:string :int :int :ulong :pointer :pointer] :bool)
37+(ffi/defcfn destroy-window! "SDL_DestroyWindow" [:pointer] :void)
38+(ffi/defcfn destroy-renderer! "SDL_DestroyRenderer" [:pointer] :void)
39+(ffi/defcfn ^:private raw-window-size "SDL_GetWindowSize"
40+ [:pointer :pointer :pointer] :bool)
41+(ffi/defcfn ^:private raw-output-size "SDL_GetRenderOutputSize"
42+ [:pointer :pointer :pointer] :bool)
43+
44+(ffi/defcfn draw-color! "SDL_SetRenderDrawColor" [:pointer :uint8 :uint8 :uint8 :uint8] :bool)
45+(ffi/defcfn clear! "SDL_RenderClear" [:pointer] :bool)
46+(ffi/defcfn present! "SDL_RenderPresent" [:pointer] :bool)
47+(ffi/defcfn blend-mode! "SDL_SetRenderDrawBlendMode" [:pointer :uint] :bool)
48+(ffi/defcfn ^:private raw-fill-rect "SDL_RenderFillRect" [:pointer :pointer] :bool)
49+(ffi/defcfn ^:private raw-clip! "SDL_SetRenderClipRect" [:pointer :pointer] :bool)
50+
51+(ffi/defcfn ^:private raw-poll "SDL_PollEvent" [:pointer] :bool)
52+(ffi/defcfn start-text-input! "SDL_StartTextInput" [:pointer] :bool)
53+(ffi/defcfn stop-text-input! "SDL_StopTextInput" [:pointer] :bool)
54+(ffi/defcfn clipboard "SDL_GetClipboardText" [] :string)
55+(ffi/defcfn clipboard! "SDL_SetClipboardText" [:string] :bool)
56+
57+(ffi/defcfn texture-from-surface "SDL_CreateTextureFromSurface" [:pointer :pointer] :pointer)
58+(ffi/defcfn destroy-texture! "SDL_DestroyTexture" [:pointer] :void)
59+(ffi/defcfn destroy-surface! "SDL_DestroySurface" [:pointer] :void)
60+(ffi/defcfn texture-color-mod! "SDL_SetTextureColorMod" [:pointer :uint8 :uint8 :uint8] :bool)
61+(ffi/defcfn texture-alpha-mod! "SDL_SetTextureAlphaMod" [:pointer :uint8] :bool)
62+(ffi/defcfn texture-blend-mode! "SDL_SetTextureBlendMode" [:pointer :uint] :bool)
63+(ffi/defcfn texture-scale-mode! "SDL_SetTextureScaleMode" [:pointer :int] :bool)
64+
65+(ffi/defcfn ttf-init! "TTF_Init" [] :bool)
66+(ffi/defcfn ttf-quit! "TTF_Quit" [] :void)
67+(ffi/defcfn open-font "TTF_OpenFont" [:string :float] :pointer)
68+(ffi/defcfn close-font! "TTF_CloseFont" [:pointer] :void)
69+(ffi/defcfn font-height "TTF_GetFontHeight" [:pointer] :int)
70+(ffi/defcfn ^:private raw-string-size "TTF_GetStringSize"
71+ [:pointer :string :ulong :pointer :pointer] :bool)
72+(ffi/defcfn ^:private raw-render-blended "TTF_RenderText_Blended"
73+ ;; SDL_Color is four bytes passed by value; on the SysV ABI a four-byte
74+ ;; aggregate of integers travels exactly as a uint32 does, so :uint is not a
75+ ;; cheat here — it is the same register, with r in the low octet.
76+ [:pointer :string :ulong :uint] :pointer)
77+
78+;; ----------------------------------------------------------------- constants
79+
80+(def INIT-VIDEO 32)
81+(def WINDOW-RESIZABLE 32)
82+(def WINDOW-HIGH-DPI 8192)
83+(def BLEND 1)
84+(def SCALE-LINEAR 1)
85+
86+;; SDL_EventType, from SDL_events.h. Only the arms this toolkit reads.
87+(def ^:private EV-QUIT 256)
88+(def ^:private EV-WINDOW-RESIZED 518)
89+(def ^:private EV-WINDOW-PIXEL-SIZE 519)
90+(def ^:private EV-WINDOW-CLOSE 528)
91+(def ^:private EV-KEY-DOWN 768)
92+(def ^:private EV-KEY-UP 769)
93+(def ^:private EV-TEXT-INPUT 771)
94+(def ^:private EV-MOUSE-MOTION 1024)
95+(def ^:private EV-MOUSE-DOWN 1025)
96+(def ^:private EV-MOUSE-UP 1026)
97+(def ^:private EV-MOUSE-WHEEL 1027)
98+
99+;; Byte offsets into the 128-byte SDL_Event union. See the namespace docstring:
100+;; a motion event's x is at 28 and a wheel event's is at 24, and no amount of
101+;; staring at one of them tells you the other.
102+(def ^:private EVENT-SIZE 128)
103+(def ^:private O-MOTION-X 28) (def ^:private O-MOTION-Y 32)
104+(def ^:private O-BUTTON 24) (def ^:private O-BUTTON-DOWN 25)
105+(def ^:private O-CLICKS 26)
106+(def ^:private O-BUTTON-X 28) (def ^:private O-BUTTON-Y 32)
107+(def ^:private O-WHEEL-X 24) (def ^:private O-WHEEL-Y 28)
108+(def ^:private O-KEY 28) (def ^:private O-MOD 32)
109+(def ^:private O-REPEAT 37)
110+(def ^:private O-TEXT 24)
111+(def ^:private O-DATA1 20) (def ^:private O-DATA2 24)
112+
113+;; SDL_Keycode values worth naming; the rest arrive as codepoints.
114+(def keycodes
115+ {13 :return 27 :escape 8 :backspace 9 :tab 32 :space 127 :delete
116+ 1073741903 :right 1073741904 :left 1073741905 :down 1073741906 :up
117+ 1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down})
118+
119+(def ^:private MOD-SHIFT 3) (def ^:private MOD-CTRL 192)
120+
121+;; -------------------------------------------------------------------- window
122+
123+(defn output-size
124+ "The renderer's size in pixels, as [w h]."
125+ [r]
126+ (ffi/with-alloc [w 4]
127+ (ffi/with-alloc [h 4]
128+ (raw-output-size r w h)
129+ [(ffi/read w :int) (ffi/read h :int)])))
130+
131+(defn window-size
132+ "The window's size in its own units, which is what events are reported in and
133+ is NOT the renderer's size on a display with a scale factor."
134+ [w]
135+ (ffi/with-alloc [a 4]
136+ (ffi/with-alloc [b 4]
137+ (raw-window-size w a b)
138+ [(ffi/read a :int) (ffi/read b :int)])))
139+
140+(defn open!
141+ "Open a window and answer {:window :renderer}. Throws if SDL will not start."
142+ [{:keys [title width height] :or {title "jvui" width 640 height 480}}]
143+ (ensure-loaded!)
144+ (when-not (init! INIT-VIDEO)
145+ (throw (ex-info (str "SDL_Init: " (error)) {})))
146+ (when-not (ttf-init!)
147+ (throw (ex-info (str "TTF_Init: " (error)) {})))
148+ (let [wp (ffi/alloc 8) rp (ffi/alloc 8)]
149+ (try
150+ (when-not (create-window-and-renderer
151+ title width height
152+ (bit-or WINDOW-RESIZABLE WINDOW-HIGH-DPI) wp rp)
153+ (throw (ex-info (str "SDL_CreateWindowAndRenderer: " (error)) {})))
154+ (let [window (ffi/read wp :pointer) renderer (ffi/read rp :pointer)]
155+ (blend-mode! renderer BLEND)
156+ {:window window :renderer renderer})
157+ (finally (ffi/free wp) (ffi/free rp)))))
158+
159+(defn close!
160+ [{:keys [window renderer]}]
161+ (when renderer (destroy-renderer! renderer))
162+ (when window (destroy-window! window))
163+ (ttf-quit!)
164+ (quit!))
165+
166+;; --------------------------------------------------------------------- text
167+
168+(defn string-size
169+ "[w h] of `s` in `font`, in pixels. The measurement the renderer will honour."
170+ [font s]
171+ (if (or (nil? font) (nil? s) (= s ""))
172+ [0 (if font (font-height font) 0)]
173+ (ffi/with-alloc [w 4]
174+ (ffi/with-alloc [h 4]
175+ (raw-string-size font s 0 w h)
176+ [(ffi/read w :int) (ffi/read h :int)]))))
177+
178+(defn render-blended
179+ "An SDL_Surface* of `s` drawn white, for the caller to make a texture of and
180+ tint. White because colour is a colour-mod on the texture, which means one
181+ cached texture serves a label in every colour it is ever drawn in."
182+ [font s]
183+ (raw-render-blended font s 0 (unchecked-int 0xFFFFFFFF)))
184+
185+;; SDL_Surface's first fields: flags(0) format(4) w(8) h(12) pitch(16) pixels(24)
186+(defn surface-size [surf] [(ffi/read surf :int 8) (ffi/read surf :int 12)])
187+
188+;; ------------------------------------------------------------------ drawing
189+
190+(defn clip!
191+ "Restrict drawing to `rect` [x y w h], or lift the restriction when nil."
192+ [r rect]
193+ (if (nil? rect)
194+ (raw-clip! r ffi/null)
195+ (let [[x y w h] rect]
196+ (ffi/with-alloc [p 16]
197+ (ffi/write p :int (int x) 0)
198+ (ffi/write p :int (int y) 4)
199+ (ffi/write p :int (max 0 (int w)) 8)
200+ (ffi/write p :int (max 0 (int h)) 12)
201+ (raw-clip! r p)))))
202+
203+;; ------------------------------------------------------------------- events
204+
205+(defonce ^:private event-buf (delay (ffi/alloc EVENT-SIZE)))
206+
207+(defn- decode [p]
208+ (let [t (ffi/read p :int 0)]
209+ (condp = t
210+ EV-QUIT {:kind :quit}
211+ EV-WINDOW-CLOSE {:kind :quit}
212+ EV-WINDOW-RESIZED {:kind :resize :w (ffi/read p :int O-DATA1)
213+ :h (ffi/read p :int O-DATA2)}
214+ EV-WINDOW-PIXEL-SIZE {:kind :resize :w (ffi/read p :int O-DATA1)
215+ :h (ffi/read p :int O-DATA2)}
216+ EV-MOUSE-MOTION {:kind :motion
217+ :x (ffi/read p :float O-MOTION-X)
218+ :y (ffi/read p :float O-MOTION-Y)}
219+ EV-MOUSE-DOWN {:kind :mouse-down
220+ :button (ffi/read p :uint8 O-BUTTON)
221+ :clicks (ffi/read p :uint8 O-CLICKS)
222+ :x (ffi/read p :float O-BUTTON-X)
223+ :y (ffi/read p :float O-BUTTON-Y)}
224+ EV-MOUSE-UP {:kind :mouse-up
225+ :button (ffi/read p :uint8 O-BUTTON)
226+ :x (ffi/read p :float O-BUTTON-X)
227+ :y (ffi/read p :float O-BUTTON-Y)}
228+ EV-MOUSE-WHEEL {:kind :wheel
229+ :dx (ffi/read p :float O-WHEEL-X)
230+ :dy (ffi/read p :float O-WHEEL-Y)}
231+ EV-KEY-DOWN (let [k (ffi/read p :uint O-KEY)
232+ m (ffi/read p :uint16 O-MOD)]
233+ {:kind :key-down
234+ :key (get keycodes k k)
235+ :shift? (pos? (bit-and m MOD-SHIFT))
236+ :ctrl? (pos? (bit-and m MOD-CTRL))
237+ :repeat? (not (zero? (ffi/read p :uint8 O-REPEAT)))})
238+ EV-KEY-UP {:kind :key-up
239+ :key (let [k (ffi/read p :uint O-KEY)] (get keycodes k k))}
240+ EV-TEXT-INPUT (let [sp (ffi/read p :pointer O-TEXT)]
241+ {:kind :text :text (if (ffi/null? sp) "" (ffi/ptr->string sp))})
242+ nil)))
243+
244+(defn drain!
245+ "Every event queued since the last call, oldest first."
246+ []
247+ (let [p @event-buf]
248+ (loop [acc []]
249+ (if (raw-poll p)
250+ (recur (if-let [e (decode p)] (conj acc e) acc))
251+ acc))))
252+
253+(ffi/defcfn ^:private raw-texture-src "SDL_RenderTexture"
254+ [:pointer :pointer :pointer :pointer] :bool)
255+(ffi/defcfn create-texture "SDL_CreateTexture" [:pointer :uint :int :int :int] :pointer)
256+(ffi/defcfn ^:private raw-update-texture "SDL_UpdateTexture"
257+ [:pointer :pointer :pointer :int] :bool)
258+(ffi/defcfn ^:private raw-line "SDL_RenderLine"
259+ [:pointer :float :float :float :float] :bool)
260+
261+(def PIXELFORMAT-ARGB8888 372645892)
262+(def TEXTUREACCESS-STATIC 0)
263+
264+(defn update-texture!
265+ "Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
266+ [tex pixels w h]
267+ (let [n (* w h)]
268+ (ffi/with-alloc [p (* 4 n)]
269+ (ffi/write-array p :int pixels)
270+ (raw-update-texture tex ffi/null p (* 4 w)))))
271+
272+(defonce ^:private rect-a (delay (ffi/alloc 16)))
273+(defonce ^:private rect-b (delay (ffi/alloc 16)))
274+
275+(defn- put-frect! [p [x y w h]]
276+ (ffi/write p :float (float x) 0)
277+ (ffi/write p :float (float y) 4)
278+ (ffi/write p :float (float w) 8)
279+ (ffi/write p :float (float h) 12)
280+ p)
281+
282+(defn fill-rect!
283+ "One filled rectangle in the renderer's current draw colour.
284+
285+ The SDL_FRect is a scratch allocation held for the life of the process: SDL
286+ copies out of it during the call and a fresh one per rectangle would be four
287+ thousand allocations a frame."
288+ [r rect]
289+ (raw-fill-rect r (put-frect! @rect-a rect)))
290+
291+(defn blit!
292+ "Draw `src` (a sub-rectangle of `tex`, or nil for all of it) into `dst`."
293+ [r tex src dst]
294+ (raw-texture-src r tex
295+ (if src (put-frect! @rect-b src) ffi/null)
296+ (put-frect! @rect-a dst)))
297+
298+(defn line! [r x0 y0 x1 y1]
299+ (raw-line r (float x0) (float y0) (float x1) (float y1)))
300+
301+(ffi/defcfn ^:private raw-read-pixels "SDL_RenderReadPixels" [:pointer :pointer] :pointer)
302+(ffi/defcfn ^:private raw-save-bmp "SDL_SaveBMP" [:pointer :string] :bool)
303+
304+(defn save-screenshot!
305+ "Write what the renderer last presented to `path` as a BMP.
306+
307+ Here for the same reason zvui's `--frames` is: so a change to a widget can be
308+ looked at without a person sitting in front of the window."
309+ [r path]
310+ (let [surf (raw-read-pixels r ffi/null)]
311+ (when-not (ffi/null? surf)
312+ (raw-save-bmp surf path)
313+ (destroy-surface! surf)
314+ path)))
new file mode 100644
@@ -0,0 +1,314 @@
1+(ns jvui.sdl
2+ "SDL3 through jolt.ffi, and nothing above it.
3+
4+ This is the whole foreign surface of jvui: a window, a renderer, an event
5+ pump, textured triangles and a font. Everything else in this project —
6+ layout, widget identity, event routing, the widgets themselves — is jolt.
7+
8+ Two libraries, both system libraries rather than anything this repo builds:
9+ libSDL3 and libSDL3_ttf. Neither is dlopened until `open!` is called, so the
10+ layout tests run on a machine with no display and no SDL at all.
11+
12+ Struct offsets below were taken with offsetof against /usr/include/SDL3 on
13+ x86-64, not inferred from one struct to another's shape. SDL3's event union
14+ is 128 bytes and its arms disagree about where the coordinates live."
15+ (:require [jolt.ffi :as ffi]))
16+
17+;; ---------------------------------------------------------------- libraries
18+
19+(defonce ^:private loaded
20+ (delay
21+ (ffi/load-library "libSDL3.so.0")
22+ (ffi/load-library "libSDL3_ttf.so.0")
23+ true))
24+
25+(defn ensure-loaded! [] @loaded)
26+
27+;; ------------------------------------------------------------------ bindings
28+
29+(ffi/defcfn init! "SDL_Init" [:ulong] :bool)
30+(ffi/defcfn quit! "SDL_Quit" [] :void)
31+(ffi/defcfn error "SDL_GetError" [] :string)
32+(ffi/defcfn delay-ms! "SDL_Delay" [:uint] :void)
33+(ffi/defcfn ticks-ns "SDL_GetTicksNS" [] :ulong)
34+
35+(ffi/defcfn ^:private create-window-and-renderer "SDL_CreateWindowAndRenderer"
36+ [:string :int :int :ulong :pointer :pointer] :bool)
37+(ffi/defcfn destroy-window! "SDL_DestroyWindow" [:pointer] :void)
38+(ffi/defcfn destroy-renderer! "SDL_DestroyRenderer" [:pointer] :void)
39+(ffi/defcfn ^:private raw-window-size "SDL_GetWindowSize"
40+ [:pointer :pointer :pointer] :bool)
41+(ffi/defcfn ^:private raw-output-size "SDL_GetRenderOutputSize"
42+ [:pointer :pointer :pointer] :bool)
43+
44+(ffi/defcfn draw-color! "SDL_SetRenderDrawColor" [:pointer :uint8 :uint8 :uint8 :uint8] :bool)
45+(ffi/defcfn clear! "SDL_RenderClear" [:pointer] :bool)
46+(ffi/defcfn present! "SDL_RenderPresent" [:pointer] :bool)
47+(ffi/defcfn blend-mode! "SDL_SetRenderDrawBlendMode" [:pointer :uint] :bool)
48+(ffi/defcfn ^:private raw-fill-rect "SDL_RenderFillRect" [:pointer :pointer] :bool)
49+(ffi/defcfn ^:private raw-clip! "SDL_SetRenderClipRect" [:pointer :pointer] :bool)
50+
51+(ffi/defcfn ^:private raw-poll "SDL_PollEvent" [:pointer] :bool)
52+(ffi/defcfn start-text-input! "SDL_StartTextInput" [:pointer] :bool)
53+(ffi/defcfn stop-text-input! "SDL_StopTextInput" [:pointer] :bool)
54+(ffi/defcfn clipboard "SDL_GetClipboardText" [] :string)
55+(ffi/defcfn clipboard! "SDL_SetClipboardText" [:string] :bool)
56+
57+(ffi/defcfn texture-from-surface "SDL_CreateTextureFromSurface" [:pointer :pointer] :pointer)
58+(ffi/defcfn destroy-texture! "SDL_DestroyTexture" [:pointer] :void)
59+(ffi/defcfn destroy-surface! "SDL_DestroySurface" [:pointer] :void)
60+(ffi/defcfn texture-color-mod! "SDL_SetTextureColorMod" [:pointer :uint8 :uint8 :uint8] :bool)
61+(ffi/defcfn texture-alpha-mod! "SDL_SetTextureAlphaMod" [:pointer :uint8] :bool)
62+(ffi/defcfn texture-blend-mode! "SDL_SetTextureBlendMode" [:pointer :uint] :bool)
63+(ffi/defcfn texture-scale-mode! "SDL_SetTextureScaleMode" [:pointer :int] :bool)
64+
65+(ffi/defcfn ttf-init! "TTF_Init" [] :bool)
66+(ffi/defcfn ttf-quit! "TTF_Quit" [] :void)
67+(ffi/defcfn open-font "TTF_OpenFont" [:string :float] :pointer)
68+(ffi/defcfn close-font! "TTF_CloseFont" [:pointer] :void)
69+(ffi/defcfn font-height "TTF_GetFontHeight" [:pointer] :int)
70+(ffi/defcfn ^:private raw-string-size "TTF_GetStringSize"
71+ [:pointer :string :ulong :pointer :pointer] :bool)
72+(ffi/defcfn ^:private raw-render-blended "TTF_RenderText_Blended"
73+ ;; SDL_Color is four bytes passed by value; on the SysV ABI a four-byte
74+ ;; aggregate of integers travels exactly as a uint32 does, so :uint is not a
75+ ;; cheat here — it is the same register, with r in the low octet.
76+ [:pointer :string :ulong :uint] :pointer)
77+
78+;; ----------------------------------------------------------------- constants
79+
80+(def INIT-VIDEO 32)
81+(def WINDOW-RESIZABLE 32)
82+(def WINDOW-HIGH-DPI 8192)
83+(def BLEND 1)
84+(def SCALE-LINEAR 1)
85+
86+;; SDL_EventType, from SDL_events.h. Only the arms this toolkit reads.
87+(def ^:private EV-QUIT 256)
88+(def ^:private EV-WINDOW-RESIZED 518)
89+(def ^:private EV-WINDOW-PIXEL-SIZE 519)
90+(def ^:private EV-WINDOW-CLOSE 528)
91+(def ^:private EV-KEY-DOWN 768)
92+(def ^:private EV-KEY-UP 769)
93+(def ^:private EV-TEXT-INPUT 771)
94+(def ^:private EV-MOUSE-MOTION 1024)
95+(def ^:private EV-MOUSE-DOWN 1025)
96+(def ^:private EV-MOUSE-UP 1026)
97+(def ^:private EV-MOUSE-WHEEL 1027)
98+
99+;; Byte offsets into the 128-byte SDL_Event union. See the namespace docstring:
100+;; a motion event's x is at 28 and a wheel event's is at 24, and no amount of
101+;; staring at one of them tells you the other.
102+(def ^:private EVENT-SIZE 128)
103+(def ^:private O-MOTION-X 28) (def ^:private O-MOTION-Y 32)
104+(def ^:private O-BUTTON 24) (def ^:private O-BUTTON-DOWN 25)
105+(def ^:private O-CLICKS 26)
106+(def ^:private O-BUTTON-X 28) (def ^:private O-BUTTON-Y 32)
107+(def ^:private O-WHEEL-X 24) (def ^:private O-WHEEL-Y 28)
108+(def ^:private O-KEY 28) (def ^:private O-MOD 32)
109+(def ^:private O-REPEAT 37)
110+(def ^:private O-TEXT 24)
111+(def ^:private O-DATA1 20) (def ^:private O-DATA2 24)
112+
113+;; SDL_Keycode values worth naming; the rest arrive as codepoints.
114+(def keycodes
115+ {13 :return 27 :escape 8 :backspace 9 :tab 32 :space 127 :delete
116+ 1073741903 :right 1073741904 :left 1073741905 :down 1073741906 :up
117+ 1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down})
118+
119+(def ^:private MOD-SHIFT 3) (def ^:private MOD-CTRL 192)
120+
121+;; -------------------------------------------------------------------- window
122+
123+(defn output-size
124+ "The renderer's size in pixels, as [w h]."
125+ [r]
126+ (ffi/with-alloc [w 4]
127+ (ffi/with-alloc [h 4]
128+ (raw-output-size r w h)
129+ [(ffi/read w :int) (ffi/read h :int)])))
130+
131+(defn window-size
132+ "The window's size in its own units, which is what events are reported in and
133+ is NOT the renderer's size on a display with a scale factor."
134+ [w]
135+ (ffi/with-alloc [a 4]
136+ (ffi/with-alloc [b 4]
137+ (raw-window-size w a b)
138+ [(ffi/read a :int) (ffi/read b :int)])))
139+
140+(defn open!
141+ "Open a window and answer {:window :renderer}. Throws if SDL will not start."
142+ [{:keys [title width height] :or {title "jvui" width 640 height 480}}]
143+ (ensure-loaded!)
144+ (when-not (init! INIT-VIDEO)
145+ (throw (ex-info (str "SDL_Init: " (error)) {})))
146+ (when-not (ttf-init!)
147+ (throw (ex-info (str "TTF_Init: " (error)) {})))
148+ (let [wp (ffi/alloc 8) rp (ffi/alloc 8)]
149+ (try
150+ (when-not (create-window-and-renderer
151+ title width height
152+ (bit-or WINDOW-RESIZABLE WINDOW-HIGH-DPI) wp rp)
153+ (throw (ex-info (str "SDL_CreateWindowAndRenderer: " (error)) {})))
154+ (let [window (ffi/read wp :pointer) renderer (ffi/read rp :pointer)]
155+ (blend-mode! renderer BLEND)
156+ {:window window :renderer renderer})
157+ (finally (ffi/free wp) (ffi/free rp)))))
158+
159+(defn close!
160+ [{:keys [window renderer]}]
161+ (when renderer (destroy-renderer! renderer))
162+ (when window (destroy-window! window))
163+ (ttf-quit!)
164+ (quit!))
165+
166+;; --------------------------------------------------------------------- text
167+
168+(defn string-size
169+ "[w h] of `s` in `font`, in pixels. The measurement the renderer will honour."
170+ [font s]
171+ (if (or (nil? font) (nil? s) (= s ""))
172+ [0 (if font (font-height font) 0)]
173+ (ffi/with-alloc [w 4]
174+ (ffi/with-alloc [h 4]
175+ (raw-string-size font s 0 w h)
176+ [(ffi/read w :int) (ffi/read h :int)]))))
177+
178+(defn render-blended
179+ "An SDL_Surface* of `s` drawn white, for the caller to make a texture of and
180+ tint. White because colour is a colour-mod on the texture, which means one
181+ cached texture serves a label in every colour it is ever drawn in."
182+ [font s]
183+ (raw-render-blended font s 0 (unchecked-int 0xFFFFFFFF)))
184+
185+;; SDL_Surface's first fields: flags(0) format(4) w(8) h(12) pitch(16) pixels(24)
186+(defn surface-size [surf] [(ffi/read surf :int 8) (ffi/read surf :int 12)])
187+
188+;; ------------------------------------------------------------------ drawing
189+
190+(defn clip!
191+ "Restrict drawing to `rect` [x y w h], or lift the restriction when nil."
192+ [r rect]
193+ (if (nil? rect)
194+ (raw-clip! r ffi/null)
195+ (let [[x y w h] rect]
196+ (ffi/with-alloc [p 16]
197+ (ffi/write p :int (int x) 0)
198+ (ffi/write p :int (int y) 4)
199+ (ffi/write p :int (max 0 (int w)) 8)
200+ (ffi/write p :int (max 0 (int h)) 12)
201+ (raw-clip! r p)))))
202+
203+;; ------------------------------------------------------------------- events
204+
205+(defonce ^:private event-buf (delay (ffi/alloc EVENT-SIZE)))
206+
207+(defn- decode [p]
208+ (let [t (ffi/read p :int 0)]
209+ (condp = t
210+ EV-QUIT {:kind :quit}
211+ EV-WINDOW-CLOSE {:kind :quit}
212+ EV-WINDOW-RESIZED {:kind :resize :w (ffi/read p :int O-DATA1)
213+ :h (ffi/read p :int O-DATA2)}
214+ EV-WINDOW-PIXEL-SIZE {:kind :resize :w (ffi/read p :int O-DATA1)
215+ :h (ffi/read p :int O-DATA2)}
216+ EV-MOUSE-MOTION {:kind :motion
217+ :x (ffi/read p :float O-MOTION-X)
218+ :y (ffi/read p :float O-MOTION-Y)}
219+ EV-MOUSE-DOWN {:kind :mouse-down
220+ :button (ffi/read p :uint8 O-BUTTON)
221+ :clicks (ffi/read p :uint8 O-CLICKS)
222+ :x (ffi/read p :float O-BUTTON-X)
223+ :y (ffi/read p :float O-BUTTON-Y)}
224+ EV-MOUSE-UP {:kind :mouse-up
225+ :button (ffi/read p :uint8 O-BUTTON)
226+ :x (ffi/read p :float O-BUTTON-X)
227+ :y (ffi/read p :float O-BUTTON-Y)}
228+ EV-MOUSE-WHEEL {:kind :wheel
229+ :dx (ffi/read p :float O-WHEEL-X)
230+ :dy (ffi/read p :float O-WHEEL-Y)}
231+ EV-KEY-DOWN (let [k (ffi/read p :uint O-KEY)
232+ m (ffi/read p :uint16 O-MOD)]
233+ {:kind :key-down
234+ :key (get keycodes k k)
235+ :shift? (pos? (bit-and m MOD-SHIFT))
236+ :ctrl? (pos? (bit-and m MOD-CTRL))
237+ :repeat? (not (zero? (ffi/read p :uint8 O-REPEAT)))})
238+ EV-KEY-UP {:kind :key-up
239+ :key (let [k (ffi/read p :uint O-KEY)] (get keycodes k k))}
240+ EV-TEXT-INPUT (let [sp (ffi/read p :pointer O-TEXT)]
241+ {:kind :text :text (if (ffi/null? sp) "" (ffi/ptr->string sp))})
242+ nil)))
243+
244+(defn drain!
245+ "Every event queued since the last call, oldest first."
246+ []
247+ (let [p @event-buf]
248+ (loop [acc []]
249+ (if (raw-poll p)
250+ (recur (if-let [e (decode p)] (conj acc e) acc))
251+ acc))))
252+
253+(ffi/defcfn ^:private raw-texture-src "SDL_RenderTexture"
254+ [:pointer :pointer :pointer :pointer] :bool)
255+(ffi/defcfn create-texture "SDL_CreateTexture" [:pointer :uint :int :int :int] :pointer)
256+(ffi/defcfn ^:private raw-update-texture "SDL_UpdateTexture"
257+ [:pointer :pointer :pointer :int] :bool)
258+(ffi/defcfn ^:private raw-line "SDL_RenderLine"
259+ [:pointer :float :float :float :float] :bool)
260+
261+(def PIXELFORMAT-ARGB8888 372645892)
262+(def TEXTUREACCESS-STATIC 0)
263+
264+(defn update-texture!
265+ "Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
266+ [tex pixels w h]
267+ (let [n (* w h)]
268+ (ffi/with-alloc [p (* 4 n)]
269+ (ffi/write-array p :int pixels)
270+ (raw-update-texture tex ffi/null p (* 4 w)))))
271+
272+(defonce ^:private rect-a (delay (ffi/alloc 16)))
273+(defonce ^:private rect-b (delay (ffi/alloc 16)))
274+
275+(defn- put-frect! [p [x y w h]]
276+ (ffi/write p :float (float x) 0)
277+ (ffi/write p :float (float y) 4)
278+ (ffi/write p :float (float w) 8)
279+ (ffi/write p :float (float h) 12)
280+ p)
281+
282+(defn fill-rect!
283+ "One filled rectangle in the renderer's current draw colour.
284+
285+ The SDL_FRect is a scratch allocation held for the life of the process: SDL
286+ copies out of it during the call and a fresh one per rectangle would be four
287+ thousand allocations a frame."
288+ [r rect]
289+ (raw-fill-rect r (put-frect! @rect-a rect)))
290+
291+(defn blit!
292+ "Draw `src` (a sub-rectangle of `tex`, or nil for all of it) into `dst`."
293+ [r tex src dst]
294+ (raw-texture-src r tex
295+ (if src (put-frect! @rect-b src) ffi/null)
296+ (put-frect! @rect-a dst)))
297+
298+(defn line! [r x0 y0 x1 y1]
299+ (raw-line r (float x0) (float y0) (float x1) (float y1)))
300+
301+(ffi/defcfn ^:private raw-read-pixels "SDL_RenderReadPixels" [:pointer :pointer] :pointer)
302+(ffi/defcfn ^:private raw-save-bmp "SDL_SaveBMP" [:pointer :string] :bool)
303+
304+(defn save-screenshot!
305+ "Write what the renderer last presented to `path` as a BMP.
306+
307+ Here for the same reason zvui's `--frames` is: so a change to a widget can be
308+ looked at without a person sitting in front of the window."
309+ [r path]
310+ (let [surf (raw-read-pixels r ffi/null)]
311+ (when-not (ffi/null? surf)
312+ (raw-save-bmp surf path)
313+ (destroy-surface! surf)
314+ path)))
added jvui/src/jvui/theme.clj +45 -0
new file mode 100644
@@ -0,0 +1,45 @@
1+(ns jvui.theme
2+ "Colours and metrics, in one map so a caller can swap the lot.
3+
4+ Colours are [r g b a] with each channel 0-255, which is what SDL wants and
5+ what a person reading the file can picture. dvui carries a Theme in its
6+ Window for the same reason: a widget asks the theme rather than naming a
7+ constant, so a dark build is a different map and not a different widget.")
8+
9+(def dark
10+ {:bg [24 24 29 255]
11+ :surface [34 34 41 255]
12+ :surface-alt [44 44 53 255]
13+ :border [62 62 74 255]
14+ :text [226 226 234 255]
15+ :text-dim [150 150 165 255]
16+ :accent [96 150 255 255]
17+ :accent-text [255 255 255 255]
18+ :hover [54 54 65 255]
19+ :press [70 70 84 255]
20+ :focus [96 150 255 255]
21+
22+ :font-size 16.0
23+ :font-size-title 22.0
24+ :padding 8.0
25+ :spacing 6.0
26+ :radius 6.0
27+ :border-width 1.0
28+ :control-height 30.0
29+ :scrollbar 10.0})
30+
31+(def light
32+ (merge dark
33+ {:bg [246 246 248 255]
34+ :surface [255 255 255 255]
35+ :surface-alt [238 238 243 255]
36+ :border [206 206 214 255]
37+ :text [26 26 32 255]
38+ :text-dim [110 110 125 255]
39+ :hover [232 232 240 255]
40+ :press [216 216 228 255]}))
41+
42+(defn mix
43+ "`t` of the way from c1 to c2, per channel."
44+ [c1 c2 t]
45+ (mapv (fn [a b] (int (+ a (* t (- b a))))) c1 c2))
new file mode 100644
@@ -0,0 +1,45 @@
1+(ns jvui.theme
2+ "Colours and metrics, in one map so a caller can swap the lot.
3+
4+ Colours are [r g b a] with each channel 0-255, which is what SDL wants and
5+ what a person reading the file can picture. dvui carries a Theme in its
6+ Window for the same reason: a widget asks the theme rather than naming a
7+ constant, so a dark build is a different map and not a different widget.")
8+
9+(def dark
10+ {:bg [24 24 29 255]
11+ :surface [34 34 41 255]
12+ :surface-alt [44 44 53 255]
13+ :border [62 62 74 255]
14+ :text [226 226 234 255]
15+ :text-dim [150 150 165 255]
16+ :accent [96 150 255 255]
17+ :accent-text [255 255 255 255]
18+ :hover [54 54 65 255]
19+ :press [70 70 84 255]
20+ :focus [96 150 255 255]
21+
22+ :font-size 16.0
23+ :font-size-title 22.0
24+ :padding 8.0
25+ :spacing 6.0
26+ :radius 6.0
27+ :border-width 1.0
28+ :control-height 30.0
29+ :scrollbar 10.0})
30+
31+(def light
32+ (merge dark
33+ {:bg [246 246 248 255]
34+ :surface [255 255 255 255]
35+ :surface-alt [238 238 243 255]
36+ :border [206 206 214 255]
37+ :text [26 26 32 255]
38+ :text-dim [110 110 125 255]
39+ :hover [232 232 240 255]
40+ :press [216 216 228 255]}))
41+
42+(defn mix
43+ "`t` of the way from c1 to c2, per channel."
44+ [c1 c2 t]
45+ (mapv (fn [a b] (int (+ a (* t (- b a))))) c1 c2))
added jvui/src/jvui/widgets.clj +329 -0
new file mode 100644
@@ -0,0 +1,329 @@
1+(ns jvui.widgets
2+ "The widgets, in the calling convention dvui made popular: you call them, and
3+ what they answer is what the person did.
4+
5+ (when (w/button \"Save\") (save!))
6+ (reset! on? (w/checkbox @on? \"Enabled\"))
7+
8+ There is no widget object to hold, no handler to register and nothing to
9+ free — a button that is not called this frame is not on the screen, which is
10+ the property the whole style is for.
11+
12+ Containers are macros so their contents read as a body rather than as a
13+ closure. They are thin: each is `core/box*` with a different set of defaults
14+ from the theme."
15+ (:require [jvui.core :as c]
16+ [jvui.theme :as theme]))
17+
18+;; -------------------------------------------------------------- containers
19+
20+(defmacro box
21+ "The general container. See `core/box*` for the options."
22+ [opts & body]
23+ `(c/box* ~opts (fn [~'_id ~'_rect] ~@body)))
24+
25+(defmacro vbox [opts & body] `(box (assoc ~opts :dir :vertical) ~@body))
26+(defmacro hbox [opts & body] `(box (assoc ~opts :dir :horizontal) ~@body))
27+
28+(defn card*
29+ "A surface with a border and a radius: the thing a group of controls sits on."
30+ [opts body]
31+ (c/box* (merge {:dir :vertical
32+ :padding (c/th :padding)
33+ :spacing (c/th :spacing)
34+ :radius (c/th :radius)
35+ :fill (c/th :surface)
36+ :border {:colour (c/th :border) :width (c/th :border-width)}
37+ :expand :horizontal}
38+ opts)
39+ body))
40+
41+(defmacro card [opts & body] `(card* ~opts (fn [~'_id ~'_rect] ~@body)))
42+
43+(defn page*
44+ "The root container: the window's background, padded, with its contents kept
45+ to `:max-width` and centred in whatever is left."
46+ [opts body]
47+ (c/box* (merge {:dir :vertical :expand :both :fill (c/th :bg)
48+ :padding (c/th :padding)}
49+ (dissoc opts :max-width))
50+ (fn [_ _]
51+ ;; The column expands vertically and is *given* its width, so the
52+ ;; gravity has something left over to centre it in.
53+ (c/box* {:dir :vertical
54+ :spacing (c/th :spacing)
55+ :expand :vertical
56+ :gravity [0.5 0.0]
57+ :min-size [(min (double (or (:max-width opts) 1.0e9))
58+ (max 0.0 (- (double (first (:size (c/ui))))
59+ (* 2 (double (c/th :padding))))))
60+ 0.0]}
61+ body))))
62+
63+(defmacro page [opts & body] `(page* ~opts (fn [~'_id ~'_rect] ~@body)))
64+
65+;; -------------------------------------------------------------------- text
66+
67+(defn label
68+ "A line of text. Answers its rectangle."
69+ ([s] (label s {}))
70+ ([s {:keys [size colour expand gravity align]
71+ :or {expand :horizontal gravity [0.0 0.5] align :left}}]
72+ (let [size (or size (c/th :font-size))
73+ colour (or colour (c/th :text))
74+ [tw th*] (c/measure s size)
75+ rect (c/leaf [(double tw) (double (max th* (c/line-height size)))]
76+ expand gravity)
77+ [x y w h] rect
78+ tx (case align
79+ :center (+ x (/ (- w tw) 2.0))
80+ :right (+ x (- w tw))
81+ x)]
82+ (c/draw-text! s tx (+ y (/ (- h th*) 2.0)) size colour)
83+ rect)))
84+
85+(defn title [s & [opts]]
86+ (label s (merge {:size (c/th :font-size-title)} opts)))
87+
88+(defn dim-label [s & [opts]]
89+ (label s (merge {:colour (c/th :text-dim)} opts)))
90+
91+;; ------------------------------------------------------------------ button
92+
93+(defn button
94+ "Answers true on the frame the button is released inside itself.
95+
96+ opts: :kind (:normal or :primary) :expand :gravity :key :min-width"
97+ ([s] (button s {}))
98+ ([s {:keys [kind expand gravity key min-width]
99+ :or {kind :normal expand :none gravity [0.0 0.5]}}]
100+ (let [size (c/th :font-size)
101+ pad (c/th :padding)
102+ [tw th*] (c/measure s size)
103+ w (max (double (or min-width 0.0)) (+ tw (* 2 pad) (* 2 pad)))
104+ h (max (double (c/th :control-height)) (+ th* pad))
105+ id (c/next-id key)
106+ rect (c/leaf [w h] expand gravity)
107+ {:keys [hover? pressed? clicked? focused?]} (c/interact! id rect)
108+ primary? (= kind :primary)
109+ base (cond primary? (c/th :accent)
110+ :else (c/th :surface-alt))
111+ fill (cond pressed? (if primary?
112+ (theme/mix base [0 0 0 255] 0.25)
113+ (c/th :press))
114+ hover? (if primary?
115+ (theme/mix base [255 255 255 255] 0.12)
116+ (c/th :hover))
117+ :else base)
118+ text-colour (if primary? (c/th :accent-text) (c/th :text))
119+ [rx ry rw rh] rect]
120+ (c/fill! rect fill (c/th :radius)
121+ (if focused? (c/th :focus) (c/th :border))
122+ (if focused? 2.0 (c/th :border-width)))
123+ (c/draw-text! s (+ rx (/ (- rw tw) 2.0)) (+ ry (/ (- rh th*) 2.0))
124+ size text-colour)
125+ clicked?)))
126+
127+;; ---------------------------------------------------------------- checkbox
128+
129+(defn checkbox
130+ "Answers the value the checkbox should have after this frame."
131+ ([value s] (checkbox value s {}))
132+ ([value s {:keys [key expand] :or {expand :horizontal}}]
133+ (let [size (c/th :font-size)
134+ gap 8.0
135+ side 18.0
136+ [tw th*] (c/measure s size)
137+ h (max side (double th*))
138+ id (c/next-id key)
139+ rect (c/leaf [(+ side gap tw) h] expand [0.0 0.5])
140+ {:keys [hover? clicked? focused?]} (c/interact! id rect)
141+ [rx ry _ rh] rect
142+ by (+ ry (/ (- rh side) 2.0))
143+ boxr [rx by side side]
144+ on? (if clicked? (not value) value)]
145+ (c/fill! boxr
146+ (cond on? (c/th :accent)
147+ hover? (c/th :hover)
148+ :else (c/th :surface-alt))
149+ 4.0
150+ (if focused? (c/th :focus) (c/th :border))
151+ (if focused? 2.0 (c/th :border-width)))
152+ (when on?
153+ ;; the tick, as two strokes rather than a glyph, so it does not depend
154+ ;; on the font having one
155+ (let [cx (+ rx 4.0) cy (+ by (/ side 2.0))]
156+ (c/draw-line! cx cy (+ rx 7.5) (+ by side -5.0) (c/th :accent-text) 2.0)
157+ (c/draw-line! (+ rx 7.5) (+ by side -5.0) (+ rx side -4.0) (+ by 5.0)
158+ (c/th :accent-text) 2.0)))
159+ (c/draw-text! s (+ rx side gap) (+ ry (/ (- rh th*) 2.0)) size (c/th :text))
160+ on?)))
161+
162+;; ------------------------------------------------------------------ slider
163+
164+(defn slider
165+ "A horizontal slider. Answers the value after this frame.
166+
167+ The drag is tracked through `capture`, so the value keeps following the
168+ pointer after it leaves the track — which is what a person expects when they
169+ drag fast, and what a plain hit-test gets wrong."
170+ ([value] (slider value {}))
171+ ([value {:keys [min max key expand step]
172+ :or {min 0.0 max 1.0 expand :horizontal}}]
173+ (let [lo (double min) hi (double max)
174+ h (double (c/th :control-height))
175+ id (c/next-id key)
176+ rect (c/leaf [120.0 h] expand [0.0 0.5])
177+ {:keys [hover? pressed? focused?]} (c/interact! id rect)
178+ [rx ry rw rh] rect
179+ knob 16.0
180+ track-h 6.0
181+ travel (clojure.core/max 1.0 (- rw knob))
182+ mx (first (:mouse (c/ui)))
183+ raw (if pressed?
184+ (+ lo (* (- hi lo)
185+ (clojure.core/max 0.0
186+ (clojure.core/min 1.0 (/ (- mx rx (/ knob 2.0)) travel)))))
187+ (double value))
188+ v (clojure.core/max lo (clojure.core/min hi
189+ (if step (* step (Math/round (/ raw (double step)))) raw)))
190+ t (if (= hi lo) 0.0 (/ (- v lo) (- hi lo)))
191+ ty (+ ry (/ (- rh track-h) 2.0))
192+ kx (+ rx (* t travel))]
193+ (c/fill! [rx ty rw track-h] (c/th :surface-alt) (/ track-h 2.0))
194+ (c/fill! [rx ty (+ (* t travel) (/ knob 2.0)) track-h] (c/th :accent)
195+ (/ track-h 2.0))
196+ (c/fill! [kx (+ ry (/ (- rh knob) 2.0)) knob knob]
197+ (if (or hover? pressed?)
198+ (theme/mix (c/th :accent) [255 255 255 255] 0.2)
199+ (c/th :accent))
200+ (/ knob 2.0)
201+ (if focused? (c/th :focus) (c/th :border))
202+ (if focused? 2.0 1.0))
203+ v)))
204+
205+;; ---------------------------------------------------------------- progress
206+
207+(defn progress
208+ ([fraction] (progress fraction {}))
209+ ([fraction {:keys [expand height] :or {expand :horizontal height 8.0}}]
210+ (let [t (max 0.0 (min 1.0 (double fraction)))
211+ rect (c/leaf [120.0 (double height)] expand [0.0 0.5])
212+ [rx ry rw rh] rect]
213+ (c/fill! rect (c/th :surface-alt) (/ rh 2.0))
214+ (when (pos? t) (c/fill! [rx ry (* t rw) rh] (c/th :accent) (/ rh 2.0)))
215+ rect)))
216+
217+;; ------------------------------------------------------------------- filler
218+
219+(defn spacer
220+ ([] (spacer {}))
221+ ([{:keys [size expand] :or {size 0.0 expand :none}}]
222+ (c/leaf [(double size) (double size)] expand [0.0 0.0])))
223+
224+(defn separator
225+ []
226+ (let [rect (c/leaf [1.0 (double (c/th :border-width))] :horizontal [0.0 0.5])]
227+ (c/fill! rect (c/th :border))
228+ rect))
229+
230+;; -------------------------------------------------------------- text entry
231+
232+(defn- clamp [v lo hi] (max lo (min hi v)))
233+
234+(defn text-entry
235+ "A single-line editable string. Answers the text after this frame.
236+
237+ The caret is an index into the string kept under the widget's id, which is
238+ the one piece of state a text field cannot recompute from its value."
239+ ([value] (text-entry value {}))
240+ ([value {:keys [key expand placeholder] :or {expand :horizontal}}]
241+ (let [size (c/th :font-size)
242+ pad (c/th :padding)
243+ h (double (c/th :control-height))
244+ id (c/next-id key)
245+ rect (c/leaf [160.0 h] expand [0.0 0.5])
246+ {:keys [hover? focused?]} (c/interact! id rect)
247+ [rx ry rw rh] rect
248+ s (str value)
249+ caret0 (clamp (c/state id :caret (count s)) 0 (count s))
250+ evs (c/key-events id)
251+ [s' caret']
252+ (reduce
253+ (fn [[s caret] e]
254+ (case (:kind e)
255+ :text (let [t (:text e)]
256+ [(str (subs s 0 caret) t (subs s caret))
257+ (+ caret (count t))])
258+ :key-down
259+ (case (:key e)
260+ :backspace (if (pos? caret)
261+ [(str (subs s 0 (dec caret)) (subs s caret))
262+ (dec caret)]
263+ [s caret])
264+ :delete (if (< caret (count s))
265+ [(str (subs s 0 caret) (subs s (inc caret))) caret]
266+ [s caret])
267+ :left [s (max 0 (dec caret))]
268+ :right [s (min (count s) (inc caret))]
269+ :home [s 0]
270+ :end [s (count s)]
271+ [s caret])
272+ [s caret]))
273+ [s caret0] (or evs []))
274+ caret' (clamp caret' 0 (count s'))]
275+ (c/state! id :caret caret')
276+ (c/fill! rect (c/th :surface) (c/th :radius)
277+ (if focused? (c/th :focus) (c/th :border))
278+ (if focused? 2.0 (c/th :border-width)))
279+ (let [[_ th*] (c/measure (if (= s' "") "M" s') size)
280+ ty (+ ry (/ (- rh th*) 2.0))]
281+ (if (and (= s' "") placeholder (not focused?))
282+ (c/draw-text! placeholder (+ rx pad) ty size (c/th :text-dim))
283+ (c/draw-text! s' (+ rx pad) ty size (c/th :text)))
284+ (when focused?
285+ (let [[cw _] (c/measure (subs s' 0 caret') size)]
286+ (c/fill! [(+ rx pad cw) (+ ty 1.0) 1.5 (- th* 2.0)] (c/th :text)))))
287+ s')))
288+
289+;; ------------------------------------------------------------------- scroll
290+
291+(defn scroll*
292+ "A clipped viewport that scrolls its contents vertically.
293+
294+ The viewport reports the height it was given, not the height of what is in
295+ it; the difference between the two is what there is to scroll, which is why
296+ `core/box*` keeps both numbers."
297+ [opts body]
298+ (let [h (double (or (:height opts) 200.0))
299+ id (c/next-id (:key opts))
300+ prev (c/data id)
301+ content-h (second (or (:content-min prev) [0.0 0.0]))
302+ view (or (:rect prev) [0.0 0.0 0.0 0.0])
303+ maxoff (max 0.0 (- content-h h))
304+ off0 (min maxoff (max 0.0 (c/state id :scroll 0.0)))
305+ off (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))
306+ off0 (or (c/wheel-events view) []))
307+ r (c/box* (merge {:dir :vertical
308+ :expand :horizontal
309+ :min-size [0.0 h]
310+ :fixed true
311+ :clip? true
312+ :spacing (c/th :spacing)
313+ :key (:key opts)
314+ :offset [0.0 (- off)]}
315+ (dissoc opts :height))
316+ body)]
317+ (c/state! id :scroll off)
318+ ;; The bar is drawn after the body so it sits over it, and only when there
319+ ;; is something to scroll.
320+ (when (pos? maxoff)
321+ (let [[vx vy vw vh] (or (:rect (c/data id)) view)
322+ bw (double (c/th :scrollbar))
323+ bh (max 24.0 (* vh (/ vh (max 1.0 content-h))))
324+ by (+ vy (* (/ off maxoff) (- vh bh)))]
325+ (c/fill! [(- (+ vx vw) bw) vy bw vh] (c/th :surface-alt) (/ bw 2.0))
326+ (c/fill! [(- (+ vx vw) bw) by bw bh] (c/th :border) (/ bw 2.0))))
327+ r))
328+
329+(defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))
new file mode 100644
@@ -0,0 +1,329 @@
1+(ns jvui.widgets
2+ "The widgets, in the calling convention dvui made popular: you call them, and
3+ what they answer is what the person did.
4+
5+ (when (w/button \"Save\") (save!))
6+ (reset! on? (w/checkbox @on? \"Enabled\"))
7+
8+ There is no widget object to hold, no handler to register and nothing to
9+ free — a button that is not called this frame is not on the screen, which is
10+ the property the whole style is for.
11+
12+ Containers are macros so their contents read as a body rather than as a
13+ closure. They are thin: each is `core/box*` with a different set of defaults
14+ from the theme."
15+ (:require [jvui.core :as c]
16+ [jvui.theme :as theme]))
17+
18+;; -------------------------------------------------------------- containers
19+
20+(defmacro box
21+ "The general container. See `core/box*` for the options."
22+ [opts & body]
23+ `(c/box* ~opts (fn [~'_id ~'_rect] ~@body)))
24+
25+(defmacro vbox [opts & body] `(box (assoc ~opts :dir :vertical) ~@body))
26+(defmacro hbox [opts & body] `(box (assoc ~opts :dir :horizontal) ~@body))
27+
28+(defn card*
29+ "A surface with a border and a radius: the thing a group of controls sits on."
30+ [opts body]
31+ (c/box* (merge {:dir :vertical
32+ :padding (c/th :padding)
33+ :spacing (c/th :spacing)
34+ :radius (c/th :radius)
35+ :fill (c/th :surface)
36+ :border {:colour (c/th :border) :width (c/th :border-width)}
37+ :expand :horizontal}
38+ opts)
39+ body))
40+
41+(defmacro card [opts & body] `(card* ~opts (fn [~'_id ~'_rect] ~@body)))
42+
43+(defn page*
44+ "The root container: the window's background, padded, with its contents kept
45+ to `:max-width` and centred in whatever is left."
46+ [opts body]
47+ (c/box* (merge {:dir :vertical :expand :both :fill (c/th :bg)
48+ :padding (c/th :padding)}
49+ (dissoc opts :max-width))
50+ (fn [_ _]
51+ ;; The column expands vertically and is *given* its width, so the
52+ ;; gravity has something left over to centre it in.
53+ (c/box* {:dir :vertical
54+ :spacing (c/th :spacing)
55+ :expand :vertical
56+ :gravity [0.5 0.0]
57+ :min-size [(min (double (or (:max-width opts) 1.0e9))
58+ (max 0.0 (- (double (first (:size (c/ui))))
59+ (* 2 (double (c/th :padding))))))
60+ 0.0]}
61+ body))))
62+
63+(defmacro page [opts & body] `(page* ~opts (fn [~'_id ~'_rect] ~@body)))
64+
65+;; -------------------------------------------------------------------- text
66+
67+(defn label
68+ "A line of text. Answers its rectangle."
69+ ([s] (label s {}))
70+ ([s {:keys [size colour expand gravity align]
71+ :or {expand :horizontal gravity [0.0 0.5] align :left}}]
72+ (let [size (or size (c/th :font-size))
73+ colour (or colour (c/th :text))
74+ [tw th*] (c/measure s size)
75+ rect (c/leaf [(double tw) (double (max th* (c/line-height size)))]
76+ expand gravity)
77+ [x y w h] rect
78+ tx (case align
79+ :center (+ x (/ (- w tw) 2.0))
80+ :right (+ x (- w tw))
81+ x)]
82+ (c/draw-text! s tx (+ y (/ (- h th*) 2.0)) size colour)
83+ rect)))
84+
85+(defn title [s & [opts]]
86+ (label s (merge {:size (c/th :font-size-title)} opts)))
87+
88+(defn dim-label [s & [opts]]
89+ (label s (merge {:colour (c/th :text-dim)} opts)))
90+
91+;; ------------------------------------------------------------------ button
92+
93+(defn button
94+ "Answers true on the frame the button is released inside itself.
95+
96+ opts: :kind (:normal or :primary) :expand :gravity :key :min-width"
97+ ([s] (button s {}))
98+ ([s {:keys [kind expand gravity key min-width]
99+ :or {kind :normal expand :none gravity [0.0 0.5]}}]
100+ (let [size (c/th :font-size)
101+ pad (c/th :padding)
102+ [tw th*] (c/measure s size)
103+ w (max (double (or min-width 0.0)) (+ tw (* 2 pad) (* 2 pad)))
104+ h (max (double (c/th :control-height)) (+ th* pad))
105+ id (c/next-id key)
106+ rect (c/leaf [w h] expand gravity)
107+ {:keys [hover? pressed? clicked? focused?]} (c/interact! id rect)
108+ primary? (= kind :primary)
109+ base (cond primary? (c/th :accent)
110+ :else (c/th :surface-alt))
111+ fill (cond pressed? (if primary?
112+ (theme/mix base [0 0 0 255] 0.25)
113+ (c/th :press))
114+ hover? (if primary?
115+ (theme/mix base [255 255 255 255] 0.12)
116+ (c/th :hover))
117+ :else base)
118+ text-colour (if primary? (c/th :accent-text) (c/th :text))
119+ [rx ry rw rh] rect]
120+ (c/fill! rect fill (c/th :radius)
121+ (if focused? (c/th :focus) (c/th :border))
122+ (if focused? 2.0 (c/th :border-width)))
123+ (c/draw-text! s (+ rx (/ (- rw tw) 2.0)) (+ ry (/ (- rh th*) 2.0))
124+ size text-colour)
125+ clicked?)))
126+
127+;; ---------------------------------------------------------------- checkbox
128+
129+(defn checkbox
130+ "Answers the value the checkbox should have after this frame."
131+ ([value s] (checkbox value s {}))
132+ ([value s {:keys [key expand] :or {expand :horizontal}}]
133+ (let [size (c/th :font-size)
134+ gap 8.0
135+ side 18.0
136+ [tw th*] (c/measure s size)
137+ h (max side (double th*))
138+ id (c/next-id key)
139+ rect (c/leaf [(+ side gap tw) h] expand [0.0 0.5])
140+ {:keys [hover? clicked? focused?]} (c/interact! id rect)
141+ [rx ry _ rh] rect
142+ by (+ ry (/ (- rh side) 2.0))
143+ boxr [rx by side side]
144+ on? (if clicked? (not value) value)]
145+ (c/fill! boxr
146+ (cond on? (c/th :accent)
147+ hover? (c/th :hover)
148+ :else (c/th :surface-alt))
149+ 4.0
150+ (if focused? (c/th :focus) (c/th :border))
151+ (if focused? 2.0 (c/th :border-width)))
152+ (when on?
153+ ;; the tick, as two strokes rather than a glyph, so it does not depend
154+ ;; on the font having one
155+ (let [cx (+ rx 4.0) cy (+ by (/ side 2.0))]
156+ (c/draw-line! cx cy (+ rx 7.5) (+ by side -5.0) (c/th :accent-text) 2.0)
157+ (c/draw-line! (+ rx 7.5) (+ by side -5.0) (+ rx side -4.0) (+ by 5.0)
158+ (c/th :accent-text) 2.0)))
159+ (c/draw-text! s (+ rx side gap) (+ ry (/ (- rh th*) 2.0)) size (c/th :text))
160+ on?)))
161+
162+;; ------------------------------------------------------------------ slider
163+
164+(defn slider
165+ "A horizontal slider. Answers the value after this frame.
166+
167+ The drag is tracked through `capture`, so the value keeps following the
168+ pointer after it leaves the track — which is what a person expects when they
169+ drag fast, and what a plain hit-test gets wrong."
170+ ([value] (slider value {}))
171+ ([value {:keys [min max key expand step]
172+ :or {min 0.0 max 1.0 expand :horizontal}}]
173+ (let [lo (double min) hi (double max)
174+ h (double (c/th :control-height))
175+ id (c/next-id key)
176+ rect (c/leaf [120.0 h] expand [0.0 0.5])
177+ {:keys [hover? pressed? focused?]} (c/interact! id rect)
178+ [rx ry rw rh] rect
179+ knob 16.0
180+ track-h 6.0
181+ travel (clojure.core/max 1.0 (- rw knob))
182+ mx (first (:mouse (c/ui)))
183+ raw (if pressed?
184+ (+ lo (* (- hi lo)
185+ (clojure.core/max 0.0
186+ (clojure.core/min 1.0 (/ (- mx rx (/ knob 2.0)) travel)))))
187+ (double value))
188+ v (clojure.core/max lo (clojure.core/min hi
189+ (if step (* step (Math/round (/ raw (double step)))) raw)))
190+ t (if (= hi lo) 0.0 (/ (- v lo) (- hi lo)))
191+ ty (+ ry (/ (- rh track-h) 2.0))
192+ kx (+ rx (* t travel))]
193+ (c/fill! [rx ty rw track-h] (c/th :surface-alt) (/ track-h 2.0))
194+ (c/fill! [rx ty (+ (* t travel) (/ knob 2.0)) track-h] (c/th :accent)
195+ (/ track-h 2.0))
196+ (c/fill! [kx (+ ry (/ (- rh knob) 2.0)) knob knob]
197+ (if (or hover? pressed?)
198+ (theme/mix (c/th :accent) [255 255 255 255] 0.2)
199+ (c/th :accent))
200+ (/ knob 2.0)
201+ (if focused? (c/th :focus) (c/th :border))
202+ (if focused? 2.0 1.0))
203+ v)))
204+
205+;; ---------------------------------------------------------------- progress
206+
207+(defn progress
208+ ([fraction] (progress fraction {}))
209+ ([fraction {:keys [expand height] :or {expand :horizontal height 8.0}}]
210+ (let [t (max 0.0 (min 1.0 (double fraction)))
211+ rect (c/leaf [120.0 (double height)] expand [0.0 0.5])
212+ [rx ry rw rh] rect]
213+ (c/fill! rect (c/th :surface-alt) (/ rh 2.0))
214+ (when (pos? t) (c/fill! [rx ry (* t rw) rh] (c/th :accent) (/ rh 2.0)))
215+ rect)))
216+
217+;; ------------------------------------------------------------------- filler
218+
219+(defn spacer
220+ ([] (spacer {}))
221+ ([{:keys [size expand] :or {size 0.0 expand :none}}]
222+ (c/leaf [(double size) (double size)] expand [0.0 0.0])))
223+
224+(defn separator
225+ []
226+ (let [rect (c/leaf [1.0 (double (c/th :border-width))] :horizontal [0.0 0.5])]
227+ (c/fill! rect (c/th :border))
228+ rect))
229+
230+;; -------------------------------------------------------------- text entry
231+
232+(defn- clamp [v lo hi] (max lo (min hi v)))
233+
234+(defn text-entry
235+ "A single-line editable string. Answers the text after this frame.
236+
237+ The caret is an index into the string kept under the widget's id, which is
238+ the one piece of state a text field cannot recompute from its value."
239+ ([value] (text-entry value {}))
240+ ([value {:keys [key expand placeholder] :or {expand :horizontal}}]
241+ (let [size (c/th :font-size)
242+ pad (c/th :padding)
243+ h (double (c/th :control-height))
244+ id (c/next-id key)
245+ rect (c/leaf [160.0 h] expand [0.0 0.5])
246+ {:keys [hover? focused?]} (c/interact! id rect)
247+ [rx ry rw rh] rect
248+ s (str value)
249+ caret0 (clamp (c/state id :caret (count s)) 0 (count s))
250+ evs (c/key-events id)
251+ [s' caret']
252+ (reduce
253+ (fn [[s caret] e]
254+ (case (:kind e)
255+ :text (let [t (:text e)]
256+ [(str (subs s 0 caret) t (subs s caret))
257+ (+ caret (count t))])
258+ :key-down
259+ (case (:key e)
260+ :backspace (if (pos? caret)
261+ [(str (subs s 0 (dec caret)) (subs s caret))
262+ (dec caret)]
263+ [s caret])
264+ :delete (if (< caret (count s))
265+ [(str (subs s 0 caret) (subs s (inc caret))) caret]
266+ [s caret])
267+ :left [s (max 0 (dec caret))]
268+ :right [s (min (count s) (inc caret))]
269+ :home [s 0]
270+ :end [s (count s)]
271+ [s caret])
272+ [s caret]))
273+ [s caret0] (or evs []))
274+ caret' (clamp caret' 0 (count s'))]
275+ (c/state! id :caret caret')
276+ (c/fill! rect (c/th :surface) (c/th :radius)
277+ (if focused? (c/th :focus) (c/th :border))
278+ (if focused? 2.0 (c/th :border-width)))
279+ (let [[_ th*] (c/measure (if (= s' "") "M" s') size)
280+ ty (+ ry (/ (- rh th*) 2.0))]
281+ (if (and (= s' "") placeholder (not focused?))
282+ (c/draw-text! placeholder (+ rx pad) ty size (c/th :text-dim))
283+ (c/draw-text! s' (+ rx pad) ty size (c/th :text)))
284+ (when focused?
285+ (let [[cw _] (c/measure (subs s' 0 caret') size)]
286+ (c/fill! [(+ rx pad cw) (+ ty 1.0) 1.5 (- th* 2.0)] (c/th :text)))))
287+ s')))
288+
289+;; ------------------------------------------------------------------- scroll
290+
291+(defn scroll*
292+ "A clipped viewport that scrolls its contents vertically.
293+
294+ The viewport reports the height it was given, not the height of what is in
295+ it; the difference between the two is what there is to scroll, which is why
296+ `core/box*` keeps both numbers."
297+ [opts body]
298+ (let [h (double (or (:height opts) 200.0))
299+ id (c/next-id (:key opts))
300+ prev (c/data id)
301+ content-h (second (or (:content-min prev) [0.0 0.0]))
302+ view (or (:rect prev) [0.0 0.0 0.0 0.0])
303+ maxoff (max 0.0 (- content-h h))
304+ off0 (min maxoff (max 0.0 (c/state id :scroll 0.0)))
305+ off (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))
306+ off0 (or (c/wheel-events view) []))
307+ r (c/box* (merge {:dir :vertical
308+ :expand :horizontal
309+ :min-size [0.0 h]
310+ :fixed true
311+ :clip? true
312+ :spacing (c/th :spacing)
313+ :key (:key opts)
314+ :offset [0.0 (- off)]}
315+ (dissoc opts :height))
316+ body)]
317+ (c/state! id :scroll off)
318+ ;; The bar is drawn after the body so it sits over it, and only when there
319+ ;; is something to scroll.
320+ (when (pos? maxoff)
321+ (let [[vx vy vw vh] (or (:rect (c/data id)) view)
322+ bw (double (c/th :scrollbar))
323+ bh (max 24.0 (* vh (/ vh (max 1.0 content-h))))
324+ by (+ vy (* (/ off maxoff) (- vh bh)))]
325+ (c/fill! [(- (+ vx vw) bw) vy bw vh] (c/th :surface-alt) (/ bw 2.0))
326+ (c/fill! [(- (+ vx vw) bw) by bw bh] (c/th :border) (/ bw 2.0))))
327+ r))
328+
329+(defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))
added jvui/test/jvui/tests.clj +299 -0
new file mode 100644
@@ -0,0 +1,299 @@
1+(ns jvui.tests
2+ "Every check here runs headless: no window, no SDL, no font. The engine takes
3+ its measurer as a function, so a stub that says eight pixels a character is
4+ enough to test every question layout actually asks. `jolt test`.
5+
6+ What is deliberately not tested here is what a screenshot answers better —
7+ whether a rounded corner looks like one. `jolt counter --shot` does that."
8+ (:require [jvui.core :as c]
9+ [jvui.widgets :as w]
10+ [jvui.theme :as theme]))
11+
12+(def ^:private failures (atom 0))
13+
14+(defn- check!
15+ [ok? msg]
16+ (when-not ok?
17+ (swap! failures inc)
18+ (println " FAIL:" msg)))
19+
20+(defn- close? [a b] (< (Math/abs (double (- a b))) 0.51))
21+
22+;; A stub font: eight pixels a character, sixteen tall. Every expected number
23+;; below is derived from these two, so the tests say what the layout does and
24+;; not what a particular face happens to measure.
25+(defn- ctx []
26+ (c/context {:size [400 300]
27+ :measure (fn [s _] [(* 8.0 (count s)) 16.0])
28+ :line-height (fn [_] 16.0)}))
29+
30+(defn- frame!
31+ "One frame with `evs` delivered, exactly as the window loop would."
32+ ([cx render] (frame! cx render []))
33+ ([cx render evs]
34+ (swap! cx assoc :events evs)
35+ (swap! cx c/apply-input evs)
36+ (c/frame! cx render)
37+ cx))
38+
39+(defn- rects
40+ "Run `render` and collect the rectangle each labelled widget got."
41+ [cx render evs]
42+ (let [seen (atom {})]
43+ (frame! cx (fn [] (render seen)) evs)
44+ @seen))
45+
46+;; --- placement ---------------------------------------------------------------
47+
48+(defn- check-leaf! []
49+ (let [cx (ctx)
50+ r (atom nil)]
51+ (frame! cx (fn [] (reset! r (w/label "hello" {:expand :none}))))
52+ (let [[x y ww hh] @r]
53+ (check! (and (close? x 0) (close? y 0)) "a leaf starts at the origin")
54+ (check! (close? ww 40) "five characters at eight pixels is forty wide")
55+ (check! (close? hh 16) "and one line tall"))))
56+
57+(defn- check-vbox-stacks! []
58+ (let [cx (ctx) seen (atom [])]
59+ (frame! cx (fn []
60+ (w/vbox {:spacing 4}
61+ (swap! seen conj (w/label "a" {:expand :none}))
62+ (swap! seen conj (w/label "b" {:expand :none})))))
63+ (let [[[_ y1] [_ y2]] @seen]
64+ (check! (close? y1 0) "the first child sits at the top")
65+ (check! (close? y2 20) "the second clears it by its height plus the spacing"))))
66+
67+(defn- check-hbox-runs! []
68+ (let [cx (ctx) seen (atom [])]
69+ (frame! cx (fn []
70+ (w/hbox {:spacing 6}
71+ (swap! seen conj (w/label "ab" {:expand :none}))
72+ (swap! seen conj (w/label "c" {:expand :none})))))
73+ (let [[[x1] [x2]] @seen]
74+ (check! (close? x1 0) "a row starts at the left")
75+ (check! (close? x2 22) "and the next child clears the first plus spacing"))))
76+
77+(defn- check-expand-shares! []
78+ ;; Two expanding children in a 300-tall column split what is left after the
79+ ;; fixed one — the number the box remembered from the frame before.
80+ (let [cx (ctx) seen (atom [])]
81+ (dotimes [_ 3]
82+ (reset! seen [])
83+ (frame! cx (fn []
84+ (w/vbox {:expand :both}
85+ (swap! seen conj (w/label "fixed" {:expand :horizontal}))
86+ (swap! seen conj (w/label "a" {:expand :both}))
87+ (swap! seen conj (w/label "b" {:expand :both}))))))
88+ (let [[_ [_ _ _ h2] [_ _ _ h3]] @seen]
89+ (check! (close? h2 h3) "equal weights get equal shares")
90+ (check! (close? h2 (/ (- 300 16) 2.0))
91+ (str "and the share is what the fixed child left: " h2)))))
92+
93+(defn- check-gravity-centres! []
94+ (let [cx (ctx) r (atom nil)]
95+ (frame! cx (fn []
96+ (w/vbox {:expand :both}
97+ (reset! r (w/label "ab" {:expand :none :gravity [0.5 0.0]})))))
98+ (check! (close? (first @r) (/ (- 400 16) 2.0))
99+ "half the leftover width sits to the left of a centred child")))
100+
101+(defn- check-layout-settles! []
102+ ;; A container cannot know its size before it has walked its children, so the
103+ ;; first walk of a new tree is wrong. The point of `frame!` is that nobody
104+ ;; ever sees that walk: by the time it paints, the numbers have settled.
105+ (let [cx (ctx) r (atom nil)]
106+ (frame! cx (fn []
107+ (w/vbox {:expand :none :padding 5}
108+ (w/label "hello" {:expand :none})
109+ (reset! r (w/label "hi" {:expand :none})))))
110+ (let [box (first (filter :content (vals (:data @cx))))]
111+ (check! (close? (first (:min-size box)) 50)
112+ "the box measures its widest child plus its padding")
113+ (check! (close? (second (:min-size box)) 42)
114+ "and the run of them, on the first frame anyone sees"))))
115+
116+;; --- identity ----------------------------------------------------------------
117+
118+(defn- check-ids-are-stable! []
119+ (let [cx (ctx) ids (atom [])]
120+ (dotimes [_ 2]
121+ (reset! ids [])
122+ (frame! cx (fn []
123+ (w/vbox {}
124+ (w/button "one")
125+ (swap! ids conj (c/next-id nil))
126+ (w/button "two")))))
127+ (check! (some? (first @ids)) "an id exists")
128+ (check! (= 1 (count (distinct @ids)))
129+ "and the same widget gets the same one on the next frame")))
130+
131+(defn- check-a-key-survives-a-reorder! []
132+ ;; The bug a key exists to stop: a list reorders, every index after the moved
133+ ;; item changes, and each widget inherits the caret and the scroll offset of
134+ ;; whichever one used to sit at its index.
135+ (let [cx (ctx) seen (atom {})
136+ render (fn [order]
137+ (fn [] (w/vbox {}
138+ (doseq [k order]
139+ (w/box {:key k}
140+ (swap! seen assoc k (c/next-id nil)))))))]
141+ (frame! cx (render [:a :b :c]))
142+ (let [before @seen]
143+ (reset! seen {})
144+ (frame! cx (render [:c :a :b]))
145+ (check! (= (:a before) (:a @seen))
146+ "a keyed widget keeps its identity when its index changes")
147+ (check! (= (:c before) (:c @seen))
148+ "including the one that moved to the front"))))
149+
150+(defn- check-keys-separate-siblings! []
151+ (let [cx (ctx) ids (atom #{})]
152+ (frame! cx (fn []
153+ (w/vbox {}
154+ (doseq [k [:a :b]]
155+ (w/box {:key k}
156+ (swap! ids conj (c/next-id nil)))))))
157+ (check! (= 2 (count @ids)) "two keyed containers are two identities")))
158+
159+;; --- events ------------------------------------------------------------------
160+
161+(defn- click-at [x y]
162+ [{:kind :motion :x x :y y}
163+ {:kind :mouse-down :x x :y y :button 1 :clicks 1}
164+ {:kind :mouse-up :x x :y y :button 1}])
165+
166+(defn- check-button-clicks! []
167+ (let [cx (ctx) hits (atom 0)]
168+ (frame! cx (fn [] (when (w/button "go" {:expand :none}) (swap! hits inc))))
169+ (check! (zero? @hits) "a button nobody touched reports nothing")
170+ (frame! cx (fn [] (when (w/button "go" {:expand :none}) (swap! hits inc)))
171+ (click-at 10 10))
172+ (check! (= 1 @hits) "a press and release inside it is a click")))
173+
174+(defn- check-release-outside-is-not-a-click! []
175+ (let [cx (ctx) hits (atom 0)
176+ render (fn [] (when (w/button "go" {:expand :none}) (swap! hits inc)))]
177+ (frame! cx render)
178+ (frame! cx render [{:kind :mouse-down :x 10 :y 10 :button 1 :clicks 1}])
179+ (check! (zero? @hits) "a press alone is not a click")
180+ (frame! cx render [{:kind :motion :x 300 :y 200}
181+ {:kind :mouse-up :x 300 :y 200 :button 1}])
182+ (check! (zero? @hits)
183+ "and sliding off before letting go is how someone changes their mind")))
184+
185+(defn- check-press-keeps-capture! []
186+ (let [cx (ctx) state (atom nil)
187+ render (fn [] (reset! state (w/slider (or (:v @state) 0.0)
188+ {:expand :none :min 0.0 :max 1.0})))]
189+ (frame! cx (fn [] (w/slider 0.0 {:expand :none})))
190+ ;; press in the middle of the track, then drag past its right edge: the
191+ ;; value must follow the pointer, not stop at the edge of the rectangle.
192+ (let [v (atom 0.0)
193+ render (fn [] (reset! v (w/slider @v {:expand :none :min 0.0 :max 1.0})))]
194+ (frame! cx render)
195+ (frame! cx render [{:kind :mouse-down :x 60 :y 15 :button 1 :clicks 1}])
196+ (check! (> @v 0.2) (str "the press moved the slider: " @v))
197+ (frame! cx render [{:kind :motion :x 400 :y 300}])
198+ (check! (close? @v 1.0)
199+ (str "and a drag beyond the track pins it at the maximum: " @v)))))
200+
201+(defn- check-checkbox-toggles! []
202+ (let [cx (ctx) on? (atom false)
203+ render (fn [] (reset! on? (w/checkbox @on? "x" {:expand :none})))]
204+ (frame! cx render)
205+ (frame! cx render (click-at 8 8))
206+ (check! (true? @on?) "a click turns it on")
207+ (frame! cx render (click-at 8 8))
208+ (check! (false? @on?) "and the next one turns it off")))
209+
210+(defn- check-text-entry! []
211+ (let [cx (ctx) s (atom "")
212+ render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
213+ (frame! cx render)
214+ (frame! cx render (click-at 10 10)) ; take focus
215+ (frame! cx render [{:kind :text :text "hi"}])
216+ (check! (= "hi" @s) (str "typing inserts at the caret: " (pr-str @s)))
217+ (frame! cx render [{:kind :key-down :key :backspace}])
218+ (check! (= "h" @s) "backspace deletes behind it")
219+ (frame! cx render [{:kind :key-down :key :left}
220+ {:kind :text :text "a"}])
221+ (check! (= "ah" @s) "and the caret moves where it is told")))
222+
223+(defn- check-unfocused-entry-ignores-keys! []
224+ (let [cx (ctx) s (atom "")
225+ render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
226+ (frame! cx render)
227+ (frame! cx render [{:kind :text :text "no"}])
228+ (check! (= "" @s) "a field nobody focused takes no text")))
229+
230+(defn- check-tab-moves-focus! []
231+ (let [cx (ctx) ids (atom [])
232+ render (fn []
233+ (reset! ids [])
234+ (w/vbox {}
235+ (swap! ids conj (c/next-id nil)) (w/button "a")
236+ (swap! ids conj (c/next-id nil)) (w/button "b")))]
237+ (frame! cx render)
238+ (frame! cx render [{:kind :key-down :key :tab}])
239+ (let [f1 (:focus @cx)]
240+ (check! (some? f1) "tab takes focus somewhere")
241+ (frame! cx render [{:kind :key-down :key :tab}])
242+ (check! (not= f1 (:focus @cx)) "and again moves it on"))))
243+
244+;; --- scrolling ---------------------------------------------------------------
245+
246+(defn- check-scroll! []
247+ (let [cx (ctx) first-y (atom nil)
248+ render (fn []
249+ (w/scroll {:height 100}
250+ (reset! first-y (second (w/label "row 0" {:expand :none})))
251+ (doseq [i (range 1 20)]
252+ (w/label (str "row " i) {:expand :none}))))]
253+ (dotimes [_ 2] (frame! cx render))
254+ (let [top @first-y
255+ view (first (filter #(= [0.0 100.0] (:min-size %)) (vals (:data @cx))))]
256+ (check! (some? view) "the viewport reports the height it was given")
257+ (check! (> (second (:content-min view)) 100.0)
258+ "and remembers that its contents are taller")
259+ (frame! cx render [{:kind :motion :x 50 :y 50}
260+ {:kind :wheel :dx 0.0 :dy -3.0}])
261+ (check! (< @first-y top)
262+ (str "a wheel down moves the contents up: " top " -> " @first-y)))))
263+
264+;; --- theme -------------------------------------------------------------------
265+
266+(defn- check-theme! []
267+ (check! (= [0 0 0 255] (theme/mix [0 0 0 255] [255 255 255 255] 0.0)) "mix at 0")
268+ (check! (= [127 127 127 255] (theme/mix [0 0 0 255] [254 254 254 255] 0.5))
269+ "and halfway"))
270+
271+;; --- runner ------------------------------------------------------------------
272+
273+(def ^:private checks
274+ [["a leaf is placed" check-leaf!]
275+ ["a column stacks" check-vbox-stacks!]
276+ ["a row runs" check-hbox-runs!]
277+ ["expand shares the slack" check-expand-shares!]
278+ ["gravity centres" check-gravity-centres!]
279+ ["layout settles unseen" check-layout-settles!]
280+ ["ids are stable" check-ids-are-stable!]
281+ ["keys separate siblings" check-keys-separate-siblings!]
282+ ["a key survives a reorder" check-a-key-survives-a-reorder!]
283+ ["a button clicks" check-button-clicks!]
284+ ["releasing outside does not" check-release-outside-is-not-a-click!]
285+ ["a press captures" check-press-keeps-capture!]
286+ ["a checkbox toggles" check-checkbox-toggles!]
287+ ["a field takes text" check-text-entry!]
288+ ["an unfocused field does not" check-unfocused-entry-ignores-keys!]
289+ ["tab moves focus" check-tab-moves-focus!]
290+ ["a viewport scrolls" check-scroll!]
291+ ["the theme mixes" check-theme!]])
292+
293+(defn -main [& _]
294+ (doseq [[name f] checks]
295+ (println "-" name)
296+ (f))
297+ (if (zero? @failures)
298+ (println "\nall" (count checks) "checks passed")
299+ (do (println "\n" @failures "failed") (System/exit 1))))
new file mode 100644
@@ -0,0 +1,299 @@
1+(ns jvui.tests
2+ "Every check here runs headless: no window, no SDL, no font. The engine takes
3+ its measurer as a function, so a stub that says eight pixels a character is
4+ enough to test every question layout actually asks. `jolt test`.
5+
6+ What is deliberately not tested here is what a screenshot answers better —
7+ whether a rounded corner looks like one. `jolt counter --shot` does that."
8+ (:require [jvui.core :as c]
9+ [jvui.widgets :as w]
10+ [jvui.theme :as theme]))
11+
12+(def ^:private failures (atom 0))
13+
14+(defn- check!
15+ [ok? msg]
16+ (when-not ok?
17+ (swap! failures inc)
18+ (println " FAIL:" msg)))
19+
20+(defn- close? [a b] (< (Math/abs (double (- a b))) 0.51))
21+
22+;; A stub font: eight pixels a character, sixteen tall. Every expected number
23+;; below is derived from these two, so the tests say what the layout does and
24+;; not what a particular face happens to measure.
25+(defn- ctx []
26+ (c/context {:size [400 300]
27+ :measure (fn [s _] [(* 8.0 (count s)) 16.0])
28+ :line-height (fn [_] 16.0)}))
29+
30+(defn- frame!
31+ "One frame with `evs` delivered, exactly as the window loop would."
32+ ([cx render] (frame! cx render []))
33+ ([cx render evs]
34+ (swap! cx assoc :events evs)
35+ (swap! cx c/apply-input evs)
36+ (c/frame! cx render)
37+ cx))
38+
39+(defn- rects
40+ "Run `render` and collect the rectangle each labelled widget got."
41+ [cx render evs]
42+ (let [seen (atom {})]
43+ (frame! cx (fn [] (render seen)) evs)
44+ @seen))
45+
46+;; --- placement ---------------------------------------------------------------
47+
48+(defn- check-leaf! []
49+ (let [cx (ctx)
50+ r (atom nil)]
51+ (frame! cx (fn [] (reset! r (w/label "hello" {:expand :none}))))
52+ (let [[x y ww hh] @r]
53+ (check! (and (close? x 0) (close? y 0)) "a leaf starts at the origin")
54+ (check! (close? ww 40) "five characters at eight pixels is forty wide")
55+ (check! (close? hh 16) "and one line tall"))))
56+
57+(defn- check-vbox-stacks! []
58+ (let [cx (ctx) seen (atom [])]
59+ (frame! cx (fn []
60+ (w/vbox {:spacing 4}
61+ (swap! seen conj (w/label "a" {:expand :none}))
62+ (swap! seen conj (w/label "b" {:expand :none})))))
63+ (let [[[_ y1] [_ y2]] @seen]
64+ (check! (close? y1 0) "the first child sits at the top")
65+ (check! (close? y2 20) "the second clears it by its height plus the spacing"))))
66+
67+(defn- check-hbox-runs! []
68+ (let [cx (ctx) seen (atom [])]
69+ (frame! cx (fn []
70+ (w/hbox {:spacing 6}
71+ (swap! seen conj (w/label "ab" {:expand :none}))
72+ (swap! seen conj (w/label "c" {:expand :none})))))
73+ (let [[[x1] [x2]] @seen]
74+ (check! (close? x1 0) "a row starts at the left")
75+ (check! (close? x2 22) "and the next child clears the first plus spacing"))))
76+
77+(defn- check-expand-shares! []
78+ ;; Two expanding children in a 300-tall column split what is left after the
79+ ;; fixed one — the number the box remembered from the frame before.
80+ (let [cx (ctx) seen (atom [])]
81+ (dotimes [_ 3]
82+ (reset! seen [])
83+ (frame! cx (fn []
84+ (w/vbox {:expand :both}
85+ (swap! seen conj (w/label "fixed" {:expand :horizontal}))
86+ (swap! seen conj (w/label "a" {:expand :both}))
87+ (swap! seen conj (w/label "b" {:expand :both}))))))
88+ (let [[_ [_ _ _ h2] [_ _ _ h3]] @seen]
89+ (check! (close? h2 h3) "equal weights get equal shares")
90+ (check! (close? h2 (/ (- 300 16) 2.0))
91+ (str "and the share is what the fixed child left: " h2)))))
92+
93+(defn- check-gravity-centres! []
94+ (let [cx (ctx) r (atom nil)]
95+ (frame! cx (fn []
96+ (w/vbox {:expand :both}
97+ (reset! r (w/label "ab" {:expand :none :gravity [0.5 0.0]})))))
98+ (check! (close? (first @r) (/ (- 400 16) 2.0))
99+ "half the leftover width sits to the left of a centred child")))
100+
101+(defn- check-layout-settles! []
102+ ;; A container cannot know its size before it has walked its children, so the
103+ ;; first walk of a new tree is wrong. The point of `frame!` is that nobody
104+ ;; ever sees that walk: by the time it paints, the numbers have settled.
105+ (let [cx (ctx) r (atom nil)]
106+ (frame! cx (fn []
107+ (w/vbox {:expand :none :padding 5}
108+ (w/label "hello" {:expand :none})
109+ (reset! r (w/label "hi" {:expand :none})))))
110+ (let [box (first (filter :content (vals (:data @cx))))]
111+ (check! (close? (first (:min-size box)) 50)
112+ "the box measures its widest child plus its padding")
113+ (check! (close? (second (:min-size box)) 42)
114+ "and the run of them, on the first frame anyone sees"))))
115+
116+;; --- identity ----------------------------------------------------------------
117+
118+(defn- check-ids-are-stable! []
119+ (let [cx (ctx) ids (atom [])]
120+ (dotimes [_ 2]
121+ (reset! ids [])
122+ (frame! cx (fn []
123+ (w/vbox {}
124+ (w/button "one")
125+ (swap! ids conj (c/next-id nil))
126+ (w/button "two")))))
127+ (check! (some? (first @ids)) "an id exists")
128+ (check! (= 1 (count (distinct @ids)))
129+ "and the same widget gets the same one on the next frame")))
130+
131+(defn- check-a-key-survives-a-reorder! []
132+ ;; The bug a key exists to stop: a list reorders, every index after the moved
133+ ;; item changes, and each widget inherits the caret and the scroll offset of
134+ ;; whichever one used to sit at its index.
135+ (let [cx (ctx) seen (atom {})
136+ render (fn [order]
137+ (fn [] (w/vbox {}
138+ (doseq [k order]
139+ (w/box {:key k}
140+ (swap! seen assoc k (c/next-id nil)))))))]
141+ (frame! cx (render [:a :b :c]))
142+ (let [before @seen]
143+ (reset! seen {})
144+ (frame! cx (render [:c :a :b]))
145+ (check! (= (:a before) (:a @seen))
146+ "a keyed widget keeps its identity when its index changes")
147+ (check! (= (:c before) (:c @seen))
148+ "including the one that moved to the front"))))
149+
150+(defn- check-keys-separate-siblings! []
151+ (let [cx (ctx) ids (atom #{})]
152+ (frame! cx (fn []
153+ (w/vbox {}
154+ (doseq [k [:a :b]]
155+ (w/box {:key k}
156+ (swap! ids conj (c/next-id nil)))))))
157+ (check! (= 2 (count @ids)) "two keyed containers are two identities")))
158+
159+;; --- events ------------------------------------------------------------------
160+
161+(defn- click-at [x y]
162+ [{:kind :motion :x x :y y}
163+ {:kind :mouse-down :x x :y y :button 1 :clicks 1}
164+ {:kind :mouse-up :x x :y y :button 1}])
165+
166+(defn- check-button-clicks! []
167+ (let [cx (ctx) hits (atom 0)]
168+ (frame! cx (fn [] (when (w/button "go" {:expand :none}) (swap! hits inc))))
169+ (check! (zero? @hits) "a button nobody touched reports nothing")
170+ (frame! cx (fn [] (when (w/button "go" {:expand :none}) (swap! hits inc)))
171+ (click-at 10 10))
172+ (check! (= 1 @hits) "a press and release inside it is a click")))
173+
174+(defn- check-release-outside-is-not-a-click! []
175+ (let [cx (ctx) hits (atom 0)
176+ render (fn [] (when (w/button "go" {:expand :none}) (swap! hits inc)))]
177+ (frame! cx render)
178+ (frame! cx render [{:kind :mouse-down :x 10 :y 10 :button 1 :clicks 1}])
179+ (check! (zero? @hits) "a press alone is not a click")
180+ (frame! cx render [{:kind :motion :x 300 :y 200}
181+ {:kind :mouse-up :x 300 :y 200 :button 1}])
182+ (check! (zero? @hits)
183+ "and sliding off before letting go is how someone changes their mind")))
184+
185+(defn- check-press-keeps-capture! []
186+ (let [cx (ctx) state (atom nil)
187+ render (fn [] (reset! state (w/slider (or (:v @state) 0.0)
188+ {:expand :none :min 0.0 :max 1.0})))]
189+ (frame! cx (fn [] (w/slider 0.0 {:expand :none})))
190+ ;; press in the middle of the track, then drag past its right edge: the
191+ ;; value must follow the pointer, not stop at the edge of the rectangle.
192+ (let [v (atom 0.0)
193+ render (fn [] (reset! v (w/slider @v {:expand :none :min 0.0 :max 1.0})))]
194+ (frame! cx render)
195+ (frame! cx render [{:kind :mouse-down :x 60 :y 15 :button 1 :clicks 1}])
196+ (check! (> @v 0.2) (str "the press moved the slider: " @v))
197+ (frame! cx render [{:kind :motion :x 400 :y 300}])
198+ (check! (close? @v 1.0)
199+ (str "and a drag beyond the track pins it at the maximum: " @v)))))
200+
201+(defn- check-checkbox-toggles! []
202+ (let [cx (ctx) on? (atom false)
203+ render (fn [] (reset! on? (w/checkbox @on? "x" {:expand :none})))]
204+ (frame! cx render)
205+ (frame! cx render (click-at 8 8))
206+ (check! (true? @on?) "a click turns it on")
207+ (frame! cx render (click-at 8 8))
208+ (check! (false? @on?) "and the next one turns it off")))
209+
210+(defn- check-text-entry! []
211+ (let [cx (ctx) s (atom "")
212+ render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
213+ (frame! cx render)
214+ (frame! cx render (click-at 10 10)) ; take focus
215+ (frame! cx render [{:kind :text :text "hi"}])
216+ (check! (= "hi" @s) (str "typing inserts at the caret: " (pr-str @s)))
217+ (frame! cx render [{:kind :key-down :key :backspace}])
218+ (check! (= "h" @s) "backspace deletes behind it")
219+ (frame! cx render [{:kind :key-down :key :left}
220+ {:kind :text :text "a"}])
221+ (check! (= "ah" @s) "and the caret moves where it is told")))
222+
223+(defn- check-unfocused-entry-ignores-keys! []
224+ (let [cx (ctx) s (atom "")
225+ render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
226+ (frame! cx render)
227+ (frame! cx render [{:kind :text :text "no"}])
228+ (check! (= "" @s) "a field nobody focused takes no text")))
229+
230+(defn- check-tab-moves-focus! []
231+ (let [cx (ctx) ids (atom [])
232+ render (fn []
233+ (reset! ids [])
234+ (w/vbox {}
235+ (swap! ids conj (c/next-id nil)) (w/button "a")
236+ (swap! ids conj (c/next-id nil)) (w/button "b")))]
237+ (frame! cx render)
238+ (frame! cx render [{:kind :key-down :key :tab}])
239+ (let [f1 (:focus @cx)]
240+ (check! (some? f1) "tab takes focus somewhere")
241+ (frame! cx render [{:kind :key-down :key :tab}])
242+ (check! (not= f1 (:focus @cx)) "and again moves it on"))))
243+
244+;; --- scrolling ---------------------------------------------------------------
245+
246+(defn- check-scroll! []
247+ (let [cx (ctx) first-y (atom nil)
248+ render (fn []
249+ (w/scroll {:height 100}
250+ (reset! first-y (second (w/label "row 0" {:expand :none})))
251+ (doseq [i (range 1 20)]
252+ (w/label (str "row " i) {:expand :none}))))]
253+ (dotimes [_ 2] (frame! cx render))
254+ (let [top @first-y
255+ view (first (filter #(= [0.0 100.0] (:min-size %)) (vals (:data @cx))))]
256+ (check! (some? view) "the viewport reports the height it was given")
257+ (check! (> (second (:content-min view)) 100.0)
258+ "and remembers that its contents are taller")
259+ (frame! cx render [{:kind :motion :x 50 :y 50}
260+ {:kind :wheel :dx 0.0 :dy -3.0}])
261+ (check! (< @first-y top)
262+ (str "a wheel down moves the contents up: " top " -> " @first-y)))))
263+
264+;; --- theme -------------------------------------------------------------------
265+
266+(defn- check-theme! []
267+ (check! (= [0 0 0 255] (theme/mix [0 0 0 255] [255 255 255 255] 0.0)) "mix at 0")
268+ (check! (= [127 127 127 255] (theme/mix [0 0 0 255] [254 254 254 255] 0.5))
269+ "and halfway"))
270+
271+;; --- runner ------------------------------------------------------------------
272+
273+(def ^:private checks
274+ [["a leaf is placed" check-leaf!]
275+ ["a column stacks" check-vbox-stacks!]
276+ ["a row runs" check-hbox-runs!]
277+ ["expand shares the slack" check-expand-shares!]
278+ ["gravity centres" check-gravity-centres!]
279+ ["layout settles unseen" check-layout-settles!]
280+ ["ids are stable" check-ids-are-stable!]
281+ ["keys separate siblings" check-keys-separate-siblings!]
282+ ["a key survives a reorder" check-a-key-survives-a-reorder!]
283+ ["a button clicks" check-button-clicks!]
284+ ["releasing outside does not" check-release-outside-is-not-a-click!]
285+ ["a press captures" check-press-keeps-capture!]
286+ ["a checkbox toggles" check-checkbox-toggles!]
287+ ["a field takes text" check-text-entry!]
288+ ["an unfocused field does not" check-unfocused-entry-ignores-keys!]
289+ ["tab moves focus" check-tab-moves-focus!]
290+ ["a viewport scrolls" check-scroll!]
291+ ["the theme mixes" check-theme!]])
292+
293+(defn -main [& _]
294+ (doseq [[name f] checks]
295+ (println "-" name)
296+ (f))
297+ (if (zero? @failures)
298+ (println "\nall" (count checks) "checks passed")
299+ (do (println "\n" @failures "failed") (System/exit 1))))