nandi/jolt-native · core.jolt

⑂ 68910bd024f8012cf0a0248b2c01850714a3ef49

core.jolt · 466 lines · 18.0 KBGDScript3    Blame HistoryRaw
Bind the terminal backend from the side that renders into it   1(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]))
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
51;; across, and a tree written for cells leaves the scale at 1.
52(defonce ^:private scale (atom 1))
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
#{:margin :margin-top :margin-bottom :margin-left :margin-right
  :padding :padding-top :padding-bottom :padding-left :padding-right
  :spacing :gap :size :reserve
  :width-request :height-request :max-width :min-width :max-height})
64(defn- scaled
"`v` in cells, rounded away from zero so a margin that was asked for is at
least one cell of one."
(let [n (/ (double v) @scale)]
69
    (zero? n) 0
    (< (Math/abs n) 1.0) (if (pos? n) 1 -1)
    :else (Math/round n))))
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"})
79(defn- handler-key?
"True for a prop that names an event handler rather than a value."
(let [s (name k)]
  (and (> (count s) 3) (= "on-" (subs s 0 3)))))
85(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]
(let [key (name k)]
92
    (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 (contains? spatial-props k)
    (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)))))
104(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)))
(doseq [[k v] props]
  (when-not (handler-key? k)
    (set-prop! node k v)))
(swap! handlers assoc node
       (reduce (fn [acc [k v]]
                 (if (and (handler-key? k) (fn? v)) (assoc acc k v) acc))
               props))
127(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))
142;; --- the backend operations --------------------------------------------------
143(defn- create!
"glimmer.backend's :create!. Children are appended by the reconciler, not
145
[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)
151
153(defn- apply-props! [tag node props] (write-props! node tag props))
155(defn- append-child! [_parent-tag parent child]
(ffi/node-append! parent child)
159(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!)
165(defn- replace-child! [_parent-tag parent old-child new-child]
(ffi/node-replace! parent old-child new-child)
(forget-dead-handlers!)
170(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))
175;; --- the loop thread ---------------------------------------------------------
176(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."
180
(swap! pending conj work)
184(defn- drain!
"Run everything `schedule` queued. compare-and-set! rather than reset!, so
work posted while the queue is being taken is not dropped."
188
  (let [q @pending]
    (when (seq q)
      (if (compare-and-set! pending q [])
        (doseq [f q] (f))
        (recur))))))
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 {}}))
202(defn- now-ms [] (System/currentTimeMillis))
204(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})
208
210(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))
215(defn every!
"Run `f` on the loop thread about every `ms` milliseconds until cancelled."
[ms f] (add-timer! ms true f))
219(defn cancel!
"Stop the timer `id`."
[id] (swap! timers update :entries dissoc id) nil)
223(defn cancel-all!
"Stop every timer, so a repeating one does not outlive the UI it animated."
[] (swap! timers assoc :entries {}) nil)
227(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)))
237
239;; --- events ------------------------------------------------------------------
240(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]
250
    (zero? n) false
    (get-in @handlers [n k]) (do (apply (get-in @handlers [n k]) args) true)
    :else (recur (ffi/node-parent n)))))
255(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."
267
  (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))))
289;; --- reading the screen ------------------------------------------------------
290(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)])
299(defn screen-line
"One painted row as text, trailing blanks trimmed."
(ffi/screen-line y))
304(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)))))))
317(defn screen!
"Print `screen-str`. The one you want from a handler or the REPL."
(println (screen-str))
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!
"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."
329
(ffi/feed-key! name))
332(defn feed-click! [x y] (ffi/feed-click! x y))
333(defn feed-wheel!
"Turn the wheel at a cell; `by` is in rows, and negative is up."
335
(ffi/feed-wheel! x y by))
338(defn focus
"The focused node, 0 for none."
(ffi/focus))
343;; --- the event loop ----------------------------------------------------------
344(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."
347
348
  (when (pos? (ffi/node-child-count node))
    (ffi/node-remove! node (ffi/node-child-at node 0))
    (recur)))
(forget-dead-handlers!)
355(defn quit!
"Stop the running loop and give the terminal back."
(reset! quit-requested true)
361(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 into 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
  :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]
       :or {mouse true fps 60 points-per-cell 1}} opts
      _ (reset! scale (max 1 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)]
396
      ;; 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)
      (loop []
        (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.
        (ffi/tick timeout)
        (ffi/frame!)
        (dispatch-events!)
        (when-not (or @quit-requested
                      (ffi/should-close?)
                      (and auto-quit-ms (>= (- (now-ms) started) auto-quit-ms)))
          (recur)))
      (finally
        (reset! b/loop-running? false)
        (cancel-all!)
        (ffi/close!)
        (reset! handlers {}))))))
422;; --- looking at what was rendered --------------------------------------------
423(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)))
434
"`dump-str`, read back as hiccup data — vectors, keywords and maps."
([] (dump 0))
([node] (read-string (dump-str node))))
439(defn dump!
"Print `dump-str` to stdout."
([] (dump! 0))
([node] (println (dump-str node)) nil))
444;; --- the backend -------------------------------------------------------------
445(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!})
458(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)
466(defonce ^:private installed (do (install!) true))

Bind the terminal backend from the side that renders into it 3cfee15 nandi 17d ago	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:
	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))