nandi/jolt-native · core.jolt

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