nandi/jolt-native · core.clj

⑂ 0fb017593acce485b16f9756141b599beb49dc76
core.clj · 547 lines · 22.5 KBClojure    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
Paint a frame only when the tree has moved   92;; --- what makes a frame worth painting ---------------------------------------
93;; Every change the reconciler makes to the tree passes through the backend
94;; operations below, so they are the exact answer to "does this frame differ
95;; from the one on the screen?". Without asking, the loop laid the whole tree
96;; out and painted it `fps` times a second whether or not anything had moved,
97;; which costs most of a core on a screen that is standing still: `tui_frame`
98;; sends only the cells that changed, but it computes every one of them first.
99(defonce ^:private dirty (atom true))
101(defn- touch!
102  "Say that the tree no longer matches what was painted."
104  (reset! dirty true)
107;; A change that reached the library without passing through a backend
108;; operation would otherwise sit unpainted until the next keypress, so the loop
109;; paints regardless this often. One frame a second is not a cost worth saving.
110(def ^:private idle-repaint-ms 1000)
Bind the terminal backend from the side that renders into it   112;; --- props -------------------------------------------------------------------
113;; :hbox and :vbox are one node in the library; the tag only implies an
114;; orientation, and an explicit :orientation prop still wins.
115(def ^:private tag-orientation {:hbox "horizontal" :vbox "vertical"})
117(defn- handler-key?
118  "True for a prop that names an event handler rather than a value."
120  (let [s (name k)]
121    (and (> (count s) 3) (= "on-" (subs s 0 3)))))
Measure a gap down the page in rows, and let a thin one be nothing   123(defn- axis-scale
124  "Which divisor `k` is measured in, on a node laid out `vertical?`.
126  `:spacing` and `:gap` are the ones that need asking: they are the distance
127  between a box's children, so which axis they run along is the box's own
128  orientation and not something the name says. nil for a prop that is not a
129  distance at all."
130  [k vertical?]
132    (contains? col-props k) @col-scale
133    (contains? row-props k) @row-scale
134    (contains? #{:spacing :gap} k) (if vertical? @row-scale @col-scale)
135    :else nil))
Bind the terminal backend from the side that renders into it   137(defn- set-prop!
138  "Write one prop to a node, in the ABI type that fits its value. nil clears
139  nothing — the prop was already dropped by the clear that precedes a write —
140  and an unrecognized value is stringified rather than refused, so a prop this
141  backend has not learned yet still reaches the library."
Measure a gap down the page in rows, and let a thin one be nothing   142  [node k v vertical?]
Bind the terminal backend from the side that renders into it   143  (let [key (name k)]
144
145      (nil? v)     nil
146      (true? v)    (ffi/node-set-bool! node key true)
147      (false? v)   (ffi/node-set-bool! node key false)
148      (number? v)  (ffi/node-set-num! node key
Measure a gap down the page in rows, and let a thin one be nothing   149                                      (double (if-let [scale (axis-scale k vertical?)]
150                                                (scaled v scale)
Bind the terminal backend from the side that renders into it   151
152      (string? v)  (ffi/node-set-str! node key v)
153      (keyword? v) (ffi/node-set-str! node key (name v))
154      :else        (ffi/node-set-str! node key (str v)))))
156(defn- write-props!
157  "Replace a node's props with `props`.
159  Cleared first, deliberately: a re-render that stops setting `:placeholder`
160  means the placeholder is gone, and patching in place would leave the old one
161  behind. It also discards the value the library wrote back when the reader
162  typed into an entry or moved a list's cursor — which is the point. The
163  component's state is the truth, and this is the frame where it says so."
164  [node tag props]
165  (ffi/node-clear-props! node)
166  (when-let [orientation (tag-orientation tag)]
167    (when-not (contains? props :orientation)
168      (ffi/node-set-str! node "orientation" orientation)))
Measure a gap down the page in rows, and let a thin one be nothing   169  ;; Which way this node lays its children out, for the props whose axis is the
170  ;; box's rather than their own. Everything that is not explicitly a row is a
171  ;; column, which is what the library assumes of a container it does not know.
172  (let [vertical? (not= "horizontal"
173                        (or (some-> (:orientation props) name)
174                            (tag-orientation tag)
175                            "vertical"))]
176    (doseq [[k v] props]
177      (when-not (handler-key? k)
178        (set-prop! node k v vertical?))))
Bind the terminal backend from the side that renders into it   179  (swap! handlers assoc node
180         (reduce (fn [acc [k v]]
181                   (if (and (handler-key? k) (fn? v)) (assoc acc k v) acc))
183                 props))
Paint a frame only when the tree has moved   184  (touch!))
Bind the terminal backend from the side that renders into it   185
186(defn- forget-dead-handlers!
187  "Drop handler entries for nodes the library has freed.
189  Removing a subtree frees every node under it, and only the library knows
190  which those were — so rather than mirror the tree here to walk it, the map is
191  filtered against what still exists."
193  (swap! handlers
194         (fn [m]
195           (reduce (fn [acc [id hs]]
196                     (if (ffi/node-exists? id) (assoc acc id hs) acc))
201;; --- the backend operations --------------------------------------------------
202(defn- create!
203  "glimmer.backend's :create!. Children are appended by the reconciler, not
204
205  [tag props]
206  (let [node (ffi/node-new (name tag))]
207    (when (zero? node)
208      (throw (ex-info "jolttui could not allocate a node" {:tag tag})))
209    (write-props! node tag props)
210
212(defn- apply-props! [tag node props] (write-props! node tag props))
214(defn- append-child! [_parent-tag parent child]
215  (ffi/node-append! parent child)
Paint a frame only when the tree has moved   216  (touch!))
Bind the terminal backend from the side that renders into it   217
218(defn- remove-child! [_parent-tag parent child]
219  ;; The library frees the subtree; glimmer never mentions it again.
220  (ffi/node-remove! parent child)
221  (forget-dead-handlers!)
Paint a frame only when the tree has moved   222  (touch!))
Bind the terminal backend from the side that renders into it   223
224(defn- replace-child! [_parent-tag parent old-child new-child]
225  (ffi/node-replace! parent old-child new-child)
226  (forget-dead-handlers!)
Paint a frame only when the tree has moved   227  (touch!))
Bind the terminal backend from the side that renders into it   228
229(defn- reorder-child! [_parent-tag parent child sibling]
230  ;; nil sibling means "first"; the ABI spells that 0.
231  (ffi/node-insert-after! parent child (or sibling 0))
Paint a frame only when the tree has moved   232  (touch!))
Bind the terminal backend from the side that renders into it   233
234;; --- the loop thread ---------------------------------------------------------
235(defn- schedule
236  "glimmer.backend's :schedule. Every node call belongs to the thread that
237  opened the session, so a ratom mutated on a reader thread (or any future)
238  queues its re-render here and the loop performs it on the next tick."
239
240  (swap! pending conj work)
243(defn- drain!
244  "Run everything `schedule` queued. compare-and-set! rather than reset!, so
245  work posted while the queue is being taken is not dropped."
247
248    (let [q @pending]
249      (when (seq q)
250        (if (compare-and-set! pending q [])
251          (doseq [f q] (f))
252          (recur))))))
254;; --- timers ------------------------------------------------------------------
255;; A spinner or a clock has to change with nothing being pressed. The loop
256;; already wakes every tick, so a timer is a due time and a thunk. Both entry
257;; points are safe to call from another thread, and both run their thunk ON the
258;; loop thread, the only one allowed to touch nodes.
259(defonce ^:private timers (atom {:next-id 0 :entries {}}))
261(defn- now-ms [] (System/currentTimeMillis))
263(defn- add-timer! [ms every? f]
264  (let [id (:next-id (swap! timers update :next-id inc))]
265    (swap! timers assoc-in [:entries id]
266           {:due (+ (now-ms) ms) :every (when every? ms) :f f})
267
269(defn after!
270  "Run `f` on the loop thread in about `ms` milliseconds. Returns an id for
271  `cancel!`. Resolution is one tick."
272  [ms f] (add-timer! ms false f))
274(defn every!
275  "Run `f` on the loop thread about every `ms` milliseconds until cancelled."
276  [ms f] (add-timer! ms true f))
278(defn cancel!
279  "Stop the timer `id`."
280  [id] (swap! timers update :entries dissoc id) nil)
282(defn cancel-all!
283  "Stop every timer, so a repeating one does not outlive the UI it animated."
284  [] (swap! timers assoc :entries {}) nil)
286(defn- pump-timers! []
287  (let [t (now-ms)
288        due (reduce (fn [acc [id e]] (if (<= (:due e) t) (conj acc [id e]) acc))
290                    (:entries @timers))]
291    (doseq [[id e] due]
292      (if-let [period (:every e)]
293        (swap! timers assoc-in [:entries id :due] (+ t period))
294        (swap! timers update :entries dissoc id))
295      ((:f e)))
296
298;; --- events ------------------------------------------------------------------
299(defn- bubble!
300  "Walk from `node` up to the window looking for `k`, and call the first one
301  found with `args`. True when something took it.
303  Only keys do this. Everything else here is raised on the widget it happened
304  to, and a container has no business hearing about a click on a button inside
305  it — but a key nothing wanted is exactly the event a screen wants to answer,
306  and the focused widget is rarely the thing that knows what Esc means."
307  [node k & args]
308  (loop [n node]
309
310      (zero? n) false
311      (get-in @handlers [n k]) (do (apply (get-in @handlers [n k]) args) true)
312      :else (recur (ffi/node-parent n)))))
314(defn- dispatch-events!
315  "Drain the tick's interactions and call the handlers they belong to.
317  An event whose node has no handler for it is dropped, which is what makes a
318  control that ignores its own event still work: the library wrote the new
319  state into the node, and the next render either confirms it or overwrites it.
321  `:on-activate` is called with no arguments, as it is on the Vidya backend —
322  the entry's text has already been written back to the node, and a component
323  that cares holds it in a ratom anyway. `:on-select` and `:on-scroll` are the
324  two that carry what changed, because there is nowhere else to read it from."
326
327    (when (ffi/poll-event!)
328      (let [node (ffi/event-node)
329            kind (ffi/event-name)
330            hs (get @handlers node)]
331        (case kind
332          "click"    (when-let [f (:on-click hs)] (f))
333          "toggled"  (when-let [f (:on-toggled hs)] (f))
334          ;; The text is read before anything else can overwrite the library's
335          ;; scratch buffer for its family — jolt copies it as it crosses.
336          "change"   (when-let [f (:on-change hs)] (f (ffi/event-text)))
337          "activate" (when-let [f (:on-activate hs)] (f))
338          "select"   (when-let [f (:on-select hs)]
339                       (f (long (ffi/event-num)) (ffi/event-text)))
340          "scroll"   (when-let [f (:on-scroll hs)] (f (long (ffi/event-num))))
341          "close"    (when-let [f (:on-close hs)] (f))
342          ;; The one that bubbles. It arrives on whatever has focus, which is
343          ;; not usually the component that knows what the key meant.
344          "key"      (bubble! node :on-key (ffi/event-text))
345          nil))
346      (recur))))
348;; --- reading the screen ------------------------------------------------------
349(defn screen-size
350  "The terminal's size as `[columns rows]`. `[0 0]` before a session is open.
352  Cells, not points: this is what a layout has to divide up, and it changes
353  when the window is dragged. Read it from a timer — `every!` — and hold it in
354  a ratom, so the components that switch on it re-render only when it moves."
356  [(ffi/screen-width) (ffi/screen-height)])
358(defn screen-line
359  "One painted row as text, trailing blanks trimmed."
361  (ffi/screen-line y))
363(defn screen-str
364  "Everything painted, as one string of rows.
366  What a headless session is for: mount a tree, tick it once, and this is the
367  answer — a screenshot a test can assert on and a bug report can paste, with
368  no terminal anywhere."
370  (let [h (ffi/screen-height)]
371    (loop [y 0 acc []]
372      (if (>= y h)
373        (str/join "\n" acc)
374        (recur (inc y) (conj acc (ffi/screen-line y)))))))
376(defn screen!
377  "Print `screen-str`. The one you want from a handler or the REPL."
379  (println (screen-str))
382;; --- driving it by hand ------------------------------------------------------
383;; The same entry points a real terminal's input arrives through, so a test
384;; types what a person types.
385(defn feed-key!
386  "Type one key by name — \"a\", \"enter\", \"shift+tab\", \"ctrl+u\", \"f5\".
387  True when the backend acted on it, false when it went out as a `key` event."
388
389  (ffi/feed-key! name))
391(defn feed-click! [x y] (ffi/feed-click! x y))
392(defn feed-wheel!
393  "Turn the wheel at a cell; `by` is in rows, and negative is up."
394
395  (ffi/feed-wheel! x y by))
397(defn focus
398  "The focused node, 0 for none."
400  (ffi/focus))
402;; --- the event loop ----------------------------------------------------------
403(defn- clear-children!
404  "Drop everything under `node`. Removing a child frees it, so this walks the
405  first slot until there is nothing left rather than iterating an index."
406
407
408    (when (pos? (ffi/node-child-count node))
409      (ffi/node-remove! node (ffi/node-child-at node 0))
410      (recur)))
411  (forget-dead-handlers!)
414(defn quit!
415  "Stop the running loop and give the terminal back."
417  (reset! quit-requested true)
420(defn- run!
421  "glimmer.backend's :run. Takes the terminal, mounts the root component into
422  the library's root node, and paints until Ctrl-C, Ctrl-Q or `quit!`. Blocks,
423  like every UI main loop.
425  Options (on top of glimmer's own):
426    :mouse           report clicks and the wheel (default true)
Measure a gap down the page in rows, and let a thin one be nothing   427    :points-per-cell how many of the tree's own units go across one cell
428                     (default 1). 8 is about right for a tree written against a
429                     window: it is the width of a character in the size a
Bind the terminal backend from the side that renders into it   430                     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   432    :points-per-row  the same down the page (default: twice
433                     `:points-per-cell`, because a cell is about twice as tall
434                     as it is wide). This is the one that decides how much of a
435                     conversation fits on a screen.
Bind the terminal backend from the side that renders into it   436    :fps             how often the loop wakes when no input arrives (default 60)
437    :headless        [columns rows] — a session with no terminal at all, for a
438                     test or a screenshot; input is fed by hand
439    :auto-quit-ms    stop after roughly this long, for a smoke test that has
440                     nobody to press a key
442  The session is closed in a finally, so a handler that throws does not leave a
443  terminal in raw mode on the alternate screen — which is the one failure here
444  a reader cannot recover from without `reset`."
445  [opts mount-root!]
Measure a gap down the page in rows, and let a thin one be nothing   446  (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   447         :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   448        _ (reset! col-scale (max 1 points-per-cell))
449        _ (reset! row-scale (max 1 (or points-per-row (* 2 points-per-cell))))
Bind the terminal backend from the side that renders into it   450        opened? (if headless
451                  (ffi/headless! (first headless) (second headless))
452                  (ffi/open! mouse))]
453    (when-not opened?
454      (throw (ex-info "jolttui could not open a session"
455                      {:headless headless})))
456    (reset! quit-requested false)
457    (let [started (now-ms)
458          timeout (max 1 (quot 1000 (max 1 fps)))
459          root (ffi/tree-root)]
460
461        ;; The library's root outlives a run — it is process-wide, not per
462        ;; session — so a second `ui/run` in one process (a test, a REPL) would
463        ;; otherwise mount its tree alongside the last one's.
464        (clear-children! root)
465        (mount-root! root :window)
466        (reset! b/loop-running? true)
Paint a frame only when the tree has moved   467        (touch!)
468        (loop [painted 0]
Bind the terminal backend from the side that renders into it   469          (drain!)
470          (pump-timers!)
471          ;; Input first, then one call that lays out and paints the whole
472          ;; tree, then the events both produced — while the frame that caused
473          ;; them is still the frame the components rendered.
Paint a frame only when the tree has moved   474
475          ;; `tick` blocks for up to `timeout`, so a loop that paints only when
476          ;; the tree has moved spends an idle screen asleep in there. What it
477          ;; handled went into the library's own state — the text in an entry,
478          ;; a list's cursor — which is a change nothing else here will report.
479          (when (pos? (ffi/tick timeout))
480            (touch!))
481          (let [now (now-ms)
482                paint? (or @dirty (>= (- now painted) idle-repaint-ms))]
483            ;; Cleared before the paint, not after: work posted from another
484            ;; thread while this one is inside `frame!` arrives as a mutation
485            ;; on the next tick's `drain!`, and must not be cleared by this one.
486            (when paint?
487              (reset! dirty false)
488              (ffi/frame!))
489            ;; Handlers run here, after the frame they are answering. What they
490            ;; change is painted by the next pass, which is the pass their
491            ;; `touch!` has just asked for.
492            (dispatch-events!)
493            (when-not (or @quit-requested
494                          (ffi/should-close?)
495                          (and auto-quit-ms (>= (- (now-ms) started) auto-quit-ms)))
496              (recur (if paint? now painted)))))
Bind the terminal backend from the side that renders into it   497        (finally
498          (reset! b/loop-running? false)
499          (cancel-all!)
500          (ffi/close!)
501          (reset! handlers {}))))))
503;; --- looking at what was rendered --------------------------------------------
504(defn dump-str
505  "The rendered tree as hiccup text, read back out of the library.
507  With no argument, the whole window; with a node handle, that subtree. This is
508  the tree as it *is* after the reconciler has run, not what a component
509  returned. `:hbox` and `:vbox` are one node down there and both dump as
510  `:box`, with the orientation in the props; no `:on-*` appears, because
511  handlers are held on this side and never sent."
512  ([] (dump-str 0))
513  ([node] (ffi/tree-dump node)))
515
516  "`dump-str`, read back as hiccup data — vectors, keywords and maps."
517  ([] (dump 0))
518  ([node] (read-string (dump-str node))))
520(defn dump!
521  "Print `dump-str` to stdout."
522  ([] (dump! 0))
523  ([node] (println (dump-str node)) nil))
525;; --- the backend -------------------------------------------------------------
526(def backend
527  "The terminal backend map handed to glimmer.backend/register!. See that
528  namespace for the contract each key satisfies."
529  {:name           :tui
530   :create!        create!
531   :apply-props!   apply-props!
532   :append-child!  append-child!
533   :remove-child!  remove-child!
534   :replace-child! replace-child!
535   :reorder-child! reorder-child!
536   :schedule       schedule
537   :run            run!})
539(defn install!
540  "Make the terminal the surface glimmer renders onto. Called on load, so
541  requiring this namespace is enough; exposed for code that wants to be
542  explicit, or to switch back after another backend was installed."
544  (b/register! backend)
547(defonce ^:private installed (do (install!) true))