From 564e3449617e767fbd9806dfc88402ebb64b7edc Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 12 Apr 2026 20:00:53 +0000 Subject: [PATCH] Add computed+HO tests, remove duplicate pretext-layout-lines define MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - 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) --- spec/tests/test-unified-reactive.sx | 84 ++++++++++++ sx/sx/pretext-client.sx | 199 +++++++++------------------- sx/sx/pretext-demo.sx | 43 +----- 3 files changed, 150 insertions(+), 176 deletions(-) diff --git a/spec/tests/test-unified-reactive.sx b/spec/tests/test-unified-reactive.sx index 849f238f..0dba0cbb 100644 --- a/spec/tests/test-unified-reactive.sx +++ b/spec/tests/test-unified-reactive.sx @@ -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))))) diff --git a/sx/sx/pretext-client.sx b/sx/sx/pretext-client.sx index bb4ad8af..4799cec7 100644 --- a/sx/sx/pretext-client.sx +++ b/sx/sx/pretext-client.sx @@ -15,141 +15,72 @@ (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}))))))) - (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")))))))) + ((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 + () + (deref max-w) + (deref font-size) + (deref use-optimal) + (do-layout))) + (div + (~tw :tokens "space-y-4") (div - (~tw :tokens "space-y-4") + (~tw :tokens "flex flex-wrap gap-4 items-end") (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"))) + (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 - :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" - :ref (fn (el) (reset! info-ref el)) - "")) - (div :ref (fn (el) (reset! container-ref el)) "") - (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)) - "")))))))) + (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 + :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" + :ref (fn (el) (reset! info-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" ""))))))) \ No newline at end of file diff --git a/sx/sx/pretext-demo.sx b/sx/sx/pretext-demo.sx index d9bb979f..55fc5758 100644 --- a/sx/sx/pretext-demo.sx +++ b/sx/sx/pretext-demo.sx @@ -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 ()