nandi/jolt-nativepublic Fork 0
5145c3b332ec94862a49f0de18056217f55483d7
Commits
Clone
git clone https://git.rickub.com/nandi/jolt-native.git
git clone ssh://git@rickub.com/nandi/jolt-native.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

tests.clj · 273 lines · 11.9 KBClojure Blame HistoryRaw
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 10d ago1(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]
Make a list follow what arrives in it 95540ef nandi 10d ago8 [jvui.widgets :as w]
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 10d ago9 [glimmer.core :as gui]
10 [glimmer-jvui.core :as jv]
11 [jvui.core :as c]))
12
13(def ^:private failures (atom 0))
14
15(defn- check! [ok? msg]
16 (when-not ok?
17 (swap! failures inc)
18 (println " FAIL:" msg)))
19
20(defn- ctx []
21 (c/context {:size [400 300]
22 :measure (fn [s _] [(* 8.0 (count s)) 16.0])
23 :line-height (fn [_] 16.0)}))
24
25(defn- walk [n] (cons n (mapcat walk (:children @n))))
26(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
27(defn- labels [root]
28 (map #(str (:label (:props @%)))
29 (filter #(= :label (:tag @%)) (walk root))))
30
31(defn- centre
32 "The middle of the rectangle jvui gave this node on the last walk."
33 [n]
34 (let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
35
36(defn- click-at [x y]
37 [{:kind :motion :x x :y y}
38 {:kind :mouse-down :x x :y y :button 1 :clicks 1}
39 {:kind :mouse-up :x x :y y :button 1}])
40
41;; --- the reconciler reaches the backend --------------------------------------
42
43(def ^:private clicks (ra/atom 0))
44(def ^:private on? (ra/atom false))
45
46(defn- app []
47 [:card {}
48 [:title {:label "Counter"}]
49 [:label {:label (str "Count: " (ra/deref clicks))}]
50 [:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
51 [:checkbox {:label "loud" :checked (ra/deref on?)
52 :on-change #(ra/reset! on? %)}]])
53
54(defn- check-tree! []
55 (let [root (jv/root-node)]
56 (gui/mount root :page [app])
57 (check! (some? (tagged root :card)) "the reconciler built a card")
58 (check! (some? (tagged root :button)) "and a button")
59 (check! (some #{"Count: 0"} (labels root))
60 "and a label that read the ratom")))
61
62(defn- check-walk-places-widgets! []
63 (let [root (jv/root-node) cx (ctx)]
64 (gui/mount root :page [app])
65 (jv/render-once root cx)
66 (let [placed (vals (:data @cx))
67 card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
68 placed))]
69 (check! (some? card) "the walk placed a container with a rectangle")
70 (check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
71 (keep :rect placed))
72 "and no rectangle came out negative"))))
73
74;; --- a click goes all the way round ------------------------------------------
75
76(defn- check-click-fires-the-handler! []
77 (let [root (jv/root-node) cx (ctx)]
78 (ra/reset! clicks 0)
79 (gui/mount root :page [app])
80 (jv/render-once root cx)
81 (jv/render-once root cx)
82 (let [before (ra/deref clicks)
83 [bx by] (centre (tagged root :button))]
84 (jv/render-once root cx (click-at bx by))
85 (check! (= (inc before) (ra/deref clicks))
86 (str "the click reached :on-click (" before " -> "
87 (ra/deref clicks) ")"))
88 (jv/render-once root cx)
89 (check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
90 "and the reactive re-render reached the tree"))))
91
92(defn- check-press-alone-is-not-a-click! []
93 (let [root (jv/root-node) cx (ctx)]
94 (ra/reset! clicks 0)
95 (gui/mount root :page [app])
96 (jv/render-once root cx)
97 (jv/render-once root cx)
98 (let [[bx by] (centre (tagged root :button))]
99 (jv/render-once root cx [{:kind :motion :x bx :y by}
100 {:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
101 (check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
102 (jv/render-once root cx [{:kind :motion :x 390 :y 290}
103 {:kind :mouse-up :x 390 :y 290 :button 1}])
104 (check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
105
106;; --- identity follows the node, not its index --------------------------------
107
108(defn- check-reorder-keeps-identity! []
109 ;; The reason every node carries a serial as its jvui key. Render a list,
110 ;; reorder it, and the ids the walk hands out must travel with the nodes.
111 (let [root (jv/root-node) cx (ctx)
112 items (ra/atom [:a :b :c])
113 list-app (fn []
114 (into [:vbox {}]
115 (for [k (ra/deref items)]
116 ^{:key k} [:button {:label (name k)}])))
117 ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
118 (filter #(= :button (:tag @%)) (walk root)))))]
119 (gui/mount root :page [list-app])
120 (jv/render-once root cx)
121 (let [before (ids)]
122 (ra/reset! items [:c :a :b])
123 (jv/render-once root cx)
124 (let [after (ids)]
125 (check! (= 3 (count after)) "the list still has three buttons")
126 (check! (= (get before "a") (get after "a"))
127 "a keyed node keeps its jvui key across a reorder")
128 (check! (= (get before "c") (get after "c"))
129 "including the one that moved to the front")))))
130
131;; --- the vocabulary ----------------------------------------------------------
132
133(defn- check-unknown-tag-is-a-container! []
134 (let [root (jv/root-node) cx (ctx)]
135 (gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
136 (jv/render-once root cx)
137 (check! (some #{"inside"} (labels root))
138 "an unknown tag shows its contents rather than raising")))
139
140(defn- check-entry-round-trips! []
141 (let [root (jv/root-node) cx (ctx)
142 text (ra/atom "")]
143 (gui/mount root :page
144 [(fn [] [:entry {:value (ra/deref text)
145 :on-change #(ra/reset! text %)}])])
146 (jv/render-once root cx)
147 (let [[ex ey] (centre (tagged root :entry))]
148 (jv/render-once root cx (click-at ex ey))) ; take focus
149 (jv/render-once root cx [{:kind :text :text "hi"}])
150 (check! (= "hi" (ra/deref text))
151 (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
152
Report Enter from a field, and take its width request c03a752 nandi 10d ago153(defn- check-enter-sends! []
154 ;; Enter is the one key a field must not swallow. frq sends its message
155 ;; on it, so a compose box that accepted text and never reported Enter
156 ;; would take a message and have no way to say it was finished — typing
157 ;; works, sending does not, and nothing looks broken.
158 (let [root (jv/root-node) cx (ctx)
159 text (ra/atom "hello")
160 sent (ra/atom nil)]
161 (gui/mount root :page
162 [(fn [] [:entry {:value (ra/deref text)
163 :on-change #(ra/reset! text %)
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit 2271a91 nandi 10d ago164 ;; A THUNK, which is what frq's handlers
165 ;; are: s/send-draft! takes no arguments
166 ;; and the text is already the caller's
167 ;; from :on-change.
168 :on-activate #(ra/reset! sent (ra/deref text))}])])
Report Enter from a field, and take its width request c03a752 nandi 10d ago169 (jv/render-once root cx)
170 (let [[ex ey] (centre (tagged root :entry))]
171 (jv/render-once root cx (click-at ex ey))) ; take focus
172 (jv/render-once root cx [{:kind :key-down :key :return}])
173 (check! (= "hello" (ra/deref sent))
174 (str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
175
Make a list follow what arrives in it 95540ef nandi 10d ago176(defn- label-node [root text]
177 (first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
178 (walk root))))
179
Let a container fill its parent, and report "end" as the word e72d7b0 nandi 10d ago180(defn- check-rows-do-not-stretch! []
181 ;; Every box shrink-wrapping its children is how frq's chat column came
182 ;; out a couple of hundred points wide in a five-hundred-point window,
183 ;; with every message wrapped to match and the scrollbar stranded in the
184 ;; middle of the screen. A container fills its parent's cross axis.
185 ;;
186 ;; And a ROW's children must NOT: :cross rather than :horizontal is what
187 ;; keeps a line of buttons from stretching to fill the window.
188 (let [root (jv/root-node) cx (ctx)] ; a 400-wide context
189 (gui/mount root :page
190 [(fn [] [:vbox {:key :outer}
191 [:vbox {:key :inner} [:label {:label "hi"}]]
192 [:hbox {:key :row} [:button {:label "a"}]
193 [:button {:label "b"}]]])])
194 (dotimes [_ 3] (jv/render-once root cx))
195 ;; Only tags that register for events carry a rect here, so the
196 ;; filling half is checked by pixel in props-check — a card paints a
197 ;; background and a screenshot can measure it. What CAN be asserted
198 ;; from the tree is the half that would regress silently.
199 (let [buttons (filter #(and (= :button (:tag @%)) (:rect @%)) (walk root))]
200 (check! (every? #(< (nth (:rect @%) 2) 120.0) buttons)
201 (str "and buttons in a row do not stretch: "
202 (pr-str (map #(nth (:rect @%) 2) buttons)))))))
203
Make a list follow what arrives in it 95540ef nandi 10d ago204(defn- check-scroll-sticks! []
205 ;; A chat that does not follow new messages is the difference between a
206 ;; window you read and one you drag.
207 ;;
208 ;; Asserted on GEOMETRY and not on which labels exist: every line is in
209 ;; the tree whether or not it is on screen, so `labels` cannot tell a
210 ;; stuck list from a pinned one. What tells them apart is where the last
211 ;; line was PUT — inside the viewport, or far below it.
212 (let [root (jv/root-node) cx (ctx)
213 n (ra/atom 3)]
214 (gui/mount root :page
215 [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
216 (into [:vbox {}]
217 (for [i (range (ra/deref n))]
218 [:label {:key i :label (str "line " i)}]))])])
219 (dotimes [_ 3] (jv/render-once root cx))
220 (ra/reset! n 40)
221 (dotimes [_ 3] (jv/render-once root cx))
222 ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
223 ;; to scroll. A stuck list is at the far end of it; a pinned one is
224 ;; still at zero.
225 (let [off (w/scroll-offset "chat")]
226 (check! (and off (> off 100.0))
227 (str "a stuck list followed its content: offset=" off))
228 ;; And it must STOP following once the reader has moved, or they can
229 ;; never read anything but the newest line.
230 ;; The mouse has to be OVER the list: a wheel is delivered to
231 ;; whatever is under the pointer, and the pointer only moves on a
232 ;; motion event.
233 (jv/render-once root cx [{:kind :motion :x 20 :y 30}])
234 (dotimes [_ 4]
235 (jv/render-once root cx [{:kind :motion :x 20 :y 30}
236 {:kind :wheel :x 20 :y 30 :dy 3}]))
237 (let [off2 (w/scroll-offset "chat")]
238 (check! (and off2 (< off2 off))
239 (str "and let go when the reader scrolled up: " off " -> " off2))))))
240
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 10d ago241(defn- check-checkbox-round-trips! []
242 (let [root (jv/root-node) cx (ctx)]
243 (ra/reset! on? false)
244 (gui/mount root :page [app])
245 (jv/render-once root cx)
246 (jv/render-once root cx)
247 (let [[bx by] (centre (tagged root :checkbox))]
248 (jv/render-once root cx (click-at bx by)))
249 (check! (true? (ra/deref on?))
250 (str "the checkbox reached :on-change: " (ra/deref on?)))))
251
252;; --- runner ------------------------------------------------------------------
253
254(def ^:private checks
255 [["the reconciler builds a tree" check-tree!]
256 ["the walk places widgets" check-walk-places-widgets!]
257 ["a click fires the handler" check-click-fires-the-handler!]
258 ["a press alone does not" check-press-alone-is-not-a-click!]
259 ["a reorder keeps identity" check-reorder-keeps-identity!]
260 ["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 10d ago261 ["a row does not stretch" check-rows-do-not-stretch!]
Make a list follow what arrives in it 95540ef nandi 10d ago262 ["a list sticks to the end" check-scroll-sticks!]
Report Enter from a field, and take its width request c03a752 nandi 10d ago263 ["Enter sends" check-enter-sends!]
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 10d ago264 ["an entry round-trips" check-entry-round-trips!]
265 ["a checkbox round-trips" check-checkbox-round-trips!]])
266
267(defn -main [& _]
268 (doseq [[name f] checks]
269 (println "-" name)
270 (f))
271 (if (zero? @failures)
272 (println "\nall" (count checks) "checks passed")
273 (do (println "\n" @failures "failed") (System/exit 1))))