(ns glimmer-jvui.core
  "A glimmer backend that renders through [jvui](../../../jvui).

   glimmer owns the reactive core — ratoms, components, the reconciler — and
   knows nothing about any toolkit. glimmer-gtk fills that in with GtkWidgets,
   glimmer-vidya with a Rust node arena painted by egui, glimmer-gfx with a
   software rasterizer it writes itself. This fills it in with jvui, and so is
   the smallest of the four: everything a backend usually has to supply — the
   measuring, the placing, the hit testing, the painting — is already a toolkit
   one directory over.

   What is left is the half an immediate-mode library does not have: a tree to
   hold still between frames. The reconciler needs somewhere to put a widget it
   created and to append a child to, and jvui's widgets draw and return within
   one call. So a node here is an atom of {:tag :props :children :key}, about
   thirty lines of it, and once a frame `emit!` walks that tree and calls the
   jvui widget each node names.

   # The walk is the closure

   glimmer-vidya's README explains why its tree lives in Rust: `ScrollArea` and
   `Frame` take an `FnOnce(&mut Ui)` and keep their begin/end private, so a
   push/pop ABI cannot scroll a page. jvui's containers take a body function
   for the same reason, and here the recursion *is* that function — `emit!` on
   a container passes `emit-children!` as the body, and the nesting takes care
   of itself.

   # Why every node carries a key

   jvui identifies a widget by its parent and its index among its siblings,
   unless it is given a `:key`, which replaces the index. A reconciler reorders
   children; an identity built on the index would hand each widget after the
   moved one the caret, the scroll offset and the drag of whichever widget used
   to sit at its index. So every node gets a serial number at creation and
   passes it as its key, and the identity follows the node rather than its
   position. That is the bug class zvui's README describes from the backend
   side, closed here at the other end."
  (:require [glimmer.backend :as b]
            [jvui.app :as app]
            [jvui.core :as c]
            [jvui.theme :as theme]
            [jvui.widgets :as w]
            [jvui.frames :as frames]
            [jvui.host :as host]))

;; --- the retained tree -------------------------------------------------------

(defonce ^:private serial (atom 0))

(defn- create! [tag props]
  (atom {:tag tag :props props :children [] :key (swap! serial inc)}))

(defn- apply-props! [_tag n props] (swap! n assoc :props props) nil)
(defn- append-child! [_t parent child] (swap! parent update :children conj child) nil)
(defn- remove-child! [_t parent child]
  (swap! parent update :children #(vec (remove #{child} %))) nil)
(defn- replace-child! [_t parent old new]
  (swap! parent update :children #(mapv (fn [c] (if (= c old) new c)) %)) nil)
(defn- reorder-child! [_t parent child sibling]
  (swap! parent update :children
         (fn [cs]
           (let [cs (vec (remove #{child} cs))
                 i (if (nil? sibling) 0 (inc (.indexOf cs sibling)))]
             (vec (concat (subvec cs 0 i) [child] (subvec cs i))))))
  nil)

;; --- props -------------------------------------------------------------------

(defn- txt [props] (str (or (:label props) (:text props) "")))

(defn- num [v default] (if (number? v) (double v) default))

(defn- box-opts
  "The container options shared by every container tag."
  [props key]
  (cond-> {:key key
           :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)}
    (:spacing props) (assoc :spacing (num (:spacing props) 0.0))
    (:padding props) (assoc :padding (num (:padding props) 0.0))
    (:margin props)  (assoc :margin (num (:margin props) 0.0))
    (:expand props)  (assoc :expand (:expand props))))

(defn- fire! [n k & args]
  (when-let [f (get (:props @n) k)] (apply f args)))

;; --- the walk ----------------------------------------------------------------

(def ^:dynamic *record-rects?*
  "When true, each node keeps the rectangle jvui gave it, under `:rect`.

   Off in a running window, where it would be a `swap!` per node per frame for
   nobody's benefit. On under `render-once`, so a test can click the centre of
   a button the way a person would, rather than guessing at a coordinate and
   re-guessing every time a padding changes."
  false)

(declare emit!)

(defn- record! [n id]
  (when *record-rects?* (swap! n assoc :rect (c/rect-of id)))
  nil)

(defn- emit-children! [n]
  (fn [_id _rect] (doseq [c (:children @n)] (emit! c))))

(defn- emit!
  "Render one node, and through it everything below it.

   A widget answers what the person did to it, and that answer is turned back
   into the callback prop the component registered — which is the whole seam
   between an immediate-mode toolkit and a retained, callback-shaped one."
  [n]
  (let [{:keys [tag props key]} @n
        s (txt props)]
    (case tag
      :page (w/page* (cond-> {:key key}
                       (:max-width props) (assoc :max-width (:max-width props)))
                     (emit-children! n))

      (:card :frame) (w/card* (box-opts props key) (emit-children! n))

      :scroll (w/scroll* (assoc (box-opts props key)
                                :height (num (:height props) 200.0))
                         (emit-children! n))

      :hbox (c/box* (assoc (box-opts props key) :dir :horizontal)
                    (emit-children! n))

      (:vbox :box) (c/box* (box-opts props key) (emit-children! n))

      ;; ONE tag for both kinds of picture: `:feed` is live pixels pushed
      ;; in under a name and re-uploaded as they arrive, `:src` is a file
      ;; decoded once and kept by path. Everything downstream — the fit, the
      ;; bounds, the click — is the same, which is why libvidya makes this a
      ;; prop and not a second tag, and why frq writes [:image {:feed k}]
      ;; for a call tile and [:image {:src p}] for an attachment.
      ;;
      ;; The pixels never go through the reconciler either way: a frame
      ;; arrives when the network says so, and a props diff at thirty a
      ;; second would be a re-render per frame per peer.
      :image (let [id (c/next-id key)
                   rect (w/image {:feed (:feed props) :src (:src props)}
                                 {:fit (:fit props)
                                  :max-width (:max-width props)
                                  :max-height (:max-height props)
                                  :size (:size props)
                                  :expand (:expand props)})]
               (record! n id)
               (when (:clicked? (c/interact! id rect)) (fire! n :on-click)))

      :title-2 (w/title-2 s)

      :status (w/status s (boolean (:live props)))

      :spinner (w/spinner s)

      :link (let [id (c/next-id key)]
              (record! n id)
              (when (w/link s {:key key}) (fire! n :on-click)))

      :emoji (w/emoji (or (:emoji props) s) (:size props))

      :avatar (w/avatar (or (:label props) s)
                        (cond-> {}
                          (:src props)  (assoc :src (:src props))
                          (:size props) (assoc :size (:size props))))

      :reaction (let [id (c/next-id key)
                      glyph (or (:emoji props) s)]
                  (record! n id)
                  (when (w/reaction glyph {:count (or (:count props) 0)
                                           :mine? (boolean (:mine props))
                                           :size  (:size props)
                                           :key   key})
                    (fire! n :on-click)))

      :title (w/title s)

      :label (if (:dim props) (w/dim-label s) (w/label s))
      :dim-label (w/dim-label s)

      :button (let [id (c/next-id key)
                    hit? (w/button s {:key key :kind (or (:kind props) :normal)})]
                (record! n id)
                (when hit? (fire! n :on-click)))

      ;; :checkbutton is the same widget under GTK's name for it, which is
      ;; what libvidya calls it too — `"checkbutton" | "checkbox"` is one
      ;; arm of its tag table. frq writes both.
      (:checkbox :checkbutton) (let [was (boolean (:checked props))
                      id (c/next-id key)
                      now (w/checkbox was s {:key key})]
                  (record! n id)
                  (when (not= now was) (fire! n :on-change now)))

      :slider (let [was (num (:value props) 0.0)
                    id (c/next-id key)
                    now (w/slider was {:key key
                                       :min (num (:min props) 0.0)
                                       :max (num (:max props) 100.0)})]
                ;; == and not not=, because a component holding a long 0 must
                ;; not be told every frame that its slider moved to 0.0
                (record! n id)
                (when-not (== now was) (fire! n :on-change now)))

      (:entry :text-entry)
      (let [was (str (or (:value props) (:text props) ""))
            id (c/next-id key)
            now (w/text-entry was {:key key :placeholder (:placeholder props)})]
        (record! n id)
        (when (not= now was) (fire! n :on-change now)))

      :progress (w/progress (num (:value props) 0.0))
      :separator (w/separator)
      (:spacer :gap) (w/spacer {:size (num (:size props) 8.0)
                                :expand (:expand props :none)})

      ;; An unknown tag is a container rather than an error, so a tree written
      ;; against a richer backend still shows its contents here — the same
      ;; bargain jolt-zvui makes with the tags it does not know.
      (c/box* (box-opts props key) (emit-children! n)))))

;; --- the loop ----------------------------------------------------------------

(defonce ^:private pending (atom []))

(defn- schedule! [work] (swap! pending conj work) nil)

;; --- timers -----------------------------------------------------------------
;; A client needs somewhere to run work that is not a reaction to anything:
;; frq drives its whole media plane from `(every! 16 pump!)`, and a decoded
;; frame arrives because a timer asked for it rather than because a person
;; clicked. There is no other hook of the right shape — a component body runs
;; when its state changes, which for a video feed is never.
;;
;; Run from the same `:before` as the reconciler's queue, and for the same
;; reason: a callback that patches the tree must not do it mid-walk.

(defonce ^:private timers (atom {}))
(defonce ^:private next-timer (atom 0))

(defn- now-ms [] (System/currentTimeMillis))

(defn after!
  "Run `f` once, at least `ms` from now. Answers a handle for `cancel!`."
  [ms f]
  (let [id (swap! next-timer inc)]
    (swap! timers assoc id {:at (+ (now-ms) ms) :every nil :f f})
    id))

(defn every!
  "Run `f` every `ms`. Answers a handle for `cancel!`.

  Every `ms` AT MOST, not exactly: it fires on the first frame after the
  deadline, so a 16ms timer on a 60Hz window runs once a frame and on a
  slower one runs less often. That is the right failure — a timer that tried
  to catch up would run twice in a row on a stutter, and for a pump that
  means two frames decoded and one shown."
  [ms f]
  (let [id (swap! next-timer inc)]
    (swap! timers assoc id {:at (+ (now-ms) ms) :every ms :f f})
    id))

(defn cancel!
  "Stop a timer."
  [id]
  (swap! timers dissoc id)
  nil)

(defn- run-timers! []
  (let [t (now-ms)
        due (filter (fn [[_ v]] (<= (:at v) t)) @timers)]
    (doseq [[id {:keys [every f]}] due]
      (if every
        (swap! timers assoc-in [id :at] (+ t every))
        (swap! timers dissoc id))
      ;; A throwing timer is cancelled rather than allowed to throw every
      ;; frame for the rest of the session, which is unreadable and stops
      ;; the ones behind it.
      (try (f)
           (catch Exception e
             (swap! timers dissoc id)
             (println "glimmer-jvui: timer failed, cancelled:" (ex-message e)))))))

(defn- drain-pending! []
  (run-timers!)
  (let [[ws] (reset-vals! pending [])]
    (doseq [w ws] (w))))

(defn- run!
  "glimmer.backend's :run. Creates the root page, mounts into it, then hands the
   loop to jvui.

   The reconciler's queued work is drained by jvui's `:before` hook rather than
   inside the walk: a re-render patches the tree, and patching a tree while it
   is being walked is how a frame ends up half old and half new."
  [opts mount-root!]
  (let [{:keys [title width height max-width theme frames auto-quit-ms shot]
         :or {title "glimmer" width 720 height 520}} opts
        root (create! :page (cond-> {} max-width (assoc :max-width max-width)))]
    (mount-root! root :page)
    (reset! b/loop-running? true)
    (try
      (app/run! (fn [] (emit! root))
                {:title title :width width :height height
                 :theme (or theme theme/dark)
                 :before drain-pending!
                 :frames frames :auto-quit-ms auto-quit-ms :shot shot})
      (finally (reset! b/loop-running? false)))))

;; --- registration ------------------------------------------------------------

(def backend
  {:name :jvui
   :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!})

(b/register! backend)

;; --- headless driving, for tests ---------------------------------------------

(defn root-node
  "A bare root page, for mounting into without a window."
  [] (create! :page {}))

(defn render-once
  "Walk `root` through jvui with no window, no font and no display.

   `cx` is a `jvui.core/context`; `evs` the events that frame. Answers the
   context, whose `:data` is every rectangle the walk placed — which is enough
   for a test to assert about a layout and to click on it."
  ([root cx] (render-once root cx []))
  ([root cx evs]
   (drain-pending!)
   (swap! cx assoc :events evs)
   (swap! cx c/apply-input evs)
   (binding [*record-rects?* true]
     (c/frame! cx (fn [] (emit! root))))
   cx))

;; --- feeds ------------------------------------------------------------------
;; The same three calls glimmer-vidya exposes, so a client that paints a call
;; does not care which backend is under it. They are not part of the
;; reconciler and deliberately so: pixels arrive between frames, and the tree
;; only ever holds the key.

(defn frame-rgba!
  "Hand feed `key` a new picture: `w` by `h` RGBA at FOREIGN pointer `px`.

  The pointer is read during this call and not kept, so a caller may reuse
  or free it immediately afterwards — which is what a decoder handing out a
  borrowed buffer needs."
  [key w h px]
  (frames/put! key w h px))

(defn frame-drop!
  "Forget a feed and release its texture — someone left, or turned a camera
  off."
  [key]
  (frames/drop! key))

(defn feed-keys
  "Every feed with a picture."
  []
  (frames/keys*))

;; --- the platform -----------------------------------------------------------
;; The rest of what glimmer-vidya answers, so a client can ask its backend
;; about the window it is in without knowing which backend that is. Thin on
;; purpose: every one of these is jvui.host, and the indirection exists so
;; the client requires one namespace rather than two.

(def set-title!          host/set-title!)
(def window-width        host/window-width)
(def screen-size         host/screen-size)
(def quit!               host/quit!)
(def open-url!           host/open-url!)
(def clipboard-image-png! host/clipboard-image-png!)

;; False and nil on a desktop, which is the right answer rather than a gap:
;; the chooser exists so a phone can hand back a grant for one picture, and
;; a caller reads the false and offers a file browser instead. glimmer-vidya
;; says the same thing here.
(def pick-image!         host/pick-image!)
(def picked-image!       host/picked-image!)