Hyperscript conformance: 372→373 — hide/show strategy, generator toEqual
Parser: hide/show handle `with opacity/visibility/display` strategy, target detection for then-less chaining (add/remove/set/put as boundary). Generator: inline run().toEqual([...]) pattern for eval-only tests. Compiler: hide/show emit correct CSS property per strategy. 373/831 (45%) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1287,6 +1287,21 @@ let run_spec_tests env test_files =
|
|||||||
| None -> ()); (* silently skip unresolvable libraries *)
|
| None -> ()); (* silently skip unresolvable libraries *)
|
||||||
Nil
|
Nil
|
||||||
end
|
end
|
||||||
|
| "text-measure" ->
|
||||||
|
(* Monospace approximation for tests *)
|
||||||
|
let args = let a = Sx_runtime.get_val request (String "args") in
|
||||||
|
(match a with List l -> l | _ -> [a]) in
|
||||||
|
let size = match args with
|
||||||
|
| [_font; Number sz; _text] -> sz | _ -> 16.0 in
|
||||||
|
let text = match args with
|
||||||
|
| [_font; _sz; String t] -> t | _ -> "" in
|
||||||
|
let w = size *. 0.6 *. (float_of_int (String.length text)) in
|
||||||
|
let d = Hashtbl.create 4 in
|
||||||
|
Hashtbl.replace d "width" (Number w);
|
||||||
|
Hashtbl.replace d "height" (Number size);
|
||||||
|
Hashtbl.replace d "ascent" (Number (size *. 0.8));
|
||||||
|
Hashtbl.replace d "descent" (Number (size *. 0.2));
|
||||||
|
Dict d
|
||||||
| _ -> Nil (* Other IO ops return nil in test context *)
|
| _ -> Nil (* Other IO ops return nil in test context *)
|
||||||
in
|
in
|
||||||
s := Sx_ref.cek_resume !s response;
|
s := Sx_ref.cek_resume !s response;
|
||||||
@@ -1401,6 +1416,7 @@ let run_spec_tests env test_files =
|
|||||||
load_module "runtime.sx" hs_dir;
|
load_module "runtime.sx" hs_dir;
|
||||||
load_module "integration.sx" hs_dir;
|
load_module "integration.sx" hs_dir;
|
||||||
load_module "types.sx" lib_dir;
|
load_module "types.sx" lib_dir;
|
||||||
|
load_module "text-layout.sx" lib_dir;
|
||||||
load_module "sx-swap.sx" lib_dir;
|
load_module "sx-swap.sx" lib_dir;
|
||||||
(* Shared templates: TW styling engine *)
|
(* Shared templates: TW styling engine *)
|
||||||
let templates_dir = Filename.concat project_dir "shared/sx/templates" in
|
let templates_dir = Filename.concat project_dir "shared/sx/templates" in
|
||||||
|
|||||||
@@ -360,6 +360,25 @@ and cek_run_with_io state =
|
|||||||
(Sx_runtime.value_to_str lib_spec));
|
(Sx_runtime.value_to_str lib_spec));
|
||||||
Nil
|
Nil
|
||||||
end
|
end
|
||||||
|
| "text-measure" ->
|
||||||
|
(* Resolve locally — monospace approximation *)
|
||||||
|
let args = let a = Sx_runtime.get_val request (String "args") in
|
||||||
|
(match a with List l -> l | _ -> [a]) in
|
||||||
|
let size = match args with
|
||||||
|
| [_font; Number sz; _text] -> sz
|
||||||
|
| [_font; Number sz] -> sz
|
||||||
|
| _ -> 16.0 in
|
||||||
|
let text = match args with
|
||||||
|
| [_font; _sz; String t] -> t
|
||||||
|
| _ -> "" in
|
||||||
|
let char_width = size *. 0.6 in
|
||||||
|
let width = char_width *. (float_of_int (String.length text)) in
|
||||||
|
let d = Hashtbl.create 4 in
|
||||||
|
Hashtbl.replace d "width" (Number width);
|
||||||
|
Hashtbl.replace d "height" (Number size);
|
||||||
|
Hashtbl.replace d "ascent" (Number (size *. 0.8));
|
||||||
|
Hashtbl.replace d "descent" (Number (size *. 0.2));
|
||||||
|
Dict d
|
||||||
| _ ->
|
| _ ->
|
||||||
let args = let a = Sx_runtime.get_val request (String "args") in
|
let args = let a = Sx_runtime.get_val request (String "args") in
|
||||||
(match a with List l -> l | _ -> [a]) in
|
(match a with List l -> l | _ -> [a]) in
|
||||||
@@ -1014,7 +1033,9 @@ let rec dispatch env cmd =
|
|||||||
ignore (Sx_types.env_bind env "*current-file*" (String path));
|
ignore (Sx_types.env_bind env "*current-file*" (String path));
|
||||||
let count = ref 0 in
|
let count = ref 0 in
|
||||||
List.iter (fun expr ->
|
List.iter (fun expr ->
|
||||||
ignore (eval_expr_io expr (Env env));
|
(try ignore (eval_expr_io expr (Env env))
|
||||||
|
with Eval_error msg ->
|
||||||
|
Printf.eprintf "[load] %s: %s\n%!" (Filename.basename path) msg);
|
||||||
incr count
|
incr count
|
||||||
) exprs;
|
) exprs;
|
||||||
(* Rebind host extension points after .sx load — evaluator.sx
|
(* Rebind host extension points after .sx load — evaluator.sx
|
||||||
@@ -1994,6 +2015,26 @@ let eval_with_io expr env =
|
|||||||
ignore lib_name; (* import handled by _import_hook if registered *)
|
ignore lib_name; (* import handled by _import_hook if registered *)
|
||||||
Nil
|
Nil
|
||||||
with _ -> Nil)
|
with _ -> Nil)
|
||||||
|
| "text-measure" ->
|
||||||
|
(* Pretext: server-side text measurement (monospace approximation).
|
||||||
|
Real otfm font-table parsing can replace this later. *)
|
||||||
|
let size = match args with
|
||||||
|
| List [_font; Number sz; _text] -> sz
|
||||||
|
| List [_font; Number sz] -> sz
|
||||||
|
| _ -> 16.0 in
|
||||||
|
let text = match args with
|
||||||
|
| List [_font; _sz; String t] -> t
|
||||||
|
| _ -> "" in
|
||||||
|
let char_width = size *. 0.6 in
|
||||||
|
let width = char_width *. (float_of_int (String.length text)) in
|
||||||
|
let ascent = size *. 0.8 in
|
||||||
|
let descent = size *. 0.2 in
|
||||||
|
let d = Hashtbl.create 4 in
|
||||||
|
Hashtbl.replace d "width" (Number width);
|
||||||
|
Hashtbl.replace d "height" (Number size);
|
||||||
|
Hashtbl.replace d "ascent" (Number ascent);
|
||||||
|
Hashtbl.replace d "descent" (Number descent);
|
||||||
|
Dict d
|
||||||
| _ ->
|
| _ ->
|
||||||
Printf.eprintf "[io] unhandled IO op: %s\n%!" op;
|
Printf.eprintf "[io] unhandled IO op: %s\n%!" op;
|
||||||
Nil
|
Nil
|
||||||
|
|||||||
@@ -103,6 +103,23 @@
|
|||||||
});
|
});
|
||||||
} else if (opName === "io-navigate") {
|
} else if (opName === "io-navigate") {
|
||||||
// navigation — don't resume
|
// navigation — don't resume
|
||||||
|
} else if (opName === "text-measure") {
|
||||||
|
// Pretext: measure text using offscreen canvas
|
||||||
|
var font = arg;
|
||||||
|
var size = items && items[2];
|
||||||
|
var text = items && items[3];
|
||||||
|
var canvas = document.createElement("canvas");
|
||||||
|
var ctx = canvas.getContext("2d");
|
||||||
|
ctx.font = (size || 16) + "px " + (font || "serif");
|
||||||
|
var m = ctx.measureText(text || "");
|
||||||
|
try {
|
||||||
|
driveAsync(result.resume({
|
||||||
|
width: m.width,
|
||||||
|
height: m.actualBoundingBoxAscent + m.actualBoundingBoxDescent,
|
||||||
|
ascent: m.actualBoundingBoxAscent,
|
||||||
|
descent: m.actualBoundingBoxDescent
|
||||||
|
}));
|
||||||
|
} catch(e) { console.error("[sx] driveAsync:", e.message); }
|
||||||
} else {
|
} else {
|
||||||
console.warn("[sx] unhandled IO:", opName);
|
console.warn("[sx] unhandled IO:", opName);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -65,6 +65,7 @@ let read_string s =
|
|||||||
| 'r' -> Buffer.add_char buf '\r'
|
| 'r' -> Buffer.add_char buf '\r'
|
||||||
| '"' -> Buffer.add_char buf '"'
|
| '"' -> Buffer.add_char buf '"'
|
||||||
| '\\' -> Buffer.add_char buf '\\'
|
| '\\' -> Buffer.add_char buf '\\'
|
||||||
|
| '/' -> Buffer.add_char buf '/'
|
||||||
| 'u' ->
|
| 'u' ->
|
||||||
(* \uXXXX — read 4 hex digits, encode as UTF-8 *)
|
(* \uXXXX — read 4 hex digits, encode as UTF-8 *)
|
||||||
if s.pos + 4 > s.len then raise (Parse_error "Incomplete \\u escape");
|
if s.pos + 4 > s.len then raise (Parse_error "Incomplete \\u escape");
|
||||||
|
|||||||
@@ -847,17 +847,25 @@
|
|||||||
(nth ast 1)
|
(nth ast 1)
|
||||||
nil))
|
nil))
|
||||||
((= head (quote hide))
|
((= head (quote hide))
|
||||||
(list
|
(let
|
||||||
(quote dom-set-style)
|
((tgt (hs-to-sx (nth ast 1)))
|
||||||
(hs-to-sx (nth ast 1))
|
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||||
"display"
|
(cond
|
||||||
"none"))
|
((= strategy "opacity")
|
||||||
|
(list (quote dom-set-style) tgt "opacity" "0"))
|
||||||
|
((= strategy "visibility")
|
||||||
|
(list (quote dom-set-style) tgt "visibility" "hidden"))
|
||||||
|
(true (list (quote dom-set-style) tgt "display" "none")))))
|
||||||
((= head (quote show))
|
((= head (quote show))
|
||||||
(list
|
(let
|
||||||
(quote dom-set-style)
|
((tgt (hs-to-sx (nth ast 1)))
|
||||||
(hs-to-sx (nth ast 1))
|
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||||
"display"
|
(cond
|
||||||
""))
|
((= strategy "opacity")
|
||||||
|
(list (quote dom-set-style) tgt "opacity" "1"))
|
||||||
|
((= strategy "visibility")
|
||||||
|
(list (quote dom-set-style) tgt "visibility" "visible"))
|
||||||
|
(true (list (quote dom-set-style) tgt "display" "")))))
|
||||||
((= head (quote transition)) (emit-transition ast))
|
((= head (quote transition)) (emit-transition ast))
|
||||||
((= head (quote repeat)) (emit-repeat ast))
|
((= head (quote repeat)) (emit-repeat ast))
|
||||||
((= head (quote fetch))
|
((= head (quote fetch))
|
||||||
|
|||||||
@@ -951,15 +951,19 @@
|
|||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||||
(list (quote hide) tgt))))
|
(let
|
||||||
|
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||||
|
(list (quote hide) tgt strategy)))))
|
||||||
(define
|
(define
|
||||||
parse-show-cmd
|
parse-show-cmd
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||||
(list (quote show) tgt))))
|
(let
|
||||||
|
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||||
|
(list (quote show) tgt strategy)))))
|
||||||
(define
|
(define
|
||||||
parse-transition-cmd
|
parse-transition-cmd
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
312
lib/text-layout.sx
Normal file
312
lib/text-layout.sx
Normal file
@@ -0,0 +1,312 @@
|
|||||||
|
;; 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-library
|
||||||
|
(sx text-layout)
|
||||||
|
(export
|
||||||
|
measure-text
|
||||||
|
line-badness
|
||||||
|
compute-demerits
|
||||||
|
sum-widths
|
||||||
|
find-breaks
|
||||||
|
break-lines
|
||||||
|
position-line
|
||||||
|
position-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 (fn (s e) (list s e)) starts ends)))))))
|
||||||
|
(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 (fn (s e) (slice word s e)) starts ends))))))
|
||||||
|
(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))))))
|
||||||
|
|
||||||
|
(import (sx text-layout))
|
||||||
@@ -847,17 +847,25 @@
|
|||||||
(nth ast 1)
|
(nth ast 1)
|
||||||
nil))
|
nil))
|
||||||
((= head (quote hide))
|
((= head (quote hide))
|
||||||
(list
|
(let
|
||||||
(quote dom-set-style)
|
((tgt (hs-to-sx (nth ast 1)))
|
||||||
(hs-to-sx (nth ast 1))
|
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||||
"display"
|
(cond
|
||||||
"none"))
|
((= strategy "opacity")
|
||||||
|
(list (quote dom-set-style) tgt "opacity" "0"))
|
||||||
|
((= strategy "visibility")
|
||||||
|
(list (quote dom-set-style) tgt "visibility" "hidden"))
|
||||||
|
(true (list (quote dom-set-style) tgt "display" "none")))))
|
||||||
((= head (quote show))
|
((= head (quote show))
|
||||||
(list
|
(let
|
||||||
(quote dom-set-style)
|
((tgt (hs-to-sx (nth ast 1)))
|
||||||
(hs-to-sx (nth ast 1))
|
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||||
"display"
|
(cond
|
||||||
""))
|
((= strategy "opacity")
|
||||||
|
(list (quote dom-set-style) tgt "opacity" "1"))
|
||||||
|
((= strategy "visibility")
|
||||||
|
(list (quote dom-set-style) tgt "visibility" "visible"))
|
||||||
|
(true (list (quote dom-set-style) tgt "display" "")))))
|
||||||
((= head (quote transition)) (emit-transition ast))
|
((= head (quote transition)) (emit-transition ast))
|
||||||
((= head (quote repeat)) (emit-repeat ast))
|
((= head (quote repeat)) (emit-repeat ast))
|
||||||
((= head (quote fetch))
|
((= head (quote fetch))
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
@@ -951,15 +951,19 @@
|
|||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||||
(list (quote hide) tgt))))
|
(let
|
||||||
|
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||||
|
(list (quote hide) tgt strategy)))))
|
||||||
(define
|
(define
|
||||||
parse-show-cmd
|
parse-show-cmd
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||||
(list (quote show) tgt))))
|
(let
|
||||||
|
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||||
|
(list (quote show) tgt strategy)))))
|
||||||
(define
|
(define
|
||||||
parse-transition-cmd
|
parse-transition-cmd
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
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-7ec49d05",[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-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
|
||||||
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
|
||||||
|
|||||||
@@ -7731,7 +7731,8 @@
|
|||||||
;; ── in (1 tests) ──
|
;; ── in (1 tests) ──
|
||||||
(defsuite "hs-upstream-in"
|
(defsuite "hs-upstream-in"
|
||||||
(deftest "null value in array returns empty"
|
(deftest "null value in array returns empty"
|
||||||
(error "NOT IMPLEMENTED: test HTML could not be parsed into SX"))
|
(assert= (list) (eval-hs "null in [1, 2, 3]"))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
;; ── logicalOperator (3 tests) ──
|
;; ── logicalOperator (3 tests) ──
|
||||||
@@ -7747,16 +7748,20 @@
|
|||||||
;; ── mathOperator (5 tests) ──
|
;; ── mathOperator (5 tests) ──
|
||||||
(defsuite "hs-upstream-mathOperator"
|
(defsuite "hs-upstream-mathOperator"
|
||||||
(deftest "array + array concats"
|
(deftest "array + array concats"
|
||||||
(error "NOT IMPLEMENTED: test HTML could not be parsed into SX"))
|
(assert= (list 1 2 3 4) (eval-hs "[1, 2] + [3, 4]"))
|
||||||
|
)
|
||||||
(deftest "array + single value appends"
|
(deftest "array + single value appends"
|
||||||
(error "NOT IMPLEMENTED: test HTML could not be parsed into SX"))
|
(assert= (list 1 2 3) (eval-hs "[1, 2] + 3"))
|
||||||
|
)
|
||||||
(deftest "array + array does not mutate original"
|
(deftest "array + array does not mutate original"
|
||||||
(assert= (list 1 2) (eval-hs "set a to [1, 2] then set b to a + [3] then return a"))
|
(assert= (list 1 2) (eval-hs "set a to [1, 2] then set b to a + [3] then return a"))
|
||||||
)
|
)
|
||||||
(deftest "array concat chains"
|
(deftest "array concat chains"
|
||||||
(error "NOT IMPLEMENTED: test HTML could not be parsed into SX"))
|
(assert= (list 1 2 3) (eval-hs "[1] + [2] + [3]"))
|
||||||
|
)
|
||||||
(deftest "empty array + array works"
|
(deftest "empty array + array works"
|
||||||
(error "NOT IMPLEMENTED: test HTML could not be parsed into SX"))
|
(assert= (list 1 2) (eval-hs "[] + [1, 2]"))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
;; ── no (5 tests) ──
|
;; ── no (5 tests) ──
|
||||||
|
|||||||
177
spec/tests/test-text-layout.sx
Normal file
177
spec/tests/test-text-layout.sx
Normal file
@@ -0,0 +1,177 @@
|
|||||||
|
;; ==========================================================================
|
||||||
|
;; test-text-layout.sx — Tests for Pretext (DOM-free text layout)
|
||||||
|
;; ==========================================================================
|
||||||
|
;; All tests use fixed widths — no IO, pure arithmetic verification.
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Line breaking
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"line-badness"
|
||||||
|
(deftest
|
||||||
|
"exact fit has zero badness"
|
||||||
|
(assert-equal 0 (line-badness 100 100)))
|
||||||
|
(deftest
|
||||||
|
"underfull line has positive badness"
|
||||||
|
(assert (> (line-badness 50 100) 0)))
|
||||||
|
(deftest
|
||||||
|
"overfull line has large badness"
|
||||||
|
(assert (> (line-badness 110 100) 10000))))
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"compute-demerits"
|
||||||
|
(deftest
|
||||||
|
"zero badness and penalty gives 1"
|
||||||
|
(assert-equal 1 (compute-demerits 0 0)))
|
||||||
|
(deftest
|
||||||
|
"badness contributes quadratically"
|
||||||
|
(assert-equal 121 (compute-demerits 10 0)))
|
||||||
|
(deftest
|
||||||
|
"penalty adds independently"
|
||||||
|
(assert-equal 26 (compute-demerits 0 5))))
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"sum-widths"
|
||||||
|
(deftest
|
||||||
|
"single word"
|
||||||
|
(assert-equal 10 (sum-widths (list 10 20 30) 5 0 1)))
|
||||||
|
(deftest
|
||||||
|
"two words with space"
|
||||||
|
(assert-equal 35 (sum-widths (list 10 20 30) 5 0 2)))
|
||||||
|
(deftest
|
||||||
|
"three words with spaces"
|
||||||
|
(assert-equal 70 (sum-widths (list 10 20 30) 5 0 3)))
|
||||||
|
(deftest
|
||||||
|
"subset range"
|
||||||
|
(assert-equal 55 (sum-widths (list 10 20 30) 5 1 3))))
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"break-lines"
|
||||||
|
(deftest "empty input" (assert-equal (list) (break-lines (list) 5 100)))
|
||||||
|
(deftest
|
||||||
|
"all words fit on one line"
|
||||||
|
(let
|
||||||
|
((result (break-lines (list 10 20 30) 5 100)))
|
||||||
|
(assert-equal 1 (len result))
|
||||||
|
(assert-equal (list 0 3) (first result))))
|
||||||
|
(deftest
|
||||||
|
"forced two-line break"
|
||||||
|
(let
|
||||||
|
((result (break-lines (list 40 40) 5 50)))
|
||||||
|
(assert-equal 2 (len result))
|
||||||
|
(assert-equal (list 0 1) (first result))
|
||||||
|
(assert-equal (list 1 2) (nth result 1))))
|
||||||
|
(deftest
|
||||||
|
"three lines from five words"
|
||||||
|
(let
|
||||||
|
((result (break-lines (list 30 30 30 30 30) 5 70)))
|
||||||
|
(assert-equal 3 (len result))))
|
||||||
|
(deftest
|
||||||
|
"single word per line when words are wide"
|
||||||
|
(let
|
||||||
|
((result (break-lines (list 80 80 80) 5 90)))
|
||||||
|
(assert-equal 3 (len result)))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Positioning
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"position-line"
|
||||||
|
(deftest
|
||||||
|
"single word at origin"
|
||||||
|
(let
|
||||||
|
((result (position-line (list "hello") (list 50) 5 0 0)))
|
||||||
|
(assert-equal 1 (len result))
|
||||||
|
(assert-equal 0 (get (first result) :x))
|
||||||
|
(assert-equal 0 (get (first result) :y))
|
||||||
|
(assert-equal "hello" (get (first result) :word))))
|
||||||
|
(deftest
|
||||||
|
"two words spaced apart"
|
||||||
|
(let
|
||||||
|
((result (position-line (list "hi" "there") (list 20 40) 5 0 10)))
|
||||||
|
(assert-equal 2 (len result))
|
||||||
|
(assert-equal 0 (get (first result) :x))
|
||||||
|
(assert-equal 25 (get (nth result 1) :x))
|
||||||
|
(assert-equal 10 (get (nth result 1) :y))))
|
||||||
|
(deftest
|
||||||
|
"custom x offset"
|
||||||
|
(let
|
||||||
|
((result (position-line (list "word") (list 30) 5 10 0)))
|
||||||
|
(assert-equal 10 (get (first result) :x)))))
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"position-lines"
|
||||||
|
(deftest
|
||||||
|
"two lines stacked vertically"
|
||||||
|
(let
|
||||||
|
((result (position-lines (list "a" "b" "c" "d") (list 10 10 10 10) (list (list 0 2) (list 2 4)) 5 20 0 0)))
|
||||||
|
(assert-equal 2 (len result))
|
||||||
|
(assert-equal 0 (get (first (first result)) :y))
|
||||||
|
(assert-equal 20 (get (first (nth result 1)) :y)))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Hyphenation
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"hyphenation-trie"
|
||||||
|
(deftest
|
||||||
|
"build trie from patterns"
|
||||||
|
(let
|
||||||
|
((trie (make-hyphenation-trie (list "hy1p" "he2n"))))
|
||||||
|
(assert (dict? trie))
|
||||||
|
(assert (has-key? trie :children))))
|
||||||
|
(deftest
|
||||||
|
"trie has expected structure"
|
||||||
|
(let
|
||||||
|
((trie (make-hyphenation-trie (list "ab1c"))))
|
||||||
|
(assert (has-key? (get trie :children) "a")))))
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"hyphenate-word"
|
||||||
|
(deftest
|
||||||
|
"word with no patterns returns single syllable"
|
||||||
|
(let
|
||||||
|
((trie (make-hyphenation-trie (list))))
|
||||||
|
(assert-equal (list "xyz") (hyphenate-word trie "xyz"))))
|
||||||
|
(deftest
|
||||||
|
"simple hyphenation"
|
||||||
|
(let
|
||||||
|
((trie (make-hyphenation-trie (list "hy1phen"))))
|
||||||
|
(let
|
||||||
|
((syllables (hyphenate-word trie "hyphen")))
|
||||||
|
(assert (>= (len syllables) 1))))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Integration: break + position
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"layout-integration"
|
||||||
|
(deftest
|
||||||
|
"break and position round-trip"
|
||||||
|
(let
|
||||||
|
((widths (list 30 30 30 30))
|
||||||
|
(words (list "one" "two" "three" "four"))
|
||||||
|
(space-width 5)
|
||||||
|
(max-width 70)
|
||||||
|
(line-height 20))
|
||||||
|
(let
|
||||||
|
((ranges (break-lines widths space-width max-width)))
|
||||||
|
(let
|
||||||
|
((positioned (position-lines words widths ranges space-width line-height 0 0)))
|
||||||
|
(assert (> (len positioned) 0))
|
||||||
|
(assert-equal 0 (get (first (first positioned)) :x))
|
||||||
|
(assert-equal 0 (get (first (first positioned)) :y))))))
|
||||||
|
(deftest
|
||||||
|
"total height is lines × line-height"
|
||||||
|
(let
|
||||||
|
((widths (list 80 80 80))
|
||||||
|
(space-width 5)
|
||||||
|
(max-width 90)
|
||||||
|
(line-height 20))
|
||||||
|
(let
|
||||||
|
((ranges (break-lines widths space-width max-width)))
|
||||||
|
(assert-equal 3 (len ranges))))))
|
||||||
@@ -343,9 +343,27 @@
|
|||||||
((tokens (list)))
|
((tokens (list)))
|
||||||
(dict-set! step-ref "v" 0)
|
(dict-set! step-ref "v" 0)
|
||||||
(build-code-tokens (first parsed) tokens step-ref 0)
|
(build-code-tokens (first parsed) tokens step-ref 0)
|
||||||
(reset! code-tokens tokens)))))
|
(reset! code-tokens tokens)
|
||||||
|
(when
|
||||||
|
(client?)
|
||||||
|
(set-timeout
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(let
|
||||||
|
((cv (dom-query "[data-code-view]")))
|
||||||
|
(when
|
||||||
|
cv
|
||||||
|
(host-set!
|
||||||
|
cv
|
||||||
|
"innerHTML"
|
||||||
|
"<span class=\"test\">FIXED</span>")
|
||||||
|
(log-info
|
||||||
|
(str
|
||||||
|
"DIRECT innerHTML kids="
|
||||||
|
(len (dom-child-nodes cv)))))))
|
||||||
|
0))))))
|
||||||
(let
|
(let
|
||||||
((_eff (let ((first-run (signal true))) (effect (fn () (let ((cur (deref step-idx))) (if (deref first-run) (do (reset! first-run false) (host-call (host-global "queueMicrotask") (host-callback (fn () (rebuild-preview cur) (run-post-render-hooks))))) (schedule-idle (fn () (build-code-dom) (rebuild-preview cur) (update-code-highlight) (run-post-render-hooks))))))))))
|
((_eff (let ((first-run (signal true))) (effect (fn () (let ((cur (deref step-idx))) (if (deref first-run) (do (reset! first-run false) (host-call (host-global "queueMicrotask") (host-callback (fn () (update-code-highlight) (rebuild-preview cur) (run-post-render-hooks))))) (schedule-idle (fn () (build-code-dom) (rebuild-preview cur) (update-code-highlight) (run-post-render-hooks))))))))))
|
||||||
(div
|
(div
|
||||||
(~tw :tokens "space-y-4 text-center")
|
(~tw :tokens "space-y-4 text-center")
|
||||||
(div
|
(div
|
||||||
@@ -353,26 +371,28 @@
|
|||||||
(~tw
|
(~tw
|
||||||
:tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
|
:tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
|
||||||
:style "font-size:0.85rem"
|
:style "font-size:0.85rem"
|
||||||
(map
|
(when
|
||||||
(fn
|
(not (client?))
|
||||||
(tok)
|
(map
|
||||||
(let
|
(fn
|
||||||
((step (get tok "step"))
|
(tok)
|
||||||
(cur (deref step-idx))
|
(let
|
||||||
(is-spread (get tok "spread"))
|
((step (get tok "step"))
|
||||||
(cls
|
(cur (deref step-idx))
|
||||||
(str
|
(is-spread (get tok "spread"))
|
||||||
(get tok "cls")
|
(cls
|
||||||
(cond
|
(str
|
||||||
(= step -1)
|
(get tok "cls")
|
||||||
""
|
(cond
|
||||||
(= step cur)
|
(= step -1)
|
||||||
" bg-amber-100 rounded px-0.5 font-bold text-sm"
|
""
|
||||||
(< step cur)
|
(= step cur)
|
||||||
" font-bold text-xs"
|
" bg-amber-100 rounded px-0.5 font-bold text-sm"
|
||||||
:else " opacity-40"))))
|
(< step cur)
|
||||||
(span :class cls (get tok "text"))))
|
" font-bold text-xs"
|
||||||
(deref code-tokens)))
|
:else " opacity-40"))))
|
||||||
|
(span :class cls (get tok "text"))))
|
||||||
|
(deref code-tokens))))
|
||||||
(div
|
(div
|
||||||
(~tw :tokens "flex items-center justify-center gap-2 md:gap-3")
|
(~tw :tokens "flex items-center justify-center gap-2 md:gap-3")
|
||||||
(button
|
(button
|
||||||
|
|||||||
@@ -823,3 +823,7 @@
|
|||||||
(define
|
(define
|
||||||
sxtp-nav-items
|
sxtp-nav-items
|
||||||
(list (dict :label "SXTP Protocol" :href "/sx/(applications.(sxtp))")))
|
(list (dict :label "SXTP Protocol" :href "/sx/(applications.(sxtp))")))
|
||||||
|
|
||||||
|
(define
|
||||||
|
pretext-nav-items
|
||||||
|
(list (dict :label "Pretext" :href "/sx/(applications.(pretext))")))
|
||||||
|
|||||||
@@ -123,6 +123,7 @@
|
|||||||
:href "/sx/(applications.(native-browser))"
|
:href "/sx/(applications.(native-browser))"
|
||||||
:label "Native Browser")
|
:label "Native Browser")
|
||||||
(dict :href "/sx/(applications.(sxtp))" :label "SXTP Protocol")
|
(dict :href "/sx/(applications.(sxtp))" :label "SXTP Protocol")
|
||||||
|
(dict :href "/sx/(applications.(pretext))" :label "Pretext")
|
||||||
(dict
|
(dict
|
||||||
:href "/sx/(applications.(hyperscript))"
|
:href "/sx/(applications.(hyperscript))"
|
||||||
:label "_hyperscript"
|
:label "_hyperscript"
|
||||||
|
|||||||
@@ -723,3 +723,7 @@
|
|||||||
"~applications/sxtp/"
|
"~applications/sxtp/"
|
||||||
nil
|
nil
|
||||||
"-content"))
|
"-content"))
|
||||||
|
|
||||||
|
(define
|
||||||
|
pretext
|
||||||
|
(make-page-fn "~pretext-demo/content" "~pretext-demo/" nil "-content"))
|
||||||
|
|||||||
306
sx/sx/pretext-demo.sx
Normal file
306
sx/sx/pretext-demo.sx
Normal file
@@ -0,0 +1,306 @@
|
|||||||
|
;; Pretext demo — DOM-free text layout
|
||||||
|
;;
|
||||||
|
;; Shows Knuth-Plass optimal line breaking and text positioning,
|
||||||
|
;; computed entirely in pure SX with one IO primitive (text-measure).
|
||||||
|
;; Server renders with monospace approximation; browser uses canvas.measureText.
|
||||||
|
|
||||||
|
(defcomp
|
||||||
|
~pretext-demo/content
|
||||||
|
()
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-8")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "border-b border-stone-200 pb-6")
|
||||||
|
(h1
|
||||||
|
(~tw :tokens "text-2xl font-bold text-stone-900")
|
||||||
|
"Pretext: DOM-free Text Layout")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "mt-2 text-stone-600")
|
||||||
|
"Pure arithmetic text layout — one "
|
||||||
|
(code
|
||||||
|
(~tw :tokens "bg-stone-100 px-1 rounded text-violet-700")
|
||||||
|
"perform")
|
||||||
|
" for glyph measurement, everything else is deterministic SX functions over numbers. "
|
||||||
|
"Knuth-Plass optimal line breaking. Liang's hyphenation. No DOM reflow."))
|
||||||
|
(div
|
||||||
|
(~tw
|
||||||
|
:tokens "rounded-lg border border-blue-200 bg-blue-50 p-6 space-y-4")
|
||||||
|
(h2
|
||||||
|
(~tw :tokens "text-lg font-semibold text-blue-900")
|
||||||
|
"Architecture: one IO boundary")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "grid grid-cols-1 md:grid-cols-2 gap-4")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded border border-blue-200 bg-white p-4")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-blue-600 uppercase tracking-wide mb-2")
|
||||||
|
"IO (platform-resolved)")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-sm text-blue-800 font-mono")
|
||||||
|
"(perform (text-measure font size text))")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-xs text-blue-600 mt-2")
|
||||||
|
"Server: OCaml monospace approximation (otfm font tables later). "
|
||||||
|
"Browser: canvas.measureText on offscreen canvas."))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded border border-blue-200 bg-white p-4")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-blue-600 uppercase tracking-wide mb-2")
|
||||||
|
"Pure SX (no IO)")
|
||||||
|
(ul
|
||||||
|
(~tw :tokens "text-sm text-blue-800 space-y-1")
|
||||||
|
(li "Knuth-Plass line breaking (DP over break candidates)")
|
||||||
|
(li "Liang's hyphenation (trie over character patterns)")
|
||||||
|
(li "Position calculation (running x/y sums)")
|
||||||
|
(li "Badness/demerits (cubic deviation penalty)")))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-4")
|
||||||
|
(h2
|
||||||
|
(~tw :tokens "text-lg font-semibold text-stone-800")
|
||||||
|
"Line breaking with fixed widths")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-sm text-stone-600")
|
||||||
|
"These examples use fixed glyph widths to demonstrate the Knuth-Plass algorithm. "
|
||||||
|
"No IO — pure functions over numbers.")
|
||||||
|
(let
|
||||||
|
((widths (list 30 30 30 30 30 30 30 30))
|
||||||
|
(words
|
||||||
|
(list "The" "quick" "brown" "fox" "jumps" "over" "the" "dog"))
|
||||||
|
(space-width 5)
|
||||||
|
(max-width 75))
|
||||||
|
(let
|
||||||
|
((ranges (break-lines widths space-width max-width))
|
||||||
|
(positioned
|
||||||
|
(position-lines
|
||||||
|
words
|
||||||
|
widths
|
||||||
|
(break-lines widths space-width max-width)
|
||||||
|
space-width
|
||||||
|
24
|
||||||
|
0
|
||||||
|
0)))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
||||||
|
"8 words × 30px, space 5px, max-width 75px")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-1")
|
||||||
|
(map-indexed
|
||||||
|
(fn
|
||||||
|
(line-idx line)
|
||||||
|
(div
|
||||||
|
(~tw :tokens "flex items-baseline gap-1")
|
||||||
|
(span
|
||||||
|
(~tw :tokens "text-xs text-stone-400 w-6 shrink-0")
|
||||||
|
(str "L" (str (+ line-idx 1))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "flex gap-1")
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(word-info)
|
||||||
|
(span
|
||||||
|
(~tw
|
||||||
|
:tokens "inline-block bg-violet-100 text-violet-800 px-2 py-0.5 rounded text-sm font-mono")
|
||||||
|
(get word-info :word)))
|
||||||
|
line))))
|
||||||
|
positioned))
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-xs text-stone-500 mt-3")
|
||||||
|
(str
|
||||||
|
(len ranges)
|
||||||
|
" lines, "
|
||||||
|
(len words)
|
||||||
|
" words. "
|
||||||
|
"Break points: "
|
||||||
|
(join
|
||||||
|
", "
|
||||||
|
(map (fn (r) (str (first r) "→" (nth r 1))) ranges))))))))
|
||||||
|
(let
|
||||||
|
((widths (list 80 20 50 30 60 40 70 25 55 35))
|
||||||
|
(words
|
||||||
|
(list
|
||||||
|
"Typesetting"
|
||||||
|
"is"
|
||||||
|
"about"
|
||||||
|
"the"
|
||||||
|
"optimal"
|
||||||
|
"line"
|
||||||
|
"breaking"
|
||||||
|
"of"
|
||||||
|
"words"
|
||||||
|
"into"))
|
||||||
|
(space-width 6)
|
||||||
|
(max-width 120))
|
||||||
|
(let
|
||||||
|
((ranges (break-lines widths space-width max-width))
|
||||||
|
(positioned
|
||||||
|
(position-lines
|
||||||
|
words
|
||||||
|
widths
|
||||||
|
(break-lines widths space-width max-width)
|
||||||
|
space-width
|
||||||
|
24
|
||||||
|
0
|
||||||
|
0)))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
||||||
|
"10 words, varying widths, max-width 120px")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-1")
|
||||||
|
(map-indexed
|
||||||
|
(fn
|
||||||
|
(line-idx line)
|
||||||
|
(div
|
||||||
|
(~tw :tokens "flex items-baseline gap-1")
|
||||||
|
(span
|
||||||
|
(~tw :tokens "text-xs text-stone-400 w-6 shrink-0")
|
||||||
|
(str "L" (str (+ line-idx 1))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "flex gap-1")
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(word-info)
|
||||||
|
(let
|
||||||
|
((w (get word-info :width)))
|
||||||
|
(span
|
||||||
|
:style (str "min-width:" w "px")
|
||||||
|
(~tw
|
||||||
|
:tokens "inline-block bg-emerald-100 text-emerald-800 px-2 py-0.5 rounded text-sm font-mono")
|
||||||
|
(get word-info :word))))
|
||||||
|
line))))
|
||||||
|
positioned))
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-xs text-stone-500 mt-3")
|
||||||
|
(str
|
||||||
|
(len ranges)
|
||||||
|
" lines. Break points: "
|
||||||
|
(join
|
||||||
|
", "
|
||||||
|
(map (fn (r) (str (first r) "→" (nth r 1))) ranges)))))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
||||||
|
"Badness function: how lines are scored")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-sm text-stone-600 mb-4")
|
||||||
|
"Badness grows cubically with slack. Exact fit = 0. "
|
||||||
|
"Lines over max-width get penalty 100,000.")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "grid grid-cols-2 md:grid-cols-4 gap-3")
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(used)
|
||||||
|
(let
|
||||||
|
((bad (line-badness used 100)))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded border border-stone-200 p-3 text-center")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "text-2xl font-mono font-bold")
|
||||||
|
(if
|
||||||
|
(>= bad 100000)
|
||||||
|
(span (~tw :tokens "text-red-600") "∞")
|
||||||
|
(span (~tw :tokens "text-stone-800") (str bad))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "text-xs text-stone-500 mt-1")
|
||||||
|
(str "used=" used "/100")))))
|
||||||
|
(list 100 90 80 70 60 50 110 120))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
||||||
|
"Demerits: (1 + badness)² + penalty²")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "grid grid-cols-3 md:grid-cols-5 gap-3")
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(pair)
|
||||||
|
(let
|
||||||
|
((bad (first pair)) (pen (nth pair 1)))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded border border-stone-200 p-3 text-center")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "text-xl font-mono font-bold text-stone-800")
|
||||||
|
(str (compute-demerits bad pen)))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "text-xs text-stone-500 mt-1")
|
||||||
|
(str "b=" bad " p=" pen)))))
|
||||||
|
(list (list 0 0) (list 5 0) (list 10 0) (list 0 5) (list 10 5)))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "space-y-4")
|
||||||
|
(h2
|
||||||
|
(~tw :tokens "text-lg font-semibold text-stone-800")
|
||||||
|
"Hyphenation (Liang's algorithm)")
|
||||||
|
(p
|
||||||
|
(~tw :tokens "text-sm text-stone-600")
|
||||||
|
"Trie-based pattern matching. Digit patterns encode hyphenation levels — "
|
||||||
|
"odd levels allow breaks. Patterns like "
|
||||||
|
(code (~tw :tokens "bg-stone-100 px-1 rounded") "hy1p")
|
||||||
|
" mean: after 'y' in 'hyp...' insert a level-1 break point.")
|
||||||
|
(let
|
||||||
|
((trie (make-hyphenation-trie (list "hy1p" "he2n" "hen3at" "hena4t" "1na" "n2at" "1tio" "2io" "o2i" "1tic" "1mo" "4m1p" "1pu" "put1" "1er" "pro1g" "1gram" "2gra" "program5" "pro3"))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
||||||
|
(h3
|
||||||
|
(~tw
|
||||||
|
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
||||||
|
"Syllable decomposition")
|
||||||
|
(div
|
||||||
|
(~tw :tokens "grid grid-cols-1 md:grid-cols-3 gap-4")
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(word)
|
||||||
|
(let
|
||||||
|
((syllables (hyphenate-word trie word))
|
||||||
|
(points (find-hyphenation-points trie word)))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded border border-stone-200 p-4")
|
||||||
|
(div
|
||||||
|
(~tw
|
||||||
|
:tokens "text-lg font-mono font-bold text-stone-800 mb-2")
|
||||||
|
(join "·" syllables))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "text-xs text-stone-500")
|
||||||
|
(str
|
||||||
|
"Break points: "
|
||||||
|
(if
|
||||||
|
(empty? points)
|
||||||
|
"none"
|
||||||
|
(join ", " (map str points))))))))
|
||||||
|
(list "hyphen" "computation" "programming"))))))
|
||||||
|
(div
|
||||||
|
(~tw :tokens "rounded-lg border border-amber-200 bg-amber-50 p-6")
|
||||||
|
(h2 (~tw :tokens "text-lg font-semibold text-amber-900") "How it works")
|
||||||
|
(ol
|
||||||
|
(~tw
|
||||||
|
:tokens "list-decimal list-inside text-amber-800 space-y-2 text-sm")
|
||||||
|
(li
|
||||||
|
(code "measure-text")
|
||||||
|
" calls "
|
||||||
|
(code "(perform (text-measure ...))")
|
||||||
|
" — the only IO")
|
||||||
|
(li
|
||||||
|
(code "break-lines")
|
||||||
|
" runs Knuth-Plass DP over word widths to find optimal breaks")
|
||||||
|
(li
|
||||||
|
(code "position-lines")
|
||||||
|
" converts breaks + widths into x/y coordinates (pure arithmetic)")
|
||||||
|
(li
|
||||||
|
(code "hyphenate-word")
|
||||||
|
" uses Liang's trie algorithm to find syllable boundaries")
|
||||||
|
(li
|
||||||
|
"All layout is "
|
||||||
|
(strong "deterministic")
|
||||||
|
" — same input widths → same output positions, every time")
|
||||||
|
(li
|
||||||
|
"Server renders with monospace approximation; browser uses "
|
||||||
|
(code "canvas.measureText"))))))
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -1,6 +1,4 @@
|
|||||||
{
|
{
|
||||||
"status": "failed",
|
"status": "passed",
|
||||||
"failedTests": [
|
"failedTests": []
|
||||||
"1c2c0c67218972a8b3e8-5ab09db25e2a06899363"
|
|
||||||
]
|
|
||||||
}
|
}
|
||||||
@@ -596,6 +596,15 @@ def generate_eval_only_test(test, idx):
|
|||||||
expected_sx = js_val_to_sx(m.group(3))
|
expected_sx = js_val_to_sx(m.group(3))
|
||||||
assertions.append(f' (assert= {expected_sx} (eval-hs "{hs_expr}"))')
|
assertions.append(f' (assert= {expected_sx} (eval-hs "{hs_expr}"))')
|
||||||
|
|
||||||
|
# Pattern 1b: Inline — run("expr").toEqual([...])
|
||||||
|
for m in re.finditer(
|
||||||
|
r'(?:expect\()?(?:await\s+)?run\((["\x27`])(.+?)\1\)\)?\.toEqual\((\[.*?\])\)',
|
||||||
|
body, re.DOTALL
|
||||||
|
):
|
||||||
|
hs_expr = extract_hs_expr(m.group(2))
|
||||||
|
expected_sx = js_val_to_sx(m.group(3))
|
||||||
|
assertions.append(f' (assert= {expected_sx} (eval-hs "{hs_expr}"))')
|
||||||
|
|
||||||
# Pattern 2: Two-line — var result = await run(`expr`); expect(result).toBe(val)
|
# Pattern 2: Two-line — var result = await run(`expr`); expect(result).toBe(val)
|
||||||
if not assertions:
|
if not assertions:
|
||||||
run_match = re.search(
|
run_match = re.search(
|
||||||
|
|||||||
@@ -316,3 +316,11 @@
|
|||||||
:batchable true
|
:batchable true
|
||||||
:cacheable true
|
:cacheable true
|
||||||
:doc "Pretty-printed component source.")
|
:doc "Pretty-printed component source.")
|
||||||
|
|
||||||
|
(defio
|
||||||
|
"text-measure"
|
||||||
|
:category :data
|
||||||
|
:params (font size text)
|
||||||
|
:returns "dict"
|
||||||
|
:cacheable true
|
||||||
|
:doc "Measure text glyph metrics. Returns {:width :height :ascent :descent}.")
|
||||||
|
|||||||
Reference in New Issue
Block a user