Step 17b: client-side Pretext island with live controls
defisland ~pretext-demo/live — same Knuth-Plass algorithm running in the browser with canvas.measureText for pixel-perfect font metrics. - Width slider (200-700px), font size slider (10-24px) - Greedy vs Knuth-Plass toggle button - Reactive re-layout on every control change - All layout functions inlined in the island (no library deps) - Perfectly straight right edges — browser measures AND renders Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
203
sx/sx/pretext-client.sx
Normal file
203
sx/sx/pretext-client.sx
Normal file
@@ -0,0 +1,203 @@
|
|||||||
|
;; Pretext island — client-side text layout with live controls
|
||||||
|
;;
|
||||||
|
;; Uses canvas.measureText for pixel-perfect browser font measurement.
|
||||||
|
;; All layout functions inside the island — self-contained.
|
||||||
|
|
||||||
|
(defisland
|
||||||
|
~pretext-demo/live
|
||||||
|
()
|
||||||
|
(let
|
||||||
|
((text "In the beginning was the Word, and the Word was with God, and the Word was God. The same was in the beginning with God. All things were made by him; and without him was not any thing made that was made. In him was life; and the life was the light of men.")
|
||||||
|
(words (split text " "))
|
||||||
|
(max-w (signal 500))
|
||||||
|
(font-size (signal 16))
|
||||||
|
(use-optimal (signal true))
|
||||||
|
(doc (host-global "document"))
|
||||||
|
(canvas (host-call doc "createElement" "canvas"))
|
||||||
|
(ctx (host-call canvas "getContext" "2d")))
|
||||||
|
(let
|
||||||
|
((measure-word (fn (word sz) (do (host-set! ctx "font" (str sz "px 'Pretext Serif', DejaVu Serif, serif")) (host-get (host-call ctx "measureText" word) "width"))))
|
||||||
|
(sum-w
|
||||||
|
(fn
|
||||||
|
(widths sw from to)
|
||||||
|
(let
|
||||||
|
loop
|
||||||
|
((k from) (total 0))
|
||||||
|
(if
|
||||||
|
(>= k to)
|
||||||
|
(+ total (* (max 0 (- (- to from) 1)) sw))
|
||||||
|
(loop (+ k 1) (+ total (nth widths k)))))))
|
||||||
|
(brk-optimal
|
||||||
|
(fn
|
||||||
|
(widths sw mx)
|
||||||
|
(let
|
||||||
|
((n (len widths)))
|
||||||
|
(if
|
||||||
|
(<= n 0)
|
||||||
|
(list)
|
||||||
|
(let
|
||||||
|
((dp (map (fn (i) (if (= i 0) (list 0 -1) (list 999999999 -1))) (range (+ n 1)))))
|
||||||
|
(for-each
|
||||||
|
(fn
|
||||||
|
(i)
|
||||||
|
(let
|
||||||
|
((prev-cost (first (nth dp i))))
|
||||||
|
(let
|
||||||
|
try-j
|
||||||
|
((j i))
|
||||||
|
(when
|
||||||
|
(< j n)
|
||||||
|
(let
|
||||||
|
((used (sum-w widths sw i (+ j 1))))
|
||||||
|
(when
|
||||||
|
(<= used (* mx 1.15))
|
||||||
|
(let
|
||||||
|
((slack (- mx used)))
|
||||||
|
(let
|
||||||
|
((bad (if (< slack 0) 100000 (let ((r (/ slack mx))) (* (* r r) (* r 1000))))))
|
||||||
|
(let
|
||||||
|
((cost (+ prev-cost (let ((b (+ 1 bad))) (* b b))))
|
||||||
|
(entry (nth dp (+ j 1))))
|
||||||
|
(when
|
||||||
|
(< cost (first entry))
|
||||||
|
(set!
|
||||||
|
dp
|
||||||
|
(map-indexed
|
||||||
|
(fn
|
||||||
|
(idx e)
|
||||||
|
(if
|
||||||
|
(= idx (+ j 1))
|
||||||
|
(list cost i)
|
||||||
|
e))
|
||||||
|
dp)))
|
||||||
|
(try-j (+ j 1)))))))))))
|
||||||
|
(range n))
|
||||||
|
(let
|
||||||
|
((breaks (let trace ((pos n) (acc (list))) (let ((prev (nth (nth dp pos) 1))) (if (<= prev 0) acc (trace prev (cons prev acc)))))))
|
||||||
|
(let
|
||||||
|
((starts (cons 0 breaks)))
|
||||||
|
(let
|
||||||
|
((ends (append (rest starts) (list n))))
|
||||||
|
(map (fn (s e) (list s e)) starts ends)))))))))
|
||||||
|
(brk-greedy
|
||||||
|
(fn
|
||||||
|
(widths sw mx)
|
||||||
|
(let
|
||||||
|
((n (len widths)) (lines (list)) (start 0) (used 0))
|
||||||
|
(for-each
|
||||||
|
(fn
|
||||||
|
(i)
|
||||||
|
(let
|
||||||
|
((w (nth widths i))
|
||||||
|
(needed (if (= i start) w (+ used sw w))))
|
||||||
|
(if
|
||||||
|
(and (> needed mx) (not (= i start)))
|
||||||
|
(do
|
||||||
|
(set! lines (append lines (list (list start i))))
|
||||||
|
(set! start i)
|
||||||
|
(set! used w))
|
||||||
|
(set! used needed))))
|
||||||
|
(range n))
|
||||||
|
(append lines (list (list start n)))))))
|
||||||
|
(let
|
||||||
|
((layout (computed (fn () (let ((sz (deref font-size)) (mw (deref max-w)) (optimal (deref use-optimal))) (let ((widths (map (fn (w) (measure-word w sz)) words)) (sw (measure-word " " sz))) (let ((ranges (if optimal (brk-optimal widths sw mw) (brk-greedy widths sw mw))) (lh (* sz 1.5))) (map (fn (line-idx) (let ((range (nth ranges line-idx)) (y (* line-idx lh))) (let ((start (first range)) (end (nth range 1))) (let ((lw (slice words start end)) (lwid (slice widths start end))) (let ((total-w (reduce + 0 lwid)) (n-gaps (max 1 (- (len lw) 1))) (is-last (= line-idx (- (len ranges) 1)))) (let ((gap (if is-last sw (/ (- mw total-w) n-gaps)))) (let pos ((i 0) (x 0) (acc (list))) (if (>= i (len lw)) {:y y :words acc} (pos (+ i 1) (+ x (nth lwid i) gap) (append acc (list {:x x :word (nth lw i)}))))))))))) (range (len ranges))))))))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-4")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "flex flex-wrap gap-4 items-end")
|
||||||
|
(div
|
||||||
|
(label
|
||||||
|
(~tw :tokens "block text-xs text-stone-500 mb-1")
|
||||||
|
"Width")
|
||||||
|
(input
|
||||||
|
:type "range"
|
||||||
|
:min "200"
|
||||||
|
:max "700"
|
||||||
|
:value (deref max-w)
|
||||||
|
(~tw :tokens "w-32")
|
||||||
|
:on-input (fn
|
||||||
|
(e)
|
||||||
|
(reset!
|
||||||
|
max-w
|
||||||
|
(parse-number (host-get (host-get e "target") "value"))))))
|
||||||
|
(div
|
||||||
|
(label
|
||||||
|
(~tw :tokens "block text-xs text-stone-500 mb-1")
|
||||||
|
"Font size")
|
||||||
|
(input
|
||||||
|
:type "range"
|
||||||
|
:min "10"
|
||||||
|
:max "24"
|
||||||
|
:value (deref font-size)
|
||||||
|
(~tw :tokens "w-24")
|
||||||
|
:on-input (fn
|
||||||
|
(e)
|
||||||
|
(reset!
|
||||||
|
font-size
|
||||||
|
(parse-number (host-get (host-get e "target") "value"))))))
|
||||||
|
(div
|
||||||
|
(label
|
||||||
|
(~tw :tokens "block text-xs text-stone-500 mb-1")
|
||||||
|
"Algorithm")
|
||||||
|
(button
|
||||||
|
(~tw
|
||||||
|
:tokens "px-3 py-1 rounded border text-sm transition-colors")
|
||||||
|
:class (if
|
||||||
|
(deref use-optimal)
|
||||||
|
"bg-violet-600 text-white border-violet-600"
|
||||||
|
"bg-white text-stone-600 border-stone-300")
|
||||||
|
:on-click (fn (e) (reset! use-optimal (not (deref use-optimal))))
|
||||||
|
(if (deref use-optimal) "Knuth-Plass" "Greedy")))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "text-xs text-stone-400")
|
||||||
|
(str (deref max-w) "px / " (deref font-size) "px")))
|
||||||
|
(let
|
||||||
|
((lines (deref layout))
|
||||||
|
(lh (* (deref font-size) 1.5))
|
||||||
|
(mw (deref max-w))
|
||||||
|
(sz (deref font-size)))
|
||||||
|
(div
|
||||||
|
:class "relative rounded-lg border border-stone-200 bg-white overflow-hidden"
|
||||||
|
(div
|
||||||
|
:class "px-4 pt-3 pb-1"
|
||||||
|
(span
|
||||||
|
:class "text-xs font-medium uppercase tracking-wide text-stone-400"
|
||||||
|
(str
|
||||||
|
"Client-side — "
|
||||||
|
(len lines)
|
||||||
|
" lines, "
|
||||||
|
(len words)
|
||||||
|
" words")))
|
||||||
|
(div
|
||||||
|
:style (str
|
||||||
|
"position:relative;height:"
|
||||||
|
(* (len lines) lh)
|
||||||
|
"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:"
|
||||||
|
sz
|
||||||
|
"px;line-height:"
|
||||||
|
lh
|
||||||
|
"px;white-space:nowrap;")
|
||||||
|
(get pw :word)))
|
||||||
|
(get line :words))))
|
||||||
|
lines))
|
||||||
|
(div
|
||||||
|
:class "px-4 py-2 border-t border-stone-100 bg-stone-50 flex justify-between"
|
||||||
|
(span
|
||||||
|
:class "text-xs text-stone-400"
|
||||||
|
(str (len lines) " lines"))
|
||||||
|
(span :class "text-xs text-stone-400" (str "width: " mw "px"))))))))))
|
||||||
@@ -290,4 +290,16 @@
|
|||||||
(li
|
(li
|
||||||
"All layout is "
|
"All layout is "
|
||||||
(strong "deterministic")
|
(strong "deterministic")
|
||||||
" — same widths → same positions, every time"))))))))
|
" — same widths → same positions, every time")))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-3")
|
||||||
|
(h2
|
||||||
|
(~tw :tokens "text-xl font-semibold text-stone-800")
|
||||||
|
"Live layout (client-side)")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-sm text-stone-500")
|
||||||
|
"Same algorithm running in the browser. "
|
||||||
|
(code "canvas.measureText")
|
||||||
|
" gives pixel-perfect metrics — the browser that measures is the browser that renders. "
|
||||||
|
"Drag the sliders to re-layout in real time.")
|
||||||
|
(span :data-sx-island "pretext-demo/live" "")))))))
|
||||||
Reference in New Issue
Block a user