(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))