Fix browser compat: sublist replaces 3-arg slice, manual sum replaces reduce

- Added sublist helper (portable list extraction, avoids 3-arg slice
  which fails in browser WASM kernel)
- Replaced reduce + 0 lwid with manual sum loop (reduce has browser
  compat issues with dict-set! error in call stack)
- Imperative DOM update via effect for clean paragraph re-rendering
  on signal changes (clear container, create new spans)
- String slice in hyphenate-word kept (works on strings)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-12 18:31:34 +00:00
parent 13f24e5f26
commit 1884c28763
6 changed files with 137 additions and 66 deletions

View File

@@ -34,6 +34,21 @@
typeset
typeset-plain)
(begin
(define
sublist
(fn
(lst start end)
(let
loop
((i 0) (src lst) (acc (list)))
(cond
(>= i end)
(reverse acc)
(empty? src)
(reverse acc)
(>= i start)
(loop (+ i 1) (rest src) (cons (first src) acc))
:else (loop (+ i 1) (rest src) acc)))))
(define
measure-text
(fn
@@ -188,8 +203,8 @@
(end (nth range 1))
(y (+ y0 (* line-idx line-height))))
(let
((line-words (slice words start end))
(line-widths (slice widths start end)))
((line-words (sublist words start end))
(line-widths (sublist widths start end)))
(position-line line-words line-widths space-width x0 y))))
line-ranges)))
(define
@@ -221,10 +236,10 @@
(let
((start (first range)) (end (nth range 1)))
(let
((lw (slice words start end))
(lwid (slice widths start end)))
((lw (sublist words start end))
(lwid (sublist widths start end)))
(let
((total-w (reduce + 0 lwid))
((total-w (let sum-loop ((k 0) (t 0)) (if (>= k (len lwid)) t (sum-loop (+ k 1) (+ t (nth lwid k))))))
(n-gaps (max 1 (- (len lw) 1)))
(is-last (= line-idx (- n-lines 1))))
(let

View File

@@ -1553,18 +1553,20 @@
cl-collect
(fn
(acc)
(let
((cmd (parse-cmd)))
(if
(nil? cmd)
acc
(let
((acc2 (append acc (list cmd))))
(cond
((match-kw "then") (cl-collect acc2))
((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))
(cl-collect acc2))
(true acc2)))))))
(do
(match-kw "then")
(let
((cmd (parse-cmd)))
(if
(nil? cmd)
acc
(let
((acc2 (append acc (list cmd))))
(cond
((match-kw "then") (cl-collect acc2))
((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))
(cl-collect acc2))
(true acc2))))))))
(let
((cmds (cl-collect (list))))
(cond

File diff suppressed because one or more lines are too long

View File

@@ -34,6 +34,21 @@
typeset
typeset-plain)
(begin
(define
sublist
(fn
(lst start end)
(let
loop
((i 0) (src lst) (acc (list)))
(cond
(>= i end)
(reverse acc)
(empty? src)
(reverse acc)
(>= i start)
(loop (+ i 1) (rest src) (cons (first src) acc))
:else (loop (+ i 1) (rest src) acc)))))
(define
measure-text
(fn
@@ -188,8 +203,8 @@
(end (nth range 1))
(y (+ y0 (* line-idx line-height))))
(let
((line-words (slice words start end))
(line-widths (slice widths start end)))
((line-words (sublist words start end))
(line-widths (sublist widths start end)))
(position-line line-words line-widths space-width x0 y))))
line-ranges)))
(define
@@ -221,10 +236,10 @@
(let
((start (first range)) (end (nth range 1)))
(let
((lw (slice words start end))
(lwid (slice widths start end)))
((lw (sublist words start end))
(lwid (sublist widths start end)))
(let
((total-w (reduce + 0 lwid))
((total-w (let sum-loop ((k 0) (t 0)) (if (>= k (len lwid)) t (sum-loop (+ k 1) (+ t (nth lwid k))))))
(n-gaps (max 1 (- (len lw) 1)))
(is-last (= line-idx (- n-lines 1))))
(let

File diff suppressed because one or more lines are too long

View File

@@ -1,5 +1,6 @@
;; Pretext island — client-side text layout with live controls
;; Uses bytecode-compiled break-lines from text-layout library.
;; Imperative DOM update via effect for clean re-rendering.
(defisland
~pretext-demo/live
@@ -12,11 +13,81 @@
(use-optimal (signal true))
(doc (host-global "document"))
(canvas (host-call doc "createElement" "canvas"))
(ctx (host-call canvas "getContext" "2d")))
(ctx (host-call canvas "getContext" "2d"))
(container-ref (signal nil))
(info-ref (signal nil))
(footer-ref (signal nil)))
(let
((mw (fn (word sz) (do (host-set! ctx "font" (str sz "px 'Pretext Serif', DejaVu Serif, serif")) (host-get (host-call ctx "measureText" word) "width")))))
(let
((layout (computed (fn () (let ((sz (deref font-size)) (mxw (deref max-w)) (opt (deref use-optimal))) (let ((widths (map (fn (w) (mw w sz)) words)) (spw (mw " " sz)) (lh (* sz 1.5))) (let ((ranges (if opt (break-lines widths spw mxw) (break-lines-greedy widths spw mxw)))) (pretext-layout-lines words widths ranges spw mxw lh))))))))
((layout (computed (fn () (let ((sz (deref font-size)) (mxw (deref max-w)) (opt (deref use-optimal))) (let ((widths (map (fn (w) (mw w sz)) words)) (spw (mw " " sz)) (lh (* sz 1.5))) (let ((ranges (if opt (break-lines widths spw mxw) (break-lines-greedy widths spw mxw)))) {:lines (pretext-layout-lines words widths ranges spw mxw lh) :lh lh :mxw mxw :sz sz})))))))
(effect
(fn
()
(let
((data (deref layout))
(el (deref container-ref))
(info-el (deref info-ref))
(footer-el (deref footer-ref)))
(when
el
(let
((lines (get data :lines))
(lh (get data :lh))
(sz (get data :sz))
(mxw (get data :mxw)))
(host-set! el "innerHTML" "")
(host-set!
el
"style"
(str
"position:relative;height:"
(* (len lines) lh)
"px;padding:12px 16px;"))
(for-each
(fn
(line)
(let
((y (get line :y)))
(for-each
(fn
(pw)
(let
((span (host-call doc "createElement" "span")))
(host-set! span "textContent" (get pw :word))
(host-set!
span
"style"
(str
"position:absolute;left:"
(+ (get pw :x) 16)
"px;top:"
(+ y 12)
"px;font-family:'Pretext Serif',serif;font-size:"
sz
"px;line-height:"
lh
"px;white-space:nowrap;"))
(host-call el "appendChild" span)))
(get line :words))))
lines)
(when
info-el
(host-set!
info-el
"textContent"
(str
"Client-side — "
(len lines)
" lines, "
(len words)
" words")))
(when
footer-el
(host-set!
footer-el
"textContent"
(str (len lines) " lines — width: " mxw "px"))))))))
(div
(~tw :tokens "space-y-4")
(div
@@ -73,44 +144,12 @@
:class "px-4 pt-3 pb-1"
(span
:class "text-xs font-medium uppercase tracking-wide text-stone-400"
(str
"Client-side — "
(len (deref layout))
" lines, "
(len words)
" words")))
:ref (fn (el) (reset! info-ref el))
""))
(div :ref (fn (el) (reset! container-ref el)) "")
(div
:style (str
"position:relative;height:"
(* (len (deref layout)) (* (deref font-size) 1.5))
"px;padding:12px 16px;")
(map
(fn
(line)
(let
((y (get line :y)))
(map
(fn
(pw)
(span
:style (str
"position:absolute;left:"
(+ (get pw :x) 16)
"px;top:"
(+ y 12)
"px;font-family:'Pretext Serif',serif;font-size:"
(deref font-size)
"px;line-height:"
(* (deref font-size) 1.5)
"px;white-space:nowrap;")
(get pw :word)))
(get line :words))))
(deref layout)))
(div
:class "px-4 py-2 border-t border-stone-100 bg-stone-50 flex justify-between"
:class "px-4 py-2 border-t border-stone-100 bg-stone-50"
(span
:class "text-xs text-stone-400"
(str (len (deref layout)) " lines"))
(span
:class "text-xs text-stone-400"
(str "width: " (deref max-w) "px")))))))))
:ref (fn (el) (reset! footer-ref el))
""))))))))