Hyperscript: hide/show strategy (opacity/visibility), add/remove query-all
Parser: hide/show handle `with opacity/visibility/display` strategy and properly detect target vs command boundaries. Compiler: emit correct CSS property per strategy, add-class/remove-class use for-each+query-all for class selectors. Runtime: hs-query-all uses dom-body, hs-each helper for collection iteration. Generator: inline run().toEqual() pattern for eval-only tests. 372/831 (45%) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -751,10 +751,21 @@
|
||||
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
|
||||
(list (quote hs-query-last) (nth ast 1))))
|
||||
((= head (quote add-class))
|
||||
(list
|
||||
(quote dom-add-class)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
(let
|
||||
((raw-tgt (nth ast 2)))
|
||||
(if
|
||||
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote _el))
|
||||
(list (quote dom-add-class) (quote _el) (nth ast 1)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-add-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(nth ast 1)))))
|
||||
((= head (quote multi-add-class))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1)))
|
||||
@@ -774,10 +785,24 @@
|
||||
(fn (cls) (list (quote dom-remove-class) target cls))
|
||||
classes))))
|
||||
((= head (quote remove-class))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
(let
|
||||
((raw-tgt (nth ast 2)))
|
||||
(if
|
||||
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote _el))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(quote _el)
|
||||
(nth ast 1)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(nth ast 1)))))
|
||||
((= head (quote toggle-class))
|
||||
(list
|
||||
(quote hs-toggle-class!)
|
||||
|
||||
@@ -13,45 +13,53 @@
|
||||
;; Register an event listener. Returns unlisten function.
|
||||
;; (hs-on target event-name handler) → unlisten-fn
|
||||
(define
|
||||
hs-on
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
hs-each
|
||||
(fn
|
||||
(target action)
|
||||
(if (list? target) (for-each action target) (action target))))
|
||||
|
||||
;; Register for every occurrence (no queuing — each fires independently).
|
||||
;; Stock hyperscript queues by default; "every" disables queuing.
|
||||
(define
|
||||
hs-on-every
|
||||
hs-on
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
|
||||
;; Run an initializer function immediately.
|
||||
;; (hs-init thunk) — called at element boot time
|
||||
(define hs-init (fn (thunk) (thunk)))
|
||||
(define
|
||||
hs-on-every
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
|
||||
;; ── Async / timing ──────────────────────────────────────────────
|
||||
|
||||
;; Wait for a duration in milliseconds.
|
||||
;; In hyperscript, wait is async-transparent — execution pauses.
|
||||
;; Here we use perform/IO suspension for true pause semantics.
|
||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||
(define hs-init (fn (thunk) (thunk)))
|
||||
|
||||
;; Wait for a DOM event on a target.
|
||||
;; (hs-wait-for target event-name) — suspends until event fires
|
||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define
|
||||
hs-wait-for
|
||||
(fn
|
||||
(target event-name)
|
||||
(perform (list (quote io-wait-event) target event-name))))
|
||||
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
|
||||
;; ── Class manipulation ──────────────────────────────────────────
|
||||
|
||||
;; Toggle a single class on an element.
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
(define
|
||||
hs-toggle-class!
|
||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
(define
|
||||
hs-toggle-between!
|
||||
(fn
|
||||
@@ -61,8 +69,10 @@
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
(define
|
||||
hs-toggle-style!
|
||||
(fn
|
||||
@@ -86,10 +96,9 @@
|
||||
(dom-set-style target prop "hidden")
|
||||
(dom-set-style target prop "")))))))
|
||||
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
;; Navigate to a URL.
|
||||
(define
|
||||
hs-take!
|
||||
(fn
|
||||
@@ -105,9 +114,7 @@
|
||||
(for-each (fn (el) (dom-remove-attr el name)) els)
|
||||
(dom-set-attr target name "true"))))))
|
||||
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Navigate to a URL.
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
@@ -120,10 +127,10 @@
|
||||
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
||||
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
|
||||
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
;; Find previous sibling matching a selector.
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
;; Find previous sibling matching a selector.
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-scroll!
|
||||
(fn
|
||||
@@ -136,7 +143,7 @@
|
||||
((= position "bottom") (dict :block "end"))
|
||||
(true (dict :block "start")))))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
@@ -146,12 +153,14 @@
|
||||
(host-call event "preventDefault" (list))
|
||||
(when (= mode "event") (host-call event "stopPropagation" (list))))))
|
||||
|
||||
;; Last element matching selector.
|
||||
;; First/last within a specific scope.
|
||||
(define hs-select! (fn (target) (host-call target "select" (list))))
|
||||
|
||||
;; First/last within a specific scope.
|
||||
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
(define
|
||||
hs-next
|
||||
(fn
|
||||
@@ -171,9 +180,7 @@
|
||||
(true (find-next (dom-next-sibling el))))))
|
||||
(find-next sibling)))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-previous
|
||||
(fn
|
||||
@@ -193,27 +200,24 @@
|
||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||
(find-prev sibling)))))
|
||||
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-query-all
|
||||
(fn
|
||||
(sel)
|
||||
(dom-query-all
|
||||
(host-call (host-global "document") "querySelector" (list "body"))
|
||||
sel)))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -222,17 +226,17 @@
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Install a behavior on an element.
|
||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||
;; (hs-install behavior-fn me ...args)
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -241,10 +245,10 @@
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -254,10 +258,6 @@
|
||||
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
||||
(do-repeat 0)))
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -365,14 +365,14 @@
|
||||
(value type-name)
|
||||
(if (nil? value) false (hs-type-check value type-name))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-falsy?
|
||||
(fn
|
||||
@@ -384,7 +384,8 @@
|
||||
((and (list? v) (= (len v) 0)) true)
|
||||
((= v 0) true)
|
||||
(true false))))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-matches?
|
||||
(fn
|
||||
@@ -393,8 +394,7 @@
|
||||
(string? target)
|
||||
(if (= pattern ".*") true (string-contains? target pattern))
|
||||
false)))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-contains?
|
||||
(fn
|
||||
@@ -414,7 +414,7 @@
|
||||
true
|
||||
(hs-contains? (rest collection) item)))))
|
||||
(true false))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-empty?
|
||||
(fn
|
||||
@@ -425,13 +425,13 @@
|
||||
((list? v) (= (len v) 0))
|
||||
((dict? v) (= (len (keys v)) 0))
|
||||
(true false))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-template
|
||||
(fn
|
||||
@@ -517,7 +517,7 @@
|
||||
(set! i (+ i 1))
|
||||
(tpl-loop)))))))
|
||||
(do (tpl-loop) result))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-make-object
|
||||
(fn
|
||||
@@ -529,7 +529,7 @@
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
pairs)
|
||||
d))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-method-call
|
||||
(fn
|
||||
@@ -552,11 +552,11 @@
|
||||
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
||||
(idx-loop obj 0)))
|
||||
(true nil))))
|
||||
;; Collection: sorted by descending
|
||||
(define hs-beep (fn (v) v))
|
||||
;; Collection: split by
|
||||
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||
(define hs-beep (fn (v) v))
|
||||
;; Collection: joined by
|
||||
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||
|
||||
(define
|
||||
hs-slice
|
||||
(fn
|
||||
|
||||
@@ -751,10 +751,21 @@
|
||||
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
|
||||
(list (quote hs-query-last) (nth ast 1))))
|
||||
((= head (quote add-class))
|
||||
(list
|
||||
(quote dom-add-class)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
(let
|
||||
((raw-tgt (nth ast 2)))
|
||||
(if
|
||||
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote _el))
|
||||
(list (quote dom-add-class) (quote _el) (nth ast 1)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-add-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(nth ast 1)))))
|
||||
((= head (quote multi-add-class))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1)))
|
||||
@@ -774,10 +785,24 @@
|
||||
(fn (cls) (list (quote dom-remove-class) target cls))
|
||||
classes))))
|
||||
((= head (quote remove-class))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
(let
|
||||
((raw-tgt (nth ast 2)))
|
||||
(if
|
||||
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote _el))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(quote _el)
|
||||
(nth ast 1)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(nth ast 1)))))
|
||||
((= head (quote toggle-class))
|
||||
(list
|
||||
(quote hs-toggle-class!)
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -13,45 +13,53 @@
|
||||
;; Register an event listener. Returns unlisten function.
|
||||
;; (hs-on target event-name handler) → unlisten-fn
|
||||
(define
|
||||
hs-on
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
hs-each
|
||||
(fn
|
||||
(target action)
|
||||
(if (list? target) (for-each action target) (action target))))
|
||||
|
||||
;; Register for every occurrence (no queuing — each fires independently).
|
||||
;; Stock hyperscript queues by default; "every" disables queuing.
|
||||
(define
|
||||
hs-on-every
|
||||
hs-on
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
|
||||
;; Run an initializer function immediately.
|
||||
;; (hs-init thunk) — called at element boot time
|
||||
(define hs-init (fn (thunk) (thunk)))
|
||||
(define
|
||||
hs-on-every
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
|
||||
;; ── Async / timing ──────────────────────────────────────────────
|
||||
|
||||
;; Wait for a duration in milliseconds.
|
||||
;; In hyperscript, wait is async-transparent — execution pauses.
|
||||
;; Here we use perform/IO suspension for true pause semantics.
|
||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||
(define hs-init (fn (thunk) (thunk)))
|
||||
|
||||
;; Wait for a DOM event on a target.
|
||||
;; (hs-wait-for target event-name) — suspends until event fires
|
||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define
|
||||
hs-wait-for
|
||||
(fn
|
||||
(target event-name)
|
||||
(perform (list (quote io-wait-event) target event-name))))
|
||||
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
|
||||
;; ── Class manipulation ──────────────────────────────────────────
|
||||
|
||||
;; Toggle a single class on an element.
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
(define
|
||||
hs-toggle-class!
|
||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
(define
|
||||
hs-toggle-between!
|
||||
(fn
|
||||
@@ -61,8 +69,10 @@
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
(define
|
||||
hs-toggle-style!
|
||||
(fn
|
||||
@@ -86,10 +96,9 @@
|
||||
(dom-set-style target prop "hidden")
|
||||
(dom-set-style target prop "")))))))
|
||||
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
;; Navigate to a URL.
|
||||
(define
|
||||
hs-take!
|
||||
(fn
|
||||
@@ -105,9 +114,7 @@
|
||||
(for-each (fn (el) (dom-remove-attr el name)) els)
|
||||
(dom-set-attr target name "true"))))))
|
||||
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Navigate to a URL.
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
@@ -120,10 +127,10 @@
|
||||
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
||||
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
|
||||
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
;; Find previous sibling matching a selector.
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
;; Find previous sibling matching a selector.
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-scroll!
|
||||
(fn
|
||||
@@ -136,7 +143,7 @@
|
||||
((= position "bottom") (dict :block "end"))
|
||||
(true (dict :block "start")))))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
@@ -146,12 +153,14 @@
|
||||
(host-call event "preventDefault" (list))
|
||||
(when (= mode "event") (host-call event "stopPropagation" (list))))))
|
||||
|
||||
;; Last element matching selector.
|
||||
;; First/last within a specific scope.
|
||||
(define hs-select! (fn (target) (host-call target "select" (list))))
|
||||
|
||||
;; First/last within a specific scope.
|
||||
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
(define
|
||||
hs-next
|
||||
(fn
|
||||
@@ -171,9 +180,7 @@
|
||||
(true (find-next (dom-next-sibling el))))))
|
||||
(find-next sibling)))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-previous
|
||||
(fn
|
||||
@@ -193,27 +200,24 @@
|
||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||
(find-prev sibling)))))
|
||||
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-query-all
|
||||
(fn
|
||||
(sel)
|
||||
(dom-query-all
|
||||
(host-call (host-global "document") "querySelector" (list "body"))
|
||||
sel)))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -222,17 +226,17 @@
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Install a behavior on an element.
|
||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||
;; (hs-install behavior-fn me ...args)
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -241,10 +245,10 @@
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -254,10 +258,6 @@
|
||||
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
||||
(do-repeat 0)))
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -365,14 +365,14 @@
|
||||
(value type-name)
|
||||
(if (nil? value) false (hs-type-check value type-name))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-falsy?
|
||||
(fn
|
||||
@@ -384,7 +384,8 @@
|
||||
((and (list? v) (= (len v) 0)) true)
|
||||
((= v 0) true)
|
||||
(true false))))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-matches?
|
||||
(fn
|
||||
@@ -393,8 +394,7 @@
|
||||
(string? target)
|
||||
(if (= pattern ".*") true (string-contains? target pattern))
|
||||
false)))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-contains?
|
||||
(fn
|
||||
@@ -414,7 +414,7 @@
|
||||
true
|
||||
(hs-contains? (rest collection) item)))))
|
||||
(true false))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-empty?
|
||||
(fn
|
||||
@@ -425,13 +425,13 @@
|
||||
((list? v) (= (len v) 0))
|
||||
((dict? v) (= (len (keys v)) 0))
|
||||
(true false))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-template
|
||||
(fn
|
||||
@@ -517,7 +517,7 @@
|
||||
(set! i (+ i 1))
|
||||
(tpl-loop)))))))
|
||||
(do (tpl-loop) result))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-make-object
|
||||
(fn
|
||||
@@ -529,7 +529,7 @@
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
pairs)
|
||||
d))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-method-call
|
||||
(fn
|
||||
@@ -552,11 +552,11 @@
|
||||
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
||||
(idx-loop obj 0)))
|
||||
(true nil))))
|
||||
;; Collection: sorted by descending
|
||||
(define hs-beep (fn (v) v))
|
||||
;; Collection: split by
|
||||
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||
(define hs-beep (fn (v) v))
|
||||
;; Collection: joined by
|
||||
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||
|
||||
(define
|
||||
hs-slice
|
||||
(fn
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -955,6 +955,7 @@
|
||||
"hs-compiler"
|
||||
],
|
||||
"exports": [
|
||||
"hs-each",
|
||||
"hs-on",
|
||||
"hs-on-every",
|
||||
"hs-init",
|
||||
|
||||
@@ -343,25 +343,7 @@
|
||||
((tokens (list)))
|
||||
(dict-set! step-ref "v" 0)
|
||||
(build-code-tokens (first parsed) tokens step-ref 0)
|
||||
(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))))))
|
||||
(reset! code-tokens tokens)))))
|
||||
(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 () (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
|
||||
|
||||
@@ -1,306 +1,329 @@
|
||||
;; 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.
|
||||
;; Visual-first: shows typeset text, then explains how.
|
||||
;; All layout computed server-side in pure SX.
|
||||
|
||||
;; Render a single line of positioned words
|
||||
(defcomp
|
||||
~pretext-demo/render-line
|
||||
(&key line-words line-widths gap-w y)
|
||||
(let
|
||||
((positions (list)) (x 0))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((w (nth line-words i)) (ww (nth line-widths i)))
|
||||
(append!
|
||||
positions
|
||||
(span
|
||||
:style (str
|
||||
"position:absolute;left:"
|
||||
(+ x 16)
|
||||
"px;top:"
|
||||
(+ y 12)
|
||||
"px;font-size:15px;line-height:24px;white-space:nowrap;")
|
||||
w))
|
||||
(set! x (+ x ww gap-w))))
|
||||
(range (len line-words)))
|
||||
positions))
|
||||
|
||||
;; Render a paragraph as positioned words using break-lines output
|
||||
(defcomp
|
||||
~pretext-demo/typeset-block
|
||||
(&key words widths space-width max-width line-height label)
|
||||
(let
|
||||
((ranges (break-lines widths space-width max-width))
|
||||
(lh (or line-height 24)))
|
||||
(div
|
||||
(~tw
|
||||
:tokens "relative rounded-lg border border-stone-200 bg-white overflow-hidden")
|
||||
(when
|
||||
label
|
||||
(div
|
||||
(~tw :tokens "px-4 pt-3 pb-1")
|
||||
(span
|
||||
(~tw
|
||||
:tokens "text-xs font-medium uppercase tracking-wide text-stone-400")
|
||||
label)))
|
||||
(div
|
||||
:style (str
|
||||
"position:relative;height:"
|
||||
(* (len ranges) lh)
|
||||
"px;padding:12px 16px;")
|
||||
(map-indexed
|
||||
(fn
|
||||
(line-idx range)
|
||||
(let
|
||||
((start (first range))
|
||||
(end (nth range 1))
|
||||
(y (* line-idx lh))
|
||||
(line-words (slice words start end))
|
||||
(line-widths (slice widths start end))
|
||||
(total-word-w (reduce + 0 line-widths))
|
||||
(gaps (max 1 (- (len line-words) 1)))
|
||||
(slack (- max-width total-word-w))
|
||||
(is-last (= line-idx (- (len ranges) 1)))
|
||||
(gap-w (if is-last space-width (/ slack gaps))))
|
||||
(~pretext-demo/render-line
|
||||
:line-words line-words
|
||||
:line-widths line-widths
|
||||
:gap-w gap-w
|
||||
:y y)))
|
||||
ranges))
|
||||
(div
|
||||
(~tw
|
||||
:tokens "px-4 py-2 border-t border-stone-100 bg-stone-50 flex justify-between")
|
||||
(span
|
||||
(~tw :tokens "text-xs text-stone-400")
|
||||
(str (len ranges) " lines, " (len words) " words"))
|
||||
(span
|
||||
(~tw :tokens "text-xs text-stone-400")
|
||||
(str "width: " max-width "px"))))))
|
||||
|
||||
;; Simple greedy word wrap for comparison
|
||||
(defcomp
|
||||
~pretext-demo/greedy-block
|
||||
(&key words widths space-width max-width line-height label)
|
||||
(let
|
||||
((n (len widths))
|
||||
(lines (list))
|
||||
(current-start 0)
|
||||
(current-width 0)
|
||||
(lh (or line-height 24)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((w (nth widths i))
|
||||
(needed
|
||||
(if (= i current-start) w (+ current-width space-width w))))
|
||||
(if
|
||||
(and (> needed max-width) (not (= i current-start)))
|
||||
(do
|
||||
(append! lines (list current-start i))
|
||||
(set! current-start i)
|
||||
(set! current-width w))
|
||||
(set! current-width needed))))
|
||||
(range n))
|
||||
(append! lines (list current-start n))
|
||||
(div
|
||||
(~tw
|
||||
:tokens "relative rounded-lg border border-stone-200 bg-white overflow-hidden")
|
||||
(when
|
||||
label
|
||||
(div
|
||||
(~tw :tokens "px-4 pt-3 pb-1")
|
||||
(span
|
||||
(~tw
|
||||
:tokens "text-xs font-medium uppercase tracking-wide text-stone-400")
|
||||
label)))
|
||||
(div
|
||||
:style (str
|
||||
"position:relative;height:"
|
||||
(* (len lines) lh)
|
||||
"px;padding:12px 16px;")
|
||||
(map-indexed
|
||||
(fn
|
||||
(line-idx range)
|
||||
(let
|
||||
((start (first range))
|
||||
(end (nth range 1))
|
||||
(y (* line-idx lh))
|
||||
(line-words (slice words start end))
|
||||
(line-widths (slice widths start end))
|
||||
(total-word-w (reduce + 0 line-widths))
|
||||
(gaps (max 1 (- (len line-words) 1)))
|
||||
(slack (- max-width total-word-w))
|
||||
(is-last (= line-idx (- (len lines) 1)))
|
||||
(gap-w (if is-last space-width (/ slack gaps))))
|
||||
(~pretext-demo/render-line
|
||||
:line-words line-words
|
||||
:line-widths line-widths
|
||||
:gap-w gap-w
|
||||
:y y)))
|
||||
lines))
|
||||
(div
|
||||
(~tw
|
||||
:tokens "px-4 py-2 border-t border-stone-100 bg-stone-50 flex justify-between")
|
||||
(span
|
||||
(~tw :tokens "text-xs text-stone-400")
|
||||
(str (len lines) " lines (greedy)"))
|
||||
(span
|
||||
(~tw :tokens "text-xs text-stone-400")
|
||||
(str "width: " max-width "px"))))))
|
||||
|
||||
(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
|
||||
((sample-text "In the beginning was the Word, and the Word was with God, and the Word was God. The same was in the beginning with God. All things were made by him; and without him was not any thing made that was made. In him was life; and the life was the light of men.")
|
||||
(sample-words
|
||||
(split
|
||||
"In the beginning was the Word, and the Word was with God, and the Word was God. The same was in the beginning with God. All things were made by him; and without him was not any thing made that was made. In him was life; and the life was the light of men."
|
||||
" "))
|
||||
(char-w 9.6)
|
||||
(space-w 9.6))
|
||||
(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)))
|
||||
((sample-widths (map (fn (w) (* (len w) char-w)) sample-words)))
|
||||
(div
|
||||
(~tw :tokens "space-y-10")
|
||||
(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")
|
||||
(~tw :tokens "space-y-4")
|
||||
(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))
|
||||
(h1
|
||||
(~tw :tokens "text-3xl font-bold text-stone-900 tracking-tight")
|
||||
"Pretext")
|
||||
(p
|
||||
(~tw :tokens "mt-1 text-lg text-stone-500")
|
||||
"DOM-free text layout. One IO boundary. Pure arithmetic."))
|
||||
(div
|
||||
(~tw :tokens "max-w-xl mx-auto mt-6")
|
||||
(~pretext-demo/typeset-block
|
||||
:words sample-words
|
||||
:widths sample-widths
|
||||
:space-width space-w
|
||||
:max-width 520
|
||||
:label "Knuth-Plass optimal line breaking — John 1:1–4")))
|
||||
(div
|
||||
(~tw :tokens "rounded-lg border border-violet-200 bg-violet-50 p-5")
|
||||
(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"))))
|
||||
(~tw :tokens "text-sm text-violet-800")
|
||||
(strong "One ")
|
||||
(code (~tw :tokens "bg-violet-100 px-1 rounded") "perform")
|
||||
" for glyph measurement. Everything else — line breaking, positioning, hyphenation, justification — is pure SX functions over numbers. "
|
||||
"Server renders with font-table lookups. Browser uses "
|
||||
(code "canvas.measureText")
|
||||
". Same algorithm, same output."))
|
||||
(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")
|
||||
(~tw :tokens "space-y-3")
|
||||
(h2
|
||||
(~tw :tokens "text-xl font-semibold text-stone-800")
|
||||
"Greedy vs optimal")
|
||||
(p
|
||||
(~tw :tokens "text-sm text-stone-500")
|
||||
"Most web text uses greedy word wrap — break when the next word doesn't fit. "
|
||||
"Knuth-Plass considers all possible breaks simultaneously, minimizing total raggedness.")
|
||||
(let
|
||||
((narrow-widths (map (fn (w) (* (len w) 7.8)) sample-words))
|
||||
(narrow-sw 7.8)
|
||||
(narrow-max 340))
|
||||
(div
|
||||
(~tw :tokens "grid grid-cols-1 md:grid-cols-2 gap-4")
|
||||
(~pretext-demo/greedy-block
|
||||
:words sample-words
|
||||
:widths narrow-widths
|
||||
:space-width narrow-sw
|
||||
:max-width narrow-max
|
||||
:line-height 22
|
||||
:label "Greedy (browser default)")
|
||||
(~pretext-demo/typeset-block
|
||||
:words sample-words
|
||||
:widths narrow-widths
|
||||
:space-width narrow-sw
|
||||
:max-width narrow-max
|
||||
:line-height 22
|
||||
:label "Knuth-Plass optimal"))))
|
||||
(div
|
||||
(~tw :tokens "space-y-3")
|
||||
(h2
|
||||
(~tw :tokens "text-xl font-semibold text-stone-800")
|
||||
"How lines are scored")
|
||||
(p
|
||||
(~tw :tokens "text-sm text-stone-500")
|
||||
"Each line gets a badness score — how far it deviates from ideal width. "
|
||||
"The algorithm minimizes total demerits (1 + badness)² across all lines.")
|
||||
(div
|
||||
(~tw :tokens "grid grid-cols-1 md:grid-cols-3 gap-4")
|
||||
(~tw :tokens "grid grid-cols-4 md:grid-cols-8 gap-2")
|
||||
(map
|
||||
(fn
|
||||
(word)
|
||||
(used)
|
||||
(let
|
||||
((syllables (hyphenate-word trie word))
|
||||
(points (find-hyphenation-points trie word)))
|
||||
((bad (line-badness used 100))
|
||||
(pct (str (min used 100) "%")))
|
||||
(div
|
||||
(~tw :tokens "rounded border border-stone-200 p-4")
|
||||
(~tw
|
||||
:tokens "rounded border border-stone-200 p-2 text-center")
|
||||
(div
|
||||
:style (str
|
||||
"height:4px;background:linear-gradient(90deg,hsl(263,70%,50%) "
|
||||
pct
|
||||
",#e7e5e4 "
|
||||
pct
|
||||
");border-radius:2px;margin-bottom:6px;")
|
||||
"")
|
||||
(div
|
||||
(~tw :tokens "text-sm font-mono font-bold")
|
||||
(if
|
||||
(>= bad 100000)
|
||||
(span (~tw :tokens "text-red-500") "∞")
|
||||
(span (~tw :tokens "text-stone-700") (str bad))))
|
||||
(div
|
||||
(~tw :tokens "text-xs text-stone-400 mt-0.5")
|
||||
(str used "%")))))
|
||||
(list 100 95 90 85 80 70 50 110))))
|
||||
(div
|
||||
(~tw :tokens "space-y-3")
|
||||
(h2
|
||||
(~tw :tokens "text-xl font-semibold text-stone-800")
|
||||
"Hyphenation")
|
||||
(p
|
||||
(~tw :tokens "text-sm text-stone-500")
|
||||
"Liang's algorithm: a trie of character patterns with numeric levels. "
|
||||
"Odd levels mark valid break points.")
|
||||
(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" "ty1" "1graph" "2ph"))))
|
||||
(div
|
||||
(~tw :tokens "flex flex-wrap gap-3")
|
||||
(map
|
||||
(fn
|
||||
(word)
|
||||
(let
|
||||
((syllables (hyphenate-word trie word)))
|
||||
(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"))))))
|
||||
:tokens "rounded-lg border border-stone-200 bg-white px-4 py-3 text-center")
|
||||
(div
|
||||
(~tw
|
||||
:tokens "text-lg font-mono font-semibold text-stone-800 tracking-wide")
|
||||
(map-indexed
|
||||
(fn
|
||||
(i syl)
|
||||
(if
|
||||
(= i 0)
|
||||
(span syl)
|
||||
(list
|
||||
(span
|
||||
(~tw :tokens "text-violet-400 mx-0.5")
|
||||
"·")
|
||||
(span syl))))
|
||||
syllables))
|
||||
(div (~tw :tokens "text-xs text-stone-400 mt-1") word))))
|
||||
(list "hyphen" "computation" "programming" "typography")))))
|
||||
(div
|
||||
(~tw
|
||||
:tokens "rounded-lg border border-stone-200 bg-stone-50 p-5 space-y-2")
|
||||
(h3
|
||||
(~tw
|
||||
:tokens "text-sm font-semibold text-stone-600 uppercase tracking-wide")
|
||||
"The pipeline")
|
||||
(ol
|
||||
(~tw
|
||||
:tokens "list-decimal list-inside text-sm text-stone-600 space-y-1")
|
||||
(li
|
||||
(code "measure-text")
|
||||
" — the only IO. Server: font tables. Browser: "
|
||||
(code "canvas.measureText"))
|
||||
(li
|
||||
(code "break-lines")
|
||||
" — Knuth-Plass DP over word widths → optimal break points")
|
||||
(li
|
||||
(code "position-lines")
|
||||
" — pure arithmetic: widths + breaks → x,y coordinates")
|
||||
(li
|
||||
(code "hyphenate-word")
|
||||
" — Liang's trie: character patterns → syllable boundaries")
|
||||
(li
|
||||
"All layout is "
|
||||
(strong "deterministic")
|
||||
" — same widths → same positions, every time")))))))
|
||||
Reference in New Issue
Block a user