Take another line when the message stops fitting
A text field was one line tall and slid its contents sideways when there were too many of them for it. That is right for a handle or a URL, which are read at the end and typed once, and wrong for the thing frq puts in it: a message is written, re-read and edited, and a paragraph shown twelve characters at a time is a paragraph nobody can check before they send it. So `text-entry` grows. `:rows` is how many lines it starts at and `:max-rows` how many it may reach; past that it scrolls by lines with the caret kept in view. Both default to one, so every field that already exists is the field it was. Wrapping is kept as index spans into the string rather than as copied lines, because a caret is an offset and a line it cannot be located in is a line the caret cannot be drawn on. Hard breaks first, then the same greedy word wrap the labels use. Shift+Enter is the break. Plain Enter still belongs to the client, which sends on it, and a field one line tall takes neither — a newline it could not show would leave the text saying one thing and the box another. Up and down move a display line, keeping the caret's offset into the line rather than its pixel column: two lines of proportional text never share a column, and a caret that tracked pixels drifted a character on every press. Home and End became line-local for the same reason. `entry-lines` answers how tall it was drawn, and the backend fires `:on-rows` when that changes: a client laying its screen out in points has no other way to hear that everything below the field just moved. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
b44d525 parent: 4e714e5 modified
glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +18 -0 | @@ -351,10 +351,28 @@ | ||
| 351 | 351 | ;; :hexpand says take the rest of the |
| 352 | 352 | ;; row, which is this widget's default. |
| 353 | 353 | :min-width (:width-request props) |
| 354 | + ;; How tall it starts and how tall it may | |
| 355 | + ;; grow. :rows is what frq already writes | |
| 356 | + ;; for the terminal, where the field is a | |
| 357 | + ;; fixed block of the screen; :max-rows is | |
| 358 | + ;; the window's answer to the same problem | |
| 359 | + ;; — a compose box that gains a line when | |
| 360 | + ;; the message stops fitting rather than | |
| 361 | + ;; sliding a paragraph past one border. | |
| 362 | + :rows (:rows props) | |
| 363 | + :max-rows (:max-rows props) | |
| 354 | 364 | :expand (if (false? (:hexpand props)) |
| 355 | 365 | :none :horizontal)})] |
| 356 | 366 | (record! n id) |
| 357 | 367 | (when (not= now was) (fire! n :on-change now)) |
| 368 | + ;; A field that grew moved everything under it, and a client laying | |
| 369 | + ;; its screen out in points has no other way to hear about it: frq | |
| 370 | + ;; reserves the strip below its message list by hand, and a compose | |
| 371 | + ;; box that got taller without saying so grows down off the window. | |
| 372 | + (let [lines (w/entry-lines id)] | |
| 373 | + (when (not= lines (:lines-told (c/data id))) | |
| 374 | + (c/data! id {:lines-told lines}) | |
| 375 | + (fire! n :on-rows lines))) | |
| 358 | 376 | ;; Enter, which a field must not swallow as input: frq sends its |
| 359 | 377 | ;; message on it, and without this the compose box accepted text |
| 360 | 378 | ;; and had no way to say it was finished. |
| @@ -351,10 +351,28 @@ | |||
| 351 | ;; :hexpand says take the rest of the | 351 | ;; :hexpand says take the rest of the |
| 352 | ;; row, which is this widget's default. | 352 | ;; row, which is this widget's default. |
| 353 | :min-width (:width-request props) | 353 | :min-width (:width-request props) |
| 354 | + ;; How tall it starts and how tall it may | ||
| 355 | + ;; grow. :rows is what frq already writes | ||
| 356 | + ;; for the terminal, where the field is a | ||
| 357 | + ;; fixed block of the screen; :max-rows is | ||
| 358 | + ;; the window's answer to the same problem | ||
| 359 | + ;; — a compose box that gains a line when | ||
| 360 | + ;; the message stops fitting rather than | ||
| 361 | + ;; sliding a paragraph past one border. | ||
| 362 | + :rows (:rows props) | ||
| 363 | + :max-rows (:max-rows props) | ||
| 354 | :expand (if (false? (:hexpand props)) | 364 | :expand (if (false? (:hexpand props)) |
| 355 | :none :horizontal)})] | 365 | :none :horizontal)})] |
| 356 | (record! n id) | 366 | (record! n id) |
| 357 | (when (not= now was) (fire! n :on-change now)) | 367 | (when (not= now was) (fire! n :on-change now)) |
| 368 | + ;; A field that grew moved everything under it, and a client laying | ||
| 369 | + ;; its screen out in points has no other way to hear about it: frq | ||
| 370 | + ;; reserves the strip below its message list by hand, and a compose | ||
| 371 | + ;; box that got taller without saying so grows down off the window. | ||
| 372 | + (let [lines (w/entry-lines id)] | ||
| 373 | + (when (not= lines (:lines-told (c/data id))) | ||
| 374 | + (c/data! id {:lines-told lines}) | ||
| 375 | + (fire! n :on-rows lines))) | ||
| 358 | ;; Enter, which a field must not swallow as input: frq sends its | 376 | ;; Enter, which a field must not swallow as input: frq sends its |
| 359 | ;; message on it, and without this the compose box accepted text | 377 | ;; message on it, and without this the compose box accepted text |
| 360 | ;; and had no way to say it was finished. | 378 | ;; and had no way to say it was finished. |
modified
jvui/src/jvui/widgets.clj +181 -20 | @@ -309,24 +309,138 @@ | ||
| 309 | 309 | [id] |
| 310 | 310 | (boolean (c/state id :activated false))) |
| 311 | 311 | |
| 312 | +(defn entry-lines | |
| 313 | + "How many lines the field under `id` was drawn as on the frame just walked. | |
| 314 | + | |
| 315 | + A field that grows moves everything under it, and a caller laying out a | |
| 316 | + screen by hand — frq reserves the strip below its message list in points — | |
| 317 | + has to be told, or the box grows down over the bottom edge of the window." | |
| 318 | + [id] | |
| 319 | + (long (c/state id :lines 1))) | |
| 320 | + | |
| 321 | +(defn- fit-count | |
| 322 | + "How many characters from `a` fit in `width`, without running past `end`. | |
| 323 | + | |
| 324 | + At least one: a width narrower than a single character would otherwise | |
| 325 | + answer zero, and a wrap that consumes nothing never terminates." | |
| 326 | + [s a end size width] | |
| 327 | + (loop [k 1] | |
| 328 | + (cond | |
| 329 | + (>= (+ a k) end) (- end a) | |
| 330 | + (> (first (c/measure (subs s a (+ a k)) size)) width) (max 1 (dec k)) | |
| 331 | + :else (recur (inc k))))) | |
| 332 | + | |
| 333 | +(defn- wrap-hard-line | |
| 334 | + "Break `s` between `a` and `end` into [lo hi] index pairs that each fit. | |
| 335 | + | |
| 336 | + Index pairs and not strings, unlike `wrap-lines` above: a caret is an | |
| 337 | + offset into the whole string, and a line it cannot be located in is a | |
| 338 | + line the caret cannot be drawn on. The space a line is broken at belongs | |
| 339 | + to neither side — it is stepped over — which is what makes the pairs a | |
| 340 | + partition of the text rather than a copy of it." | |
| 341 | + [s a end size width] | |
| 342 | + (loop [a a out []] | |
| 343 | + (if (>= a end) | |
| 344 | + (conj out [a end]) | |
| 345 | + (let [k (fit-count s a end size width)] | |
| 346 | + (if (>= (+ a k) end) | |
| 347 | + (conj out [a end]) | |
| 348 | + (let [sp (str/last-index-of (subs s a (+ a k 1)) " ")] | |
| 349 | + (if sp | |
| 350 | + (recur (+ a sp 1) (conj out [a (+ a sp)])) | |
| 351 | + (recur (+ a k) (conj out [a (+ a k)]))))))))) | |
| 352 | + | |
| 353 | +(defn- wrap-spans | |
| 354 | + "The whole string as [lo hi] pairs: hard breaks first, then wrapping. | |
| 355 | + | |
| 356 | + A width of zero or less is \"no room known yet\" — the first frame, before | |
| 357 | + the box has a size — and answers one span, exactly as an unwrapped field | |
| 358 | + would. Reading it as no room instead pins every line to one character." | |
| 359 | + [s size width] | |
| 360 | + (let [n (count s)] | |
| 361 | + (if-not (pos? width) | |
| 362 | + [[0 n]] | |
| 363 | + (loop [a 0 out []] | |
| 364 | + (let [nl (str/index-of s "\n" a) | |
| 365 | + end (or nl n) | |
| 366 | + out (into out (wrap-hard-line s a end size width))] | |
| 367 | + (if nl (recur (inc nl) out) out)))))) | |
| 368 | + | |
| 369 | +(defn- span-at | |
| 370 | + "Which of `spans` the caret is on, as an index into them. | |
| 371 | + | |
| 372 | + The first that contains it, so a caret sitting exactly on a soft break | |
| 373 | + shows at the end of the line it was typed on rather than jumping to the | |
| 374 | + head of the next one — the break has not been typed and the eye did not | |
| 375 | + move." | |
| 376 | + [spans caret] | |
| 377 | + (or (first (keep-indexed (fn [i [_ hi]] (when (<= caret hi) i)) spans)) | |
| 378 | + (max 0 (dec (count spans))))) | |
| 379 | + | |
| 312 | 380 | (defn text-entry |
| 313 | - "A single-line editable string. Answers the text after this frame. | |
| 381 | + "An editable string. Answers the text after this frame. | |
| 382 | + | |
| 383 | + One line by default. `:rows` is how many it is tall to start with and | |
| 384 | + `:max-rows` how many it may GROW to: a field given room to grow wraps its | |
| 385 | + text instead of sliding it sideways, and gains a line every time the text | |
| 386 | + stops fitting, up to that cap — past which it scrolls by lines, keeping | |
| 387 | + the caret in view. That is the shape a compose box wants; a handle or a | |
| 388 | + URL field leaves `:max-rows` alone and keeps the old single line. | |
| 314 | 389 | |
| 315 | 390 | The caret is an index into the string kept under the widget's id, which is |
| 316 | 391 | the one piece of state a text field cannot recompute from its value." |
| 317 | 392 | ([value] (text-entry value {})) |
| 318 | - ([value {:keys [key expand placeholder min-width] | |
| 319 | - :or {expand :horizontal}}] | |
| 393 | + ([value {:keys [key expand placeholder min-width rows max-rows] | |
| 394 | + :or {expand :horizontal rows 1}}] | |
| 320 | 395 | (let [size (c/th :font-size) |
| 321 | 396 | pad (c/th :padding) |
| 322 | - h (double (c/th :control-height)) | |
| 397 | + lh (double (c/line-height size)) | |
| 398 | + ;; `(or rows 1)` and not only the destructuring default: a backend | |
| 399 | + ;; forwarding a client's props writes the key whether or not the | |
| 400 | + ;; client set it, and an explicit nil never reaches an `:or`. | |
| 401 | + rows (max 1 (long (or rows 1))) | |
| 402 | + max-rows (max rows (long (or max-rows rows))) | |
| 403 | + grows? (> max-rows 1) | |
| 323 | 404 | id (c/next-id key) |
| 405 | + s (str value) | |
| 406 | + ;; What the text is wrapped against, in this order: the width the | |
| 407 | + ;; field actually had last frame, and before there was one, what the | |
| 408 | + ;; box says is free. The first is exact and the second is not — a row | |
| 409 | + ;; has not yet subtracted the Send button sitting after this field — | |
| 410 | + ;; so the estimate is only ever what the opening frame wraps by. | |
| 411 | + prev (c/rect-of id) | |
| 412 | + inner0 (- (if (and prev (pos? (nth prev 2))) | |
| 413 | + (double (nth prev 2)) | |
| 414 | + (c/avail-width)) | |
| 415 | + (* 2 pad)) | |
| 416 | + spans (if grows? (wrap-spans s size inner0) [[0 (count s)]]) | |
| 417 | + ;; The height is asked for BEFORE this frame's text is known — the | |
| 418 | + ;; box needs a size to place the widget — so it is the height the | |
| 419 | + ;; string coming in wants. A keystroke that adds a line shows on the | |
| 420 | + ;; next frame, which is the same frame the text itself lands on. | |
| 421 | + shown (clamp (count spans) rows max-rows) | |
| 422 | + h (+ (double (c/th :control-height)) (* (dec shown) lh)) | |
| 324 | 423 | rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5]) |
| 325 | 424 | {:keys [hover? focused?]} (c/interact! id rect) |
| 326 | 425 | [rx ry rw rh] rect |
| 327 | - s (str value) | |
| 426 | + inner (- rw (* 2 pad)) | |
| 427 | + spans (if grows? (wrap-spans s size inner) spans) | |
| 328 | 428 | caret0 (clamp (c/state id :caret (count s)) 0 (count s)) |
| 329 | 429 | evs (c/key-events id) |
| 430 | + ;; Where the caret would land on the line above or below, by the | |
| 431 | + ;; offset it holds INTO its line rather than by how far along the | |
| 432 | + ;; line it looks. Two lines of proportional text never share a | |
| 433 | + ;; column, and a caret that tracked pixels would drift a character | |
| 434 | + ;; either way on every press; one that keeps its offset comes back | |
| 435 | + ;; to where it started when the key is pressed the other way. | |
| 436 | + line-step (fn [caret by] | |
| 437 | + (let [i (span-at spans caret) | |
| 438 | + [lo _] (nth spans i) | |
| 439 | + j (clamp (+ i by) 0 (dec (count spans)))] | |
| 440 | + (if (= i j) | |
| 441 | + caret | |
| 442 | + (let [[lo' hi'] (nth spans j)] | |
| 443 | + (min hi' (+ lo' (- caret lo))))))) | |
| 330 | 444 | [s' caret'] |
| 331 | 445 | (reduce |
| 332 | 446 | (fn [[s caret] e] |
| @@ -345,44 +459,91 @@ | ||
| 345 | 459 | [s caret]) |
| 346 | 460 | :left [s (max 0 (dec caret))] |
| 347 | 461 | :right [s (min (count s) (inc caret))] |
| 348 | - :home [s 0] | |
| 349 | - :end [s (count s)] | |
| 462 | + :up [s (line-step caret -1)] | |
| 463 | + :down [s (line-step caret 1)] | |
| 464 | + ;; Line-local, on a field that has lines. Home on the third | |
| 465 | + ;; line of a paragraph means the head of that line — the | |
| 466 | + ;; whole string's start is what Ctrl+Home is elsewhere, and | |
| 467 | + ;; a caret that leapt three lines away on a key pressed to | |
| 468 | + ;; reach the margin is a key nobody presses twice. | |
| 469 | + :home [s (if grows? (first (nth spans (span-at spans caret))) 0)] | |
| 470 | + :end [s (if grows? | |
| 471 | + (second (nth spans (span-at spans caret))) | |
| 472 | + (count s))] | |
| 473 | + ;; Shift+Enter is the break, and only where there is room for | |
| 474 | + ;; one: plain Enter still belongs to the client, which sends | |
| 475 | + ;; on it. A field one line tall takes neither — a newline it | |
| 476 | + ;; could not show would leave the text saying one thing and | |
| 477 | + ;; the box another. | |
| 478 | + :return (if (and grows? (:shift? e)) | |
| 479 | + [(str (subs s 0 caret) "\n" (subs s caret)) | |
| 480 | + (inc caret)] | |
| 481 | + [s caret]) | |
| 350 | 482 | [s caret]) |
| 351 | 483 | [s caret])) |
| 352 | 484 | [s caret0] (or evs [])) |
| 353 | - caret' (clamp caret' 0 (count s'))] | |
| 485 | + caret' (clamp caret' 0 (count s')) | |
| 486 | + spans' (if grows? (wrap-spans s' size inner) [[0 (count s')]])] | |
| 354 | 487 | (c/state! id :caret caret') |
| 488 | + ;; What the NEXT frame will be tall enough for, recorded for a caller | |
| 489 | + ;; that has to leave room for it. A frame late by construction, which is | |
| 490 | + ;; the same beat everything else about this field runs on. | |
| 491 | + (c/state! id :lines (clamp (count spans') rows max-rows)) | |
| 355 | 492 | ;; Enter is not an edit and must not be swallowed as one: a client |
| 356 | 493 | ;; sends its message on it. Recorded as state rather than returned, |
| 357 | 494 | ;; because `text-entry` already answers the text and a second return |
| 358 | 495 | ;; value would change every existing call. |
| 359 | 496 | (c/state! id :activated |
| 360 | - (boolean (some #(and (= :key-down (:kind %)) (= :return (:key %))) | |
| 497 | + (boolean (some #(and (= :key-down (:kind %)) (= :return (:key %)) | |
| 498 | + (not (and grows? (:shift? %)))) | |
| 361 | 499 | (or evs [])))) |
| 500 | + ;; A field that just gained or lost a line has to be walked again to be | |
| 501 | + ;; drawn at its new height, and on a loop that paints only when | |
| 502 | + ;; something happened the keystroke it grew on is already spent. | |
| 503 | + (when (not= (count spans') (count spans)) (c/refresh!)) | |
| 362 | 504 | (c/fill! rect (c/th :surface) (c/th :radius) |
| 363 | 505 | (if focused? (c/th :focus) (c/th :border)) |
| 364 | 506 | (if focused? 2.0 (c/th :border-width))) |
| 365 | 507 | (let [[_ th*] (c/measure (if (= s' "") "M" s') size) |
| 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))] | |
| 508 | + i (span-at spans' caret') | |
| 509 | + ;; Which line is at the top, on a field with more text than it can | |
| 510 | + ;; show. Kept between frames so a reader who scrolled away with the | |
| 511 | + ;; arrows stays where they left off, and pulled back whenever the | |
| 512 | + ;; caret has left the window — which is what typing does. | |
| 513 | + visible (clamp (count spans') rows max-rows) | |
| 514 | + top (-> (long (c/state id :top 0)) | |
| 515 | + (clamp 0 (max 0 (- (count spans') visible))) | |
| 516 | + (clamp (- i (dec visible)) i) | |
| 517 | + (max 0)) | |
| 518 | + ;; One line is centred in the control's height, as it always was. | |
| 519 | + ;; Several start from the top inset by that same half-gap, so the | |
| 520 | + ;; first line of a grown box sits where the only line of a short | |
| 521 | + ;; one did and the text does not shuffle as it grows. | |
| 522 | + ty0 (+ ry (/ (- (double (c/th :control-height)) th*) 2.0)) | |
| 523 | + [clo chi] (nth spans' i) | |
| 524 | + caret-x (first (c/measure (subs s' clo caret') size)) | |
| 525 | + ;; Sideways only where there is nowhere to wrap to. A field of one | |
| 526 | + ;; line narrower than its contents is the ordinary case — a handle, | |
| 527 | + ;; a URL, a password — and without this the text simply runs out | |
| 528 | + ;; past the border and over whatever is beside it. | |
| 529 | + shift (if grows? 0.0 (max 0.0 (- caret-x inner)))] | |
| 530 | + (c/state! id :top top) | |
| 374 | 531 | (c/with-clip [(+ rx pad) ry inner rh] |
| 375 | 532 | (fn [] |
| 376 | 533 | (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))))) | |
| 534 | + (c/draw-text! placeholder (+ rx pad) ty0 size (c/th :text-dim)) | |
| 535 | + (dotimes [k (min visible (- (count spans') top))] | |
| 536 | + (let [[lo hi] (nth spans' (+ top k))] | |
| 537 | + (c/draw-text! (subs s' lo hi) (- (+ rx pad) shift) | |
| 538 | + (+ ty0 (* k lh)) size (c/th :text))))))) | |
| 379 | 539 | ;; The caret rides the same shift, and inside the same clip: a caret |
| 380 | 540 | ;; drawn at the untranslated offset sits past the border on a full |
| 381 | 541 | ;; field, pointing at where the text would have been. |
| 382 | 542 | (when focused? |
| 383 | 543 | (c/with-clip [(+ rx pad) ry inner rh] |
| 384 | 544 | (fn [] |
| 385 | - (c/fill! [(- (+ rx pad caret-x) shift) (+ ty 1.0) 1.5 (- th* 2.0)] | |
| 545 | + (c/fill! [(- (+ rx pad caret-x) shift) | |
| 546 | + (+ ty0 (* (- i top) lh) 1.0) 1.5 (- th* 2.0)] | |
| 386 | 547 | (c/th :text)))))) |
| 387 | 548 | s'))) |
| 388 | 549 | |
| @@ -309,24 +309,138 @@ | |||
| 309 | [id] | 309 | [id] |
| 310 | (boolean (c/state id :activated false))) | 310 | (boolean (c/state id :activated false))) |
| 311 | 311 | ||
| 312 | +(defn entry-lines | ||
| 313 | + "How many lines the field under `id` was drawn as on the frame just walked. | ||
| 314 | + | ||
| 315 | + A field that grows moves everything under it, and a caller laying out a | ||
| 316 | + screen by hand — frq reserves the strip below its message list in points — | ||
| 317 | + has to be told, or the box grows down over the bottom edge of the window." | ||
| 318 | + [id] | ||
| 319 | + (long (c/state id :lines 1))) | ||
| 320 | + | ||
| 321 | +(defn- fit-count | ||
| 322 | + "How many characters from `a` fit in `width`, without running past `end`. | ||
| 323 | + | ||
| 324 | + At least one: a width narrower than a single character would otherwise | ||
| 325 | + answer zero, and a wrap that consumes nothing never terminates." | ||
| 326 | + [s a end size width] | ||
| 327 | + (loop [k 1] | ||
| 328 | + (cond | ||
| 329 | + (>= (+ a k) end) (- end a) | ||
| 330 | + (> (first (c/measure (subs s a (+ a k)) size)) width) (max 1 (dec k)) | ||
| 331 | + :else (recur (inc k))))) | ||
| 332 | + | ||
| 333 | +(defn- wrap-hard-line | ||
| 334 | + "Break `s` between `a` and `end` into [lo hi] index pairs that each fit. | ||
| 335 | + | ||
| 336 | + Index pairs and not strings, unlike `wrap-lines` above: a caret is an | ||
| 337 | + offset into the whole string, and a line it cannot be located in is a | ||
| 338 | + line the caret cannot be drawn on. The space a line is broken at belongs | ||
| 339 | + to neither side — it is stepped over — which is what makes the pairs a | ||
| 340 | + partition of the text rather than a copy of it." | ||
| 341 | + [s a end size width] | ||
| 342 | + (loop [a a out []] | ||
| 343 | + (if (>= a end) | ||
| 344 | + (conj out [a end]) | ||
| 345 | + (let [k (fit-count s a end size width)] | ||
| 346 | + (if (>= (+ a k) end) | ||
| 347 | + (conj out [a end]) | ||
| 348 | + (let [sp (str/last-index-of (subs s a (+ a k 1)) " ")] | ||
| 349 | + (if sp | ||
| 350 | + (recur (+ a sp 1) (conj out [a (+ a sp)])) | ||
| 351 | + (recur (+ a k) (conj out [a (+ a k)]))))))))) | ||
| 352 | + | ||
| 353 | +(defn- wrap-spans | ||
| 354 | + "The whole string as [lo hi] pairs: hard breaks first, then wrapping. | ||
| 355 | + | ||
| 356 | + A width of zero or less is \"no room known yet\" — the first frame, before | ||
| 357 | + the box has a size — and answers one span, exactly as an unwrapped field | ||
| 358 | + would. Reading it as no room instead pins every line to one character." | ||
| 359 | + [s size width] | ||
| 360 | + (let [n (count s)] | ||
| 361 | + (if-not (pos? width) | ||
| 362 | + [[0 n]] | ||
| 363 | + (loop [a 0 out []] | ||
| 364 | + (let [nl (str/index-of s "\n" a) | ||
| 365 | + end (or nl n) | ||
| 366 | + out (into out (wrap-hard-line s a end size width))] | ||
| 367 | + (if nl (recur (inc nl) out) out)))))) | ||
| 368 | + | ||
| 369 | +(defn- span-at | ||
| 370 | + "Which of `spans` the caret is on, as an index into them. | ||
| 371 | + | ||
| 372 | + The first that contains it, so a caret sitting exactly on a soft break | ||
| 373 | + shows at the end of the line it was typed on rather than jumping to the | ||
| 374 | + head of the next one — the break has not been typed and the eye did not | ||
| 375 | + move." | ||
| 376 | + [spans caret] | ||
| 377 | + (or (first (keep-indexed (fn [i [_ hi]] (when (<= caret hi) i)) spans)) | ||
| 378 | + (max 0 (dec (count spans))))) | ||
| 379 | + | ||
| 312 | (defn text-entry | 380 | (defn text-entry |
| 313 | - "A single-line editable string. Answers the text after this frame. | 381 | + "An editable string. Answers the text after this frame. |
| 382 | + | ||
| 383 | + One line by default. `:rows` is how many it is tall to start with and | ||
| 384 | + `:max-rows` how many it may GROW to: a field given room to grow wraps its | ||
| 385 | + text instead of sliding it sideways, and gains a line every time the text | ||
| 386 | + stops fitting, up to that cap — past which it scrolls by lines, keeping | ||
| 387 | + the caret in view. That is the shape a compose box wants; a handle or a | ||
| 388 | + URL field leaves `:max-rows` alone and keeps the old single line. | ||
| 314 | 389 | ||
| 315 | The caret is an index into the string kept under the widget's id, which is | 390 | The caret is an index into the string kept under the widget's id, which is |
| 316 | the one piece of state a text field cannot recompute from its value." | 391 | the one piece of state a text field cannot recompute from its value." |
| 317 | ([value] (text-entry value {})) | 392 | ([value] (text-entry value {})) |
| 318 | - ([value {:keys [key expand placeholder min-width] | 393 | + ([value {:keys [key expand placeholder min-width rows max-rows] |
| 319 | - :or {expand :horizontal}}] | 394 | + :or {expand :horizontal rows 1}}] |
| 320 | (let [size (c/th :font-size) | 395 | (let [size (c/th :font-size) |
| 321 | pad (c/th :padding) | 396 | pad (c/th :padding) |
| 322 | - h (double (c/th :control-height)) | 397 | + lh (double (c/line-height size)) |
| 398 | + ;; `(or rows 1)` and not only the destructuring default: a backend | ||
| 399 | + ;; forwarding a client's props writes the key whether or not the | ||
| 400 | + ;; client set it, and an explicit nil never reaches an `:or`. | ||
| 401 | + rows (max 1 (long (or rows 1))) | ||
| 402 | + max-rows (max rows (long (or max-rows rows))) | ||
| 403 | + grows? (> max-rows 1) | ||
| 323 | id (c/next-id key) | 404 | id (c/next-id key) |
| 405 | + s (str value) | ||
| 406 | + ;; What the text is wrapped against, in this order: the width the | ||
| 407 | + ;; field actually had last frame, and before there was one, what the | ||
| 408 | + ;; box says is free. The first is exact and the second is not — a row | ||
| 409 | + ;; has not yet subtracted the Send button sitting after this field — | ||
| 410 | + ;; so the estimate is only ever what the opening frame wraps by. | ||
| 411 | + prev (c/rect-of id) | ||
| 412 | + inner0 (- (if (and prev (pos? (nth prev 2))) | ||
| 413 | + (double (nth prev 2)) | ||
| 414 | + (c/avail-width)) | ||
| 415 | + (* 2 pad)) | ||
| 416 | + spans (if grows? (wrap-spans s size inner0) [[0 (count s)]]) | ||
| 417 | + ;; The height is asked for BEFORE this frame's text is known — the | ||
| 418 | + ;; box needs a size to place the widget — so it is the height the | ||
| 419 | + ;; string coming in wants. A keystroke that adds a line shows on the | ||
| 420 | + ;; next frame, which is the same frame the text itself lands on. | ||
| 421 | + shown (clamp (count spans) rows max-rows) | ||
| 422 | + h (+ (double (c/th :control-height)) (* (dec shown) lh)) | ||
| 324 | rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5]) | 423 | rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5]) |
| 325 | {:keys [hover? focused?]} (c/interact! id rect) | 424 | {:keys [hover? focused?]} (c/interact! id rect) |
| 326 | [rx ry rw rh] rect | 425 | [rx ry rw rh] rect |
| 327 | - s (str value) | 426 | + inner (- rw (* 2 pad)) |
| 427 | + spans (if grows? (wrap-spans s size inner) spans) | ||
| 328 | caret0 (clamp (c/state id :caret (count s)) 0 (count s)) | 428 | caret0 (clamp (c/state id :caret (count s)) 0 (count s)) |
| 329 | evs (c/key-events id) | 429 | evs (c/key-events id) |
| 430 | + ;; Where the caret would land on the line above or below, by the | ||
| 431 | + ;; offset it holds INTO its line rather than by how far along the | ||
| 432 | + ;; line it looks. Two lines of proportional text never share a | ||
| 433 | + ;; column, and a caret that tracked pixels would drift a character | ||
| 434 | + ;; either way on every press; one that keeps its offset comes back | ||
| 435 | + ;; to where it started when the key is pressed the other way. | ||
| 436 | + line-step (fn [caret by] | ||
| 437 | + (let [i (span-at spans caret) | ||
| 438 | + [lo _] (nth spans i) | ||
| 439 | + j (clamp (+ i by) 0 (dec (count spans)))] | ||
| 440 | + (if (= i j) | ||
| 441 | + caret | ||
| 442 | + (let [[lo' hi'] (nth spans j)] | ||
| 443 | + (min hi' (+ lo' (- caret lo))))))) | ||
| 330 | [s' caret'] | 444 | [s' caret'] |
| 331 | (reduce | 445 | (reduce |
| 332 | (fn [[s caret] e] | 446 | (fn [[s caret] e] |
| @@ -345,44 +459,91 @@ | |||
| 345 | [s caret]) | 459 | [s caret]) |
| 346 | :left [s (max 0 (dec caret))] | 460 | :left [s (max 0 (dec caret))] |
| 347 | :right [s (min (count s) (inc caret))] | 461 | :right [s (min (count s) (inc caret))] |
| 348 | - :home [s 0] | 462 | + :up [s (line-step caret -1)] |
| 349 | - :end [s (count s)] | 463 | + :down [s (line-step caret 1)] |
| 464 | + ;; Line-local, on a field that has lines. Home on the third | ||
| 465 | + ;; line of a paragraph means the head of that line — the | ||
| 466 | + ;; whole string's start is what Ctrl+Home is elsewhere, and | ||
| 467 | + ;; a caret that leapt three lines away on a key pressed to | ||
| 468 | + ;; reach the margin is a key nobody presses twice. | ||
| 469 | + :home [s (if grows? (first (nth spans (span-at spans caret))) 0)] | ||
| 470 | + :end [s (if grows? | ||
| 471 | + (second (nth spans (span-at spans caret))) | ||
| 472 | + (count s))] | ||
| 473 | + ;; Shift+Enter is the break, and only where there is room for | ||
| 474 | + ;; one: plain Enter still belongs to the client, which sends | ||
| 475 | + ;; on it. A field one line tall takes neither — a newline it | ||
| 476 | + ;; could not show would leave the text saying one thing and | ||
| 477 | + ;; the box another. | ||
| 478 | + :return (if (and grows? (:shift? e)) | ||
| 479 | + [(str (subs s 0 caret) "\n" (subs s caret)) | ||
| 480 | + (inc caret)] | ||
| 481 | + [s caret]) | ||
| 350 | [s caret]) | 482 | [s caret]) |
| 351 | [s caret])) | 483 | [s caret])) |
| 352 | [s caret0] (or evs [])) | 484 | [s caret0] (or evs [])) |
| 353 | - caret' (clamp caret' 0 (count s'))] | 485 | + caret' (clamp caret' 0 (count s')) |
| 486 | + spans' (if grows? (wrap-spans s' size inner) [[0 (count s')]])] | ||
| 354 | (c/state! id :caret caret') | 487 | (c/state! id :caret caret') |
| 488 | + ;; What the NEXT frame will be tall enough for, recorded for a caller | ||
| 489 | + ;; that has to leave room for it. A frame late by construction, which is | ||
| 490 | + ;; the same beat everything else about this field runs on. | ||
| 491 | + (c/state! id :lines (clamp (count spans') rows max-rows)) | ||
| 355 | ;; Enter is not an edit and must not be swallowed as one: a client | 492 | ;; 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, | 493 | ;; sends its message on it. Recorded as state rather than returned, |
| 357 | ;; because `text-entry` already answers the text and a second return | 494 | ;; because `text-entry` already answers the text and a second return |
| 358 | ;; value would change every existing call. | 495 | ;; value would change every existing call. |
| 359 | (c/state! id :activated | 496 | (c/state! id :activated |
| 360 | - (boolean (some #(and (= :key-down (:kind %)) (= :return (:key %))) | 497 | + (boolean (some #(and (= :key-down (:kind %)) (= :return (:key %)) |
| 498 | + (not (and grows? (:shift? %)))) | ||
| 361 | (or evs [])))) | 499 | (or evs [])))) |
| 500 | + ;; A field that just gained or lost a line has to be walked again to be | ||
| 501 | + ;; drawn at its new height, and on a loop that paints only when | ||
| 502 | + ;; something happened the keystroke it grew on is already spent. | ||
| 503 | + (when (not= (count spans') (count spans)) (c/refresh!)) | ||
| 362 | (c/fill! rect (c/th :surface) (c/th :radius) | 504 | (c/fill! rect (c/th :surface) (c/th :radius) |
| 363 | (if focused? (c/th :focus) (c/th :border)) | 505 | (if focused? (c/th :focus) (c/th :border)) |
| 364 | (if focused? 2.0 (c/th :border-width))) | 506 | (if focused? 2.0 (c/th :border-width))) |
| 365 | (let [[_ th*] (c/measure (if (= s' "") "M" s') size) | 507 | (let [[_ th*] (c/measure (if (= s' "") "M" s') size) |
| 366 | - ty (+ ry (/ (- rh th*) 2.0)) | 508 | + i (span-at spans' caret') |
| 367 | - inner (- rw (* 2 pad)) | 509 | + ;; Which line is at the top, on a field with more text than it can |
| 368 | - ;; How far the text is slid left so the caret stays in view. A | 510 | + ;; show. Kept between frames so a reader who scrolled away with the |
| 369 | - ;; field narrower than its contents is the ordinary case — a | 511 | + ;; arrows stays where they left off, and pulled back whenever the |
| 370 | - ;; handle, a URL, a password — and without this the text simply | 512 | + ;; caret has left the window — which is what typing does. |
| 371 | - ;; runs out past the border and over whatever is beside it. | 513 | + visible (clamp (count spans') rows max-rows) |
| 372 | - caret-x (first (c/measure (subs s' 0 caret') size)) | 514 | + top (-> (long (c/state id :top 0)) |
| 373 | - shift (max 0.0 (- caret-x inner))] | 515 | + (clamp 0 (max 0 (- (count spans') visible))) |
| 516 | + (clamp (- i (dec visible)) i) | ||
| 517 | + (max 0)) | ||
| 518 | + ;; One line is centred in the control's height, as it always was. | ||
| 519 | + ;; Several start from the top inset by that same half-gap, so the | ||
| 520 | + ;; first line of a grown box sits where the only line of a short | ||
| 521 | + ;; one did and the text does not shuffle as it grows. | ||
| 522 | + ty0 (+ ry (/ (- (double (c/th :control-height)) th*) 2.0)) | ||
| 523 | + [clo chi] (nth spans' i) | ||
| 524 | + caret-x (first (c/measure (subs s' clo caret') size)) | ||
| 525 | + ;; Sideways only where there is nowhere to wrap to. A field of one | ||
| 526 | + ;; line narrower than its contents is the ordinary case — a handle, | ||
| 527 | + ;; a URL, a password — and without this the text simply runs out | ||
| 528 | + ;; past the border and over whatever is beside it. | ||
| 529 | + shift (if grows? 0.0 (max 0.0 (- caret-x inner)))] | ||
| 530 | + (c/state! id :top top) | ||
| 374 | (c/with-clip [(+ rx pad) ry inner rh] | 531 | (c/with-clip [(+ rx pad) ry inner rh] |
| 375 | (fn [] | 532 | (fn [] |
| 376 | (if (and (= s' "") placeholder (not focused?)) | 533 | (if (and (= s' "") placeholder (not focused?)) |
| 377 | - (c/draw-text! placeholder (+ rx pad) ty size (c/th :text-dim)) | 534 | + (c/draw-text! placeholder (+ rx pad) ty0 size (c/th :text-dim)) |
| 378 | - (c/draw-text! s' (- (+ rx pad) shift) ty size (c/th :text))))) | 535 | + (dotimes [k (min visible (- (count spans') top))] |
| 536 | + (let [[lo hi] (nth spans' (+ top k))] | ||
| 537 | + (c/draw-text! (subs s' lo hi) (- (+ rx pad) shift) | ||
| 538 | + (+ ty0 (* k lh)) size (c/th :text))))))) | ||
| 379 | ;; The caret rides the same shift, and inside the same clip: a caret | 539 | ;; 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 | 540 | ;; drawn at the untranslated offset sits past the border on a full |
| 381 | ;; field, pointing at where the text would have been. | 541 | ;; field, pointing at where the text would have been. |
| 382 | (when focused? | 542 | (when focused? |
| 383 | (c/with-clip [(+ rx pad) ry inner rh] | 543 | (c/with-clip [(+ rx pad) ry inner rh] |
| 384 | (fn [] | 544 | (fn [] |
| 385 | - (c/fill! [(- (+ rx pad caret-x) shift) (+ ty 1.0) 1.5 (- th* 2.0)] | 545 | + (c/fill! [(- (+ rx pad caret-x) shift) |
| 546 | + (+ ty0 (* (- i top) lh) 1.0) 1.5 (- th* 2.0)] | ||
| 386 | (c/th :text)))))) | 547 | (c/th :text)))))) |
| 387 | s'))) | 548 | s'))) |
| 388 | 549 | ||
modified
jvui/test/jvui/tests.clj +40 -0 | @@ -220,6 +220,44 @@ | ||
| 220 | 220 | {:kind :text :text "a"}]) |
| 221 | 221 | (check! (= "ah" @s) "and the caret moves where it is told"))) |
| 222 | 222 | |
| 223 | +(defn- check-entry-grows! [] | |
| 224 | + ;; Eight pixels a character and sixteen tall, from the stub: a field 160 | |
| 225 | + ;; wide keeps 160 minus two paddings for text, so sixty characters is | |
| 226 | + ;; several lines' worth however the padding comes out. | |
| 227 | + (let [cx (ctx) s (atom "") h (atom nil) | |
| 228 | + render (fn [opts] | |
| 229 | + (fn [] | |
| 230 | + (let [id (c/next-id nil)] | |
| 231 | + (reset! s (w/text-entry @s (merge {:expand :none} opts))) | |
| 232 | + (reset! h (nth (c/rect-of id) 3))))) | |
| 233 | + grows (render {:max-rows 3})] | |
| 234 | + (frame! cx grows) | |
| 235 | + (frame! cx grows (click-at 10 10)) | |
| 236 | + (let [one @h] | |
| 237 | + (frame! cx grows [{:kind :text :text (apply str (repeat 60 "x"))}]) | |
| 238 | + (frame! cx grows) | |
| 239 | + (check! (> @h one) | |
| 240 | + (str "a field with room to grow gets taller: " @h | |
| 241 | + " against " one)) | |
| 242 | + (frame! cx (render {})) | |
| 243 | + (check! (close? @h one) | |
| 244 | + "and one without keeps the single line it always had")))) | |
| 245 | + | |
| 246 | +(defn- check-entry-shift-enter! [] | |
| 247 | + (let [cx (ctx) s (atom "") acts (atom 0) | |
| 248 | + render (fn [] | |
| 249 | + (let [id (c/next-id nil)] | |
| 250 | + (reset! s (w/text-entry @s {:expand :none :max-rows 3})) | |
| 251 | + (when (w/entry-activated? id) (swap! acts inc))))] | |
| 252 | + (frame! cx render) | |
| 253 | + (frame! cx render (click-at 10 10)) | |
| 254 | + (frame! cx render [{:kind :key-down :key :return :shift? true}]) | |
| 255 | + (check! (= "\n" @s) (str "shift+enter is a break: " (pr-str @s))) | |
| 256 | + (check! (zero? @acts) "and not a send") | |
| 257 | + (frame! cx render [{:kind :key-down :key :return}]) | |
| 258 | + (check! (= "\n" @s) "plain enter still types nothing") | |
| 259 | + (check! (= 1 @acts) "and activates the field"))) | |
| 260 | + | |
| 223 | 261 | (defn- check-unfocused-entry-ignores-keys! [] |
| 224 | 262 | (let [cx (ctx) s (atom "") |
| 225 | 263 | render (fn [] (reset! s (w/text-entry @s {:expand :none})))] |
| @@ -344,6 +382,8 @@ | ||
| 344 | 382 | ["a checkbox toggles" check-checkbox-toggles!] |
| 345 | 383 | ["a field takes text" check-text-entry!] |
| 346 | 384 | ["an unfocused field does not" check-unfocused-entry-ignores-keys!] |
| 385 | + ["a field grows" check-entry-grows!] | |
| 386 | + ["shift+enter breaks a line" check-entry-shift-enter!] | |
| 347 | 387 | ["tab moves focus" check-tab-moves-focus!] |
| 348 | 388 | ["a viewport scrolls" check-scroll!] |
| 349 | 389 | ["the theme mixes" check-theme!]]) |
| @@ -220,6 +220,44 @@ | |||
| 220 | {:kind :text :text "a"}]) | 220 | {:kind :text :text "a"}]) |
| 221 | (check! (= "ah" @s) "and the caret moves where it is told"))) | 221 | (check! (= "ah" @s) "and the caret moves where it is told"))) |
| 222 | 222 | ||
| 223 | +(defn- check-entry-grows! [] | ||
| 224 | + ;; Eight pixels a character and sixteen tall, from the stub: a field 160 | ||
| 225 | + ;; wide keeps 160 minus two paddings for text, so sixty characters is | ||
| 226 | + ;; several lines' worth however the padding comes out. | ||
| 227 | + (let [cx (ctx) s (atom "") h (atom nil) | ||
| 228 | + render (fn [opts] | ||
| 229 | + (fn [] | ||
| 230 | + (let [id (c/next-id nil)] | ||
| 231 | + (reset! s (w/text-entry @s (merge {:expand :none} opts))) | ||
| 232 | + (reset! h (nth (c/rect-of id) 3))))) | ||
| 233 | + grows (render {:max-rows 3})] | ||
| 234 | + (frame! cx grows) | ||
| 235 | + (frame! cx grows (click-at 10 10)) | ||
| 236 | + (let [one @h] | ||
| 237 | + (frame! cx grows [{:kind :text :text (apply str (repeat 60 "x"))}]) | ||
| 238 | + (frame! cx grows) | ||
| 239 | + (check! (> @h one) | ||
| 240 | + (str "a field with room to grow gets taller: " @h | ||
| 241 | + " against " one)) | ||
| 242 | + (frame! cx (render {})) | ||
| 243 | + (check! (close? @h one) | ||
| 244 | + "and one without keeps the single line it always had")))) | ||
| 245 | + | ||
| 246 | +(defn- check-entry-shift-enter! [] | ||
| 247 | + (let [cx (ctx) s (atom "") acts (atom 0) | ||
| 248 | + render (fn [] | ||
| 249 | + (let [id (c/next-id nil)] | ||
| 250 | + (reset! s (w/text-entry @s {:expand :none :max-rows 3})) | ||
| 251 | + (when (w/entry-activated? id) (swap! acts inc))))] | ||
| 252 | + (frame! cx render) | ||
| 253 | + (frame! cx render (click-at 10 10)) | ||
| 254 | + (frame! cx render [{:kind :key-down :key :return :shift? true}]) | ||
| 255 | + (check! (= "\n" @s) (str "shift+enter is a break: " (pr-str @s))) | ||
| 256 | + (check! (zero? @acts) "and not a send") | ||
| 257 | + (frame! cx render [{:kind :key-down :key :return}]) | ||
| 258 | + (check! (= "\n" @s) "plain enter still types nothing") | ||
| 259 | + (check! (= 1 @acts) "and activates the field"))) | ||
| 260 | + | ||
| 223 | (defn- check-unfocused-entry-ignores-keys! [] | 261 | (defn- check-unfocused-entry-ignores-keys! [] |
| 224 | (let [cx (ctx) s (atom "") | 262 | (let [cx (ctx) s (atom "") |
| 225 | render (fn [] (reset! s (w/text-entry @s {:expand :none})))] | 263 | render (fn [] (reset! s (w/text-entry @s {:expand :none})))] |
| @@ -344,6 +382,8 @@ | |||
| 344 | ["a checkbox toggles" check-checkbox-toggles!] | 382 | ["a checkbox toggles" check-checkbox-toggles!] |
| 345 | ["a field takes text" check-text-entry!] | 383 | ["a field takes text" check-text-entry!] |
| 346 | ["an unfocused field does not" check-unfocused-entry-ignores-keys!] | 384 | ["an unfocused field does not" check-unfocused-entry-ignores-keys!] |
| 385 | + ["a field grows" check-entry-grows!] | ||
| 386 | + ["shift+enter breaks a line" check-entry-shift-enter!] | ||
| 347 | ["tab moves focus" check-tab-moves-focus!] | 387 | ["tab moves focus" check-tab-moves-focus!] |
| 348 | ["a viewport scrolls" check-scroll!] | 388 | ["a viewport scrolls" check-scroll!] |
| 349 | ["the theme mixes" check-theme!]]) | 389 | ["the theme mixes" check-theme!]]) |