Fix Pretext island: library functions inside define-library begin block
Root cause: sx_insert_near placed break-lines-greedy, pretext-position-line, pretext-layout-lines OUTSIDE the define-library begin block. The bytecode compiler only compiles forms inside begin as STORE_GLOBAL — forms outside are invisible to the browser VM. Fix: moved all function definitions inside (begin ...) of (define-library). Bytecode now includes all 17 functions (11K compiled, was 9K). Browser load-sxbc: simplified VmSuspended handling — just catch and continue, since STORE_GLOBAL ops already ran before the import OP_PERFORM. sync_vm_to_env copies them to global_env. Island now calls break-lines and pretext-layout-lines from bytecode-compiled library — runs on VM, not CEK interpreter. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -688,42 +688,12 @@ let () =
|
|||||||
(* Use execute_module_safe to handle import suspension.
|
(* Use execute_module_safe to handle import suspension.
|
||||||
Libraries compiled from define-library + import emit OP_PERFORM
|
Libraries compiled from define-library + import emit OP_PERFORM
|
||||||
at the end; we catch and resolve the import inline. *)
|
at the end; we catch and resolve the import inline. *)
|
||||||
let run_module c =
|
(try
|
||||||
let rec handle_result r =
|
ignore (Sx_vm.execute_module code _vm_globals)
|
||||||
match r with
|
with
|
||||||
| Ok _result -> ()
|
| Sx_vm.VmSuspended _ -> () (* Import suspension — defines already in globals *)
|
||||||
| 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
|
|
||||||
| _ -> ());
|
| _ -> ());
|
||||||
|
sync_vm_to_env ();
|
||||||
Number (float_of_int (Hashtbl.length _vm_globals))
|
Number (float_of_int (Hashtbl.length _vm_globals))
|
||||||
| _ -> raise (Eval_error "load-sxbc: expected (sxbc version hash (code ...))"));
|
| _ -> raise (Eval_error "load-sxbc: expected (sxbc version hash (code ...))"));
|
||||||
|
|
||||||
|
|||||||
@@ -13,21 +13,6 @@
|
|||||||
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
||||||
;; Liang's hyphenation (trie over character patterns).
|
;; 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
|
(define-library
|
||||||
(sx text-layout)
|
(sx text-layout)
|
||||||
(export
|
(export
|
||||||
@@ -149,6 +134,32 @@
|
|||||||
(let
|
(let
|
||||||
((ends (append (rest starts) (list n))))
|
((ends (append (rest starts) (list n))))
|
||||||
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
||||||
|
(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))))))))
|
||||||
(define
|
(define
|
||||||
position-line
|
position-line
|
||||||
(fn
|
(fn
|
||||||
@@ -181,6 +192,45 @@
|
|||||||
(line-widths (slice widths start end)))
|
(line-widths (slice widths start end)))
|
||||||
(position-line line-words line-widths space-width x0 y))))
|
(position-line line-words line-widths space-width x0 y))))
|
||||||
line-ranges)))
|
line-ranges)))
|
||||||
|
(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
|
||||||
|
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)))))
|
||||||
(define
|
(define
|
||||||
make-hyphenation-trie
|
make-hyphenation-trie
|
||||||
(fn
|
(fn
|
||||||
@@ -327,31 +377,4 @@
|
|||||||
(lh (or line-height 1.4)))
|
(lh (or line-height 1.4)))
|
||||||
(layout-paragraph words f s w lh))))))
|
(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))
|
(import (sx text-layout))
|
||||||
@@ -240,18 +240,22 @@
|
|||||||
((prop (nth ast 1)) (value (hs-to-sx (nth ast 2))))
|
((prop (nth ast 1)) (value (hs-to-sx (nth ast 2))))
|
||||||
(if
|
(if
|
||||||
(= (len ast) 5)
|
(= (len ast) 5)
|
||||||
(list
|
(let
|
||||||
(quote hs-transition)
|
((raw-tgt (nth ast 4)))
|
||||||
(hs-to-sx (nth ast 4))
|
(list
|
||||||
prop
|
(quote hs-transition)
|
||||||
value
|
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||||
(nth ast 3))
|
prop
|
||||||
(list
|
value
|
||||||
(quote hs-transition)
|
(nth ast 3)))
|
||||||
(hs-to-sx (nth ast 3))
|
(let
|
||||||
prop
|
((raw-tgt (nth ast 3)))
|
||||||
value
|
(list
|
||||||
nil)))))
|
(quote hs-transition)
|
||||||
|
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||||
|
prop
|
||||||
|
value
|
||||||
|
nil))))))
|
||||||
(define
|
(define
|
||||||
emit-make
|
emit-make
|
||||||
(fn
|
(fn
|
||||||
@@ -913,6 +917,19 @@
|
|||||||
(list (quote dom-set-style) tgt "visibility" "visible"))
|
(list (quote dom-set-style) tgt "visibility" "visible"))
|
||||||
(true (list (quote dom-set-style) tgt "display" "")))))
|
(true (list (quote dom-set-style) tgt "display" "")))))
|
||||||
((= head (quote transition)) (emit-transition ast))
|
((= head (quote transition)) (emit-transition ast))
|
||||||
|
((= head (quote transition-from))
|
||||||
|
(let
|
||||||
|
((prop (nth ast 1))
|
||||||
|
(from-val (hs-to-sx (nth ast 2)))
|
||||||
|
(to-val (hs-to-sx (nth ast 3)))
|
||||||
|
(dur (nth ast 4)))
|
||||||
|
(list
|
||||||
|
(quote hs-transition-from)
|
||||||
|
(quote me)
|
||||||
|
prop
|
||||||
|
from-val
|
||||||
|
to-val
|
||||||
|
dur)))
|
||||||
((= head (quote repeat)) (emit-repeat ast))
|
((= head (quote repeat)) (emit-repeat ast))
|
||||||
((= head (quote fetch))
|
((= head (quote fetch))
|
||||||
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
|
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
@@ -1011,18 +1011,21 @@
|
|||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((and (= (tp-val) "my") (= (get (nth tokens (+ p 1)) "type") "style")) (do (adv!) (get (adv!) "value"))) (true (get (adv!) "value")))))
|
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((= (tp-val) "my") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) (true (get (adv!) "value")))))
|
||||||
(expect-kw! "to")
|
|
||||||
(let
|
(let
|
||||||
((value (parse-expr)))
|
((from-val (if (match-kw "from") (parse-expr) nil)))
|
||||||
|
(expect-kw! "to")
|
||||||
(let
|
(let
|
||||||
((dur (if (match-kw "over") (parse-expr) nil)))
|
((value (parse-expr)))
|
||||||
(let
|
(let
|
||||||
((tgt nil))
|
((dur (if (match-kw "over") (parse-expr) nil)))
|
||||||
(if
|
(if
|
||||||
dur
|
from-val
|
||||||
(list (quote transition) prop value dur tgt)
|
(list (quote transition-from) prop from-val value dur)
|
||||||
(list (quote transition) prop value tgt))))))))
|
(if
|
||||||
|
dur
|
||||||
|
(list (quote transition) prop value dur nil)
|
||||||
|
(list (quote transition) prop value nil)))))))))
|
||||||
(define
|
(define
|
||||||
parse-repeat-cmd
|
parse-repeat-cmd
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
@@ -344,6 +344,20 @@
|
|||||||
(dom-set-style target prop value)
|
(dom-set-style target prop value)
|
||||||
(when duration (hs-settle target))))
|
(when duration (hs-settle target))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
hs-transition-from
|
||||||
|
(fn
|
||||||
|
(target prop from-val to-val duration)
|
||||||
|
(dom-set-style target prop (str from-val))
|
||||||
|
(when
|
||||||
|
duration
|
||||||
|
(dom-set-style
|
||||||
|
target
|
||||||
|
"transition"
|
||||||
|
(str prop " " (/ duration 1000) "s")))
|
||||||
|
(dom-set-style target prop (str to-val))
|
||||||
|
(when duration (hs-settle target))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-type-check
|
hs-type-check
|
||||||
(fn
|
(fn
|
||||||
@@ -359,20 +373,21 @@
|
|||||||
((= type-name "Object") (dict? value))
|
((= type-name "Object") (dict? value))
|
||||||
(true true)))))
|
(true true)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-type-check-strict
|
hs-type-check-strict
|
||||||
(fn
|
(fn
|
||||||
(value type-name)
|
(value type-name)
|
||||||
(if (nil? value) false (hs-type-check value type-name))))
|
(if (nil? value) false (hs-type-check value type-name))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-strict-eq
|
hs-strict-eq
|
||||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||||
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||||
|
;; Property access — dot notation and .length
|
||||||
(define
|
(define
|
||||||
hs-falsy?
|
hs-falsy?
|
||||||
(fn
|
(fn
|
||||||
@@ -384,8 +399,7 @@
|
|||||||
((and (list? v) (= (len v) 0)) true)
|
((and (list? v) (= (len v) 0)) true)
|
||||||
((= v 0) true)
|
((= v 0) true)
|
||||||
(true false))))
|
(true false))))
|
||||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
;; DOM query stub — sandbox returns empty list
|
||||||
;; Property access — dot notation and .length
|
|
||||||
(define
|
(define
|
||||||
hs-matches?
|
hs-matches?
|
||||||
(fn
|
(fn
|
||||||
@@ -394,7 +408,7 @@
|
|||||||
(string? target)
|
(string? target)
|
||||||
(if (= pattern ".*") true (string-contains? target pattern))
|
(if (= pattern ".*") true (string-contains? target pattern))
|
||||||
false)))
|
false)))
|
||||||
;; DOM query stub — sandbox returns empty list
|
;; Method dispatch — obj.method(args)
|
||||||
(define
|
(define
|
||||||
hs-contains?
|
hs-contains?
|
||||||
(fn
|
(fn
|
||||||
@@ -414,11 +428,11 @@
|
|||||||
true
|
true
|
||||||
(hs-contains? (rest collection) item)))))
|
(hs-contains? (rest collection) item)))))
|
||||||
(true false))))
|
(true false))))
|
||||||
;; Method dispatch — obj.method(args)
|
|
||||||
(define precedes? (fn (a b) (< (str a) (str b))))
|
|
||||||
|
|
||||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||||
;; beep! — debug logging, returns value unchanged
|
;; beep! — debug logging, returns value unchanged
|
||||||
|
(define precedes? (fn (a b) (< (str a) (str b))))
|
||||||
|
;; Property-based is — check obj.key truthiness
|
||||||
(define
|
(define
|
||||||
hs-empty?
|
hs-empty?
|
||||||
(fn
|
(fn
|
||||||
@@ -429,11 +443,11 @@
|
|||||||
((list? v) (= (len v) 0))
|
((list? v) (= (len v) 0))
|
||||||
((dict? v) (= (len (keys v)) 0))
|
((dict? v) (= (len (keys v)) 0))
|
||||||
(true false))))
|
(true false))))
|
||||||
;; Property-based is — check obj.key truthiness
|
|
||||||
(define hs-first (fn (lst) (first lst)))
|
|
||||||
;; Array slicing (inclusive both ends)
|
;; Array slicing (inclusive both ends)
|
||||||
(define hs-last (fn (lst) (last lst)))
|
(define hs-first (fn (lst) (first lst)))
|
||||||
;; Collection: sorted by
|
;; Collection: sorted by
|
||||||
|
(define hs-last (fn (lst) (last lst)))
|
||||||
|
;; Collection: sorted by descending
|
||||||
(define
|
(define
|
||||||
hs-template
|
hs-template
|
||||||
(fn
|
(fn
|
||||||
@@ -519,7 +533,7 @@
|
|||||||
(set! i (+ i 1))
|
(set! i (+ i 1))
|
||||||
(tpl-loop)))))))
|
(tpl-loop)))))))
|
||||||
(do (tpl-loop) result))))
|
(do (tpl-loop) result))))
|
||||||
;; Collection: sorted by descending
|
;; Collection: split by
|
||||||
(define
|
(define
|
||||||
hs-make-object
|
hs-make-object
|
||||||
(fn
|
(fn
|
||||||
@@ -531,7 +545,7 @@
|
|||||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||||
pairs)
|
pairs)
|
||||||
d))))
|
d))))
|
||||||
;; Collection: split by
|
;; Collection: joined by
|
||||||
(define
|
(define
|
||||||
hs-method-call
|
hs-method-call
|
||||||
(fn
|
(fn
|
||||||
@@ -554,7 +568,7 @@
|
|||||||
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
||||||
(idx-loop obj 0)))
|
(idx-loop obj 0)))
|
||||||
(true nil))))
|
(true nil))))
|
||||||
;; Collection: joined by
|
|
||||||
(define hs-beep (fn (v) v))
|
(define hs-beep (fn (v) v))
|
||||||
|
|
||||||
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
@@ -1011,6 +1011,7 @@
|
|||||||
"hs-install",
|
"hs-install",
|
||||||
"hs-measure",
|
"hs-measure",
|
||||||
"hs-transition",
|
"hs-transition",
|
||||||
|
"hs-transition-from",
|
||||||
"hs-type-check",
|
"hs-type-check",
|
||||||
"hs-type-check-strict",
|
"hs-type-check-strict",
|
||||||
"hs-strict-eq",
|
"hs-strict-eq",
|
||||||
|
|||||||
@@ -13,21 +13,6 @@
|
|||||||
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
||||||
;; Liang's hyphenation (trie over character patterns).
|
;; 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
|
(define-library
|
||||||
(sx text-layout)
|
(sx text-layout)
|
||||||
(export
|
(export
|
||||||
@@ -149,6 +134,32 @@
|
|||||||
(let
|
(let
|
||||||
((ends (append (rest starts) (list n))))
|
((ends (append (rest starts) (list n))))
|
||||||
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
||||||
|
(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))))))))
|
||||||
(define
|
(define
|
||||||
position-line
|
position-line
|
||||||
(fn
|
(fn
|
||||||
@@ -181,6 +192,45 @@
|
|||||||
(line-widths (slice widths start end)))
|
(line-widths (slice widths start end)))
|
||||||
(position-line line-words line-widths space-width x0 y))))
|
(position-line line-words line-widths space-width x0 y))))
|
||||||
line-ranges)))
|
line-ranges)))
|
||||||
|
(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
|
||||||
|
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)))))
|
||||||
(define
|
(define
|
||||||
make-hyphenation-trie
|
make-hyphenation-trie
|
||||||
(fn
|
(fn
|
||||||
@@ -327,31 +377,4 @@
|
|||||||
(lh (or line-height 1.4)))
|
(lh (or line-height 1.4)))
|
||||||
(layout-paragraph words f s w lh))))))
|
(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))
|
(import (sx text-layout))
|
||||||
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};
|
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
|
||||||
}
|
}
|
||||||
(globalThis))
|
(globalThis))
|
||||||
({"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
|
({"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-653fa705",[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
|
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_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
|
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
|
||||||
|
|||||||
@@ -1,4 +1,5 @@
|
|||||||
;; Pretext island — client-side text layout with live controls
|
;; Pretext island — client-side text layout with live controls
|
||||||
|
;; Uses bytecode-compiled break-lines from text-layout library.
|
||||||
|
|
||||||
(defisland
|
(defisland
|
||||||
~pretext-demo/live
|
~pretext-demo/live
|
||||||
@@ -13,51 +14,9 @@
|
|||||||
(canvas (host-call doc "createElement" "canvas"))
|
(canvas (host-call doc "createElement" "canvas"))
|
||||||
(ctx (host-call canvas "getContext" "2d")))
|
(ctx (host-call canvas "getContext" "2d")))
|
||||||
(let
|
(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"))))
|
((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")))))
|
||||||
(sw-fn
|
|
||||||
(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-greedy
|
|
||||||
(fn
|
|
||||||
(widths sw mx)
|
|
||||||
(let
|
|
||||||
((n (len widths)) (lines (list)) (st 0) (us 0))
|
|
||||||
(for-each
|
|
||||||
(fn
|
|
||||||
(i)
|
|
||||||
(let
|
|
||||||
((w (nth widths i)) (nd (if (= i st) w (+ us sw w))))
|
|
||||||
(if
|
|
||||||
(and (> nd mx) (not (= i st)))
|
|
||||||
(do
|
|
||||||
(set! lines (append lines (list (list st i))))
|
|
||||||
(set! st i)
|
|
||||||
(set! us w))
|
|
||||||
(set! us nd))))
|
|
||||||
(range n))
|
|
||||||
(append lines (list (list st n))))))
|
|
||||||
(pos-line
|
|
||||||
(fn
|
|
||||||
(lw lwid gap)
|
|
||||||
(let
|
|
||||||
loop
|
|
||||||
((i 0) (x 0) (acc (list)))
|
|
||||||
(if
|
|
||||||
(>= i (len lw))
|
|
||||||
acc
|
|
||||||
(loop
|
|
||||||
(+ i 1)
|
|
||||||
(+ x (nth lwid i) gap)
|
|
||||||
(append acc (list {:x x :word (nth lw i)}))))))))
|
|
||||||
(let
|
(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 (brk-greedy widths spw mxw)) (result (list))) (for-each (fn (li) (let ((rng (nth ranges li)) (y (* li lh))) (let ((s (first rng)) (e (nth rng 1))) (let ((n-line (- e s)) (lw (list)) (lwid (list))) (for-each (fn (k) (append! lw (nth words (+ s k))) (append! lwid (nth widths (+ s k)))) (range n-line)) (let ((tw (reduce + 0 lwid)) (ng (max 1 (- n-line 1))) (il (= li (- (len ranges) 1)))) (let ((gap (if il spw (/ (- mxw tw) ng)))) (append! result {:y y :words (pos-line lw lwid gap)}))))))) (range (len ranges))) result)))))))
|
((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)))) (pretext-layout-lines words widths ranges spw mxw lh))))))))
|
||||||
(div
|
(div
|
||||||
(~tw :tokens "space-y-4")
|
(~tw :tokens "space-y-4")
|
||||||
(div
|
(div
|
||||||
|
|||||||
Reference in New Issue
Block a user