nandi/jolt-native · tests.clj

⑂ 6a3304ddddcc7d3e9486b470fea5933a1f81f8e8

tests.clj · 374 lines · 16.7 KBClojure    Blame HistoryRaw
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 1(ns glimmer-jvui.tests
"Every check here runs headless: no window, no SDL, no font, no display.
 jvui takes its measurer as a function, so the whole stack — glimmer's
 reconciler, this backend's walk, jvui's layout and event routing — can be
 driven with a stub that says eight pixels a character. `jolt test`."
(:require [glimmer.ratom :as ra]
Settle the layout before painting it, not after   8            [glimmer.backend :as b]
Make a list follow what arrives in it   9            [jvui.widgets :as w]
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 10            [glimmer.core :as gui]
          [glimmer-jvui.core :as jv]
          [jvui.core :as c]))
14(def ^:private failures (atom 0))
16(defn- check! [ok? msg]
(when-not ok?
  (swap! failures inc)
  (println "  FAIL:" msg)))
21(defn- ctx []
(c/context {:size [400 300]
            :measure (fn [s _] [(* 8.0 (count s)) 16.0])
            :line-height (fn [_] 16.0)}))
26(defn- walk [n] (cons n (mapcat walk (:children @n))))
27(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
28(defn- labels [root]
(map #(str (:label (:props @%)))
     (filter #(= :label (:tag @%)) (walk root))))
32(defn- centre
"The middle of the rectangle jvui gave this node on the last walk."
(let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
37(defn- click-at [x y]
[{:kind :motion :x x :y y}
 {:kind :mouse-down :x x :y y :button 1 :clicks 1}
 {:kind :mouse-up :x x :y y :button 1}])
42;; --- the reconciler reaches the backend --------------------------------------
44(def ^:private clicks (ra/atom 0))
45(def ^:private on? (ra/atom false))
47(defn- app []
[:card {}
 [:title {:label "Counter"}]
 [:label {:label (str "Count: " (ra/deref clicks))}]
 [:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
 [:checkbox {:label "loud" :checked (ra/deref on?)
             :on-change #(ra/reset! on? %)}]])
55(defn- check-tree! []
(let [root (jv/root-node)]
  (gui/mount root :page [app])
  (check! (some? (tagged root :card)) "the reconciler built a card")
  (check! (some? (tagged root :button)) "and a button")
  (check! (some #{"Count: 0"} (labels root))
          "and a label that read the ratom")))
63(defn- check-walk-places-widgets! []
(let [root (jv/root-node) cx (ctx)]
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (let [placed (vals (:data @cx))
        card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
                            placed))]
    (check! (some? card) "the walk placed a container with a rectangle")
    (check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
                    (keep :rect placed))
            "and no rectangle came out negative"))))
75;; --- a click goes all the way round ------------------------------------------
77(defn- check-click-fires-the-handler! []
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! clicks 0)
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (jv/render-once root cx)
  (let [before (ra/deref clicks)
        [bx by] (centre (tagged root :button))]
    (jv/render-once root cx (click-at bx by))
    (check! (= (inc before) (ra/deref clicks))
            (str "the click reached :on-click (" before " -> "
                 (ra/deref clicks) ")"))
    (jv/render-once root cx)
    (check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
            "and the reactive re-render reached the tree"))))
93(defn- check-press-alone-is-not-a-click! []
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! clicks 0)
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (jv/render-once root cx)
  (let [[bx by] (centre (tagged root :button))]
    (jv/render-once root cx [{:kind :motion :x bx :y by}
                             {:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
  (check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
  (jv/render-once root cx [{:kind :motion :x 390 :y 290}
                           {:kind :mouse-up :x 390 :y 290 :button 1}])
  (check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
107;; --- identity follows the node, not its index --------------------------------
109(defn- check-reorder-keeps-identity! []
;; The reason every node carries a serial as its jvui key. Render a list,
;; reorder it, and the ids the walk hands out must travel with the nodes.
(let [root (jv/root-node) cx (ctx)
      items (ra/atom [:a :b :c])
      list-app (fn []
                 (into [:vbox {}]
                       (for [k (ra/deref items)]
                         ^{:key k} [:button {:label (name k)}])))
      ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
                               (filter #(= :button (:tag @%)) (walk root)))))]
  (gui/mount root :page [list-app])
  (jv/render-once root cx)
  (let [before (ids)]
    (ra/reset! items [:c :a :b])
    (jv/render-once root cx)
    (let [after (ids)]
      (check! (= 3 (count after)) "the list still has three buttons")
      (check! (= (get before "a") (get after "a"))
              "a keyed node keeps its jvui key across a reorder")
      (check! (= (get before "c") (get after "c"))
              "including the one that moved to the front")))))
132;; --- the vocabulary ----------------------------------------------------------
134(defn- check-unknown-tag-is-a-container! []
(let [root (jv/root-node) cx (ctx)]
  (gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
  (jv/render-once root cx)
  (check! (some #{"inside"} (labels root))
          "an unknown tag shows its contents rather than raising")))
141(defn- check-entry-round-trips! []
(let [root (jv/root-node) cx (ctx)
      text (ra/atom "")]
  (gui/mount root :page
             [(fn [] [:entry {:value (ra/deref text)
                              :on-change #(ra/reset! text %)}])])
  (jv/render-once root cx)
  (let [[ex ey] (centre (tagged root :entry))]
    (jv/render-once root cx (click-at ex ey)))       ; take focus
  (jv/render-once root cx [{:kind :text :text "hi"}])
  (check! (= "hi" (ra/deref text))
          (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
Put the caret where the click lands, and paste into the field   154(defn- check-paste-reaches-the-client! []
;; Both halves of a paste, through the reconciler. Text lands in :on-change
;; like typing; a clipboard with no text on it reaches :on-paste-empty, a
;; THUNK, which is frq's `s/paste-image!` — the way a picture is pasted.
(let [root (jv/root-node) cx (ctx)
      text (ra/atom "")
      asked (ra/atom 0)
      clip (atom "pasted")]
  (swap! cx assoc :clipboard (fn [] @clip))
  (gui/mount root :page
             [(fn [] [:entry {:value (ra/deref text)
                              :on-change #(ra/reset! text %)
                              :on-paste-empty #(ra/swap! asked inc)}])])
  (jv/render-once root cx)
  (let [[ex ey] (centre (tagged root :entry))]
    (jv/render-once root cx (click-at ex ey)))
  (jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
  (check! (= "pasted" (ra/deref text))
          (str "pasted text reached :on-change: " (pr-str (ra/deref text))))
  (check! (zero? (ra/deref asked)) "and a paste of text is not a request")
  (reset! clip nil)
  (jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
  (check! (= 1 (ra/deref asked))
          "a paste with no text on the clipboard reached :on-paste-empty")
  (check! (= "pasted" (ra/deref text)) "and changed nothing")))
Report Enter from a field, and take its width request   180(defn- check-enter-sends! []
;; Enter is the one key a field must not swallow. frq sends its message
;; on it, so a compose box that accepted text and never reported Enter
;; would take a message and have no way to say it was finished — typing
;; works, sending does not, and nothing looks broken.
(let [root (jv/root-node) cx (ctx)
      text (ra/atom "hello")
      sent (ra/atom nil)]
  (gui/mount root :page
             [(fn [] [:entry {:value (ra/deref text)
                              :on-change #(ra/reset! text %)
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit   191                                ;; A THUNK, which is what frq's handlers
                              ;; are: s/send-draft! takes no arguments
                              ;; and the text is already the caller's
                              ;; from :on-change.
                              :on-activate #(ra/reset! sent (ra/deref text))}])])
Report Enter from a field, and take its width request   196    (jv/render-once root cx)
  (let [[ex ey] (centre (tagged root :entry))]
    (jv/render-once root cx (click-at ex ey)))       ; take focus
  (jv/render-once root cx [{:kind :key-down :key :return}])
  (check! (= "hello" (ra/deref sent))
          (str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
Make a list follow what arrives in it   203(defn- label-node [root text]
(first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
               (walk root))))
Let a container fill its parent, and report "end" as the word   207(defn- check-rows-do-not-stretch! []
;; Every box shrink-wrapping its children is how frq's chat column came
;; out a couple of hundred points wide in a five-hundred-point window,
;; with every message wrapped to match and the scrollbar stranded in the
;; middle of the screen. A container fills its parent's cross axis.
;; And a ROW's children must NOT: :cross rather than :horizontal is what
;; keeps a line of buttons from stretching to fill the window.
(let [root (jv/root-node) cx (ctx)]     ; a 400-wide context
  (gui/mount root :page
             [(fn [] [:vbox {:key :outer}
                      [:vbox {:key :inner} [:label {:label "hi"}]]
                      [:hbox {:key :row} [:button {:label "a"}]
                                         [:button {:label "b"}]]])])
  (dotimes [_ 3] (jv/render-once root cx))
  ;; Only tags that register for events carry a rect here, so the
  ;; filling half is checked by pixel in props-check — a card paints a
  ;; background and a screenshot can measure it. What CAN be asserted
  ;; from the tree is the half that would regress silently.
  (let [buttons (filter #(and (= :button (:tag @%)) (:rect @%)) (walk root))]
    (check! (every? #(< (nth (:rect @%) 2) 120.0) buttons)
            (str "and buttons in a row do not stretch: "
                 (pr-str (map #(nth (:rect @%) 2) buttons)))))))
Make a list follow what arrives in it   231(defn- check-scroll-sticks! []
;; A chat that does not follow new messages is the difference between a
;; window you read and one you drag.
;; Asserted on GEOMETRY and not on which labels exist: every line is in
;; the tree whether or not it is on screen, so `labels` cannot tell a
;; stuck list from a pinned one. What tells them apart is where the last
;; line was PUT — inside the viewport, or far below it.
(let [root (jv/root-node) cx (ctx)
      n (ra/atom 3)]
  (gui/mount root :page
             [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
                      (into [:vbox {}]
                            (for [i (range (ra/deref n))]
                              [:label {:key i :label (str "line " i)}]))])])
  (dotimes [_ 3] (jv/render-once root cx))
  (ra/reset! n 40)
  (dotimes [_ 3] (jv/render-once root cx))
  ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
  ;; to scroll. A stuck list is at the far end of it; a pinned one is
  ;; still at zero.
  (let [off (w/scroll-offset "chat")]
    (check! (and off (> off 100.0))
            (str "a stuck list followed its content: offset=" off))
    ;; And it must STOP following once the reader has moved, or they can
    ;; never read anything but the newest line.
    ;; The mouse has to be OVER the list: a wheel is delivered to
    ;; whatever is under the pointer, and the pointer only moves on a
    ;; motion event.
    (jv/render-once root cx [{:kind :motion :x 20 :y 30}])
    (dotimes [_ 4]
      (jv/render-once root cx [{:kind :motion :x 20 :y 30}
                               {:kind :wheel :x 20 :y 30 :dy 3}]))
    (let [off2 (w/scroll-offset "chat")]
      (check! (and off2 (< off2 off))
              (str "and let go when the reader scrolled up: " off " -> " off2))))))
Bring a :scroll-here row into view   268(defn- check-scroll-here! []
;; frq's reply chip sets :scroll-here on the message it answers. The list
;; is stuck to its end, so the row it points at is far above the viewport
;; until something moves it.
(let [root (jv/root-node) cx (ctx)
      target (ra/atom nil)]
  (gui/mount root :page
             [(fn [] [:scroll {:height 60 :scroll-key "jump" :stick-to-bottom true}
                      (into [:vbox {}]
                            (for [i (range 40)]
                              [:vbox {:key i :scroll-here (= i (ra/deref target))}
                               [:label {:label (str "line " i)}]]))])])
  (dotimes [_ 3] (jv/render-once root cx))
  (let [stuck (w/scroll-offset "jump")]
    (ra/reset! target 4)
    (dotimes [_ 3] (jv/render-once root cx))
    ;; Labels keep no rectangle, so the offset says where the list went:
    ;; line 4 starts under a hundred points down, and centring a line in a
    ;; sixty-tall viewport puts the offset below that — nowhere near the
    ;; end, where forty lines leave it.
    (let [off (w/scroll-offset "jump")]
      (check! (and stuck (> stuck 400.0))
              (str "the list starts at its end: offset=" stuck))
      (check! (and off (< off 100.0))
              (str "a :scroll-here row is brought on screen: offset=" off))))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 294(defn- check-checkbox-round-trips! []
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! on? false)
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (jv/render-once root cx)
  (let [[bx by] (centre (tagged root :checkbox))]
    (jv/render-once root cx (click-at bx by)))
  (check! (true? (ra/deref on?))
          (str "the checkbox reached :on-change: " (ra/deref on?)))))
305;; --- runner ------------------------------------------------------------------
Settle the layout before painting it, not after   307(def ^:private rows (ra/atom 1))
309(defn- growing []
[:vbox {}
 [:card {}
  (for [i (range (ra/deref rows))]
    ^{:key i} [:label {:label (str "line " i)}])]
 [:button {:label "under"}]])
316(defn- check-a-patch-settles-before-it-paints! []
;; What the eye actually catches. A container is as big as what its children
;; asked for LAST frame, so the first walk after the reconciler patches the
;; tree knows the new children and the old sizes: the card already holds four
;; lines and the button under it still sits where one line put it. That frame
;; is painted, and the frame after it is right — a flash of the old layout
;; under the new contents, on every change the client makes.
;; The fix is for the backend to say that it patched something, so jvui
;; spends that walk settling instead of painting. Checked here rather than in
;; jvui's own tests because it takes a reconciler to reproduce: the patch has
;; to arrive BETWEEN two frames, which is the one thing a widget called
;; directly cannot do.
;; `loop-running?` is what makes glimmer defer a re-render onto the frame
;; loop rather than run it inline, which is the arrangement a window is in
;; and the only one where any of this happens.
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! rows 1)
  (gui/mount root :page [growing])
  (dotimes [_ 3] (jv/render-once root cx))
  (reset! b/loop-running? true)
338
    (let [under #(second (:rect @(tagged root :button)))
          was (under)]
      (ra/reset! rows 4)
      (jv/render-once root cx)
      (let [painted (under)]
        (jv/render-once root cx)
        (check! (not= painted was)
                "the frame after a patch has moved what the patch moved")
        (check! (= painted (under))
                (str "and it is already where it comes to rest: painted at "
                     painted ", settles at " (under)))))
    (finally (reset! b/loop-running? false)))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 352(def ^:private checks
[["the reconciler builds a tree"  check-tree!]
 ["the walk places widgets"       check-walk-places-widgets!]
 ["a click fires the handler"     check-click-fires-the-handler!]
 ["a press alone does not"        check-press-alone-is-not-a-click!]
 ["a reorder keeps identity"      check-reorder-keeps-identity!]
 ["an unknown tag is a container" check-unknown-tag-is-a-container!]
Let a container fill its parent, and report "end" as the word   359   ["a row does not stretch"       check-rows-do-not-stretch!]
Make a list follow what arrives in it   360   ["a list sticks to the end"     check-scroll-sticks!]
Bring a :scroll-here row into view   361   ["a row asks to be seen"        check-scroll-here!]
Report Enter from a field, and take its width request   362   ["Enter sends"                  check-enter-sends!]
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 363   ["an entry round-trips"          check-entry-round-trips!]
Put the caret where the click lands, and paste into the field   364   ["a paste reaches the client"    check-paste-reaches-the-client!]
Settle the layout before painting it, not after   365   ["a checkbox round-trips"        check-checkbox-round-trips!]
 ["a patch settles before it paints" check-a-patch-settles-before-it-paints!]])
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 367
368(defn -main [& _]
(doseq [[name f] checks]
  (println "-" name)
371
(if (zero? @failures)
  (println "\nall" (count checks) "checks passed")
  (do (println "\n" @failures "failed") (System/exit 1))))

Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	1	(ns glimmer-jvui.tests
	2	"Every check here runs headless: no window, no SDL, no font, no display.
	3
	4	jvui takes its measurer as a function, so the whole stack — glimmer's
	5	reconciler, this backend's walk, jvui's layout and event routing — can be
	6	driven with a stub that says eight pixels a character. `jolt test`."
	7	(:require [glimmer.ratom :as ra]
Settle the layout before painting it, not after 51145df nandi 9d ago	8	[glimmer.backend :as b]
Make a list follow what arrives in it 95540ef nandi 9d ago	9	[jvui.widgets :as w]
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	10	[glimmer.core :as gui]
	11	[glimmer-jvui.core :as jv]
	12	[jvui.core :as c]))
	13
	14	(def ^:private failures (atom 0))
	15
	16	(defn- check! [ok? msg]
	17	(when-not ok?
	18	(swap! failures inc)
	19	(println " FAIL:" msg)))
	20
	21	(defn- ctx []
	22	(c/context {:size [400 300]
	23	:measure (fn [s _] [(* 8.0 (count s)) 16.0])
	24	:line-height (fn [_] 16.0)}))
	25
	26	(defn- walk [n] (cons n (mapcat walk (:children @n))))
	27	(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
	28	(defn- labels [root]
	29	(map #(str (:label (:props @%)))
	30	(filter #(= :label (:tag @%)) (walk root))))
	31
	32	(defn- centre
	33	"The middle of the rectangle jvui gave this node on the last walk."
	34	[n]
	35	(let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
	36
	37	(defn- click-at [x y]
	38	[{:kind :motion :x x :y y}
	39	{:kind :mouse-down :x x :y y :button 1 :clicks 1}
	40	{:kind :mouse-up :x x :y y :button 1}])
	41
	42	;; --- the reconciler reaches the backend --------------------------------------
	43
	44	(def ^:private clicks (ra/atom 0))
	45	(def ^:private on? (ra/atom false))
	46
	47	(defn- app []
	48	[:card {}
	49	[:title {:label "Counter"}]
	50	[:label {:label (str "Count: " (ra/deref clicks))}]
	51	[:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
	52	[:checkbox {:label "loud" :checked (ra/deref on?)
	53	:on-change #(ra/reset! on? %)}]])
	54
	55	(defn- check-tree! []
	56	(let [root (jv/root-node)]
	57	(gui/mount root :page [app])
	58	(check! (some? (tagged root :card)) "the reconciler built a card")
	59	(check! (some? (tagged root :button)) "and a button")
	60	(check! (some #{"Count: 0"} (labels root))
	61	"and a label that read the ratom")))
	62
	63	(defn- check-walk-places-widgets! []
	64	(let [root (jv/root-node) cx (ctx)]
	65	(gui/mount root :page [app])
	66	(jv/render-once root cx)
	67	(let [placed (vals (:data @cx))
	68	card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
	69	placed))]
	70	(check! (some? card) "the walk placed a container with a rectangle")
	71	(check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
	72	(keep :rect placed))
	73	"and no rectangle came out negative"))))
74
75	;; --- a click goes all the way round ------------------------------------------
76
77	(defn- check-click-fires-the-handler! []
78	(let [root (jv/root-node) cx (ctx)]
79	(ra/reset! clicks 0)
80	(gui/mount root :page [app])
81	(jv/render-once root cx)
82	(jv/render-once root cx)
83	(let [before (ra/deref clicks)
84	[bx by] (centre (tagged root :button))]
85	(jv/render-once root cx (click-at bx by))
86	(check! (= (inc before) (ra/deref clicks))
87	(str "the click reached :on-click (" before " -> "
88	(ra/deref clicks) ")"))
89	(jv/render-once root cx)
90	(check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
91	"and the reactive re-render reached the tree"))))
92
93	(defn- check-press-alone-is-not-a-click! []
94	(let [root (jv/root-node) cx (ctx)]
95	(ra/reset! clicks 0)
96	(gui/mount root :page [app])
97	(jv/render-once root cx)
98	(jv/render-once root cx)
99	(let [[bx by] (centre (tagged root :button))]
100	(jv/render-once root cx [{:kind :motion :x bx :y by}
101	{:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
102	(check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
103	(jv/render-once root cx [{:kind :motion :x 390 :y 290}
104	{:kind :mouse-up :x 390 :y 290 :button 1}])
105	(check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
106
107	;; --- identity follows the node, not its index --------------------------------
108
109	(defn- check-reorder-keeps-identity! []
110	;; The reason every node carries a serial as its jvui key. Render a list,
111	;; reorder it, and the ids the walk hands out must travel with the nodes.
112	(let [root (jv/root-node) cx (ctx)
113	items (ra/atom [:a :b :c])
114	list-app (fn []
115	(into [:vbox {}]
116	(for [k (ra/deref items)]
117	^{:key k} [:button {:label (name k)}])))
118	ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
119	(filter #(= :button (:tag @%)) (walk root)))))]
120	(gui/mount root :page [list-app])
121	(jv/render-once root cx)
122	(let [before (ids)]
123	(ra/reset! items [:c :a :b])
124	(jv/render-once root cx)
125	(let [after (ids)]
126	(check! (= 3 (count after)) "the list still has three buttons")
127	(check! (= (get before "a") (get after "a"))
128	"a keyed node keeps its jvui key across a reorder")
129	(check! (= (get before "c") (get after "c"))
130	"including the one that moved to the front")))))
131
132	;; --- the vocabulary ----------------------------------------------------------
133
134	(defn- check-unknown-tag-is-a-container! []
135	(let [root (jv/root-node) cx (ctx)]
136	(gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
137	(jv/render-once root cx)
138	(check! (some #{"inside"} (labels root))
139	"an unknown tag shows its contents rather than raising")))
140
141	(defn- check-entry-round-trips! []
142	(let [root (jv/root-node) cx (ctx)
143	text (ra/atom "")]
144	(gui/mount root :page
145	[(fn [] [:entry {:value (ra/deref text)
146	:on-change #(ra/reset! text %)}])])
147	(jv/render-once root cx)
148	(let [[ex ey] (centre (tagged root :entry))]
149	(jv/render-once root cx (click-at ex ey))) ; take focus
150	(jv/render-once root cx [{:kind :text :text "hi"}])
151	(check! (= "hi" (ra/deref text))
152	(str "typed text reached :on-change: " (pr-str (ra/deref text))))))
153
Put the caret where the click lands, and paste into the field c7d6ea8 nandi 9d ago	154	(defn- check-paste-reaches-the-client! []
	155	;; Both halves of a paste, through the reconciler. Text lands in :on-change
	156	;; like typing; a clipboard with no text on it reaches :on-paste-empty, a
	157	;; THUNK, which is frq's `s/paste-image!` — the way a picture is pasted.
	158	(let [root (jv/root-node) cx (ctx)
	159	text (ra/atom "")
	160	asked (ra/atom 0)
	161	clip (atom "pasted")]
	162	(swap! cx assoc :clipboard (fn [] @clip))
	163	(gui/mount root :page
	164	[(fn [] [:entry {:value (ra/deref text)
	165	:on-change #(ra/reset! text %)
	166	:on-paste-empty #(ra/swap! asked inc)}])])
	167	(jv/render-once root cx)
	168	(let [[ex ey] (centre (tagged root :entry))]
	169	(jv/render-once root cx (click-at ex ey)))
	170	(jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
	171	(check! (= "pasted" (ra/deref text))
	172	(str "pasted text reached :on-change: " (pr-str (ra/deref text))))
	173	(check! (zero? (ra/deref asked)) "and a paste of text is not a request")
	174	(reset! clip nil)
	175	(jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
	176	(check! (= 1 (ra/deref asked))
	177	"a paste with no text on the clipboard reached :on-paste-empty")
	178	(check! (= "pasted" (ra/deref text)) "and changed nothing")))
	179
Report Enter from a field, and take its width request c03a752 nandi 9d ago	180	(defn- check-enter-sends! []
	181	;; Enter is the one key a field must not swallow. frq sends its message
	182	;; on it, so a compose box that accepted text and never reported Enter
	183	;; would take a message and have no way to say it was finished — typing
	184	;; works, sending does not, and nothing looks broken.
	185	(let [root (jv/root-node) cx (ctx)
	186	text (ra/atom "hello")
	187	sent (ra/atom nil)]
	188	(gui/mount root :page
	189	[(fn [] [:entry {:value (ra/deref text)
	190	:on-change #(ra/reset! text %)
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit 2271a91 nandi 9d ago	191	;; A THUNK, which is what frq's handlers
	192	;; are: s/send-draft! takes no arguments
	193	;; and the text is already the caller's
	194	;; from :on-change.
	195	:on-activate #(ra/reset! sent (ra/deref text))}])])
Report Enter from a field, and take its width request c03a752 nandi 9d ago	196	(jv/render-once root cx)
	197	(let [[ex ey] (centre (tagged root :entry))]
	198	(jv/render-once root cx (click-at ex ey))) ; take focus
	199	(jv/render-once root cx [{:kind :key-down :key :return}])
	200	(check! (= "hello" (ra/deref sent))
	201	(str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
	202
Make a list follow what arrives in it 95540ef nandi 9d ago	203	(defn- label-node [root text]
	204	(first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
	205	(walk root))))
	206
Let a container fill its parent, and report "end" as the word e72d7b0 nandi 9d ago	207	(defn- check-rows-do-not-stretch! []
	208	;; Every box shrink-wrapping its children is how frq's chat column came
	209	;; out a couple of hundred points wide in a five-hundred-point window,
	210	;; with every message wrapped to match and the scrollbar stranded in the
	211	;; middle of the screen. A container fills its parent's cross axis.
	212	;;
	213	;; And a ROW's children must NOT: :cross rather than :horizontal is what
	214	;; keeps a line of buttons from stretching to fill the window.
	215	(let [root (jv/root-node) cx (ctx)] ; a 400-wide context
	216	(gui/mount root :page
	217	[(fn [] [:vbox {:key :outer}
	218	[:vbox {:key :inner} [:label {:label "hi"}]]
	219	[:hbox {:key :row} [:button {:label "a"}]
	220	[:button {:label "b"}]]])])
	221	(dotimes [_ 3] (jv/render-once root cx))
	222	;; Only tags that register for events carry a rect here, so the
	223	;; filling half is checked by pixel in props-check — a card paints a
	224	;; background and a screenshot can measure it. What CAN be asserted
	225	;; from the tree is the half that would regress silently.
	226	(let [buttons (filter #(and (= :button (:tag @%)) (:rect @%)) (walk root))]
	227	(check! (every? #(< (nth (:rect @%) 2) 120.0) buttons)
	228	(str "and buttons in a row do not stretch: "
	229	(pr-str (map #(nth (:rect @%) 2) buttons)))))))
	230
Make a list follow what arrives in it 95540ef nandi 9d ago	231	(defn- check-scroll-sticks! []
	232	;; A chat that does not follow new messages is the difference between a
	233	;; window you read and one you drag.
	234	;;
	235	;; Asserted on GEOMETRY and not on which labels exist: every line is in
	236	;; the tree whether or not it is on screen, so `labels` cannot tell a
	237	;; stuck list from a pinned one. What tells them apart is where the last
	238	;; line was PUT — inside the viewport, or far below it.
	239	(let [root (jv/root-node) cx (ctx)
	240	n (ra/atom 3)]
	241	(gui/mount root :page
	242	[(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
	243	(into [:vbox {}]
	244	(for [i (range (ra/deref n))]
	245	[:label {:key i :label (str "line " i)}]))])])
	246	(dotimes [_ 3] (jv/render-once root cx))
	247	(ra/reset! n 40)
	248	(dotimes [_ 3] (jv/render-once root cx))
	249	;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
	250	;; to scroll. A stuck list is at the far end of it; a pinned one is
	251	;; still at zero.
	252	(let [off (w/scroll-offset "chat")]
	253	(check! (and off (> off 100.0))
	254	(str "a stuck list followed its content: offset=" off))
	255	;; And it must STOP following once the reader has moved, or they can
	256	;; never read anything but the newest line.
	257	;; The mouse has to be OVER the list: a wheel is delivered to
	258	;; whatever is under the pointer, and the pointer only moves on a
	259	;; motion event.
	260	(jv/render-once root cx [{:kind :motion :x 20 :y 30}])
	261	(dotimes [_ 4]
	262	(jv/render-once root cx [{:kind :motion :x 20 :y 30}
	263	{:kind :wheel :x 20 :y 30 :dy 3}]))
	264	(let [off2 (w/scroll-offset "chat")]
	265	(check! (and off2 (< off2 off))
	266	(str "and let go when the reader scrolled up: " off " -> " off2))))))
	267
Bring a :scroll-here row into view e0d9029 nandi 8d ago	268	(defn- check-scroll-here! []
	269	;; frq's reply chip sets :scroll-here on the message it answers. The list
	270	;; is stuck to its end, so the row it points at is far above the viewport
	271	;; until something moves it.
	272	(let [root (jv/root-node) cx (ctx)
	273	target (ra/atom nil)]
	274	(gui/mount root :page
	275	[(fn [] [:scroll {:height 60 :scroll-key "jump" :stick-to-bottom true}
	276	(into [:vbox {}]
	277	(for [i (range 40)]
	278	[:vbox {:key i :scroll-here (= i (ra/deref target))}
	279	[:label {:label (str "line " i)}]]))])])
	280	(dotimes [_ 3] (jv/render-once root cx))
	281	(let [stuck (w/scroll-offset "jump")]
	282	(ra/reset! target 4)
	283	(dotimes [_ 3] (jv/render-once root cx))
	284	;; Labels keep no rectangle, so the offset says where the list went:
	285	;; line 4 starts under a hundred points down, and centring a line in a
	286	;; sixty-tall viewport puts the offset below that — nowhere near the
	287	;; end, where forty lines leave it.
	288	(let [off (w/scroll-offset "jump")]
	289	(check! (and stuck (> stuck 400.0))
	290	(str "the list starts at its end: offset=" stuck))
	291	(check! (and off (< off 100.0))
	292	(str "a :scroll-here row is brought on screen: offset=" off))))))
	293
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	294	(defn- check-checkbox-round-trips! []
	295	(let [root (jv/root-node) cx (ctx)]
	296	(ra/reset! on? false)
	297	(gui/mount root :page [app])
	298	(jv/render-once root cx)
	299	(jv/render-once root cx)
	300	(let [[bx by] (centre (tagged root :checkbox))]
	301	(jv/render-once root cx (click-at bx by)))
	302	(check! (true? (ra/deref on?))
	303	(str "the checkbox reached :on-change: " (ra/deref on?)))))
	304
	305	;; --- runner ------------------------------------------------------------------
	306
Settle the layout before painting it, not after 51145df nandi 9d ago	307	(def ^:private rows (ra/atom 1))
	308
	309	(defn- growing []
	310	[:vbox {}
	311	[:card {}
	312	(for [i (range (ra/deref rows))]
	313	^{:key i} [:label {:label (str "line " i)}])]
	314	[:button {:label "under"}]])
	315
	316	(defn- check-a-patch-settles-before-it-paints! []
	317	;; What the eye actually catches. A container is as big as what its children
	318	;; asked for LAST frame, so the first walk after the reconciler patches the
	319	;; tree knows the new children and the old sizes: the card already holds four
	320	;; lines and the button under it still sits where one line put it. That frame
	321	;; is painted, and the frame after it is right — a flash of the old layout
	322	;; under the new contents, on every change the client makes.
	323	;;
	324	;; The fix is for the backend to say that it patched something, so jvui
	325	;; spends that walk settling instead of painting. Checked here rather than in
	326	;; jvui's own tests because it takes a reconciler to reproduce: the patch has
	327	;; to arrive BETWEEN two frames, which is the one thing a widget called
	328	;; directly cannot do.
	329	;;
	330	;; `loop-running?` is what makes glimmer defer a re-render onto the frame
	331	;; loop rather than run it inline, which is the arrangement a window is in
	332	;; and the only one where any of this happens.
	333	(let [root (jv/root-node) cx (ctx)]
	334	(ra/reset! rows 1)
	335	(gui/mount root :page [growing])
	336	(dotimes [_ 3] (jv/render-once root cx))
	337	(reset! b/loop-running? true)
	338	(try
	339	(let [under #(second (:rect @(tagged root :button)))
	340	was (under)]
	341	(ra/reset! rows 4)
	342	(jv/render-once root cx)
	343	(let [painted (under)]
	344	(jv/render-once root cx)
	345	(check! (not= painted was)
	346	"the frame after a patch has moved what the patch moved")
	347	(check! (= painted (under))
	348	(str "and it is already where it comes to rest: painted at "
	349	painted ", settles at " (under)))))
	350	(finally (reset! b/loop-running? false)))))
	351
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	352	(def ^:private checks
	353	[["the reconciler builds a tree" check-tree!]
	354	["the walk places widgets" check-walk-places-widgets!]
	355	["a click fires the handler" check-click-fires-the-handler!]
	356	["a press alone does not" check-press-alone-is-not-a-click!]
	357	["a reorder keeps identity" check-reorder-keeps-identity!]
	358	["an unknown tag is a container" check-unknown-tag-is-a-container!]
Let a container fill its parent, and report "end" as the word e72d7b0 nandi 9d ago	359	["a row does not stretch" check-rows-do-not-stretch!]
Make a list follow what arrives in it 95540ef nandi 9d ago	360	["a list sticks to the end" check-scroll-sticks!]
Bring a :scroll-here row into view e0d9029 nandi 8d ago	361	["a row asks to be seen" check-scroll-here!]
Report Enter from a field, and take its width request c03a752 nandi 9d ago	362	["Enter sends" check-enter-sends!]
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	363	["an entry round-trips" check-entry-round-trips!]
Put the caret where the click lands, and paste into the field c7d6ea8 nandi 9d ago	364	["a paste reaches the client" check-paste-reaches-the-client!]
Settle the layout before painting it, not after 51145df nandi 9d ago	365	["a checkbox round-trips" check-checkbox-round-trips!]
	366	["a patch settles before it paints" check-a-patch-settles-before-it-paints!]])
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	367
	368	(defn -main [& _]
	369	(doseq [[name f] checks]
	370	(println "-" name)
	371	(f))
	372	(if (zero? @failures)
	373	(println "\nall" (count checks) "checks passed")
	374	(do (println "\n" @failures "failed") (System/exit 1))))