Step 17b: bytecode-compiled text-layout, WASM library import fix
- text-layout.sx added to WASM bytecode pipeline (9K compiled) - Fix multi-list map calls (map-indexed + nth instead of map fn list1 list2) - pretext-layout-lines and pretext-position-line moved to library exports - Browser load-sxbc: handle VmSuspended for import, copy library exports to global_env after module load (define-library export fix) - compile-modules.js: text-layout in SOURCE_MAP, FILES, and entry deps - Island uses library functions (break-lines, pretext-layout-lines) instead of inlining — runs on bytecode VM when exports resolve Known issue: define-library exports don't propagate to browser global env yet. The load-sxbc import suspension handler resumes correctly but bind_import_set doesn't fire. Needs deeper investigation into how the WASM kernel's define-library registers exports vs how other libraries (adapter-html, tw) make their exports available. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -47,6 +47,7 @@ const SOURCE_MAP = {
|
||||
'engine.sx': 'web/engine.sx', 'orchestration.sx': 'web/orchestration.sx',
|
||||
'boot.sx': 'web/boot.sx',
|
||||
'tw-layout.sx': 'web/tw-layout.sx', 'tw-type.sx': 'web/tw-type.sx', 'tw.sx': 'web/tw.sx',
|
||||
'text-layout.sx': 'lib/text-layout.sx',
|
||||
};
|
||||
let synced = 0;
|
||||
for (const [dist, src] of Object.entries(SOURCE_MAP)) {
|
||||
@@ -79,6 +80,7 @@ const FILES = [
|
||||
'page-helpers.sx', 'freeze.sx', 'bytecode.sx', 'compiler.sx', 'vm.sx',
|
||||
'dom.sx', 'browser.sx', 'adapter-html.sx', 'adapter-sx.sx', 'adapter-dom.sx',
|
||||
'tw-layout.sx', 'tw-type.sx', 'tw.sx',
|
||||
'text-layout.sx',
|
||||
'boot-helpers.sx', 'hypersx.sx', 'harness.sx', 'harness-reactive.sx',
|
||||
'harness-web.sx', 'engine.sx', 'orchestration.sx',
|
||||
// Hyperscript modules — loaded on demand via transparent lazy loader
|
||||
@@ -478,6 +480,10 @@ if (entryFile) {
|
||||
for (const m of HS_LAZY) {
|
||||
if (manifest[m] && !lazyDeps.includes(m)) lazyDeps.push(m);
|
||||
}
|
||||
// Text layout library — loaded eagerly for Pretext island
|
||||
if (manifest['sx text-layout'] && !eagerDeps.includes('sx text-layout')) {
|
||||
eagerDeps.push('sx text-layout');
|
||||
}
|
||||
manifest['_entry'] = {
|
||||
file: entryFile.file,
|
||||
deps: eagerDeps,
|
||||
|
||||
@@ -685,8 +685,45 @@ let () =
|
||||
in
|
||||
let module_val = convert_code code_form in
|
||||
let code = Sx_vm.code_from_value module_val in
|
||||
let _result = Sx_vm.execute_module code _vm_globals in
|
||||
(* Use execute_module_safe to handle import suspension.
|
||||
Libraries compiled from define-library + import emit OP_PERFORM
|
||||
at the end; we catch and resolve the import inline. *)
|
||||
let run_module c =
|
||||
let rec handle_result r =
|
||||
match r with
|
||||
| Ok _result -> ()
|
||||
| Error (request, saved_vm) ->
|
||||
(* Import suspension — library body already ran and registered.
|
||||
Copy exports to global env, then resume the VM. *)
|
||||
let lib_spec = Sx_runtime.get_val request (String "library") in
|
||||
(try ignore (Sx_ref.bind_import_set lib_spec (Env global_env))
|
||||
with _ -> ());
|
||||
let next = try Ok (Sx_vm.resume_vm saved_vm Nil)
|
||||
with Sx_vm.VmSuspended (req2, vm2) -> Error (req2, vm2) in
|
||||
handle_result next
|
||||
in
|
||||
handle_result (Sx_vm.execute_module_safe c _vm_globals)
|
||||
in
|
||||
run_module code;
|
||||
sync_vm_to_env ();
|
||||
(* After loading, copy any new library exports to global env.
|
||||
define-library registers exports in _library_registry_;
|
||||
the import OP_PERFORM can't execute bind_import_set in bytecode,
|
||||
so we manually copy exports that aren't yet in global_env. *)
|
||||
(match Sx_ref._library_registry_ with
|
||||
| Dict registry ->
|
||||
Hashtbl.iter (fun _key entry ->
|
||||
(match Sx_runtime.get_val entry (String "exports") with
|
||||
| Dict exports ->
|
||||
Hashtbl.iter (fun name value ->
|
||||
if not (Sx_types.env_has global_env name) then begin
|
||||
ignore (Sx_types.env_bind global_env name value);
|
||||
Hashtbl.replace _vm_globals name value
|
||||
end
|
||||
) exports
|
||||
| _ -> ())
|
||||
) registry
|
||||
| _ -> ());
|
||||
Number (float_of_int (Hashtbl.length _vm_globals))
|
||||
| _ -> raise (Eval_error "load-sxbc: expected (sxbc version hash (code ...))"));
|
||||
|
||||
|
||||
@@ -314,7 +314,10 @@
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote set!)
|
||||
t
|
||||
(list (quote +) (list (quote or) t 0) amount)))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -363,7 +366,10 @@
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote set!)
|
||||
t
|
||||
(list (quote -) (list (quote or) t 0) amount)))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -801,8 +807,23 @@
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||
(nth ast 1)))))
|
||||
((= head (quote remove-element))
|
||||
(list (quote dom-remove) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
(list (quote dom-remove-attr) tgt (nth ast 1))))
|
||||
((= head (quote remove-css))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
|
||||
(props (nth ast 1)))
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn (p) (list (quote dom-set-style) tgt p ""))
|
||||
props))))
|
||||
((= head (quote toggle-class))
|
||||
(list
|
||||
(quote hs-toggle-class!)
|
||||
|
||||
@@ -727,30 +727,68 @@
|
||||
parse-remove-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")) (extra-classes (list)))
|
||||
(define
|
||||
collect-classes!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(= (tp-type) "class")
|
||||
(set!
|
||||
extra-classes
|
||||
(append extra-classes (list (get (adv!) "value"))))
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
||||
((cls (get (adv!) "value")) (extra-classes (list)))
|
||||
(define
|
||||
collect-classes!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(= (tp-type) "class")
|
||||
(set!
|
||||
extra-classes
|
||||
(append extra-classes (list (get (adv!) "value"))))
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes)))))))
|
||||
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes))))))
|
||||
nil)))
|
||||
(= (tp-type) "attr")
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(match-kw "]")
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(list (quote remove-attr) attr-name tgt)))
|
||||
nil)))
|
||||
((= (tp-val) "{")
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((props (list)))
|
||||
(define
|
||||
collect-props!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(not (= (tp-val) "}"))
|
||||
(when (= (tp-val) ";") (adv!))
|
||||
(when
|
||||
(not (= (tp-val) "}"))
|
||||
(set!
|
||||
props
|
||||
(append props (list (get (adv!) "value"))))
|
||||
(collect-props!)))))
|
||||
(collect-props!)
|
||||
(match-kw "}")
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(list (quote remove-css) props tgt)))))
|
||||
(true
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote remove-element) target))))))
|
||||
(define
|
||||
parse-toggle-cmd
|
||||
(fn
|
||||
@@ -1168,6 +1206,7 @@
|
||||
()
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(match-kw "then")
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
|
||||
@@ -13,6 +13,21 @@
|
||||
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
||||
;; Liang's hyphenation (trie over character patterns).
|
||||
|
||||
(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)})))))))
|
||||
|
||||
(define-library
|
||||
(sx text-layout)
|
||||
(export
|
||||
@@ -25,6 +40,8 @@
|
||||
break-lines-greedy
|
||||
position-line
|
||||
position-lines
|
||||
pretext-position-line
|
||||
pretext-layout-lines
|
||||
layout-paragraph
|
||||
make-hyphenation-trie
|
||||
find-hyphenation-points
|
||||
@@ -131,7 +148,7 @@
|
||||
((starts (cons 0 breaks)))
|
||||
(let
|
||||
((ends (append (rest starts) (list n))))
|
||||
(map (fn (s e) (list s e)) starts ends)))))))
|
||||
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
||||
(define
|
||||
position-line
|
||||
(fn
|
||||
@@ -266,7 +283,7 @@
|
||||
(let
|
||||
((starts (cons 0 points))
|
||||
(ends (append points (list (len word)))))
|
||||
(map (fn (s e) (slice word s e)) starts ends))))))
|
||||
(map-indexed (fn (i s) (slice word s (nth ends i))) starts))))))
|
||||
(define
|
||||
layout-paragraph
|
||||
(fn
|
||||
|
||||
@@ -314,7 +314,10 @@
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote set!)
|
||||
t
|
||||
(list (quote +) (list (quote or) t 0) amount)))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -363,7 +366,10 @@
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote set!)
|
||||
t
|
||||
(list (quote -) (list (quote or) t 0) amount)))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -801,8 +807,23 @@
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||
(nth ast 1)))))
|
||||
((= head (quote remove-element))
|
||||
(list (quote dom-remove) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
(list (quote dom-remove-attr) tgt (nth ast 1))))
|
||||
((= head (quote remove-css))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
|
||||
(props (nth ast 1)))
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn (p) (list (quote dom-set-style) tgt p ""))
|
||||
props))))
|
||||
((= head (quote toggle-class))
|
||||
(list
|
||||
(quote hs-toggle-class!)
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -727,30 +727,68 @@
|
||||
parse-remove-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")) (extra-classes (list)))
|
||||
(define
|
||||
collect-classes!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(= (tp-type) "class")
|
||||
(set!
|
||||
extra-classes
|
||||
(append extra-classes (list (get (adv!) "value"))))
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
||||
((cls (get (adv!) "value")) (extra-classes (list)))
|
||||
(define
|
||||
collect-classes!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(= (tp-type) "class")
|
||||
(set!
|
||||
extra-classes
|
||||
(append extra-classes (list (get (adv!) "value"))))
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes)))))))
|
||||
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes))))))
|
||||
nil)))
|
||||
(= (tp-type) "attr")
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(match-kw "]")
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(list (quote remove-attr) attr-name tgt)))
|
||||
nil)))
|
||||
((= (tp-val) "{")
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((props (list)))
|
||||
(define
|
||||
collect-props!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(not (= (tp-val) "}"))
|
||||
(when (= (tp-val) ";") (adv!))
|
||||
(when
|
||||
(not (= (tp-val) "}"))
|
||||
(set!
|
||||
props
|
||||
(append props (list (get (adv!) "value"))))
|
||||
(collect-props!)))))
|
||||
(collect-props!)
|
||||
(match-kw "}")
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(list (quote remove-css) props tgt)))))
|
||||
(true
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote remove-element) target))))))
|
||||
(define
|
||||
parse-toggle-cmd
|
||||
(fn
|
||||
@@ -1168,6 +1206,7 @@
|
||||
()
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(match-kw "then")
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -618,6 +618,29 @@
|
||||
"tw-process-token"
|
||||
]
|
||||
},
|
||||
"sx text-layout": {
|
||||
"file": "text-layout.sxbc",
|
||||
"deps": [],
|
||||
"exports": [
|
||||
"measure-text",
|
||||
"line-badness",
|
||||
"compute-demerits",
|
||||
"sum-widths",
|
||||
"find-breaks",
|
||||
"break-lines",
|
||||
"break-lines-greedy",
|
||||
"position-line",
|
||||
"position-lines",
|
||||
"pretext-position-line",
|
||||
"pretext-layout-lines",
|
||||
"layout-paragraph",
|
||||
"make-hyphenation-trie",
|
||||
"find-hyphenation-points",
|
||||
"hyphenate-word",
|
||||
"typeset",
|
||||
"typeset-plain"
|
||||
]
|
||||
},
|
||||
"web boot-helpers": {
|
||||
"file": "boot-helpers.sxbc",
|
||||
"deps": [
|
||||
@@ -1039,7 +1062,8 @@
|
||||
"web router",
|
||||
"web page-helpers",
|
||||
"web orchestration",
|
||||
"sx render"
|
||||
"sx render",
|
||||
"sx text-layout"
|
||||
],
|
||||
"lazy_deps": [
|
||||
"sx bytecode",
|
||||
|
||||
357
shared/static/wasm/sx/text-layout.sx
Normal file
357
shared/static/wasm/sx/text-layout.sx
Normal file
@@ -0,0 +1,357 @@
|
||||
;; Pretext — DOM-free text layout (pure SX)
|
||||
;;
|
||||
;; Cheng Lou's insight: text measurement is IO, but text *layout* is
|
||||
;; pure arithmetic. One `perform` for glyph metrics, everything else
|
||||
;; is deterministic functions over numbers.
|
||||
;;
|
||||
;; Architecture:
|
||||
;; (perform (text-measure :font font :size size :text text))
|
||||
;; → {:widths (...) :height N :ascent N :descent N}
|
||||
;;
|
||||
;; break-lines, position-glyphs, hyphenate — all pure SX.
|
||||
;;
|
||||
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
||||
;; Liang's hyphenation (trie over character patterns).
|
||||
|
||||
(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)})))))))
|
||||
|
||||
(define-library
|
||||
(sx text-layout)
|
||||
(export
|
||||
measure-text
|
||||
line-badness
|
||||
compute-demerits
|
||||
sum-widths
|
||||
find-breaks
|
||||
break-lines
|
||||
break-lines-greedy
|
||||
position-line
|
||||
position-lines
|
||||
pretext-position-line
|
||||
pretext-layout-lines
|
||||
layout-paragraph
|
||||
make-hyphenation-trie
|
||||
find-hyphenation-points
|
||||
hyphenate-word
|
||||
typeset
|
||||
typeset-plain)
|
||||
(begin
|
||||
(define
|
||||
measure-text
|
||||
(fn
|
||||
(font size text)
|
||||
(perform (list (quote text-measure) font size text))))
|
||||
(define
|
||||
line-badness
|
||||
(fn
|
||||
(used max-width)
|
||||
(let
|
||||
((slack (- max-width used)))
|
||||
(if
|
||||
(< slack 0)
|
||||
100000
|
||||
(let
|
||||
((ratio (/ slack max-width)))
|
||||
(* (* ratio ratio) (* ratio 1000)))))))
|
||||
(define
|
||||
compute-demerits
|
||||
(fn
|
||||
(badness penalty)
|
||||
(let
|
||||
((base (+ 1 badness)))
|
||||
(+ (* base base) (* penalty penalty)))))
|
||||
(define
|
||||
sum-widths
|
||||
(fn
|
||||
(widths space-width from to)
|
||||
(let
|
||||
loop
|
||||
((k from) (total 0))
|
||||
(if
|
||||
(>= k to)
|
||||
(let
|
||||
((spaces (max 0 (- (- to from) 1))))
|
||||
(+ total (* spaces space-width)))
|
||||
(loop (+ k 1) (+ total (nth widths k)))))))
|
||||
(define
|
||||
find-breaks
|
||||
(fn
|
||||
(widths space-width max-width)
|
||||
(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-widths widths space-width i (+ j 1))))
|
||||
(when
|
||||
(<= used (* max-width 1.15))
|
||||
(let
|
||||
((bad (line-badness used max-width))
|
||||
(penalty 0))
|
||||
(let
|
||||
((cost (+ prev-cost (compute-demerits bad penalty)))
|
||||
(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
|
||||
trace
|
||||
((pos n) (breaks (list)))
|
||||
(let
|
||||
((prev (nth (nth dp pos) 1)))
|
||||
(if (<= prev 0) breaks (trace prev (cons prev breaks))))))))))
|
||||
(define
|
||||
break-lines
|
||||
(fn
|
||||
(widths space-width max-width)
|
||||
(let
|
||||
((breaks (find-breaks widths space-width max-width))
|
||||
(n (len widths)))
|
||||
(if
|
||||
(= n 0)
|
||||
(list)
|
||||
(let
|
||||
((starts (cons 0 breaks)))
|
||||
(let
|
||||
((ends (append (rest starts) (list n))))
|
||||
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
||||
(define
|
||||
position-line
|
||||
(fn
|
||||
(words widths space-width x0 y)
|
||||
(let
|
||||
loop
|
||||
((i 0) (x x0) (result (list)))
|
||||
(if
|
||||
(>= i (len words))
|
||||
(reverse result)
|
||||
(let
|
||||
((w (nth words i)) (width (nth widths i)))
|
||||
(loop
|
||||
(+ i 1)
|
||||
(+ x width space-width)
|
||||
(cons {:width width :x x :y y :word w} result)))))))
|
||||
(define
|
||||
position-lines
|
||||
(fn
|
||||
(words widths line-ranges space-width line-height x0 y0)
|
||||
(map-indexed
|
||||
(fn
|
||||
(line-idx range)
|
||||
(let
|
||||
((start (first range))
|
||||
(end (nth range 1))
|
||||
(y (+ y0 (* line-idx line-height))))
|
||||
(let
|
||||
((line-words (slice words start end))
|
||||
(line-widths (slice widths start end)))
|
||||
(position-line line-words line-widths space-width x0 y))))
|
||||
line-ranges)))
|
||||
(define
|
||||
make-hyphenation-trie
|
||||
(fn
|
||||
(patterns)
|
||||
(let
|
||||
((trie {:children {} :levels (list)}))
|
||||
(for-each
|
||||
(fn
|
||||
(pattern)
|
||||
(let
|
||||
((chars (list)) (levels (list)) (current-level 0))
|
||||
(for-each
|
||||
(fn
|
||||
(ch)
|
||||
(if
|
||||
(and (>= (char-code ch) 48) (<= (char-code ch) 57))
|
||||
(set! current-level (parse-number ch))
|
||||
(do
|
||||
(set! chars (append chars (list ch)))
|
||||
(set! levels (append levels (list current-level)))
|
||||
(set! current-level 0))))
|
||||
(map (fn (i) (char-at pattern i)) (range (len pattern))))
|
||||
(set! levels (append levels (list current-level)))
|
||||
(let
|
||||
insert
|
||||
((node trie) (i 0))
|
||||
(if
|
||||
(>= i (len chars))
|
||||
(dict-set! node :levels levels)
|
||||
(let
|
||||
((ch (nth chars i)) (children (get node :children)))
|
||||
(when
|
||||
(not (has-key? children ch))
|
||||
(dict-set! children ch {:children {} :levels (list)}))
|
||||
(insert (get children ch) (+ i 1)))))))
|
||||
patterns)
|
||||
trie)))
|
||||
(define
|
||||
find-hyphenation-points
|
||||
(fn
|
||||
(trie word)
|
||||
(let
|
||||
((n (len word))
|
||||
(padded (str "." word "."))
|
||||
(pn (+ n 2))
|
||||
(levels (map (fn (_) 0) (range (+ n 1)))))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
walk
|
||||
((node trie) (j i))
|
||||
(when
|
||||
(< j pn)
|
||||
(let
|
||||
((ch (char-at padded j))
|
||||
(children (get node :children)))
|
||||
(when
|
||||
(has-key? children ch)
|
||||
(let
|
||||
((child (get children ch)))
|
||||
(when
|
||||
(not (empty? (get child :levels)))
|
||||
(let
|
||||
((pat-levels (get child :levels)))
|
||||
(for-each
|
||||
(fn
|
||||
(k)
|
||||
(when
|
||||
(< (+ i k) (+ n 1))
|
||||
(let
|
||||
((old (nth levels (+ i k)))
|
||||
(new-val (nth pat-levels k)))
|
||||
(when
|
||||
(> new-val old)
|
||||
(set!
|
||||
levels
|
||||
(map-indexed
|
||||
(fn
|
||||
(idx v)
|
||||
(if (= idx (+ i k)) new-val v))
|
||||
levels))))))
|
||||
(range (len pat-levels)))))
|
||||
(walk child (+ j 1))))))))
|
||||
(range pn))
|
||||
(filter
|
||||
(fn
|
||||
(i)
|
||||
(and (> i 1) (< i (- n 1)) (= (mod (nth levels i) 2) 1)))
|
||||
(range (+ n 1))))))
|
||||
(define
|
||||
hyphenate-word
|
||||
(fn
|
||||
(trie word)
|
||||
(let
|
||||
((points (find-hyphenation-points trie word)))
|
||||
(if
|
||||
(empty? points)
|
||||
(list word)
|
||||
(let
|
||||
((starts (cons 0 points))
|
||||
(ends (append points (list (len word)))))
|
||||
(map-indexed (fn (i s) (slice word s (nth ends i))) starts))))))
|
||||
(define
|
||||
layout-paragraph
|
||||
(fn
|
||||
(words font size max-width line-height-factor)
|
||||
(let
|
||||
((metrics (map (fn (w) (measure-text font size w)) words))
|
||||
(widths (map (fn (m) (get m :width)) metrics))
|
||||
(height
|
||||
(if (empty? metrics) size (get (first metrics) :height)))
|
||||
(line-height (* height (or line-height-factor 1.4)))
|
||||
(space-metrics (measure-text font size " "))
|
||||
(space-width (get space-metrics :width)))
|
||||
(let
|
||||
((line-ranges (break-lines widths space-width max-width))
|
||||
(positioned
|
||||
(position-lines
|
||||
words
|
||||
widths
|
||||
(break-lines widths space-width max-width)
|
||||
space-width
|
||||
line-height
|
||||
0
|
||||
0)))
|
||||
{:lines positioned :width max-width :line-height line-height :font-height height :line-ranges line-ranges :height (* (len line-ranges) line-height)}))))
|
||||
(define
|
||||
typeset-plain
|
||||
(fn
|
||||
(text font size max-width)
|
||||
(let
|
||||
((words (split text " ")))
|
||||
(layout-paragraph words font size max-width 1.4))))
|
||||
(define
|
||||
typeset
|
||||
(fn
|
||||
(text &key font size max-width line-height)
|
||||
(let
|
||||
((words (split text " "))
|
||||
(f (or font "serif"))
|
||||
(s (or size 16))
|
||||
(w (or max-width 600))
|
||||
(lh (or line-height 1.4)))
|
||||
(layout-paragraph words f s w lh))))))
|
||||
|
||||
(define
|
||||
break-lines-greedy
|
||||
(fn
|
||||
(widths space-width max-width)
|
||||
(let
|
||||
((n (len widths)))
|
||||
(if
|
||||
(= n 0)
|
||||
(list)
|
||||
(let
|
||||
((lines (list)) (start 0) (used 0))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((w (nth widths i))
|
||||
(needed (if (= i start) w (+ used space-width w))))
|
||||
(if
|
||||
(and (> needed max-width) (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))))))))
|
||||
|
||||
(import (sx text-layout))
|
||||
3
shared/static/wasm/sx/text-layout.sxbc
Normal file
3
shared/static/wasm/sx/text-layout.sxbc
Normal file
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1792,7 +1792,7 @@
|
||||
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
|
||||
}
|
||||
(globalThis))
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-982ed992",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-acaac3c1",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-80a20737",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-08c26bf2",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
|
||||
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
|
||||
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,7 +1,7 @@
|
||||
;; 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.
|
||||
;; Calls break-lines/break-lines-greedy from lib/text-layout.sx (bytecode-compiled).
|
||||
|
||||
(defisland
|
||||
~pretext-demo/live
|
||||
@@ -16,91 +16,9 @@
|
||||
(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)))))))
|
||||
((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")))))
|
||||
(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))))))))))
|
||||
((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)) (lh (* sz 1.5))) (let ((ranges (if optimal (break-lines widths sw mw) (break-lines-greedy widths sw mw)))) (pretext-layout-lines words widths ranges sw mw lh))))))))
|
||||
(div
|
||||
(~tw :tokens "space-y-4")
|
||||
(div
|
||||
|
||||
@@ -198,23 +198,54 @@ def parse_checks(check):
|
||||
|
||||
all_checks.append(('skip', part[:60], None, None))
|
||||
|
||||
# Deduplicate: keep last per (type, name, key)
|
||||
# Deduplicate: keep last per (element, property).
|
||||
# Pre-action and post-action assertions for the same property get the same key,
|
||||
# so only the post-action assertion (the last one) survives.
|
||||
seen = {}
|
||||
for c in all_checks:
|
||||
key = (c[0], c[1], c[2] if c[0] == 'class' else None)
|
||||
typ, name = c[0], c[1]
|
||||
if typ in ('class',):
|
||||
key = (name, 'class', c[2])
|
||||
elif typ in ('innerHTML', 'textContent'):
|
||||
key = (name, 'content')
|
||||
elif typ in ('style', 'computedStyle'):
|
||||
key = (name, 'style', c[2])
|
||||
elif typ in ('attr', 'hasAttr'):
|
||||
key = (name, 'attr', c[2])
|
||||
elif typ in ('noParent', 'hasParent'):
|
||||
key = (name, 'parent')
|
||||
elif typ in ('value',):
|
||||
key = (name, 'value')
|
||||
else:
|
||||
key = (typ, name, c[2])
|
||||
seen[key] = c
|
||||
|
||||
return list(seen.values())
|
||||
|
||||
|
||||
def make_ref_fn(elements, var_names):
|
||||
"""Create a ref function that maps upstream JS variable names to SX let-bound variables."""
|
||||
tag_to_var = {}
|
||||
"""Create a ref function that maps upstream JS variable names to SX let-bound variables.
|
||||
|
||||
Upstream naming conventions:
|
||||
- div, form, button, select — first element of that tag type
|
||||
- d1, d2, d3 — elements by position (1-indexed)
|
||||
- div1, div2, div3 — divs by position among same tag (1-indexed)
|
||||
- bar, btn, A, B — elements by ID
|
||||
"""
|
||||
# Map tag → first UNNAMED element of that tag (no id)
|
||||
tag_to_unnamed = {}
|
||||
# Map tag → list of vars for elements of that tag (ordered)
|
||||
tag_to_all = {}
|
||||
id_to_var = {}
|
||||
last_var = var_names[-1] if var_names else '_el-div'
|
||||
first_var = var_names[0] if var_names else '_el-div'
|
||||
|
||||
for i, el in enumerate(elements):
|
||||
tag_to_var[el['tag']] = var_names[i]
|
||||
tag = el['tag']
|
||||
if tag not in tag_to_unnamed and not el['id']:
|
||||
tag_to_unnamed[tag] = var_names[i]
|
||||
if tag not in tag_to_all:
|
||||
tag_to_all[tag] = []
|
||||
tag_to_all[tag].append(var_names[i])
|
||||
if el['id']:
|
||||
id_to_var[el['id']] = var_names[i]
|
||||
|
||||
@@ -223,12 +254,42 @@ def make_ref_fn(elements, var_names):
|
||||
'output'}
|
||||
|
||||
def ref(name):
|
||||
if name in tags:
|
||||
return tag_to_var.get(name, last_var)
|
||||
# Exact ID match first
|
||||
if name in id_to_var:
|
||||
return id_to_var[name]
|
||||
if re.match(r'^[a-z]+\d*$', name) and len(elements) > 0:
|
||||
return last_var
|
||||
|
||||
# Bare tag name → first UNNAMED element of that tag (upstream convention:
|
||||
# named elements use their ID, unnamed use their tag)
|
||||
if name in tags:
|
||||
if name in tag_to_unnamed:
|
||||
return tag_to_unnamed[name]
|
||||
# Fallback: first element of that tag (even if named)
|
||||
return tag_to_all.get(name, [first_var])[0]
|
||||
|
||||
# Tag + number: div1→1st div, div2→2nd div, form1→1st form, etc.
|
||||
m = re.match(r'^([a-z]+)(\d+)$', name)
|
||||
if m:
|
||||
tag_part, num = m.group(1), int(m.group(2))
|
||||
if tag_part in tag_to_all:
|
||||
idx = num - 1 # 1-indexed
|
||||
if 0 <= idx < len(tag_to_all[tag_part]):
|
||||
return tag_to_all[tag_part][idx]
|
||||
|
||||
# Positional: d1→1st element, d2→2nd, d3→3rd, etc.
|
||||
m = re.match(r'^d(\d+)$', name)
|
||||
if m:
|
||||
idx = int(m.group(1)) - 1 # 1-indexed
|
||||
if 0 <= idx < len(var_names):
|
||||
return var_names[idx]
|
||||
|
||||
# Short aliases: btn → look up as ID
|
||||
if name == 'btn':
|
||||
return id_to_var.get('btn', tag_to_unnamed.get('button', first_var))
|
||||
|
||||
# Single-letter or short lowercase → try as ID, fallback to first element
|
||||
if re.match(r'^[a-z]+$', name) and len(elements) > 0:
|
||||
return first_var
|
||||
|
||||
return f'(dom-query-by-id "{name}")'
|
||||
|
||||
return ref
|
||||
@@ -442,6 +503,8 @@ def emit_element_setup(lines, elements, var_names):
|
||||
# Clean up: collapse spaces, dedupe then
|
||||
hs_val = re.sub(r'\s+', ' ', hs_val)
|
||||
hs_val = re.sub(r'(then\s*)+then', 'then', hs_val)
|
||||
# Don't insert 'then' between event name and first command in 'on' handlers
|
||||
hs_val = re.sub(r'\bon (\w[\w.:+-]*) then\b', r'on \1 ', hs_val)
|
||||
hs_val = hs_val.strip()
|
||||
if not hs_val:
|
||||
lines.append(f' (dom-append (dom-body) {var})')
|
||||
|
||||
Reference in New Issue
Block a user