Make a list follow what arrives in it
The scroll props frq writes and this dropped: stick-to-bottom, scroll-to-bottom, scroll-key, reserve, and the at-end report it listens for on :on-change and :on-scroll. A chat that does not follow new messages is the difference between a window you read and one you drag. scroll-key is why offsets are kept by NAME now. A widget id is a position in this frame's tree, so two lists never on screen together — one channel's messages and another's — share an id and therefore an offset, and switching between them carried the wrong scroll across. Three rules where the controls disagree, and each one is a bug if it goes the other way: A hand on the wheel beats sticking. Deciding to stick before reading the wheel pins the offset at the end every frame, so the reader drags and it snaps back — which reads as the window being broken rather than as a policy. Found by testing it, because sticking alone passed. Sticking beats a jump, so a jump to an old message is not snatched back by the next arrival. And a jump is asked for by CHANGING the number rather than by setting it, or a caller wanting to jump twice to the same place has nothing to say the second time. Arriving at the end is reported at once; leaving it has to hold three frames. A burst of messages grows the content faster than the offset follows, and reporting that honestly would blink "scrolled away" whenever a channel is busy. The first report is swallowed: it arrives before the content has a height, when every list is trivially at its end. scroll-offset is public because a viewport answers its rectangle and not its state, and a caller restoring a position — or a test asking whether a list actually followed — has nowhere else to look. Which is what the test does: the labels are all in the tree whether or not they are on screen, so only the offset can tell a stuck list from a pinned one. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
95540ef parent: c03a752 modified
glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +23 -2 | @@ -119,8 +119,29 @@ | ||
| 119 | 119 | |
| 120 | 120 | (:card :frame) (w/card* (box-opts props key) (emit-children! n)) |
| 121 | 121 | |
| 122 | - :scroll (w/scroll* (assoc (box-opts props key) | |
| 123 | - :height (num (:height props) 200.0)) | |
| 122 | + ;; A list that follows what arrives in it. Everything here beyond | |
| 123 | + ;; :height is a prop frq writes and this used to drop on the floor — | |
| 124 | + ;; the chat did not follow new messages, and switching channels | |
| 125 | + ;; carried the previous one's scroll across. | |
| 126 | + :scroll (w/scroll* (cond-> (box-opts props key) | |
| 127 | + (:height props) | |
| 128 | + (assoc :height (num (:height props) 200.0)) | |
| 129 | + (:reserve props) | |
| 130 | + (assoc :reserve (num (:reserve props) 0.0)) | |
| 131 | + (:scroll-key props) | |
| 132 | + (assoc :scroll-key (str (:scroll-key props))) | |
| 133 | + (:stick-to-bottom props) | |
| 134 | + (assoc :stick-to-bottom true) | |
| 135 | + (:scroll-to-bottom props) | |
| 136 | + (assoc :scroll-to-bottom (num (:scroll-to-bottom props) 0.0)) | |
| 137 | + ;; libvidya calls this "change" and answers | |
| 138 | + ;; "end"/"away"; frq listens on :on-change and | |
| 139 | + ;; :on-scroll. Both are given the boolean. | |
| 140 | + (or (:on-change props) (:on-scroll props)) | |
| 141 | + (assoc :on-at-end | |
| 142 | + (fn [at-end?] | |
| 143 | + (fire! n :on-change at-end?) | |
| 144 | + (fire! n :on-scroll at-end?)))) | |
| 124 | 145 | (emit-children! n)) |
| 125 | 146 | |
| 126 | 147 | :hbox (c/box* (assoc (box-opts props key) :dir :horizontal) |
| @@ -119,8 +119,29 @@ | |||
| 119 | 119 | ||
| 120 | (:card :frame) (w/card* (box-opts props key) (emit-children! n)) | 120 | (:card :frame) (w/card* (box-opts props key) (emit-children! n)) |
| 121 | 121 | ||
| 122 | - :scroll (w/scroll* (assoc (box-opts props key) | 122 | + ;; A list that follows what arrives in it. Everything here beyond |
| 123 | - :height (num (:height props) 200.0)) | 123 | + ;; :height is a prop frq writes and this used to drop on the floor — |
| 124 | + ;; the chat did not follow new messages, and switching channels | ||
| 125 | + ;; carried the previous one's scroll across. | ||
| 126 | + :scroll (w/scroll* (cond-> (box-opts props key) | ||
| 127 | + (:height props) | ||
| 128 | + (assoc :height (num (:height props) 200.0)) | ||
| 129 | + (:reserve props) | ||
| 130 | + (assoc :reserve (num (:reserve props) 0.0)) | ||
| 131 | + (:scroll-key props) | ||
| 132 | + (assoc :scroll-key (str (:scroll-key props))) | ||
| 133 | + (:stick-to-bottom props) | ||
| 134 | + (assoc :stick-to-bottom true) | ||
| 135 | + (:scroll-to-bottom props) | ||
| 136 | + (assoc :scroll-to-bottom (num (:scroll-to-bottom props) 0.0)) | ||
| 137 | + ;; libvidya calls this "change" and answers | ||
| 138 | + ;; "end"/"away"; frq listens on :on-change and | ||
| 139 | + ;; :on-scroll. Both are given the boolean. | ||
| 140 | + (or (:on-change props) (:on-scroll props)) | ||
| 141 | + (assoc :on-at-end | ||
| 142 | + (fn [at-end?] | ||
| 143 | + (fire! n :on-change at-end?) | ||
| 144 | + (fire! n :on-scroll at-end?)))) | ||
| 124 | (emit-children! n)) | 145 | (emit-children! n)) |
| 125 | 146 | ||
| 126 | :hbox (c/box* (assoc (box-opts props key) :dir :horizontal) | 147 | :hbox (c/box* (assoc (box-opts props key) :dir :horizontal) |
modified
glimmer-backends/glimmer-jvui/test/glimmer_jvui/tests.clj +43 -0 | @@ -5,6 +5,7 @@ | ||
| 5 | 5 | reconciler, this backend's walk, jvui's layout and event routing — can be |
| 6 | 6 | driven with a stub that says eight pixels a character. `jolt test`." |
| 7 | 7 | (:require [glimmer.ratom :as ra] |
| 8 | + [jvui.widgets :as w] | |
| 8 | 9 | [glimmer.core :as gui] |
| 9 | 10 | [glimmer-jvui.core :as jv] |
| 10 | 11 | [jvui.core :as c])) |
| @@ -168,6 +169,47 @@ | ||
| 168 | 169 | (check! (= "hello" (ra/deref sent)) |
| 169 | 170 | (str "Enter reached :on-activate: " (pr-str (ra/deref sent)))))) |
| 170 | 171 | |
| 172 | +(defn- label-node [root text] | |
| 173 | + (first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%))))) | |
| 174 | + (walk root)))) | |
| 175 | + | |
| 176 | +(defn- check-scroll-sticks! [] | |
| 177 | + ;; A chat that does not follow new messages is the difference between a | |
| 178 | + ;; window you read and one you drag. | |
| 179 | + ;; | |
| 180 | + ;; Asserted on GEOMETRY and not on which labels exist: every line is in | |
| 181 | + ;; the tree whether or not it is on screen, so `labels` cannot tell a | |
| 182 | + ;; stuck list from a pinned one. What tells them apart is where the last | |
| 183 | + ;; line was PUT — inside the viewport, or far below it. | |
| 184 | + (let [root (jv/root-node) cx (ctx) | |
| 185 | + n (ra/atom 3)] | |
| 186 | + (gui/mount root :page | |
| 187 | + [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true} | |
| 188 | + (into [:vbox {}] | |
| 189 | + (for [i (range (ra/deref n))] | |
| 190 | + [:label {:key i :label (str "line " i)}]))])]) | |
| 191 | + (dotimes [_ 3] (jv/render-once root cx)) | |
| 192 | + (ra/reset! n 40) | |
| 193 | + (dotimes [_ 3] (jv/render-once root cx)) | |
| 194 | + ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way | |
| 195 | + ;; to scroll. A stuck list is at the far end of it; a pinned one is | |
| 196 | + ;; still at zero. | |
| 197 | + (let [off (w/scroll-offset "chat")] | |
| 198 | + (check! (and off (> off 100.0)) | |
| 199 | + (str "a stuck list followed its content: offset=" off)) | |
| 200 | + ;; And it must STOP following once the reader has moved, or they can | |
| 201 | + ;; never read anything but the newest line. | |
| 202 | + ;; The mouse has to be OVER the list: a wheel is delivered to | |
| 203 | + ;; whatever is under the pointer, and the pointer only moves on a | |
| 204 | + ;; motion event. | |
| 205 | + (jv/render-once root cx [{:kind :motion :x 20 :y 30}]) | |
| 206 | + (dotimes [_ 4] | |
| 207 | + (jv/render-once root cx [{:kind :motion :x 20 :y 30} | |
| 208 | + {:kind :wheel :x 20 :y 30 :dy 3}])) | |
| 209 | + (let [off2 (w/scroll-offset "chat")] | |
| 210 | + (check! (and off2 (< off2 off)) | |
| 211 | + (str "and let go when the reader scrolled up: " off " -> " off2)))))) | |
| 212 | + | |
| 171 | 213 | (defn- check-checkbox-round-trips! [] |
| 172 | 214 | (let [root (jv/root-node) cx (ctx)] |
| 173 | 215 | (ra/reset! on? false) |
| @@ -188,6 +230,7 @@ | ||
| 188 | 230 | ["a press alone does not" check-press-alone-is-not-a-click!] |
| 189 | 231 | ["a reorder keeps identity" check-reorder-keeps-identity!] |
| 190 | 232 | ["an unknown tag is a container" check-unknown-tag-is-a-container!] |
| 233 | + ["a list sticks to the end" check-scroll-sticks!] | |
| 191 | 234 | ["Enter sends" check-enter-sends!] |
| 192 | 235 | ["an entry round-trips" check-entry-round-trips!] |
| 193 | 236 | ["a checkbox round-trips" check-checkbox-round-trips!]]) |
| @@ -5,6 +5,7 @@ | |||
| 5 | reconciler, this backend's walk, jvui's layout and event routing — can be | 5 | reconciler, this backend's walk, jvui's layout and event routing — can be |
| 6 | driven with a stub that says eight pixels a character. `jolt test`." | 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])) |
| @@ -168,6 +169,47 @@ | |||
| 168 | (check! (= "hello" (ra/deref sent)) | 169 | (check! (= "hello" (ra/deref sent)) |
| 169 | (str "Enter reached :on-activate: " (pr-str (ra/deref sent)))))) | 170 | (str "Enter reached :on-activate: " (pr-str (ra/deref sent)))))) |
| 170 | 171 | ||
| 172 | +(defn- label-node [root text] | ||
| 173 | + (first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%))))) | ||
| 174 | + (walk root)))) | ||
| 175 | + | ||
| 176 | +(defn- check-scroll-sticks! [] | ||
| 177 | + ;; A chat that does not follow new messages is the difference between a | ||
| 178 | + ;; window you read and one you drag. | ||
| 179 | + ;; | ||
| 180 | + ;; Asserted on GEOMETRY and not on which labels exist: every line is in | ||
| 181 | + ;; the tree whether or not it is on screen, so `labels` cannot tell a | ||
| 182 | + ;; stuck list from a pinned one. What tells them apart is where the last | ||
| 183 | + ;; line was PUT — inside the viewport, or far below it. | ||
| 184 | + (let [root (jv/root-node) cx (ctx) | ||
| 185 | + n (ra/atom 3)] | ||
| 186 | + (gui/mount root :page | ||
| 187 | + [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true} | ||
| 188 | + (into [:vbox {}] | ||
| 189 | + (for [i (range (ra/deref n))] | ||
| 190 | + [:label {:key i :label (str "line " i)}]))])]) | ||
| 191 | + (dotimes [_ 3] (jv/render-once root cx)) | ||
| 192 | + (ra/reset! n 40) | ||
| 193 | + (dotimes [_ 3] (jv/render-once root cx)) | ||
| 194 | + ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way | ||
| 195 | + ;; to scroll. A stuck list is at the far end of it; a pinned one is | ||
| 196 | + ;; still at zero. | ||
| 197 | + (let [off (w/scroll-offset "chat")] | ||
| 198 | + (check! (and off (> off 100.0)) | ||
| 199 | + (str "a stuck list followed its content: offset=" off)) | ||
| 200 | + ;; And it must STOP following once the reader has moved, or they can | ||
| 201 | + ;; never read anything but the newest line. | ||
| 202 | + ;; The mouse has to be OVER the list: a wheel is delivered to | ||
| 203 | + ;; whatever is under the pointer, and the pointer only moves on a | ||
| 204 | + ;; motion event. | ||
| 205 | + (jv/render-once root cx [{:kind :motion :x 20 :y 30}]) | ||
| 206 | + (dotimes [_ 4] | ||
| 207 | + (jv/render-once root cx [{:kind :motion :x 20 :y 30} | ||
| 208 | + {:kind :wheel :x 20 :y 30 :dy 3}])) | ||
| 209 | + (let [off2 (w/scroll-offset "chat")] | ||
| 210 | + (check! (and off2 (< off2 off)) | ||
| 211 | + (str "and let go when the reader scrolled up: " off " -> " off2)))))) | ||
| 212 | + | ||
| 171 | (defn- check-checkbox-round-trips! [] | 213 | (defn- check-checkbox-round-trips! [] |
| 172 | (let [root (jv/root-node) cx (ctx)] | 214 | (let [root (jv/root-node) cx (ctx)] |
| 173 | (ra/reset! on? false) | 215 | (ra/reset! on? false) |
| @@ -188,6 +230,7 @@ | |||
| 188 | ["a press alone does not" check-press-alone-is-not-a-click!] | 230 | ["a press alone does not" check-press-alone-is-not-a-click!] |
| 189 | ["a reorder keeps identity" check-reorder-keeps-identity!] | 231 | ["a reorder keeps identity" check-reorder-keeps-identity!] |
| 190 | ["an unknown tag is a container" check-unknown-tag-is-a-container!] | 232 | ["an unknown tag is a container" check-unknown-tag-is-a-container!] |
| 233 | + ["a list sticks to the end" check-scroll-sticks!] | ||
| 191 | ["Enter sends" check-enter-sends!] | 234 | ["Enter sends" check-enter-sends!] |
| 192 | ["an entry round-trips" check-entry-round-trips!] | 235 | ["an entry round-trips" check-entry-round-trips!] |
| 193 | ["a checkbox round-trips" check-checkbox-round-trips!]]) | 236 | ["a checkbox round-trips" check-checkbox-round-trips!]]) |
modified
jvui/src/jvui/core.clj +15 -0 | @@ -281,6 +281,21 @@ | ||
| 281 | 281 | room (- (double (or sw 0)) rx)] |
| 282 | 282 | (max 0.0 (if (pos? room) (min box room) box)))) |
| 283 | 283 | |
| 284 | +(defn avail-height | |
| 285 | + "How much height the current box can still give a child. | |
| 286 | + | |
| 287 | + The mirror of `avail-width`, and bounded by the WINDOW for the same | |
| 288 | + reason: a column's height comes from what its children asked for last | |
| 289 | + frame, so asking the box how much room there is gets back what you | |
| 290 | + already took." | |
| 291 | + [] | |
| 292 | + (let [{:keys [dir rect] :as f} (top) | |
| 293 | + [_ ry _ rh] rect | |
| 294 | + [_ sh] (:size (ui)) | |
| 295 | + box (if (= dir :vertical) (- rh (ctr f CURSOR)) rh) | |
| 296 | + room (- (double (or sh 0)) ry)] | |
| 297 | + (max 0.0 (if (pos? room) (min box room) box)))) | |
| 298 | + | |
| 284 | 299 | (defn next-id |
| 285 | 300 | "Claim the next id under the current box." |
| 286 | 301 | ([] (next-id nil)) |
| @@ -281,6 +281,21 @@ | |||
| 281 | room (- (double (or sw 0)) rx)] | 281 | room (- (double (or sw 0)) rx)] |
| 282 | (max 0.0 (if (pos? room) (min box room) box)))) | 282 | (max 0.0 (if (pos? room) (min box room) box)))) |
| 283 | 283 | ||
| 284 | +(defn avail-height | ||
| 285 | + "How much height the current box can still give a child. | ||
| 286 | + | ||
| 287 | + The mirror of `avail-width`, and bounded by the WINDOW for the same | ||
| 288 | + reason: a column's height comes from what its children asked for last | ||
| 289 | + frame, so asking the box how much room there is gets back what you | ||
| 290 | + already took." | ||
| 291 | + [] | ||
| 292 | + (let [{:keys [dir rect] :as f} (top) | ||
| 293 | + [_ ry _ rh] rect | ||
| 294 | + [_ sh] (:size (ui)) | ||
| 295 | + box (if (= dir :vertical) (- rh (ctr f CURSOR)) rh) | ||
| 296 | + room (- (double (or sh 0)) ry)] | ||
| 297 | + (max 0.0 (if (pos? room) (min box room) box)))) | ||
| 298 | + | ||
| 284 | (defn next-id | 299 | (defn next-id |
| 285 | "Claim the next id under the current box." | 300 | "Claim the next id under the current box." |
| 286 | ([] (next-id nil)) | 301 | ([] (next-id nil)) |
modified
jvui/src/jvui/widgets.clj +91 -12 | @@ -365,22 +365,84 @@ | ||
| 365 | 365 | |
| 366 | 366 | ;; ------------------------------------------------------------------- scroll |
| 367 | 367 | |
| 368 | +(defonce ^:private scroll-areas | |
| 369 | + ;; Offsets kept by NAME, outliving the node that showed them. | |
| 370 | + ;; | |
| 371 | + ;; A widget id is a position in this frame's tree, so two lists that are | |
| 372 | + ;; never on screen together — one channel's messages and another's — | |
| 373 | + ;; share one id and therefore one offset, and switching between them | |
| 374 | + ;; carries the wrong scroll across. `:scroll-key` names the area instead, | |
| 375 | + ;; and the name outlives the node. | |
| 376 | + (atom {})) | |
| 377 | + | |
| 378 | +(defn scroll-offset | |
| 379 | + "How far the area named `k` is scrolled, or nil if it has never shown. | |
| 380 | + | |
| 381 | + Public because it is the only way to ask a viewport what it did — the | |
| 382 | + widget answers its rectangle, not its state — and a caller restoring a | |
| 383 | + position, or a test asking whether a list actually followed its | |
| 384 | + content, has nowhere else to look." | |
| 385 | + [k] | |
| 386 | + (:offset (get @scroll-areas k))) | |
| 387 | + | |
| 368 | 388 | (defn scroll* |
| 369 | 389 | "A clipped viewport that scrolls its contents vertically. |
| 370 | 390 | |
| 371 | - The viewport reports the height it was given, not the height of what is in | |
| 372 | - it; the difference between the two is what there is to scroll, which is why | |
| 373 | - `core/box*` keeps both numbers." | |
| 391 | + The viewport reports the height it was given, not the height of what is | |
| 392 | + in it; the difference between the two is what there is to scroll, which | |
| 393 | + is why `core/box*` keeps both numbers. | |
| 394 | + | |
| 395 | + opts beyond `core/box*`'s: | |
| 396 | + | |
| 397 | + :height the viewport's own height | |
| 398 | + :scroll-key a name for the offset, so it survives the node | |
| 399 | + :reserve leave this much of the available height behind | |
| 400 | + :stick-to-bottom follow new content while the reader is at the end | |
| 401 | + :scroll-to-bottom a number the caller BUMPS to ask for a jump | |
| 402 | + :on-at-end called with true/false as the reader arrives at or | |
| 403 | + leaves the end" | |
| 374 | 404 | [opts body] |
| 375 | - (let [h (double (or (:height opts) 200.0)) | |
| 405 | + (let [{:keys [scroll-key reserve stick-to-bottom scroll-to-bottom on-at-end]} opts | |
| 406 | + avail (c/avail-height) | |
| 407 | + h (double (cond | |
| 408 | + (:height opts) (:height opts) | |
| 409 | + ;; `:reserve` says how much must be left for whatever | |
| 410 | + ;; sits below — a compose bar — rather than giving the | |
| 411 | + ;; viewport a height of its own. | |
| 412 | + (and reserve (pos? avail)) (max 0.0 (- avail (double reserve))) | |
| 413 | + :else 200.0)) | |
| 376 | 414 | id (c/next-id (:key opts)) |
| 415 | + area (or scroll-key id) | |
| 377 | 416 | prev (c/data id) |
| 378 | 417 | content-h (second (or (:content-min prev) [0.0 0.0])) |
| 379 | 418 | view (or (:rect prev) [0.0 0.0 0.0 0.0]) |
| 380 | 419 | maxoff (max 0.0 (- content-h h)) |
| 381 | - off0 (min maxoff (max 0.0 (c/state id :scroll 0.0))) | |
| 382 | - off (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e)))))) | |
| 383 | - off0 (or (c/wheel-events view) [])) | |
| 420 | + st (get @scroll-areas area {}) | |
| 421 | + off0 (min maxoff (max 0.0 (or (:offset st) 0.0))) | |
| 422 | + wheel (or (c/wheel-events view) []) | |
| 423 | + ;; A jump is asked for by CHANGING the number, not by setting it: | |
| 424 | + ;; a caller that wanted to jump twice to the same place would | |
| 425 | + ;; otherwise have nothing to say the second time. | |
| 426 | + jump? (and scroll-to-bottom | |
| 427 | + (pos? (double scroll-to-bottom)) | |
| 428 | + (not= scroll-to-bottom (:jumped st))) | |
| 429 | + ;; The wheel is applied FIRST, and a wheel that moved the list | |
| 430 | + ;; breaks the stick for that frame. Deciding to stick before | |
| 431 | + ;; reading it pins the offset at the end every frame and the | |
| 432 | + ;; reader can never scroll up at all — they drag and it snaps | |
| 433 | + ;; back, which reads as the window being broken. | |
| 434 | + wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e)))))) | |
| 435 | + off0 wheel) | |
| 436 | + moved? (not= wheeled off0) | |
| 437 | + ;; Sticking and jumping are the same control pulling opposite | |
| 438 | + ;; ways. Sticking wins over a jump, so a jump to an old message | |
| 439 | + ;; is not snatched back by the next arrival — but a hand on the | |
| 440 | + ;; wheel wins over both. | |
| 441 | + stick? (and stick-to-bottom (not jump?) (not moved?) (:at-end st true)) | |
| 442 | + off (cond | |
| 443 | + jump? maxoff | |
| 444 | + stick? maxoff | |
| 445 | + :else wheeled) | |
| 384 | 446 | r (c/box* (merge {:dir :vertical |
| 385 | 447 | :expand :horizontal |
| 386 | 448 | :min-size [0.0 h] |
| @@ -389,11 +451,28 @@ | ||
| 389 | 451 | :spacing (c/th :spacing) |
| 390 | 452 | :key (:key opts) |
| 391 | 453 | :offset [0.0 (- off)]} |
| 392 | - (dissoc opts :height)) | |
| 393 | - body)] | |
| 394 | - (c/state! id :scroll off) | |
| 395 | - ;; The bar is drawn after the body so it sits over it, and only when there | |
| 396 | - ;; is something to scroll. | |
| 454 | + (dissoc opts :height :scroll-key :reserve :stick-to-bottom | |
| 455 | + :scroll-to-bottom :on-at-end)) | |
| 456 | + body) | |
| 457 | + ;; Within a couple of lines of the end counts as at it: a reader | |
| 458 | + ;; who has not moved should not stop being followed because the | |
| 459 | + ;; last message was a pixel taller than the one before. | |
| 460 | + at-end? (>= off (- maxoff 24.0)) | |
| 461 | + ;; Arriving at the end is reported at once; leaving it has to hold | |
| 462 | + ;; for a few frames. A burst of messages grows the content faster | |
| 463 | + ;; than the offset follows, and reporting that honestly would | |
| 464 | + ;; blink "scrolled away" whenever a channel is busy. | |
| 465 | + away (if at-end? 0 (inc (or (:away st) 0))) | |
| 466 | + settled (cond at-end? true (>= away 3) false :else nil) | |
| 467 | + was (:reported st)] | |
| 468 | + (swap! scroll-areas assoc area | |
| 469 | + (cond-> (assoc st :offset off :at-end at-end? :away away) | |
| 470 | + jump? (assoc :jumped scroll-to-bottom) | |
| 471 | + (some? settled) (assoc :reported settled))) | |
| 472 | + ;; Not on the first report: the opening one arrives before the content | |
| 473 | + ;; has a height, and every list would announce itself as at its end. | |
| 474 | + (when (and on-at-end (some? settled) (some? was) (not= was settled)) | |
| 475 | + (on-at-end settled)) | |
| 397 | 476 | (when (pos? maxoff) |
| 398 | 477 | (let [[vx vy vw vh] (or (:rect (c/data id)) view) |
| 399 | 478 | bw (double (c/th :scrollbar)) |
| @@ -365,22 +365,84 @@ | |||
| 365 | 365 | ||
| 366 | ;; ------------------------------------------------------------------- scroll | 366 | ;; ------------------------------------------------------------------- scroll |
| 367 | 367 | ||
| 368 | +(defonce ^:private scroll-areas | ||
| 369 | + ;; Offsets kept by NAME, outliving the node that showed them. | ||
| 370 | + ;; | ||
| 371 | + ;; A widget id is a position in this frame's tree, so two lists that are | ||
| 372 | + ;; never on screen together — one channel's messages and another's — | ||
| 373 | + ;; share one id and therefore one offset, and switching between them | ||
| 374 | + ;; carries the wrong scroll across. `:scroll-key` names the area instead, | ||
| 375 | + ;; and the name outlives the node. | ||
| 376 | + (atom {})) | ||
| 377 | + | ||
| 378 | +(defn scroll-offset | ||
| 379 | + "How far the area named `k` is scrolled, or nil if it has never shown. | ||
| 380 | + | ||
| 381 | + Public because it is the only way to ask a viewport what it did — the | ||
| 382 | + widget answers its rectangle, not its state — and a caller restoring a | ||
| 383 | + position, or a test asking whether a list actually followed its | ||
| 384 | + content, has nowhere else to look." | ||
| 385 | + [k] | ||
| 386 | + (:offset (get @scroll-areas k))) | ||
| 387 | + | ||
| 368 | (defn scroll* | 388 | (defn scroll* |
| 369 | "A clipped viewport that scrolls its contents vertically. | 389 | "A clipped viewport that scrolls its contents vertically. |
| 370 | 390 | ||
| 371 | - The viewport reports the height it was given, not the height of what is in | 391 | + The viewport reports the height it was given, not the height of what is |
| 372 | - it; the difference between the two is what there is to scroll, which is why | 392 | + in it; the difference between the two is what there is to scroll, which |
| 373 | - `core/box*` keeps both numbers." | 393 | + is why `core/box*` keeps both numbers. |
| 394 | + | ||
| 395 | + opts beyond `core/box*`'s: | ||
| 396 | + | ||
| 397 | + :height the viewport's own height | ||
| 398 | + :scroll-key a name for the offset, so it survives the node | ||
| 399 | + :reserve leave this much of the available height behind | ||
| 400 | + :stick-to-bottom follow new content while the reader is at the end | ||
| 401 | + :scroll-to-bottom a number the caller BUMPS to ask for a jump | ||
| 402 | + :on-at-end called with true/false as the reader arrives at or | ||
| 403 | + leaves the end" | ||
| 374 | [opts body] | 404 | [opts body] |
| 375 | - (let [h (double (or (:height opts) 200.0)) | 405 | + (let [{:keys [scroll-key reserve stick-to-bottom scroll-to-bottom on-at-end]} opts |
| 406 | + avail (c/avail-height) | ||
| 407 | + h (double (cond | ||
| 408 | + (:height opts) (:height opts) | ||
| 409 | + ;; `:reserve` says how much must be left for whatever | ||
| 410 | + ;; sits below — a compose bar — rather than giving the | ||
| 411 | + ;; viewport a height of its own. | ||
| 412 | + (and reserve (pos? avail)) (max 0.0 (- avail (double reserve))) | ||
| 413 | + :else 200.0)) | ||
| 376 | id (c/next-id (:key opts)) | 414 | id (c/next-id (:key opts)) |
| 415 | + area (or scroll-key id) | ||
| 377 | prev (c/data id) | 416 | prev (c/data id) |
| 378 | content-h (second (or (:content-min prev) [0.0 0.0])) | 417 | content-h (second (or (:content-min prev) [0.0 0.0])) |
| 379 | view (or (:rect prev) [0.0 0.0 0.0 0.0]) | 418 | view (or (:rect prev) [0.0 0.0 0.0 0.0]) |
| 380 | maxoff (max 0.0 (- content-h h)) | 419 | maxoff (max 0.0 (- content-h h)) |
| 381 | - off0 (min maxoff (max 0.0 (c/state id :scroll 0.0))) | 420 | + st (get @scroll-areas area {}) |
| 382 | - off (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e)))))) | 421 | + off0 (min maxoff (max 0.0 (or (:offset st) 0.0))) |
| 383 | - off0 (or (c/wheel-events view) [])) | 422 | + wheel (or (c/wheel-events view) []) |
| 423 | + ;; A jump is asked for by CHANGING the number, not by setting it: | ||
| 424 | + ;; a caller that wanted to jump twice to the same place would | ||
| 425 | + ;; otherwise have nothing to say the second time. | ||
| 426 | + jump? (and scroll-to-bottom | ||
| 427 | + (pos? (double scroll-to-bottom)) | ||
| 428 | + (not= scroll-to-bottom (:jumped st))) | ||
| 429 | + ;; The wheel is applied FIRST, and a wheel that moved the list | ||
| 430 | + ;; breaks the stick for that frame. Deciding to stick before | ||
| 431 | + ;; reading it pins the offset at the end every frame and the | ||
| 432 | + ;; reader can never scroll up at all — they drag and it snaps | ||
| 433 | + ;; back, which reads as the window being broken. | ||
| 434 | + wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e)))))) | ||
| 435 | + off0 wheel) | ||
| 436 | + moved? (not= wheeled off0) | ||
| 437 | + ;; Sticking and jumping are the same control pulling opposite | ||
| 438 | + ;; ways. Sticking wins over a jump, so a jump to an old message | ||
| 439 | + ;; is not snatched back by the next arrival — but a hand on the | ||
| 440 | + ;; wheel wins over both. | ||
| 441 | + stick? (and stick-to-bottom (not jump?) (not moved?) (:at-end st true)) | ||
| 442 | + off (cond | ||
| 443 | + jump? maxoff | ||
| 444 | + stick? maxoff | ||
| 445 | + :else wheeled) | ||
| 384 | r (c/box* (merge {:dir :vertical | 446 | r (c/box* (merge {:dir :vertical |
| 385 | :expand :horizontal | 447 | :expand :horizontal |
| 386 | :min-size [0.0 h] | 448 | :min-size [0.0 h] |
| @@ -389,11 +451,28 @@ | |||
| 389 | :spacing (c/th :spacing) | 451 | :spacing (c/th :spacing) |
| 390 | :key (:key opts) | 452 | :key (:key opts) |
| 391 | :offset [0.0 (- off)]} | 453 | :offset [0.0 (- off)]} |
| 392 | - (dissoc opts :height)) | 454 | + (dissoc opts :height :scroll-key :reserve :stick-to-bottom |
| 393 | - body)] | 455 | + :scroll-to-bottom :on-at-end)) |
| 394 | - (c/state! id :scroll off) | 456 | + body) |
| 395 | - ;; The bar is drawn after the body so it sits over it, and only when there | 457 | + ;; Within a couple of lines of the end counts as at it: a reader |
| 396 | - ;; is something to scroll. | 458 | + ;; who has not moved should not stop being followed because the |
| 459 | + ;; last message was a pixel taller than the one before. | ||
| 460 | + at-end? (>= off (- maxoff 24.0)) | ||
| 461 | + ;; Arriving at the end is reported at once; leaving it has to hold | ||
| 462 | + ;; for a few frames. A burst of messages grows the content faster | ||
| 463 | + ;; than the offset follows, and reporting that honestly would | ||
| 464 | + ;; blink "scrolled away" whenever a channel is busy. | ||
| 465 | + away (if at-end? 0 (inc (or (:away st) 0))) | ||
| 466 | + settled (cond at-end? true (>= away 3) false :else nil) | ||
| 467 | + was (:reported st)] | ||
| 468 | + (swap! scroll-areas assoc area | ||
| 469 | + (cond-> (assoc st :offset off :at-end at-end? :away away) | ||
| 470 | + jump? (assoc :jumped scroll-to-bottom) | ||
| 471 | + (some? settled) (assoc :reported settled))) | ||
| 472 | + ;; Not on the first report: the opening one arrives before the content | ||
| 473 | + ;; has a height, and every list would announce itself as at its end. | ||
| 474 | + (when (and on-at-end (some? settled) (some? was) (not= was settled)) | ||
| 475 | + (on-at-end settled)) | ||
| 397 | (when (pos? maxoff) | 476 | (when (pos? maxoff) |
| 398 | (let [[vx vy vw vh] (or (:rect (c/data id)) view) | 477 | (let [[vx vy vw vh] (or (:rect (c/data id)) view) |
| 399 | bw (double (c/th :scrollbar)) | 478 | bw (double (c/th :scrollbar)) |