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