Add computed+HO tests, remove duplicate pretext-layout-lines define
- 7 new tests in computed-ho-forms suite: computed with map, reduce, for-each, nested map, dict creation, signal updates. All pass on OCaml and WASM sandbox. - Removed standalone pretext-position-line and pretext-layout-lines from pretext-demo.sx — now in text-layout library only - Root cause of island error: pretext-demo.sx had old define with (reduce + 0 lwid) that the server serialized into component defs, overriding the library's sum-loop version Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -598,3 +598,87 @@
|
||||
(assert-equal
|
||||
"hello world"
|
||||
(bind (str (context :first) " " (context :second))))))))
|
||||
|
||||
(defsuite
|
||||
"computed-ho-forms"
|
||||
(deftest
|
||||
"computed with map"
|
||||
(let
|
||||
((s (signal 10))
|
||||
(c
|
||||
(computed (fn () (map (fn (x) (* x (deref s))) (list 1 2 3))))))
|
||||
(assert-equal (list 10 20 30) (deref c))))
|
||||
(deftest
|
||||
"computed with map then reduce"
|
||||
(let
|
||||
((s (signal 10))
|
||||
(c
|
||||
(computed
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((widths (map (fn (x) (* x (deref s))) (list 1 2 3))))
|
||||
(reduce + 0 widths))))))
|
||||
(assert-equal 60 (deref c))))
|
||||
(deftest
|
||||
"computed with map+reduce updates on signal change"
|
||||
(let
|
||||
((s (signal 10))
|
||||
(c
|
||||
(computed
|
||||
(fn
|
||||
()
|
||||
(reduce + 0 (map (fn (x) (* x (deref s))) (list 1 2 3)))))))
|
||||
(assert-equal 60 (deref c))
|
||||
(reset! s 5)
|
||||
(assert-equal 30 (deref c))))
|
||||
(deftest
|
||||
"computed with for-each and mutation"
|
||||
(let
|
||||
((s (signal 2))
|
||||
(c
|
||||
(computed
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((acc (list)))
|
||||
(for-each
|
||||
(fn (x) (append! acc (* x (deref s))))
|
||||
(list 10 20 30))
|
||||
acc)))))
|
||||
(assert-equal (list 20 40 60) (deref c))))
|
||||
(deftest
|
||||
"computed with nested map"
|
||||
(let
|
||||
((s (signal 1))
|
||||
(c
|
||||
(computed
|
||||
(fn
|
||||
()
|
||||
(map
|
||||
(fn (row) (map (fn (x) (+ x (deref s))) row))
|
||||
(list (list 1 2) (list 3 4)))))))
|
||||
(assert-equal (list (list 2 3) (list 4 5)) (deref c))))
|
||||
(deftest
|
||||
"computed with map producing dicts"
|
||||
(let
|
||||
((s (signal 10))
|
||||
(c
|
||||
(computed (fn () (map (fn (w) {:width (* (len w) (deref s)) :word w}) (list "hi" "there"))))))
|
||||
(let
|
||||
((result (deref c)))
|
||||
(assert-equal 2 (len result))
|
||||
(assert-equal "hi" (get (first result) :word))
|
||||
(assert-equal 20 (get (first result) :width)))))
|
||||
(deftest
|
||||
"computed with map+dict then sum widths"
|
||||
(let
|
||||
((s (signal 10))
|
||||
(c
|
||||
(computed
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((items (map (fn (w) {:width (* (len w) (deref s)) :word w}) (list "hi" "there" "world"))))
|
||||
(reduce + 0 (map (fn (item) (get item :width)) items)))))))
|
||||
(assert-equal 120 (deref c)))))
|
||||
|
||||
@@ -15,87 +15,22 @@
|
||||
(canvas (host-call doc "createElement" "canvas"))
|
||||
(ctx (host-call canvas "getContext" "2d"))
|
||||
(container-ref (signal nil))
|
||||
(info-ref (signal nil))
|
||||
(footer-ref (signal nil)))
|
||||
(info-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)))) {:lines (pretext-layout-lines words widths ranges spw mxw lh) :lh lh :mxw mxw :sz sz})))))))
|
||||
((do-layout (fn () (let ((el (deref container-ref)) (info-el (deref info-ref)) (sz (deref font-size)) (mxw (deref max-w)) (opt (deref use-optimal)) (lh 0)) (when el (set! lh (* sz 1.5)) (host-set! ctx "font" (str sz "px 'Pretext Serif', DejaVu Serif, serif")) (let ((widths (map (fn (w) (host-get (host-call ctx "measureText" w) "width")) words)) (spw (host-get (host-call ctx "measureText" " ") "width"))) (let ((ranges (if opt (break-lines widths spw mxw) (break-lines-greedy widths spw mxw)))) (let ((lines (pretext-layout-lines words widths ranges spw mxw lh))) (host-set! el "innerHTML" "") (host-set! el "style" (str "position:relative;height:" (* (len lines) lh) "px;padding:12px 16px;")) (for-each (fn (line) (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:" (+ (get line :y) 12) "px;font:" sz "px 'Pretext Serif',serif;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 — " mxw "px / " sz "px / " (if opt "Knuth-Plass" "Greedy"))))))))))))
|
||||
(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"))))))))
|
||||
(deref max-w)
|
||||
(deref font-size)
|
||||
(deref use-optimal)
|
||||
(do-layout)))
|
||||
(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")
|
||||
(label (~tw :tokens "block text-xs text-stone-500 mb-1") "Width")
|
||||
(input
|
||||
:type "range"
|
||||
:min "200"
|
||||
@@ -134,10 +69,7 @@
|
||||
"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")))
|
||||
(if (deref use-optimal) "Knuth-Plass" "Greedy"))))
|
||||
(div
|
||||
:class "relative rounded-lg border border-stone-200 bg-white overflow-hidden"
|
||||
(div
|
||||
@@ -146,10 +78,9 @@
|
||||
:class "text-xs font-medium uppercase tracking-wide text-stone-400"
|
||||
:ref (fn (el) (reset! info-ref el))
|
||||
""))
|
||||
(div :ref (fn (el) (reset! container-ref el)) "")
|
||||
(div
|
||||
:ref (fn (el) (do (reset! container-ref el) (do-layout)))
|
||||
"")
|
||||
(div
|
||||
:class "px-4 py-2 border-t border-stone-100 bg-stone-50"
|
||||
(span
|
||||
:class "text-xs text-stone-400"
|
||||
:ref (fn (el) (reset! footer-ref el))
|
||||
""))))))))
|
||||
(span :class "text-xs text-stone-400" "")))))))
|
||||
@@ -4,48 +4,6 @@
|
||||
;; Uses measure-text (perform) for glyph measurement.
|
||||
|
||||
;; Compute positioned word data for one line.
|
||||
(define
|
||||
pretext-position-line
|
||||
(fn
|
||||
(words widths gap-w)
|
||||
(let
|
||||
loop
|
||||
((i 0) (x 0) (acc (list)))
|
||||
(if
|
||||
(>= i (len words))
|
||||
acc
|
||||
(loop
|
||||
(+ i 1)
|
||||
(+ x (nth widths i) gap-w)
|
||||
(append acc (list {:width (nth widths i) :x x :word (nth words i)})))))))
|
||||
|
||||
;; Compute all positioned lines for a paragraph.
|
||||
(define
|
||||
pretext-layout-lines
|
||||
(fn
|
||||
(words widths ranges space-width max-width line-height)
|
||||
(let
|
||||
((n-lines (len ranges)))
|
||||
(map
|
||||
(fn
|
||||
(line-idx)
|
||||
(let
|
||||
((range (nth ranges line-idx)) (y (* line-idx line-height)))
|
||||
(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 (- n-lines 1))))
|
||||
(let
|
||||
((gap (if is-last space-width (/ (- max-width total-w) n-gaps))))
|
||||
{:y y :words (pretext-position-line lw lwid gap)}))))))
|
||||
(range n-lines)))))
|
||||
|
||||
;; Render pre-computed positioned lines
|
||||
(defcomp
|
||||
~pretext-demo/render-paragraph
|
||||
(&key lines max-width line-height n-words label)
|
||||
@@ -92,6 +50,7 @@
|
||||
(str n-lines " lines, " n-words " words"))
|
||||
(span :class "text-xs text-stone-400" (str "width: " max-width "px"))))))
|
||||
|
||||
;; Compute all positioned lines for a paragraph.
|
||||
(defcomp
|
||||
~pretext-demo/content
|
||||
()
|
||||
|
||||
Reference in New Issue
Block a user