nandi/jolt-native · core.clj

⑂ 109c7e403bee6fa2ec5a768c39d45341fc10cd6e

core.clj · 233 lines · 9.4 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]
          [jvui.widgets :as w]))
44;; --- the retained tree -------------------------------------------------------
46(defonce ^:private serial (atom 0))
48(defn- create! [tag props]
(atom {:tag tag :props props :children [] :key (swap! serial inc)}))
51(defn- apply-props! [_tag n props] (swap! n assoc :props props) nil)
52(defn- append-child! [_t parent child] (swap! parent update :children conj child) nil)
53(defn- remove-child! [_t parent child]
(swap! parent update :children #(vec (remove #{child} %))) nil)
55(defn- replace-child! [_t parent old new]
(swap! parent update :children #(mapv (fn [c] (if (= c old) new c)) %)) nil)
57(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))))))
65;; --- props -------------------------------------------------------------------
67(defn- txt [props] (str (or (:label props) (:text props) "")))
69(defn- num [v default] (if (number? v) (double v) default))
71(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))))
81(defn- fire! [n k & args]
(when-let [f (get (:props @n) k)] (apply f args)))
84;; --- the walk ----------------------------------------------------------------
86(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."
95(declare emit!)
97(defn- record! [n id]
(when *record-rects?* (swap! n assoc :rect (c/rect-of id)))
101(defn- emit-children! [n]
(fn [_id _rect] (doseq [c (:children @n)] (emit! c))))
104(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))
    :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))
    :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)))
    :checkbox (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)))))
172;; --- the loop ----------------------------------------------------------------
174(defonce ^:private pending (atom []))
176(defn- schedule! [work] (swap! pending conj work) nil)
178(defn- drain-pending! []
(let [[ws] (reset-vals! pending [])]
  (doseq [w ws] (w))))
182(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)
195
    (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)))))
203;; --- registration ------------------------------------------------------------
205(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!})
212(b/register! backend)
214;; --- headless driving, for tests ---------------------------------------------
216(defn root-node
"A bare root page, for mounting into without a window."
[] (create! :page {}))
220(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))))

Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	1	(ns glimmer-jvui.core
	2	"A glimmer backend that renders through [jvui](../../../jvui).
	3
	4	glimmer owns the reactive core — ratoms, components, the reconciler — and
	5	knows nothing about any toolkit. glimmer-gtk fills that in with GtkWidgets,
	6	glimmer-vidya with a Rust node arena painted by egui, glimmer-gfx with a
	7	software rasterizer it writes itself. This fills it in with jvui, and so is
	8	the smallest of the four: everything a backend usually has to supply — the
	9	measuring, the placing, the hit testing, the painting — is already a toolkit
	10	one directory over.
	11
	12	What is left is the half an immediate-mode library does not have: a tree to
	13	hold still between frames. The reconciler needs somewhere to put a widget it
	14	created and to append a child to, and jvui's widgets draw and return within
	15	one call. So a node here is an atom of {:tag :props :children :key}, about
	16	thirty lines of it, and once a frame `emit!` walks that tree and calls the
	17	jvui widget each node names.
	18
	19	# The walk is the closure
	20
	21	glimmer-vidya's README explains why its tree lives in Rust: `ScrollArea` and
	22	`Frame` take an `FnOnce(&mut Ui)` and keep their begin/end private, so a
	23	push/pop ABI cannot scroll a page. jvui's containers take a body function
	24	for the same reason, and here the recursion is that function — `emit!` on
	25	a container passes `emit-children!` as the body, and the nesting takes care
	26	of itself.
	27
	28	# Why every node carries a key
	29
	30	jvui identifies a widget by its parent and its index among its siblings,
	31	unless it is given a `:key`, which replaces the index. A reconciler reorders
	32	children; an identity built on the index would hand each widget after the
	33	moved one the caret, the scroll offset and the drag of whichever widget used
	34	to sit at its index. So every node gets a serial number at creation and
	35	passes it as its key, and the identity follows the node rather than its
	36	position. That is the bug class zvui's README describes from the backend
	37	side, closed here at the other end."
	38	(:require [glimmer.backend :as b]
	39	[jvui.app :as app]
	40	[jvui.core :as c]
	41	[jvui.theme :as theme]
	42	[jvui.widgets :as w]))
	43
	44	;; --- the retained tree -------------------------------------------------------
	45
	46	(defonce ^:private serial (atom 0))
	47
	48	(defn- create! [tag props]
	49	(atom {:tag tag :props props :children [] :key (swap! serial inc)}))
	50
	51	(defn- apply-props! [_tag n props] (swap! n assoc :props props) nil)
	52	(defn- append-child! [_t parent child] (swap! parent update :children conj child) nil)
	53	(defn- remove-child! [_t parent child]
	54	(swap! parent update :children #(vec (remove #{child} %))) nil)
	55	(defn- replace-child! [_t parent old new]
	56	(swap! parent update :children #(mapv (fn [c] (if (= c old) new c)) %)) nil)
	57	(defn- reorder-child! [_t parent child sibling]
	58	(swap! parent update :children
	59	(fn [cs]
	60	(let [cs (vec (remove #{child} cs))
	61	i (if (nil? sibling) 0 (inc (.indexOf cs sibling)))]
	62	(vec (concat (subvec cs 0 i) [child] (subvec cs i))))))
	63	nil)
	64
65	;; --- props -------------------------------------------------------------------
66
67	(defn- txt [props] (str (or (:label props) (:text props) "")))
68
69	(defn- num [v default] (if (number? v) (double v) default))
70
71	(defn- box-opts
72	"The container options shared by every container tag."
73	[props key]
74	(cond-> {:key key
75	:dir (if (= :horizontal (:orientation props)) :horizontal :vertical)}
76	(:spacing props) (assoc :spacing (num (:spacing props) 0.0))
77	(:padding props) (assoc :padding (num (:padding props) 0.0))
78	(:margin props) (assoc :margin (num (:margin props) 0.0))
79	(:expand props) (assoc :expand (:expand props))))
80
81	(defn- fire! [n k & args]
82	(when-let [f (get (:props @n) k)] (apply f args)))
83
84	;; --- the walk ----------------------------------------------------------------
85
86	(def ^:dynamic record-rects?
87	"When true, each node keeps the rectangle jvui gave it, under `:rect`.
88
89	Off in a running window, where it would be a `swap!` per node per frame for
90	nobody's benefit. On under `render-once`, so a test can click the centre of
91	a button the way a person would, rather than guessing at a coordinate and
92	re-guessing every time a padding changes."
93	false)
94
95	(declare emit!)
96
97	(defn- record! [n id]
98	(when record-rects? (swap! n assoc :rect (c/rect-of id)))
99	nil)
100
101	(defn- emit-children! [n]
102	(fn [_id _rect] (doseq [c (:children @n)] (emit! c))))
103
104	(defn- emit!
105	"Render one node, and through it everything below it.
106
107	A widget answers what the person did to it, and that answer is turned back
108	into the callback prop the component registered — which is the whole seam
109	between an immediate-mode toolkit and a retained, callback-shaped one."
110	[n]
111	(let [{:keys [tag props key]} @n
112	s (txt props)]
113	(case tag
114	:page (w/page* (cond-> {:key key}
115	(:max-width props) (assoc :max-width (:max-width props)))
116	(emit-children! n))
117
118	(:card :frame) (w/card* (box-opts props key) (emit-children! n))
119
120	:scroll (w/scroll* (assoc (box-opts props key)
121	:height (num (:height props) 200.0))
122	(emit-children! n))
123
124	:hbox (c/box* (assoc (box-opts props key) :dir :horizontal)
125	(emit-children! n))
126
127	(:vbox :box) (c/box* (box-opts props key) (emit-children! n))
128
129	:title (w/title s)
130
131	:label (if (:dim props) (w/dim-label s) (w/label s))
132	:dim-label (w/dim-label s)
133
134	:button (let [id (c/next-id key)
135	hit? (w/button s {:key key :kind (or (:kind props) :normal)})]
136	(record! n id)
137	(when hit? (fire! n :on-click)))
138
139	:checkbox (let [was (boolean (:checked props))
140	id (c/next-id key)
141	now (w/checkbox was s {:key key})]
142	(record! n id)
143	(when (not= now was) (fire! n :on-change now)))
144
145	:slider (let [was (num (:value props) 0.0)
146	id (c/next-id key)
147	now (w/slider was {:key key
148	:min (num (:min props) 0.0)
149	:max (num (:max props) 100.0)})]
150	;; == and not not=, because a component holding a long 0 must
151	;; not be told every frame that its slider moved to 0.0
152	(record! n id)
153	(when-not (== now was) (fire! n :on-change now)))
154
155	(:entry :text-entry)
156	(let [was (str (or (:value props) (:text props) ""))
157	id (c/next-id key)
158	now (w/text-entry was {:key key :placeholder (:placeholder props)})]
159	(record! n id)
160	(when (not= now was) (fire! n :on-change now)))
161
162	:progress (w/progress (num (:value props) 0.0))
163	:separator (w/separator)
164	(:spacer :gap) (w/spacer {:size (num (:size props) 8.0)
165	:expand (:expand props :none)})
166
167	;; An unknown tag is a container rather than an error, so a tree written
168	;; against a richer backend still shows its contents here — the same
169	;; bargain jolt-zvui makes with the tags it does not know.
170	(c/box* (box-opts props key) (emit-children! n)))))
171
172	;; --- the loop ----------------------------------------------------------------
173
174	(defonce ^:private pending (atom []))
175
176	(defn- schedule! [work] (swap! pending conj work) nil)
177
178	(defn- drain-pending! []
179	(let [[ws] (reset-vals! pending [])]
180	(doseq [w ws] (w))))
181
182	(defn- run!
183	"glimmer.backend's :run. Creates the root page, mounts into it, then hands the
184	loop to jvui.
185
186	The reconciler's queued work is drained by jvui's `:before` hook rather than
187	inside the walk: a re-render patches the tree, and patching a tree while it
188	is being walked is how a frame ends up half old and half new."
189	[opts mount-root!]
190	(let [{:keys [title width height max-width theme frames auto-quit-ms shot]
191	:or {title "glimmer" width 720 height 520}} opts
192	root (create! :page (cond-> {} max-width (assoc :max-width max-width)))]
193	(mount-root! root :page)
194	(reset! b/loop-running? true)
195	(try
196	(app/run! (fn [] (emit! root))
197	{:title title :width width :height height
198	:theme (or theme theme/dark)
199	:before drain-pending!
200	:frames frames :auto-quit-ms auto-quit-ms :shot shot})
201	(finally (reset! b/loop-running? false)))))
202
203	;; --- registration ------------------------------------------------------------
204
205	(def backend
206	{:name :jvui
207	:create! create! :apply-props! apply-props!
208	:append-child! append-child! :remove-child! remove-child!
209	:replace-child! replace-child! :reorder-child! reorder-child!
210	:schedule schedule! :run run!})
211
212	(b/register! backend)
213
214	;; --- headless driving, for tests ---------------------------------------------
215
216	(defn root-node
217	"A bare root page, for mounting into without a window."
218	[] (create! :page {}))
219
220	(defn render-once
221	"Walk `root` through jvui with no window, no font and no display.
222
223	`cx` is a `jvui.core/context`; `evs` the events that frame. Answers the
224	context, whose `:data` is every rectangle the walk placed — which is enough
225	for a test to assert about a layout and to click on it."
226	([root cx] (render-once root cx []))
227	([root cx evs]
228	(drain-pending!)
229	(swap! cx assoc :events evs)
230	(swap! cx c/apply-input evs)
231	(binding [record-rects? true]
232	(c/frame! cx (fn [] (emit! root))))
233	cx))