rickub
Sign in Get started
nandi/jolt-nativepublic⑂ Fork 0
⑂ ce4d910
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.

Merge jvui-for-frq: the toolkit frq's window is painted with

jvui and glimmer-jvui, brought up to what frq needs of them: every tag and
prop its screens use, containers that fill the window, lists that follow
what arrives in them, wrapping labels, the fallback and colour-emoji font
handling, and a scroll that leaves its bar's strip to the bar. Beside them
the dependency split and the JOLT_WITHOUT_MOQ guard on the Android glue,
merged in from no-moq-deps.

Branched rather than committed here because main was where the terminal
work was going on; that one commit is in this merge's first parent and the
branch was rebased onto it, so there is nothing to reconcile.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-10T10:37:16-07:00 Browse files
ce4d910 parents: 361b4dc d6b9f3a
modified android/jolt_main.c +14 -0
@@ -29,7 +29,15 @@
2929 #include <android/log.h>
3030 #include <pthread.h>
3131
32+/* JOLT_WITHOUT_MOQ builds this glue for an app that does not link
33+ * libjoltmoq. frq is one: its media plane is jolt now — MoQ through
34+ * libmoq_ffi, Opus, H.264, V4L2 and ALSA — so the Rust one is an object it
35+ * never opens, and seventeen megabytes of APK for nothing. Everything moq
36+ * below is behind this, because --no-undefined turns an unreferenced symbol
37+ * into a link error rather than a surprise on the phone. */
38+#ifndef JOLT_WITHOUT_MOQ
3239 #include "joltmoq.h"
40+#endif
3341 #include "scheme.h"
3442 #include "vidya.h"
3543 #include "vidya_tree.h"
@@ -114,6 +122,7 @@ static void register_vidya_api(void) {
114122 REGISTER_VIDYA(vidya_tree_dump);
115123 }
116124
125+#ifndef JOLT_WITHOUT_MOQ
117126 /*
118127 * The media plane's symbols, registered for the same reason the Vidya ones
119128 * above are: they live in libjoltmoq.so, a third object, and Android's loader
@@ -164,6 +173,7 @@ static void register_joltmoq_api(void) {
164173 REGISTER_JOLTMOQ(joltmoq_can_dial);
165174 REGISTER_JOLTMOQ(joltmoq_new_instance);
166175 }
176+#endif /* JOLT_WITHOUT_MOQ */
167177
168178 /*
169179 * Chez writes to stdout/stderr, which on Android goes nowhere. Pump both into
@@ -204,8 +214,11 @@ int vidya_jolt_main(void) {
204214 (iptr)(_binary_jolt_boot_end - _binary_jolt_boot_start));
205215 Sbuild_heap(NULL, NULL);
206216 register_vidya_api();
217+#ifndef JOLT_WITHOUT_MOQ
207218 register_joltmoq_api();
219+#endif
208220
221+#ifndef JOLT_WITHOUT_MOQ
209222 /* The media plane's own handles, which it cannot get for itself: they arrive
210223 in android-activity's glue, and the glue is in libvidya.so. This is the
211224 only place both objects are in scope. Before Scheme starts, so no call can
@@ -221,6 +234,7 @@ int vidya_jolt_main(void) {
221234 "VidyaJolt", "media plane JNI handles: vm=%p activity=%p",
222235 moq_vm, moq_activity);
223236 joltmoq_android_init(moq_vm, moq_activity);
237+#endif
224238
225239 __android_log_print(ANDROID_LOG_INFO, "VidyaJolt", "starting Jolt application");
226240 int status = Sscheme_start(1, argv);
@@ -29,7 +29,15 @@
29 #include <android/log.h>29 #include <android/log.h>
30 #include <pthread.h>30 #include <pthread.h>
31 31
32+/* JOLT_WITHOUT_MOQ builds this glue for an app that does not link
33+ * libjoltmoq. frq is one: its media plane is jolt now — MoQ through
34+ * libmoq_ffi, Opus, H.264, V4L2 and ALSA — so the Rust one is an object it
35+ * never opens, and seventeen megabytes of APK for nothing. Everything moq
36+ * below is behind this, because --no-undefined turns an unreferenced symbol
37+ * into a link error rather than a surprise on the phone. */
38+#ifndef JOLT_WITHOUT_MOQ
32 #include "joltmoq.h"39 #include "joltmoq.h"
40+#endif
33 #include "scheme.h"41 #include "scheme.h"
34 #include "vidya.h"42 #include "vidya.h"
35 #include "vidya_tree.h"43 #include "vidya_tree.h"
@@ -114,6 +122,7 @@ static void register_vidya_api(void) {
114 REGISTER_VIDYA(vidya_tree_dump);122 REGISTER_VIDYA(vidya_tree_dump);
115 }123 }
116 124
125+#ifndef JOLT_WITHOUT_MOQ
117 /*126 /*
118 * The media plane's symbols, registered for the same reason the Vidya ones127 * The media plane's symbols, registered for the same reason the Vidya ones
119 * above are: they live in libjoltmoq.so, a third object, and Android's loader128 * above are: they live in libjoltmoq.so, a third object, and Android's loader
@@ -164,6 +173,7 @@ static void register_joltmoq_api(void) {
164 REGISTER_JOLTMOQ(joltmoq_can_dial);173 REGISTER_JOLTMOQ(joltmoq_can_dial);
165 REGISTER_JOLTMOQ(joltmoq_new_instance);174 REGISTER_JOLTMOQ(joltmoq_new_instance);
166 }175 }
176+#endif /* JOLT_WITHOUT_MOQ */
167 177
168 /*178 /*
169 * Chez writes to stdout/stderr, which on Android goes nowhere. Pump both into179 * Chez writes to stdout/stderr, which on Android goes nowhere. Pump both into
@@ -204,8 +214,11 @@ int vidya_jolt_main(void) {
204 (iptr)(_binary_jolt_boot_end - _binary_jolt_boot_start));214 (iptr)(_binary_jolt_boot_end - _binary_jolt_boot_start));
205 Sbuild_heap(NULL, NULL);215 Sbuild_heap(NULL, NULL);
206 register_vidya_api();216 register_vidya_api();
217+#ifndef JOLT_WITHOUT_MOQ
207 register_joltmoq_api();218 register_joltmoq_api();
219+#endif
208 220
221+#ifndef JOLT_WITHOUT_MOQ
209 /* The media plane's own handles, which it cannot get for itself: they arrive222 /* The media plane's own handles, which it cannot get for itself: they arrive
210 in android-activity's glue, and the glue is in libvidya.so. This is the223 in android-activity's glue, and the glue is in libvidya.so. This is the
211 only place both objects are in scope. Before Scheme starts, so no call can224 only place both objects are in scope. Before Scheme starts, so no call can
@@ -221,6 +234,7 @@ int vidya_jolt_main(void) {
221 "VidyaJolt", "media plane JNI handles: vm=%p activity=%p",234 "VidyaJolt", "media plane JNI handles: vm=%p activity=%p",
222 moq_vm, moq_activity);235 moq_vm, moq_activity);
223 joltmoq_android_init(moq_vm, moq_activity);236 joltmoq_android_init(moq_vm, moq_activity);
237+#endif
224 238
225 __android_log_print(ANDROID_LOG_INFO, "VidyaJolt", "starting Jolt application");239 __android_log_print(ANDROID_LOG_INFO, "VidyaJolt", "starting Jolt application");
226 int status = Sscheme_start(1, argv);240 int status = Sscheme_start(1, argv);
modified flake.nix +40 -4
@@ -132,8 +132,40 @@
132132 buildInputs = desktopBuildInputs;
133133 } // v4l2Env;
134134
135- # Every external crate, compiled once and shared by the three objects,
136- # the clippy run and the test run.
135+ # Every external crate, compiled once and shared by the objects that
136+ # actually want it.
137+ #
138+ # This used to be ONE derivation for the whole workspace, and the
139+ # sharing was the point: three objects, one dependency build. What it
140+ # cost was invisible until a consumer wanted only some of them.
141+ # jolt-moq brings moq-net, iroh, quinn, rustls and aws-lc-sys behind
142+ # it -- 440 crates that nothing else here touches -- so a build of
143+ # libvidya alone still paid for the media plane. A client that has
144+ # stopped loading libjoltmoq paid for it too, which is the case that
145+ # made this worth splitting.
146+ #
147+ # Split by CONSUMER rather than per package: vidya and tui share
148+ # nearly everything, and giving them an artifact each would trade one
149+ # kind of waste for another.
150+ depsFor = { pname, packages }:
151+ craneLib.buildDepsOnly (commonArgs // {
152+ inherit pname;
153+ version = "0.1.0";
154+ cargoExtraArgs =
155+ "--locked " + lib.concatMapStringsSep " " (p: "-p " + p) packages;
156+ });
157+
158+ uiArtifacts = depsFor {
159+ pname = "jolt-native-ui-deps";
160+ packages = [ "vidya-ffi" "jolt-tui" ];
161+ };
162+ moqArtifacts = depsFor {
163+ pname = "jolt-native-moq-deps";
164+ packages = [ "jolt-moq" ];
165+ };
166+
167+ # The whole workspace, for the clippy and test runs — those do build
168+ # everything, and want the sharing this split gives up.
137169 cargoArtifacts = craneLib.buildDepsOnly (commonArgs // {
138170 pname = "jolt-native-deps";
139171 version = "0.1.0";
@@ -147,9 +179,10 @@
147179 # crates/jolt-vidya. Nothing is silenced — a header that stops being
148180 # there should fail the build rather than ship an object with no ABI
149181 # beside it.
150- soPackage = { pname, package, dir, soname }:
182+ soPackage = { pname, package, dir, soname, artifacts }:
151183 craneLib.buildPackage (commonArgs // {
152- inherit pname cargoArtifacts;
184+ inherit pname;
185+ cargoArtifacts = artifacts;
153186 version = "0.1.0";
154187 cargoExtraArgs = "--locked -p ${package}";
155188 doCheck = false;
@@ -161,18 +194,21 @@
161194 });
162195
163196 libvidya = soPackage {
197+ artifacts = uiArtifacts;
164198 pname = "libvidya";
165199 package = "vidya-ffi";
166200 dir = "jolt-vidya";
167201 soname = "libvidya.so";
168202 };
169203 libjolttui = soPackage {
204+ artifacts = uiArtifacts;
170205 pname = "libjolttui";
171206 package = "jolt-tui";
172207 dir = "jolt-tui";
173208 soname = "libjolttui.so";
174209 };
175210 libjoltmoq = soPackage {
211+ artifacts = moqArtifacts;
176212 pname = "libjoltmoq";
177213 package = "jolt-moq";
178214 dir = "jolt-moq";
@@ -132,8 +132,40 @@
132 buildInputs = desktopBuildInputs;132 buildInputs = desktopBuildInputs;
133 } // v4l2Env;133 } // v4l2Env;
134 134
135- # Every external crate, compiled once and shared by the three objects,135+ # Every external crate, compiled once and shared by the objects that
136- # the clippy run and the test run.136+ # actually want it.
137+ #
138+ # This used to be ONE derivation for the whole workspace, and the
139+ # sharing was the point: three objects, one dependency build. What it
140+ # cost was invisible until a consumer wanted only some of them.
141+ # jolt-moq brings moq-net, iroh, quinn, rustls and aws-lc-sys behind
142+ # it -- 440 crates that nothing else here touches -- so a build of
143+ # libvidya alone still paid for the media plane. A client that has
144+ # stopped loading libjoltmoq paid for it too, which is the case that
145+ # made this worth splitting.
146+ #
147+ # Split by CONSUMER rather than per package: vidya and tui share
148+ # nearly everything, and giving them an artifact each would trade one
149+ # kind of waste for another.
150+ depsFor = { pname, packages }:
151+ craneLib.buildDepsOnly (commonArgs // {
152+ inherit pname;
153+ version = "0.1.0";
154+ cargoExtraArgs =
155+ "--locked " + lib.concatMapStringsSep " " (p: "-p " + p) packages;
156+ });
157+
158+ uiArtifacts = depsFor {
159+ pname = "jolt-native-ui-deps";
160+ packages = [ "vidya-ffi" "jolt-tui" ];
161+ };
162+ moqArtifacts = depsFor {
163+ pname = "jolt-native-moq-deps";
164+ packages = [ "jolt-moq" ];
165+ };
166+
167+ # The whole workspace, for the clippy and test runs — those do build
168+ # everything, and want the sharing this split gives up.
137 cargoArtifacts = craneLib.buildDepsOnly (commonArgs // {169 cargoArtifacts = craneLib.buildDepsOnly (commonArgs // {
138 pname = "jolt-native-deps";170 pname = "jolt-native-deps";
139 version = "0.1.0";171 version = "0.1.0";
@@ -147,9 +179,10 @@
147 # crates/jolt-vidya. Nothing is silenced — a header that stops being179 # crates/jolt-vidya. Nothing is silenced — a header that stops being
148 # there should fail the build rather than ship an object with no ABI180 # there should fail the build rather than ship an object with no ABI
149 # beside it.181 # beside it.
150- soPackage = { pname, package, dir, soname }:182+ soPackage = { pname, package, dir, soname, artifacts }:
151 craneLib.buildPackage (commonArgs // {183 craneLib.buildPackage (commonArgs // {
152- inherit pname cargoArtifacts;184+ inherit pname;
185+ cargoArtifacts = artifacts;
153 version = "0.1.0";186 version = "0.1.0";
154 cargoExtraArgs = "--locked -p ${package}";187 cargoExtraArgs = "--locked -p ${package}";
155 doCheck = false;188 doCheck = false;
@@ -161,18 +194,21 @@
161 });194 });
162 195
163 libvidya = soPackage {196 libvidya = soPackage {
197+ artifacts = uiArtifacts;
164 pname = "libvidya";198 pname = "libvidya";
165 package = "vidya-ffi";199 package = "vidya-ffi";
166 dir = "jolt-vidya";200 dir = "jolt-vidya";
167 soname = "libvidya.so";201 soname = "libvidya.so";
168 };202 };
169 libjolttui = soPackage {203 libjolttui = soPackage {
204+ artifacts = uiArtifacts;
170 pname = "libjolttui";205 pname = "libjolttui";
171 package = "jolt-tui";206 package = "jolt-tui";
172 dir = "jolt-tui";207 dir = "jolt-tui";
173 soname = "libjolttui.so";208 soname = "libjolttui.so";
174 };209 };
175 libjoltmoq = soPackage {210 libjoltmoq = soPackage {
211+ artifacts = moqArtifacts;
176 pname = "libjoltmoq";212 pname = "libjoltmoq";
177 package = "jolt-moq";213 package = "jolt-moq";
178 dir = "jolt-moq";214 dir = "jolt-moq";
modified glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +285 -15
@@ -39,7 +39,9 @@
3939 [jvui.app :as app]
4040 [jvui.core :as c]
4141 [jvui.theme :as theme]
42- [jvui.widgets :as w]))
42+ [jvui.widgets :as w]
43+ [jvui.frames :as frames]
44+ [jvui.host :as host]))
4345
4446 ;; --- the retained tree -------------------------------------------------------
4547
@@ -68,15 +70,68 @@
6870
6971 (defn- num [v default] (if (number? v) (double v) default))
7072
73+(defn- fills-height?
74+ "Does any child of `n` ask to fill the height?
75+
76+ A row is only as tall as what is in it, and frq marks the PANES with
77+ :fill-height rather than the row that holds them — egui gives a
78+ horizontal layout the available height and the panes fill that, so
79+ there is nothing there to mark. Here the row has to be told, and its
80+ own children are what know: a row holding something that wants the
81+ height wants the height.
82+
83+ Asked of the tree rather than inferred from the layout, because the
84+ layout answers a frame too late — a row that learns it should be tall
85+ from what happened last frame is a row that is the wrong height on
86+ the frame anybody looks at."
87+ [n]
88+ (boolean (some #(:fill-height (:props (deref %))) (:children (deref n)))))
89+
7190 (defn- box-opts
7291 "The container options shared by every container tag."
73- [props key]
92+ ([props key] (box-opts props key false))
93+ ([props key fill-height?]
7494 (cond-> {:key key
75- :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)}
95+ :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)
96+ ;; A CONTAINER fills its parent's cross axis by default. Without
97+ ;; this every box shrink-wraps its children, and frq's chat
98+ ;; column came out a couple of hundred points wide in a
99+ ;; five-hundred-point window with every message wrapped to
100+ ;; match — the tree is nested boxes, and each one only as wide
101+ ;; as what is in it.
102+ ;;
103+ ;; :cross and not :horizontal: in a ROW, :horizontal means take
104+ ;; a share of the slack, and a line of buttons would stretch to
105+ ;; fill the window.
106+ :expand :cross}
107+ ;; :fill-height is frq's way of saying "this is the pane that takes
108+ ;; what is left". It is the messages column in the row that also
109+ ;; holds the people panel, and without it that column claims no slack
110+ ;; at all — the backlog ends up as wide as the widest message and the
111+ ;; scrollbar sits in the middle of the window.
112+ ;;
113+ ;; :both rather than :vertical, despite the name: in a ROW the space
114+ ;; to be taken is horizontal, and a pane that fills the height of a
115+ ;; row it does not fill the width of is not what anyone means by it.
116+ ;; The panes that do NOT ask for it stay :cross and keep their own
117+ ;; size, which is what leaves the slack to be taken.
118+ (or (:fill-height props) fill-height?) (assoc :expand :both)
119+ ;; A minimum, not a size: the messages column asks for one only while
120+ ;; the people panel is beside it.
121+ (:width-request props)
122+ (assoc :min-size [(num (:width-request props) 0.0) 0.0])
76123 (:spacing props) (assoc :spacing (num (:spacing props) 0.0))
77124 (:padding props) (assoc :padding (num (:padding props) 0.0))
78125 (:margin props) (assoc :margin (num (:margin props) 0.0))
79- (:expand props) (assoc :expand (:expand props))))
126+ (:expand props) (assoc :expand (:expand props))
127+ ;; A row whose children start a new line when they run out of room —
128+ ;; a line of reaction pills is the case that needs it.
129+ (:wrap props) (assoc :wrap true)
130+ ;; Cross-axis placement: :start :center :end, as a gravity.
131+ (:align props) (assoc :gravity (case (:align props)
132+ (:center "center") [0.0 0.5]
133+ (:end "end") [0.0 1.0]
134+ [0.0 0.0])))))
80135
81136 (defn- fire! [n k & args]
82137 (when-let [f (get (:props @n) k)] (apply f args)))
@@ -117,14 +172,92 @@
117172
118173 (:card :frame) (w/card* (box-opts props key) (emit-children! n))
119174
120- :scroll (w/scroll* (assoc (box-opts props key)
121- :height (num (:height props) 200.0))
175+ ;; A list that follows what arrives in it. Everything here beyond
176+ ;; :height is a prop frq writes and this used to drop on the floor —
177+ ;; the chat did not follow new messages, and switching channels
178+ ;; carried the previous one's scroll across.
179+ ;; :expand is forced rather than left to box-opts, whose default is
180+ ;; :cross — and a viewport that fills only the width asks its column
181+ ;; for no height, is given none, and shows nothing at all. It is the
182+ ;; one container that always fills both ways.
183+ :scroll (w/scroll* (cond-> (assoc (box-opts props key) :expand :both)
184+ (:height props)
185+ (assoc :height (num (:height props) 200.0))
186+ (:reserve props)
187+ (assoc :reserve (num (:reserve props) 0.0))
188+ (:scroll-key props)
189+ (assoc :scroll-key (str (:scroll-key props)))
190+ (:stick-to-bottom props)
191+ (assoc :stick-to-bottom true)
192+ (:scroll-to-bottom props)
193+ (assoc :scroll-to-bottom (num (:scroll-to-bottom props) 0.0))
194+ ;; "end" or "away", the STRING libvidya emits —
195+ ;; frq's handler is (= "end" %) and a boolean
196+ ;; makes it permanently false.
197+ ;;
198+ ;; :on-scroll is deliberately not fired here.
199+ ;; It is the channel for backends that report an
200+ ;; OFFSET rather than a place — the terminal's —
201+ ;; and frq turns one into the other with
202+ ;; `scrolled!`. A window that reports where it
203+ ;; ended up has nothing to say on it.
204+ (:on-change props)
205+ (assoc :on-at-end
206+ (fn [at-end?]
207+ (fire! n :on-change (if at-end? "end" "away")))))
122208 (emit-children! n))
123209
124- :hbox (c/box* (assoc (box-opts props key) :dir :horizontal)
210+ :hbox (c/box* (assoc (box-opts props key (fills-height? n)) :dir :horizontal)
125211 (emit-children! n))
126212
127- (:vbox :box) (c/box* (box-opts props key) (emit-children! n))
213+ (:vbox :box) (c/box* (box-opts props key (fills-height? n))
214+ (emit-children! n))
215+
216+ ;; ONE tag for both kinds of picture: `:feed` is live pixels pushed
217+ ;; in under a name and re-uploaded as they arrive, `:src` is a file
218+ ;; decoded once and kept by path. Everything downstream — the fit, the
219+ ;; bounds, the click — is the same, which is why libvidya makes this a
220+ ;; prop and not a second tag, and why frq writes [:image {:feed k}]
221+ ;; for a call tile and [:image {:src p}] for an attachment.
222+ ;;
223+ ;; The pixels never go through the reconciler either way: a frame
224+ ;; arrives when the network says so, and a props diff at thirty a
225+ ;; second would be a re-render per frame per peer.
226+ :image (let [id (c/next-id key)
227+ rect (w/image {:feed (:feed props) :src (:src props)}
228+ {:fit (:fit props)
229+ :max-width (:max-width props)
230+ :max-height (:max-height props)
231+ :size (:size props)
232+ :expand (:expand props)})]
233+ (record! n id)
234+ (when (:clicked? (c/interact! id rect)) (fire! n :on-click)))
235+
236+ :title-2 (w/title-2 s)
237+
238+ :status (w/status s (boolean (:live props)))
239+
240+ :spinner (w/spinner s)
241+
242+ :link (let [id (c/next-id key)]
243+ (record! n id)
244+ (when (w/link s {:key key}) (fire! n :on-click)))
245+
246+ :emoji (w/emoji (or (:emoji props) s) (:size props))
247+
248+ :avatar (w/avatar (or (:label props) s)
249+ (cond-> {}
250+ (:src props) (assoc :src (:src props))
251+ (:size props) (assoc :size (:size props))))
252+
253+ :reaction (let [id (c/next-id key)
254+ glyph (or (:emoji props) s)]
255+ (record! n id)
256+ (when (w/reaction glyph {:count (or (:count props) 0)
257+ :mine? (boolean (:mine props))
258+ :size (:size props)
259+ :key key})
260+ (fire! n :on-click)))
128261
129262 :title (w/title s)
130263
@@ -136,11 +269,27 @@
136269 (record! n id)
137270 (when hit? (fire! n :on-click)))
138271
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)))
272+ ;; :checkbutton is the same widget under GTK's name for it, which is
273+ ;; what libvidya calls it too — `"checkbutton" | "checkbox"` is one
274+ ;; arm of its tag table. frq writes both.
275+ ;; :active is what frq and libvidya call it — `props.bool("active")`
276+ ;; in libvidya's tag table — and :checked is what this backend called
277+ ;; it first. Both are read, because a client written against either
278+ ;; should not render a permanently empty tick; :active wins where
279+ ;; both appear.
280+ ;;
281+ ;; Likewise both events fire. libvidya emits "toggled"; :on-change is
282+ ;; what the checkbox here answered to before.
283+ (:checkbox :checkbutton)
284+ (let [was (boolean (if (contains? props :active)
285+ (:active props)
286+ (:checked props)))
287+ id (c/next-id key)
288+ now (w/checkbox was s {:key key})]
289+ (record! n id)
290+ (when (not= now was)
291+ (fire! n :on-toggled now)
292+ (fire! n :on-change now)))
144293
145294 :slider (let [was (num (:value props) 0.0)
146295 id (c/next-id key)
@@ -155,9 +304,27 @@
155304 (:entry :text-entry)
156305 (let [was (str (or (:value props) (:text props) ""))
157306 id (c/next-id key)
158- now (w/text-entry was {:key key :placeholder (:placeholder props)})]
307+ now (w/text-entry was {:key key
308+ :placeholder (:placeholder props)
309+ ;; :width-request is what frq and
310+ ;; libvidya call a minimum width;
311+ ;; :hexpand says take the rest of the
312+ ;; row, which is this widget's default.
313+ :min-width (:width-request props)
314+ :expand (if (false? (:hexpand props))
315+ :none :horizontal)})]
159316 (record! n id)
160- (when (not= now was) (fire! n :on-change now)))
317+ (when (not= now was) (fire! n :on-change now))
318+ ;; Enter, which a field must not swallow as input: frq sends its
319+ ;; message on it, and without this the compose box accepted text
320+ ;; and had no way to say it was finished.
321+ ;;
322+ ;; NO ARGUMENT. libvidya emits activate with an empty string, and
323+ ;; frq's handlers are thunks — `s/send-draft!` takes none, and
324+ ;; handing it the text is an arity error the moment somebody
325+ ;; presses Enter. The text is already theirs; they got it from
326+ ;; :on-change.
327+ (when (w/entry-activated? id) (fire! n :on-activate)))
161328
162329 :progress (w/progress (num (:value props) 0.0))
163330 :separator (w/separator)
@@ -175,7 +342,64 @@
175342
176343 (defn- schedule! [work] (swap! pending conj work) nil)
177344
345+;; --- timers -----------------------------------------------------------------
346+;; A client needs somewhere to run work that is not a reaction to anything:
347+;; frq drives its whole media plane from `(every! 16 pump!)`, and a decoded
348+;; frame arrives because a timer asked for it rather than because a person
349+;; clicked. There is no other hook of the right shape — a component body runs
350+;; when its state changes, which for a video feed is never.
351+;;
352+;; Run from the same `:before` as the reconciler's queue, and for the same
353+;; reason: a callback that patches the tree must not do it mid-walk.
354+
355+(defonce ^:private timers (atom {}))
356+(defonce ^:private next-timer (atom 0))
357+
358+(defn- now-ms [] (System/currentTimeMillis))
359+
360+(defn after!
361+ "Run `f` once, at least `ms` from now. Answers a handle for `cancel!`."
362+ [ms f]
363+ (let [id (swap! next-timer inc)]
364+ (swap! timers assoc id {:at (+ (now-ms) ms) :every nil :f f})
365+ id))
366+
367+(defn every!
368+ "Run `f` every `ms`. Answers a handle for `cancel!`.
369+
370+ Every `ms` AT MOST, not exactly: it fires on the first frame after the
371+ deadline, so a 16ms timer on a 60Hz window runs once a frame and on a
372+ slower one runs less often. That is the right failure — a timer that tried
373+ to catch up would run twice in a row on a stutter, and for a pump that
374+ means two frames decoded and one shown."
375+ [ms f]
376+ (let [id (swap! next-timer inc)]
377+ (swap! timers assoc id {:at (+ (now-ms) ms) :every ms :f f})
378+ id))
379+
380+(defn cancel!
381+ "Stop a timer."
382+ [id]
383+ (swap! timers dissoc id)
384+ nil)
385+
386+(defn- run-timers! []
387+ (let [t (now-ms)
388+ due (filter (fn [[_ v]] (<= (:at v) t)) @timers)]
389+ (doseq [[id {:keys [every f]}] due]
390+ (if every
391+ (swap! timers assoc-in [id :at] (+ t every))
392+ (swap! timers dissoc id))
393+ ;; A throwing timer is cancelled rather than allowed to throw every
394+ ;; frame for the rest of the session, which is unreadable and stops
395+ ;; the ones behind it.
396+ (try (f)
397+ (catch Exception e
398+ (swap! timers dissoc id)
399+ (println "glimmer-jvui: timer failed, cancelled:" (ex-message e)))))))
400+
178401 (defn- drain-pending! []
402+ (run-timers!)
179403 (let [[ws] (reset-vals! pending [])]
180404 (doseq [w ws] (w))))
181405
@@ -231,3 +455,49 @@
231455 (binding [*record-rects?* true]
232456 (c/frame! cx (fn [] (emit! root))))
233457 cx))
458+
459+;; --- feeds ------------------------------------------------------------------
460+;; The same three calls glimmer-vidya exposes, so a client that paints a call
461+;; does not care which backend is under it. They are not part of the
462+;; reconciler and deliberately so: pixels arrive between frames, and the tree
463+;; only ever holds the key.
464+
465+(defn frame-rgba!
466+ "Hand feed `key` a new picture: `w` by `h` RGBA at FOREIGN pointer `px`.
467+
468+ The pointer is read during this call and not kept, so a caller may reuse
469+ or free it immediately afterwards — which is what a decoder handing out a
470+ borrowed buffer needs."
471+ [key w h px]
472+ (frames/put! key w h px))
473+
474+(defn frame-drop!
475+ "Forget a feed and release its texture — someone left, or turned a camera
476+ off."
477+ [key]
478+ (frames/drop! key))
479+
480+(defn feed-keys
481+ "Every feed with a picture."
482+ []
483+ (frames/keys*))
484+
485+;; --- the platform -----------------------------------------------------------
486+;; The rest of what glimmer-vidya answers, so a client can ask its backend
487+;; about the window it is in without knowing which backend that is. Thin on
488+;; purpose: every one of these is jvui.host, and the indirection exists so
489+;; the client requires one namespace rather than two.
490+
491+(def set-title! host/set-title!)
492+(def window-width host/window-width)
493+(def screen-size host/screen-size)
494+(def quit! host/quit!)
495+(def open-url! host/open-url!)
496+(def clipboard-image-png! host/clipboard-image-png!)
497+
498+;; False and nil on a desktop, which is the right answer rather than a gap:
499+;; the chooser exists so a phone can hand back a grant for one picture, and
500+;; a caller reads the false and offers a file browser instead. glimmer-vidya
501+;; says the same thing here.
502+(def pick-image! host/pick-image!)
503+(def picked-image! host/picked-image!)
@@ -39,7 +39,9 @@
39 [jvui.app :as app]39 [jvui.app :as app]
40 [jvui.core :as c]40 [jvui.core :as c]
41 [jvui.theme :as theme]41 [jvui.theme :as theme]
42- [jvui.widgets :as w]))42+ [jvui.widgets :as w]
43+ [jvui.frames :as frames]
44+ [jvui.host :as host]))
43 45
44 ;; --- the retained tree -------------------------------------------------------46 ;; --- the retained tree -------------------------------------------------------
45 47
@@ -68,15 +70,68 @@
68 70
69 (defn- num [v default] (if (number? v) (double v) default))71 (defn- num [v default] (if (number? v) (double v) default))
70 72
73+(defn- fills-height?
74+ "Does any child of `n` ask to fill the height?
75+
76+ A row is only as tall as what is in it, and frq marks the PANES with
77+ :fill-height rather than the row that holds them — egui gives a
78+ horizontal layout the available height and the panes fill that, so
79+ there is nothing there to mark. Here the row has to be told, and its
80+ own children are what know: a row holding something that wants the
81+ height wants the height.
82+
83+ Asked of the tree rather than inferred from the layout, because the
84+ layout answers a frame too late — a row that learns it should be tall
85+ from what happened last frame is a row that is the wrong height on
86+ the frame anybody looks at."
87+ [n]
88+ (boolean (some #(:fill-height (:props (deref %))) (:children (deref n)))))
89+
71 (defn- box-opts90 (defn- box-opts
72 "The container options shared by every container tag."91 "The container options shared by every container tag."
73- [props key]92+ ([props key] (box-opts props key false))
93+ ([props key fill-height?]
74 (cond-> {:key key94 (cond-> {:key key
75- :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)}95+ :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)
96+ ;; A CONTAINER fills its parent's cross axis by default. Without
97+ ;; this every box shrink-wraps its children, and frq's chat
98+ ;; column came out a couple of hundred points wide in a
99+ ;; five-hundred-point window with every message wrapped to
100+ ;; match — the tree is nested boxes, and each one only as wide
101+ ;; as what is in it.
102+ ;;
103+ ;; :cross and not :horizontal: in a ROW, :horizontal means take
104+ ;; a share of the slack, and a line of buttons would stretch to
105+ ;; fill the window.
106+ :expand :cross}
107+ ;; :fill-height is frq's way of saying "this is the pane that takes
108+ ;; what is left". It is the messages column in the row that also
109+ ;; holds the people panel, and without it that column claims no slack
110+ ;; at all — the backlog ends up as wide as the widest message and the
111+ ;; scrollbar sits in the middle of the window.
112+ ;;
113+ ;; :both rather than :vertical, despite the name: in a ROW the space
114+ ;; to be taken is horizontal, and a pane that fills the height of a
115+ ;; row it does not fill the width of is not what anyone means by it.
116+ ;; The panes that do NOT ask for it stay :cross and keep their own
117+ ;; size, which is what leaves the slack to be taken.
118+ (or (:fill-height props) fill-height?) (assoc :expand :both)
119+ ;; A minimum, not a size: the messages column asks for one only while
120+ ;; the people panel is beside it.
121+ (:width-request props)
122+ (assoc :min-size [(num (:width-request props) 0.0) 0.0])
76 (:spacing props) (assoc :spacing (num (:spacing props) 0.0))123 (:spacing props) (assoc :spacing (num (:spacing props) 0.0))
77 (:padding props) (assoc :padding (num (:padding props) 0.0))124 (:padding props) (assoc :padding (num (:padding props) 0.0))
78 (:margin props) (assoc :margin (num (:margin props) 0.0))125 (:margin props) (assoc :margin (num (:margin props) 0.0))
79- (:expand props) (assoc :expand (:expand props))))126+ (:expand props) (assoc :expand (:expand props))
127+ ;; A row whose children start a new line when they run out of room —
128+ ;; a line of reaction pills is the case that needs it.
129+ (:wrap props) (assoc :wrap true)
130+ ;; Cross-axis placement: :start :center :end, as a gravity.
131+ (:align props) (assoc :gravity (case (:align props)
132+ (:center "center") [0.0 0.5]
133+ (:end "end") [0.0 1.0]
134+ [0.0 0.0])))))
80 135
81 (defn- fire! [n k & args]136 (defn- fire! [n k & args]
82 (when-let [f (get (:props @n) k)] (apply f args)))137 (when-let [f (get (:props @n) k)] (apply f args)))
@@ -117,14 +172,92 @@
117 172
118 (:card :frame) (w/card* (box-opts props key) (emit-children! n))173 (:card :frame) (w/card* (box-opts props key) (emit-children! n))
119 174
120- :scroll (w/scroll* (assoc (box-opts props key)175+ ;; A list that follows what arrives in it. Everything here beyond
121- :height (num (:height props) 200.0))176+ ;; :height is a prop frq writes and this used to drop on the floor —
177+ ;; the chat did not follow new messages, and switching channels
178+ ;; carried the previous one's scroll across.
179+ ;; :expand is forced rather than left to box-opts, whose default is
180+ ;; :cross — and a viewport that fills only the width asks its column
181+ ;; for no height, is given none, and shows nothing at all. It is the
182+ ;; one container that always fills both ways.
183+ :scroll (w/scroll* (cond-> (assoc (box-opts props key) :expand :both)
184+ (:height props)
185+ (assoc :height (num (:height props) 200.0))
186+ (:reserve props)
187+ (assoc :reserve (num (:reserve props) 0.0))
188+ (:scroll-key props)
189+ (assoc :scroll-key (str (:scroll-key props)))
190+ (:stick-to-bottom props)
191+ (assoc :stick-to-bottom true)
192+ (:scroll-to-bottom props)
193+ (assoc :scroll-to-bottom (num (:scroll-to-bottom props) 0.0))
194+ ;; "end" or "away", the STRING libvidya emits —
195+ ;; frq's handler is (= "end" %) and a boolean
196+ ;; makes it permanently false.
197+ ;;
198+ ;; :on-scroll is deliberately not fired here.
199+ ;; It is the channel for backends that report an
200+ ;; OFFSET rather than a place — the terminal's —
201+ ;; and frq turns one into the other with
202+ ;; `scrolled!`. A window that reports where it
203+ ;; ended up has nothing to say on it.
204+ (:on-change props)
205+ (assoc :on-at-end
206+ (fn [at-end?]
207+ (fire! n :on-change (if at-end? "end" "away")))))
122 (emit-children! n))208 (emit-children! n))
123 209
124- :hbox (c/box* (assoc (box-opts props key) :dir :horizontal)210+ :hbox (c/box* (assoc (box-opts props key (fills-height? n)) :dir :horizontal)
125 (emit-children! n))211 (emit-children! n))
126 212
127- (:vbox :box) (c/box* (box-opts props key) (emit-children! n))213+ (:vbox :box) (c/box* (box-opts props key (fills-height? n))
214+ (emit-children! n))
215+
216+ ;; ONE tag for both kinds of picture: `:feed` is live pixels pushed
217+ ;; in under a name and re-uploaded as they arrive, `:src` is a file
218+ ;; decoded once and kept by path. Everything downstream — the fit, the
219+ ;; bounds, the click — is the same, which is why libvidya makes this a
220+ ;; prop and not a second tag, and why frq writes [:image {:feed k}]
221+ ;; for a call tile and [:image {:src p}] for an attachment.
222+ ;;
223+ ;; The pixels never go through the reconciler either way: a frame
224+ ;; arrives when the network says so, and a props diff at thirty a
225+ ;; second would be a re-render per frame per peer.
226+ :image (let [id (c/next-id key)
227+ rect (w/image {:feed (:feed props) :src (:src props)}
228+ {:fit (:fit props)
229+ :max-width (:max-width props)
230+ :max-height (:max-height props)
231+ :size (:size props)
232+ :expand (:expand props)})]
233+ (record! n id)
234+ (when (:clicked? (c/interact! id rect)) (fire! n :on-click)))
235+
236+ :title-2 (w/title-2 s)
237+
238+ :status (w/status s (boolean (:live props)))
239+
240+ :spinner (w/spinner s)
241+
242+ :link (let [id (c/next-id key)]
243+ (record! n id)
244+ (when (w/link s {:key key}) (fire! n :on-click)))
245+
246+ :emoji (w/emoji (or (:emoji props) s) (:size props))
247+
248+ :avatar (w/avatar (or (:label props) s)
249+ (cond-> {}
250+ (:src props) (assoc :src (:src props))
251+ (:size props) (assoc :size (:size props))))
252+
253+ :reaction (let [id (c/next-id key)
254+ glyph (or (:emoji props) s)]
255+ (record! n id)
256+ (when (w/reaction glyph {:count (or (:count props) 0)
257+ :mine? (boolean (:mine props))
258+ :size (:size props)
259+ :key key})
260+ (fire! n :on-click)))
128 261
129 :title (w/title s)262 :title (w/title s)
130 263
@@ -136,11 +269,27 @@
136 (record! n id)269 (record! n id)
137 (when hit? (fire! n :on-click)))270 (when hit? (fire! n :on-click)))
138 271
139- :checkbox (let [was (boolean (:checked props))272+ ;; :checkbutton is the same widget under GTK's name for it, which is
140- id (c/next-id key)273+ ;; what libvidya calls it too — `"checkbutton" | "checkbox"` is one
141- now (w/checkbox was s {:key key})]274+ ;; arm of its tag table. frq writes both.
142- (record! n id)275+ ;; :active is what frq and libvidya call it — `props.bool("active")`
143- (when (not= now was) (fire! n :on-change now)))276+ ;; in libvidya's tag table — and :checked is what this backend called
277+ ;; it first. Both are read, because a client written against either
278+ ;; should not render a permanently empty tick; :active wins where
279+ ;; both appear.
280+ ;;
281+ ;; Likewise both events fire. libvidya emits "toggled"; :on-change is
282+ ;; what the checkbox here answered to before.
283+ (:checkbox :checkbutton)
284+ (let [was (boolean (if (contains? props :active)
285+ (:active props)
286+ (:checked props)))
287+ id (c/next-id key)
288+ now (w/checkbox was s {:key key})]
289+ (record! n id)
290+ (when (not= now was)
291+ (fire! n :on-toggled now)
292+ (fire! n :on-change now)))
144 293
145 :slider (let [was (num (:value props) 0.0)294 :slider (let [was (num (:value props) 0.0)
146 id (c/next-id key)295 id (c/next-id key)
@@ -155,9 +304,27 @@
155 (:entry :text-entry)304 (:entry :text-entry)
156 (let [was (str (or (:value props) (:text props) ""))305 (let [was (str (or (:value props) (:text props) ""))
157 id (c/next-id key)306 id (c/next-id key)
158- now (w/text-entry was {:key key :placeholder (:placeholder props)})]307+ now (w/text-entry was {:key key
308+ :placeholder (:placeholder props)
309+ ;; :width-request is what frq and
310+ ;; libvidya call a minimum width;
311+ ;; :hexpand says take the rest of the
312+ ;; row, which is this widget's default.
313+ :min-width (:width-request props)
314+ :expand (if (false? (:hexpand props))
315+ :none :horizontal)})]
159 (record! n id)316 (record! n id)
160- (when (not= now was) (fire! n :on-change now)))317+ (when (not= now was) (fire! n :on-change now))
318+ ;; Enter, which a field must not swallow as input: frq sends its
319+ ;; message on it, and without this the compose box accepted text
320+ ;; and had no way to say it was finished.
321+ ;;
322+ ;; NO ARGUMENT. libvidya emits activate with an empty string, and
323+ ;; frq's handlers are thunks — `s/send-draft!` takes none, and
324+ ;; handing it the text is an arity error the moment somebody
325+ ;; presses Enter. The text is already theirs; they got it from
326+ ;; :on-change.
327+ (when (w/entry-activated? id) (fire! n :on-activate)))
161 328
162 :progress (w/progress (num (:value props) 0.0))329 :progress (w/progress (num (:value props) 0.0))
163 :separator (w/separator)330 :separator (w/separator)
@@ -175,7 +342,64 @@
175 342
176 (defn- schedule! [work] (swap! pending conj work) nil)343 (defn- schedule! [work] (swap! pending conj work) nil)
177 344
345+;; --- timers -----------------------------------------------------------------
346+;; A client needs somewhere to run work that is not a reaction to anything:
347+;; frq drives its whole media plane from `(every! 16 pump!)`, and a decoded
348+;; frame arrives because a timer asked for it rather than because a person
349+;; clicked. There is no other hook of the right shape — a component body runs
350+;; when its state changes, which for a video feed is never.
351+;;
352+;; Run from the same `:before` as the reconciler's queue, and for the same
353+;; reason: a callback that patches the tree must not do it mid-walk.
354+
355+(defonce ^:private timers (atom {}))
356+(defonce ^:private next-timer (atom 0))
357+
358+(defn- now-ms [] (System/currentTimeMillis))
359+
360+(defn after!
361+ "Run `f` once, at least `ms` from now. Answers a handle for `cancel!`."
362+ [ms f]
363+ (let [id (swap! next-timer inc)]
364+ (swap! timers assoc id {:at (+ (now-ms) ms) :every nil :f f})
365+ id))
366+
367+(defn every!
368+ "Run `f` every `ms`. Answers a handle for `cancel!`.
369+
370+ Every `ms` AT MOST, not exactly: it fires on the first frame after the
371+ deadline, so a 16ms timer on a 60Hz window runs once a frame and on a
372+ slower one runs less often. That is the right failure — a timer that tried
373+ to catch up would run twice in a row on a stutter, and for a pump that
374+ means two frames decoded and one shown."
375+ [ms f]
376+ (let [id (swap! next-timer inc)]
377+ (swap! timers assoc id {:at (+ (now-ms) ms) :every ms :f f})
378+ id))
379+
380+(defn cancel!
381+ "Stop a timer."
382+ [id]
383+ (swap! timers dissoc id)
384+ nil)
385+
386+(defn- run-timers! []
387+ (let [t (now-ms)
388+ due (filter (fn [[_ v]] (<= (:at v) t)) @timers)]
389+ (doseq [[id {:keys [every f]}] due]
390+ (if every
391+ (swap! timers assoc-in [id :at] (+ t every))
392+ (swap! timers dissoc id))
393+ ;; A throwing timer is cancelled rather than allowed to throw every
394+ ;; frame for the rest of the session, which is unreadable and stops
395+ ;; the ones behind it.
396+ (try (f)
397+ (catch Exception e
398+ (swap! timers dissoc id)
399+ (println "glimmer-jvui: timer failed, cancelled:" (ex-message e)))))))
400+
178 (defn- drain-pending! []401 (defn- drain-pending! []
402+ (run-timers!)
179 (let [[ws] (reset-vals! pending [])]403 (let [[ws] (reset-vals! pending [])]
180 (doseq [w ws] (w))))404 (doseq [w ws] (w))))
181 405
@@ -231,3 +455,49 @@
231 (binding [*record-rects?* true]455 (binding [*record-rects?* true]
232 (c/frame! cx (fn [] (emit! root))))456 (c/frame! cx (fn [] (emit! root))))
233 cx))457 cx))
458+
459+;; --- feeds ------------------------------------------------------------------
460+;; The same three calls glimmer-vidya exposes, so a client that paints a call
461+;; does not care which backend is under it. They are not part of the
462+;; reconciler and deliberately so: pixels arrive between frames, and the tree
463+;; only ever holds the key.
464+
465+(defn frame-rgba!
466+ "Hand feed `key` a new picture: `w` by `h` RGBA at FOREIGN pointer `px`.
467+
468+ The pointer is read during this call and not kept, so a caller may reuse
469+ or free it immediately afterwards — which is what a decoder handing out a
470+ borrowed buffer needs."
471+ [key w h px]
472+ (frames/put! key w h px))
473+
474+(defn frame-drop!
475+ "Forget a feed and release its texture — someone left, or turned a camera
476+ off."
477+ [key]
478+ (frames/drop! key))
479+
480+(defn feed-keys
481+ "Every feed with a picture."
482+ []
483+ (frames/keys*))
484+
485+;; --- the platform -----------------------------------------------------------
486+;; The rest of what glimmer-vidya answers, so a client can ask its backend
487+;; about the window it is in without knowing which backend that is. Thin on
488+;; purpose: every one of these is jvui.host, and the indirection exists so
489+;; the client requires one namespace rather than two.
490+
491+(def set-title! host/set-title!)
492+(def window-width host/window-width)
493+(def screen-size host/screen-size)
494+(def quit! host/quit!)
495+(def open-url! host/open-url!)
496+(def clipboard-image-png! host/clipboard-image-png!)
497+
498+;; False and nil on a desktop, which is the right answer rather than a gap:
499+;; the chooser exists so a phone can hand back a grant for one picture, and
500+;; a caller reads the false and offers a file browser instead. glimmer-vidya
501+;; says the same thing here.
502+(def pick-image! host/pick-image!)
503+(def picked-image! host/picked-image!)
added glimmer-backends/glimmer-jvui/test/glimmer_jvui/props_check.clj +64 -0
new file mode 100644
@@ -0,0 +1,64 @@
1+(ns glimmer-jvui.props-check
2+ "Two prop-level bugs the tag diff could not see, checked against pixels.
3+
4+ A tag being handled is not the same as a tag reading the props a client
5+ actually writes. Both of these rendered perfectly and said the wrong
6+ thing: a checkbutton whose tick never appeared because frq writes
7+ `:active` where this read `:checked`, and a field whose text ran out past
8+ its own border because nothing clipped it."
9+ (:require [glimmer.core :as ui]
10+ [glimmer-jvui.core]
11+ [jvui.sdl :as sdl]
12+ [jolt.ffi :as ffi]))
13+
14+(defn- bmp [path]
15+ (let [b (java.nio.file.Files/readAllBytes
16+ (java.nio.file.Path/of path (into-array String [])))
17+ u (fn [i] (bit-and (int (aget b i)) 255))
18+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
19+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
20+ off (le 10) w (le 18) h (le 22) stride (* 4 (quot (+ (* w 3) 3) 4))]
21+ {:w w :h h :px (fn [x y] (let [i (+ off (* (- h 1 y) stride) (* 3 x))]
22+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))}))
23+
24+(defn- ink-in
25+ "How many pixels inside [x0 y0 x1 y1] differ from the background."
26+ [{:keys [px]} bg x0 y0 x1 y1]
27+ (count (for [y (range y0 y1) x (range x0 x1)
28+ :let [p (px x y)]
29+ :when (> (+ (abs (- (:r p) (:r bg))) (abs (- (:g p) (:g bg)))
30+ (abs (- (:b p) (:b bg)))) 40)]
31+ 1)))
32+
33+(defn -main [& _]
34+ (let [shot (str (System/getProperty "java.io.tmpdir") "/jvui-props.bmp")
35+ out (atom []) ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))]
36+ (ui/run (fn []
37+ [:vbox {:spacing 8}
38+ ;; A card paints a background, so how wide it comes out is
39+ ;; visible. Nested two deep because frq's tree is nested:
40+ ;; every box shrink-wrapping is how its chat column ended
41+ ;; up a couple of hundred points wide in a wider window.
42+ [:vbox {} [:card {} [:label {:label "x"}]]]
43+ ;; :active, the way frq writes it — the tick must appear.
44+ [:checkbutton {:label "TLS" :active true}]
45+ ;; A string far wider than the field it is in.
46+ [:entry {:value "nandi-test.bsky.social-and-then-some-more-text"}]])
47+ {:title "props" :width 240 :height 140 :frames 6 :shot shot})
48+ (let [img (bmp shot)
49+ bg ((:px img) 2 2)]
50+ ;; The tick is inside the little box at the far left of the first row.
51+ (ck! "an :active checkbutton draws its tick"
52+ (> (ink-in img bg 4 4 26 30) 12))
53+ ;; Nothing may be drawn to the right of the field's own border.
54+ (ck! "entry text stops at the field's edge"
55+ (zero? (ink-in img bg 232 100 240 140)))
56+ ;; The card's own background, out near the right edge: a
57+ ;; shrink-wrapped one would not reach.
58+ (ck! "a nested container fills the width"
59+ (pos? (ink-in img bg 200 4 232 40))))
60+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
61+ (let [bad (remove second @out)]
62+ (println (if (seq bad) (str (count bad) " of " (count @out) " checks FAILED")
63+ (str "all " (count @out) " checks passed")))
64+ (when (seq bad) (System/exit 1)))))
new file mode 100644
@@ -0,0 +1,64 @@
1+(ns glimmer-jvui.props-check
2+ "Two prop-level bugs the tag diff could not see, checked against pixels.
3+
4+ A tag being handled is not the same as a tag reading the props a client
5+ actually writes. Both of these rendered perfectly and said the wrong
6+ thing: a checkbutton whose tick never appeared because frq writes
7+ `:active` where this read `:checked`, and a field whose text ran out past
8+ its own border because nothing clipped it."
9+ (:require [glimmer.core :as ui]
10+ [glimmer-jvui.core]
11+ [jvui.sdl :as sdl]
12+ [jolt.ffi :as ffi]))
13+
14+(defn- bmp [path]
15+ (let [b (java.nio.file.Files/readAllBytes
16+ (java.nio.file.Path/of path (into-array String [])))
17+ u (fn [i] (bit-and (int (aget b i)) 255))
18+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
19+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
20+ off (le 10) w (le 18) h (le 22) stride (* 4 (quot (+ (* w 3) 3) 4))]
21+ {:w w :h h :px (fn [x y] (let [i (+ off (* (- h 1 y) stride) (* 3 x))]
22+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))}))
23+
24+(defn- ink-in
25+ "How many pixels inside [x0 y0 x1 y1] differ from the background."
26+ [{:keys [px]} bg x0 y0 x1 y1]
27+ (count (for [y (range y0 y1) x (range x0 x1)
28+ :let [p (px x y)]
29+ :when (> (+ (abs (- (:r p) (:r bg))) (abs (- (:g p) (:g bg)))
30+ (abs (- (:b p) (:b bg)))) 40)]
31+ 1)))
32+
33+(defn -main [& _]
34+ (let [shot (str (System/getProperty "java.io.tmpdir") "/jvui-props.bmp")
35+ out (atom []) ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))]
36+ (ui/run (fn []
37+ [:vbox {:spacing 8}
38+ ;; A card paints a background, so how wide it comes out is
39+ ;; visible. Nested two deep because frq's tree is nested:
40+ ;; every box shrink-wrapping is how its chat column ended
41+ ;; up a couple of hundred points wide in a wider window.
42+ [:vbox {} [:card {} [:label {:label "x"}]]]
43+ ;; :active, the way frq writes it — the tick must appear.
44+ [:checkbutton {:label "TLS" :active true}]
45+ ;; A string far wider than the field it is in.
46+ [:entry {:value "nandi-test.bsky.social-and-then-some-more-text"}]])
47+ {:title "props" :width 240 :height 140 :frames 6 :shot shot})
48+ (let [img (bmp shot)
49+ bg ((:px img) 2 2)]
50+ ;; The tick is inside the little box at the far left of the first row.
51+ (ck! "an :active checkbutton draws its tick"
52+ (> (ink-in img bg 4 4 26 30) 12))
53+ ;; Nothing may be drawn to the right of the field's own border.
54+ (ck! "entry text stops at the field's edge"
55+ (zero? (ink-in img bg 232 100 240 140)))
56+ ;; The card's own background, out near the right edge: a
57+ ;; shrink-wrapped one would not reach.
58+ (ck! "a nested container fills the width"
59+ (pos? (ink-in img bg 200 4 232 40))))
60+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
61+ (let [bad (remove second @out)]
62+ (println (if (seq bad) (str (count bad) " of " (count @out) " checks FAILED")
63+ (str "all " (count @out) " checks passed")))
64+ (when (seq bad) (System/exit 1)))))
added glimmer-backends/glimmer-jvui/test/glimmer_jvui/tags_check.clj +81 -0
new file mode 100644
@@ -0,0 +1,81 @@
1+(ns glimmer-jvui.tags-check
2+ "Every tag frq renders, rendered, and the ones with a colour checked.
3+
4+ The layout tests already prove a tag is not an unknown container. What
5+ they cannot see is whether it drew anything, because headless there is no
6+ renderer — so this opens a window under SDL's dummy driver and reads the
7+ screenshot back.
8+
9+ Only the tags with a colour worth asserting on are checked by pixel: a
10+ decoded PNG must be the green it was written as, and an avatar with no
11+ picture must be a filled disc rather than nothing. The rest are checked
12+ for not throwing and not being swallowed as unknown, which is the failure
13+ they would actually have."
14+ (:require [glimmer.core :as ui]
15+ [glimmer-jvui.core :as backend]
16+ [jolt.ffi :as ffi]))
17+
18+(defn- bmp [path]
19+ (let [b (java.nio.file.Files/readAllBytes
20+ (java.nio.file.Path/of path (into-array String [])))
21+ u (fn [i] (bit-and (int (aget b i)) 255))
22+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
23+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
24+ off (le 10) w (le 18) h (le 22)
25+ stride (* 4 (quot (+ (* w 3) 3) 4))]
26+ {:w w :h h
27+ :px (fn [x y] (let [i (+ off (* (- h 1 y) stride) (* 3 x))]
28+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))}))
29+
30+(defn- scan
31+ "Does any pixel in the image satisfy `p`?"
32+ [{:keys [w h px]} p]
33+ (boolean (some (fn [y] (some (fn [x] (p (px x y))) (range 0 w 2))) (range 0 h 2))))
34+
35+(defn -main [& _]
36+ (let [shot (str (System/getProperty "java.io.tmpdir") "/jvui-tags.bmp")
37+ feed (ffi/alloc (* 4 16 16))
38+ out (atom [])
39+ ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))]
40+ ;; A live feed frame: pure red, so it cannot be confused with the file.
41+ (dotimes [i (* 16 16)]
42+ (ffi/write (+ feed (* 4 i) 0) :uint8 240)
43+ (ffi/write (+ feed (* 4 i) 1) :uint8 0)
44+ (ffi/write (+ feed (* 4 i) 2) :uint8 0)
45+ (ffi/write (+ feed (* 4 i) 3) :uint8 255))
46+ (backend/every! 16 (fn [] (backend/frame-rgba! "cam" 16 16 feed)))
47+ (try
48+ (ui/run
49+ (fn []
50+ [:vbox {:spacing 4}
51+ [:title-2 {:label "heading"}]
52+ [:status {:label "connected" :live true}]
53+ [:spinner {:label "working"}]
54+ [:link {:label "a link"}]
55+ [:emoji {:emoji "x" :size 14}]
56+ [:reaction {:emoji "y" :count 3 :mine true}]
57+ [:hbox {:spacing 4}
58+ [:avatar {:label "nandi" :size 24}]
59+ [:image {:src "/tmp/jvui-green.png" :max-width 40}]
60+ [:image {:feed "cam" :size [40.0 40.0]}]]])
61+ {:title "tags" :width 320 :height 320 :frames 6 :shot shot})
62+ (finally (ffi/free feed)))
63+ (let [img (bmp shot)]
64+ (ck! "a decoded PNG is on screen, and green"
65+ (scan img (fn [{:keys [r g b]}] (and (> g 150) (< r 90) (< b 90)))))
66+ (ck! "a live feed is on screen, and red"
67+ (scan img (fn [{:keys [r g b]}] (and (> r 180) (< g 80) (< b 80)))))
68+ (ck! "an avatar with no picture is a filled disc"
69+ (scan img (fn [{:keys [r g b]}]
70+ ;; any of the name palette, none of which is the
71+ ;; background or the two above
72+ (and (> (max r g b) 90) (< (max r g b) 230)
73+ (> (- (max r g b) (min r g b)) 40)
74+ (not (and (> g 150) (< r 90)))
75+ (not (and (> r 180) (< g 80))))))))
76+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
77+ (let [bad (remove second @out)]
78+ (println (if (seq bad)
79+ (str (count bad) " of " (count @out) " checks FAILED")
80+ (str "all " (count @out) " checks passed")))
81+ (when (seq bad) (System/exit 1)))))
new file mode 100644
@@ -0,0 +1,81 @@
1+(ns glimmer-jvui.tags-check
2+ "Every tag frq renders, rendered, and the ones with a colour checked.
3+
4+ The layout tests already prove a tag is not an unknown container. What
5+ they cannot see is whether it drew anything, because headless there is no
6+ renderer — so this opens a window under SDL's dummy driver and reads the
7+ screenshot back.
8+
9+ Only the tags with a colour worth asserting on are checked by pixel: a
10+ decoded PNG must be the green it was written as, and an avatar with no
11+ picture must be a filled disc rather than nothing. The rest are checked
12+ for not throwing and not being swallowed as unknown, which is the failure
13+ they would actually have."
14+ (:require [glimmer.core :as ui]
15+ [glimmer-jvui.core :as backend]
16+ [jolt.ffi :as ffi]))
17+
18+(defn- bmp [path]
19+ (let [b (java.nio.file.Files/readAllBytes
20+ (java.nio.file.Path/of path (into-array String [])))
21+ u (fn [i] (bit-and (int (aget b i)) 255))
22+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
23+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
24+ off (le 10) w (le 18) h (le 22)
25+ stride (* 4 (quot (+ (* w 3) 3) 4))]
26+ {:w w :h h
27+ :px (fn [x y] (let [i (+ off (* (- h 1 y) stride) (* 3 x))]
28+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))}))
29+
30+(defn- scan
31+ "Does any pixel in the image satisfy `p`?"
32+ [{:keys [w h px]} p]
33+ (boolean (some (fn [y] (some (fn [x] (p (px x y))) (range 0 w 2))) (range 0 h 2))))
34+
35+(defn -main [& _]
36+ (let [shot (str (System/getProperty "java.io.tmpdir") "/jvui-tags.bmp")
37+ feed (ffi/alloc (* 4 16 16))
38+ out (atom [])
39+ ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))]
40+ ;; A live feed frame: pure red, so it cannot be confused with the file.
41+ (dotimes [i (* 16 16)]
42+ (ffi/write (+ feed (* 4 i) 0) :uint8 240)
43+ (ffi/write (+ feed (* 4 i) 1) :uint8 0)
44+ (ffi/write (+ feed (* 4 i) 2) :uint8 0)
45+ (ffi/write (+ feed (* 4 i) 3) :uint8 255))
46+ (backend/every! 16 (fn [] (backend/frame-rgba! "cam" 16 16 feed)))
47+ (try
48+ (ui/run
49+ (fn []
50+ [:vbox {:spacing 4}
51+ [:title-2 {:label "heading"}]
52+ [:status {:label "connected" :live true}]
53+ [:spinner {:label "working"}]
54+ [:link {:label "a link"}]
55+ [:emoji {:emoji "x" :size 14}]
56+ [:reaction {:emoji "y" :count 3 :mine true}]
57+ [:hbox {:spacing 4}
58+ [:avatar {:label "nandi" :size 24}]
59+ [:image {:src "/tmp/jvui-green.png" :max-width 40}]
60+ [:image {:feed "cam" :size [40.0 40.0]}]]])
61+ {:title "tags" :width 320 :height 320 :frames 6 :shot shot})
62+ (finally (ffi/free feed)))
63+ (let [img (bmp shot)]
64+ (ck! "a decoded PNG is on screen, and green"
65+ (scan img (fn [{:keys [r g b]}] (and (> g 150) (< r 90) (< b 90)))))
66+ (ck! "a live feed is on screen, and red"
67+ (scan img (fn [{:keys [r g b]}] (and (> r 180) (< g 80) (< b 80)))))
68+ (ck! "an avatar with no picture is a filled disc"
69+ (scan img (fn [{:keys [r g b]}]
70+ ;; any of the name palette, none of which is the
71+ ;; background or the two above
72+ (and (> (max r g b) 90) (< (max r g b) 230)
73+ (> (- (max r g b) (min r g b)) 40)
74+ (not (and (> g 150) (< r 90)))
75+ (not (and (> r 180) (< g 80))))))))
76+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
77+ (let [bad (remove second @out)]
78+ (println (if (seq bad)
79+ (str (count bad) " of " (count @out) " checks FAILED")
80+ (str "all " (count @out) " checks passed")))
81+ (when (seq bad) (System/exit 1)))))
modified glimmer-backends/glimmer-jvui/test/glimmer_jvui/tests.clj +92 -0
@@ -5,6 +5,7 @@
55 reconciler, this backend's walk, jvui's layout and event routing — can be
66 driven with a stub that says eight pixels a character. `jolt test`."
77 (:require [glimmer.ratom :as ra]
8+ [jvui.widgets :as w]
89 [glimmer.core :as gui]
910 [glimmer-jvui.core :as jv]
1011 [jvui.core :as c]))
@@ -149,6 +150,94 @@
149150 (check! (= "hi" (ra/deref text))
150151 (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
151152
153+(defn- check-enter-sends! []
154+ ;; Enter is the one key a field must not swallow. frq sends its message
155+ ;; on it, so a compose box that accepted text and never reported Enter
156+ ;; would take a message and have no way to say it was finished — typing
157+ ;; works, sending does not, and nothing looks broken.
158+ (let [root (jv/root-node) cx (ctx)
159+ text (ra/atom "hello")
160+ sent (ra/atom nil)]
161+ (gui/mount root :page
162+ [(fn [] [:entry {:value (ra/deref text)
163+ :on-change #(ra/reset! text %)
164+ ;; A THUNK, which is what frq's handlers
165+ ;; are: s/send-draft! takes no arguments
166+ ;; and the text is already the caller's
167+ ;; from :on-change.
168+ :on-activate #(ra/reset! sent (ra/deref text))}])])
169+ (jv/render-once root cx)
170+ (let [[ex ey] (centre (tagged root :entry))]
171+ (jv/render-once root cx (click-at ex ey))) ; take focus
172+ (jv/render-once root cx [{:kind :key-down :key :return}])
173+ (check! (= "hello" (ra/deref sent))
174+ (str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
175+
176+(defn- label-node [root text]
177+ (first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
178+ (walk root))))
179+
180+(defn- check-rows-do-not-stretch! []
181+ ;; Every box shrink-wrapping its children is how frq's chat column came
182+ ;; out a couple of hundred points wide in a five-hundred-point window,
183+ ;; with every message wrapped to match and the scrollbar stranded in the
184+ ;; middle of the screen. A container fills its parent's cross axis.
185+ ;;
186+ ;; And a ROW's children must NOT: :cross rather than :horizontal is what
187+ ;; keeps a line of buttons from stretching to fill the window.
188+ (let [root (jv/root-node) cx (ctx)] ; a 400-wide context
189+ (gui/mount root :page
190+ [(fn [] [:vbox {:key :outer}
191+ [:vbox {:key :inner} [:label {:label "hi"}]]
192+ [:hbox {:key :row} [:button {:label "a"}]
193+ [:button {:label "b"}]]])])
194+ (dotimes [_ 3] (jv/render-once root cx))
195+ ;; Only tags that register for events carry a rect here, so the
196+ ;; filling half is checked by pixel in props-check — a card paints a
197+ ;; background and a screenshot can measure it. What CAN be asserted
198+ ;; from the tree is the half that would regress silently.
199+ (let [buttons (filter #(and (= :button (:tag @%)) (:rect @%)) (walk root))]
200+ (check! (every? #(< (nth (:rect @%) 2) 120.0) buttons)
201+ (str "and buttons in a row do not stretch: "
202+ (pr-str (map #(nth (:rect @%) 2) buttons)))))))
203+
204+(defn- check-scroll-sticks! []
205+ ;; A chat that does not follow new messages is the difference between a
206+ ;; window you read and one you drag.
207+ ;;
208+ ;; Asserted on GEOMETRY and not on which labels exist: every line is in
209+ ;; the tree whether or not it is on screen, so `labels` cannot tell a
210+ ;; stuck list from a pinned one. What tells them apart is where the last
211+ ;; line was PUT — inside the viewport, or far below it.
212+ (let [root (jv/root-node) cx (ctx)
213+ n (ra/atom 3)]
214+ (gui/mount root :page
215+ [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
216+ (into [:vbox {}]
217+ (for [i (range (ra/deref n))]
218+ [:label {:key i :label (str "line " i)}]))])])
219+ (dotimes [_ 3] (jv/render-once root cx))
220+ (ra/reset! n 40)
221+ (dotimes [_ 3] (jv/render-once root cx))
222+ ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
223+ ;; to scroll. A stuck list is at the far end of it; a pinned one is
224+ ;; still at zero.
225+ (let [off (w/scroll-offset "chat")]
226+ (check! (and off (> off 100.0))
227+ (str "a stuck list followed its content: offset=" off))
228+ ;; And it must STOP following once the reader has moved, or they can
229+ ;; never read anything but the newest line.
230+ ;; The mouse has to be OVER the list: a wheel is delivered to
231+ ;; whatever is under the pointer, and the pointer only moves on a
232+ ;; motion event.
233+ (jv/render-once root cx [{:kind :motion :x 20 :y 30}])
234+ (dotimes [_ 4]
235+ (jv/render-once root cx [{:kind :motion :x 20 :y 30}
236+ {:kind :wheel :x 20 :y 30 :dy 3}]))
237+ (let [off2 (w/scroll-offset "chat")]
238+ (check! (and off2 (< off2 off))
239+ (str "and let go when the reader scrolled up: " off " -> " off2))))))
240+
152241 (defn- check-checkbox-round-trips! []
153242 (let [root (jv/root-node) cx (ctx)]
154243 (ra/reset! on? false)
@@ -169,6 +258,9 @@
169258 ["a press alone does not" check-press-alone-is-not-a-click!]
170259 ["a reorder keeps identity" check-reorder-keeps-identity!]
171260 ["an unknown tag is a container" check-unknown-tag-is-a-container!]
261+ ["a row does not stretch" check-rows-do-not-stretch!]
262+ ["a list sticks to the end" check-scroll-sticks!]
263+ ["Enter sends" check-enter-sends!]
172264 ["an entry round-trips" check-entry-round-trips!]
173265 ["a checkbox round-trips" check-checkbox-round-trips!]])
174266
@@ -5,6 +5,7 @@
5 reconciler, this backend's walk, jvui's layout and event routing — can be5 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`."6 driven with a stub that says eight pixels a character. `jolt test`."
7 (:require [glimmer.ratom :as ra]7 (:require [glimmer.ratom :as ra]
8+ [jvui.widgets :as w]
8 [glimmer.core :as gui]9 [glimmer.core :as gui]
9 [glimmer-jvui.core :as jv]10 [glimmer-jvui.core :as jv]
10 [jvui.core :as c]))11 [jvui.core :as c]))
@@ -149,6 +150,94 @@
149 (check! (= "hi" (ra/deref text))150 (check! (= "hi" (ra/deref text))
150 (str "typed text reached :on-change: " (pr-str (ra/deref text))))))151 (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
151 152
153+(defn- check-enter-sends! []
154+ ;; Enter is the one key a field must not swallow. frq sends its message
155+ ;; on it, so a compose box that accepted text and never reported Enter
156+ ;; would take a message and have no way to say it was finished — typing
157+ ;; works, sending does not, and nothing looks broken.
158+ (let [root (jv/root-node) cx (ctx)
159+ text (ra/atom "hello")
160+ sent (ra/atom nil)]
161+ (gui/mount root :page
162+ [(fn [] [:entry {:value (ra/deref text)
163+ :on-change #(ra/reset! text %)
164+ ;; A THUNK, which is what frq's handlers
165+ ;; are: s/send-draft! takes no arguments
166+ ;; and the text is already the caller's
167+ ;; from :on-change.
168+ :on-activate #(ra/reset! sent (ra/deref text))}])])
169+ (jv/render-once root cx)
170+ (let [[ex ey] (centre (tagged root :entry))]
171+ (jv/render-once root cx (click-at ex ey))) ; take focus
172+ (jv/render-once root cx [{:kind :key-down :key :return}])
173+ (check! (= "hello" (ra/deref sent))
174+ (str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
175+
176+(defn- label-node [root text]
177+ (first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
178+ (walk root))))
179+
180+(defn- check-rows-do-not-stretch! []
181+ ;; Every box shrink-wrapping its children is how frq's chat column came
182+ ;; out a couple of hundred points wide in a five-hundred-point window,
183+ ;; with every message wrapped to match and the scrollbar stranded in the
184+ ;; middle of the screen. A container fills its parent's cross axis.
185+ ;;
186+ ;; And a ROW's children must NOT: :cross rather than :horizontal is what
187+ ;; keeps a line of buttons from stretching to fill the window.
188+ (let [root (jv/root-node) cx (ctx)] ; a 400-wide context
189+ (gui/mount root :page
190+ [(fn [] [:vbox {:key :outer}
191+ [:vbox {:key :inner} [:label {:label "hi"}]]
192+ [:hbox {:key :row} [:button {:label "a"}]
193+ [:button {:label "b"}]]])])
194+ (dotimes [_ 3] (jv/render-once root cx))
195+ ;; Only tags that register for events carry a rect here, so the
196+ ;; filling half is checked by pixel in props-check — a card paints a
197+ ;; background and a screenshot can measure it. What CAN be asserted
198+ ;; from the tree is the half that would regress silently.
199+ (let [buttons (filter #(and (= :button (:tag @%)) (:rect @%)) (walk root))]
200+ (check! (every? #(< (nth (:rect @%) 2) 120.0) buttons)
201+ (str "and buttons in a row do not stretch: "
202+ (pr-str (map #(nth (:rect @%) 2) buttons)))))))
203+
204+(defn- check-scroll-sticks! []
205+ ;; A chat that does not follow new messages is the difference between a
206+ ;; window you read and one you drag.
207+ ;;
208+ ;; Asserted on GEOMETRY and not on which labels exist: every line is in
209+ ;; the tree whether or not it is on screen, so `labels` cannot tell a
210+ ;; stuck list from a pinned one. What tells them apart is where the last
211+ ;; line was PUT — inside the viewport, or far below it.
212+ (let [root (jv/root-node) cx (ctx)
213+ n (ra/atom 3)]
214+ (gui/mount root :page
215+ [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
216+ (into [:vbox {}]
217+ (for [i (range (ra/deref n))]
218+ [:label {:key i :label (str "line " i)}]))])])
219+ (dotimes [_ 3] (jv/render-once root cx))
220+ (ra/reset! n 40)
221+ (dotimes [_ 3] (jv/render-once root cx))
222+ ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
223+ ;; to scroll. A stuck list is at the far end of it; a pinned one is
224+ ;; still at zero.
225+ (let [off (w/scroll-offset "chat")]
226+ (check! (and off (> off 100.0))
227+ (str "a stuck list followed its content: offset=" off))
228+ ;; And it must STOP following once the reader has moved, or they can
229+ ;; never read anything but the newest line.
230+ ;; The mouse has to be OVER the list: a wheel is delivered to
231+ ;; whatever is under the pointer, and the pointer only moves on a
232+ ;; motion event.
233+ (jv/render-once root cx [{:kind :motion :x 20 :y 30}])
234+ (dotimes [_ 4]
235+ (jv/render-once root cx [{:kind :motion :x 20 :y 30}
236+ {:kind :wheel :x 20 :y 30 :dy 3}]))
237+ (let [off2 (w/scroll-offset "chat")]
238+ (check! (and off2 (< off2 off))
239+ (str "and let go when the reader scrolled up: " off " -> " off2))))))
240+
152 (defn- check-checkbox-round-trips! []241 (defn- check-checkbox-round-trips! []
153 (let [root (jv/root-node) cx (ctx)]242 (let [root (jv/root-node) cx (ctx)]
154 (ra/reset! on? false)243 (ra/reset! on? false)
@@ -169,6 +258,9 @@
169 ["a press alone does not" check-press-alone-is-not-a-click!]258 ["a press alone does not" check-press-alone-is-not-a-click!]
170 ["a reorder keeps identity" check-reorder-keeps-identity!]259 ["a reorder keeps identity" check-reorder-keeps-identity!]
171 ["an unknown tag is a container" check-unknown-tag-is-a-container!]260 ["an unknown tag is a container" check-unknown-tag-is-a-container!]
261+ ["a row does not stretch" check-rows-do-not-stretch!]
262+ ["a list sticks to the end" check-scroll-sticks!]
263+ ["Enter sends" check-enter-sends!]
172 ["an entry round-trips" check-entry-round-trips!]264 ["an entry round-trips" check-entry-round-trips!]
173 ["a checkbox round-trips" check-checkbox-round-trips!]])265 ["a checkbox round-trips" check-checkbox-round-trips!]])
174 266
added glimmer-backends/glimmer-jvui/test/glimmer_jvui/video_check.clj +81 -0
new file mode 100644
@@ -0,0 +1,81 @@
1+(ns glimmer-jvui.video-check
2+ "An :image node with a live :feed, painted, and the pixels checked.
3+
4+ :image and not a :video tag of its own, because that is how libvidya has
5+ it and how frq writes it: a feed and a file differ in where the pixels
6+ come from and in nothing downstream of that.
7+
8+ The layout tests run headless and cannot see this: with no renderer every
9+ frame is dropped and a video tile is an empty rectangle that lays out
10+ correctly. What is actually at stake is the CHANNEL ORDER — a buffer whose
11+ bytes run R,G,B,A is the 32-bit word 0xAABBGGRR, so SDL wants ABGR8888 and
12+ the obvious-looking ARGB8888 rotates every channel and turns skin blue. A
13+ test that only asked whether a texture existed would pass either way.
14+
15+ So: a window under SDL's dummy driver, a frame with a RED left half and a
16+ BLUE right half, a screenshot, and a look at what came out."
17+ (:require [glimmer.core :as ui]
18+ [glimmer.ratom :as ra]
19+ [glimmer-jvui.core :as backend]
20+ [jvui.sdl :as sdl]
21+ [jolt.ffi :as ffi]))
22+
23+(defn- red-blue
24+ "w by h RGBA: red left, blue right, opaque."
25+ [w h]
26+ (let [p (ffi/alloc (* 4 w h))]
27+ (dotimes [y h]
28+ (dotimes [x w]
29+ (let [o (* 4 (+ (* y w) x))
30+ left? (< x (quot w 2))]
31+ (ffi/write (+ p o 0) :uint8 (if left? 230 10)) ; R
32+ (ffi/write (+ p o 1) :uint8 10) ; G
33+ (ffi/write (+ p o 2) :uint8 (if left? 10 230)) ; B
34+ (ffi/write (+ p o 3) :uint8 255)))) ; A
35+ p))
36+
37+;; A BMP from SDL is bottom-up and 24bpp, with rows padded to a four-byte
38+;; boundary and the pixel array offset in the header at byte 10. Every one of
39+;; those was got wrong first time round — 32bpp and no padding — and the
40+;; result was not an error but plausible-looking numbers from the wrong
41+;; addresses, which is exactly how a pixel test lies to you.
42+(defn- bmp-pixel [path x y]
43+ (let [b (java.nio.file.Files/readAllBytes (java.nio.file.Path/of path (into-array String [])))
44+ u (fn [i] (bit-and (int (aget b i)) 255))
45+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
46+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
47+ off (le 10)
48+ w (le 18)
49+ h (le 22)
50+ stride (* 4 (quot (+ (* w 3) 3) 4))
51+ i (+ off (* (- h 1 y) stride) (* 3 x))]
52+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))
53+
54+(defn -main [& _]
55+ (let [px (red-blue 64 64)
56+ shot (str (System/getProperty "java.io.tmpdir") "/jvui-video-check.bmp")
57+ n (ra/atom 0)]
58+ (try
59+ ;; Pushed from a TIMER, which is how frq does it — av.clj drives its
60+ ;; whole media plane from (every! 16 pump!). Pushing from the
61+ ;; component body instead is what the first version of this test did,
62+ ;; and it silently proved nothing: a component with no state renders
63+ ;; once, at mount, before the window exists — so the frame was
64+ ;; dropped for want of a renderer and the tile was empty for a
65+ ;; reason that had nothing to do with the picture.
66+ (backend/every! 16 (fn [] (backend/frame-rgba! "peer" 64 64 px)))
67+ (ui/run (fn [] [:image {:feed "peer" :size [120.0 120.0]}])
68+ {:title "video" :width 160 :height 160 :frames 6 :shot shot})
69+ (finally (ffi/free px)))
70+ (let [left (bmp-pixel shot 40 80)
71+ right (bmp-pixel shot 120 80)
72+ ok-l (and (> (:r left) 150) (< (:b left) 100))
73+ ok-r (and (> (:b right) 150) (< (:r right) 100))]
74+ (println " left pixel " (pr-str left))
75+ (println " right pixel" (pr-str right))
76+ (println (if ok-l "- the red half is red" "FAIL the red half is not red"))
77+ (println (if ok-r "- the blue half is blue" "FAIL the blue half is not blue"))
78+ (if (and ok-l ok-r)
79+ (println "all 2 checks passed")
80+ (do (println "channel order is wrong — see the ABGR note in jvui.sdl")
81+ (System/exit 1))))))
new file mode 100644
@@ -0,0 +1,81 @@
1+(ns glimmer-jvui.video-check
2+ "An :image node with a live :feed, painted, and the pixels checked.
3+
4+ :image and not a :video tag of its own, because that is how libvidya has
5+ it and how frq writes it: a feed and a file differ in where the pixels
6+ come from and in nothing downstream of that.
7+
8+ The layout tests run headless and cannot see this: with no renderer every
9+ frame is dropped and a video tile is an empty rectangle that lays out
10+ correctly. What is actually at stake is the CHANNEL ORDER — a buffer whose
11+ bytes run R,G,B,A is the 32-bit word 0xAABBGGRR, so SDL wants ABGR8888 and
12+ the obvious-looking ARGB8888 rotates every channel and turns skin blue. A
13+ test that only asked whether a texture existed would pass either way.
14+
15+ So: a window under SDL's dummy driver, a frame with a RED left half and a
16+ BLUE right half, a screenshot, and a look at what came out."
17+ (:require [glimmer.core :as ui]
18+ [glimmer.ratom :as ra]
19+ [glimmer-jvui.core :as backend]
20+ [jvui.sdl :as sdl]
21+ [jolt.ffi :as ffi]))
22+
23+(defn- red-blue
24+ "w by h RGBA: red left, blue right, opaque."
25+ [w h]
26+ (let [p (ffi/alloc (* 4 w h))]
27+ (dotimes [y h]
28+ (dotimes [x w]
29+ (let [o (* 4 (+ (* y w) x))
30+ left? (< x (quot w 2))]
31+ (ffi/write (+ p o 0) :uint8 (if left? 230 10)) ; R
32+ (ffi/write (+ p o 1) :uint8 10) ; G
33+ (ffi/write (+ p o 2) :uint8 (if left? 10 230)) ; B
34+ (ffi/write (+ p o 3) :uint8 255)))) ; A
35+ p))
36+
37+;; A BMP from SDL is bottom-up and 24bpp, with rows padded to a four-byte
38+;; boundary and the pixel array offset in the header at byte 10. Every one of
39+;; those was got wrong first time round — 32bpp and no padding — and the
40+;; result was not an error but plausible-looking numbers from the wrong
41+;; addresses, which is exactly how a pixel test lies to you.
42+(defn- bmp-pixel [path x y]
43+ (let [b (java.nio.file.Files/readAllBytes (java.nio.file.Path/of path (into-array String [])))
44+ u (fn [i] (bit-and (int (aget b i)) 255))
45+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
46+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
47+ off (le 10)
48+ w (le 18)
49+ h (le 22)
50+ stride (* 4 (quot (+ (* w 3) 3) 4))
51+ i (+ off (* (- h 1 y) stride) (* 3 x))]
52+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))
53+
54+(defn -main [& _]
55+ (let [px (red-blue 64 64)
56+ shot (str (System/getProperty "java.io.tmpdir") "/jvui-video-check.bmp")
57+ n (ra/atom 0)]
58+ (try
59+ ;; Pushed from a TIMER, which is how frq does it — av.clj drives its
60+ ;; whole media plane from (every! 16 pump!). Pushing from the
61+ ;; component body instead is what the first version of this test did,
62+ ;; and it silently proved nothing: a component with no state renders
63+ ;; once, at mount, before the window exists — so the frame was
64+ ;; dropped for want of a renderer and the tile was empty for a
65+ ;; reason that had nothing to do with the picture.
66+ (backend/every! 16 (fn [] (backend/frame-rgba! "peer" 64 64 px)))
67+ (ui/run (fn [] [:image {:feed "peer" :size [120.0 120.0]}])
68+ {:title "video" :width 160 :height 160 :frames 6 :shot shot})
69+ (finally (ffi/free px)))
70+ (let [left (bmp-pixel shot 40 80)
71+ right (bmp-pixel shot 120 80)
72+ ok-l (and (> (:r left) 150) (< (:b left) 100))
73+ ok-r (and (> (:b right) 150) (< (:r right) 100))]
74+ (println " left pixel " (pr-str left))
75+ (println " right pixel" (pr-str right))
76+ (println (if ok-l "- the red half is red" "FAIL the red half is not red"))
77+ (println (if ok-r "- the blue half is blue" "FAIL the blue half is not blue"))
78+ (if (and ok-l ok-r)
79+ (println "all 2 checks passed")
80+ (do (println "channel order is wrong — see the ABGR note in jvui.sdl")
81+ (System/exit 1))))))
modified jvui/deps.edn +6 -1
@@ -12,7 +12,12 @@
1212 :jolt/native [{:name "SDL3" :optional true
1313 :linux ["libSDL3.so.0"] :darwin ["libSDL3.0.dylib"]}
1414 {:name "SDL3_ttf" :optional true
15- :linux ["libSDL3_ttf.so.0"] :darwin ["libSDL3_ttf.0.dylib"]}]
15+ :linux ["libSDL3_ttf.so.0"] :darwin ["libSDL3_ttf.0.dylib"]}
16+ ;; Pictures from files — an avatar, an attachment, a paste.
17+ ;; Optional like the other two: a caller that shows none, and
18+ ;; the layout tests, run without it.
19+ {:name "SDL3_image" :optional true
20+ :linux ["libSDL3_image.so.0"] :darwin ["libSDL3_image.0.dylib"]}]
1621
1722 :aliases {:test {:extra-paths ["test"] :main-opts ["-m" "jvui.tests"]}
1823 :counter {:extra-paths ["examples"] :main-opts ["-m" "jvui.counter"]}
@@ -12,7 +12,12 @@
12 :jolt/native [{:name "SDL3" :optional true12 :jolt/native [{:name "SDL3" :optional true
13 :linux ["libSDL3.so.0"] :darwin ["libSDL3.0.dylib"]}13 :linux ["libSDL3.so.0"] :darwin ["libSDL3.0.dylib"]}
14 {:name "SDL3_ttf" :optional true14 {:name "SDL3_ttf" :optional true
15- :linux ["libSDL3_ttf.so.0"] :darwin ["libSDL3_ttf.0.dylib"]}]15+ :linux ["libSDL3_ttf.so.0"] :darwin ["libSDL3_ttf.0.dylib"]}
16+ ;; Pictures from files — an avatar, an attachment, a paste.
17+ ;; Optional like the other two: a caller that shows none, and
18+ ;; the layout tests, run without it.
19+ {:name "SDL3_image" :optional true
20+ :linux ["libSDL3_image.so.0"] :darwin ["libSDL3_image.0.dylib"]}]
16 21
17 :aliases {:test {:extra-paths ["test"] :main-opts ["-m" "jvui.tests"]}22 :aliases {:test {:extra-paths ["test"] :main-opts ["-m" "jvui.tests"]}
18 :counter {:extra-paths ["examples"] :main-opts ["-m" "jvui.counter"]}23 :counter {:extra-paths ["examples"] :main-opts ["-m" "jvui.counter"]}
modified jvui/src/jvui/app.clj +14 -0
@@ -7,6 +7,8 @@
77 (:require [jvui.sdl :as sdl]
88 [jvui.font :as font]
99 [jvui.paint :as paint]
10+ [jvui.frames :as frames]
11+ [jvui.host :as host]
1012 [jvui.theme :as theme]
1113 [jvui.core :as c]))
1214
@@ -68,6 +70,11 @@
6870 :theme (or theme theme/dark)})
6971 painter (:painter @ctx)
7072 deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
73+ ;; Feeds can only be uploaded once there is a renderer to upload
74+ ;; into. Anything that arrives before this is dropped rather than
75+ ;; queued — see jvui.frames.
76+ (frames/install-renderer! renderer)
77+ (host/install! window)
7178 (sdl/start-text-input! window)
7279 (try
7380 (loop [n 0]
@@ -92,10 +99,17 @@
9299 (sdl/present! renderer)
93100 (sdl/delay-ms! 16)
94101 (when-not (or (:quit? @ctx)
102+ ;; A client asking to close — see jvui.host/quit!.
103+ ;; Checked here so teardown stays the loop's, which
104+ ;; is the only thing that knows what is still being
105+ ;; walked.
106+ (host/quit-requested?)
95107 (and frames (>= (inc n) frames))
96108 (and deadline (> (System/currentTimeMillis) deadline)))
97109 (recur (inc n)))))
98110 (finally
111+ (frames/clear!)
112+ (host/clear!)
99113 (paint/close! painter)
100114 (font/close! fonts)
101115 (sdl/close! win))))))
@@ -7,6 +7,8 @@
7 (:require [jvui.sdl :as sdl]7 (:require [jvui.sdl :as sdl]
8 [jvui.font :as font]8 [jvui.font :as font]
9 [jvui.paint :as paint]9 [jvui.paint :as paint]
10+ [jvui.frames :as frames]
11+ [jvui.host :as host]
10 [jvui.theme :as theme]12 [jvui.theme :as theme]
11 [jvui.core :as c]))13 [jvui.core :as c]))
12 14
@@ -68,6 +70,11 @@
68 :theme (or theme theme/dark)})70 :theme (or theme theme/dark)})
69 painter (:painter @ctx)71 painter (:painter @ctx)
70 deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]72 deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
73+ ;; Feeds can only be uploaded once there is a renderer to upload
74+ ;; into. Anything that arrives before this is dropped rather than
75+ ;; queued — see jvui.frames.
76+ (frames/install-renderer! renderer)
77+ (host/install! window)
71 (sdl/start-text-input! window)78 (sdl/start-text-input! window)
72 (try79 (try
73 (loop [n 0]80 (loop [n 0]
@@ -92,10 +99,17 @@
92 (sdl/present! renderer)99 (sdl/present! renderer)
93 (sdl/delay-ms! 16)100 (sdl/delay-ms! 16)
94 (when-not (or (:quit? @ctx)101 (when-not (or (:quit? @ctx)
102+ ;; A client asking to close — see jvui.host/quit!.
103+ ;; Checked here so teardown stays the loop's, which
104+ ;; is the only thing that knows what is still being
105+ ;; walked.
106+ (host/quit-requested?)
95 (and frames (>= (inc n) frames))107 (and frames (>= (inc n) frames))
96 (and deadline (> (System/currentTimeMillis) deadline)))108 (and deadline (> (System/currentTimeMillis) deadline)))
97 (recur (inc n)))))109 (recur (inc n)))))
98 (finally110 (finally
111+ (frames/clear!)
112+ (host/clear!)
99 (paint/close! painter)113 (paint/close! painter)
100 (font/close! fonts)114 (font/close! fonts)
101 (sdl/close! win))))))115 (sdl/close! win))))))
modified jvui/src/jvui/core.clj +156 -11
@@ -37,6 +37,7 @@
3737 the drag until release even when the pointer leaves its rectangle, which is
3838 what makes a slider survive a fast gesture."
3939 (:require [jvui.paint :as paint]
40+ [jvui.frames :as frames]
4041 [jvui.theme :as theme]
4142 [jvui.font :as font]
4243 [jvui.sdl :as sdl]))
@@ -121,6 +122,51 @@
121122 [s x y size colour]
122123 (when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))
123124
125+(defn draw-picture!
126+ "Paint a texture into `rect`, letterboxed to keep its shape."
127+ [tex tw th rect]
128+ (when (and (drawing?) tex)
129+ (paint/frame! (:painter (ui)) tex tw th rect)))
130+
131+(defn colour-emoji?
132+ "Whether `s` would be drawn as a colour picture rather than as text.
133+
134+ Answered off the painter and not off `drawing?`, so the layout passes and
135+ the paint pass agree: a glyph that will be a square picture has to be
136+ MEASURED as one, three walks before it is drawn. A headless walk has no
137+ painter and no colour anything, and answers false."
138+ [s]
139+ (boolean (when-let [p (:painter (ui))] (paint/colour-emoji? p s))))
140+
141+(defn draw-emoji!
142+ "Paint `s` as a colour picture in `rect`, if there is one."
143+ [s rect]
144+ (when (drawing?) (paint/emoji! (:painter (ui)) s rect)))
145+
146+(defn draw-frame!
147+ "Paint feed `key`'s latest picture into `rect`, if it has one."
148+ [key rect]
149+ (when-let [{:keys [tex w h]} (frames/lookup key)]
150+ (draw-picture! tex w h rect)))
151+
152+(def ^:private name-palette
153+ ;; Eight, and chosen to stay apart at avatar size against both themes.
154+ ;; More would collide less and look less like a set.
155+ [[214 96 96 255] [214 148 60 255] [186 186 64 255] [104 186 104 255]
156+ [76 176 176 255] [92 140 214 255] [148 112 208 255] [204 104 168 255]])
157+
158+(defn name-colour
159+ "A stable colour for a name.
160+
161+ Stable is the whole requirement: the same person must be the same colour
162+ in the member list, in the message they sent and in the tile they are
163+ speaking from, or the colour is decoration rather than identity. So it is
164+ a hash of the name and not a counter."
165+ [s]
166+ (let [h (reduce (fn [a ch] (bit-and (+ (* a 31) (int ch)) 0x7fffffff))
167+ 7 (seq (str s)))]
168+ (nth name-palette (mod h (count name-palette)))))
169+
124170 (defn draw-line!
125171 [x0 y0 x1 y1 colour width]
126172 (when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))
@@ -164,12 +210,26 @@
164210 (def ^:private CROSS 2)
165211 (def ^:private N 3)
166212 (def ^:private EXPANDERS 4)
213+;; Wrapped rows only: where the current row starts, and how tall it is so
214+;; far. A box that does not wrap leaves both at zero and behaves exactly as
215+;; it did.
216+(def ^:private ROWY 5)
217+(def ^:private ROWH 6)
167218
168-(defn- counters [] (double-array 5))
219+(defn- counters [] (double-array 7))
169220 (defn- ctr [f i] (aget (:c f) i))
170221 (defn- ctr+ [f i v] (aset (:c f) i (+ (aget (:c f) i) v)))
171222
172223 (defn- expands?
224+ "Does a child with this `expand` take more room along `axis`?
225+
226+ `:cross` is the container's answer, and the one worth explaining: fill
227+ the parent's OTHER axis and take no share of its own. A column inside a
228+ column should be as wide as its parent and only as tall as its
229+ contents; a row inside that column, the same. Saying `:horizontal`
230+ instead works in a column and is wrong in a row — there it makes the
231+ child fight its siblings for the slack, and a line of buttons stretches
232+ to fill the window."
173233 [expand axis]
174234 (case expand
175235 :both true
@@ -186,8 +246,17 @@
186246 [advance min-along min-cross grew?]
187247 (let [f (top)]
188248 (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)))
249+ (if (:wrap f)
250+ ;; A wrapped row measures differently in both directions: its own
251+ ;; axis is the WIDEST row rather than the run of every child, and
252+ ;; its cross axis is the rows stacked rather than the tallest child.
253+ (do
254+ (aset (:c f) ALONG (max (ctr f ALONG) (- (ctr f CURSOR) (:spacing f))))
255+ (aset (:c f) ROWH (max (ctr f ROWH) (double min-cross)))
256+ (aset (:c f) CROSS (+ (ctr f ROWY) (ctr f ROWH))))
257+ (do
258+ (ctr+ f ALONG (+ min-along (if (pos? (ctr f N)) (:spacing f) 0.0)))
259+ (aset (:c f) CROSS (max (ctr f CROSS) (double min-cross)))))
191260 (ctr+ f N 1.0)
192261 (when grew? (ctr+ f EXPANDERS 1.0))))
193262
@@ -204,8 +273,9 @@
204273 [rx ry rw rh] rect
205274 [ox oy] (or offset [0.0 0.0])
206275 along-axis (if (= dir :vertical) :vertical :horizontal)
207- grow-along? (expands? expand along-axis)
208- grow-cross? (expands? expand (if (= dir :vertical) :horizontal :vertical))]
276+ cross-axis (if (= dir :vertical) :horizontal :vertical)
277+ grow-along? (and (not= expand :cross) (expands? expand along-axis))
278+ grow-cross? (or (= expand :cross) (expands? expand cross-axis))]
209279 (if (= dir :vertical)
210280 (let [h (+ mh (if grow-along? share 0.0))
211281 ;; NOT clamped to the box's width. A container's own size comes from
@@ -219,12 +289,61 @@
219289 (tally! h mh mw grow-along?)
220290 [x y w h])
221291 (let [w (+ mw (if grow-along? share 0.0))
292+ ;; Wrap BEFORE placing: a child that will not fit on this row
293+ ;; starts the next one. Never on the first child of a row —
294+ ;; something wider than the whole box has to go somewhere, and
295+ ;; wrapping it forever is worse than letting it overflow.
296+ _ (when (and (:wrap f) (pos? (ctr f N)) (> (+ cursor w) rw))
297+ (aset (:c f) CURSOR 0.0)
298+ (ctr+ f ROWY (+ (ctr f ROWH) (:spacing f)))
299+ (aset (:c f) ROWH 0.0))
300+ cursor (ctr f CURSOR)
222301 h (if grow-cross? rh mh)
223302 x (+ rx ox cursor)
224- y (+ ry oy (* gy (- rh h)))]
303+ y (+ ry oy (ctr f ROWY) (if (:wrap f) 0.0 (* gy (- rh h))))]
225304 (tally! w mw mh grow-along?)
226305 [x y w h]))))
227306
307+(defn avail-width
308+ "How much width the current box can still give a child.
309+
310+ Along a row that is what is left after the children already placed; down
311+ a column it is the whole width, because each child starts at the left.
312+
313+ Answers 0 before a box has a width — a container's size comes from what
314+ its children asked for LAST frame, so on the first one there is nothing
315+ to divide. A caller must read 0 as \"no constraint known yet\" and not as
316+ \"no room\": treating it as no room pins the child at zero and the loop
317+ never recovers, which is the same trap `rect-for` documents above."
318+ []
319+ (let [{:keys [dir rect] :as f} (top)
320+ [rx _ rw _] rect
321+ [sw _] (:size (ui))
322+ box (if (= dir :vertical) rw (- rw (ctr f CURSOR)))
323+ ;; Bounded by the WINDOW, not only by the box. A box's width comes
324+ ;; from what its children asked for last frame, so an unconstrained
325+ ;; one is exactly as wide as its widest child — ask it how much room
326+ ;; there is and it answers "as much as you took", and a label that
327+ ;; wants to wrap never does. The window is the one width in the tree
328+ ;; that no child can talk into growing.
329+ room (- (double (or sw 0)) rx)]
330+ (max 0.0 (if (pos? room) (min box room) box))))
331+
332+(defn avail-height
333+ "How much height the current box can still give a child.
334+
335+ The mirror of `avail-width`, and bounded by the WINDOW for the same
336+ reason: a column's height comes from what its children asked for last
337+ frame, so asking the box how much room there is gets back what you
338+ already took."
339+ []
340+ (let [{:keys [dir rect] :as f} (top)
341+ [_ ry _ rh] rect
342+ [_ sh] (:size (ui))
343+ box (if (= dir :vertical) (- rh (ctr f CURSOR)) rh)
344+ room (- (double (or sh 0)) ry)]
345+ (max 0.0 (if (pos? room) (min box room) box))))
346+
228347 (defn next-id
229348 "Claim the next id under the current box."
230349 ([] (next-id nil))
@@ -240,14 +359,29 @@
240359 (upd! assoc :clip rect)
241360 (when (drawing?) (paint/set-clip! (:painter (ui)) rect)))
242361
362+(defn with-clip
363+ "Run `f` with drawing confined to `rect`, then put the old clip back.
364+
365+ Intersected with whatever clip is already in force, so a field inside a
366+ scrolled viewport is bounded by both and not just by itself."
367+ [rect f]
368+ (let [prev (:clip (ui))
369+ r (if prev (intersect prev rect) rect)]
370+ (set-clip! r)
371+ (try (f) (finally (set-clip! prev)))))
372+
243373 (defn box*
244374 "The container everything else is built from.
245375
246376 opts: :dir :spacing :padding :margin :expand :gravity :key :fill :border
247- :radius :min-size :clip? :offset"
377+ :radius :min-size :clip? :offset :wrap
378+
379+ :wrap only means anything on a row: children that will not fit start a
380+ new line instead of running off the end. A column already puts every
381+ child on a line of its own."
248382 [opts body]
249383 (let [{:keys [dir spacing padding margin expand gravity key fill border
250- radius min-size clip? offset fixed]
384+ radius min-size clip? offset fixed wrap pad-right]
251385 :or {dir :vertical expand :none gravity [0.0 0.0] clip? false}} opts
252386 spacing (double (or spacing 0.0))
253387 padding (double (or padding 0.0))
@@ -266,8 +400,13 @@
266400 [ox oy ow oh] outer
267401 box-rect [(+ ox margin) (+ oy margin)
268402 (- ow (* 2 margin)) (- oh (* 2 margin))]
403+ ;; A strip along the right the children never get, on top of the
404+ ;; padding: it is where a scrollbar goes. Only the CONTENT loses
405+ ;; it — the box keeps its rectangle, so the bar is drawn inside the
406+ ;; box's own edge rather than beyond it.
407+ pad-right (double (or pad-right 0.0))
269408 content [(+ (first box-rect) padding) (+ (second box-rect) padding)
270- (max 0.0 (- (nth box-rect 2) (* 2 padding)))
409+ (max 0.0 (- (nth box-rect 2) (* 2 padding) pad-right))
271410 (max 0.0 (- (nth box-rect 3) (* 2 padding)))]
272411 ;; Extra space to hand out along our own axis, computed from what we
273412 ;; counted last frame: whatever the fixed children took is spoken for,
@@ -289,6 +428,9 @@
289428 (when clip? (set-clip! (intersect (or outer-clip content) content)))
290429 (push-frame! {:id id :dir dir :rect content :spacing spacing
291430 :share share :c (counters)
431+ ;; Only a row can wrap. A column already puts every child
432+ ;; on a line of its own.
433+ :wrap (boolean (and wrap (= dir :horizontal)))
292434 :offset (or offset [0.0 0.0])})
293435 (let [result (when body (body id box-rect))
294436 f (pop-frame!)]
@@ -297,9 +439,12 @@
297439 ;; the run of them; this swap is the only place that distinction is spelled
298440 ;; out.
299441 (let [pad2 (+ (* 2 padding) (* 2 margin))
442+ ;; The gutter counts towards the WIDTH the box needs and nothing
443+ ;; else: it is a strip the children were not given, so a box
444+ ;; wide enough for them is not wide enough for them and it.
300445 computed (if (= dir :vertical)
301- [(+ (ctr f CROSS) pad2) (+ (ctr f ALONG) pad2)]
302- [(+ (ctr f ALONG) pad2) (+ (ctr f CROSS) pad2)])
446+ [(+ (ctr f CROSS) pad2 pad-right) (+ (ctr f ALONG) pad2)]
447+ [(+ (ctr f ALONG) pad2 pad-right) (+ (ctr f CROSS) pad2)])
303448 computed (if min-size
304449 [(max (first computed) (first min-size))
305450 (max (second computed) (second min-size))]
@@ -37,6 +37,7 @@
37 the drag until release even when the pointer leaves its rectangle, which is37 the drag until release even when the pointer leaves its rectangle, which is
38 what makes a slider survive a fast gesture."38 what makes a slider survive a fast gesture."
39 (:require [jvui.paint :as paint]39 (:require [jvui.paint :as paint]
40+ [jvui.frames :as frames]
40 [jvui.theme :as theme]41 [jvui.theme :as theme]
41 [jvui.font :as font]42 [jvui.font :as font]
42 [jvui.sdl :as sdl]))43 [jvui.sdl :as sdl]))
@@ -121,6 +122,51 @@
121 [s x y size colour]122 [s x y size colour]
122 (when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))123 (when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))
123 124
125+(defn draw-picture!
126+ "Paint a texture into `rect`, letterboxed to keep its shape."
127+ [tex tw th rect]
128+ (when (and (drawing?) tex)
129+ (paint/frame! (:painter (ui)) tex tw th rect)))
130+
131+(defn colour-emoji?
132+ "Whether `s` would be drawn as a colour picture rather than as text.
133+
134+ Answered off the painter and not off `drawing?`, so the layout passes and
135+ the paint pass agree: a glyph that will be a square picture has to be
136+ MEASURED as one, three walks before it is drawn. A headless walk has no
137+ painter and no colour anything, and answers false."
138+ [s]
139+ (boolean (when-let [p (:painter (ui))] (paint/colour-emoji? p s))))
140+
141+(defn draw-emoji!
142+ "Paint `s` as a colour picture in `rect`, if there is one."
143+ [s rect]
144+ (when (drawing?) (paint/emoji! (:painter (ui)) s rect)))
145+
146+(defn draw-frame!
147+ "Paint feed `key`'s latest picture into `rect`, if it has one."
148+ [key rect]
149+ (when-let [{:keys [tex w h]} (frames/lookup key)]
150+ (draw-picture! tex w h rect)))
151+
152+(def ^:private name-palette
153+ ;; Eight, and chosen to stay apart at avatar size against both themes.
154+ ;; More would collide less and look less like a set.
155+ [[214 96 96 255] [214 148 60 255] [186 186 64 255] [104 186 104 255]
156+ [76 176 176 255] [92 140 214 255] [148 112 208 255] [204 104 168 255]])
157+
158+(defn name-colour
159+ "A stable colour for a name.
160+
161+ Stable is the whole requirement: the same person must be the same colour
162+ in the member list, in the message they sent and in the tile they are
163+ speaking from, or the colour is decoration rather than identity. So it is
164+ a hash of the name and not a counter."
165+ [s]
166+ (let [h (reduce (fn [a ch] (bit-and (+ (* a 31) (int ch)) 0x7fffffff))
167+ 7 (seq (str s)))]
168+ (nth name-palette (mod h (count name-palette)))))
169+
124 (defn draw-line!170 (defn draw-line!
125 [x0 y0 x1 y1 colour width]171 [x0 y0 x1 y1 colour width]
126 (when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))172 (when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))
@@ -164,12 +210,26 @@
164 (def ^:private CROSS 2)210 (def ^:private CROSS 2)
165 (def ^:private N 3)211 (def ^:private N 3)
166 (def ^:private EXPANDERS 4)212 (def ^:private EXPANDERS 4)
213+;; Wrapped rows only: where the current row starts, and how tall it is so
214+;; far. A box that does not wrap leaves both at zero and behaves exactly as
215+;; it did.
216+(def ^:private ROWY 5)
217+(def ^:private ROWH 6)
167 218
168-(defn- counters [] (double-array 5))219+(defn- counters [] (double-array 7))
169 (defn- ctr [f i] (aget (:c f) i))220 (defn- ctr [f i] (aget (:c f) i))
170 (defn- ctr+ [f i v] (aset (:c f) i (+ (aget (:c f) i) v)))221 (defn- ctr+ [f i v] (aset (:c f) i (+ (aget (:c f) i) v)))
171 222
172 (defn- expands?223 (defn- expands?
224+ "Does a child with this `expand` take more room along `axis`?
225+
226+ `:cross` is the container's answer, and the one worth explaining: fill
227+ the parent's OTHER axis and take no share of its own. A column inside a
228+ column should be as wide as its parent and only as tall as its
229+ contents; a row inside that column, the same. Saying `:horizontal`
230+ instead works in a column and is wrong in a row — there it makes the
231+ child fight its siblings for the slack, and a line of buttons stretches
232+ to fill the window."
173 [expand axis]233 [expand axis]
174 (case expand234 (case expand
175 :both true235 :both true
@@ -186,8 +246,17 @@
186 [advance min-along min-cross grew?]246 [advance min-along min-cross grew?]
187 (let [f (top)]247 (let [f (top)]
188 (ctr+ f CURSOR (+ advance (:spacing f)))248 (ctr+ f CURSOR (+ advance (:spacing f)))
189- (ctr+ f ALONG (+ min-along (if (pos? (ctr f N)) (:spacing f) 0.0)))249+ (if (:wrap f)
190- (aset (:c f) CROSS (max (ctr f CROSS) (double min-cross)))250+ ;; A wrapped row measures differently in both directions: its own
251+ ;; axis is the WIDEST row rather than the run of every child, and
252+ ;; its cross axis is the rows stacked rather than the tallest child.
253+ (do
254+ (aset (:c f) ALONG (max (ctr f ALONG) (- (ctr f CURSOR) (:spacing f))))
255+ (aset (:c f) ROWH (max (ctr f ROWH) (double min-cross)))
256+ (aset (:c f) CROSS (+ (ctr f ROWY) (ctr f ROWH))))
257+ (do
258+ (ctr+ f ALONG (+ min-along (if (pos? (ctr f N)) (:spacing f) 0.0)))
259+ (aset (:c f) CROSS (max (ctr f CROSS) (double min-cross)))))
191 (ctr+ f N 1.0)260 (ctr+ f N 1.0)
192 (when grew? (ctr+ f EXPANDERS 1.0))))261 (when grew? (ctr+ f EXPANDERS 1.0))))
193 262
@@ -204,8 +273,9 @@
204 [rx ry rw rh] rect273 [rx ry rw rh] rect
205 [ox oy] (or offset [0.0 0.0])274 [ox oy] (or offset [0.0 0.0])
206 along-axis (if (= dir :vertical) :vertical :horizontal)275 along-axis (if (= dir :vertical) :vertical :horizontal)
207- grow-along? (expands? expand along-axis)276+ cross-axis (if (= dir :vertical) :horizontal :vertical)
208- grow-cross? (expands? expand (if (= dir :vertical) :horizontal :vertical))]277+ grow-along? (and (not= expand :cross) (expands? expand along-axis))
278+ grow-cross? (or (= expand :cross) (expands? expand cross-axis))]
209 (if (= dir :vertical)279 (if (= dir :vertical)
210 (let [h (+ mh (if grow-along? share 0.0))280 (let [h (+ mh (if grow-along? share 0.0))
211 ;; NOT clamped to the box's width. A container's own size comes from281 ;; NOT clamped to the box's width. A container's own size comes from
@@ -219,12 +289,61 @@
219 (tally! h mh mw grow-along?)289 (tally! h mh mw grow-along?)
220 [x y w h])290 [x y w h])
221 (let [w (+ mw (if grow-along? share 0.0))291 (let [w (+ mw (if grow-along? share 0.0))
292+ ;; Wrap BEFORE placing: a child that will not fit on this row
293+ ;; starts the next one. Never on the first child of a row —
294+ ;; something wider than the whole box has to go somewhere, and
295+ ;; wrapping it forever is worse than letting it overflow.
296+ _ (when (and (:wrap f) (pos? (ctr f N)) (> (+ cursor w) rw))
297+ (aset (:c f) CURSOR 0.0)
298+ (ctr+ f ROWY (+ (ctr f ROWH) (:spacing f)))
299+ (aset (:c f) ROWH 0.0))
300+ cursor (ctr f CURSOR)
222 h (if grow-cross? rh mh)301 h (if grow-cross? rh mh)
223 x (+ rx ox cursor)302 x (+ rx ox cursor)
224- y (+ ry oy (* gy (- rh h)))]303+ y (+ ry oy (ctr f ROWY) (if (:wrap f) 0.0 (* gy (- rh h))))]
225 (tally! w mw mh grow-along?)304 (tally! w mw mh grow-along?)
226 [x y w h]))))305 [x y w h]))))
227 306
307+(defn avail-width
308+ "How much width the current box can still give a child.
309+
310+ Along a row that is what is left after the children already placed; down
311+ a column it is the whole width, because each child starts at the left.
312+
313+ Answers 0 before a box has a width — a container's size comes from what
314+ its children asked for LAST frame, so on the first one there is nothing
315+ to divide. A caller must read 0 as \"no constraint known yet\" and not as
316+ \"no room\": treating it as no room pins the child at zero and the loop
317+ never recovers, which is the same trap `rect-for` documents above."
318+ []
319+ (let [{:keys [dir rect] :as f} (top)
320+ [rx _ rw _] rect
321+ [sw _] (:size (ui))
322+ box (if (= dir :vertical) rw (- rw (ctr f CURSOR)))
323+ ;; Bounded by the WINDOW, not only by the box. A box's width comes
324+ ;; from what its children asked for last frame, so an unconstrained
325+ ;; one is exactly as wide as its widest child — ask it how much room
326+ ;; there is and it answers "as much as you took", and a label that
327+ ;; wants to wrap never does. The window is the one width in the tree
328+ ;; that no child can talk into growing.
329+ room (- (double (or sw 0)) rx)]
330+ (max 0.0 (if (pos? room) (min box room) box))))
331+
332+(defn avail-height
333+ "How much height the current box can still give a child.
334+
335+ The mirror of `avail-width`, and bounded by the WINDOW for the same
336+ reason: a column's height comes from what its children asked for last
337+ frame, so asking the box how much room there is gets back what you
338+ already took."
339+ []
340+ (let [{:keys [dir rect] :as f} (top)
341+ [_ ry _ rh] rect
342+ [_ sh] (:size (ui))
343+ box (if (= dir :vertical) (- rh (ctr f CURSOR)) rh)
344+ room (- (double (or sh 0)) ry)]
345+ (max 0.0 (if (pos? room) (min box room) box))))
346+
228 (defn next-id347 (defn next-id
229 "Claim the next id under the current box."348 "Claim the next id under the current box."
230 ([] (next-id nil))349 ([] (next-id nil))
@@ -240,14 +359,29 @@
240 (upd! assoc :clip rect)359 (upd! assoc :clip rect)
241 (when (drawing?) (paint/set-clip! (:painter (ui)) rect)))360 (when (drawing?) (paint/set-clip! (:painter (ui)) rect)))
242 361
362+(defn with-clip
363+ "Run `f` with drawing confined to `rect`, then put the old clip back.
364+
365+ Intersected with whatever clip is already in force, so a field inside a
366+ scrolled viewport is bounded by both and not just by itself."
367+ [rect f]
368+ (let [prev (:clip (ui))
369+ r (if prev (intersect prev rect) rect)]
370+ (set-clip! r)
371+ (try (f) (finally (set-clip! prev)))))
372+
243 (defn box*373 (defn box*
244 "The container everything else is built from.374 "The container everything else is built from.
245 375
246 opts: :dir :spacing :padding :margin :expand :gravity :key :fill :border376 opts: :dir :spacing :padding :margin :expand :gravity :key :fill :border
247- :radius :min-size :clip? :offset"377+ :radius :min-size :clip? :offset :wrap
378+
379+ :wrap only means anything on a row: children that will not fit start a
380+ new line instead of running off the end. A column already puts every
381+ child on a line of its own."
248 [opts body]382 [opts body]
249 (let [{:keys [dir spacing padding margin expand gravity key fill border383 (let [{:keys [dir spacing padding margin expand gravity key fill border
250- radius min-size clip? offset fixed]384+ radius min-size clip? offset fixed wrap pad-right]
251 :or {dir :vertical expand :none gravity [0.0 0.0] clip? false}} opts385 :or {dir :vertical expand :none gravity [0.0 0.0] clip? false}} opts
252 spacing (double (or spacing 0.0))386 spacing (double (or spacing 0.0))
253 padding (double (or padding 0.0))387 padding (double (or padding 0.0))
@@ -266,8 +400,13 @@
266 [ox oy ow oh] outer400 [ox oy ow oh] outer
267 box-rect [(+ ox margin) (+ oy margin)401 box-rect [(+ ox margin) (+ oy margin)
268 (- ow (* 2 margin)) (- oh (* 2 margin))]402 (- ow (* 2 margin)) (- oh (* 2 margin))]
403+ ;; A strip along the right the children never get, on top of the
404+ ;; padding: it is where a scrollbar goes. Only the CONTENT loses
405+ ;; it — the box keeps its rectangle, so the bar is drawn inside the
406+ ;; box's own edge rather than beyond it.
407+ pad-right (double (or pad-right 0.0))
269 content [(+ (first box-rect) padding) (+ (second box-rect) padding)408 content [(+ (first box-rect) padding) (+ (second box-rect) padding)
270- (max 0.0 (- (nth box-rect 2) (* 2 padding)))409+ (max 0.0 (- (nth box-rect 2) (* 2 padding) pad-right))
271 (max 0.0 (- (nth box-rect 3) (* 2 padding)))]410 (max 0.0 (- (nth box-rect 3) (* 2 padding)))]
272 ;; Extra space to hand out along our own axis, computed from what we411 ;; 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,412 ;; counted last frame: whatever the fixed children took is spoken for,
@@ -289,6 +428,9 @@
289 (when clip? (set-clip! (intersect (or outer-clip content) content)))428 (when clip? (set-clip! (intersect (or outer-clip content) content)))
290 (push-frame! {:id id :dir dir :rect content :spacing spacing429 (push-frame! {:id id :dir dir :rect content :spacing spacing
291 :share share :c (counters)430 :share share :c (counters)
431+ ;; Only a row can wrap. A column already puts every child
432+ ;; on a line of its own.
433+ :wrap (boolean (and wrap (= dir :horizontal)))
292 :offset (or offset [0.0 0.0])})434 :offset (or offset [0.0 0.0])})
293 (let [result (when body (body id box-rect))435 (let [result (when body (body id box-rect))
294 f (pop-frame!)]436 f (pop-frame!)]
@@ -297,9 +439,12 @@
297 ;; the run of them; this swap is the only place that distinction is spelled439 ;; the run of them; this swap is the only place that distinction is spelled
298 ;; out.440 ;; out.
299 (let [pad2 (+ (* 2 padding) (* 2 margin))441 (let [pad2 (+ (* 2 padding) (* 2 margin))
442+ ;; The gutter counts towards the WIDTH the box needs and nothing
443+ ;; else: it is a strip the children were not given, so a box
444+ ;; wide enough for them is not wide enough for them and it.
300 computed (if (= dir :vertical)445 computed (if (= dir :vertical)
301- [(+ (ctr f CROSS) pad2) (+ (ctr f ALONG) pad2)]446+ [(+ (ctr f CROSS) pad2 pad-right) (+ (ctr f ALONG) pad2)]
302- [(+ (ctr f ALONG) pad2) (+ (ctr f CROSS) pad2)])447+ [(+ (ctr f ALONG) pad2 pad-right) (+ (ctr f CROSS) pad2)])
303 computed (if min-size448 computed (if min-size
304 [(max (first computed) (first min-size))449 [(max (first computed) (first min-size))
305 (max (second computed) (second min-size))]450 (max (second computed) (second min-size))]
modified jvui/src/jvui/font.clj +155 -1
@@ -13,7 +13,8 @@
1313 with a colour-mod at draw time, so one cached texture serves a label in
1414 every colour it is ever drawn in, and a static page uploads nothing at all
1515 after its first frame."
16- (:require [jvui.sdl :as sdl]))
16+ (:require [clojure.string]
17+ [jvui.sdl :as sdl]))
1718
1819 (def ^:private candidates
1920 ["/usr/share/fonts/noto/NotoSans-Regular.ttf"
@@ -35,11 +36,137 @@
3536
3637 (defn- ffi-null? [p] (or (nil? p) (and (number? p) (zero? p))))
3738
39+(def ^:private fallbacks
40+ "Faces to try for what the UI font has no glyph for.
41+
42+ A UI font covers Latin and stops. frq's chrome is icons and its
43+ messages carry emoji, and every one of those was coming out as the
44+ missing-glyph box — which is what the reader sees as \"the glyphs are
45+ broken\". SDL_ttf keeps a list of fallback faces and asks each in turn,
46+ so this costs nothing for text that the main face already has.
47+
48+ Outline faces first, and colour emoji last, because a colour emoji
49+ font is usually BITMAP — one fixed strike, commonly 109 or 128 pixels
50+ — and a face that cannot be scaled to the size asked for is worse than
51+ no face at all. `usable?` below is what actually decides; the order
52+ only settles who wins when both would do.
53+
54+ JVUI_FALLBACK_FONTS overrides, colon-separated, for a machine whose
55+ fonts live somewhere else."
56+ [;; Monochrome and scalable. Noto Emoji is the outline companion to
57+ ;; NotoColorEmoji and is the one that works at a UI size.
58+ "/usr/share/fonts/noto/NotoEmoji-Regular.ttf"
59+ "/usr/share/fonts/truetype/noto/NotoEmoji-Regular.ttf"
60+ "/usr/share/fonts/noto/NotoSansSymbols2-Regular.ttf"
61+ "/usr/share/fonts/noto/NotoSansSymbols-Regular.ttf"
62+ "/usr/share/fonts/truetype/noto/NotoSansSymbols2-Regular.ttf"
63+ "/usr/share/fonts/truetype/noto/NotoSansSymbols-Regular.ttf"
64+ ;; Last, and only where SDL_ttf can scale it.
65+ "/usr/share/fonts/noto/NotoColorEmoji.ttf"
66+ "/usr/share/fonts/truetype/noto/NotoColorEmoji.ttf"])
67+
68+(defn- fallback-paths []
69+ (if-let [env (System/getenv "JVUI_FALLBACK_FONTS")]
70+ (remove clojure.string/blank? (clojure.string/split env #":"))
71+ (filter #(.exists (java.io.File. %)) fallbacks)))
72+
73+(def ^:private colour-faces
74+ "Colour emoji faces, for the picture path below rather than as fallbacks.
75+
76+ JVUI_COLOUR_EMOJI_FONT overrides, and an empty value turns colour off —
77+ which is the way to get the monochrome fallback back on a machine that
78+ has both."
79+ ["/usr/share/fonts/noto/NotoColorEmoji.ttf"
80+ "/usr/share/fonts/truetype/noto/NotoColorEmoji.ttf"
81+ "/usr/share/fonts/noto/NotoColorEmoji-Regular.ttf"
82+ "/System/Library/Fonts/Apple Color Emoji.ttc"])
83+
84+(defn- colour-path []
85+ (if-let [env (System/getenv "JVUI_COLOUR_EMOJI_FONT")]
86+ (when (seq env) env)
87+ (first (filter #(.exists (java.io.File. %)) colour-faces))))
88+
3889 (defn open
3990 "A font cache over `path`. Sizes are opened lazily and kept."
4091 [path]
4192 (atom {:path path :faces {} :sizes {} :textures {}}))
4293
94+;; --- colour emoji ------------------------------------------------------------
95+;;
96+;; Not through the fallback list, and it cannot be: a colour emoji face is a
97+;; BITMAP with one strike — NotoColorEmoji has a single 128-pixel one — so
98+;; SDL_ttf answers 128 to every size it is asked for, measurement as much as
99+;; drawing. Added as a fallback it makes any line holding an emoji a hundred
100+;; and twenty-eight pixels tall, which is what `usable?` above refuses.
101+;;
102+;; So it is drawn as a PICTURE instead: rendered once at the size it insists
103+;; on, kept as a texture, and blitted into whatever box the layout gave the
104+;; glyph. The scale happens on the GPU at draw time, where the size the face
105+;; will not do costs nothing. The monochrome fallback stays as it is and
106+;; answers everything this has no glyph for.
107+
108+(defn- colour-face
109+ "The colour emoji face, opened once, or nil where there is none.
110+
111+ `:colour` is a three-state cell: absent means not looked for, false means
112+ looked for and not found. Without the false a machine with no colour face
113+ re-opens nothing but re-walks the candidate list on every glyph."
114+ [cache]
115+ (let [v (:colour @cache)]
116+ (if (some? v)
117+ (or v nil)
118+ (let [path (colour-path)
119+ f (when path (sdl/open-font path (float 32)))
120+ f (when-not (ffi-null? f) f)]
121+ (swap! cache assoc :colour (or f false))
122+ f))))
123+
124+(defn- ignorable?
125+ "Codepoints an emoji carries that no face is expected to have a glyph for:
126+ the variation selectors that ask for emoji presentation, the zero-width
127+ joiner that binds a sequence, and the tag characters flags are spelled
128+ with."
129+ [cp]
130+ (or (= cp 0x200D) (<= 0xFE00 cp 0xFE0F) (<= 0xE0020 cp 0xE007F)))
131+
132+(defn colour-glyph?
133+ "Whether the colour face can draw `s` — every codepoint in it that is a
134+ glyph at all.
135+
136+ Every one, not the first: taking the first would claim a family the face
137+ has only the man of, and draw it as a man."
138+ [cache s]
139+ (boolean
140+ (when-let [f (and (seq s) (colour-face cache))]
141+ ;; `seq` over the codepoints, not over UTF-16: a jolt string is
142+ ;; Scheme's, whose characters are whole scalars, so there are no
143+ ;; surrogate halves here to pair up. frq.glyphs walks emoji the same
144+ ;; way.
145+ (let [cps (remove ignorable? (map int (seq s)))]
146+ (and (seq cps) (every? #(sdl/font-has-glyph? f (int %)) cps))))))
147+
148+(defn colour-texture
149+ "An SDL texture of `s` in colour, and its [w h], cached. nil where the
150+ colour face cannot draw it.
151+
152+ One texture per string rather than per string-and-size, because the face
153+ has one size: the caller scales it into the rectangle the layout gave."
154+ [cache renderer s]
155+ (when (colour-glyph? cache s)
156+ (or (get-in @cache [:colour-textures s])
157+ (let [surf (sdl/render-blended (colour-face cache) s)]
158+ (when-not (ffi-null? surf)
159+ (let [tex (sdl/texture-from-surface renderer surf)
160+ wh (sdl/surface-size surf)]
161+ (sdl/destroy-surface! surf)
162+ (sdl/texture-blend-mode! tex sdl/BLEND)
163+ ;; Linear, because this texture is only ever drawn scaled DOWN
164+ ;; — 128 pixels into a sixteen-pixel line — and nearest at that
165+ ;; ratio is a handful of the original pixels and looks it.
166+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR)
167+ (swap! cache assoc-in [:colour-textures s] [tex wh])
168+ [tex wh]))))))
169+
43170 (defn- face
44171 [cache size]
45172 (let [k (int size)]
@@ -47,6 +174,31 @@
47174 (let [f (sdl/open-font (:path @cache) (float size))]
48175 (when (or (nil? f) (and (number? f) (zero? f)))
49176 (throw (ex-info (str "TTF_OpenFont " (:path @cache) ": " (sdl/error)) {})))
177+ ;; Fallbacks are per FACE, not per family, so each size opens its
178+ ;; own and they are kept for as long as the face is — SDL_ttf
179+ ;; holds the pointer and does not copy the font.
180+ (let [want (sdl/font-height f)
181+ fbs (into []
182+ (keep (fn [path]
183+ (let [g (sdl/open-font path (float size))]
184+ (when-not (ffi-null? g)
185+ ;; A face that answers a size it was
186+ ;; not asked for cannot be used. A
187+ ;; colour emoji font is a bitmap with
188+ ;; one strike — ask for 14 and it
189+ ;; still gives 128 — and SDL_ttf draws
190+ ;; it at that, so one emoji in a
191+ ;; message makes a row a hundred and
192+ ;; twenty-eight pixels tall and pushes
193+ ;; the rest of the window out of the
194+ ;; way. Twice the face's own height is
195+ ;; the line: a symbol face runs a
196+ ;; little tall and is fine.
197+ (if (> (sdl/font-height g) (* 2 want))
198+ (do (sdl/close-font! g) nil)
199+ (do (sdl/add-fallback-font! f g) g))))))
200+ (fallback-paths))]
201+ (swap! cache update :fallbacks (fnil into []) fbs))
50202 (swap! cache assoc-in [:faces k] f)
51203 f))))
52204
@@ -80,5 +232,7 @@
80232 (defn close!
81233 [cache]
82234 (doseq [[_ [tex _]] (:textures @cache)] (sdl/destroy-texture! tex))
235+ (doseq [[_ [tex _]] (:colour-textures @cache)] (sdl/destroy-texture! tex))
83236 (doseq [[_ f] (:faces @cache)] (sdl/close-font! f))
237+ (when-let [f (:colour @cache)] (sdl/close-font! f))
84238 (reset! cache {:path (:path @cache) :faces {} :sizes {} :textures {}}))
@@ -13,7 +13,8 @@
13 with a colour-mod at draw time, so one cached texture serves a label in13 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 all14 every colour it is ever drawn in, and a static page uploads nothing at all
15 after its first frame."15 after its first frame."
16- (:require [jvui.sdl :as sdl]))16+ (:require [clojure.string]
17+ [jvui.sdl :as sdl]))
17 18
18 (def ^:private candidates19 (def ^:private candidates
19 ["/usr/share/fonts/noto/NotoSans-Regular.ttf"20 ["/usr/share/fonts/noto/NotoSans-Regular.ttf"
@@ -35,11 +36,137 @@
35 36
36 (defn- ffi-null? [p] (or (nil? p) (and (number? p) (zero? p))))37 (defn- ffi-null? [p] (or (nil? p) (and (number? p) (zero? p))))
37 38
39+(def ^:private fallbacks
40+ "Faces to try for what the UI font has no glyph for.
41+
42+ A UI font covers Latin and stops. frq's chrome is icons and its
43+ messages carry emoji, and every one of those was coming out as the
44+ missing-glyph box — which is what the reader sees as \"the glyphs are
45+ broken\". SDL_ttf keeps a list of fallback faces and asks each in turn,
46+ so this costs nothing for text that the main face already has.
47+
48+ Outline faces first, and colour emoji last, because a colour emoji
49+ font is usually BITMAP — one fixed strike, commonly 109 or 128 pixels
50+ — and a face that cannot be scaled to the size asked for is worse than
51+ no face at all. `usable?` below is what actually decides; the order
52+ only settles who wins when both would do.
53+
54+ JVUI_FALLBACK_FONTS overrides, colon-separated, for a machine whose
55+ fonts live somewhere else."
56+ [;; Monochrome and scalable. Noto Emoji is the outline companion to
57+ ;; NotoColorEmoji and is the one that works at a UI size.
58+ "/usr/share/fonts/noto/NotoEmoji-Regular.ttf"
59+ "/usr/share/fonts/truetype/noto/NotoEmoji-Regular.ttf"
60+ "/usr/share/fonts/noto/NotoSansSymbols2-Regular.ttf"
61+ "/usr/share/fonts/noto/NotoSansSymbols-Regular.ttf"
62+ "/usr/share/fonts/truetype/noto/NotoSansSymbols2-Regular.ttf"
63+ "/usr/share/fonts/truetype/noto/NotoSansSymbols-Regular.ttf"
64+ ;; Last, and only where SDL_ttf can scale it.
65+ "/usr/share/fonts/noto/NotoColorEmoji.ttf"
66+ "/usr/share/fonts/truetype/noto/NotoColorEmoji.ttf"])
67+
68+(defn- fallback-paths []
69+ (if-let [env (System/getenv "JVUI_FALLBACK_FONTS")]
70+ (remove clojure.string/blank? (clojure.string/split env #":"))
71+ (filter #(.exists (java.io.File. %)) fallbacks)))
72+
73+(def ^:private colour-faces
74+ "Colour emoji faces, for the picture path below rather than as fallbacks.
75+
76+ JVUI_COLOUR_EMOJI_FONT overrides, and an empty value turns colour off —
77+ which is the way to get the monochrome fallback back on a machine that
78+ has both."
79+ ["/usr/share/fonts/noto/NotoColorEmoji.ttf"
80+ "/usr/share/fonts/truetype/noto/NotoColorEmoji.ttf"
81+ "/usr/share/fonts/noto/NotoColorEmoji-Regular.ttf"
82+ "/System/Library/Fonts/Apple Color Emoji.ttc"])
83+
84+(defn- colour-path []
85+ (if-let [env (System/getenv "JVUI_COLOUR_EMOJI_FONT")]
86+ (when (seq env) env)
87+ (first (filter #(.exists (java.io.File. %)) colour-faces))))
88+
38 (defn open89 (defn open
39 "A font cache over `path`. Sizes are opened lazily and kept."90 "A font cache over `path`. Sizes are opened lazily and kept."
40 [path]91 [path]
41 (atom {:path path :faces {} :sizes {} :textures {}}))92 (atom {:path path :faces {} :sizes {} :textures {}}))
42 93
94+;; --- colour emoji ------------------------------------------------------------
95+;;
96+;; Not through the fallback list, and it cannot be: a colour emoji face is a
97+;; BITMAP with one strike — NotoColorEmoji has a single 128-pixel one — so
98+;; SDL_ttf answers 128 to every size it is asked for, measurement as much as
99+;; drawing. Added as a fallback it makes any line holding an emoji a hundred
100+;; and twenty-eight pixels tall, which is what `usable?` above refuses.
101+;;
102+;; So it is drawn as a PICTURE instead: rendered once at the size it insists
103+;; on, kept as a texture, and blitted into whatever box the layout gave the
104+;; glyph. The scale happens on the GPU at draw time, where the size the face
105+;; will not do costs nothing. The monochrome fallback stays as it is and
106+;; answers everything this has no glyph for.
107+
108+(defn- colour-face
109+ "The colour emoji face, opened once, or nil where there is none.
110+
111+ `:colour` is a three-state cell: absent means not looked for, false means
112+ looked for and not found. Without the false a machine with no colour face
113+ re-opens nothing but re-walks the candidate list on every glyph."
114+ [cache]
115+ (let [v (:colour @cache)]
116+ (if (some? v)
117+ (or v nil)
118+ (let [path (colour-path)
119+ f (when path (sdl/open-font path (float 32)))
120+ f (when-not (ffi-null? f) f)]
121+ (swap! cache assoc :colour (or f false))
122+ f))))
123+
124+(defn- ignorable?
125+ "Codepoints an emoji carries that no face is expected to have a glyph for:
126+ the variation selectors that ask for emoji presentation, the zero-width
127+ joiner that binds a sequence, and the tag characters flags are spelled
128+ with."
129+ [cp]
130+ (or (= cp 0x200D) (<= 0xFE00 cp 0xFE0F) (<= 0xE0020 cp 0xE007F)))
131+
132+(defn colour-glyph?
133+ "Whether the colour face can draw `s` — every codepoint in it that is a
134+ glyph at all.
135+
136+ Every one, not the first: taking the first would claim a family the face
137+ has only the man of, and draw it as a man."
138+ [cache s]
139+ (boolean
140+ (when-let [f (and (seq s) (colour-face cache))]
141+ ;; `seq` over the codepoints, not over UTF-16: a jolt string is
142+ ;; Scheme's, whose characters are whole scalars, so there are no
143+ ;; surrogate halves here to pair up. frq.glyphs walks emoji the same
144+ ;; way.
145+ (let [cps (remove ignorable? (map int (seq s)))]
146+ (and (seq cps) (every? #(sdl/font-has-glyph? f (int %)) cps))))))
147+
148+(defn colour-texture
149+ "An SDL texture of `s` in colour, and its [w h], cached. nil where the
150+ colour face cannot draw it.
151+
152+ One texture per string rather than per string-and-size, because the face
153+ has one size: the caller scales it into the rectangle the layout gave."
154+ [cache renderer s]
155+ (when (colour-glyph? cache s)
156+ (or (get-in @cache [:colour-textures s])
157+ (let [surf (sdl/render-blended (colour-face cache) s)]
158+ (when-not (ffi-null? surf)
159+ (let [tex (sdl/texture-from-surface renderer surf)
160+ wh (sdl/surface-size surf)]
161+ (sdl/destroy-surface! surf)
162+ (sdl/texture-blend-mode! tex sdl/BLEND)
163+ ;; Linear, because this texture is only ever drawn scaled DOWN
164+ ;; — 128 pixels into a sixteen-pixel line — and nearest at that
165+ ;; ratio is a handful of the original pixels and looks it.
166+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR)
167+ (swap! cache assoc-in [:colour-textures s] [tex wh])
168+ [tex wh]))))))
169+
43 (defn- face170 (defn- face
44 [cache size]171 [cache size]
45 (let [k (int size)]172 (let [k (int size)]
@@ -47,6 +174,31 @@
47 (let [f (sdl/open-font (:path @cache) (float size))]174 (let [f (sdl/open-font (:path @cache) (float size))]
48 (when (or (nil? f) (and (number? f) (zero? f)))175 (when (or (nil? f) (and (number? f) (zero? f)))
49 (throw (ex-info (str "TTF_OpenFont " (:path @cache) ": " (sdl/error)) {})))176 (throw (ex-info (str "TTF_OpenFont " (:path @cache) ": " (sdl/error)) {})))
177+ ;; Fallbacks are per FACE, not per family, so each size opens its
178+ ;; own and they are kept for as long as the face is — SDL_ttf
179+ ;; holds the pointer and does not copy the font.
180+ (let [want (sdl/font-height f)
181+ fbs (into []
182+ (keep (fn [path]
183+ (let [g (sdl/open-font path (float size))]
184+ (when-not (ffi-null? g)
185+ ;; A face that answers a size it was
186+ ;; not asked for cannot be used. A
187+ ;; colour emoji font is a bitmap with
188+ ;; one strike — ask for 14 and it
189+ ;; still gives 128 — and SDL_ttf draws
190+ ;; it at that, so one emoji in a
191+ ;; message makes a row a hundred and
192+ ;; twenty-eight pixels tall and pushes
193+ ;; the rest of the window out of the
194+ ;; way. Twice the face's own height is
195+ ;; the line: a symbol face runs a
196+ ;; little tall and is fine.
197+ (if (> (sdl/font-height g) (* 2 want))
198+ (do (sdl/close-font! g) nil)
199+ (do (sdl/add-fallback-font! f g) g))))))
200+ (fallback-paths))]
201+ (swap! cache update :fallbacks (fnil into []) fbs))
50 (swap! cache assoc-in [:faces k] f)202 (swap! cache assoc-in [:faces k] f)
51 f))))203 f))))
52 204
@@ -80,5 +232,7 @@
80 (defn close!232 (defn close!
81 [cache]233 [cache]
82 (doseq [[_ [tex _]] (:textures @cache)] (sdl/destroy-texture! tex))234 (doseq [[_ [tex _]] (:textures @cache)] (sdl/destroy-texture! tex))
235+ (doseq [[_ [tex _]] (:colour-textures @cache)] (sdl/destroy-texture! tex))
83 (doseq [[_ f] (:faces @cache)] (sdl/close-font! f))236 (doseq [[_ f] (:faces @cache)] (sdl/close-font! f))
237+ (when-let [f (:colour @cache)] (sdl/close-font! f))
84 (reset! cache {:path (:path @cache) :faces {} :sizes {} :textures {}}))238 (reset! cache {:path (:path @cache) :faces {} :sizes {} :textures {}}))
added jvui/src/jvui/frames.clj +118 -0
new file mode 100644
@@ -0,0 +1,118 @@
1+(ns jvui.frames
2+ "Pictures that arrive from somewhere else — a camera, a decoder, a call.
3+
4+ Everything else jvui paints, it paints: a rectangle, a glyph, a rounded
5+ corner. A video frame is different in two ways that make it worth its own
6+ namespace.
7+
8+ IT ARRIVES BETWEEN FRAMES. A decoder hands over a picture when the network
9+ gives it one, not when the UI is walking, so there is no painter in scope
10+ and no rect to put it in. The texture is uploaded THEN — immediately, on
11+ the thread that brought it — and the walk finds it already on the GPU.
12+
13+ AND THE PIXELS ARE BORROWED. The pointer belongs to whatever decoded it and
14+ is good until that decoder produces its next picture, so it cannot be kept
15+ and cannot be copied into a jolt value on the way past. `put!` uploads
16+ straight from the pointer and returns; after that the caller may do what it
17+ likes with the memory.
18+
19+ Which is why the renderer is held here as state rather than passed in. It
20+ is not lovely, and the alternative is worse: threading a painter through a
21+ media pipeline so a codec can know about a toolkit."
22+ (:require [jvui.sdl :as sdl]
23+ [jolt.ffi :as ffi]))
24+
25+(defonce ^:private renderer (atom nil))
26+(defonce ^:private textures (atom {}))
27+
28+(defn install-renderer!
29+ "Called by the frame loop when a window opens.
30+
31+ Frames that arrive before this are dropped rather than queued: a picture
32+ with nowhere to go is a picture nobody saw, and holding it would mean
33+ holding a pointer whose owner has moved on."
34+ [r]
35+ (reset! renderer r))
36+
37+(defn- free-texture! [{:keys [tex]}]
38+ (when tex (sdl/destroy-texture! tex)))
39+
40+(defn drop!
41+ "Forget a feed and release its texture."
42+ [key]
43+ (when-let [t (get @textures key)]
44+ (swap! textures dissoc key)
45+ (free-texture! t))
46+ nil)
47+
48+(defn put!
49+ "Upload one RGBA frame, `w` by `h`, from FOREIGN memory at `ptr`.
50+
51+ The texture is recreated when the size changes — a peer switching camera
52+ or resolution mid-call is a real thing, and SDL will not resize one in
53+ place. Otherwise the same texture is written over, which is what
54+ STREAMING access is for."
55+ [key w h ptr]
56+ (when-let [r @renderer]
57+ (when (and (pos? w) (pos? h) ptr)
58+ (let [have (get @textures key)
59+ t (if (and have (= w (:w have)) (= h (:h have)))
60+ have
61+ (do (when have (free-texture! have))
62+ (let [tex (sdl/create-texture r sdl/PIXELFORMAT-ABGR8888
63+ sdl/TEXTUREACCESS-STREAMING
64+ w h)]
65+ (when tex
66+ (sdl/texture-blend-mode! tex sdl/BLEND)
67+ ;; Linear, because a call tile is almost never shown
68+ ;; at the size it was encoded.
69+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR))
70+ {:tex tex :w w :h h})))]
71+ (when (:tex t)
72+ (sdl/update-texture-raw! (:tex t) ptr (* 4 w))
73+ (swap! textures assoc key t))))
74+ nil))
75+
76+(defn from-file
77+ "The texture for a picture on disk, decoded once and kept.
78+
79+ Cached by PATH, and never re-read: a file that changed under us is not a
80+ case this has — frq writes an attachment once, under a name it chose, and
81+ a picture that needs to change gets a new path.
82+
83+ nil when there is no renderer yet, when SDL3_image is not installed, or
84+ when the file will not decode. All three are the same answer to a caller:
85+ there is no picture, draw what you would have drawn without one. A
86+ broken-image glyph would be worse — the text beside it already says what
87+ it was meant to be."
88+ [path]
89+ (when-let [r @renderer]
90+ (let [k [::file path]]
91+ (or (get @textures k)
92+ (let [tex (try (sdl/img-load-texture r (str path))
93+ (catch Exception _ nil))]
94+ (when (and tex (not (ffi/null? tex)))
95+ (let [[w h] (or (sdl/texture-size tex) [0 0])
96+ t {:tex tex :w w :h h}]
97+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR)
98+ (swap! textures assoc k t)
99+ t)))))))
100+
101+(defn lookup
102+ "{:tex :w :h} for a feed, or nil."
103+ [key]
104+ (get @textures key))
105+
106+(defn keys*
107+ "Every live feed with a picture. Decoded files are not feeds and are not
108+ listed — a caller asking this wants to know who is on camera."
109+ []
110+ (set (remove vector? (keys @textures))))
111+
112+(defn clear!
113+ "Release every texture — the window is going away."
114+ []
115+ (doseq [[_ t] @textures] (free-texture! t))
116+ (reset! textures {})
117+ (reset! renderer nil)
118+ nil)
new file mode 100644
@@ -0,0 +1,118 @@
1+(ns jvui.frames
2+ "Pictures that arrive from somewhere else — a camera, a decoder, a call.
3+
4+ Everything else jvui paints, it paints: a rectangle, a glyph, a rounded
5+ corner. A video frame is different in two ways that make it worth its own
6+ namespace.
7+
8+ IT ARRIVES BETWEEN FRAMES. A decoder hands over a picture when the network
9+ gives it one, not when the UI is walking, so there is no painter in scope
10+ and no rect to put it in. The texture is uploaded THEN — immediately, on
11+ the thread that brought it — and the walk finds it already on the GPU.
12+
13+ AND THE PIXELS ARE BORROWED. The pointer belongs to whatever decoded it and
14+ is good until that decoder produces its next picture, so it cannot be kept
15+ and cannot be copied into a jolt value on the way past. `put!` uploads
16+ straight from the pointer and returns; after that the caller may do what it
17+ likes with the memory.
18+
19+ Which is why the renderer is held here as state rather than passed in. It
20+ is not lovely, and the alternative is worse: threading a painter through a
21+ media pipeline so a codec can know about a toolkit."
22+ (:require [jvui.sdl :as sdl]
23+ [jolt.ffi :as ffi]))
24+
25+(defonce ^:private renderer (atom nil))
26+(defonce ^:private textures (atom {}))
27+
28+(defn install-renderer!
29+ "Called by the frame loop when a window opens.
30+
31+ Frames that arrive before this are dropped rather than queued: a picture
32+ with nowhere to go is a picture nobody saw, and holding it would mean
33+ holding a pointer whose owner has moved on."
34+ [r]
35+ (reset! renderer r))
36+
37+(defn- free-texture! [{:keys [tex]}]
38+ (when tex (sdl/destroy-texture! tex)))
39+
40+(defn drop!
41+ "Forget a feed and release its texture."
42+ [key]
43+ (when-let [t (get @textures key)]
44+ (swap! textures dissoc key)
45+ (free-texture! t))
46+ nil)
47+
48+(defn put!
49+ "Upload one RGBA frame, `w` by `h`, from FOREIGN memory at `ptr`.
50+
51+ The texture is recreated when the size changes — a peer switching camera
52+ or resolution mid-call is a real thing, and SDL will not resize one in
53+ place. Otherwise the same texture is written over, which is what
54+ STREAMING access is for."
55+ [key w h ptr]
56+ (when-let [r @renderer]
57+ (when (and (pos? w) (pos? h) ptr)
58+ (let [have (get @textures key)
59+ t (if (and have (= w (:w have)) (= h (:h have)))
60+ have
61+ (do (when have (free-texture! have))
62+ (let [tex (sdl/create-texture r sdl/PIXELFORMAT-ABGR8888
63+ sdl/TEXTUREACCESS-STREAMING
64+ w h)]
65+ (when tex
66+ (sdl/texture-blend-mode! tex sdl/BLEND)
67+ ;; Linear, because a call tile is almost never shown
68+ ;; at the size it was encoded.
69+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR))
70+ {:tex tex :w w :h h})))]
71+ (when (:tex t)
72+ (sdl/update-texture-raw! (:tex t) ptr (* 4 w))
73+ (swap! textures assoc key t))))
74+ nil))
75+
76+(defn from-file
77+ "The texture for a picture on disk, decoded once and kept.
78+
79+ Cached by PATH, and never re-read: a file that changed under us is not a
80+ case this has — frq writes an attachment once, under a name it chose, and
81+ a picture that needs to change gets a new path.
82+
83+ nil when there is no renderer yet, when SDL3_image is not installed, or
84+ when the file will not decode. All three are the same answer to a caller:
85+ there is no picture, draw what you would have drawn without one. A
86+ broken-image glyph would be worse — the text beside it already says what
87+ it was meant to be."
88+ [path]
89+ (when-let [r @renderer]
90+ (let [k [::file path]]
91+ (or (get @textures k)
92+ (let [tex (try (sdl/img-load-texture r (str path))
93+ (catch Exception _ nil))]
94+ (when (and tex (not (ffi/null? tex)))
95+ (let [[w h] (or (sdl/texture-size tex) [0 0])
96+ t {:tex tex :w w :h h}]
97+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR)
98+ (swap! textures assoc k t)
99+ t)))))))
100+
101+(defn lookup
102+ "{:tex :w :h} for a feed, or nil."
103+ [key]
104+ (get @textures key))
105+
106+(defn keys*
107+ "Every live feed with a picture. Decoded files are not feeds and are not
108+ listed — a caller asking this wants to know who is on camera."
109+ []
110+ (set (remove vector? (keys @textures))))
111+
112+(defn clear!
113+ "Release every texture — the window is going away."
114+ []
115+ (doseq [[_ t] @textures] (free-texture! t))
116+ (reset! textures {})
117+ (reset! renderer nil)
118+ nil)
added jvui/src/jvui/host.clj +122 -0
new file mode 100644
@@ -0,0 +1,122 @@
1+(ns jvui.host
2+ "The window as a thing in an operating system, rather than a thing to draw in.
3+
4+ Its title, the display it is on, the browser, the clipboard, and asking it
5+ to close. None of this is painting and none of it belongs in a widget, but
6+ a client cannot do any of it either — the window handle lives here, so the
7+ questions come here too.
8+
9+ Everything answers a harmless nothing before a window exists: no title to
10+ set, no display to measure, no clipboard to read. A client that runs
11+ headless — jvui's own tests do — should not have to guard every call."
12+ (:require [jvui.sdl :as sdl]))
13+
14+(defonce ^:private win (atom nil))
15+(defonce ^:private quit? (atom false))
16+
17+(defn install!
18+ "Called by the frame loop when a window opens."
19+ [window]
20+ (reset! win window)
21+ (reset! quit? false))
22+
23+(defn clear! [] (reset! win nil) nil)
24+
25+(defn window
26+ "The open window, or nil."
27+ []
28+ @win)
29+
30+;; --- closing -----------------------------------------------------------------
31+
32+(defn quit!
33+ "Ask the frame loop to stop after the current frame.
34+
35+ A request rather than an exit: the loop owns teardown — textures, painter,
36+ fonts, the window itself — and tearing any of it down from under a walk
37+ that is still running is how a close turns into a crash."
38+ []
39+ (reset! quit? true)
40+ nil)
41+
42+(defn quit-requested? [] @quit?)
43+
44+;; --- the window --------------------------------------------------------------
45+
46+(defn set-title! [s]
47+ (when-let [w @win] (sdl/set-window-title! w (str s)))
48+ nil)
49+
50+(defn window-size
51+ "[w h] in window units, or nil with no window."
52+ []
53+ (when-let [w @win] (sdl/window-size w)))
54+
55+(defn window-width
56+ "Width in window units, or 0 with no window — a caller dividing by it wants
57+ a number, and zero is the honest one."
58+ []
59+ (or (first (window-size)) 0))
60+
61+(defn screen-size
62+ "[w h] of the display this window is on. [0 0] before there is one.
63+
64+ NUMBERS, not nil, and that is the whole point of the zero. A client asks
65+ this while it is starting — frq computes its layout from
66+ `(long (second (screen-size)))` on the first tick, which is before the
67+ window opens — and nil there is a NullPointerException in the caller
68+ rather than a small first frame. `window-width` already answers 0 for the
69+ same reason; this matches it.
70+
71+ The value is right on the next tick, and a layout computed against zero
72+ for one frame is a layout nobody saw."
73+ []
74+ (or (when-let [w @win] (sdl/display-bounds w)) [0 0]))
75+
76+;; --- the world outside -------------------------------------------------------
77+
78+(defn open-url!
79+ "Hand a URL to whatever the desktop opens URLs with."
80+ [url]
81+ (boolean (and (string? url) (seq url) (sdl/open-url! url))))
82+
83+(defn clipboard-image-png!
84+ "Write the clipboard's picture to `path` as PNG; true when there was one.
85+
86+ Only image/png is asked for. A clipboard may also hold a bitmap or a TIFF
87+ and converting those would mean an encoder in here, which is a lot of
88+ toolkit for a paste — and every desktop that puts a picture on a clipboard
89+ this decade puts a PNG there too."
90+ [path]
91+ (boolean
92+ (when (sdl/has-clipboard-data "image/png")
93+ (when-let [[p n] (sdl/clipboard-data "image/png")]
94+ (try
95+ (let [bs (byte-array n)]
96+ (jolt.ffi/read-array p :byte bs)
97+ (java.nio.file.Files/write
98+ (java.nio.file.Path/of (str path) (into-array String []))
99+ bs
100+ (into-array java.nio.file.OpenOption []))
101+ true)
102+ (finally (sdl/sdl-free! p)))))))
103+
104+;; --- the picture chooser ------------------------------------------------------
105+;; There is not one, and that is the same answer glimmer-vidya gives on a
106+;; desktop. The chooser exists so a phone can hand back a grant for one
107+;; picture without the app holding a permission over all of them; a desktop
108+;; has no such thing and browsing the filesystem is the answer there.
109+;;
110+;; So these are not stubs waiting to be filled in on this backend — they are
111+;; the correct answer for it, and a caller reads the false and offers a file
112+;; browser instead. An Android jvui would replace them.
113+
114+(defn pick-image!
115+ "False: this platform has no picture chooser."
116+ []
117+ false)
118+
119+(defn picked-image!
120+ "nil: nothing was ever chosen, because nothing could be."
121+ [_path]
122+ nil)
new file mode 100644
@@ -0,0 +1,122 @@
1+(ns jvui.host
2+ "The window as a thing in an operating system, rather than a thing to draw in.
3+
4+ Its title, the display it is on, the browser, the clipboard, and asking it
5+ to close. None of this is painting and none of it belongs in a widget, but
6+ a client cannot do any of it either — the window handle lives here, so the
7+ questions come here too.
8+
9+ Everything answers a harmless nothing before a window exists: no title to
10+ set, no display to measure, no clipboard to read. A client that runs
11+ headless — jvui's own tests do — should not have to guard every call."
12+ (:require [jvui.sdl :as sdl]))
13+
14+(defonce ^:private win (atom nil))
15+(defonce ^:private quit? (atom false))
16+
17+(defn install!
18+ "Called by the frame loop when a window opens."
19+ [window]
20+ (reset! win window)
21+ (reset! quit? false))
22+
23+(defn clear! [] (reset! win nil) nil)
24+
25+(defn window
26+ "The open window, or nil."
27+ []
28+ @win)
29+
30+;; --- closing -----------------------------------------------------------------
31+
32+(defn quit!
33+ "Ask the frame loop to stop after the current frame.
34+
35+ A request rather than an exit: the loop owns teardown — textures, painter,
36+ fonts, the window itself — and tearing any of it down from under a walk
37+ that is still running is how a close turns into a crash."
38+ []
39+ (reset! quit? true)
40+ nil)
41+
42+(defn quit-requested? [] @quit?)
43+
44+;; --- the window --------------------------------------------------------------
45+
46+(defn set-title! [s]
47+ (when-let [w @win] (sdl/set-window-title! w (str s)))
48+ nil)
49+
50+(defn window-size
51+ "[w h] in window units, or nil with no window."
52+ []
53+ (when-let [w @win] (sdl/window-size w)))
54+
55+(defn window-width
56+ "Width in window units, or 0 with no window — a caller dividing by it wants
57+ a number, and zero is the honest one."
58+ []
59+ (or (first (window-size)) 0))
60+
61+(defn screen-size
62+ "[w h] of the display this window is on. [0 0] before there is one.
63+
64+ NUMBERS, not nil, and that is the whole point of the zero. A client asks
65+ this while it is starting — frq computes its layout from
66+ `(long (second (screen-size)))` on the first tick, which is before the
67+ window opens — and nil there is a NullPointerException in the caller
68+ rather than a small first frame. `window-width` already answers 0 for the
69+ same reason; this matches it.
70+
71+ The value is right on the next tick, and a layout computed against zero
72+ for one frame is a layout nobody saw."
73+ []
74+ (or (when-let [w @win] (sdl/display-bounds w)) [0 0]))
75+
76+;; --- the world outside -------------------------------------------------------
77+
78+(defn open-url!
79+ "Hand a URL to whatever the desktop opens URLs with."
80+ [url]
81+ (boolean (and (string? url) (seq url) (sdl/open-url! url))))
82+
83+(defn clipboard-image-png!
84+ "Write the clipboard's picture to `path` as PNG; true when there was one.
85+
86+ Only image/png is asked for. A clipboard may also hold a bitmap or a TIFF
87+ and converting those would mean an encoder in here, which is a lot of
88+ toolkit for a paste — and every desktop that puts a picture on a clipboard
89+ this decade puts a PNG there too."
90+ [path]
91+ (boolean
92+ (when (sdl/has-clipboard-data "image/png")
93+ (when-let [[p n] (sdl/clipboard-data "image/png")]
94+ (try
95+ (let [bs (byte-array n)]
96+ (jolt.ffi/read-array p :byte bs)
97+ (java.nio.file.Files/write
98+ (java.nio.file.Path/of (str path) (into-array String []))
99+ bs
100+ (into-array java.nio.file.OpenOption []))
101+ true)
102+ (finally (sdl/sdl-free! p)))))))
103+
104+;; --- the picture chooser ------------------------------------------------------
105+;; There is not one, and that is the same answer glimmer-vidya gives on a
106+;; desktop. The chooser exists so a phone can hand back a grant for one
107+;; picture without the app holding a permission over all of them; a desktop
108+;; has no such thing and browsing the filesystem is the answer there.
109+;;
110+;; So these are not stubs waiting to be filled in on this backend — they are
111+;; the correct answer for it, and a caller reads the false and offers a file
112+;; browser instead. An Android jvui would replace them.
113+
114+(defn pick-image!
115+ "False: this platform has no picture chooser."
116+ []
117+ false)
118+
119+(defn picked-image!
120+ "nil: nothing was ever chosen, because nothing could be."
121+ [_path]
122+ nil)
modified jvui/src/jvui/paint.clj +30 -0
@@ -134,6 +134,36 @@
134134 colour (max 0.0 (- radius bw)))))
135135 (when colour (round-rect! p [x y w h] colour radius))))))
136136
137+(defn frame!
138+ "Blit a whole texture into `rect`, letterboxed to keep its shape.
139+
140+ Stretching to fill would be one line shorter and would make every face in
141+ a call slightly wrong — a 16:9 camera in a square tile is the ordinary
142+ case, not the exceptional one."
143+ [p tex tw th [x y w h]]
144+ (let [{:keys [r]} @p
145+ sx (/ (double w) tw)
146+ sy (/ (double h) th)
147+ k (min sx sy)
148+ dw (* tw k)
149+ dh (* th k)]
150+ (flush! p)
151+ (sdl/blit! r tex nil [(+ x (/ (- w dw) 2.0)) (+ y (/ (- h dh) 2.0)) dw dh])))
152+
153+(defn colour-emoji?
154+ "Whether `s` has a colour picture to be drawn as."
155+ [p s]
156+ (font/colour-glyph? (:fonts @p) s))
157+
158+(defn emoji!
159+ "Draw `s` as a colour picture in `rect`. Answers whether it did — a caller
160+ that gets false draws it as text instead."
161+ [p s rect]
162+ (let [{:keys [r fonts]} @p]
163+ (if-let [[tex [tw th]] (font/colour-texture fonts r s)]
164+ (do (frame! p tex tw th rect) true)
165+ false)))
166+
137167 (defn line!
138168 "A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case
139169 — which in this toolkit is a checkbox tick — is a few offset hairlines,
@@ -134,6 +134,36 @@
134 colour (max 0.0 (- radius bw)))))134 colour (max 0.0 (- radius bw)))))
135 (when colour (round-rect! p [x y w h] colour radius))))))135 (when colour (round-rect! p [x y w h] colour radius))))))
136 136
137+(defn frame!
138+ "Blit a whole texture into `rect`, letterboxed to keep its shape.
139+
140+ Stretching to fill would be one line shorter and would make every face in
141+ a call slightly wrong — a 16:9 camera in a square tile is the ordinary
142+ case, not the exceptional one."
143+ [p tex tw th [x y w h]]
144+ (let [{:keys [r]} @p
145+ sx (/ (double w) tw)
146+ sy (/ (double h) th)
147+ k (min sx sy)
148+ dw (* tw k)
149+ dh (* th k)]
150+ (flush! p)
151+ (sdl/blit! r tex nil [(+ x (/ (- w dw) 2.0)) (+ y (/ (- h dh) 2.0)) dw dh])))
152+
153+(defn colour-emoji?
154+ "Whether `s` has a colour picture to be drawn as."
155+ [p s]
156+ (font/colour-glyph? (:fonts @p) s))
157+
158+(defn emoji!
159+ "Draw `s` as a colour picture in `rect`. Answers whether it did — a caller
160+ that gets false draws it as text instead."
161+ [p s rect]
162+ (let [{:keys [r fonts]} @p]
163+ (if-let [[tex [tw th]] (font/colour-texture fonts r s)]
164+ (do (frame! p tex tw th rect) true)
165+ false)))
166+
137 (defn line!167 (defn line!
138 "A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case168 "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,169 — which in this toolkit is a checkbox tick — is a few offset hairlines,
modified jvui/src/jvui/sdl.clj +75 -0
@@ -67,6 +67,10 @@
6767 (ffi/defcfn open-font "TTF_OpenFont" [:string :float] :pointer)
6868 (ffi/defcfn close-font! "TTF_CloseFont" [:pointer] :void)
6969 (ffi/defcfn font-height "TTF_GetFontHeight" [:pointer] :int)
70+;; A face to try for characters the main one has no glyph for. SDL_ttf keeps
71+;; a list of them and asks each in turn.
72+(ffi/defcfn add-fallback-font! "TTF_AddFallbackFont" [:pointer :pointer] :bool)
73+(ffi/defcfn font-has-glyph? "TTF_FontHasGlyph" [:pointer :uint] :bool)
7074 (ffi/defcfn ^:private raw-string-size "TTF_GetStringSize"
7175 [:pointer :string :ulong :pointer :pointer] :bool)
7276 (ffi/defcfn ^:private raw-render-blended "TTF_RenderText_Blended"
@@ -259,7 +263,20 @@
259263 [:pointer :float :float :float :float] :bool)
260264
261265 (def PIXELFORMAT-ARGB8888 372645892)
266+
267+;; SDL_PIXELFORMAT_ABGR8888, which is what SDL_PIXELFORMAT_RGBA32 aliases to
268+;; on a little-endian machine. Named by its packed layout rather than its byte
269+;; order, which is the trap: a buffer whose BYTES run R,G,B,A reads as the
270+;; 32-bit word 0xAABBGGRR, so ABGR8888 is the one that matches it and
271+;; ARGB8888 — the obvious-looking choice — puts the channels through a
272+;; rotation and turns skin blue.
273+(def PIXELFORMAT-ABGR8888 376840196)
274+
262275 (def TEXTUREACCESS-STATIC 0)
276+;; STREAMING for anything uploaded every frame. STATIC textures live in
277+;; memory the driver expects to write rarely; a video feed at thirty a second
278+;; is the case the distinction exists for.
279+(def TEXTUREACCESS-STREAMING 1)
263280
264281 (defn update-texture!
265282 "Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
@@ -269,6 +286,64 @@
269286 (ffi/write-array p :int pixels)
270287 (raw-update-texture tex ffi/null p (* 4 w)))))
271288
289+;; --- the platform around the window -----------------------------------------
290+;; Title, display, browser, clipboard. None of it is drawing, and all of it is
291+;; what a client asks the toolkit for because the toolkit is the only thing
292+;; holding a window handle.
293+
294+(ffi/defcfn set-window-title! "SDL_SetWindowTitle" [:pointer :string] :bool)
295+(ffi/defcfn open-url! "SDL_OpenURL" [:string] :bool)
296+(ffi/defcfn display-for-window "SDL_GetDisplayForWindow" [:pointer] :uint)
297+(ffi/defcfn ^:private raw-display-bounds "SDL_GetDisplayUsableBounds"
298+ [:uint :pointer] :bool)
299+(ffi/defcfn has-clipboard-data "SDL_HasClipboardData" [:string] :bool)
300+(ffi/defcfn ^:private raw-clipboard-data "SDL_GetClipboardData"
301+ [:string :pointer] :pointer)
302+(ffi/defcfn sdl-free! "SDL_free" [:pointer] :void)
303+
304+(defn display-bounds
305+ "[w h] of the display `window` is on, minus whatever the desktop reserves
306+ for panels — usable bounds rather than raw, because a window sized to the
307+ whole display is one with its bottom edge under a taskbar."
308+ [window]
309+ (ffi/with-alloc [r 16]
310+ (when (raw-display-bounds (display-for-window window) r)
311+ [(ffi/read (+ r 8) :int) (ffi/read (+ r 12) :int)])))
312+
313+(defn clipboard-data
314+ "The clipboard's contents for `mime`, as [pointer length], or nil.
315+
316+ The pointer is SDL's and the caller must hand it back to `sdl-free!`."
317+ [mime]
318+ (ffi/with-alloc [sz 8]
319+ (let [p (raw-clipboard-data mime sz)
320+ n (ffi/read sz :uint64)]
321+ (when (and p (not (ffi/null? p)) (pos? n))
322+ [p n]))))
323+
324+(ffi/defcfn img-load-texture "IMG_LoadTexture" [:pointer :string] :pointer)
325+(ffi/defcfn ^:private raw-texture-size "SDL_GetTextureSize"
326+ [:pointer :pointer :pointer] :bool)
327+
328+(defn texture-size
329+ "[w h] of a texture, or nil."
330+ [tex]
331+ (ffi/with-alloc [w 4]
332+ (ffi/with-alloc [h 4]
333+ (when (raw-texture-size tex w h)
334+ [(long (ffi/read w :float)) (long (ffi/read h :float))]))))
335+
336+(defn update-texture-raw!
337+ "Upload `h` rows of `pitch` bytes from FOREIGN memory into the whole of `tex`.
338+
339+ The pointer is the caller's and is read during the call and not kept. That
340+ is the difference from `update-texture!` above, and the reason this exists:
341+ that one takes an int-array, which means a decoded frame becomes a jolt
342+ value on its way to the screen. At thirty frames a second and two megabytes
343+ a frame, the copy costs more than the decode."
344+ [tex ptr pitch]
345+ (raw-update-texture tex ffi/null ptr pitch))
346+
272347 (defonce ^:private rect-a (delay (ffi/alloc 16)))
273348 (defonce ^:private rect-b (delay (ffi/alloc 16)))
274349
@@ -67,6 +67,10 @@
67 (ffi/defcfn open-font "TTF_OpenFont" [:string :float] :pointer)67 (ffi/defcfn open-font "TTF_OpenFont" [:string :float] :pointer)
68 (ffi/defcfn close-font! "TTF_CloseFont" [:pointer] :void)68 (ffi/defcfn close-font! "TTF_CloseFont" [:pointer] :void)
69 (ffi/defcfn font-height "TTF_GetFontHeight" [:pointer] :int)69 (ffi/defcfn font-height "TTF_GetFontHeight" [:pointer] :int)
70+;; A face to try for characters the main one has no glyph for. SDL_ttf keeps
71+;; a list of them and asks each in turn.
72+(ffi/defcfn add-fallback-font! "TTF_AddFallbackFont" [:pointer :pointer] :bool)
73+(ffi/defcfn font-has-glyph? "TTF_FontHasGlyph" [:pointer :uint] :bool)
70 (ffi/defcfn ^:private raw-string-size "TTF_GetStringSize"74 (ffi/defcfn ^:private raw-string-size "TTF_GetStringSize"
71 [:pointer :string :ulong :pointer :pointer] :bool)75 [:pointer :string :ulong :pointer :pointer] :bool)
72 (ffi/defcfn ^:private raw-render-blended "TTF_RenderText_Blended"76 (ffi/defcfn ^:private raw-render-blended "TTF_RenderText_Blended"
@@ -259,7 +263,20 @@
259 [:pointer :float :float :float :float] :bool)263 [:pointer :float :float :float :float] :bool)
260 264
261 (def PIXELFORMAT-ARGB8888 372645892)265 (def PIXELFORMAT-ARGB8888 372645892)
266+
267+;; SDL_PIXELFORMAT_ABGR8888, which is what SDL_PIXELFORMAT_RGBA32 aliases to
268+;; on a little-endian machine. Named by its packed layout rather than its byte
269+;; order, which is the trap: a buffer whose BYTES run R,G,B,A reads as the
270+;; 32-bit word 0xAABBGGRR, so ABGR8888 is the one that matches it and
271+;; ARGB8888 — the obvious-looking choice — puts the channels through a
272+;; rotation and turns skin blue.
273+(def PIXELFORMAT-ABGR8888 376840196)
274+
262 (def TEXTUREACCESS-STATIC 0)275 (def TEXTUREACCESS-STATIC 0)
276+;; STREAMING for anything uploaded every frame. STATIC textures live in
277+;; memory the driver expects to write rarely; a video feed at thirty a second
278+;; is the case the distinction exists for.
279+(def TEXTUREACCESS-STREAMING 1)
263 280
264 (defn update-texture!281 (defn update-texture!
265 "Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."282 "Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
@@ -269,6 +286,64 @@
269 (ffi/write-array p :int pixels)286 (ffi/write-array p :int pixels)
270 (raw-update-texture tex ffi/null p (* 4 w)))))287 (raw-update-texture tex ffi/null p (* 4 w)))))
271 288
289+;; --- the platform around the window -----------------------------------------
290+;; Title, display, browser, clipboard. None of it is drawing, and all of it is
291+;; what a client asks the toolkit for because the toolkit is the only thing
292+;; holding a window handle.
293+
294+(ffi/defcfn set-window-title! "SDL_SetWindowTitle" [:pointer :string] :bool)
295+(ffi/defcfn open-url! "SDL_OpenURL" [:string] :bool)
296+(ffi/defcfn display-for-window "SDL_GetDisplayForWindow" [:pointer] :uint)
297+(ffi/defcfn ^:private raw-display-bounds "SDL_GetDisplayUsableBounds"
298+ [:uint :pointer] :bool)
299+(ffi/defcfn has-clipboard-data "SDL_HasClipboardData" [:string] :bool)
300+(ffi/defcfn ^:private raw-clipboard-data "SDL_GetClipboardData"
301+ [:string :pointer] :pointer)
302+(ffi/defcfn sdl-free! "SDL_free" [:pointer] :void)
303+
304+(defn display-bounds
305+ "[w h] of the display `window` is on, minus whatever the desktop reserves
306+ for panels — usable bounds rather than raw, because a window sized to the
307+ whole display is one with its bottom edge under a taskbar."
308+ [window]
309+ (ffi/with-alloc [r 16]
310+ (when (raw-display-bounds (display-for-window window) r)
311+ [(ffi/read (+ r 8) :int) (ffi/read (+ r 12) :int)])))
312+
313+(defn clipboard-data
314+ "The clipboard's contents for `mime`, as [pointer length], or nil.
315+
316+ The pointer is SDL's and the caller must hand it back to `sdl-free!`."
317+ [mime]
318+ (ffi/with-alloc [sz 8]
319+ (let [p (raw-clipboard-data mime sz)
320+ n (ffi/read sz :uint64)]
321+ (when (and p (not (ffi/null? p)) (pos? n))
322+ [p n]))))
323+
324+(ffi/defcfn img-load-texture "IMG_LoadTexture" [:pointer :string] :pointer)
325+(ffi/defcfn ^:private raw-texture-size "SDL_GetTextureSize"
326+ [:pointer :pointer :pointer] :bool)
327+
328+(defn texture-size
329+ "[w h] of a texture, or nil."
330+ [tex]
331+ (ffi/with-alloc [w 4]
332+ (ffi/with-alloc [h 4]
333+ (when (raw-texture-size tex w h)
334+ [(long (ffi/read w :float)) (long (ffi/read h :float))]))))
335+
336+(defn update-texture-raw!
337+ "Upload `h` rows of `pitch` bytes from FOREIGN memory into the whole of `tex`.
338+
339+ The pointer is the caller's and is read during the call and not kept. That
340+ is the difference from `update-texture!` above, and the reason this exists:
341+ that one takes an int-array, which means a decoded frame becomes a jolt
342+ value on its way to the screen. At thirty frames a second and two megabytes
343+ a frame, the copy costs more than the decode."
344+ [tex ptr pitch]
345+ (raw-update-texture tex ffi/null ptr pitch))
346+
272 (defonce ^:private rect-a (delay (ffi/alloc 16)))347 (defonce ^:private rect-a (delay (ffi/alloc 16)))
273 (defonce ^:private rect-b (delay (ffi/alloc 16)))348 (defonce ^:private rect-b (delay (ffi/alloc 16)))
274 349
modified jvui/src/jvui/widgets.clj +426 -34
@@ -13,7 +13,9 @@
1313 closure. They are thin: each is `core/box*` with a different set of defaults
1414 from the theme."
1515 (:require [jvui.core :as c]
16- [jvui.theme :as theme]))
16+ [jvui.theme :as theme]
17+ [jvui.frames :as frames]
18+ [clojure.string :as str]))
1719
1820 ;; -------------------------------------------------------------- containers
1921
@@ -64,22 +66,89 @@
6466
6567 ;; -------------------------------------------------------------------- text
6668
69+(defn- break-word
70+ "Cut a word too long for `width` into pieces that fit.
71+
72+ Character-wise and greedy. Only ever reached for a word that would not
73+ fit on a line of its own — an ordinary sentence never comes here."
74+ [w size width]
75+ (loop [rest* w out []]
76+ (if (or (empty? rest*) (<= (first (c/measure rest* size)) width))
77+ (if (seq rest*) (conj out rest*) out)
78+ (let [n (loop [i 1]
79+ (cond (>= i (count rest*)) (count rest*)
80+ (> (first (c/measure (subs rest* 0 i) size)) width) (max 1 (dec i))
81+ :else (recur (inc i))))]
82+ (recur (subs rest* n) (conj out (subs rest* 0 n)))))))
83+
84+(defn- wrap-lines
85+ "Break `s` into lines that each fit `width`, on spaces.
86+
87+ Greedy and word-wise, and a word that cannot fit on a line of its own
88+ is broken at a character. That second half was left out first time
89+ round on the grounds that a URL cut in half reads worse than one that
90+ overflows — which was wrong, and the sign-in screen showed why: an
91+ OAuth login URL is one unbreakable word, so it made its container
92+ wider than the window and pushed the whole page off both edges. A
93+ broken URL is worse than an unbroken one; a window you cannot read is
94+ worse than both.
95+
96+ Measured through the same `c/measure` the drawing uses, so a line that
97+ is said to fit does fit — a wrap computed against a different metric
98+ than the renderer's is off by a word at the worst moments."
99+ [s size width]
100+ (let [words (mapcat (fn [w]
101+ (if (> (first (c/measure w size)) width)
102+ (break-word w size width)
103+ [w]))
104+ (str/split (str s) #" "))]
105+ (loop [[w & more] words line nil out []]
106+ (cond
107+ (nil? w) (if line (conj out line) out)
108+ (nil? line) (recur more w out)
109+ :else
110+ (let [try* (str line " " w)]
111+ (if (<= (first (c/measure try* size)) width)
112+ (recur more try* out)
113+ (recur more w (conj out line))))))))
114+
67115 (defn label
68- "A line of text. Answers its rectangle."
116+ "A line of text, wrapped to the space it was given. Answers its rectangle.
117+
118+ Wrapping is on when the text does not fit and the box has told us how
119+ much room there is. That is not a style choice: without it one long
120+ sentence makes its container wider than the window, and a page that
121+ centres its content then hangs off BOTH edges — which is exactly what
122+ frq's sign-in screen did the first time it was painted here.
123+
124+ `:wrap false` turns it off for a caller that would rather overflow, and
125+ a width of zero — the first frame, before any box knows its size — is
126+ read as \"not yet\" rather than \"no room\"."
69127 ([s] (label s {}))
70- ([s {:keys [size colour expand gravity align]
71- :or {expand :horizontal gravity [0.0 0.5] align :left}}]
128+ ([s {:keys [size colour expand gravity align wrap]
129+ :or {expand :horizontal gravity [0.0 0.5] align :left wrap true}}]
72130 (let [size (or size (c/th :font-size))
73131 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)))]
132+ [tw0 th0] (c/measure s size)
133+ avail (c/avail-width)
134+ lines (if (and wrap (pos? avail) (> tw0 avail))
135+ (wrap-lines s size avail)
136+ [(str s)])
137+ many? (> (count lines) 1)
138+ widths (mapv #(first (c/measure % size)) lines)
139+ tw (if many? (reduce max 0.0 widths) tw0)
140+ lh (max th0 (c/line-height size))
141+ rect (c/leaf [(double tw) (double (* lh (count lines)))]
76142 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)
143+ [x y w h] rect]
144+ (dotimes [i (count lines)]
145+ (let [ln (nth lines i)
146+ lw (nth widths i)
147+ tx (case align
148+ :center (+ x (/ (- w lw) 2.0))
149+ :right (+ x (- w lw))
150+ x)]
151+ (c/draw-text! ln tx (+ y (* i lh) (/ (- lh th0) 2.0)) size colour)))
83152 rect)))
84153
85154 (defn title [s & [opts]]
@@ -231,18 +300,28 @@
231300
232301 (defn- clamp [v lo hi] (max lo (min hi v)))
233302
303+(defn entry-activated?
304+ "Did the field under `id` see Enter on the frame just walked?
305+
306+ Asked after `text-entry`, which records it. Enter is the one key a text
307+ field must NOT treat as input — the client sends on it — and a widget
308+ that answered only its text gave a caller no way to know."
309+ [id]
310+ (boolean (c/state id :activated false)))
311+
234312 (defn text-entry
235313 "A single-line editable string. Answers the text after this frame.
236314
237315 The caret is an index into the string kept under the widget's id, which is
238316 the one piece of state a text field cannot recompute from its value."
239317 ([value] (text-entry value {}))
240- ([value {:keys [key expand placeholder] :or {expand :horizontal}}]
318+ ([value {:keys [key expand placeholder min-width]
319+ :or {expand :horizontal}}]
241320 (let [size (c/th :font-size)
242321 pad (c/th :padding)
243322 h (double (c/th :control-height))
244323 id (c/next-id key)
245- rect (c/leaf [160.0 h] expand [0.0 0.5])
324+ rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5])
246325 {:keys [hover? focused?]} (c/interact! id rect)
247326 [rx ry rw rh] rect
248327 s (str value)
@@ -273,50 +352,178 @@
273352 [s caret0] (or evs []))
274353 caret' (clamp caret' 0 (count s'))]
275354 (c/state! id :caret caret')
355+ ;; Enter is not an edit and must not be swallowed as one: a client
356+ ;; sends its message on it. Recorded as state rather than returned,
357+ ;; because `text-entry` already answers the text and a second return
358+ ;; value would change every existing call.
359+ (c/state! id :activated
360+ (boolean (some #(and (= :key-down (:kind %)) (= :return (:key %)))
361+ (or evs []))))
276362 (c/fill! rect (c/th :surface) (c/th :radius)
277363 (if focused? (c/th :focus) (c/th :border))
278364 (if focused? 2.0 (c/th :border-width)))
279365 (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)))
366+ ty (+ ry (/ (- rh th*) 2.0))
367+ inner (- rw (* 2 pad))
368+ ;; How far the text is slid left so the caret stays in view. A
369+ ;; field narrower than its contents is the ordinary case — a
370+ ;; handle, a URL, a password — and without this the text simply
371+ ;; runs out past the border and over whatever is beside it.
372+ caret-x (first (c/measure (subs s' 0 caret') size))
373+ shift (max 0.0 (- caret-x inner))]
374+ (c/with-clip [(+ rx pad) ry inner rh]
375+ (fn []
376+ (if (and (= s' "") placeholder (not focused?))
377+ (c/draw-text! placeholder (+ rx pad) ty size (c/th :text-dim))
378+ (c/draw-text! s' (- (+ rx pad) shift) ty size (c/th :text)))))
379+ ;; The caret rides the same shift, and inside the same clip: a caret
380+ ;; drawn at the untranslated offset sits past the border on a full
381+ ;; field, pointing at where the text would have been.
284382 (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)))))
383+ (c/with-clip [(+ rx pad) ry inner rh]
384+ (fn []
385+ (c/fill! [(- (+ rx pad caret-x) shift) (+ ty 1.0) 1.5 (- th* 2.0)]
386+ (c/th :text))))))
287387 s')))
288388
289389 ;; ------------------------------------------------------------------- scroll
290390
391+(defonce ^:private scroll-areas
392+ ;; Offsets kept by NAME, outliving the node that showed them.
393+ ;;
394+ ;; A widget id is a position in this frame's tree, so two lists that are
395+ ;; never on screen together — one channel's messages and another's —
396+ ;; share one id and therefore one offset, and switching between them
397+ ;; carries the wrong scroll across. `:scroll-key` names the area instead,
398+ ;; and the name outlives the node.
399+ (atom {}))
400+
401+(defn scroll-offset
402+ "How far the area named `k` is scrolled, or nil if it has never shown.
403+
404+ Public because it is the only way to ask a viewport what it did — the
405+ widget answers its rectangle, not its state — and a caller restoring a
406+ position, or a test asking whether a list actually followed its
407+ content, has nowhere else to look."
408+ [k]
409+ (:offset (get @scroll-areas k)))
410+
291411 (defn scroll*
292412 "A clipped viewport that scrolls its contents vertically.
293413
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."
414+ The viewport reports the height it was given, not the height of what is
415+ in it; the difference between the two is what there is to scroll, which
416+ is why `core/box*` keeps both numbers.
417+
418+ opts beyond `core/box*`'s:
419+
420+ :height the viewport's own height
421+ :scroll-key a name for the offset, so it survives the node
422+ :reserve leave this much of the available height behind
423+ :stick-to-bottom follow new content while the reader is at the end
424+ :scroll-to-bottom a number the caller BUMPS to ask for a jump
425+ :on-at-end called with true/false as the reader arrives at or
426+ leaves the end"
297427 [opts body]
298- (let [h (double (or (:height opts) 200.0))
428+ (let [{:keys [scroll-key reserve stick-to-bottom scroll-to-bottom on-at-end]} opts
299429 id (c/next-id (:key opts))
430+ area (or scroll-key id)
300431 prev (c/data id)
432+ ;; A viewport with no height of its own FILLS what is left rather
433+ ;; than ASKING for it. Asking is what it did first — a minimum of
434+ ;; the whole column — and then the column had nothing left for
435+ ;; the separator and compose bar under it, which went off the
436+ ;; bottom of the window.
437+ ;;
438+ ;; So the height is the one it was GIVEN last frame, and it
439+ ;; reports a minimum of nothing. Two hundred is the answer on the
440+ ;; first frame only, before it has been given anything.
441+ given (nth (:rect prev) 3 nil)
442+ h (double (cond
443+ (:height opts) (:height opts)
444+ (and given (pos? (double given)))
445+ (max 0.0 (- (double given) (double (or reserve 0.0))))
446+ :else 200.0))
301447 content-h (second (or (:content-min prev) [0.0 0.0]))
302448 view (or (:rect prev) [0.0 0.0 0.0 0.0])
303449 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) []))
450+ st (get @scroll-areas area {})
451+ off0 (min maxoff (max 0.0 (or (:offset st) 0.0)))
452+ wheel (or (c/wheel-events view) [])
453+ ;; A jump is asked for by CHANGING the number, not by setting it:
454+ ;; a caller that wanted to jump twice to the same place would
455+ ;; otherwise have nothing to say the second time.
456+ jump? (and scroll-to-bottom
457+ (pos? (double scroll-to-bottom))
458+ (not= scroll-to-bottom (:jumped st)))
459+ ;; The wheel is applied FIRST, and a wheel that moved the list
460+ ;; breaks the stick for that frame. Deciding to stick before
461+ ;; reading it pins the offset at the end every frame and the
462+ ;; reader can never scroll up at all — they drag and it snaps
463+ ;; back, which reads as the window being broken.
464+ wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))
465+ off0 wheel)
466+ moved? (not= wheeled off0)
467+ ;; Sticking and jumping are the same control pulling opposite
468+ ;; ways. Sticking wins over a jump, so a jump to an old message
469+ ;; is not snatched back by the next arrival — but a hand on the
470+ ;; wheel wins over both.
471+ stick? (and stick-to-bottom (not jump?) (not moved?) (:at-end st true))
472+ off (cond
473+ jump? maxoff
474+ stick? maxoff
475+ :else wheeled)
476+ ;; The gutter the bar is drawn in, taken off the content whether or
477+ ;; not there is anything to scroll yet. Always, because the
478+ ;; alternative is that a list reflows the moment it grows past the
479+ ;; window — every line rewrapping under the reader as the message
480+ ;; that overflowed arrives. And taken at all because the bar is
481+ ;; painted over the viewport's right edge: without it the last
482+ ;; characters of every wrapped line sit under the bar, which is
483+ ;; where "the sidebar truncates" comes from.
484+ ;; The bar's own width and a gap beside it. Reserving the bar alone
485+ ;; leaves the wrap boundary exactly at its left edge, so a line ends
486+ ;; flush against it — legible, but it reads as text running into the
487+ ;; bar, and a glyph whose drawn width runs a hair past its measured
488+ ;; one touches it. A gap is what puts the last word beside the bar
489+ ;; rather than on it.
490+ gutter (+ (double (c/th :scrollbar)) (double (c/th :spacing)))
307491 r (c/box* (merge {:dir :vertical
308- :expand :horizontal
309- :min-size [0.0 h]
492+ :expand :both
493+ :pad-right gutter
494+ ;; An explicit :height IS a demand and is
495+ ;; reported as one. Without it the viewport
496+ ;; fills what is left and asks for nothing —
497+ ;; asking is what left the compose bar off the
498+ ;; bottom of the window.
499+ :min-size [0.0 (if (:height opts) h 0.0)]
310500 :fixed true
311501 :clip? true
312502 :spacing (c/th :spacing)
313503 :key (:key opts)
314504 :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.
505+ (dissoc opts :height :scroll-key :reserve :stick-to-bottom
506+ :scroll-to-bottom :on-at-end))
507+ body)
508+ ;; Within a couple of lines of the end counts as at it: a reader
509+ ;; who has not moved should not stop being followed because the
510+ ;; last message was a pixel taller than the one before.
511+ at-end? (>= off (- maxoff 24.0))
512+ ;; Arriving at the end is reported at once; leaving it has to hold
513+ ;; for a few frames. A burst of messages grows the content faster
514+ ;; than the offset follows, and reporting that honestly would
515+ ;; blink "scrolled away" whenever a channel is busy.
516+ away (if at-end? 0 (inc (or (:away st) 0)))
517+ settled (cond at-end? true (>= away 3) false :else nil)
518+ was (:reported st)]
519+ (swap! scroll-areas assoc area
520+ (cond-> (assoc st :offset off :at-end at-end? :away away)
521+ jump? (assoc :jumped scroll-to-bottom)
522+ (some? settled) (assoc :reported settled)))
523+ ;; Not on the first report: the opening one arrives before the content
524+ ;; has a height, and every list would announce itself as at its end.
525+ (when (and on-at-end (some? settled) (some? was) (not= was settled))
526+ (on-at-end settled))
320527 (when (pos? maxoff)
321528 (let [[vx vy vw vh] (or (:rect (c/data id)) view)
322529 bw (double (c/th :scrollbar))
@@ -327,3 +534,188 @@
327534 r))
328535
329536 (defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))
537+
538+(defn- picture
539+ "The texture for either kind of source: a live `feed` or a file `src`."
540+ [{:keys [feed src]}]
541+ (cond feed (frames/lookup feed)
542+ src (frames/from-file src)))
543+
544+(defn image
545+ "A picture: live pixels under `:feed`, or a file at `:src`.
546+
547+ One widget and not two, because everything downstream — the fit, the
548+ bounds, the click — is the same for both. That is libvidya's arrangement
549+ too, and frq writes [:image {:feed k}] for a call tile and
550+ [:image {:src p}] for an attachment.
551+
552+ `:fit` gives it every point of the space it has been handed; otherwise it
553+ asks for its own size, bounded by `:max-width` and `:max-height`. Either
554+ way the picture keeps its shape — a 16:9 camera in a square tile is the
555+ ordinary case, and stretching it is the one thing nobody wants.
556+
557+ A source with no picture yet — a feed before its first frame, a file that
558+ will not decode — draws the empty tile and nothing else. Not a
559+ broken-image glyph: the text beside it already says what it was meant to
560+ be, and a tile that appears only once a frame lands rearranges the wall
561+ under the person every time somebody joins."
562+ ([opts] (image opts {}))
563+ ([{:keys [feed src] :as source}
564+ {:keys [fit max-width max-height size expand gravity placeholder?]
565+ :or {gravity [0.5 0.5] placeholder? true}}]
566+ (let [t (picture source)
567+ [tw th*] (if t [(:w t) (:h t)] [0 0])
568+ want (cond
569+ size size
570+ (and fit) [320.0 180.0]
571+ (pos? tw)
572+ (let [k (min (if max-width (/ (double max-width) tw) 1.0)
573+ (if max-height (/ (double max-height) th*) 1.0))]
574+ [(* tw k) (* th* k)])
575+ :else [(double (or max-width 160)) (double (or max-height 90))])
576+ rect (c/leaf (mapv double want)
577+ (or expand (if fit :both :none))
578+ gravity)]
579+ (when placeholder? (c/fill! rect (c/th :surface-alt) 6.0))
580+ (when (and t (:tex t)) (c/draw-picture! (:tex t) (:w t) (:h t) rect))
581+ rect)))
582+
583+(defn title-2
584+ "A second-level heading — smaller than `title`, still bold."
585+ [s]
586+ (label s {:size (* 1.15 (c/th :font-size)) :colour (c/th :text)}))
587+
588+(defn status
589+ "A line of text with a dot in front of it saying whether the thing is live."
590+ ([s] (status s false))
591+ ([s live?]
592+ (c/box* {:dir :horizontal :spacing 6 :gravity [0.0 0.5]}
593+ (fn [_ _]
594+ (let [line (c/th :font-size)
595+ d (max 7.0 (min 12.0 (* line 0.55)))
596+ r (c/leaf [(+ d 4.0) line] :none [0.0 0.5])
597+ [x y w h] r]
598+ (c/fill! [(+ x 2.0) (+ y (/ (- h d) 2.0)) d d]
599+ (if live? (c/th :accent) (c/th :text-dim))
600+ (/ d 2.0)))
601+ (label s)))))
602+
603+(defn spinner
604+ "A turning mark, and a word beside it if there is one.
605+
606+ Turned from the wall clock rather than a frame counter: a loop that
607+ dropped frames would otherwise show a spinner that stutters in a way that
608+ reads as the work having stalled, which is the one thing it is there to
609+ deny."
610+ ([] (spinner ""))
611+ ([s]
612+ (c/box* {:dir :horizontal :spacing 6 :gravity [0.0 0.5]}
613+ (fn [_ _]
614+ (let [line (c/th :font-size)
615+ r (c/leaf [line line] :none [0.0 0.5])
616+ [x y w h] r
617+ cx (+ x (/ w 2.0)) cy (+ y (/ h 2.0))
618+ rad (* 0.4 (min w h))
619+ t (/ (double (mod (System/currentTimeMillis) 1000)) 1000.0)
620+ a (* t 2.0 Math/PI)]
621+ ;; Three ticks around a circle: enough to read as turning, and no
622+ ;; arc primitive needed.
623+ (dotimes [i 3]
624+ (let [th* (+ a (* i (/ (* 2.0 Math/PI) 3.0)))]
625+ (c/fill! [(+ cx (* rad (Math/cos th*)) -1.5)
626+ (+ cy (* rad (Math/sin th*)) -1.5) 3.0 3.0]
627+ (c/th :accent) 1.5))))
628+ (when (seq s) (label s))))))
629+
630+(defn link
631+ "Text that is a place to go. Answers true on the frame it was clicked."
632+ ([s] (link s {}))
633+ ([s {:keys [key]}]
634+ (let [id (c/next-id key)
635+ rect (label s {:colour (c/th :accent)})]
636+ (:clicked? (c/interact! id rect)))))
637+
638+(defn emoji
639+ "One emoji, drawn as a character and sized to sit level with the words
640+ either side.
641+
642+ In colour where there is a colour face to draw it from, and as text
643+ where there is not.
644+
645+ The two paths differ in more than the picture: a colour emoji face is a
646+ bitmap with one 128-pixel strike, so it cannot be a fallback font and is
647+ drawn as an image scaled into the line — which means the glyph occupies a
648+ SQUARE of the size asked for, decided here rather than measured. The text
649+ path stays exactly what it was, a label in the UI font, and is what a
650+ machine with no colour face gets."
651+ ([s] (emoji s nil))
652+ ([s size]
653+ (let [sz (double (or size (c/th :font-size)))]
654+ (if (c/colour-emoji? s)
655+ (let [rect (c/leaf [sz sz] :none [0.5 0.5])]
656+ (c/draw-emoji! s rect)
657+ rect)
658+ (label s {:size sz})))))
659+
660+(defn avatar
661+ "A round picture for somebody, or their initial on a colour if there is
662+ none.
663+
664+ The fallback is not a placeholder to be replaced later — most people in
665+ most rooms have no picture, so the initial IS the avatar, and its colour
666+ comes from the name so the same person is the same colour everywhere."
667+ ([nick] (avatar nick {}))
668+ ([nick {:keys [src size] :or {size 24.0}}]
669+ (let [rect (c/leaf [size size] :none [0.5 0.5])
670+ t (when src (frames/from-file src))]
671+ (if (and t (:tex t))
672+ (c/draw-picture! (:tex t) (:w t) (:h t) rect)
673+ (let [name (str nick)
674+ bare (str/replace name #"^[#&@+%~]+" "")
675+ initial (if (seq bare) (str/upper-case (subs bare 0 1)) "?")
676+ [x y w h] rect]
677+ (c/fill! rect (c/name-colour name) (/ size 2.0))
678+ (let [sz (* size 0.5)
679+ [tw th*] (c/measure initial sz)]
680+ (c/draw-text! initial (+ x (/ (- w tw) 2.0)) (+ y (/ (- h th*) 2.0))
681+ sz (c/th :accent-text)))))
682+ rect)))
683+
684+(defn reaction
685+ "A tally wearing a pill: an emoji, how many people, and whether you are one
686+ of them.
687+
688+ The same glyph `emoji` draws, and the same two ways of drawing it: a
689+ colour face gives a square picture, and everything else is text. So the
690+ glyph and the tally are measured and drawn apart rather than as one
691+ string — a picture cannot be concatenated onto a number.
692+
693+ A reaction is not a character otherwise either: it answers the pointer
694+ and it is a count. `mine?` is bordered rather than filled differently,
695+ because the pill has to stay readable at the size a line of them ends
696+ up."
697+ ([glyph] (reaction glyph {}))
698+ ([glyph {:keys [count mine? size key]
699+ :or {count 0 mine? false}}]
700+ (let [sz (double (or size (c/th :font-size)))
701+ colour? (c/colour-emoji? (str glyph))
702+ tally (when (pos? count) (str " " count))
703+ [gw gh] (if colour? [sz sz] (c/measure (str glyph) sz))
704+ [cw ch] (if tally (c/measure tally sz) [0.0 0.0])
705+ tw (+ (double gw) (double cw))
706+ th* (max (double gh) (double ch))
707+ pad 6.0
708+ rect (c/leaf [(+ tw (* 2 pad)) (+ th* 4.0)] :none [0.0 0.5])
709+ id (c/next-id key)
710+ [x y w h] rect]
711+ (c/fill! rect (if mine? (c/th :press) (c/th :surface-alt))
712+ (/ h 2.0)
713+ (when mine? (c/th :accent)) (if mine? 1.0 0.0))
714+ (if colour?
715+ (c/draw-emoji! (str glyph) [(+ x pad) (+ y (/ (- h sz) 2.0)) sz sz])
716+ (c/draw-text! (str glyph) (+ x pad) (+ y (/ (- h (double gh)) 2.0))
717+ sz (c/th :text)))
718+ (when tally
719+ (c/draw-text! tally (+ x pad (double gw)) (+ y (/ (- h (double ch)) 2.0))
720+ sz (c/th :text)))
721+ (:clicked? (c/interact! id rect)))))
@@ -13,7 +13,9 @@
13 closure. They are thin: each is `core/box*` with a different set of defaults13 closure. They are thin: each is `core/box*` with a different set of defaults
14 from the theme."14 from the theme."
15 (:require [jvui.core :as c]15 (:require [jvui.core :as c]
16- [jvui.theme :as theme]))16+ [jvui.theme :as theme]
17+ [jvui.frames :as frames]
18+ [clojure.string :as str]))
17 19
18 ;; -------------------------------------------------------------- containers20 ;; -------------------------------------------------------------- containers
19 21
@@ -64,22 +66,89 @@
64 66
65 ;; -------------------------------------------------------------------- text67 ;; -------------------------------------------------------------------- text
66 68
69+(defn- break-word
70+ "Cut a word too long for `width` into pieces that fit.
71+
72+ Character-wise and greedy. Only ever reached for a word that would not
73+ fit on a line of its own — an ordinary sentence never comes here."
74+ [w size width]
75+ (loop [rest* w out []]
76+ (if (or (empty? rest*) (<= (first (c/measure rest* size)) width))
77+ (if (seq rest*) (conj out rest*) out)
78+ (let [n (loop [i 1]
79+ (cond (>= i (count rest*)) (count rest*)
80+ (> (first (c/measure (subs rest* 0 i) size)) width) (max 1 (dec i))
81+ :else (recur (inc i))))]
82+ (recur (subs rest* n) (conj out (subs rest* 0 n)))))))
83+
84+(defn- wrap-lines
85+ "Break `s` into lines that each fit `width`, on spaces.
86+
87+ Greedy and word-wise, and a word that cannot fit on a line of its own
88+ is broken at a character. That second half was left out first time
89+ round on the grounds that a URL cut in half reads worse than one that
90+ overflows — which was wrong, and the sign-in screen showed why: an
91+ OAuth login URL is one unbreakable word, so it made its container
92+ wider than the window and pushed the whole page off both edges. A
93+ broken URL is worse than an unbroken one; a window you cannot read is
94+ worse than both.
95+
96+ Measured through the same `c/measure` the drawing uses, so a line that
97+ is said to fit does fit — a wrap computed against a different metric
98+ than the renderer's is off by a word at the worst moments."
99+ [s size width]
100+ (let [words (mapcat (fn [w]
101+ (if (> (first (c/measure w size)) width)
102+ (break-word w size width)
103+ [w]))
104+ (str/split (str s) #" "))]
105+ (loop [[w & more] words line nil out []]
106+ (cond
107+ (nil? w) (if line (conj out line) out)
108+ (nil? line) (recur more w out)
109+ :else
110+ (let [try* (str line " " w)]
111+ (if (<= (first (c/measure try* size)) width)
112+ (recur more try* out)
113+ (recur more w (conj out line))))))))
114+
67 (defn label115 (defn label
68- "A line of text. Answers its rectangle."116+ "A line of text, wrapped to the space it was given. Answers its rectangle.
117+
118+ Wrapping is on when the text does not fit and the box has told us how
119+ much room there is. That is not a style choice: without it one long
120+ sentence makes its container wider than the window, and a page that
121+ centres its content then hangs off BOTH edges — which is exactly what
122+ frq's sign-in screen did the first time it was painted here.
123+
124+ `:wrap false` turns it off for a caller that would rather overflow, and
125+ a width of zero — the first frame, before any box knows its size — is
126+ read as \"not yet\" rather than \"no room\"."
69 ([s] (label s {}))127 ([s] (label s {}))
70- ([s {:keys [size colour expand gravity align]128+ ([s {:keys [size colour expand gravity align wrap]
71- :or {expand :horizontal gravity [0.0 0.5] align :left}}]129+ :or {expand :horizontal gravity [0.0 0.5] align :left wrap true}}]
72 (let [size (or size (c/th :font-size))130 (let [size (or size (c/th :font-size))
73 colour (or colour (c/th :text))131 colour (or colour (c/th :text))
74- [tw th*] (c/measure s size)132+ [tw0 th0] (c/measure s size)
75- rect (c/leaf [(double tw) (double (max th* (c/line-height size)))]133+ avail (c/avail-width)
134+ lines (if (and wrap (pos? avail) (> tw0 avail))
135+ (wrap-lines s size avail)
136+ [(str s)])
137+ many? (> (count lines) 1)
138+ widths (mapv #(first (c/measure % size)) lines)
139+ tw (if many? (reduce max 0.0 widths) tw0)
140+ lh (max th0 (c/line-height size))
141+ rect (c/leaf [(double tw) (double (* lh (count lines)))]
76 expand gravity)142 expand gravity)
77- [x y w h] rect143+ [x y w h] rect]
78- tx (case align144+ (dotimes [i (count lines)]
79- :center (+ x (/ (- w tw) 2.0))145+ (let [ln (nth lines i)
80- :right (+ x (- w tw))146+ lw (nth widths i)
81- x)]147+ tx (case align
82- (c/draw-text! s tx (+ y (/ (- h th*) 2.0)) size colour)148+ :center (+ x (/ (- w lw) 2.0))
149+ :right (+ x (- w lw))
150+ x)]
151+ (c/draw-text! ln tx (+ y (* i lh) (/ (- lh th0) 2.0)) size colour)))
83 rect)))152 rect)))
84 153
85 (defn title [s & [opts]]154 (defn title [s & [opts]]
@@ -231,18 +300,28 @@
231 300
232 (defn- clamp [v lo hi] (max lo (min hi v)))301 (defn- clamp [v lo hi] (max lo (min hi v)))
233 302
303+(defn entry-activated?
304+ "Did the field under `id` see Enter on the frame just walked?
305+
306+ Asked after `text-entry`, which records it. Enter is the one key a text
307+ field must NOT treat as input — the client sends on it — and a widget
308+ that answered only its text gave a caller no way to know."
309+ [id]
310+ (boolean (c/state id :activated false)))
311+
234 (defn text-entry312 (defn text-entry
235 "A single-line editable string. Answers the text after this frame.313 "A single-line editable string. Answers the text after this frame.
236 314
237 The caret is an index into the string kept under the widget's id, which is315 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."316 the one piece of state a text field cannot recompute from its value."
239 ([value] (text-entry value {}))317 ([value] (text-entry value {}))
240- ([value {:keys [key expand placeholder] :or {expand :horizontal}}]318+ ([value {:keys [key expand placeholder min-width]
319+ :or {expand :horizontal}}]
241 (let [size (c/th :font-size)320 (let [size (c/th :font-size)
242 pad (c/th :padding)321 pad (c/th :padding)
243 h (double (c/th :control-height))322 h (double (c/th :control-height))
244 id (c/next-id key)323 id (c/next-id key)
245- rect (c/leaf [160.0 h] expand [0.0 0.5])324+ rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5])
246 {:keys [hover? focused?]} (c/interact! id rect)325 {:keys [hover? focused?]} (c/interact! id rect)
247 [rx ry rw rh] rect326 [rx ry rw rh] rect
248 s (str value)327 s (str value)
@@ -273,50 +352,178 @@
273 [s caret0] (or evs []))352 [s caret0] (or evs []))
274 caret' (clamp caret' 0 (count s'))]353 caret' (clamp caret' 0 (count s'))]
275 (c/state! id :caret caret')354 (c/state! id :caret caret')
355+ ;; Enter is not an edit and must not be swallowed as one: a client
356+ ;; sends its message on it. Recorded as state rather than returned,
357+ ;; because `text-entry` already answers the text and a second return
358+ ;; value would change every existing call.
359+ (c/state! id :activated
360+ (boolean (some #(and (= :key-down (:kind %)) (= :return (:key %)))
361+ (or evs []))))
276 (c/fill! rect (c/th :surface) (c/th :radius)362 (c/fill! rect (c/th :surface) (c/th :radius)
277 (if focused? (c/th :focus) (c/th :border))363 (if focused? (c/th :focus) (c/th :border))
278 (if focused? 2.0 (c/th :border-width)))364 (if focused? 2.0 (c/th :border-width)))
279 (let [[_ th*] (c/measure (if (= s' "") "M" s') size)365 (let [[_ th*] (c/measure (if (= s' "") "M" s') size)
280- ty (+ ry (/ (- rh th*) 2.0))]366+ ty (+ ry (/ (- rh th*) 2.0))
281- (if (and (= s' "") placeholder (not focused?))367+ inner (- rw (* 2 pad))
282- (c/draw-text! placeholder (+ rx pad) ty size (c/th :text-dim))368+ ;; How far the text is slid left so the caret stays in view. A
283- (c/draw-text! s' (+ rx pad) ty size (c/th :text)))369+ ;; field narrower than its contents is the ordinary case — a
370+ ;; handle, a URL, a password — and without this the text simply
371+ ;; runs out past the border and over whatever is beside it.
372+ caret-x (first (c/measure (subs s' 0 caret') size))
373+ shift (max 0.0 (- caret-x inner))]
374+ (c/with-clip [(+ rx pad) ry inner rh]
375+ (fn []
376+ (if (and (= s' "") placeholder (not focused?))
377+ (c/draw-text! placeholder (+ rx pad) ty size (c/th :text-dim))
378+ (c/draw-text! s' (- (+ rx pad) shift) ty size (c/th :text)))))
379+ ;; The caret rides the same shift, and inside the same clip: a caret
380+ ;; drawn at the untranslated offset sits past the border on a full
381+ ;; field, pointing at where the text would have been.
284 (when focused?382 (when focused?
285- (let [[cw _] (c/measure (subs s' 0 caret') size)]383+ (c/with-clip [(+ rx pad) ry inner rh]
286- (c/fill! [(+ rx pad cw) (+ ty 1.0) 1.5 (- th* 2.0)] (c/th :text)))))384+ (fn []
385+ (c/fill! [(- (+ rx pad caret-x) shift) (+ ty 1.0) 1.5 (- th* 2.0)]
386+ (c/th :text))))))
287 s')))387 s')))
288 388
289 ;; ------------------------------------------------------------------- scroll389 ;; ------------------------------------------------------------------- scroll
290 390
391+(defonce ^:private scroll-areas
392+ ;; Offsets kept by NAME, outliving the node that showed them.
393+ ;;
394+ ;; A widget id is a position in this frame's tree, so two lists that are
395+ ;; never on screen together — one channel's messages and another's —
396+ ;; share one id and therefore one offset, and switching between them
397+ ;; carries the wrong scroll across. `:scroll-key` names the area instead,
398+ ;; and the name outlives the node.
399+ (atom {}))
400+
401+(defn scroll-offset
402+ "How far the area named `k` is scrolled, or nil if it has never shown.
403+
404+ Public because it is the only way to ask a viewport what it did — the
405+ widget answers its rectangle, not its state — and a caller restoring a
406+ position, or a test asking whether a list actually followed its
407+ content, has nowhere else to look."
408+ [k]
409+ (:offset (get @scroll-areas k)))
410+
291 (defn scroll*411 (defn scroll*
292 "A clipped viewport that scrolls its contents vertically.412 "A clipped viewport that scrolls its contents vertically.
293 413
294- The viewport reports the height it was given, not the height of what is in414+ The viewport reports the height it was given, not the height of what is
295- it; the difference between the two is what there is to scroll, which is why415+ in it; the difference between the two is what there is to scroll, which
296- `core/box*` keeps both numbers."416+ is why `core/box*` keeps both numbers.
417+
418+ opts beyond `core/box*`'s:
419+
420+ :height the viewport's own height
421+ :scroll-key a name for the offset, so it survives the node
422+ :reserve leave this much of the available height behind
423+ :stick-to-bottom follow new content while the reader is at the end
424+ :scroll-to-bottom a number the caller BUMPS to ask for a jump
425+ :on-at-end called with true/false as the reader arrives at or
426+ leaves the end"
297 [opts body]427 [opts body]
298- (let [h (double (or (:height opts) 200.0))428+ (let [{:keys [scroll-key reserve stick-to-bottom scroll-to-bottom on-at-end]} opts
299 id (c/next-id (:key opts))429 id (c/next-id (:key opts))
430+ area (or scroll-key id)
300 prev (c/data id)431 prev (c/data id)
432+ ;; A viewport with no height of its own FILLS what is left rather
433+ ;; than ASKING for it. Asking is what it did first — a minimum of
434+ ;; the whole column — and then the column had nothing left for
435+ ;; the separator and compose bar under it, which went off the
436+ ;; bottom of the window.
437+ ;;
438+ ;; So the height is the one it was GIVEN last frame, and it
439+ ;; reports a minimum of nothing. Two hundred is the answer on the
440+ ;; first frame only, before it has been given anything.
441+ given (nth (:rect prev) 3 nil)
442+ h (double (cond
443+ (:height opts) (:height opts)
444+ (and given (pos? (double given)))
445+ (max 0.0 (- (double given) (double (or reserve 0.0))))
446+ :else 200.0))
301 content-h (second (or (:content-min prev) [0.0 0.0]))447 content-h (second (or (:content-min prev) [0.0 0.0]))
302 view (or (:rect prev) [0.0 0.0 0.0 0.0])448 view (or (:rect prev) [0.0 0.0 0.0 0.0])
303 maxoff (max 0.0 (- content-h h))449 maxoff (max 0.0 (- content-h h))
304- off0 (min maxoff (max 0.0 (c/state id :scroll 0.0)))450+ st (get @scroll-areas area {})
305- off (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))451+ off0 (min maxoff (max 0.0 (or (:offset st) 0.0)))
306- off0 (or (c/wheel-events view) []))452+ wheel (or (c/wheel-events view) [])
453+ ;; A jump is asked for by CHANGING the number, not by setting it:
454+ ;; a caller that wanted to jump twice to the same place would
455+ ;; otherwise have nothing to say the second time.
456+ jump? (and scroll-to-bottom
457+ (pos? (double scroll-to-bottom))
458+ (not= scroll-to-bottom (:jumped st)))
459+ ;; The wheel is applied FIRST, and a wheel that moved the list
460+ ;; breaks the stick for that frame. Deciding to stick before
461+ ;; reading it pins the offset at the end every frame and the
462+ ;; reader can never scroll up at all — they drag and it snaps
463+ ;; back, which reads as the window being broken.
464+ wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))
465+ off0 wheel)
466+ moved? (not= wheeled off0)
467+ ;; Sticking and jumping are the same control pulling opposite
468+ ;; ways. Sticking wins over a jump, so a jump to an old message
469+ ;; is not snatched back by the next arrival — but a hand on the
470+ ;; wheel wins over both.
471+ stick? (and stick-to-bottom (not jump?) (not moved?) (:at-end st true))
472+ off (cond
473+ jump? maxoff
474+ stick? maxoff
475+ :else wheeled)
476+ ;; The gutter the bar is drawn in, taken off the content whether or
477+ ;; not there is anything to scroll yet. Always, because the
478+ ;; alternative is that a list reflows the moment it grows past the
479+ ;; window — every line rewrapping under the reader as the message
480+ ;; that overflowed arrives. And taken at all because the bar is
481+ ;; painted over the viewport's right edge: without it the last
482+ ;; characters of every wrapped line sit under the bar, which is
483+ ;; where "the sidebar truncates" comes from.
484+ ;; The bar's own width and a gap beside it. Reserving the bar alone
485+ ;; leaves the wrap boundary exactly at its left edge, so a line ends
486+ ;; flush against it — legible, but it reads as text running into the
487+ ;; bar, and a glyph whose drawn width runs a hair past its measured
488+ ;; one touches it. A gap is what puts the last word beside the bar
489+ ;; rather than on it.
490+ gutter (+ (double (c/th :scrollbar)) (double (c/th :spacing)))
307 r (c/box* (merge {:dir :vertical491 r (c/box* (merge {:dir :vertical
308- :expand :horizontal492+ :expand :both
309- :min-size [0.0 h]493+ :pad-right gutter
494+ ;; An explicit :height IS a demand and is
495+ ;; reported as one. Without it the viewport
496+ ;; fills what is left and asks for nothing —
497+ ;; asking is what left the compose bar off the
498+ ;; bottom of the window.
499+ :min-size [0.0 (if (:height opts) h 0.0)]
310 :fixed true500 :fixed true
311 :clip? true501 :clip? true
312 :spacing (c/th :spacing)502 :spacing (c/th :spacing)
313 :key (:key opts)503 :key (:key opts)
314 :offset [0.0 (- off)]}504 :offset [0.0 (- off)]}
315- (dissoc opts :height))505+ (dissoc opts :height :scroll-key :reserve :stick-to-bottom
316- body)]506+ :scroll-to-bottom :on-at-end))
317- (c/state! id :scroll off)507+ body)
318- ;; The bar is drawn after the body so it sits over it, and only when there508+ ;; Within a couple of lines of the end counts as at it: a reader
319- ;; is something to scroll.509+ ;; who has not moved should not stop being followed because the
510+ ;; last message was a pixel taller than the one before.
511+ at-end? (>= off (- maxoff 24.0))
512+ ;; Arriving at the end is reported at once; leaving it has to hold
513+ ;; for a few frames. A burst of messages grows the content faster
514+ ;; than the offset follows, and reporting that honestly would
515+ ;; blink "scrolled away" whenever a channel is busy.
516+ away (if at-end? 0 (inc (or (:away st) 0)))
517+ settled (cond at-end? true (>= away 3) false :else nil)
518+ was (:reported st)]
519+ (swap! scroll-areas assoc area
520+ (cond-> (assoc st :offset off :at-end at-end? :away away)
521+ jump? (assoc :jumped scroll-to-bottom)
522+ (some? settled) (assoc :reported settled)))
523+ ;; Not on the first report: the opening one arrives before the content
524+ ;; has a height, and every list would announce itself as at its end.
525+ (when (and on-at-end (some? settled) (some? was) (not= was settled))
526+ (on-at-end settled))
320 (when (pos? maxoff)527 (when (pos? maxoff)
321 (let [[vx vy vw vh] (or (:rect (c/data id)) view)528 (let [[vx vy vw vh] (or (:rect (c/data id)) view)
322 bw (double (c/th :scrollbar))529 bw (double (c/th :scrollbar))
@@ -327,3 +534,188 @@
327 r))534 r))
328 535
329 (defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))536 (defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))
537+
538+(defn- picture
539+ "The texture for either kind of source: a live `feed` or a file `src`."
540+ [{:keys [feed src]}]
541+ (cond feed (frames/lookup feed)
542+ src (frames/from-file src)))
543+
544+(defn image
545+ "A picture: live pixels under `:feed`, or a file at `:src`.
546+
547+ One widget and not two, because everything downstream — the fit, the
548+ bounds, the click — is the same for both. That is libvidya's arrangement
549+ too, and frq writes [:image {:feed k}] for a call tile and
550+ [:image {:src p}] for an attachment.
551+
552+ `:fit` gives it every point of the space it has been handed; otherwise it
553+ asks for its own size, bounded by `:max-width` and `:max-height`. Either
554+ way the picture keeps its shape — a 16:9 camera in a square tile is the
555+ ordinary case, and stretching it is the one thing nobody wants.
556+
557+ A source with no picture yet — a feed before its first frame, a file that
558+ will not decode — draws the empty tile and nothing else. Not a
559+ broken-image glyph: the text beside it already says what it was meant to
560+ be, and a tile that appears only once a frame lands rearranges the wall
561+ under the person every time somebody joins."
562+ ([opts] (image opts {}))
563+ ([{:keys [feed src] :as source}
564+ {:keys [fit max-width max-height size expand gravity placeholder?]
565+ :or {gravity [0.5 0.5] placeholder? true}}]
566+ (let [t (picture source)
567+ [tw th*] (if t [(:w t) (:h t)] [0 0])
568+ want (cond
569+ size size
570+ (and fit) [320.0 180.0]
571+ (pos? tw)
572+ (let [k (min (if max-width (/ (double max-width) tw) 1.0)
573+ (if max-height (/ (double max-height) th*) 1.0))]
574+ [(* tw k) (* th* k)])
575+ :else [(double (or max-width 160)) (double (or max-height 90))])
576+ rect (c/leaf (mapv double want)
577+ (or expand (if fit :both :none))
578+ gravity)]
579+ (when placeholder? (c/fill! rect (c/th :surface-alt) 6.0))
580+ (when (and t (:tex t)) (c/draw-picture! (:tex t) (:w t) (:h t) rect))
581+ rect)))
582+
583+(defn title-2
584+ "A second-level heading — smaller than `title`, still bold."
585+ [s]
586+ (label s {:size (* 1.15 (c/th :font-size)) :colour (c/th :text)}))
587+
588+(defn status
589+ "A line of text with a dot in front of it saying whether the thing is live."
590+ ([s] (status s false))
591+ ([s live?]
592+ (c/box* {:dir :horizontal :spacing 6 :gravity [0.0 0.5]}
593+ (fn [_ _]
594+ (let [line (c/th :font-size)
595+ d (max 7.0 (min 12.0 (* line 0.55)))
596+ r (c/leaf [(+ d 4.0) line] :none [0.0 0.5])
597+ [x y w h] r]
598+ (c/fill! [(+ x 2.0) (+ y (/ (- h d) 2.0)) d d]
599+ (if live? (c/th :accent) (c/th :text-dim))
600+ (/ d 2.0)))
601+ (label s)))))
602+
603+(defn spinner
604+ "A turning mark, and a word beside it if there is one.
605+
606+ Turned from the wall clock rather than a frame counter: a loop that
607+ dropped frames would otherwise show a spinner that stutters in a way that
608+ reads as the work having stalled, which is the one thing it is there to
609+ deny."
610+ ([] (spinner ""))
611+ ([s]
612+ (c/box* {:dir :horizontal :spacing 6 :gravity [0.0 0.5]}
613+ (fn [_ _]
614+ (let [line (c/th :font-size)
615+ r (c/leaf [line line] :none [0.0 0.5])
616+ [x y w h] r
617+ cx (+ x (/ w 2.0)) cy (+ y (/ h 2.0))
618+ rad (* 0.4 (min w h))
619+ t (/ (double (mod (System/currentTimeMillis) 1000)) 1000.0)
620+ a (* t 2.0 Math/PI)]
621+ ;; Three ticks around a circle: enough to read as turning, and no
622+ ;; arc primitive needed.
623+ (dotimes [i 3]
624+ (let [th* (+ a (* i (/ (* 2.0 Math/PI) 3.0)))]
625+ (c/fill! [(+ cx (* rad (Math/cos th*)) -1.5)
626+ (+ cy (* rad (Math/sin th*)) -1.5) 3.0 3.0]
627+ (c/th :accent) 1.5))))
628+ (when (seq s) (label s))))))
629+
630+(defn link
631+ "Text that is a place to go. Answers true on the frame it was clicked."
632+ ([s] (link s {}))
633+ ([s {:keys [key]}]
634+ (let [id (c/next-id key)
635+ rect (label s {:colour (c/th :accent)})]
636+ (:clicked? (c/interact! id rect)))))
637+
638+(defn emoji
639+ "One emoji, drawn as a character and sized to sit level with the words
640+ either side.
641+
642+ In colour where there is a colour face to draw it from, and as text
643+ where there is not.
644+
645+ The two paths differ in more than the picture: a colour emoji face is a
646+ bitmap with one 128-pixel strike, so it cannot be a fallback font and is
647+ drawn as an image scaled into the line — which means the glyph occupies a
648+ SQUARE of the size asked for, decided here rather than measured. The text
649+ path stays exactly what it was, a label in the UI font, and is what a
650+ machine with no colour face gets."
651+ ([s] (emoji s nil))
652+ ([s size]
653+ (let [sz (double (or size (c/th :font-size)))]
654+ (if (c/colour-emoji? s)
655+ (let [rect (c/leaf [sz sz] :none [0.5 0.5])]
656+ (c/draw-emoji! s rect)
657+ rect)
658+ (label s {:size sz})))))
659+
660+(defn avatar
661+ "A round picture for somebody, or their initial on a colour if there is
662+ none.
663+
664+ The fallback is not a placeholder to be replaced later — most people in
665+ most rooms have no picture, so the initial IS the avatar, and its colour
666+ comes from the name so the same person is the same colour everywhere."
667+ ([nick] (avatar nick {}))
668+ ([nick {:keys [src size] :or {size 24.0}}]
669+ (let [rect (c/leaf [size size] :none [0.5 0.5])
670+ t (when src (frames/from-file src))]
671+ (if (and t (:tex t))
672+ (c/draw-picture! (:tex t) (:w t) (:h t) rect)
673+ (let [name (str nick)
674+ bare (str/replace name #"^[#&@+%~]+" "")
675+ initial (if (seq bare) (str/upper-case (subs bare 0 1)) "?")
676+ [x y w h] rect]
677+ (c/fill! rect (c/name-colour name) (/ size 2.0))
678+ (let [sz (* size 0.5)
679+ [tw th*] (c/measure initial sz)]
680+ (c/draw-text! initial (+ x (/ (- w tw) 2.0)) (+ y (/ (- h th*) 2.0))
681+ sz (c/th :accent-text)))))
682+ rect)))
683+
684+(defn reaction
685+ "A tally wearing a pill: an emoji, how many people, and whether you are one
686+ of them.
687+
688+ The same glyph `emoji` draws, and the same two ways of drawing it: a
689+ colour face gives a square picture, and everything else is text. So the
690+ glyph and the tally are measured and drawn apart rather than as one
691+ string — a picture cannot be concatenated onto a number.
692+
693+ A reaction is not a character otherwise either: it answers the pointer
694+ and it is a count. `mine?` is bordered rather than filled differently,
695+ because the pill has to stay readable at the size a line of them ends
696+ up."
697+ ([glyph] (reaction glyph {}))
698+ ([glyph {:keys [count mine? size key]
699+ :or {count 0 mine? false}}]
700+ (let [sz (double (or size (c/th :font-size)))
701+ colour? (c/colour-emoji? (str glyph))
702+ tally (when (pos? count) (str " " count))
703+ [gw gh] (if colour? [sz sz] (c/measure (str glyph) sz))
704+ [cw ch] (if tally (c/measure tally sz) [0.0 0.0])
705+ tw (+ (double gw) (double cw))
706+ th* (max (double gh) (double ch))
707+ pad 6.0
708+ rect (c/leaf [(+ tw (* 2 pad)) (+ th* 4.0)] :none [0.0 0.5])
709+ id (c/next-id key)
710+ [x y w h] rect]
711+ (c/fill! rect (if mine? (c/th :press) (c/th :surface-alt))
712+ (/ h 2.0)
713+ (when mine? (c/th :accent)) (if mine? 1.0 0.0))
714+ (if colour?
715+ (c/draw-emoji! (str glyph) [(+ x pad) (+ y (/ (- h sz) 2.0)) sz sz])
716+ (c/draw-text! (str glyph) (+ x pad) (+ y (/ (- h (double gh)) 2.0))
717+ sz (c/th :text)))
718+ (when tally
719+ (c/draw-text! tally (+ x pad (double gw)) (+ y (/ (- h (double ch)) 2.0))
720+ sz (c/th :text)))
721+ (:clicked? (c/interact! id rect)))))
added jvui/test/jvui/font_check.clj +32 -0
new file mode 100644
@@ -0,0 +1,32 @@
1+(ns jvui.font-check
2+ "A fallback face must not change the line.
3+
4+ The headless tests measure with a stub — eight pixels a character — so
5+ they cannot see this at all. What it guards is the thing that made the
6+ compose bar a hundred and forty pixels tall: a colour emoji font is a
7+ bitmap with one fixed strike, and asked for fourteen it answers a
8+ hundred and twenty-eight. SDL_ttf then draws it at that, so one emoji
9+ in a message reshapes the window around it.
10+
11+ Needs the real fonts, which is why it is not in the headless set."
12+ (:require [jvui.sdl :as sdl] [jvui.font :as font]))
13+
14+(defn -main [& _]
15+ (sdl/ensure-loaded!)
16+ (sdl/ttf-init!)
17+ (let [c (font/open (font/find-font))
18+ h (font/line-height c 14)
19+ out (atom [])
20+ ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))]
21+ (ck! "the face has a sane line height" (< 8 h 40))
22+ ;; Each of these goes to a fallback on most systems. Whatever answers,
23+ ;; it must answer at the line the text sits on.
24+ (doseq [[what s] [["an arrow" "←"] ["a picture glyph" "🖼"] ["plain text" "Chats"]]]
25+ (let [[w gh] (font/size-of c s 14)]
26+ (ck! (str what " measures on the line")
27+ (and (pos? w) (<= gh (* 2 h))))))
28+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
29+ (let [bad (remove second @out)]
30+ (println (if (seq bad) (str (count bad) " of " (count @out) " checks FAILED")
31+ (str "all " (count @out) " checks passed")))
32+ (when (seq bad) (System/exit 1)))))
new file mode 100644
@@ -0,0 +1,32 @@
1+(ns jvui.font-check
2+ "A fallback face must not change the line.
3+
4+ The headless tests measure with a stub — eight pixels a character — so
5+ they cannot see this at all. What it guards is the thing that made the
6+ compose bar a hundred and forty pixels tall: a colour emoji font is a
7+ bitmap with one fixed strike, and asked for fourteen it answers a
8+ hundred and twenty-eight. SDL_ttf then draws it at that, so one emoji
9+ in a message reshapes the window around it.
10+
11+ Needs the real fonts, which is why it is not in the headless set."
12+ (:require [jvui.sdl :as sdl] [jvui.font :as font]))
13+
14+(defn -main [& _]
15+ (sdl/ensure-loaded!)
16+ (sdl/ttf-init!)
17+ (let [c (font/open (font/find-font))
18+ h (font/line-height c 14)
19+ out (atom [])
20+ ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))]
21+ (ck! "the face has a sane line height" (< 8 h 40))
22+ ;; Each of these goes to a fallback on most systems. Whatever answers,
23+ ;; it must answer at the line the text sits on.
24+ (doseq [[what s] [["an arrow" "←"] ["a picture glyph" "🖼"] ["plain text" "Chats"]]]
25+ (let [[w gh] (font/size-of c s 14)]
26+ (ck! (str what " measures on the line")
27+ (and (pos? w) (<= gh (* 2 h))))))
28+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
29+ (let [bad (remove second @out)]
30+ (println (if (seq bad) (str (count bad) " of " (count @out) " checks FAILED")
31+ (str "all " (count @out) " checks passed")))
32+ (when (seq bad) (System/exit 1)))))
added jvui/test/jvui/frames_check.clj +69 -0
new file mode 100644
@@ -0,0 +1,69 @@
1+(ns jvui.frames-check
2+ "Does a borrowed pointer actually reach a texture?
3+
4+ The other tests walk the UI with no window, which is what makes them fast
5+ and what makes them blind to this: with no renderer there is nothing to
6+ upload into, so every frame is dropped and every check passes for the
7+ wrong reason. So this one opens a REAL window — under SDL's dummy video
8+ driver, which gives a renderer and no display — and asks whether the
9+ texture is there afterwards."
10+ (:require [jvui.app :as app]
11+ [jvui.core :as c]
12+ [jvui.frames :as frames]
13+ [jvui.widgets :as w]
14+ [jolt.ffi :as ffi]))
15+
16+(defn- checker
17+ "A w by h RGBA frame in FOREIGN memory: red on the left, blue on the right,
18+ fully opaque. Two colours so a channel rotation shows up as the wrong one
19+ rather than as a plausible picture."
20+ [w h]
21+ (let [p (ffi/alloc (* 4 w h))]
22+ (dotimes [y h]
23+ (dotimes [x w]
24+ (let [o (* 4 (+ (* y w) x))
25+ left? (< x (quot w 2))]
26+ (ffi/write (+ p o 0) :uint8 (if left? 220 20))
27+ (ffi/write (+ p o 1) :uint8 20)
28+ (ffi/write (+ p o 2) :uint8 (if left? 20 220))
29+ (ffi/write (+ p o 3) :uint8 255))))
30+ p))
31+
32+(defn -main [& _]
33+ (let [px (checker 64 32)
34+ results (atom [])
35+ check! (fn [name ok?] (swap! results conj [name (boolean ok?)]))
36+ frames-seen (atom 0)]
37+ (try
38+ (app/run!
39+ (fn []
40+ (swap! frames-seen inc)
41+ ;; Push a picture the way a decoder would: from foreign memory,
42+ ;; between walks, with no painter in scope.
43+ (when (= 1 @frames-seen)
44+ (frames/put! "peer" 64 32 px))
45+ (when (= 2 @frames-seen)
46+ (let [t (frames/lookup "peer")]
47+ (check! "a frame becomes a texture" (some? (:tex t)))
48+ (check! "at the size it was given" (and (= 64 (:w t)) (= 32 (:h t))))
49+ (check! "and is listed as a feed" (contains? (frames/keys*) "peer")))
50+ ;; A resize must replace the texture rather than write past it.
51+ (frames/put! "peer" 32 64 px))
52+ (when (= 3 @frames-seen)
53+ (let [t (frames/lookup "peer")]
54+ (check! "a resize replaces it" (and (= 32 (:w t)) (= 64 (:h t)))))
55+ (frames/drop! "peer")
56+ (check! "dropping releases it" (nil? (frames/lookup "peer"))))
57+ [:page {}
58+ [:card {} [:title {:label "frames"}]]])
59+ {:title "frames" :width 200 :height 120 :frames 4})
60+ (finally (ffi/free px)))
61+ (doseq [[name ok?] @results]
62+ (println (if ok? "- " "FAIL ") name))
63+ (let [bad (remove second @results)]
64+ (println (if (seq bad)
65+ (str (count bad) " of " (count @results) " checks FAILED")
66+ (str "all " (count @results) " checks passed")))
67+ (when (or (seq bad) (< (count @results) 5))
68+ (println "expected 5 checks, ran" (count @results))
69+ (System/exit 1)))))
new file mode 100644
@@ -0,0 +1,69 @@
1+(ns jvui.frames-check
2+ "Does a borrowed pointer actually reach a texture?
3+
4+ The other tests walk the UI with no window, which is what makes them fast
5+ and what makes them blind to this: with no renderer there is nothing to
6+ upload into, so every frame is dropped and every check passes for the
7+ wrong reason. So this one opens a REAL window — under SDL's dummy video
8+ driver, which gives a renderer and no display — and asks whether the
9+ texture is there afterwards."
10+ (:require [jvui.app :as app]
11+ [jvui.core :as c]
12+ [jvui.frames :as frames]
13+ [jvui.widgets :as w]
14+ [jolt.ffi :as ffi]))
15+
16+(defn- checker
17+ "A w by h RGBA frame in FOREIGN memory: red on the left, blue on the right,
18+ fully opaque. Two colours so a channel rotation shows up as the wrong one
19+ rather than as a plausible picture."
20+ [w h]
21+ (let [p (ffi/alloc (* 4 w h))]
22+ (dotimes [y h]
23+ (dotimes [x w]
24+ (let [o (* 4 (+ (* y w) x))
25+ left? (< x (quot w 2))]
26+ (ffi/write (+ p o 0) :uint8 (if left? 220 20))
27+ (ffi/write (+ p o 1) :uint8 20)
28+ (ffi/write (+ p o 2) :uint8 (if left? 20 220))
29+ (ffi/write (+ p o 3) :uint8 255))))
30+ p))
31+
32+(defn -main [& _]
33+ (let [px (checker 64 32)
34+ results (atom [])
35+ check! (fn [name ok?] (swap! results conj [name (boolean ok?)]))
36+ frames-seen (atom 0)]
37+ (try
38+ (app/run!
39+ (fn []
40+ (swap! frames-seen inc)
41+ ;; Push a picture the way a decoder would: from foreign memory,
42+ ;; between walks, with no painter in scope.
43+ (when (= 1 @frames-seen)
44+ (frames/put! "peer" 64 32 px))
45+ (when (= 2 @frames-seen)
46+ (let [t (frames/lookup "peer")]
47+ (check! "a frame becomes a texture" (some? (:tex t)))
48+ (check! "at the size it was given" (and (= 64 (:w t)) (= 32 (:h t))))
49+ (check! "and is listed as a feed" (contains? (frames/keys*) "peer")))
50+ ;; A resize must replace the texture rather than write past it.
51+ (frames/put! "peer" 32 64 px))
52+ (when (= 3 @frames-seen)
53+ (let [t (frames/lookup "peer")]
54+ (check! "a resize replaces it" (and (= 32 (:w t)) (= 64 (:h t)))))
55+ (frames/drop! "peer")
56+ (check! "dropping releases it" (nil? (frames/lookup "peer"))))
57+ [:page {}
58+ [:card {} [:title {:label "frames"}]]])
59+ {:title "frames" :width 200 :height 120 :frames 4})
60+ (finally (ffi/free px)))
61+ (doseq [[name ok?] @results]
62+ (println (if ok? "- " "FAIL ") name))
63+ (let [bad (remove second @results)]
64+ (println (if (seq bad)
65+ (str (count bad) " of " (count @results) " checks FAILED")
66+ (str "all " (count @results) " checks passed")))
67+ (when (or (seq bad) (< (count @results) 5))
68+ (println "expected 5 checks, ran" (count @results))
69+ (System/exit 1)))))
added jvui/test/jvui/host_check.clj +55 -0
new file mode 100644
@@ -0,0 +1,55 @@
1+(ns jvui.host-check
2+ "The seven platform calls, against a real window.
3+
4+ Under SDL's dummy video driver, which gives a window and a renderer and no
5+ display. That limits what can be claimed and the claims are limited to
6+ match: `open-url!` is not invoked, because succeeding would mean a browser
7+ opening on somebody's desktop and failing would only mean this container
8+ has none. Everything else is checked for real."
9+ (:require [jvui.app :as app]
10+ [jvui.host :as host]
11+ [jvui.widgets :as w]))
12+
13+(defn -main [& _]
14+ (let [out (atom [])
15+ ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))
16+ seen (atom 0)]
17+ ;; Before any window: everything must answer harmlessly rather than throw.
18+ ;; Numbers and not nil: a client that asks before the window is open
19+ ;; does arithmetic on the answer. frq does exactly that on its first
20+ ;; tick, and nil there was a NullPointerException in the caller.
21+ (ck! "no window: screen-size is [0 0]" (= [0 0] (host/screen-size)))
22+ (ck! "no window: window-width is 0" (zero? (host/window-width)))
23+ (ck! "no window: set-title! is quiet" (nil? (host/set-title! "x")))
24+ (ck! "no window: no clipboard picture" (false? (host/clipboard-image-png! "/tmp/nope.png")))
25+ (ck! "no chooser on a desktop" (false? (host/pick-image!)))
26+ (ck! "and nothing ever chosen" (nil? (host/picked-image! "/tmp/nope.png")))
27+
28+ (app/run!
29+ (fn []
30+ (swap! seen inc)
31+ (when (= 1 @seen)
32+ (ck! "a window is installed" (some? (host/window)))
33+ (ck! "window-width is positive" (pos? (host/window-width)))
34+ (let [[sw sh] (or (host/screen-size) [0 0])]
35+ (ck! "screen-size answers a display" (and (pos? sw) (pos? sh))))
36+ (ck! "set-title! does not throw" (nil? (host/set-title! "retitled")))
37+ ;; No picture on this clipboard, so false — the path that matters
38+ ;; is that asking is safe, not that a picture appears.
39+ (ck! "clipboard with no picture is false"
40+ (false? (host/clipboard-image-png! "/tmp/jvui-clip.png"))))
41+ ;; Ask to close on the third frame; the loop is allowed six, so
42+ ;; stopping earlier is the evidence.
43+ (when (= 3 @seen) (host/quit!))
44+ (w/page* {} (fn [_ _] (w/label "host"))))
45+ {:title "host" :width 200 :height 140 :frames 6})
46+
47+ (ck! "quit! stopped the loop early" (< @seen 6))
48+ (ck! "and the window is released" (nil? (host/window)))
49+
50+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
51+ (let [bad (remove second @out)]
52+ (println (if (seq bad)
53+ (str (count bad) " of " (count @out) " checks FAILED")
54+ (str "all " (count @out) " checks passed")))
55+ (when (seq bad) (System/exit 1)))))
new file mode 100644
@@ -0,0 +1,55 @@
1+(ns jvui.host-check
2+ "The seven platform calls, against a real window.
3+
4+ Under SDL's dummy video driver, which gives a window and a renderer and no
5+ display. That limits what can be claimed and the claims are limited to
6+ match: `open-url!` is not invoked, because succeeding would mean a browser
7+ opening on somebody's desktop and failing would only mean this container
8+ has none. Everything else is checked for real."
9+ (:require [jvui.app :as app]
10+ [jvui.host :as host]
11+ [jvui.widgets :as w]))
12+
13+(defn -main [& _]
14+ (let [out (atom [])
15+ ck! (fn [n ok?] (swap! out conj [n (boolean ok?)]))
16+ seen (atom 0)]
17+ ;; Before any window: everything must answer harmlessly rather than throw.
18+ ;; Numbers and not nil: a client that asks before the window is open
19+ ;; does arithmetic on the answer. frq does exactly that on its first
20+ ;; tick, and nil there was a NullPointerException in the caller.
21+ (ck! "no window: screen-size is [0 0]" (= [0 0] (host/screen-size)))
22+ (ck! "no window: window-width is 0" (zero? (host/window-width)))
23+ (ck! "no window: set-title! is quiet" (nil? (host/set-title! "x")))
24+ (ck! "no window: no clipboard picture" (false? (host/clipboard-image-png! "/tmp/nope.png")))
25+ (ck! "no chooser on a desktop" (false? (host/pick-image!)))
26+ (ck! "and nothing ever chosen" (nil? (host/picked-image! "/tmp/nope.png")))
27+
28+ (app/run!
29+ (fn []
30+ (swap! seen inc)
31+ (when (= 1 @seen)
32+ (ck! "a window is installed" (some? (host/window)))
33+ (ck! "window-width is positive" (pos? (host/window-width)))
34+ (let [[sw sh] (or (host/screen-size) [0 0])]
35+ (ck! "screen-size answers a display" (and (pos? sw) (pos? sh))))
36+ (ck! "set-title! does not throw" (nil? (host/set-title! "retitled")))
37+ ;; No picture on this clipboard, so false — the path that matters
38+ ;; is that asking is safe, not that a picture appears.
39+ (ck! "clipboard with no picture is false"
40+ (false? (host/clipboard-image-png! "/tmp/jvui-clip.png"))))
41+ ;; Ask to close on the third frame; the loop is allowed six, so
42+ ;; stopping earlier is the evidence.
43+ (when (= 3 @seen) (host/quit!))
44+ (w/page* {} (fn [_ _] (w/label "host"))))
45+ {:title "host" :width 200 :height 140 :frames 6})
46+
47+ (ck! "quit! stopped the loop early" (< @seen 6))
48+ (ck! "and the window is released" (nil? (host/window)))
49+
50+ (doseq [[n ok?] @out] (println (if ok? "- " "FAIL ") n))
51+ (let [bad (remove second @out)]
52+ (println (if (seq bad)
53+ (str (count bad) " of " (count @out) " checks FAILED")
54+ (str "all " (count @out) " checks passed")))
55+ (when (seq bad) (System/exit 1)))))
modified jvui/test/jvui/tests.clj +58 -0
@@ -268,12 +268,70 @@
268268 (check! (= [127 127 127 255] (theme/mix [0 0 0 255] [254 254 254 255] 0.5))
269269 "and halfway"))
270270
271+(defn- check-long-word-breaks! []
272+ ;; An OAuth login URL is ONE word with no spaces in it. Word-wise
273+ ;; wrapping leaves it long, it makes its container wider than the
274+ ;; window, and the sign-in page then hangs off both edges — which is
275+ ;; exactly what frq did. A broken URL is worse than an unbroken one; a
276+ ;; window you cannot read is worse than both.
277+ (let [url (str "https://freeq.at/auth/login?handle=nandi-test.bsky.social"
278+ "&return_to=http%3A%2F%2F127.0.0.1%3A7390%2Fcallback")
279+ cx (ctx) seen (atom nil)]
280+ (dotimes [_ 2]
281+ (frame! cx (fn [] (c/box* {:dir :vertical}
282+ (fn [_ _] (reset! seen (w/label url)))))))
283+ (let [[_ _ w h] @seen]
284+ (check! (<= w 400.5) "an unbreakable word is broken to fit")
285+ (check! (> h 16.5) "over as many lines as it takes"))))
286+
287+(defn- check-row-wraps! []
288+ ;; A row of reaction pills has to start a new line rather than run off
289+ ;; the end of the message it belongs to.
290+ (let [cx (ctx) seen (atom [])]
291+ (dotimes [_ 2]
292+ (reset! seen [])
293+ (frame! cx (fn [] (c/box* {:dir :horizontal :wrap true :spacing 4}
294+ (fn [_ _]
295+ (dotimes [i 12]
296+ (swap! seen conj
297+ (w/label (str "pill" i) {:expand :none}))))))))
298+ (let [ys (distinct (map second @seen))
299+ xs (map first @seen)]
300+ (check! (> (count ys) 1)
301+ (str "a wrapped row used more than one line: " (count ys)))
302+ (check! (<= (apply max xs) 400.0)
303+ (str "and none of it ran off the end: max x=" (apply max xs))))))
304+
305+(defn- check-label-wraps! []
306+ ;; A sentence longer than its box must come back TALLER and no wider, not
307+ ;; wider and on one line. Without this a single long label makes its
308+ ;; container wider than the window, and a page that centres its content
309+ ;; then hangs off BOTH edges — which is what frq's sign-in screen did the
310+ ;; first time jvui painted it.
311+ ;;
312+ ;; The stub font is eight pixels a character, so the numbers below are
313+ ;; the box width and not a property of any real face.
314+ (let [text (apply str (repeat 12 "wordy ")) ; 72 chars ≈ 576px unwrapped
315+ cx (ctx) ; a 400-wide context
316+ seen (atom nil)]
317+ (dotimes [_ 2]
318+ ;; Twice, because a box's width comes from what its children asked
319+ ;; for LAST frame — the first has nothing to wrap against.
320+ (frame! cx (fn [] (c/box* {:dir :vertical}
321+ (fn [_ _] (reset! seen (w/label text)))))))
322+ (let [[_ _ w h] @seen]
323+ (check! (<= w 400.5) "a long label wraps inside its box")
324+ (check! (> h 16.5) "and takes more than one line to do it"))))
325+
271326 ;; --- runner ------------------------------------------------------------------
272327
273328 (def ^:private checks
274329 [["a leaf is placed" check-leaf!]
275330 ["a column stacks" check-vbox-stacks!]
276331 ["a row runs" check-hbox-runs!]
332+ ["a long label wraps" check-label-wraps!]
333+ ["an unbreakable word breaks" check-long-word-breaks!]
334+ ["a row wraps" check-row-wraps!]
277335 ["expand shares the slack" check-expand-shares!]
278336 ["gravity centres" check-gravity-centres!]
279337 ["layout settles unseen" check-layout-settles!]
@@ -268,12 +268,70 @@
268 (check! (= [127 127 127 255] (theme/mix [0 0 0 255] [254 254 254 255] 0.5))268 (check! (= [127 127 127 255] (theme/mix [0 0 0 255] [254 254 254 255] 0.5))
269 "and halfway"))269 "and halfway"))
270 270
271+(defn- check-long-word-breaks! []
272+ ;; An OAuth login URL is ONE word with no spaces in it. Word-wise
273+ ;; wrapping leaves it long, it makes its container wider than the
274+ ;; window, and the sign-in page then hangs off both edges — which is
275+ ;; exactly what frq did. A broken URL is worse than an unbroken one; a
276+ ;; window you cannot read is worse than both.
277+ (let [url (str "https://freeq.at/auth/login?handle=nandi-test.bsky.social"
278+ "&return_to=http%3A%2F%2F127.0.0.1%3A7390%2Fcallback")
279+ cx (ctx) seen (atom nil)]
280+ (dotimes [_ 2]
281+ (frame! cx (fn [] (c/box* {:dir :vertical}
282+ (fn [_ _] (reset! seen (w/label url)))))))
283+ (let [[_ _ w h] @seen]
284+ (check! (<= w 400.5) "an unbreakable word is broken to fit")
285+ (check! (> h 16.5) "over as many lines as it takes"))))
286+
287+(defn- check-row-wraps! []
288+ ;; A row of reaction pills has to start a new line rather than run off
289+ ;; the end of the message it belongs to.
290+ (let [cx (ctx) seen (atom [])]
291+ (dotimes [_ 2]
292+ (reset! seen [])
293+ (frame! cx (fn [] (c/box* {:dir :horizontal :wrap true :spacing 4}
294+ (fn [_ _]
295+ (dotimes [i 12]
296+ (swap! seen conj
297+ (w/label (str "pill" i) {:expand :none}))))))))
298+ (let [ys (distinct (map second @seen))
299+ xs (map first @seen)]
300+ (check! (> (count ys) 1)
301+ (str "a wrapped row used more than one line: " (count ys)))
302+ (check! (<= (apply max xs) 400.0)
303+ (str "and none of it ran off the end: max x=" (apply max xs))))))
304+
305+(defn- check-label-wraps! []
306+ ;; A sentence longer than its box must come back TALLER and no wider, not
307+ ;; wider and on one line. Without this a single long label makes its
308+ ;; container wider than the window, and a page that centres its content
309+ ;; then hangs off BOTH edges — which is what frq's sign-in screen did the
310+ ;; first time jvui painted it.
311+ ;;
312+ ;; The stub font is eight pixels a character, so the numbers below are
313+ ;; the box width and not a property of any real face.
314+ (let [text (apply str (repeat 12 "wordy ")) ; 72 chars ≈ 576px unwrapped
315+ cx (ctx) ; a 400-wide context
316+ seen (atom nil)]
317+ (dotimes [_ 2]
318+ ;; Twice, because a box's width comes from what its children asked
319+ ;; for LAST frame — the first has nothing to wrap against.
320+ (frame! cx (fn [] (c/box* {:dir :vertical}
321+ (fn [_ _] (reset! seen (w/label text)))))))
322+ (let [[_ _ w h] @seen]
323+ (check! (<= w 400.5) "a long label wraps inside its box")
324+ (check! (> h 16.5) "and takes more than one line to do it"))))
325+
271 ;; --- runner ------------------------------------------------------------------326 ;; --- runner ------------------------------------------------------------------
272 327
273 (def ^:private checks328 (def ^:private checks
274 [["a leaf is placed" check-leaf!]329 [["a leaf is placed" check-leaf!]
275 ["a column stacks" check-vbox-stacks!]330 ["a column stacks" check-vbox-stacks!]
276 ["a row runs" check-hbox-runs!]331 ["a row runs" check-hbox-runs!]
332+ ["a long label wraps" check-label-wraps!]
333+ ["an unbreakable word breaks" check-long-word-breaks!]
334+ ["a row wraps" check-row-wraps!]
277 ["expand shares the slack" check-expand-shares!]335 ["expand shares the slack" check-expand-shares!]
278 ["gravity centres" check-gravity-centres!]336 ["gravity centres" check-gravity-centres!]
279 ["layout settles unseen" check-layout-settles!]337 ["layout settles unseen" check-layout-settles!]