rickub
nandi/jolt-nativepublic⑂ Fork 0
⑂ 5acc801872977305e0f29a8dc4aca4ddca240f98
Branches
main View all branches → View all tags →
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.

core.jolt · 466 lines · 18.0 KBGDScript3 Blame HistoryRaw
Bind the terminal backend from the side that renders into it 3cfee15 nandi 18d ago1(ns glimmer-tui.core
2 "The terminal backend for glimmer. Requiring this namespace installs it,
3 after which glimmer's portable reconciler renders the same hiccup into a
4 terminal:
5
6 (ns myapp
7 (:require [glimmer.ratom :refer [atom]]
8 [glimmer.core :as ui]
9 [glimmer-tui.core])) ; installs this backend
10
11 (defn -main [& _] (ui/run my-app))
12
13 It is glimmer-vidya with a different shared object under it. A terminal has
14 no widgets to hand a reconciler — only a grid you overwrite — so the widget
15 tree lives one layer down in libjolttui, and this namespace is the thin part:
16 it turns glimmer's create/patch/append/remove into node mutations, runs the
17 loop, and routes what comes back to the handlers the components declared.
18
19 **Handlers do not cross the FFI.** A jolt closure has no C representation, so
20 identity travels instead: a node reports that it was clicked, and the handler
21 map here says whose `:on-click` that was.
22
23 What is not here, because a terminal has not got it: pictures, a window
24 title, a pointer that hovers, a clipboard. Keys are here instead — see
25 `:on-key`, which bubbles."
26 (:require [clojure.string :as str]
27 [glimmer.backend :as b]
28 [glimmer-tui.ffi :as ffi]))
29
30;; Node id -> the :on-* props that node was last rendered with. Kept here
31;; rather than sent across because a closure has no C representation.
32;;
33;; Ids are recycled by the arena, which is safe only because every id is
34;; written here by `create!` before anything can raise an event against it — a
35;; reused id has its predecessor's handlers overwritten in the same breath.
36(defonce ^:private handlers (atom {}))
37
38;; Work posted from other threads, run on the loop thread at the top of a tick.
39(defonce ^:private pending (atom []))
40
41;; Set by quit!, read by the loop.
42(defonce ^:private quit-requested (atom false))
43
44;; How many points a cell is worth, for the props that are a distance.
45;;
46;; A tree written for a window carries its spacing in points — `:margin 12`,
47;; `:width-request 260` — and a terminal that takes those at face value paints
48;; twelve blank rows and a column wider than the screen. The reconciler is not
49;; the place to fix that and neither is the app: the numbers are right, and it
50;; is the unit under them that changed. So the backend divides on the way
51;; across, and a tree written for cells leaves the scale at 1.
52(defonce ^:private scale (atom 1))
53
54;; The props that are a distance rather than a count, a flag or a name. A key
55;; this list does not know crosses unscaled, which is the right way round: a
56;; number that turns out to be a length paints a little large, where a scaled
57;; `:value` or `:selected` would be silently wrong.
58(def ^:private spatial-props
59 #{:margin :margin-top :margin-bottom :margin-left :margin-right
60 :padding :padding-top :padding-bottom :padding-left :padding-right
61 :spacing :gap :size :reserve
62 :width-request :height-request :max-width :min-width :max-height})
63
64(defn- scaled
65 "`v` in cells, rounded away from zero so a margin that was asked for is at
66 least one cell of one."
67 [v]
68 (let [n (/ (double v) @scale)]
69 (cond
70 (zero? n) 0
71 (< (Math/abs n) 1.0) (if (pos? n) 1 -1)
72 :else (Math/round n))))
73
74;; --- props -------------------------------------------------------------------
75;; :hbox and :vbox are one node in the library; the tag only implies an
76;; orientation, and an explicit :orientation prop still wins.
77(def ^:private tag-orientation {:hbox "horizontal" :vbox "vertical"})
78
79(defn- handler-key?
80 "True for a prop that names an event handler rather than a value."
81 [k]
82 (let [s (name k)]
83 (and (> (count s) 3) (= "on-" (subs s 0 3)))))
84
85(defn- set-prop!
86 "Write one prop to a node, in the ABI type that fits its value. nil clears
87 nothing — the prop was already dropped by the clear that precedes a write —
88 and an unrecognized value is stringified rather than refused, so a prop this
89 backend has not learned yet still reaches the library."
90 [node k v]
91 (let [key (name k)]
92 (cond
93 (nil? v) nil
94 (true? v) (ffi/node-set-bool! node key true)
95 (false? v) (ffi/node-set-bool! node key false)
96 (number? v) (ffi/node-set-num! node key
97 (double (if (contains? spatial-props k)
98 (scaled v)
99 v)))
100 (string? v) (ffi/node-set-str! node key v)
101 (keyword? v) (ffi/node-set-str! node key (name v))
102 :else (ffi/node-set-str! node key (str v)))))
103
104(defn- write-props!
105 "Replace a node's props with `props`.
106
107 Cleared first, deliberately: a re-render that stops setting `:placeholder`
108 means the placeholder is gone, and patching in place would leave the old one
109 behind. It also discards the value the library wrote back when the reader
110 typed into an entry or moved a list's cursor — which is the point. The
111 component's state is the truth, and this is the frame where it says so."
112 [node tag props]
113 (ffi/node-clear-props! node)
114 (when-let [orientation (tag-orientation tag)]
115 (when-not (contains? props :orientation)
116 (ffi/node-set-str! node "orientation" orientation)))
117 (doseq [[k v] props]
118 (when-not (handler-key? k)
119 (set-prop! node k v)))
120 (swap! handlers assoc node
121 (reduce (fn [acc [k v]]
122 (if (and (handler-key? k) (fn? v)) (assoc acc k v) acc))
123 {}
124 props))
125 nil)
126
127(defn- forget-dead-handlers!
128 "Drop handler entries for nodes the library has freed.
129
130 Removing a subtree frees every node under it, and only the library knows
131 which those were — so rather than mirror the tree here to walk it, the map is
132 filtered against what still exists."
133 []
134 (swap! handlers
135 (fn [m]
136 (reduce (fn [acc [id hs]]
137 (if (ffi/node-exists? id) (assoc acc id hs) acc))
138 {}
139 m)))
140 nil)
141
142;; --- the backend operations --------------------------------------------------
143(defn- create!
144 "glimmer.backend's :create!. Children are appended by the reconciler, not
145 here."
146 [tag props]
147 (let [node (ffi/node-new (name tag))]
148 (when (zero? node)
149 (throw (ex-info "jolttui could not allocate a node" {:tag tag})))
150 (write-props! node tag props)
151 node))
152
153(defn- apply-props! [tag node props] (write-props! node tag props))
154
155(defn- append-child! [_parent-tag parent child]
156 (ffi/node-append! parent child)
157 nil)
158
159(defn- remove-child! [_parent-tag parent child]
160 ;; The library frees the subtree; glimmer never mentions it again.
161 (ffi/node-remove! parent child)
162 (forget-dead-handlers!)
163 nil)
164
165(defn- replace-child! [_parent-tag parent old-child new-child]
166 (ffi/node-replace! parent old-child new-child)
167 (forget-dead-handlers!)
168 nil)
169
170(defn- reorder-child! [_parent-tag parent child sibling]
171 ;; nil sibling means "first"; the ABI spells that 0.
172 (ffi/node-insert-after! parent child (or sibling 0))
173 nil)
174
175;; --- the loop thread ---------------------------------------------------------
176(defn- schedule
177 "glimmer.backend's :schedule. Every node call belongs to the thread that
178 opened the session, so a ratom mutated on a reader thread (or any future)
179 queues its re-render here and the loop performs it on the next tick."
180 [work]
181 (swap! pending conj work)
182 nil)
183
184(defn- drain!
185 "Run everything `schedule` queued. compare-and-set! rather than reset!, so
186 work posted while the queue is being taken is not dropped."
187 []
188 (loop []
189 (let [q @pending]
190 (when (seq q)
191 (if (compare-and-set! pending q [])
192 (doseq [f q] (f))
193 (recur))))))
194
195;; --- timers ------------------------------------------------------------------
196;; A spinner or a clock has to change with nothing being pressed. The loop
197;; already wakes every tick, so a timer is a due time and a thunk. Both entry
198;; points are safe to call from another thread, and both run their thunk ON the
199;; loop thread, the only one allowed to touch nodes.
200(defonce ^:private timers (atom {:next-id 0 :entries {}}))
201
202(defn- now-ms [] (System/currentTimeMillis))
203
204(defn- add-timer! [ms every? f]
205 (let [id (:next-id (swap! timers update :next-id inc))]
206 (swap! timers assoc-in [:entries id]
207 {:due (+ (now-ms) ms) :every (when every? ms) :f f})
208 id))
209
210(defn after!
211 "Run `f` on the loop thread in about `ms` milliseconds. Returns an id for
212 `cancel!`. Resolution is one tick."
213 [ms f] (add-timer! ms false f))
214
215(defn every!
216 "Run `f` on the loop thread about every `ms` milliseconds until cancelled."
217 [ms f] (add-timer! ms true f))
218
219(defn cancel!
220 "Stop the timer `id`."
221 [id] (swap! timers update :entries dissoc id) nil)
222
223(defn cancel-all!
224 "Stop every timer, so a repeating one does not outlive the UI it animated."
225 [] (swap! timers assoc :entries {}) nil)
226
227(defn- pump-timers! []
228 (let [t (now-ms)
229 due (reduce (fn [acc [id e]] (if (<= (:due e) t) (conj acc [id e]) acc))
230 []
231 (:entries @timers))]
232 (doseq [[id e] due]
233 (if-let [period (:every e)]
234 (swap! timers assoc-in [:entries id :due] (+ t period))
235 (swap! timers update :entries dissoc id))
236 ((:f e)))
237 nil))
238
239;; --- events ------------------------------------------------------------------
240(defn- bubble!
241 "Walk from `node` up to the window looking for `k`, and call the first one
242 found with `args`. True when something took it.
243
244 Only keys do this. Everything else here is raised on the widget it happened
245 to, and a container has no business hearing about a click on a button inside
246 it — but a key nothing wanted is exactly the event a screen wants to answer,
247 and the focused widget is rarely the thing that knows what Esc means."
248 [node k & args]
249 (loop [n node]
250 (cond
251 (zero? n) false
252 (get-in @handlers [n k]) (do (apply (get-in @handlers [n k]) args) true)
253 :else (recur (ffi/node-parent n)))))
254
255(defn- dispatch-events!
256 "Drain the tick's interactions and call the handlers they belong to.
257
258 An event whose node has no handler for it is dropped, which is what makes a
259 control that ignores its own event still work: the library wrote the new
260 state into the node, and the next render either confirms it or overwrites it.
261
262 `:on-activate` is called with no arguments, as it is on the Vidya backend —
263 the entry's text has already been written back to the node, and a component
264 that cares holds it in a ratom anyway. `:on-select` and `:on-scroll` are the
265 two that carry what changed, because there is nowhere else to read it from."
266 []
267 (loop []
268 (when (ffi/poll-event!)
269 (let [node (ffi/event-node)
270 kind (ffi/event-name)
271 hs (get @handlers node)]
272 (case kind
273 "click" (when-let [f (:on-click hs)] (f))
274 "toggled" (when-let [f (:on-toggled hs)] (f))
275 ;; The text is read before anything else can overwrite the library's
276 ;; scratch buffer for its family — jolt copies it as it crosses.
277 "change" (when-let [f (:on-change hs)] (f (ffi/event-text)))
278 "activate" (when-let [f (:on-activate hs)] (f))
279 "select" (when-let [f (:on-select hs)]
280 (f (long (ffi/event-num)) (ffi/event-text)))
281 "scroll" (when-let [f (:on-scroll hs)] (f (long (ffi/event-num))))
282 "close" (when-let [f (:on-close hs)] (f))
283 ;; The one that bubbles. It arrives on whatever has focus, which is
284 ;; not usually the component that knows what the key meant.
285 "key" (bubble! node :on-key (ffi/event-text))
286 nil))
287 (recur))))
288
289;; --- reading the screen ------------------------------------------------------
290(defn screen-size
291 "The terminal's size as `[columns rows]`. `[0 0]` before a session is open.
292
293 Cells, not points: this is what a layout has to divide up, and it changes
294 when the window is dragged. Read it from a timer — `every!` — and hold it in
295 a ratom, so the components that switch on it re-render only when it moves."
296 []
297 [(ffi/screen-width) (ffi/screen-height)])
298
299(defn screen-line
300 "One painted row as text, trailing blanks trimmed."
301 [y]
302 (ffi/screen-line y))
303
304(defn screen-str
305 "Everything painted, as one string of rows.
306
307 What a headless session is for: mount a tree, tick it once, and this is the
308 answer — a screenshot a test can assert on and a bug report can paste, with
309 no terminal anywhere."
310 []
311 (let [h (ffi/screen-height)]
312 (loop [y 0 acc []]
313 (if (>= y h)
314 (str/join "\n" acc)
315 (recur (inc y) (conj acc (ffi/screen-line y)))))))
316
317(defn screen!
318 "Print `screen-str`. The one you want from a handler or the REPL."
319 []
320 (println (screen-str))
321 nil)
322
323;; --- driving it by hand ------------------------------------------------------
324;; The same entry points a real terminal's input arrives through, so a test
325;; types what a person types.
326(defn feed-key!
327 "Type one key by name — \"a\", \"enter\", \"shift+tab\", \"ctrl+u\", \"f5\".
328 True when the backend acted on it, false when it went out as a `key` event."
329 [name]
330 (ffi/feed-key! name))
331
332(defn feed-click! [x y] (ffi/feed-click! x y))
333(defn feed-wheel!
334 "Turn the wheel at a cell; `by` is in rows, and negative is up."
335 [x y by]
336 (ffi/feed-wheel! x y by))
337
338(defn focus
339 "The focused node, 0 for none."
340 []
341 (ffi/focus))
342
343;; --- the event loop ----------------------------------------------------------
344(defn- clear-children!
345 "Drop everything under `node`. Removing a child frees it, so this walks the
346 first slot until there is nothing left rather than iterating an index."
347 [node]
348 (loop []
349 (when (pos? (ffi/node-child-count node))
350 (ffi/node-remove! node (ffi/node-child-at node 0))
351 (recur)))
352 (forget-dead-handlers!)
353 nil)
354
355(defn quit!
356 "Stop the running loop and give the terminal back."
357 []
358 (reset! quit-requested true)
359 nil)
360
361(defn- run!
362 "glimmer.backend's :run. Takes the terminal, mounts the root component into
363 the library's root node, and paints until Ctrl-C, Ctrl-Q or `quit!`. Blocks,
364 like every UI main loop.
365
366 Options (on top of glimmer's own):
367 :mouse report clicks and the wheel (default true)
368 :points-per-cell how many of the tree's own units go into one cell
369 (default 1). 8 is about right for a tree written against
370 a window: it is the width of a character in the size a
371 desktop UI uses, which is what those numbers were laid out
372 in.
373 :fps how often the loop wakes when no input arrives (default 60)
374 :headless [columns rows] — a session with no terminal at all, for a
375 test or a screenshot; input is fed by hand
376 :auto-quit-ms stop after roughly this long, for a smoke test that has
377 nobody to press a key
378
379 The session is closed in a finally, so a handler that throws does not leave a
380 terminal in raw mode on the alternate screen — which is the one failure here
381 a reader cannot recover from without `reset`."
382 [opts mount-root!]
383 (let [{:keys [mouse fps headless auto-quit-ms points-per-cell]
384 :or {mouse true fps 60 points-per-cell 1}} opts
385 _ (reset! scale (max 1 points-per-cell))
386 opened? (if headless
387 (ffi/headless! (first headless) (second headless))
388 (ffi/open! mouse))]
389 (when-not opened?
390 (throw (ex-info "jolttui could not open a session"
391 {:headless headless})))
392 (reset! quit-requested false)
393 (let [started (now-ms)
394 timeout (max 1 (quot 1000 (max 1 fps)))
395 root (ffi/tree-root)]
396 (try
397 ;; The library's root outlives a run — it is process-wide, not per
398 ;; session — so a second `ui/run` in one process (a test, a REPL) would
399 ;; otherwise mount its tree alongside the last one's.
400 (clear-children! root)
401 (mount-root! root :window)
402 (reset! b/loop-running? true)
403 (loop []
404 (drain!)
405 (pump-timers!)
406 ;; Input first, then one call that lays out and paints the whole
407 ;; tree, then the events both produced — while the frame that caused
408 ;; them is still the frame the components rendered.
409 (ffi/tick timeout)
410 (ffi/frame!)
411 (dispatch-events!)
412 (when-not (or @quit-requested
413 (ffi/should-close?)
414 (and auto-quit-ms (>= (- (now-ms) started) auto-quit-ms)))
415 (recur)))
416 (finally
417 (reset! b/loop-running? false)
418 (cancel-all!)
419 (ffi/close!)
420 (reset! handlers {}))))))
421
422;; --- looking at what was rendered --------------------------------------------
423(defn dump-str
424 "The rendered tree as hiccup text, read back out of the library.
425
426 With no argument, the whole window; with a node handle, that subtree. This is
427 the tree as it *is* after the reconciler has run, not what a component
428 returned. `:hbox` and `:vbox` are one node down there and both dump as
429 `:box`, with the orientation in the props; no `:on-*` appears, because
430 handlers are held on this side and never sent."
431 ([] (dump-str 0))
432 ([node] (ffi/tree-dump node)))
433
434(defn dump
435 "`dump-str`, read back as hiccup data — vectors, keywords and maps."
436 ([] (dump 0))
437 ([node] (read-string (dump-str node))))
438
439(defn dump!
440 "Print `dump-str` to stdout."
441 ([] (dump! 0))
442 ([node] (println (dump-str node)) nil))
443
444;; --- the backend -------------------------------------------------------------
445(def backend
446 "The terminal backend map handed to glimmer.backend/register!. See that
447 namespace for the contract each key satisfies."
448 {:name :tui
449 :create! create!
450 :apply-props! apply-props!
451 :append-child! append-child!
452 :remove-child! remove-child!
453 :replace-child! replace-child!
454 :reorder-child! reorder-child!
455 :schedule schedule
456 :run run!})
457
458(defn install!
459 "Make the terminal the surface glimmer renders onto. Called on load, so
460 requiring this namespace is enough; exposed for code that wants to be
461 explicit, or to switch back after another backend was installed."
462 []
463 (b/register! backend)
464 nil)
465
466(defonce ^:private installed (do (install!) true))