(defisland ~home/stepper () (let ((source "(div (~cssx/tw :tokens \"text-center\")\n (h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")\n (span (~cssx/tw :tokens \"text-rose-500\") \"the \")\n (span (~cssx/tw :tokens \"text-amber-500\") \"joy \")\n (span (~cssx/tw :tokens \"text-emerald-500\") \"of \")\n (span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))") (steps (signal (list))) (store (if (client?) (def-store "home-stepper" (fn () {:step-idx (signal 9)})) nil)) (step-idx (if store (get store "step-idx") (signal 9))) (dom-stack-sig (signal (list))) (code-tokens (signal (list)))) (letrec ((split-tag (fn (expr result) (cond (not (list? expr)) (append! result {:expr expr :type "leaf"}) (empty? expr) nil (not (= (type-of (first expr)) "symbol")) (append! result {:expr expr :type "leaf"}) (is-html-tag? (symbol-name (first expr))) (let ((ctag (symbol-name (first expr))) (cargs (rest expr)) (cch (list)) (cat (list)) (spreads (list)) (ckw false)) (for-each (fn (a) (cond (= (type-of a) "keyword") (do (set! ckw true) (append! cat a)) ckw (do (set! ckw false) (append! cat a)) (and (list? a) (not (empty? a)) (= (type-of (first a)) "symbol") (starts-with? (symbol-name (first a)) "~")) (do (set! ckw false) (append! spreads a)) :else (do (set! ckw false) (append! cch a)))) cargs) (append! result {:spreads spreads :tag ctag :type "open" :attrs cat}) (for-each (fn (c) (split-tag c result)) cch) (append! result {:open-attrs cat :open-spreads spreads :tag ctag :type "close"})) :else (append! result {:expr expr :type "expr"})))) (build-code-tokens (fn (expr tokens step-ref indent) (cond (string? expr) (do (append! tokens {:cls "text-emerald-700" :step (get step-ref "v") :text (str "\"" expr "\"")}) (dict-set! step-ref "v" (+ (get step-ref "v") 1))) (number? expr) (do (append! tokens {:cls "text-amber-700" :step (get step-ref "v") :text (str expr)}) (dict-set! step-ref "v" (+ (get step-ref "v") 1))) (= (type-of expr) "keyword") (append! tokens {:cls "text-violet-600" :step (get step-ref "v") :text (str ":" (keyword-name expr))}) (= (type-of expr) "symbol") (let ((name (symbol-name expr))) (append! tokens {:cls (cond (is-html-tag? name) "text-sky-700 font-semibold" (starts-with? name "~") "text-rose-600 font-semibold" :else "text-stone-700") :step (get step-ref "v") :text name})) (list? expr) (when (not (empty? expr)) (let ((head (first expr)) (is-tag (and (= (type-of head) "symbol") (is-html-tag? (symbol-name head)))) (is-comp (and (= (type-of head) "symbol") (starts-with? (symbol-name head) "~"))) (open-step (get step-ref "v"))) (append! tokens {:cls "text-stone-400" :step open-step :text "("}) (build-code-tokens head tokens step-ref indent) (when is-tag (dict-set! step-ref "v" (+ (get step-ref "v") 1))) (for-each (fn (a) (let ((is-child (and (list? a) (not (empty? a)) (= (type-of (first a)) "symbol") (or (is-html-tag? (symbol-name (first a))) (starts-with? (symbol-name (first a)) "~")))) (is-spread (and (list? a) (not (empty? a)) (= (type-of (first a)) "symbol") (starts-with? (symbol-name (first a)) "~")))) (if is-spread (let ((saved (get step-ref "v")) (saved-tokens-len (len tokens))) (append! tokens {:cls "" :step -1 :text " "}) (build-code-tokens a tokens step-ref indent) (let mark-loop ((j saved-tokens-len)) (when (< j (len tokens)) (dict-set! (nth tokens j) "spread" true) (mark-loop (+ j 1)))) (dict-set! step-ref "v" saved)) (if (and is-tag is-child) (do (append! tokens {:cls "" :step -1 :text (str "\n" (join "" (map (fn (_) " ") (range 0 (+ indent 1)))))}) (build-code-tokens a tokens step-ref (+ indent 1))) (do (append! tokens {:cls "" :step -1 :text " "}) (build-code-tokens a tokens step-ref indent)))))) (rest expr)) (append! tokens {:cls "text-stone-400" :step open-step :text ")"}) (when is-tag (dict-set! step-ref "v" (+ (get step-ref "v") 1))))) :else nil))) (steps-to-preview (fn (all-steps target) (if (or (empty? all-steps) (<= target 0)) nil (let ((pos (dict "i" 0)) (max-i (min target (len all-steps)))) (letrec ((bc-loop (fn (children) (if (>= (get pos "i") max-i) children (let ((step (nth all-steps (get pos "i"))) (stype (get step "type"))) (cond (= stype "open") (do (dict-set! pos "i" (+ (get pos "i") 1)) (let ((tag (get step "tag")) (attrs (or (get step "attrs") (list))) (spreads (or (get step "spreads") (list))) (inner (bc-loop (list)))) (append! children (concat (list (make-symbol tag)) spreads attrs inner))) (bc-loop children)) (= stype "close") (do (dict-set! pos "i" (+ (get pos "i") 1)) children) (= stype "leaf") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) (= stype "expr") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) :else (do (dict-set! pos "i" (+ (get pos "i") 1)) (bc-loop children)))))))) (let ((root (bc-loop (list)))) (cond (= (len root) 1) (first root) (empty? root) nil :else (concat (list (make-symbol "<>")) root)))))))) (get-preview (fn () (dom-query "[data-sx-lake=\"home-preview\"]"))) (get-code-view (fn () (dom-query "[data-code-view]"))) (get-stack (fn () (deref dom-stack-sig))) (set-stack (fn (v) (reset! dom-stack-sig v))) (push-stack (fn (el) (reset! dom-stack-sig (append (deref dom-stack-sig) (list el))))) (pop-stack (fn () (let ((s (deref dom-stack-sig))) (when (> (len s) 1) (reset! dom-stack-sig (slice s 0 (- (len s) 1))))))) (build-code-dom (fn () nil)) (update-code-highlight (fn () (let ((code-el (get-code-view)) (cur (deref step-idx)) (tokens (deref code-tokens))) (when (and code-el (not (empty? tokens))) (dom-set-prop code-el "innerHTML" (join "" (map (fn (tok) (let ((step-num (get tok "step")) (base (get tok "cls")) (text (replace (get tok "text") "&" "&"))) (str "" text ""))) tokens))))))) (do-step (fn () (build-code-dom) (when (< (deref step-idx) (len (deref steps))) (when (empty? (get-stack)) (let ((p (get-preview))) (when p (set-stack (list p))))) (let ((step (nth (deref steps) (deref step-idx))) (step-type (get step "type")) (parent (if (empty? (get-stack)) (get-preview) (last (get-stack))))) (cond (= step-type "open") (let ((el (dom-create-element (get step "tag") nil)) (attrs (get step "attrs")) (spreads (or (get step "spreads") (list)))) (let loop ((i 0)) (when (< i (len attrs)) (dom-set-attr el (keyword-name (nth attrs i)) (nth attrs (+ i 1))) (loop (+ i 2)))) (for-each (fn (sp) (when (and (list? sp) (>= (len sp) 3) (= (type-of (nth sp 1)) "keyword") (= (keyword-name (nth sp 1)) "tokens") (string? (nth sp 2))) (let ((result (trampoline (~cssx/tw :tokens (nth sp 2))))) (when (spread? result) (let ((sattrs (spread-attrs result))) (for-each (fn (k) (if (= k "class") (dom-set-attr el "class" (str (or (dom-get-attr el "class") "") " " (get sattrs k))) (dom-set-attr el k (get sattrs k)))) (keys sattrs))))))) spreads) (when parent (dom-append parent el)) (push-stack el)) (= step-type "close") (pop-stack) (= step-type "leaf") (when parent (let ((val (get step "expr"))) (dom-append parent (create-text-node (if (string? val) val (str val)))))) (= step-type "expr") nil)) (swap! step-idx inc) (update-code-highlight)))) (rebuild-preview (fn (target) (let ((container (get-preview))) (when container (dom-set-prop container "innerHTML" "") (let ((expr (steps-to-preview (deref steps) target))) (when expr (let ((dom (render-to-dom expr (get-render-env nil) nil))) (when dom (dom-append container dom))))) (set-stack (list container)))))) (do-back (fn () (when (> (deref step-idx) 0) (let ((target (- (deref step-idx) 1))) (rebuild-preview target) (reset! step-idx target) (update-code-highlight) ))))) (let ((saved (get-cookie "sx-home-stepper"))) (when saved (thaw-from-sx saved) (when (or (< (deref step-idx) 0) (> (deref step-idx) 16)) (reset! step-idx 9)))) (let ((parsed (sx-parse source))) (when (not (empty? parsed)) (let ((result (list)) (step-ref (dict "v" 0))) (split-tag (first parsed) result) (reset! steps result) (let ((tokens (list))) (dict-set! step-ref "v" 0) (build-code-tokens (first parsed) tokens step-ref 0) (reset! code-tokens tokens))))) (let ((_eff (effect (fn () (schedule-idle (fn () (build-code-dom) (rebuild-preview (deref step-idx)) (update-code-highlight) (run-post-render-hooks))))))) (div :class "space-y-4" (div :data-code-view true (~cssx/tw :tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap") :style "font-size:0.5rem" (map (fn (tok) (let ((step (get tok "step")) (cur (deref step-idx)) (is-spread (get tok "spread")) (cls (str (get tok "cls") (cond (= step -1) "" (= step cur) " bg-amber-100 rounded px-0.5 font-bold text-sm" (< step cur) " font-bold text-xs" :else " opacity-40")))) (span :class cls (get tok "text")))) (deref code-tokens))) (div :class "flex items-center justify-center gap-2 md:gap-3" (button :on-click (fn (e) (do-back) ) :class (str "px-2 py-1 rounded text-3xl " (if (> (deref step-idx) 0) "text-stone-600 hover:text-stone-800 hover:bg-stone-100" "text-stone-300 cursor-not-allowed")) "◀") (span :class "text-sm text-stone-500 font-mono tabular-nums" (deref step-idx) " / " (len (deref steps))) (button :on-click (fn (e) (do-step) ) :class (str "px-2 py-1 rounded text-3xl " (if (< (deref step-idx) (len (deref steps))) "text-violet-600 hover:text-violet-800 hover:bg-violet-50" "text-violet-300 cursor-not-allowed")) "▶")) (lake :id "home-preview" (steps-to-preview (deref steps) (deref step-idx))))))))