nandi/jolt-native · 32fae8d

⑂ 32fae8d

Give jvui a picture from somewhere else, and a clock

Two things a client needs that jvui had no shape for. frq is the client:
its call wall is one tile per person, each filled by a decoder, and its
whole media plane is driven from (every! 16 pump!).

jvui.frames is pictures that arrive BETWEEN frames. A decoder hands one
over when the network gives it one, not when the UI is walking, so there is
no painter in scope and no rect to put it in — the texture is uploaded
then, on the thread that brought it, and the walk finds it already on the
GPU. That is also why the renderer is held as state here rather than passed
in: the alternative is threading a painter through a media pipeline so a
codec can know about a toolkit.

And the pixels are BORROWED. sdl/update-texture! takes an int-array, which
means a decoded frame becomes a jolt value on the way to the screen; at
thirty frames a second and two megabytes a frame that costs more than the
decode. update-texture-raw! reads the caller's pointer during the call and
does not keep it.

ABGR8888, not ARGB8888, and it is worth saying why in the source: a buffer
whose BYTES run R,G,B,A is the 32-bit word 0xAABBGGRR, so ABGR is the
format that matches it and the obvious-looking choice rotates every channel
and turns skin blue.

Timers run from the same :before hook as the reconciler's queue, and for
the same reason — a callback that patches the tree must not do it mid-walk.
`every!` fires on the first frame after its deadline rather than trying to
catch up: a timer that caught up would run twice after a stutter, and for a
pump that means two frames decoded and one shown.

The pixel test earns its place twice over. It reads a screenshot back and
checks the red half is red, which no layout test can: headless there is no
renderer, so every frame is dropped and an empty tile lays out perfectly.
And writing it found the thing that would have wasted an afternoon in frq —
pushing frames from a component body proves nothing, because a component
with no state renders once, at mount, before the window exists. It has to
come from a timer, which is what frq does anyway.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>

nandi committed 2026-09-10T05:35:36-07:00 Browse files

32fae8d parent: 356d73f

modified glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +96 -1 Viewed

@@ -39,7 +39,8 @@
39	39	[jvui.app :as app]
40	40	[jvui.core :as c]
41	41	[jvui.theme :as theme]
42		- [jvui.widgets :as w]))
	42	+ [jvui.widgets :as w]
	43	+ [jvui.frames :as frames]))
43	44
44	45	;; --- the retained tree -------------------------------------------------------
45	46
@@ -126,6 +127,17 @@
126	127
127	128	(:vbox :box) (c/box* (box-opts props key) (emit-children! n))
128	129
	130	+ ;; A live picture: a camera, a call, anything a decoder is filling in
	131	+ ;; between frames. The node carries only the KEY — the pixels never go
	132	+ ;; through the reconciler, because a video frame arrives when the
	133	+ ;; network says so and a props diff at thirty a second would be a
	134	+ ;; re-render per frame per peer.
	135	+ :video (w/video (or (:feed props) (:key props) (str key))
	136	+ (cond-> {}
	137	+ (:size props) (assoc :size (:size props))
	138	+ (:expand props) (assoc :expand (:expand props))
	139	+ (:gravity props) (assoc :gravity (:gravity props))))
	140	+
129	141	:title (w/title s)
130	142
131	143	:label (if (:dim props) (w/dim-label s) (w/label s))
@@ -175,7 +187,64 @@
175	187
176	188	(defn- schedule! [work] (swap! pending conj work) nil)
177	189
	190	+;; --- timers -----------------------------------------------------------------
	191	+;; A client needs somewhere to run work that is not a reaction to anything:
	192	+;; frq drives its whole media plane from `(every! 16 pump!)`, and a decoded
	193	+;; frame arrives because a timer asked for it rather than because a person
	194	+;; clicked. There is no other hook of the right shape — a component body runs
	195	+;; when its state changes, which for a video feed is never.
	196	+;;
	197	+;; Run from the same `:before` as the reconciler's queue, and for the same
	198	+;; reason: a callback that patches the tree must not do it mid-walk.
	199	+
	200	+(defonce ^:private timers (atom {}))
	201	+(defonce ^:private next-timer (atom 0))
	202	+
	203	+(defn- now-ms [] (System/currentTimeMillis))
	204	+
	205	+(defn after!
	206	+ "Run `f` once, at least `ms` from now. Answers a handle for `cancel!`."
	207	+ [ms f]
	208	+ (let [id (swap! next-timer inc)]
	209	+ (swap! timers assoc id {:at (+ (now-ms) ms) :every nil :f f})
	210	+ id))
	211	+
	212	+(defn every!
	213	+ "Run `f` every `ms`. Answers a handle for `cancel!`.
	214	+
	215	+ Every `ms` AT MOST, not exactly: it fires on the first frame after the
	216	+ deadline, so a 16ms timer on a 60Hz window runs once a frame and on a
	217	+ slower one runs less often. That is the right failure — a timer that tried
	218	+ to catch up would run twice in a row on a stutter, and for a pump that
	219	+ means two frames decoded and one shown."
	220	+ [ms f]
	221	+ (let [id (swap! next-timer inc)]
	222	+ (swap! timers assoc id {:at (+ (now-ms) ms) :every ms :f f})
	223	+ id))
	224	+
	225	+(defn cancel!
	226	+ "Stop a timer."
	227	+ [id]
	228	+ (swap! timers dissoc id)
	229	+ nil)
	230	+
	231	+(defn- run-timers! []
	232	+ (let [t (now-ms)
	233	+ due (filter (fn [[_ v]] (<= (:at v) t)) @timers)]
	234	+ (doseq [[id {:keys [every f]}] due]
	235	+ (if every
	236	+ (swap! timers assoc-in [id :at] (+ t every))
	237	+ (swap! timers dissoc id))
	238	+ ;; A throwing timer is cancelled rather than allowed to throw every
	239	+ ;; frame for the rest of the session, which is unreadable and stops
	240	+ ;; the ones behind it.
	241	+ (try (f)
	242	+ (catch Exception e
	243	+ (swap! timers dissoc id)
	244	+ (println "glimmer-jvui: timer failed, cancelled:" (ex-message e)))))))
	245	+
178	246	(defn- drain-pending! []
	247	+ (run-timers!)
179	248	(let [[ws] (reset-vals! pending [])]
180	249	(doseq [w ws] (w))))
181	250
@@ -231,3 +300,29 @@
231	300	(binding [record-rects? true]
232	301	(c/frame! cx (fn [] (emit! root))))
233	302	cx))
	303	+
	304	+;; --- feeds ------------------------------------------------------------------
	305	+;; The same three calls glimmer-vidya exposes, so a client that paints a call
	306	+;; does not care which backend is under it. They are not part of the
	307	+;; reconciler and deliberately so: pixels arrive between frames, and the tree
	308	+;; only ever holds the key.
	309	+
	310	+(defn frame-rgba!
	311	+ "Hand feed `key` a new picture: `w` by `h` RGBA at FOREIGN pointer `px`.
	312	+
	313	+ The pointer is read during this call and not kept, so a caller may reuse
	314	+ or free it immediately afterwards — which is what a decoder handing out a
	315	+ borrowed buffer needs."
	316	+ [key w h px]
	317	+ (frames/put! key w h px))
	318	+
	319	+(defn frame-drop!
	320	+ "Forget a feed and release its texture — someone left, or turned a camera
	321	+ off."
	322	+ [key]
	323	+ (frames/drop! key))
	324	+
	325	+(defn feed-keys
	326	+ "Every feed with a picture."
	327	+ []
	328	+ (frames/keys*))

              [jvui.app :as app]
              [jvui.core :as c]
              [jvui.theme :as theme]
--            [jvui.widgets :as w]))
++            [jvui.widgets :as w]
++            [jvui.frames :as frames]))
  ;; --- the retained tree -------------------------------------------------------
        (:vbox :box) (c/box* (box-opts props key) (emit-children! n))
++      ;; A live picture: a camera, a call, anything a decoder is filling in
++      ;; between frames. The node carries only the KEY — the pixels never go
++      ;; through the reconciler, because a video frame arrives when the
++      ;; network says so and a props diff at thirty a second would be a
++      ;; re-render per frame per peer.
++      :video (w/video (or (:feed props) (:key props) (str key))
++                      (cond-> {}
++                        (:size props)    (assoc :size (:size props))
++                        (:expand props)  (assoc :expand (:expand props))
++                        (:gravity props) (assoc :gravity (:gravity props))))
++
        :title (w/title s)
        :label (if (:dim props) (w/dim-label s) (w/label s))
  (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))))
     (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*))

added glimmer-backends/glimmer-jvui/test/glimmer_jvui/video_check.clj +77 -0 Viewed

new file mode 100644
@@ -0,0 +1,77 @@
	1	+(ns glimmer-jvui.video-check
	2	+ "A :video node, painted, and the pixels checked.
	3	+
	4	+ The layout tests run headless and cannot see this: with no renderer every
	5	+ frame is dropped and a video tile is an empty rectangle that lays out
	6	+ correctly. What is actually at stake is the CHANNEL ORDER — a buffer whose
	7	+ bytes run R,G,B,A is the 32-bit word 0xAABBGGRR, so SDL wants ABGR8888 and
	8	+ the obvious-looking ARGB8888 rotates every channel and turns skin blue. A
	9	+ test that only asked whether a texture existed would pass either way.
	10	+
	11	+ So: a window under SDL's dummy driver, a frame with a RED left half and a
	12	+ BLUE right half, a screenshot, and a look at what came out."
	13	+ (:require [glimmer.core :as ui]
	14	+ [glimmer.ratom :as ra]
	15	+ [glimmer-jvui.core :as backend]
	16	+ [jvui.sdl :as sdl]
	17	+ [jolt.ffi :as ffi]))
	18	+
	19	+(defn- red-blue
	20	+ "w by h RGBA: red left, blue right, opaque."
	21	+ [w h]
	22	+ (let [p (ffi/alloc (* 4 w h))]
	23	+ (dotimes [y h]
	24	+ (dotimes [x w]
	25	+ (let [o (* 4 (+ (* y w) x))
	26	+ left? (< x (quot w 2))]
	27	+ (ffi/write (+ p o 0) :uint8 (if left? 230 10)) ; R
	28	+ (ffi/write (+ p o 1) :uint8 10) ; G
	29	+ (ffi/write (+ p o 2) :uint8 (if left? 10 230)) ; B
	30	+ (ffi/write (+ p o 3) :uint8 255)))) ; A
	31	+ p))
	32	+
	33	+;; A BMP from SDL is bottom-up and 24bpp, with rows padded to a four-byte
	34	+;; boundary and the pixel array offset in the header at byte 10. Every one of
	35	+;; those was got wrong first time round — 32bpp and no padding — and the
	36	+;; result was not an error but plausible-looking numbers from the wrong
	37	+;; addresses, which is exactly how a pixel test lies to you.
	38	+(defn- bmp-pixel [path x y]
	39	+ (let [b (java.nio.file.Files/readAllBytes (java.nio.file.Path/of path (into-array String [])))
	40	+ u (fn [i] (bit-and (int (aget b i)) 255))
	41	+ le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
	42	+ (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
	43	+ off (le 10)
	44	+ w (le 18)
	45	+ h (le 22)
	46	+ stride (* 4 (quot (+ (* w 3) 3) 4))
	47	+ i (+ off (* (- h 1 y) stride) (* 3 x))]
	48	+ {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))
	49	+
	50	+(defn -main [& _]
	51	+ (let [px (red-blue 64 64)
	52	+ shot (str (System/getProperty "java.io.tmpdir") "/jvui-video-check.bmp")
	53	+ n (ra/atom 0)]
	54	+ (try
	55	+ ;; Pushed from a TIMER, which is how frq does it — av.clj drives its
	56	+ ;; whole media plane from (every! 16 pump!). Pushing from the
	57	+ ;; component body instead is what the first version of this test did,
	58	+ ;; and it silently proved nothing: a component with no state renders
	59	+ ;; once, at mount, before the window exists — so the frame was
	60	+ ;; dropped for want of a renderer and the tile was empty for a
	61	+ ;; reason that had nothing to do with the picture.
	62	+ (backend/every! 16 (fn [] (backend/frame-rgba! "peer" 64 64 px)))
	63	+ (ui/run (fn [] [:video {:feed "peer" :size [120.0 120.0]}])
	64	+ {:title "video" :width 160 :height 160 :frames 6 :shot shot})
	65	+ (finally (ffi/free px)))
	66	+ (let [left (bmp-pixel shot 40 80)
	67	+ right (bmp-pixel shot 120 80)
	68	+ ok-l (and (> (:r left) 150) (< (:b left) 100))
	69	+ ok-r (and (> (:b right) 150) (< (:r right) 100))]
	70	+ (println " left pixel " (pr-str left))
	71	+ (println " right pixel" (pr-str right))
	72	+ (println (if ok-l "- the red half is red" "FAIL the red half is not red"))
	73	+ (println (if ok-r "- the blue half is blue" "FAIL the blue half is not blue"))
	74	+ (if (and ok-l ok-r)
	75	+ (println "all 2 checks passed")
	76	+ (do (println "channel order is wrong — see the ABGR note in jvui.sdl")
	77	+ (System/exit 1))))))

++(ns glimmer-jvui.video-check
++  "A :video node, painted, and the pixels checked.
++
++  The layout tests run headless and cannot see this: with no renderer every
++  frame is dropped and a video tile is an empty rectangle that lays out
++  correctly. What is actually at stake is the CHANNEL ORDER — a buffer whose
++  bytes run R,G,B,A is the 32-bit word 0xAABBGGRR, so SDL wants ABGR8888 and
++  the obvious-looking ARGB8888 rotates every channel and turns skin blue. A
++  test that only asked whether a texture existed would pass either way.
++
++  So: a window under SDL's dummy driver, a frame with a RED left half and a
++  BLUE right half, a screenshot, and a look at what came out."
++  (:require [glimmer.core :as ui]
++            [glimmer.ratom :as ra]
++            [glimmer-jvui.core :as backend]
++            [jvui.sdl :as sdl]
++            [jolt.ffi :as ffi]))
++
++(defn- red-blue
++  "w by h RGBA: red left, blue right, opaque."
++  [w h]
++  (let [p (ffi/alloc (* 4 w h))]
++    (dotimes [y h]
++      (dotimes [x w]
++        (let [o (* 4 (+ (* y w) x))
++              left? (< x (quot w 2))]
++          (ffi/write (+ p o 0) :uint8 (if left? 230 10))   ; R
++          (ffi/write (+ p o 1) :uint8 10)                  ; G
++          (ffi/write (+ p o 2) :uint8 (if left? 10 230))   ; B
++          (ffi/write (+ p o 3) :uint8 255))))              ; A
++    p))
++
++;; A BMP from SDL is bottom-up and 24bpp, with rows padded to a four-byte
++;; boundary and the pixel array offset in the header at byte 10. Every one of
++;; those was got wrong first time round — 32bpp and no padding — and the
++;; result was not an error but plausible-looking numbers from the wrong
++;; addresses, which is exactly how a pixel test lies to you.
++(defn- bmp-pixel [path x y]
++  (let [b (java.nio.file.Files/readAllBytes (java.nio.file.Path/of path (into-array String [])))
++        u (fn [i] (bit-and (int (aget b i)) 255))
++        le (fn [i] (+ (u i) (bit-shift-left (u (+ i 1)) 8)
++                      (bit-shift-left (u (+ i 2)) 16) (bit-shift-left (u (+ i 3)) 24)))
++        off (le 10)
++        w (le 18)
++        h (le 22)
++        stride (* 4 (quot (+ (* w 3) 3) 4))
++        i (+ off (* (- h 1 y) stride) (* 3 x))]
++    {:b (u i) :g (u (+ i 1)) :r (u (+ i 2))}))
++
++(defn -main [& _]
++  (let [px   (red-blue 64 64)
++        shot (str (System/getProperty "java.io.tmpdir") "/jvui-video-check.bmp")
++        n    (ra/atom 0)]
++    (try
++      ;; Pushed from a TIMER, which is how frq does it — av.clj drives its
++      ;; whole media plane from (every! 16 pump!). Pushing from the
++      ;; component body instead is what the first version of this test did,
++      ;; and it silently proved nothing: a component with no state renders
++      ;; once, at mount, before the window exists — so the frame was
++      ;; dropped for want of a renderer and the tile was empty for a
++      ;; reason that had nothing to do with the picture.
++      (backend/every! 16 (fn [] (backend/frame-rgba! "peer" 64 64 px)))
++      (ui/run (fn [] [:video {:feed "peer" :size [120.0 120.0]}])
++              {:title "video" :width 160 :height 160 :frames 6 :shot shot})
++      (finally (ffi/free px)))
++    (let [left  (bmp-pixel shot 40 80)
++          right (bmp-pixel shot 120 80)
++          ok-l  (and (> (:r left) 150) (< (:b left) 100))
++          ok-r  (and (> (:b right) 150) (< (:r right) 100))]
++      (println "  left pixel " (pr-str left))
++      (println "  right pixel" (pr-str right))
++      (println (if ok-l "- the red half is red" "FAIL the red half is not red"))
++      (println (if ok-r "- the blue half is blue" "FAIL the blue half is not blue"))
++      (if (and ok-l ok-r)
++        (println "all 2 checks passed")
++        (do (println "channel order is wrong — see the ABGR note in jvui.sdl")
++            (System/exit 1))))))

modified jvui/src/jvui/app.clj +6 -0 Viewed

@@ -7,6 +7,7 @@
7	7	(:require [jvui.sdl :as sdl]
8	8	[jvui.font :as font]
9	9	[jvui.paint :as paint]
	10	+ [jvui.frames :as frames]
10	11	[jvui.theme :as theme]
11	12	[jvui.core :as c]))
12	13
@@ -68,6 +69,10 @@
68	69	:theme (or theme theme/dark)})
69	70	painter (:painter @ctx)
70	71	deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
	72	+ ;; Feeds can only be uploaded once there is a renderer to upload
	73	+ ;; into. Anything that arrives before this is dropped rather than
	74	+ ;; queued — see jvui.frames.
	75	+ (frames/install-renderer! renderer)
71	76	(sdl/start-text-input! window)
72	77	(try
73	78	(loop [n 0]
@@ -96,6 +101,7 @@
96	101	(and deadline (> (System/currentTimeMillis) deadline)))
97	102	(recur (inc n)))))
98	103	(finally
	104	+ (frames/clear!)
99	105	(paint/close! painter)
100	106	(font/close! fonts)
101	107	(sdl/close! win))))))

    (:require [jvui.sdl :as sdl]
              [jvui.font :as font]
              [jvui.paint :as paint]
++            [jvui.frames :as frames]
              [jvui.theme :as theme]
              [jvui.core :as c]))
                          :theme (or theme theme/dark)})
            painter (:painter @ctx)
            deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
++      ;; Feeds can only be uploaded once there is a renderer to upload
++      ;; into. Anything that arrives before this is dropped rather than
++      ;; queued — see jvui.frames.
++      (frames/install-renderer! renderer)
        (sdl/start-text-input! window)
        (try
          (loop [n 0]
                            (and deadline (> (System/currentTimeMillis) deadline)))
                (recur (inc n)))))
          (finally
++          (frames/clear!)
            (paint/close! painter)
            (font/close! fonts)
            (sdl/close! win))))))

modified jvui/src/jvui/core.clj +8 -0 Viewed

@@ -37,6 +37,7 @@
37	37	the drag until release even when the pointer leaves its rectangle, which is
38	38	what makes a slider survive a fast gesture."
39	39	(:require [jvui.paint :as paint]
	40	+ [jvui.frames :as frames]
40	41	[jvui.theme :as theme]
41	42	[jvui.font :as font]
42	43	[jvui.sdl :as sdl]))
@@ -121,6 +122,13 @@
121	122	[s x y size colour]
122	123	(when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))
123	124
	125	+(defn draw-frame!
	126	+ "Paint feed `key`'s latest picture into `rect`, if it has one."
	127	+ [key rect]
	128	+ (when (drawing?)
	129	+ (when-let [{:keys [tex w h]} (frames/lookup key)]
	130	+ (when tex (paint/frame! (:painter (ui)) tex w h rect)))))
	131	+
124	132	(defn draw-line!
125	133	[x0 y0 x1 y1 colour width]
126	134	(when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))

     the drag until release even when the pointer leaves its rectangle, which is
     what makes a slider survive a fast gesture."
    (:require [jvui.paint :as paint]
++            [jvui.frames :as frames]
              [jvui.theme :as theme]
              [jvui.font :as font]
              [jvui.sdl :as sdl]))
    [s x y size colour]
    (when (drawing?) (paint/text! (:painter (ui)) s x y size colour)))
++(defn draw-frame!
++  "Paint feed `key`'s latest picture into `rect`, if it has one."
++  [key rect]
++  (when (drawing?)
++    (when-let [{:keys [tex w h]} (frames/lookup key)]
++      (when tex (paint/frame! (:painter (ui)) tex w h rect)))))
++
  (defn draw-line!
    [x0 y0 x1 y1 colour width]
    (when (drawing?) (paint/line! (:painter (ui)) x0 y0 x1 y1 colour width)))

added jvui/src/jvui/frames.clj +91 -0 Viewed

new file mode 100644
@@ -0,0 +1,91 @@
	1	+(ns jvui.frames
	2	+ "Pictures that arrive from somewhere else — a camera, a decoder, a call.
	3	+
	4	+ Everything else jvui paints, it paints: a rectangle, a glyph, a rounded
	5	+ corner. A video frame is different in two ways that make it worth its own
	6	+ namespace.
	7	+
	8	+ IT ARRIVES BETWEEN FRAMES. A decoder hands over a picture when the network
	9	+ gives it one, not when the UI is walking, so there is no painter in scope
	10	+ and no rect to put it in. The texture is uploaded THEN — immediately, on
	11	+ the thread that brought it — and the walk finds it already on the GPU.
	12	+
	13	+ AND THE PIXELS ARE BORROWED. The pointer belongs to whatever decoded it and
	14	+ is good until that decoder produces its next picture, so it cannot be kept
	15	+ and cannot be copied into a jolt value on the way past. `put!` uploads
	16	+ straight from the pointer and returns; after that the caller may do what it
	17	+ likes with the memory.
	18	+
	19	+ Which is why the renderer is held here as state rather than passed in. It
	20	+ is not lovely, and the alternative is worse: threading a painter through a
	21	+ media pipeline so a codec can know about a toolkit."
	22	+ (:require [jvui.sdl :as sdl]))
	23	+
	24	+(defonce ^:private renderer (atom nil))
	25	+(defonce ^:private textures (atom {}))
	26	+
	27	+(defn install-renderer!
	28	+ "Called by the frame loop when a window opens.
	29	+
	30	+ Frames that arrive before this are dropped rather than queued: a picture
	31	+ with nowhere to go is a picture nobody saw, and holding it would mean
	32	+ holding a pointer whose owner has moved on."
	33	+ [r]
	34	+ (reset! renderer r))
	35	+
	36	+(defn- free-texture! [{:keys [tex]}]
	37	+ (when tex (sdl/destroy-texture! tex)))
	38	+
	39	+(defn drop!
	40	+ "Forget a feed and release its texture."
	41	+ [key]
	42	+ (when-let [t (get @textures key)]
	43	+ (swap! textures dissoc key)
	44	+ (free-texture! t))
	45	+ nil)
	46	+
	47	+(defn put!
	48	+ "Upload one RGBA frame, `w` by `h`, from FOREIGN memory at `ptr`.
	49	+
	50	+ The texture is recreated when the size changes — a peer switching camera
	51	+ or resolution mid-call is a real thing, and SDL will not resize one in
	52	+ place. Otherwise the same texture is written over, which is what
	53	+ STREAMING access is for."
	54	+ [key w h ptr]
	55	+ (when-let [r @renderer]
	56	+ (when (and (pos? w) (pos? h) ptr)
	57	+ (let [have (get @textures key)
	58	+ t (if (and have (= w (:w have)) (= h (:h have)))
	59	+ have
	60	+ (do (when have (free-texture! have))
	61	+ (let [tex (sdl/create-texture r sdl/PIXELFORMAT-ABGR8888
	62	+ sdl/TEXTUREACCESS-STREAMING
	63	+ w h)]
	64	+ (when tex
	65	+ (sdl/texture-blend-mode! tex sdl/BLEND)
	66	+ ;; Linear, because a call tile is almost never shown
	67	+ ;; at the size it was encoded.
	68	+ (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR))
	69	+ {:tex tex :w w :h h})))]
	70	+ (when (:tex t)
	71	+ (sdl/update-texture-raw! (:tex t) ptr (* 4 w))
	72	+ (swap! textures assoc key t))))
	73	+ nil))
	74	+
	75	+(defn lookup
	76	+ "{:tex :w :h} for a feed, or nil."
	77	+ [key]
	78	+ (get @textures key))
	79	+
	80	+(defn keys*
	81	+ "Every feed with a picture."
	82	+ []
	83	+ (set (keys @textures)))
	84	+
	85	+(defn clear!
	86	+ "Release every texture — the window is going away."
	87	+ []
	88	+ (doseq [[_ t] @textures] (free-texture! t))
	89	+ (reset! textures {})
	90	+ (reset! renderer nil)
	91	+ nil)

++(ns jvui.frames
++  "Pictures that arrive from somewhere else — a camera, a decoder, a call.
++
++  Everything else jvui paints, it paints: a rectangle, a glyph, a rounded
++  corner. A video frame is different in two ways that make it worth its own
++  namespace.
++
++  IT ARRIVES BETWEEN FRAMES. A decoder hands over a picture when the network
++  gives it one, not when the UI is walking, so there is no painter in scope
++  and no rect to put it in. The texture is uploaded THEN — immediately, on
++  the thread that brought it — and the walk finds it already on the GPU.
++
++  AND THE PIXELS ARE BORROWED. The pointer belongs to whatever decoded it and
++  is good until that decoder produces its next picture, so it cannot be kept
++  and cannot be copied into a jolt value on the way past. `put!` uploads
++  straight from the pointer and returns; after that the caller may do what it
++  likes with the memory.
++
++  Which is why the renderer is held here as state rather than passed in. It
++  is not lovely, and the alternative is worse: threading a painter through a
++  media pipeline so a codec can know about a toolkit."
++  (:require [jvui.sdl :as sdl]))
++
++(defonce ^:private renderer (atom nil))
++(defonce ^:private textures (atom {}))
++
++(defn install-renderer!
++  "Called by the frame loop when a window opens.
++
++  Frames that arrive before this are dropped rather than queued: a picture
++  with nowhere to go is a picture nobody saw, and holding it would mean
++  holding a pointer whose owner has moved on."
++  [r]
++  (reset! renderer r))
++
++(defn- free-texture! [{:keys [tex]}]
++  (when tex (sdl/destroy-texture! tex)))
++
++(defn drop!
++  "Forget a feed and release its texture."
++  [key]
++  (when-let [t (get @textures key)]
++    (swap! textures dissoc key)
++    (free-texture! t))
++  nil)
++
++(defn put!
++  "Upload one RGBA frame, `w` by `h`, from FOREIGN memory at `ptr`.
++
++  The texture is recreated when the size changes — a peer switching camera
++  or resolution mid-call is a real thing, and SDL will not resize one in
++  place. Otherwise the same texture is written over, which is what
++  STREAMING access is for."
++  [key w h ptr]
++  (when-let [r @renderer]
++    (when (and (pos? w) (pos? h) ptr)
++      (let [have (get @textures key)
++            t (if (and have (= w (:w have)) (= h (:h have)))
++                have
++                (do (when have (free-texture! have))
++                    (let [tex (sdl/create-texture r sdl/PIXELFORMAT-ABGR8888
++                                                  sdl/TEXTUREACCESS-STREAMING
++                                                  w h)]
++                      (when tex
++                        (sdl/texture-blend-mode! tex sdl/BLEND)
++                        ;; Linear, because a call tile is almost never shown
++                        ;; at the size it was encoded.
++                        (sdl/texture-scale-mode! tex sdl/SCALE-LINEAR))
++                      {:tex tex :w w :h h})))]
++        (when (:tex t)
++          (sdl/update-texture-raw! (:tex t) ptr (* 4 w))
++          (swap! textures assoc key t))))
++    nil))
++
++(defn lookup
++  "{:tex :w :h} for a feed, or nil."
++  [key]
++  (get @textures key))
++
++(defn keys*
++  "Every feed with a picture."
++  []
++  (set (keys @textures)))
++
++(defn clear!
++  "Release every texture — the window is going away."
++  []
++  (doseq [[_ t] @textures] (free-texture! t))
++  (reset! textures {})
++  (reset! renderer nil)
++  nil)

modified jvui/src/jvui/paint.clj +16 -0 Viewed

@@ -134,6 +134,22 @@
134	134	colour (max 0.0 (- radius bw)))))
135	135	(when colour (round-rect! p [x y w h] colour radius))))))
136	136
	137	+(defn frame!
	138	+ "Blit a whole texture into `rect`, letterboxed to keep its shape.
	139	+
	140	+ Stretching to fill would be one line shorter and would make every face in
	141	+ a call slightly wrong — a 16:9 camera in a square tile is the ordinary
	142	+ case, not the exceptional one."
	143	+ [p tex tw th [x y w h]]
	144	+ (let [{:keys [r]} @p
	145	+ sx (/ (double w) tw)
	146	+ sy (/ (double h) th)
	147	+ k (min sx sy)
	148	+ dw (* tw k)
	149	+ dh (* th k)]
	150	+ (flush! p)
	151	+ (sdl/blit! r tex nil [(+ x (/ (- w dw) 2.0)) (+ y (/ (- h dh) 2.0)) dw dh])))
	152	+
137	153	(defn line!
138	154	"A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case
139	155	— which in this toolkit is a checkbox tick — is a few offset hairlines,

                          colour (max 0.0 (- radius bw)))))
         (when colour (round-rect! p [x y w h] colour radius))))))
++(defn frame!
++  "Blit a whole texture into `rect`, letterboxed to keep its shape.
++
++   Stretching to fill would be one line shorter and would make every face in
++   a call slightly wrong — a 16:9 camera in a square tile is the ordinary
++   case, not the exceptional one."
++  [p tex tw th [x y w h]]
++  (let [{:keys [r]} @p
++        sx (/ (double w) tw)
++        sy (/ (double h) th)
++        k  (min sx sy)
++        dw (* tw k)
++        dh (* th k)]
++    (flush! p)
++    (sdl/blit! r tex nil [(+ x (/ (- w dw) 2.0)) (+ y (/ (- h dh) 2.0)) dw dh])))
++
  (defn line!
    "A `width`-thick line. Axis-aligned lines are a rectangle; the diagonal case
     — which in this toolkit is a checkbox tick — is a few offset hairlines,

modified jvui/src/jvui/sdl.clj +24 -0 Viewed

@@ -259,7 +259,20 @@
259	259	[:pointer :float :float :float :float] :bool)
260	260
261	261	(def PIXELFORMAT-ARGB8888 372645892)
	262	+
	263	+;; SDL_PIXELFORMAT_ABGR8888, which is what SDL_PIXELFORMAT_RGBA32 aliases to
	264	+;; on a little-endian machine. Named by its packed layout rather than its byte
	265	+;; order, which is the trap: a buffer whose BYTES run R,G,B,A reads as the
	266	+;; 32-bit word 0xAABBGGRR, so ABGR8888 is the one that matches it and
	267	+;; ARGB8888 — the obvious-looking choice — puts the channels through a
	268	+;; rotation and turns skin blue.
	269	+(def PIXELFORMAT-ABGR8888 376840196)
	270	+
262	271	(def TEXTUREACCESS-STATIC 0)
	272	+;; STREAMING for anything uploaded every frame. STATIC textures live in
	273	+;; memory the driver expects to write rarely; a video feed at thirty a second
	274	+;; is the case the distinction exists for.
	275	+(def TEXTUREACCESS-STREAMING 1)
263	276
264	277	(defn update-texture!
265	278	"Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
@@ -269,6 +282,17 @@
269	282	(ffi/write-array p :int pixels)
270	283	(raw-update-texture tex ffi/null p (* 4 w)))))
271	284
	285	+(defn update-texture-raw!
	286	+ "Upload `h` rows of `pitch` bytes from FOREIGN memory into the whole of `tex`.
	287	+
	288	+ The pointer is the caller's and is read during the call and not kept. That
	289	+ is the difference from `update-texture!` above, and the reason this exists:
	290	+ that one takes an int-array, which means a decoded frame becomes a jolt
	291	+ value on its way to the screen. At thirty frames a second and two megabytes
	292	+ a frame, the copy costs more than the decode."
	293	+ [tex ptr pitch]
	294	+ (raw-update-texture tex ffi/null ptr pitch))
	295	+
272	296	(defonce ^:private rect-a (delay (ffi/alloc 16)))
273	297	(defonce ^:private rect-b (delay (ffi/alloc 16)))
274	298

    [:pointer :float :float :float :float] :bool)
  (def PIXELFORMAT-ARGB8888 372645892)
++
++;; SDL_PIXELFORMAT_ABGR8888, which is what SDL_PIXELFORMAT_RGBA32 aliases to
++;; on a little-endian machine. Named by its packed layout rather than its byte
++;; order, which is the trap: a buffer whose BYTES run R,G,B,A reads as the
++;; 32-bit word 0xAABBGGRR, so ABGR8888 is the one that matches it and
++;; ARGB8888 — the obvious-looking choice — puts the channels through a
++;; rotation and turns skin blue.
++(def PIXELFORMAT-ABGR8888 376840196)
++
  (def TEXTUREACCESS-STATIC 0)
++;; STREAMING for anything uploaded every frame. STATIC textures live in
++;; memory the driver expects to write rarely; a video feed at thirty a second
++;; is the case the distinction exists for.
++(def TEXTUREACCESS-STREAMING 1)
  (defn update-texture!
    "Upload an int-array of ARGB8888 pixels, `w` wide, into the whole of `tex`."
        (ffi/write-array p :int pixels)
        (raw-update-texture tex ffi/null p (* 4 w)))))
++(defn update-texture-raw!
++  "Upload `h` rows of `pitch` bytes from FOREIGN memory into the whole of `tex`.
++
++   The pointer is the caller's and is read during the call and not kept. That
++   is the difference from `update-texture!` above, and the reason this exists:
++   that one takes an int-array, which means a decoded frame becomes a jolt
++   value on its way to the screen. At thirty frames a second and two megabytes
++   a frame, the copy costs more than the decode."
++  [tex ptr pitch]
++  (raw-update-texture tex ffi/null ptr pitch))
++
  (defonce ^:private rect-a (delay (ffi/alloc 16)))
  (defonce ^:private rect-b (delay (ffi/alloc 16)))

modified jvui/src/jvui/widgets.clj +17 -0 Viewed

@@ -327,3 +327,20 @@
327	327	r))
328	328
329	329	(defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))
	330	+
	331	+(defn video
	332	+ "A tile showing feed `key`, or the empty frame it will fill.
	333	+
	334	+ `size` is the space it asks for; the picture is letterboxed inside that,
	335	+ so a tile keeps its shape whatever the camera on the other end is doing.
	336	+
	337	+ Drawn even with no picture yet — a call wall where tiles appear only once
	338	+ a frame arrives rearranges itself under the person every time somebody
	339	+ joins, which is worse than a dark rectangle that fills."
	340	+ ([key] (video key {}))
	341	+ ([key {:keys [size expand gravity]
	342	+ :or {size [320.0 180.0] expand :both gravity [0.5 0.5]}}]
	343	+ (let [rect (c/leaf size expand gravity)]
	344	+ (c/fill! rect (c/th :surface-alt) 6.0)
	345	+ (c/draw-frame! key rect)
	346	+ rect)))

      r))
  (defmacro scroll [opts & body] `(scroll* ~opts (fn [~'_id ~'_rect] ~@body)))
++
++(defn video
++  "A tile showing feed `key`, or the empty frame it will fill.
++
++   `size` is the space it asks for; the picture is letterboxed inside that,
++   so a tile keeps its shape whatever the camera on the other end is doing.
++
++   Drawn even with no picture yet — a call wall where tiles appear only once
++   a frame arrives rearranges itself under the person every time somebody
++   joins, which is worse than a dark rectangle that fills."
++  ([key] (video key {}))
++  ([key {:keys [size expand gravity]
++         :or   {size [320.0 180.0] expand :both gravity [0.5 0.5]}}]
++   (let [rect (c/leaf size expand gravity)]
++     (c/fill! rect (c/th :surface-alt) 6.0)
++     (c/draw-frame! key rect)
++     rect)))

added jvui/test/jvui/frames_check.clj +69 -0 Viewed

new file mode 100644
@@ -0,0 +1,69 @@
	1	+(ns jvui.frames-check
	2	+ "Does a borrowed pointer actually reach a texture?
	3	+
	4	+ The other tests walk the UI with no window, which is what makes them fast
	5	+ and what makes them blind to this: with no renderer there is nothing to
	6	+ upload into, so every frame is dropped and every check passes for the
	7	+ wrong reason. So this one opens a REAL window — under SDL's dummy video
	8	+ driver, which gives a renderer and no display — and asks whether the
	9	+ texture is there afterwards."
	10	+ (:require [jvui.app :as app]
	11	+ [jvui.core :as c]
	12	+ [jvui.frames :as frames]
	13	+ [jvui.widgets :as w]
	14	+ [jolt.ffi :as ffi]))
	15	+
	16	+(defn- checker
	17	+ "A w by h RGBA frame in FOREIGN memory: red on the left, blue on the right,
	18	+ fully opaque. Two colours so a channel rotation shows up as the wrong one
	19	+ rather than as a plausible picture."
	20	+ [w h]
	21	+ (let [p (ffi/alloc (* 4 w h))]
	22	+ (dotimes [y h]
	23	+ (dotimes [x w]
	24	+ (let [o (* 4 (+ (* y w) x))
	25	+ left? (< x (quot w 2))]
	26	+ (ffi/write (+ p o 0) :uint8 (if left? 220 20))
	27	+ (ffi/write (+ p o 1) :uint8 20)
	28	+ (ffi/write (+ p o 2) :uint8 (if left? 20 220))
	29	+ (ffi/write (+ p o 3) :uint8 255))))
	30	+ p))
	31	+
	32	+(defn -main [& _]
	33	+ (let [px (checker 64 32)
	34	+ results (atom [])
	35	+ check! (fn [name ok?] (swap! results conj [name (boolean ok?)]))
	36	+ frames-seen (atom 0)]
	37	+ (try
	38	+ (app/run!
	39	+ (fn []
	40	+ (swap! frames-seen inc)
	41	+ ;; Push a picture the way a decoder would: from foreign memory,
	42	+ ;; between walks, with no painter in scope.
	43	+ (when (= 1 @frames-seen)
	44	+ (frames/put! "peer" 64 32 px))
	45	+ (when (= 2 @frames-seen)
	46	+ (let [t (frames/lookup "peer")]
	47	+ (check! "a frame becomes a texture" (some? (:tex t)))
	48	+ (check! "at the size it was given" (and (= 64 (:w t)) (= 32 (:h t))))
	49	+ (check! "and is listed as a feed" (contains? (frames/keys*) "peer")))
	50	+ ;; A resize must replace the texture rather than write past it.
	51	+ (frames/put! "peer" 32 64 px))
	52	+ (when (= 3 @frames-seen)
	53	+ (let [t (frames/lookup "peer")]
	54	+ (check! "a resize replaces it" (and (= 32 (:w t)) (= 64 (:h t)))))
	55	+ (frames/drop! "peer")
	56	+ (check! "dropping releases it" (nil? (frames/lookup "peer"))))
	57	+ [:page {}
	58	+ [:card {} [:title {:label "frames"}]]])
	59	+ {:title "frames" :width 200 :height 120 :frames 4})
	60	+ (finally (ffi/free px)))
	61	+ (doseq [[name ok?] @results]
	62	+ (println (if ok? "- " "FAIL ") name))
	63	+ (let [bad (remove second @results)]
	64	+ (println (if (seq bad)
	65	+ (str (count bad) " of " (count @results) " checks FAILED")
	66	+ (str "all " (count @results) " checks passed")))
	67	+ (when (or (seq bad) (< (count @results) 5))
	68	+ (println "expected 5 checks, ran" (count @results))
	69	+ (System/exit 1)))))

++(ns jvui.frames-check
++  "Does a borrowed pointer actually reach a texture?
++
++  The other tests walk the UI with no window, which is what makes them fast
++  and what makes them blind to this: with no renderer there is nothing to
++  upload into, so every frame is dropped and every check passes for the
++  wrong reason. So this one opens a REAL window — under SDL's dummy video
++  driver, which gives a renderer and no display — and asks whether the
++  texture is there afterwards."
++  (:require [jvui.app :as app]
++            [jvui.core :as c]
++            [jvui.frames :as frames]
++            [jvui.widgets :as w]
++            [jolt.ffi :as ffi]))
++
++(defn- checker
++  "A w by h RGBA frame in FOREIGN memory: red on the left, blue on the right,
++  fully opaque. Two colours so a channel rotation shows up as the wrong one
++  rather than as a plausible picture."
++  [w h]
++  (let [p (ffi/alloc (* 4 w h))]
++    (dotimes [y h]
++      (dotimes [x w]
++        (let [o (* 4 (+ (* y w) x))
++              left? (< x (quot w 2))]
++          (ffi/write (+ p o 0) :uint8 (if left? 220 20))
++          (ffi/write (+ p o 1) :uint8 20)
++          (ffi/write (+ p o 2) :uint8 (if left? 20 220))
++          (ffi/write (+ p o 3) :uint8 255))))
++    p))
++
++(defn -main [& _]
++  (let [px      (checker 64 32)
++        results (atom [])
++        check!  (fn [name ok?] (swap! results conj [name (boolean ok?)]))
++        frames-seen (atom 0)]
++    (try
++      (app/run!
++        (fn []
++          (swap! frames-seen inc)
++          ;; Push a picture the way a decoder would: from foreign memory,
++          ;; between walks, with no painter in scope.
++          (when (= 1 @frames-seen)
++            (frames/put! "peer" 64 32 px))
++          (when (= 2 @frames-seen)
++            (let [t (frames/lookup "peer")]
++              (check! "a frame becomes a texture" (some? (:tex t)))
++              (check! "at the size it was given" (and (= 64 (:w t)) (= 32 (:h t))))
++              (check! "and is listed as a feed" (contains? (frames/keys*) "peer")))
++            ;; A resize must replace the texture rather than write past it.
++            (frames/put! "peer" 32 64 px))
++          (when (= 3 @frames-seen)
++            (let [t (frames/lookup "peer")]
++              (check! "a resize replaces it" (and (= 32 (:w t)) (= 64 (:h t)))))
++            (frames/drop! "peer")
++            (check! "dropping releases it" (nil? (frames/lookup "peer"))))
++          [:page {}
++           [:card {} [:title {:label "frames"}]]])
++        {:title "frames" :width 200 :height 120 :frames 4})
++      (finally (ffi/free px)))
++    (doseq [[name ok?] @results]
++      (println (if ok? "- " "FAIL ") name))
++    (let [bad (remove second @results)]
++      (println (if (seq bad)
++                 (str (count bad) " of " (count @results) " checks FAILED")
++                 (str "all " (count @results) " checks passed")))
++      (when (or (seq bad) (< (count @results) 5))
++        (println "expected 5 checks, ran" (count @results))
++        (System/exit 1)))))