(ns glimmer-cosmic.core
  "The libcosmic backend for glimmer. Requiring this namespace installs it:

    (ns myapp
      (:require [glimmer.core :as ui]
                [glimmer-cosmic.core]))       ; installs this backend

    (defn -main [& _] (ui/run my-app :title \"myapp\"))

  The tree half is glimmer-vidya's: node handles in a Rust arena, props written
  across, handlers kept here and found by node id when an event comes back.

  The loop half is inverted. libcosmic will not be driven a frame at a time —
  it takes the main thread and keeps it until the window closes — so `run`
  blocks the main thread there and the reconciler lives on a worker. The worker
  is \"the UI thread\" as far as glimmer is concerned: `schedule` queues onto it,
  handlers run on it, and at the end of each pass it commits, which is the only
  moment libcosmic sees what changed."
  (:require [glimmer.backend :as b]
            [glimmer-cosmic.ffi :as ffi]))

;; Node id -> the :on-* props that node was last rendered with.
(defonce ^:private handlers (atom {}))

;; Work posted from other threads, run on the worker at the top of a pass.
(defonce ^:private pending (atom []))

(defonce ^:private quit-requested (atom false))

;; --- props -------------------------------------------------------------------
(def ^:private tag-orientation {:hbox "horizontal" :vbox "vertical"})

(defn- handler-key? [k]
  (let [s (name k)]
    (and (> (count s) 3) (= "on-" (subs s 0 3)))))

(defn- set-prop! [node k v]
  (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 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 so a prop a re-render
  stops setting is gone — and so the value libcosmic wrote back when someone
  typed is overwritten by the component's own state."
  [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))
  nil)

(defn- forget-dead-handlers! []
  (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! [tag props]
  (let [node (ffi/node-new (name tag))]
    (when (zero? node)
      (throw (ex-info "jolt-cosmic 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)
  nil)

(defn- remove-child! [_parent-tag parent child]
  (ffi/node-remove! parent child)
  (forget-dead-handlers!)
  nil)

(defn- replace-child! [_parent-tag parent old-child new-child]
  (ffi/node-replace! parent old-child new-child)
  (forget-dead-handlers!)
  nil)

(defn- reorder-child! [_parent-tag parent child sibling]
  (ffi/node-insert-after! parent child (or sibling 0))
  nil)

;; --- the worker --------------------------------------------------------------
(defn- schedule
  "glimmer.backend's :schedule. Queues `work` for the worker and wakes it, so a
  `swap!` from anywhere re-renders on the next pass rather than the next
  timeout."
  [work]
  (swap! pending conj work)
  (ffi/wake!)
  nil)

(defn- drain! []
  (loop []
    (let [q @pending]
      (when (seq q)
        (if (compare-and-set! pending q [])
          (doseq [f q] (f))
          (recur))))))

;; --- timers ------------------------------------------------------------------
(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})
    (ffi/wake!)
    id))

(defn after!
  "Run `f` on the worker in about `ms` milliseconds. Returns an id for
  `cancel!`."
  [ms f] (add-timer! ms false f))

(defn every!
  "Run `f` on the worker about every `ms` milliseconds until cancelled."
  [ms f] (add-timer! ms true f))

(defn cancel! [id] (swap! timers update :entries dissoc id) nil)

(defn cancel-all! [] (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))

(defn- next-timeout
  "How long the worker may sleep: until the nearest timer, capped so a quit or
  an auto-quit deadline is noticed within a quarter second."
  []
  (let [dues (map :due (vals (:entries @timers)))]
    (if (seq dues)
      (max 0 (min 250 (- (apply min dues) (now-ms))))
      250)))

;; --- events ------------------------------------------------------------------
(defn- dispatch-events! []
  (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))
          "change"   (when-let [f (:on-change hs)] (f (ffi/event-text)))
          "activate" (when-let [f (:on-activate hs)] (f))
          ;; The two edges of a hover, as glimmer-vidya sends them: once when
          ;; the pointer comes onto the widget and once when it leaves.
          "hover"    (when-let [f (:on-hover hs)] (f))
          "unhover"  (when-let [f (:on-unhover hs)] (f))
          nil))
      (recur))))

;; --- running -----------------------------------------------------------------
(defn- clear-children! [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!
  "Close the window; `run` returns once libcosmic has."
  []
  (reset! quit-requested true)
  (ffi/quit!)
  nil)

(defn- work-loop
  "The worker: sleep until something happens, then run queued work, handlers
  and timers, and publish whatever they changed in one commit."
  [started auto-quit-ms]
  (try
    (loop []
      (ffi/wait! (next-timeout))
      (drain!)
      (dispatch-events!)
      (pump-timers!)
      (ffi/commit!)
      (when (and auto-quit-ms (>= (- (now-ms) started) auto-quit-ms))
        (quit!))
      (when-not (ffi/should-close?)
        (recur)))
    (finally
      ;; A handler that throws takes the window with it, rather than leaving
      ;; one on screen that nothing is listening to.
      (ffi/quit!))))

(defn- run!
  "glimmer.backend's :run. Mounts the root component, starts the worker, and
  blocks the calling thread — which must be the main thread — in libcosmic
  until the window closes or `quit!` is called.

  Options (on top of glimmer's own :title :width :height :auto-quit-ms):
    :mode   :system (default), :dark or :light"
  [opts mount-root!]
  (let [{:keys [title width height mode auto-quit-ms]
         :or {title "glimmer" width 900 height 640}} opts
        root (ffi/tree-root)
        started (now-ms)]
    (reset! quit-requested false)
    ;; Mounted here, before the loop, so it reconciles inline; the first commit
    ;; is what libcosmic opens with.
    (clear-children! root)
    (mount-root! root :window)
    (ffi/commit!)
    (reset! b/loop-running? true)
    (let [worker (future (work-loop started auto-quit-ms))
          status (ffi/run! width height title
                           (case mode
                             :dark ffi/dark-mode
                             :light ffi/light-mode
                             ffi/system-mode))]
      (try
        ;; Rethrows whatever ended the worker, on the thread that called run.
        @worker
        (finally
          (reset! b/loop-running? false)
          (cancel-all!)
          (reset! handlers {})))
      (when-not (zero? status)
        (throw (ex-info "jolt-cosmic's window did not run cleanly"
                        {:status status}))))))

;; --- looking at what was rendered --------------------------------------------
(defn dump-str
  "The tree as it is in the arena — after the reconciler, before any commit —
  as hiccup text."
  ([] (dump-str 0))
  ([node] (ffi/tree-dump node)))

(defn dump
  ([] (dump 0))
  ([node] (read-string (dump-str node))))

(defn dump!
  ([] (dump! 0))
  ([node] (println (dump-str node)) nil))

;; --- the backend -------------------------------------------------------------
(def backend
  {:name           :cosmic
   :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! [] (b/register! backend) nil)

(defonce ^:private installed (do (install!) true))