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-last) (hs-to-sx (nth ast 2)) (nth ast 1))
|
||||||
(list (quote hs-query-last) (nth ast 1))))
|
(list (quote hs-query-last) (nth ast 1))))
|
||||||
((= head (quote add-class))
|
((= head (quote add-class))
|
||||||
(list
|
(let
|
||||||
(quote dom-add-class)
|
((raw-tgt (nth ast 2)))
|
||||||
(hs-to-sx (nth ast 2))
|
(if
|
||||||
(nth ast 1)))
|
(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))
|
((= head (quote multi-add-class))
|
||||||
(let
|
(let
|
||||||
((target (hs-to-sx (nth ast 1)))
|
((target (hs-to-sx (nth ast 1)))
|
||||||
@@ -774,10 +785,24 @@
|
|||||||
(fn (cls) (list (quote dom-remove-class) target cls))
|
(fn (cls) (list (quote dom-remove-class) target cls))
|
||||||
classes))))
|
classes))))
|
||||||
((= head (quote remove-class))
|
((= head (quote remove-class))
|
||||||
(list
|
(let
|
||||||
(quote dom-remove-class)
|
((raw-tgt (nth ast 2)))
|
||||||
(hs-to-sx (nth ast 2))
|
(if
|
||||||
(nth ast 1)))
|
(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))
|
((= head (quote toggle-class))
|
||||||
(list
|
(list
|
||||||
(quote hs-toggle-class!)
|
(quote hs-toggle-class!)
|
||||||
|
|||||||
@@ -13,45 +13,53 @@
|
|||||||
;; Register an event listener. Returns unlisten function.
|
;; Register an event listener. Returns unlisten function.
|
||||||
;; (hs-on target event-name handler) → unlisten-fn
|
;; (hs-on target event-name handler) → unlisten-fn
|
||||||
(define
|
(define
|
||||||
hs-on
|
hs-each
|
||||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
(fn
|
||||||
|
(target action)
|
||||||
|
(if (list? target) (for-each action target) (action target))))
|
||||||
|
|
||||||
;; Register for every occurrence (no queuing — each fires independently).
|
;; Register for every occurrence (no queuing — each fires independently).
|
||||||
;; Stock hyperscript queues by default; "every" disables queuing.
|
;; Stock hyperscript queues by default; "every" disables queuing.
|
||||||
(define
|
(define
|
||||||
hs-on-every
|
hs-on
|
||||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||||
|
|
||||||
;; Run an initializer function immediately.
|
;; Run an initializer function immediately.
|
||||||
;; (hs-init thunk) — called at element boot time
|
;; (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 ──────────────────────────────────────────────
|
;; ── Async / timing ──────────────────────────────────────────────
|
||||||
|
|
||||||
;; Wait for a duration in milliseconds.
|
;; Wait for a duration in milliseconds.
|
||||||
;; In hyperscript, wait is async-transparent — execution pauses.
|
;; In hyperscript, wait is async-transparent — execution pauses.
|
||||||
;; Here we use perform/IO suspension for true pause semantics.
|
;; 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.
|
;; Wait for a DOM event on a target.
|
||||||
;; (hs-wait-for target event-name) — suspends until event fires
|
;; (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
|
(define
|
||||||
hs-wait-for
|
hs-wait-for
|
||||||
(fn
|
(fn
|
||||||
(target event-name)
|
(target event-name)
|
||||||
(perform (list (quote io-wait-event) 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 ──────────────────────────────────────────
|
;; ── Class manipulation ──────────────────────────────────────────
|
||||||
|
|
||||||
;; Toggle a single class on an element.
|
;; 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
|
(define
|
||||||
hs-toggle-class!
|
hs-toggle-class!
|
||||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
(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
|
(define
|
||||||
hs-toggle-between!
|
hs-toggle-between!
|
||||||
(fn
|
(fn
|
||||||
@@ -61,8 +69,10 @@
|
|||||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||||
|
|
||||||
;; Take a class from siblings — add to target, remove from others.
|
;; ── DOM insertion ───────────────────────────────────────────────
|
||||||
;; (hs-take! target cls) — like radio button class behavior
|
|
||||||
|
;; Put content at a position relative to a target.
|
||||||
|
;; pos: "into" | "before" | "after"
|
||||||
(define
|
(define
|
||||||
hs-toggle-style!
|
hs-toggle-style!
|
||||||
(fn
|
(fn
|
||||||
@@ -86,10 +96,9 @@
|
|||||||
(dom-set-style target prop "hidden")
|
(dom-set-style target prop "hidden")
|
||||||
(dom-set-style target prop "")))))))
|
(dom-set-style target prop "")))))))
|
||||||
|
|
||||||
;; ── DOM insertion ───────────────────────────────────────────────
|
;; ── Navigation / traversal ──────────────────────────────────────
|
||||||
|
|
||||||
;; Put content at a position relative to a target.
|
;; Navigate to a URL.
|
||||||
;; pos: "into" | "before" | "after"
|
|
||||||
(define
|
(define
|
||||||
hs-take!
|
hs-take!
|
||||||
(fn
|
(fn
|
||||||
@@ -105,9 +114,7 @@
|
|||||||
(for-each (fn (el) (dom-remove-attr el name)) els)
|
(for-each (fn (el) (dom-remove-attr el name)) els)
|
||||||
(dom-set-attr target name "true"))))))
|
(dom-set-attr target name "true"))))))
|
||||||
|
|
||||||
;; ── Navigation / traversal ──────────────────────────────────────
|
;; Find next sibling matching a selector (or any sibling).
|
||||||
|
|
||||||
;; Navigate to a URL.
|
|
||||||
(define
|
(define
|
||||||
hs-put!
|
hs-put!
|
||||||
(fn
|
(fn
|
||||||
@@ -120,10 +127,10 @@
|
|||||||
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
||||||
((= pos "end") (dom-insert-adjacent-html target "beforeend" 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))))
|
(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
|
(define
|
||||||
hs-scroll!
|
hs-scroll!
|
||||||
(fn
|
(fn
|
||||||
@@ -136,7 +143,7 @@
|
|||||||
((= position "bottom") (dict :block "end"))
|
((= position "bottom") (dict :block "end"))
|
||||||
(true (dict :block "start")))))))
|
(true (dict :block "start")))))))
|
||||||
|
|
||||||
;; First element matching selector within a scope.
|
;; Last element matching selector.
|
||||||
(define
|
(define
|
||||||
hs-halt!
|
hs-halt!
|
||||||
(fn
|
(fn
|
||||||
@@ -146,12 +153,14 @@
|
|||||||
(host-call event "preventDefault" (list))
|
(host-call event "preventDefault" (list))
|
||||||
(when (= mode "event") (host-call event "stopPropagation" (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))))
|
(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))))
|
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||||
|
|
||||||
|
;; ── Iteration ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Repeat a thunk N times.
|
||||||
(define
|
(define
|
||||||
hs-next
|
hs-next
|
||||||
(fn
|
(fn
|
||||||
@@ -171,9 +180,7 @@
|
|||||||
(true (find-next (dom-next-sibling el))))))
|
(true (find-next (dom-next-sibling el))))))
|
||||||
(find-next sibling)))))
|
(find-next sibling)))))
|
||||||
|
|
||||||
;; ── Iteration ───────────────────────────────────────────────────
|
;; Repeat forever (until break — relies on exception/continuation).
|
||||||
|
|
||||||
;; Repeat a thunk N times.
|
|
||||||
(define
|
(define
|
||||||
hs-previous
|
hs-previous
|
||||||
(fn
|
(fn
|
||||||
@@ -193,27 +200,24 @@
|
|||||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||||
(find-prev sibling)))))
|
(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 ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
;; Fetch a URL, parse response according to format.
|
;; Fetch a URL, parse response according to format.
|
||||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||||
(define
|
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
||||||
hs-query-first
|
|
||||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
|
||||||
|
|
||||||
;; ── Type coercion ───────────────────────────────────────────────
|
;; ── Type coercion ───────────────────────────────────────────────
|
||||||
|
|
||||||
;; Coerce a value to a type by name.
|
;; Coerce a value to a type by name.
|
||||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
;; (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
|
(define
|
||||||
hs-query-last
|
hs-query-last
|
||||||
(fn
|
(fn
|
||||||
@@ -222,17 +226,17 @@
|
|||||||
((all (dom-query-all (dom-body) sel)))
|
((all (dom-query-all (dom-body) sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(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 ───────────────────────────────────────
|
;; ── Behavior installation ───────────────────────────────────────
|
||||||
|
|
||||||
;; Install a behavior on an element.
|
;; Install a behavior on an element.
|
||||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||||
;; (hs-install behavior-fn me ...args)
|
;; (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
|
(define
|
||||||
hs-last
|
hs-last
|
||||||
(fn
|
(fn
|
||||||
@@ -241,10 +245,10 @@
|
|||||||
((all (dom-query-all scope sel)))
|
((all (dom-query-all scope sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||||
|
|
||||||
;; ── Measurement ─────────────────────────────────────────────────
|
;; ── Transition ──────────────────────────────────────────────────
|
||||||
|
|
||||||
;; Measure an element's bounding rect, store as local variables.
|
;; Transition a CSS property to a value, optionally with duration.
|
||||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
;; (hs-transition target prop value duration)
|
||||||
(define
|
(define
|
||||||
hs-repeat-times
|
hs-repeat-times
|
||||||
(fn
|
(fn
|
||||||
@@ -254,10 +258,6 @@
|
|||||||
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
||||||
(do-repeat 0)))
|
(do-repeat 0)))
|
||||||
|
|
||||||
;; ── Transition ──────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Transition a CSS property to a value, optionally with duration.
|
|
||||||
;; (hs-transition target prop value duration)
|
|
||||||
(define
|
(define
|
||||||
hs-repeat-forever
|
hs-repeat-forever
|
||||||
(fn
|
(fn
|
||||||
@@ -365,14 +365,14 @@
|
|||||||
(value type-name)
|
(value type-name)
|
||||||
(if (nil? value) false (hs-type-check value type-name))))
|
(if (nil? value) false (hs-type-check value type-name))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-strict-eq
|
hs-strict-eq
|
||||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-falsy?
|
hs-falsy?
|
||||||
(fn
|
(fn
|
||||||
@@ -384,7 +384,8 @@
|
|||||||
((and (list? v) (= (len v) 0)) true)
|
((and (list? v) (= (len v) 0)) true)
|
||||||
((= v 0) true)
|
((= v 0) true)
|
||||||
(true false))))
|
(true false))))
|
||||||
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||||
|
;; Property access — dot notation and .length
|
||||||
(define
|
(define
|
||||||
hs-matches?
|
hs-matches?
|
||||||
(fn
|
(fn
|
||||||
@@ -393,8 +394,7 @@
|
|||||||
(string? target)
|
(string? target)
|
||||||
(if (= pattern ".*") true (string-contains? target pattern))
|
(if (= pattern ".*") true (string-contains? target pattern))
|
||||||
false)))
|
false)))
|
||||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
;; DOM query stub — sandbox returns empty list
|
||||||
;; Property access — dot notation and .length
|
|
||||||
(define
|
(define
|
||||||
hs-contains?
|
hs-contains?
|
||||||
(fn
|
(fn
|
||||||
@@ -414,7 +414,7 @@
|
|||||||
true
|
true
|
||||||
(hs-contains? (rest collection) item)))))
|
(hs-contains? (rest collection) item)))))
|
||||||
(true false))))
|
(true false))))
|
||||||
;; DOM query stub — sandbox returns empty list
|
;; Method dispatch — obj.method(args)
|
||||||
(define
|
(define
|
||||||
hs-empty?
|
hs-empty?
|
||||||
(fn
|
(fn
|
||||||
@@ -425,13 +425,13 @@
|
|||||||
((list? v) (= (len v) 0))
|
((list? v) (= (len v) 0))
|
||||||
((dict? v) (= (len (keys v)) 0))
|
((dict? v) (= (len (keys v)) 0))
|
||||||
(true false))))
|
(true false))))
|
||||||
;; Method dispatch — obj.method(args)
|
|
||||||
(define hs-first (fn (lst) (first lst)))
|
|
||||||
|
|
||||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||||
;; beep! — debug logging, returns value unchanged
|
;; 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
|
;; Property-based is — check obj.key truthiness
|
||||||
|
(define hs-last (fn (lst) (last lst)))
|
||||||
|
;; Array slicing (inclusive both ends)
|
||||||
(define
|
(define
|
||||||
hs-template
|
hs-template
|
||||||
(fn
|
(fn
|
||||||
@@ -517,7 +517,7 @@
|
|||||||
(set! i (+ i 1))
|
(set! i (+ i 1))
|
||||||
(tpl-loop)))))))
|
(tpl-loop)))))))
|
||||||
(do (tpl-loop) result))))
|
(do (tpl-loop) result))))
|
||||||
;; Array slicing (inclusive both ends)
|
;; Collection: sorted by
|
||||||
(define
|
(define
|
||||||
hs-make-object
|
hs-make-object
|
||||||
(fn
|
(fn
|
||||||
@@ -529,7 +529,7 @@
|
|||||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||||
pairs)
|
pairs)
|
||||||
d))))
|
d))))
|
||||||
;; Collection: sorted by
|
;; Collection: sorted by descending
|
||||||
(define
|
(define
|
||||||
hs-method-call
|
hs-method-call
|
||||||
(fn
|
(fn
|
||||||
@@ -552,11 +552,11 @@
|
|||||||
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
||||||
(idx-loop obj 0)))
|
(idx-loop obj 0)))
|
||||||
(true nil))))
|
(true nil))))
|
||||||
;; Collection: sorted by descending
|
|
||||||
(define hs-beep (fn (v) v))
|
|
||||||
;; Collection: split by
|
;; 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
|
;; Collection: joined by
|
||||||
|
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-slice
|
hs-slice
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -751,10 +751,21 @@
|
|||||||
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
|
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
|
||||||
(list (quote hs-query-last) (nth ast 1))))
|
(list (quote hs-query-last) (nth ast 1))))
|
||||||
((= head (quote add-class))
|
((= head (quote add-class))
|
||||||
(list
|
(let
|
||||||
(quote dom-add-class)
|
((raw-tgt (nth ast 2)))
|
||||||
(hs-to-sx (nth ast 2))
|
(if
|
||||||
(nth ast 1)))
|
(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))
|
((= head (quote multi-add-class))
|
||||||
(let
|
(let
|
||||||
((target (hs-to-sx (nth ast 1)))
|
((target (hs-to-sx (nth ast 1)))
|
||||||
@@ -774,10 +785,24 @@
|
|||||||
(fn (cls) (list (quote dom-remove-class) target cls))
|
(fn (cls) (list (quote dom-remove-class) target cls))
|
||||||
classes))))
|
classes))))
|
||||||
((= head (quote remove-class))
|
((= head (quote remove-class))
|
||||||
(list
|
(let
|
||||||
(quote dom-remove-class)
|
((raw-tgt (nth ast 2)))
|
||||||
(hs-to-sx (nth ast 2))
|
(if
|
||||||
(nth ast 1)))
|
(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))
|
((= head (quote toggle-class))
|
||||||
(list
|
(list
|
||||||
(quote hs-toggle-class!)
|
(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.
|
;; Register an event listener. Returns unlisten function.
|
||||||
;; (hs-on target event-name handler) → unlisten-fn
|
;; (hs-on target event-name handler) → unlisten-fn
|
||||||
(define
|
(define
|
||||||
hs-on
|
hs-each
|
||||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
(fn
|
||||||
|
(target action)
|
||||||
|
(if (list? target) (for-each action target) (action target))))
|
||||||
|
|
||||||
;; Register for every occurrence (no queuing — each fires independently).
|
;; Register for every occurrence (no queuing — each fires independently).
|
||||||
;; Stock hyperscript queues by default; "every" disables queuing.
|
;; Stock hyperscript queues by default; "every" disables queuing.
|
||||||
(define
|
(define
|
||||||
hs-on-every
|
hs-on
|
||||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||||
|
|
||||||
;; Run an initializer function immediately.
|
;; Run an initializer function immediately.
|
||||||
;; (hs-init thunk) — called at element boot time
|
;; (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 ──────────────────────────────────────────────
|
;; ── Async / timing ──────────────────────────────────────────────
|
||||||
|
|
||||||
;; Wait for a duration in milliseconds.
|
;; Wait for a duration in milliseconds.
|
||||||
;; In hyperscript, wait is async-transparent — execution pauses.
|
;; In hyperscript, wait is async-transparent — execution pauses.
|
||||||
;; Here we use perform/IO suspension for true pause semantics.
|
;; 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.
|
;; Wait for a DOM event on a target.
|
||||||
;; (hs-wait-for target event-name) — suspends until event fires
|
;; (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
|
(define
|
||||||
hs-wait-for
|
hs-wait-for
|
||||||
(fn
|
(fn
|
||||||
(target event-name)
|
(target event-name)
|
||||||
(perform (list (quote io-wait-event) 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 ──────────────────────────────────────────
|
;; ── Class manipulation ──────────────────────────────────────────
|
||||||
|
|
||||||
;; Toggle a single class on an element.
|
;; 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
|
(define
|
||||||
hs-toggle-class!
|
hs-toggle-class!
|
||||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
(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
|
(define
|
||||||
hs-toggle-between!
|
hs-toggle-between!
|
||||||
(fn
|
(fn
|
||||||
@@ -61,8 +69,10 @@
|
|||||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||||
|
|
||||||
;; Take a class from siblings — add to target, remove from others.
|
;; ── DOM insertion ───────────────────────────────────────────────
|
||||||
;; (hs-take! target cls) — like radio button class behavior
|
|
||||||
|
;; Put content at a position relative to a target.
|
||||||
|
;; pos: "into" | "before" | "after"
|
||||||
(define
|
(define
|
||||||
hs-toggle-style!
|
hs-toggle-style!
|
||||||
(fn
|
(fn
|
||||||
@@ -86,10 +96,9 @@
|
|||||||
(dom-set-style target prop "hidden")
|
(dom-set-style target prop "hidden")
|
||||||
(dom-set-style target prop "")))))))
|
(dom-set-style target prop "")))))))
|
||||||
|
|
||||||
;; ── DOM insertion ───────────────────────────────────────────────
|
;; ── Navigation / traversal ──────────────────────────────────────
|
||||||
|
|
||||||
;; Put content at a position relative to a target.
|
;; Navigate to a URL.
|
||||||
;; pos: "into" | "before" | "after"
|
|
||||||
(define
|
(define
|
||||||
hs-take!
|
hs-take!
|
||||||
(fn
|
(fn
|
||||||
@@ -105,9 +114,7 @@
|
|||||||
(for-each (fn (el) (dom-remove-attr el name)) els)
|
(for-each (fn (el) (dom-remove-attr el name)) els)
|
||||||
(dom-set-attr target name "true"))))))
|
(dom-set-attr target name "true"))))))
|
||||||
|
|
||||||
;; ── Navigation / traversal ──────────────────────────────────────
|
;; Find next sibling matching a selector (or any sibling).
|
||||||
|
|
||||||
;; Navigate to a URL.
|
|
||||||
(define
|
(define
|
||||||
hs-put!
|
hs-put!
|
||||||
(fn
|
(fn
|
||||||
@@ -120,10 +127,10 @@
|
|||||||
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
||||||
((= pos "end") (dom-insert-adjacent-html target "beforeend" 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))))
|
(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
|
(define
|
||||||
hs-scroll!
|
hs-scroll!
|
||||||
(fn
|
(fn
|
||||||
@@ -136,7 +143,7 @@
|
|||||||
((= position "bottom") (dict :block "end"))
|
((= position "bottom") (dict :block "end"))
|
||||||
(true (dict :block "start")))))))
|
(true (dict :block "start")))))))
|
||||||
|
|
||||||
;; First element matching selector within a scope.
|
;; Last element matching selector.
|
||||||
(define
|
(define
|
||||||
hs-halt!
|
hs-halt!
|
||||||
(fn
|
(fn
|
||||||
@@ -146,12 +153,14 @@
|
|||||||
(host-call event "preventDefault" (list))
|
(host-call event "preventDefault" (list))
|
||||||
(when (= mode "event") (host-call event "stopPropagation" (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))))
|
(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))))
|
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||||
|
|
||||||
|
;; ── Iteration ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Repeat a thunk N times.
|
||||||
(define
|
(define
|
||||||
hs-next
|
hs-next
|
||||||
(fn
|
(fn
|
||||||
@@ -171,9 +180,7 @@
|
|||||||
(true (find-next (dom-next-sibling el))))))
|
(true (find-next (dom-next-sibling el))))))
|
||||||
(find-next sibling)))))
|
(find-next sibling)))))
|
||||||
|
|
||||||
;; ── Iteration ───────────────────────────────────────────────────
|
;; Repeat forever (until break — relies on exception/continuation).
|
||||||
|
|
||||||
;; Repeat a thunk N times.
|
|
||||||
(define
|
(define
|
||||||
hs-previous
|
hs-previous
|
||||||
(fn
|
(fn
|
||||||
@@ -193,27 +200,24 @@
|
|||||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||||
(find-prev sibling)))))
|
(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 ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
;; Fetch a URL, parse response according to format.
|
;; Fetch a URL, parse response according to format.
|
||||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||||
(define
|
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
||||||
hs-query-first
|
|
||||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
|
||||||
|
|
||||||
;; ── Type coercion ───────────────────────────────────────────────
|
;; ── Type coercion ───────────────────────────────────────────────
|
||||||
|
|
||||||
;; Coerce a value to a type by name.
|
;; Coerce a value to a type by name.
|
||||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
;; (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
|
(define
|
||||||
hs-query-last
|
hs-query-last
|
||||||
(fn
|
(fn
|
||||||
@@ -222,17 +226,17 @@
|
|||||||
((all (dom-query-all (dom-body) sel)))
|
((all (dom-query-all (dom-body) sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(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 ───────────────────────────────────────
|
;; ── Behavior installation ───────────────────────────────────────
|
||||||
|
|
||||||
;; Install a behavior on an element.
|
;; Install a behavior on an element.
|
||||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||||
;; (hs-install behavior-fn me ...args)
|
;; (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
|
(define
|
||||||
hs-last
|
hs-last
|
||||||
(fn
|
(fn
|
||||||
@@ -241,10 +245,10 @@
|
|||||||
((all (dom-query-all scope sel)))
|
((all (dom-query-all scope sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||||
|
|
||||||
;; ── Measurement ─────────────────────────────────────────────────
|
;; ── Transition ──────────────────────────────────────────────────
|
||||||
|
|
||||||
;; Measure an element's bounding rect, store as local variables.
|
;; Transition a CSS property to a value, optionally with duration.
|
||||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
;; (hs-transition target prop value duration)
|
||||||
(define
|
(define
|
||||||
hs-repeat-times
|
hs-repeat-times
|
||||||
(fn
|
(fn
|
||||||
@@ -254,10 +258,6 @@
|
|||||||
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
||||||
(do-repeat 0)))
|
(do-repeat 0)))
|
||||||
|
|
||||||
;; ── Transition ──────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Transition a CSS property to a value, optionally with duration.
|
|
||||||
;; (hs-transition target prop value duration)
|
|
||||||
(define
|
(define
|
||||||
hs-repeat-forever
|
hs-repeat-forever
|
||||||
(fn
|
(fn
|
||||||
@@ -365,14 +365,14 @@
|
|||||||
(value type-name)
|
(value type-name)
|
||||||
(if (nil? value) false (hs-type-check value type-name))))
|
(if (nil? value) false (hs-type-check value type-name))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-strict-eq
|
hs-strict-eq
|
||||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-falsy?
|
hs-falsy?
|
||||||
(fn
|
(fn
|
||||||
@@ -384,7 +384,8 @@
|
|||||||
((and (list? v) (= (len v) 0)) true)
|
((and (list? v) (= (len v) 0)) true)
|
||||||
((= v 0) true)
|
((= v 0) true)
|
||||||
(true false))))
|
(true false))))
|
||||||
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||||
|
;; Property access — dot notation and .length
|
||||||
(define
|
(define
|
||||||
hs-matches?
|
hs-matches?
|
||||||
(fn
|
(fn
|
||||||
@@ -393,8 +394,7 @@
|
|||||||
(string? target)
|
(string? target)
|
||||||
(if (= pattern ".*") true (string-contains? target pattern))
|
(if (= pattern ".*") true (string-contains? target pattern))
|
||||||
false)))
|
false)))
|
||||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
;; DOM query stub — sandbox returns empty list
|
||||||
;; Property access — dot notation and .length
|
|
||||||
(define
|
(define
|
||||||
hs-contains?
|
hs-contains?
|
||||||
(fn
|
(fn
|
||||||
@@ -414,7 +414,7 @@
|
|||||||
true
|
true
|
||||||
(hs-contains? (rest collection) item)))))
|
(hs-contains? (rest collection) item)))))
|
||||||
(true false))))
|
(true false))))
|
||||||
;; DOM query stub — sandbox returns empty list
|
;; Method dispatch — obj.method(args)
|
||||||
(define
|
(define
|
||||||
hs-empty?
|
hs-empty?
|
||||||
(fn
|
(fn
|
||||||
@@ -425,13 +425,13 @@
|
|||||||
((list? v) (= (len v) 0))
|
((list? v) (= (len v) 0))
|
||||||
((dict? v) (= (len (keys v)) 0))
|
((dict? v) (= (len (keys v)) 0))
|
||||||
(true false))))
|
(true false))))
|
||||||
;; Method dispatch — obj.method(args)
|
|
||||||
(define hs-first (fn (lst) (first lst)))
|
|
||||||
|
|
||||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||||
;; beep! — debug logging, returns value unchanged
|
;; 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
|
;; Property-based is — check obj.key truthiness
|
||||||
|
(define hs-last (fn (lst) (last lst)))
|
||||||
|
;; Array slicing (inclusive both ends)
|
||||||
(define
|
(define
|
||||||
hs-template
|
hs-template
|
||||||
(fn
|
(fn
|
||||||
@@ -517,7 +517,7 @@
|
|||||||
(set! i (+ i 1))
|
(set! i (+ i 1))
|
||||||
(tpl-loop)))))))
|
(tpl-loop)))))))
|
||||||
(do (tpl-loop) result))))
|
(do (tpl-loop) result))))
|
||||||
;; Array slicing (inclusive both ends)
|
;; Collection: sorted by
|
||||||
(define
|
(define
|
||||||
hs-make-object
|
hs-make-object
|
||||||
(fn
|
(fn
|
||||||
@@ -529,7 +529,7 @@
|
|||||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||||
pairs)
|
pairs)
|
||||||
d))))
|
d))))
|
||||||
;; Collection: sorted by
|
;; Collection: sorted by descending
|
||||||
(define
|
(define
|
||||||
hs-method-call
|
hs-method-call
|
||||||
(fn
|
(fn
|
||||||
@@ -552,11 +552,11 @@
|
|||||||
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
||||||
(idx-loop obj 0)))
|
(idx-loop obj 0)))
|
||||||
(true nil))))
|
(true nil))))
|
||||||
;; Collection: sorted by descending
|
|
||||||
(define hs-beep (fn (v) v))
|
|
||||||
;; Collection: split by
|
;; 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
|
;; Collection: joined by
|
||||||
|
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-slice
|
hs-slice
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
@@ -955,6 +955,7 @@
|
|||||||
"hs-compiler"
|
"hs-compiler"
|
||||||
],
|
],
|
||||||
"exports": [
|
"exports": [
|
||||||
|
"hs-each",
|
||||||
"hs-on",
|
"hs-on",
|
||||||
"hs-on-every",
|
"hs-on-every",
|
||||||
"hs-init",
|
"hs-init",
|
||||||
|
|||||||
@@ -343,25 +343,7 @@
|
|||||||
((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 () (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))))))))))
|
((_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
|
||||||
|
|||||||
@@ -1,306 +1,329 @@
|
|||||||
;; Pretext demo — DOM-free text layout
|
;; Pretext demo — DOM-free text layout
|
||||||
;;
|
;;
|
||||||
;; Shows Knuth-Plass optimal line breaking and text positioning,
|
;; Visual-first: shows typeset text, then explains how.
|
||||||
;; computed entirely in pure SX with one IO primitive (text-measure).
|
;; All layout computed server-side in pure SX.
|
||||||
;; Server renders with monospace approximation; browser uses canvas.measureText.
|
|
||||||
|
;; 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
|
(defcomp
|
||||||
~pretext-demo/content
|
~pretext-demo/content
|
||||||
()
|
()
|
||||||
(div
|
(let
|
||||||
(~tw :tokens "space-y-8")
|
((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.")
|
||||||
(div
|
(sample-words
|
||||||
(~tw :tokens "border-b border-stone-200 pb-6")
|
(split
|
||||||
(h1
|
"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."
|
||||||
(~tw :tokens "text-2xl font-bold text-stone-900")
|
" "))
|
||||||
"Pretext: DOM-free Text Layout")
|
(char-w 9.6)
|
||||||
(p
|
(space-w 9.6))
|
||||||
(~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
|
(let
|
||||||
((widths (list 80 20 50 30 60 40 70 25 55 35))
|
((sample-widths (map (fn (w) (* (len w) char-w)) sample-words)))
|
||||||
(words
|
(div
|
||||||
(list
|
(~tw :tokens "space-y-10")
|
||||||
"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
|
(div
|
||||||
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
(~tw :tokens "space-y-4")
|
||||||
(h3
|
|
||||||
(~tw
|
|
||||||
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
|
||||||
"10 words, varying widths, max-width 120px")
|
|
||||||
(div
|
(div
|
||||||
(~tw :tokens "space-y-1")
|
(h1
|
||||||
(map-indexed
|
(~tw :tokens "text-3xl font-bold text-stone-900 tracking-tight")
|
||||||
(fn
|
"Pretext")
|
||||||
(line-idx line)
|
(p
|
||||||
(div
|
(~tw :tokens "mt-1 text-lg text-stone-500")
|
||||||
(~tw :tokens "flex items-baseline gap-1")
|
"DOM-free text layout. One IO boundary. Pure arithmetic."))
|
||||||
(span
|
(div
|
||||||
(~tw :tokens "text-xs text-stone-400 w-6 shrink-0")
|
(~tw :tokens "max-w-xl mx-auto mt-6")
|
||||||
(str "L" (str (+ line-idx 1))))
|
(~pretext-demo/typeset-block
|
||||||
(div
|
:words sample-words
|
||||||
(~tw :tokens "flex gap-1")
|
:widths sample-widths
|
||||||
(map
|
:space-width space-w
|
||||||
(fn
|
:max-width 520
|
||||||
(word-info)
|
:label "Knuth-Plass optimal line breaking — John 1:1–4")))
|
||||||
(let
|
(div
|
||||||
((w (get word-info :width)))
|
(~tw :tokens "rounded-lg border border-violet-200 bg-violet-50 p-5")
|
||||||
(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
|
(p
|
||||||
(~tw :tokens "text-xs text-stone-500 mt-3")
|
(~tw :tokens "text-sm text-violet-800")
|
||||||
(str
|
(strong "One ")
|
||||||
(len ranges)
|
(code (~tw :tokens "bg-violet-100 px-1 rounded") "perform")
|
||||||
" lines. Break points: "
|
" for glyph measurement. Everything else — line breaking, positioning, hyphenation, justification — is pure SX functions over numbers. "
|
||||||
(join
|
"Server renders with font-table lookups. Browser uses "
|
||||||
", "
|
(code "canvas.measureText")
|
||||||
(map (fn (r) (str (first r) "→" (nth r 1))) ranges)))))))
|
". 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")
|
|
||||||
"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
|
(div
|
||||||
(~tw :tokens "rounded-lg border border-stone-200 bg-white p-6")
|
(~tw :tokens "space-y-3")
|
||||||
(h3
|
(h2
|
||||||
(~tw
|
(~tw :tokens "text-xl font-semibold text-stone-800")
|
||||||
:tokens "text-sm font-medium text-stone-500 uppercase tracking-wide mb-3")
|
"Greedy vs optimal")
|
||||||
"Syllable decomposition")
|
(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
|
(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
|
(map
|
||||||
(fn
|
(fn
|
||||||
(word)
|
(used)
|
||||||
(let
|
(let
|
||||||
((syllables (hyphenate-word trie word))
|
((bad (line-badness used 100))
|
||||||
(points (find-hyphenation-points trie word)))
|
(pct (str (min used 100) "%")))
|
||||||
(div
|
(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
|
(div
|
||||||
(~tw
|
(~tw
|
||||||
:tokens "text-lg font-mono font-bold text-stone-800 mb-2")
|
:tokens "rounded-lg border border-stone-200 bg-white px-4 py-3 text-center")
|
||||||
(join "·" syllables))
|
(div
|
||||||
(div
|
(~tw
|
||||||
(~tw :tokens "text-xs text-stone-500")
|
:tokens "text-lg font-mono font-semibold text-stone-800 tracking-wide")
|
||||||
(str
|
(map-indexed
|
||||||
"Break points: "
|
(fn
|
||||||
(if
|
(i syl)
|
||||||
(empty? points)
|
(if
|
||||||
"none"
|
(= i 0)
|
||||||
(join ", " (map str points))))))))
|
(span syl)
|
||||||
(list "hyphen" "computation" "programming"))))))
|
(list
|
||||||
(div
|
(span
|
||||||
(~tw :tokens "rounded-lg border border-amber-200 bg-amber-50 p-6")
|
(~tw :tokens "text-violet-400 mx-0.5")
|
||||||
(h2 (~tw :tokens "text-lg font-semibold text-amber-900") "How it works")
|
"·")
|
||||||
(ol
|
(span syl))))
|
||||||
(~tw
|
syllables))
|
||||||
:tokens "list-decimal list-inside text-amber-800 space-y-2 text-sm")
|
(div (~tw :tokens "text-xs text-stone-400 mt-1") word))))
|
||||||
(li
|
(list "hyphen" "computation" "programming" "typography")))))
|
||||||
(code "measure-text")
|
(div
|
||||||
" calls "
|
(~tw
|
||||||
(code "(perform (text-measure ...))")
|
:tokens "rounded-lg border border-stone-200 bg-stone-50 p-5 space-y-2")
|
||||||
" — the only IO")
|
(h3
|
||||||
(li
|
(~tw
|
||||||
(code "break-lines")
|
:tokens "text-sm font-semibold text-stone-600 uppercase tracking-wide")
|
||||||
" runs Knuth-Plass DP over word widths to find optimal breaks")
|
"The pipeline")
|
||||||
(li
|
(ol
|
||||||
(code "position-lines")
|
(~tw
|
||||||
" converts breaks + widths into x/y coordinates (pure arithmetic)")
|
:tokens "list-decimal list-inside text-sm text-stone-600 space-y-1")
|
||||||
(li
|
(li
|
||||||
(code "hyphenate-word")
|
(code "measure-text")
|
||||||
" uses Liang's trie algorithm to find syllable boundaries")
|
" — the only IO. Server: font tables. Browser: "
|
||||||
(li
|
(code "canvas.measureText"))
|
||||||
"All layout is "
|
(li
|
||||||
(strong "deterministic")
|
(code "break-lines")
|
||||||
" — same input widths → same output positions, every time")
|
" — Knuth-Plass DP over word widths → optimal break points")
|
||||||
(li
|
(li
|
||||||
"Server renders with monospace approximation; browser uses "
|
(code "position-lines")
|
||||||
(code "canvas.measureText"))))))
|
" — 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