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:
2026-04-13 08:26:48 +00:00
parent e12ddefdff
commit e2fe070dd4
13 changed files with 171 additions and 43 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -117,6 +117,8 @@
"last"
"random"
"empty"
"clear"
"swap"
"exists"
"matches"
"contains"

File diff suppressed because one or more lines are too long

View File

@@ -1020,6 +1020,7 @@
"hs-contains?",
"precedes?",
"hs-empty?",
"hs-empty-target!",
"hs-first",
"hs-last",
"hs-template",