nandi/jolt-native · core.clj

⑂ 4e714e52a800a655efd76ac912be6d35b1909c23
core.clj · 543 lines · 24.1 KBClojure    Blame HistoryRaw
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 1(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]
Give jvui a picture from somewhere else, and a clock   42            [jvui.widgets :as w]
Answer the rest of what a client asks its window   43            [jvui.frames :as frames]
          [jvui.host :as host]))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 45
46;; --- the retained tree -------------------------------------------------------
48(defonce ^:private serial (atom 0))
50(defn- create! [tag props]
(atom {:tag tag :props props :children [] :key (swap! serial inc)}))
53(defn- apply-props! [_tag n props] (swap! n assoc :props props) nil)
54(defn- append-child! [_t parent child] (swap! parent update :children conj child) nil)
55(defn- remove-child! [_t parent child]
(swap! parent update :children #(vec (remove #{child} %))) nil)
57(defn- replace-child! [_t parent old new]
(swap! parent update :children #(mapv (fn [c] (if (= c old) new c)) %)) nil)
59(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))))))
67;; --- props -------------------------------------------------------------------
69(defn- txt [props] (str (or (:label props) (:text props) "")))
71(defn- num [v default] (if (number? v) (double v) default))
Fill the window's height, and find a glyph the UI font has not got   73(defn- fills-height?
"Does any child of `n` ask to fill the height?
 A row is only as tall as what is in it, and frq marks the PANES with
 :fill-height rather than the row that holds them — egui gives a
 horizontal layout the available height and the panes fill that, so
 there is nothing there to mark. Here the row has to be told, and its
 own children are what know: a row holding something that wants the
 height wants the height.
 Asked of the tree rather than inferred from the layout, because the
 layout answers a frame too late — a row that learns it should be tall
 from what happened last frame is a row that is the wrong height on
 the frame anybody looks at."
(boolean (some #(:fill-height (:props (deref %))) (:children (deref n)))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 90(defn- box-opts
"The container options shared by every container tag."
Fill the window's height, and find a glyph the UI font has not got   92  ([props key] (box-opts props key false))
([props key fill-height?]
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 94  (cond-> {:key key
Let a container fill its parent, and report "end" as the word   95           :dir (if (= :horizontal (:orientation props)) :horizontal :vertical)
         ;; A CONTAINER fills its parent's cross axis by default. Without
         ;; this every box shrink-wraps its children, and frq's chat
         ;; column came out a couple of hundred points wide in a
         ;; five-hundred-point window with every message wrapped to
         ;; match — the tree is nested boxes, and each one only as wide
         ;; as what is in it.
         ;; :cross and not :horizontal: in a ROW, :horizontal means take
         ;; a share of the slack, and a line of buttons would stretch to
         ;; fill the window.
         :expand :cross}
Let the pane that fills take the room, and a viewport the height it is in   107    ;; :fill-height is frq's way of saying "this is the pane that takes
  ;; what is left". It is the messages column in the row that also
  ;; holds the people panel, and without it that column claims no slack
  ;; at all — the backlog ends up as wide as the widest message and the
  ;; scrollbar sits in the middle of the window.
  ;; :both rather than :vertical, despite the name: in a ROW the space
  ;; to be taken is horizontal, and a pane that fills the height of a
  ;; row it does not fill the width of is not what anyone means by it.
  ;; The panes that do NOT ask for it stay :cross and keep their own
  ;; size, which is what leaves the slack to be taken.
Fill the window's height, and find a glyph the UI font has not got   118    (or (:fill-height props) fill-height?) (assoc :expand :both)
Let the pane that fills take the room, and a viewport the height it is in   119    ;; A minimum, not a size: the messages column asks for one only while
  ;; the people panel is beside it.
  (:width-request props)
  (assoc :min-size [(num (:width-request props) 0.0) 0.0])
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 123    (: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))
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit   126    (:expand props)  (assoc :expand (:expand props))
  ;; A row whose children start a new line when they run out of room —
  ;; a line of reaction pills is the case that needs it.
  (:wrap props)    (assoc :wrap true)
  ;; Cross-axis placement: :start :center :end, as a gravity.
  (:align props)   (assoc :gravity (case (:align props)
                                     (:center "center") [0.0 0.5]
                                     (:end "end")       [0.0 1.0]
Fill the window's height, and find a glyph the UI font has not got   134
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 135
136(defn- fire! [n k & args]
(when-let [f (get (:props @n) k)] (apply f args)))
139;; --- the walk ----------------------------------------------------------------
141(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."
148
150(declare emit!)
152(defn- record! [n id]
(when *record-rects?* (swap! n assoc :rect (c/rect-of id)))
wip hover card   156(def ^:private hovering
"Which widgets the pointer was on last frame.
 The toolkit answers `:hover?` as a state — the pointer is over this
 rectangle — and a component wants the two EVENTS at its edges. The
 difference is a set, and it is kept here rather than on the node because
 a node is replaced by the reconciler and the pointer has not moved."
(atom #{}))
165(defn- hover!
"Turn `over?` into on-hover and on-unhover, once each per crossing.
 Only on the pass that paints: hover is derived from where the pointer is
 rather than delivered as an event, so it is true on the settling passes
 too, and a handler called from one of those fires two or three times for
 one crossing."
[n id over?]
(when (c/draw-pass?)
  (let [was (contains? @hovering id)]
    (cond
      (and over? (not was)) (do (swap! hovering conj id) (fire! n :on-hover))
      (and was (not over?)) (do (swap! hovering disj id) (fire! n :on-unhover))))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 179(defn- emit-children! [n]
(fn [_id _rect] (doseq [c (:children @n)] (emit! c))))
182(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."
(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))
Make a list follow what arrives in it   198      ;; A list that follows what arrives in it. Everything here beyond
    ;; :height is a prop frq writes and this used to drop on the floor —
    ;; the chat did not follow new messages, and switching channels
    ;; carried the previous one's scroll across.
Fill the window's height, and find a glyph the UI font has not got   202      ;; :expand is forced rather than left to box-opts, whose default is
    ;; :cross — and a viewport that fills only the width asks its column
    ;; for no height, is given none, and shows nothing at all. It is the
    ;; one container that always fills both ways.
    :scroll (w/scroll* (cond-> (assoc (box-opts props key) :expand :both)
Make a list follow what arrives in it   207                           (:height props)
                         (assoc :height (num (:height props) 200.0))
                         (:reserve props)
                         (assoc :reserve (num (:reserve props) 0.0))
                         (:scroll-key props)
                         (assoc :scroll-key (str (:scroll-key props)))
                         (:stick-to-bottom props)
                         (assoc :stick-to-bottom true)
                         (:scroll-to-bottom props)
                         (assoc :scroll-to-bottom (num (:scroll-to-bottom props) 0.0))
Let a container fill its parent, and report "end" as the word   217                           ;; "end" or "away", the STRING libvidya emits —
                         ;; frq's handler is (= "end" %) and a boolean
                         ;; makes it permanently false.
                         ;; :on-scroll is deliberately not fired here.
                         ;; It is the channel for backends that report an
                         ;; OFFSET rather than a place — the terminal's —
                         ;; and frq turns one into the other with
                         ;; `scrolled!`. A window that reports where it
                         ;; ended up has nothing to say on it.
                         (:on-change props)
Make a list follow what arrives in it   228                           (assoc :on-at-end
                                (fn [at-end?]
Let a container fill its parent, and report "end" as the word   230                                    (fire! n :on-change (if at-end? "end" "away")))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 231                         (emit-children! n))
Fill the window's height, and find a glyph the UI font has not got   233      :hbox (c/box* (assoc (box-opts props key (fills-height? n)) :dir :horizontal)
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 234                    (emit-children! n))
Fill the window's height, and find a glyph the UI font has not got   236      (:vbox :box) (c/box* (box-opts props key (fills-height? n))
                         (emit-children! n))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 238
Take the eight tags a client still had nowhere to put   239      ;; 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)
wip hover card   277                      glyph (or (:emoji props) s)
                    r (w/reaction glyph {:count (or (:count props) 0)
Take the eight tags a client still had nowhere to put   279                                           :mine? (boolean (:mine props))
                                         :size  (:size props)
wip hover card   281
                (record! n id)
                (when (:clicked? r) (fire! n :on-click))
                (hover! n id (:hover? r))
                ;; Whatever the client hung under the pill is its hover
                ;; card, and a card is drawn over the row rather than in
Draw a chip.s card because it has one, not because of the pointer   287                  ;; it — see c/overlay!. Just under the pill, which is
                ;; where a pointer resting on the pill is not.
                ;; On having children and not on :hover?. The client is
                ;; the one that knows whether a card is wanted — it is
                ;; already deciding, since it is what puts the child there
                ;; — and a backend that asked the question a second time
                ;; would be answering a pointer the client may not be
                ;; tracking with a pointer of its own.
                (when (seq (:children @n))
wip hover card   297                    (let [[x y _ h] (:rect r)]
                    (c/overlay! id [x (+ y h 4.0)]
                                #(w/card* {:expand :none :key id}
                                          (emit-children! n))))))
Give jvui a picture from somewhere else, and a clock   301
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 302      :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)))
Take :checkbutton, which is :checkbox under another name   312      ;; :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.
Read :active, and keep a field's text inside the field   315      ;; :active is what frq and libvidya call it — `props.bool("active")`
    ;; in libvidya's tag table — and :checked is what this backend called
    ;; it first. Both are read, because a client written against either
    ;; should not render a permanently empty tick; :active wins where
    ;; both appear.
    ;; Likewise both events fire. libvidya emits "toggled"; :on-change is
    ;; what the checkbox here answered to before.
    (:checkbox :checkbutton)
    (let [was (boolean (if (contains? props :active)
                         (:active props)
                         (:checked props)))
          id (c/next-id key)
          now (w/checkbox was s {:key key})]
      (record! n id)
      (when (not= now was)
        (fire! n :on-toggled now)
        (fire! n :on-change now)))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 333
    :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)
Report Enter from a field, and take its width request   347            now (w/text-entry was {:key key
                                 :placeholder (:placeholder props)
                                 ;; :width-request is what frq and
                                 ;; libvidya call a minimum width;
                                 ;; :hexpand says take the rest of the
                                 ;; row, which is this widget's default.
                                 :min-width (:width-request props)
                                 :expand (if (false? (:hexpand props))
                                           :none :horizontal)})]
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 356        (record! n id)
Report Enter from a field, and take its width request   357        (when (not= now was) (fire! n :on-change now))
      ;; Enter, which a field must not swallow as input: frq sends its
      ;; message on it, and without this the compose box accepted text
      ;; and had no way to say it was finished.
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit   361
      ;; NO ARGUMENT. libvidya emits activate with an empty string, and
      ;; frq's handlers are thunks — `s/send-draft!` takes none, and
      ;; handing it the text is an arity error the moment somebody
      ;; presses Enter. The text is already theirs; they got it from
      ;; :on-change.
      (when (w/entry-activated? id) (fire! n :on-activate)))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 368
    :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)))))
379;; --- the loop ----------------------------------------------------------------
381(defonce ^:private pending (atom []))
383(defn- schedule! [work] (swap! pending conj work) nil)
Give jvui a picture from somewhere else, and a clock   385;; --- timers -----------------------------------------------------------------
386;; A client needs somewhere to run work that is not a reaction to anything:
387;; frq drives its whole media plane from `(every! 16 pump!)`, and a decoded
388;; frame arrives because a timer asked for it rather than because a person
389;; clicked. There is no other hook of the right shape — a component body runs
390;; when its state changes, which for a video feed is never.
392;; Run from the same `:before` as the reconciler's queue, and for the same
393;; reason: a callback that patches the tree must not do it mid-walk.
395(defonce ^:private timers (atom {}))
396(defonce ^:private next-timer (atom 0))
398(defn- now-ms [] (System/currentTimeMillis))
400(defn after!
"Run `f` once, at least `ms` from now. Answers a handle for `cancel!`."
402
(let [id (swap! next-timer inc)]
  (swap! timers assoc id {:at (+ (now-ms) ms) :every nil :f f})
405
407(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."
415
(let [id (swap! next-timer inc)]
  (swap! timers assoc id {:at (+ (now-ms) ms) :every ms :f f})
418
420(defn cancel!
"Stop a timer."
(swap! timers dissoc id)
426(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)))))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 441(defn- drain-pending! []
Give jvui a picture from somewhere else, and a clock   442  (run-timers!)
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 443  (let [[ws] (reset-vals! pending [])]
  (doseq [w ws] (w))))
446(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)
459
    (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)))))
467;; --- registration ------------------------------------------------------------
469(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!})
476(b/register! backend)
478;; --- headless driving, for tests ---------------------------------------------
480(defn root-node
"A bare root page, for mounting into without a window."
[] (create! :page {}))
484(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))))
Give jvui a picture from somewhere else, and a clock   498
499;; --- feeds ------------------------------------------------------------------
500;; The same three calls glimmer-vidya exposes, so a client that paints a call
501;; does not care which backend is under it. They are not part of the
502;; reconciler and deliberately so: pixels arrive between frames, and the tree
503;; only ever holds the key.
505(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))
514(defn frame-drop!
"Forget a feed and release its texture — someone left, or turned a camera
(frames/drop! key))
520(defn feed-keys
"Every feed with a picture."
(frames/keys*))
Answer the rest of what a client asks its window   524
525;; --- the platform -----------------------------------------------------------
526;; The rest of what glimmer-vidya answers, so a client can ask its backend
527;; about the window it is in without knowing which backend that is. Thin on
528;; purpose: every one of these is jvui.host, and the indirection exists so
529;; the client requires one namespace rather than two.
531(def set-title!          host/set-title!)
532(def window-width        host/window-width)
533(def screen-size         host/screen-size)
534(def quit!               host/quit!)
535(def open-url!           host/open-url!)
536(def clipboard-image-png! host/clipboard-image-png!)
538;; False and nil on a desktop, which is the right answer rather than a gap:
539;; the chooser exists so a phone can hand back a grant for one picture, and
540;; a caller reads the false and offers a file browser instead. glimmer-vidya
541;; says the same thing here.
542(def pick-image!         host/pick-image!)
543(def picked-image!       host/picked-image!)