Fix :ref callback bug in adapter-dom — Pretext island fully working
Root cause: adapter-dom.sx line 345 handled :ref by calling (dict-set! attr-val "current" el), assuming React-style ref objects. Callback-style refs (fn (el) ...) passed a function, not a dict, causing dict-set! to fail with "dict key val" error. Fix: (if (callable? attr-val) (attr-val el) (dict-set! attr-val "current" el)) Supports both callback refs and dict refs. Pretext island now fully working: - 3 controls: width slider, font size slider, algorithm toggle - Knuth-Plass + greedy line breaking via bytecode-compiled library - canvas.measureText for pixel-perfect browser font metrics - Effect-based imperative DOM rendering (createElement + appendChild) - Reactive: slider drag → re-measure → re-break → re-render Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -342,7 +342,7 @@
|
||||
(= attr-name "ref")
|
||||
(let
|
||||
((attr-val (trampoline (eval-expr attr-expr env))))
|
||||
(dict-set! attr-val "current" el))
|
||||
(if (callable? attr-val) (attr-val el) (dict-set! attr-val "current" el)))
|
||||
(= attr-name "key")
|
||||
(let
|
||||
((attr-val (trampoline (eval-expr attr-expr env))))
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -292,7 +292,7 @@
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set)
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(list
|
||||
@@ -344,7 +344,7 @@
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set)
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(list
|
||||
@@ -815,6 +815,18 @@
|
||||
(nth ast 1)))))
|
||||
((= head (quote remove-element))
|
||||
(list (quote dom-remove) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote empty-target))
|
||||
(list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote swap!))
|
||||
(let
|
||||
((lhs (nth ast 1)) (rhs (nth ast 2)))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote _swap_tmp) (hs-to-sx lhs)))
|
||||
(list
|
||||
(quote do)
|
||||
(emit-set lhs (hs-to-sx rhs))
|
||||
(emit-set rhs (quote _swap_tmp))))))
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1422,6 +1422,21 @@
|
||||
(let
|
||||
((end-pos (skip-to-close 0)))
|
||||
(substring src start-pos end-pos)))))
|
||||
(define
|
||||
parse-empty-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote sym) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote sym) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((lhs (parse-expr)))
|
||||
(match-kw "with")
|
||||
(let ((rhs (parse-expr))) (list (quote swap!) lhs rhs)))))
|
||||
(define
|
||||
parse-cmd
|
||||
(fn
|
||||
@@ -1503,6 +1518,12 @@
|
||||
(do (adv!) (parse-halt-cmd)))
|
||||
((and (= typ "keyword") (= val "focus"))
|
||||
(do (adv!) (parse-focus-cmd)))
|
||||
((and (= typ "keyword") (= val "empty"))
|
||||
(do (adv!) (parse-empty-cmd)))
|
||||
((and (= typ "keyword") (= val "clear"))
|
||||
(do (adv!) (parse-empty-cmd)))
|
||||
((and (= typ "keyword") (= val "swap"))
|
||||
(do (adv!) (parse-swap-cmd)))
|
||||
(true (parse-expr))))))
|
||||
(define
|
||||
parse-cmd-list
|
||||
@@ -1548,7 +1569,10 @@
|
||||
(= v "scroll")
|
||||
(= v "select")
|
||||
(= v "reset")
|
||||
(= v "focus"))))
|
||||
(= v "focus")
|
||||
(= v "empty")
|
||||
(= v "clear")
|
||||
(= v "swap"))))
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -444,10 +444,31 @@
|
||||
((dict? v) (= (len (keys v)) 0))
|
||||
(true false))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
(define
|
||||
hs-empty-target!
|
||||
(fn
|
||||
(target)
|
||||
(cond
|
||||
((list? target) (for-each (fn (el) (hs-empty-target! el)) target))
|
||||
((nil? target) nil)
|
||||
(true
|
||||
(let
|
||||
((tag (dom-get-prop target "tagName")))
|
||||
(cond
|
||||
((or (= tag "INPUT") (= tag "TEXTAREA"))
|
||||
(let
|
||||
((input-type (dom-get-prop target "type")))
|
||||
(if
|
||||
(or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop target "checked" false)
|
||||
(dom-set-prop target "value" ""))))
|
||||
((= tag "FORM") (dom-set-inner-html target ""))
|
||||
(true (dom-set-inner-html target ""))))))))
|
||||
;; Collection: sorted by
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
;; Collection: sorted by descending
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-template
|
||||
(fn
|
||||
@@ -533,7 +554,7 @@
|
||||
(set! i (+ i 1))
|
||||
(tpl-loop)))))))
|
||||
(do (tpl-loop) result))))
|
||||
;; Collection: split by
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-make-object
|
||||
(fn
|
||||
@@ -545,7 +566,7 @@
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
pairs)
|
||||
d))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-method-call
|
||||
(fn
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -117,6 +117,8 @@
|
||||
"last"
|
||||
"random"
|
||||
"empty"
|
||||
"clear"
|
||||
"swap"
|
||||
"exists"
|
||||
"matches"
|
||||
"contains"
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1020,6 +1020,7 @@
|
||||
"hs-contains?",
|
||||
"precedes?",
|
||||
"hs-empty?",
|
||||
"hs-empty-target!",
|
||||
"hs-first",
|
||||
"hs-last",
|
||||
"hs-template",
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
;; Test: add :ref callback
|
||||
;; Pretext island — full version with :ref (bug fix applied)
|
||||
(defisland
|
||||
~pretext-demo/live
|
||||
()
|
||||
@@ -7,38 +7,104 @@
|
||||
(mxw (signal 500))
|
||||
(font-size (signal 16))
|
||||
(use-optimal (signal true))
|
||||
(result (signal "loading..."))
|
||||
(el-ref (signal nil))
|
||||
(doc (host-global "document"))
|
||||
(canvas (host-call doc "createElement" "canvas"))
|
||||
(ctx (host-call canvas "getContext" "2d")))
|
||||
(ctx (host-call canvas "getContext" "2d"))
|
||||
(el-ref (signal nil)))
|
||||
(effect
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((w (deref mxw))
|
||||
((el (deref el-ref))
|
||||
(w (deref mxw))
|
||||
(sz (deref font-size))
|
||||
(opt (deref use-optimal)))
|
||||
(host-set! ctx "font" (str sz "px serif"))
|
||||
(let
|
||||
((widths (map (fn (wd) (host-get (host-call ctx "measureText" wd) "width")) words))
|
||||
(spw (host-get (host-call ctx "measureText" " ") "width")))
|
||||
(when
|
||||
el
|
||||
(let
|
||||
((ranges (if opt (break-lines widths spw w) (break-lines-greedy widths spw w))))
|
||||
((lh (* sz 1.5)))
|
||||
(host-set!
|
||||
ctx
|
||||
"font"
|
||||
(str sz "px 'Pretext Serif', DejaVu Serif, serif"))
|
||||
(let
|
||||
((lines (pretext-layout-lines words widths ranges spw w (* sz 1.5))))
|
||||
(reset!
|
||||
result
|
||||
(str
|
||||
(len lines)
|
||||
" lines — "
|
||||
w
|
||||
"px / "
|
||||
sz
|
||||
"px / "
|
||||
(if opt "optimal" "greedy")))))))))
|
||||
((widths (map (fn (wd) (host-get (host-call ctx "measureText" wd) "width")) words))
|
||||
(spw (host-get (host-call ctx "measureText" " ") "width")))
|
||||
(let
|
||||
((ranges (if opt (break-lines widths spw w) (break-lines-greedy widths spw w)))
|
||||
(lines
|
||||
(pretext-layout-lines
|
||||
words
|
||||
widths
|
||||
(if
|
||||
opt
|
||||
(break-lines widths spw w)
|
||||
(break-lines-greedy widths spw w))
|
||||
spw
|
||||
w
|
||||
lh)))
|
||||
(host-set! el "innerHTML" "")
|
||||
(let
|
||||
((info (host-call doc "createElement" "div")))
|
||||
(host-set! info "className" "px-4 pt-3 pb-1")
|
||||
(host-set!
|
||||
info
|
||||
"innerHTML"
|
||||
(str
|
||||
"<span class='text-xs font-medium uppercase tracking-wide text-stone-400'>"
|
||||
(len lines)
|
||||
" lines — "
|
||||
w
|
||||
"px / "
|
||||
sz
|
||||
"px / "
|
||||
(if opt "optimal" "greedy")
|
||||
"</span>"))
|
||||
(host-call el "appendChild" info))
|
||||
(let
|
||||
((container (host-call doc "createElement" "div")))
|
||||
(host-set!
|
||||
container
|
||||
"style"
|
||||
(str
|
||||
"position:relative;height:"
|
||||
(* (len lines) lh)
|
||||
"px;padding:12px 16px"))
|
||||
(let
|
||||
render-lines
|
||||
((li 0))
|
||||
(when
|
||||
(< li (len lines))
|
||||
(let
|
||||
((line (nth lines li))
|
||||
(wds (get (nth lines li) :words)))
|
||||
(let
|
||||
render-words
|
||||
((wi 0))
|
||||
(when
|
||||
(< wi (len wds))
|
||||
(let
|
||||
((pw (nth wds wi))
|
||||
(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 container "appendChild" span)
|
||||
(render-words (+ wi 1))))))
|
||||
(render-lines (+ li 1))))
|
||||
(host-call el "appendChild" container)))))))))
|
||||
(div
|
||||
(~tw :tokens "p-4 border rounded space-y-2")
|
||||
(~tw :tokens "space-y-4")
|
||||
(div
|
||||
(~tw :tokens "flex flex-wrap gap-4 items-end")
|
||||
(div
|
||||
@@ -77,5 +143,7 @@
|
||||
(~tw :tokens "px-3 py-1 rounded border text-sm")
|
||||
:on-click (fn (e) (reset! use-optimal (not (deref use-optimal))))
|
||||
(if (deref use-optimal) "Knuth-Plass" "Greedy"))))
|
||||
(div (deref result))
|
||||
(div :ref (fn (el) (reset! el-ref el)) ""))))
|
||||
(div
|
||||
:class "rounded-lg border border-stone-200 bg-white overflow-hidden"
|
||||
:ref (fn (el) (reset! el-ref el))
|
||||
""))))
|
||||
@@ -342,7 +342,7 @@
|
||||
(= attr-name "ref")
|
||||
(let
|
||||
((attr-val (trampoline (eval-expr attr-expr env))))
|
||||
(dict-set! attr-val "current" el))
|
||||
(if (callable? attr-val) (attr-val el) (dict-set! attr-val "current" el)))
|
||||
(= attr-name "key")
|
||||
(let
|
||||
((attr-val (trampoline (eval-expr attr-expr env))))
|
||||
|
||||
Reference in New Issue
Block a user