noe/arthur
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Port steps 2-3: the data model and the player

Browse source 
Steps 2 and 3 land together because the model revisions in the middle changed
code from both, and splitting them now would invent intermediate states that
never built.

  domain/channel  value-at across framed/keyed/dense, plus a cursor
  domain/node     decomposed transform, composition order, time maps
  domain/scene    topological order, z paths, eval-frame and resolver
  clock           audio-clocked frame derivation, outside app-db
  db/events/subs  re-frame arrives; the playhead is document state
  ui/player       the rAF loop; reads, blits, dispatches (almost) nothing
  ui/shell        transport

133 tests, 1158 assertions. The scene plays at 30fps against audio, scrubs, and
runs at 1/4x through 4x; verified by driving a real browser over CDP rather than
by assertion.

Two evaluators, on purpose. `eval-frame` is the specification -- allocating,
order-free, obviously correct. `resolver` is what playback uses: cached topo
order and z paths, a cursor per channel, a preallocated point buffer per node.
Both run the same walk, parameterised only by how a channel is read and where
points are written, because two independent implementations of frame evaluation
would drift and the drift would read as a rendering bug rather than as two
functions disagreeing. scene-test asserts they agree frame for frame in forward,
backward and random order.

Deviations and decisions, each with a reason:

- raster/fill-poly! is now a thin wrapper over fill-poly-buf!, which takes a flat
  preallocated buffer. ONE scanline fill serves the analysis stages, which speak
  {:x :y}, and frame evaluation, which hands over a buffer it owns. The parity
  suite still passes pixel-for-pixel, which is what makes the rewrite safe.

- The state mask carries ABSENCE ONLY. An earlier draft gave it a hidden bit too,
  per architecture.md's "hidden flag + palette index", and that bit was a dense
  [:vis] wearing a different hat -- two mechanisms for one question, which is how
  a part ends up hidden by one and shown by the other.

- The palette is a parameter of evaluation, not a global. A node names a TONE;
  which ramp that tone is read in belongs to the timeline it sits in.

- :over layers and a symbol :rate THROW rather than being ignored. Neither is
  built and nothing can produce one, so this can only fire on data that has run
  ahead of the code. A silently dropped override is a hand correction the user
  made once, watched fail, and has no reason to trust again.

Three findings the model produced rather than received:

- Presence propagates asymmetrically. An absent transform drops the subtree; an
  absent [:geom :pts] drops only that node, because an absent mouth outline has
  nothing to draw but the head it hangs off has not moved. That asymmetry is the
  reason presence is tracked per channel and not per node.

- Z paths need lexicographic compare, not `compare`, which orders vectors by
  count first -- so a cel three levels under "a1" would jump in front of a bare
  "a2" and the layer order would mostly work.

- A node stencilled by something that drew nothing is dropped, not drawn
  unclipped: an iris floating over the cheek is worse than a missing iris.

docs/ revised alongside, and those revisions are the load-bearing part:

- A scene, a timeline and a symbol are one type. The doc had two structures with
  the same fields and never said so. Two axes of nesting are now separated --
  parent/child within a timeline is flat with parent pointers, instance nesting
  is by reference -- which is why "nestable" and "flat" only sounded
  contradictory.

- Palettes are named, live on the project, and are ENABLED on a timeline as a
  channel. Absent inherits; present travels with the timeline, so a symbol
  authored against :night stays night wherever it is placed. The output index
  space is the concatenation of the named ramps, which keeps one buffer and one
  flat table and incidentally stops two nodes in different palettes colliding on
  a stencil.

- Stabilisation is a channel, not a mode: {s, theta, tx, ty} IS [:xform :*], so
  the normalise on/off/per-plate toggle is which of the three channel shapes the
  :head node carries. Always measure and always store factored -- smoothing and
  velocity-minimum key selection both need the split to exist in storage.

- There is no camera node and none is needed. Placement is a node transform, the
  stage clips what hangs off it, and project dimensions are independent of the
  footage. `makeXform` is therefore not to be ported: it bakes a cropping
  decision into every stored vertex.

- Export is removed. The .take writer was for an Animator Pro render script; the
  target is encoding video in the browser, and step 9 now says not to port the
  old one.

demo/swarm is 120 shapes on six orbits, entirely dense blocks behind store
handles -- the shape freeze produces at step 5, and the first thing to exercise
that path under load. It plays at 30fps, and bench-test keeps a deliberately
loose floor under it because a performance regression here does not announce
itself: the picture stays correct and merely arrives late.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01PDfHGdV39zu6rvgbBTfDaT
This commit is contained in:
Olive Vaughn 2026-09-27 17:28:05 -04:00
parent eb06be005c
commit 18d6495592
27 changed files with 3395 additions and 90 deletions
Download patch file Download diff file Expand all files Collapse all files

40
frontend/test/arthur/bench_test.cljs Normal file
View file

@ -0,0 +1,40 @@
(ns arthur.bench-test
"Not a correctness test — a floor.
It exists because a performance problem in this pipeline does not announce
itself: the picture is still right, it just arrives late, and \"the renderer
feels sluggish\" is indistinguishable from \"the machine is busy\" without a
number. The swarm is the only scene big enough for a regression to show up in,
so it is the one measured. The assertion is deliberately loose — it catches an
order-of-magnitude regression, not a ten percent one, because a tight bound
here would fail on a loaded CI box and teach everyone to ignore it."
(:require [cljs.test :refer [deftest is]]
[arthur.demo.swarm :as swarm]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.scene :as scene]))
(defn- ms [label n f]
(let [t0 (js/Date.now)]
(dotimes [i n] (f i))
(let [dt (- (js/Date.now) t0)]
(println (str " " label ": " dt "ms / " n " = "
(.toFixed (/ dt n) 2) "ms per frame"))
(/ dt n))))
(deftest bench
(let [res (scene/resolver @swarm/scene @swarm/store pal/index-of)
ras (raster/make 320 200)
dest (js/Uint8ClampedArray. (* 320 200 4))
n 120]
(println "\nswarm:" (count (:nodes @swarm/scene)) "nodes")
(let [a (ms "resolve " n (fn [i] (res (mod i 229))))
b (ms "resolve+draw " n (fn [i]
(raster/clear! ras 0)
(raster/draw-ops! ras (res (mod i 229)))))
c (ms "->rgba " n (fn [_] (raster/->rgba ras pal/rgb 1 dest)))]
(println (str " => draw alone ~" (.toFixed (- b a) 2)
"ms, total ~" (.toFixed (+ b c) 2) "ms ("
(.toFixed (/ 1000 (+ b c)) 1) " fps ceiling)\n"))
(is (< (+ b c) 40)
(str "a frame costs " (.toFixed (+ b c) 2) "ms; 40ms would be below 25fps")))))

108
frontend/test/arthur/clock_test.cljs Normal file
View file

@ -0,0 +1,108 @@
(ns arthur.clock-test
"The clock is four lines of arithmetic and the whole take's sync depends on
them, so they are asserted rather than eyeballed. A drift bug is invisible for
the first second and unmistakable by the tenth, which is the worst possible
shape for a bug to have."
(:require [cljs.test :refer [deftest is testing]]
[arthur.clock :as clock]))
(defn- fake
"Stands in for the audio element. The clock only ever reads `currentTime`,
`paused`, `ended` and `playbackRate` and writes `currentTime`, which is the
entire coupling — so the whole of it can be asserted in node."
[& {:keys [t paused? ended? rate duration]
:or {t 0 paused? true ended? false rate 1.0 duration 7.6}}]
#js {:currentTime t :paused paused? :ended ended?
:playbackRate rate :duration duration})
(deftest the-frame-is-derived-from-the-audio-not-counted
;; frame = ⌊currentTime · fps⌋. The whole point: nothing accumulates, so
;; nothing can drift.
(clock/attach! (fake :t 0.0))
(is (= 0 (clock/frame 30 229)))
(doseq [[t want] [[0.0 0] [0.033 0] [0.034 1] [1.0 30] [1.999 59] [2.0 60]]]
(clock/attach! (fake :t t))
(is (= want (clock/frame 30 229)) (str t "s at 30fps"))))
(deftest a-dropped-frame-lands-where-the-audio-already-is
;; THE property the derivation buys. A loop that stalled for a third of a
;; second resumes at the frame the audio reached, not a third of a second
;; behind it — the failure is a visible stutter rather than an invisible slide
;; out of sync, and those are very different bugs to own.
(clock/attach! (fake :t 1.0))
(let [before (clock/frame 30 229)]
(clock/attach! (fake :t 1.5)) ; fifteen frames' worth of stall
(is (= 45 (clock/frame 30 229)))
(is (= 30 before) "and nothing was counted in between")))
(deftest the-frame-is-clamped-into-the-clip
;; Audio is 7.601s and the clip is 229 frames at 30fps = 7.633s, so the last
;; fraction of a second has no audio and the end of the audio has no frame
;; past the last. Neither may produce an out-of-range index.
(clock/attach! (fake :t 99.0))
(is (= 228 (clock/frame 30 229)))
(clock/attach! (fake :t -1.0))
(is (= 0 (clock/frame 30 229))))
(deftest a-seek-round-trips
;; Seeking to the START of a frame rather than its middle is what makes this
;; idempotent: seek to f, read back f, at every f.
(let [a (fake)]
(clock/attach! a)
(doseq [f [0 1 57 114 171 228]]
(clock/seek! 30 229 f)
(is (= f (clock/frame 30 229)) (str "seek to " f)))))
(deftest a-seek-past-either-end-is-clamped-before-it-reaches-the-element
(let [a (fake)]
(clock/attach! a)
(clock/seek! 30 229 9999)
(is (= 228 (clock/frame 30 229)))
(clock/seek! 30 229 -5)
(is (= 0 (clock/frame 30 229)))
(is (>= (.-currentTime a) 0) "and currentTime is never negative")))
(deftest rate-does-not-enter-the-frame-calculation
;; ½× and ¼× are playbackRate and nothing else. If rate appeared here as well
;; it would be applied twice — the picture would have one rate and the sound
;; another, which is precisely the desync the audio clock exists to prevent.
(doseq [r [1.0 0.5 0.25]]
(clock/attach! (fake :t 2.0 :rate r))
(is (= 60 (clock/frame 30 229)) (str "at " r "x, 2.0s is still frame 60"))))
(deftest playing-follows-the-element
(clock/attach! (fake :paused? true))
(is (not (clock/playing?)))
(clock/attach! (fake :paused? false))
(is (clock/playing?))
(testing "and a finished file is not playing, whatever `paused` says"
(clock/attach! (fake :paused? false :ended? true))
(is (not (clock/playing?)))))
(deftest the-audio-length-is-reported-rather-than-assumed
;; A clip longer than its audio is a legitimate thing to be told about and not
;; a thing to silently truncate.
(clock/attach! (fake :duration 7.601))
(is (= 229 (clock/duration-frames 30)))
(is (= 92 (clock/duration-frames 12)))
(testing "and an unloaded element has no opinion"
(clock/attach! (fake :duration js/NaN))
(is (nil? (clock/duration-frames 30)))))
(deftest exposure-is-applied-to-the-derived-frame
;; The transport shows which frame the grid holds the playhead back onto, so
;; that `exposure 2` is visibly doing something rather than only inside the
;; scene.
(is (= [0 0 2 2 4 4] (mapv #(clock/exposed-frame % 2) (range 6))))
(is (= [0 1 2 3 4 5] (mapv #(clock/exposed-frame % 1) (range 6)))))
(deftest with-no-element-attached-nothing-explodes
;; The loop starts before the :ref has fired, so every reader has to be safe
;; on a clock that has not been handed its element yet.
(clock/attach! nil)
(is (= 0 (clock/frame 30 229)))
(is (not (clock/playing?)))
(is (= 1.0 (clock/rate)))
(is (nil? (clock/duration-frames 30)))
(is (nil? (clock/seek! 30 229 5)))
(is (nil? (clock/pause!))))

185
frontend/test/arthur/domain/channel_test.cljs Normal file
View file

@ -0,0 +1,185 @@
(ns arthur.domain.channel-test
"The channel is the load-bearing claim of the whole model: analysis and a hand
produce the SAME data, and the only difference between them is a flag nothing
in the renderer reads. These assert the parts of that claim that could silently
stop being true."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]))
;; ---- the three shapes read the same way ----
(deftest framed-is-the-same-value-at-every-frame
(let [c (ch/framed :skin-dark)]
(is (= :framed (ch/describe c)))
(is (every? #(= :skin-dark (ch/value-at c %)) (range -5 20)))))
(deftest keyed-holds-until-the-next-key
;; Hold is the DEFAULT, not a special case: docs/design.md requires it of every
;; cut part, and a tweened mouth reads as puppet software.
(let [c (ch/keyed {0 :a, 4 :b, 12 :c})]
(is (= :keyed (ch/describe c)))
(is (= [:a :a :a :a :b :b :b :b :b :b :b :b :c :c]
(mapv #(ch/value-at c %) (range 0 14))))))
(deftest a-frame-before-the-first-key-reads-the-first-key
;; The JS activeKey clamps low, and that is kept: a channel's first key is the
;; pose the part starts in. Having NO value is a different question — it is a
;; state bit, not an empty region of the key map.
(let [c (ch/keyed {10 :a, 20 :b})]
(is (= :a (ch/value-at c 0)))
(is (= :a (ch/value-at c 9)))
(is (= :b (ch/value-at c 999)) "and clamps high by holding the last key")))
(deftest keys-are-a-map-so-frame-order-in-the-literal-cannot-matter
;; Transit and JSON both lose sortedness, so the sorted index is built at read
;; time. A resolver that trusted insertion order would work in the REPL and
;; fail after a round trip through the server, which is the worst possible way
;; to find out.
(let [forward (ch/keyed (array-map 0 :a, 4 :b, 12 :c))
backward (ch/keyed (array-map 12 :c, 4 :b, 0 :a))
shuffled (ch/keyed (array-map 4 :b, 12 :c, 0 :a))]
(doseq [c [backward shuffled]]
(is (= (mapv #(ch/value-at forward %) (range 0 16))
(mapv #(ch/value-at c %) (range 0 16)))))))
(deftest dense-reads-one-value-per-frame-out-of-a-typed-array
(let [store {"blk" {:data (js/Int16Array. #js [0 0, 10 20, 30 40, 50 60]) :state nil}}
c {:animated? true :interp :hold
:dense {:store "blk" :offset 0 :stride 2 :frames 4}
:generated {:by :roto/lips-outer :analysis "sha256:test"}}]
(is (= :dense (ch/describe c)))
(is (= [[0 0] [10 20] [30 40] [50 60]]
(mapv (fn [f] (let [v (ch/value-at c f store)]
[(ch/component v 0) (ch/component v 1)]))
(range 4))))))
(deftest a-dense-value-is-a-view-not-a-copy
;; Fixed topology is what makes this possible — the frame's data is a
;; rectangular slice at a known offset — and a copy per node per frame is
;; exactly the allocation the model exists to avoid.
(let [data (js/Int16Array. #js [1 2 3 4])
store {"blk" {:data data :state nil}}
c {:animated? true :dense {:store "blk" :offset 0 :stride 2 :frames 2}}
v (ch/value-at c 1 store)]
(is (= (.-buffer data) (.-buffer v)) "shares the block's buffer")))
(deftest a-dense-read-clamps-rather-than-running-off-the-end
;; A time map with an offset deliberately reads the future — mouth lead is the
;; entire reason :offset exists — so the last frames of a leading track ask for
;; frames past the end on every take. Clamping holds the final pose; the
;; alternative blanks the mouth at the end of every clip.
(let [store {"blk" {:data (js/Int16Array. #js [7 8 9]) :state nil}}
c {:animated? true :dense {:store "blk" :offset 0 :stride 1 :frames 3}}]
(is (= 7 (ch/value-at c -4 store)))
(is (= 9 (ch/value-at c 99 store)))))
(deftest a-dense-channel-whose-store-is-missing-says-so
(let [c {:animated? true :dense {:store "gone" :offset 0 :stride 1 :frames 1}}]
(is (thrown-with-msg? ExceptionInfo #"store key is not in the store"
(ch/value-at c 0 {})))))
;; ---- presence is not visibility ----
(deftest the-mask-carries-absence-and-vis-carries-hiding
;; An occluded subject has NO VALUE on a frame. A part being switched off is a
;; different question and it is `[:vis]`, a channel like any other. Two
;; mechanisms for one question is how you get a part hidden by one and shown by
;; the other, so the mask carries absence only.
(let [state (js/Uint8Array. #js [ch/present ch/absent-bit ch/present])
store {"blk" {:data (js/Int16Array. #js [1 2 3]) :state state}}
c {:animated? true :dense {:store "blk" :offset 0 :stride 1 :frames 3}}]
(is (= 1 (ch/value-at c 0 store)))
(is (= ch/absent (ch/value-at c 1 store)))
(is (= 3 (ch/value-at c 2 store)))
(is (ch/nothing? ch/absent))
(is (not (ch/nothing? 0)) "zero is a value, not an absence")
(is (not (ch/nothing? false)) "and so is false")))
(deftest a-block-with-no-mask-is-present-throughout
;; The mask is optional: a generator that cannot fail to detect has nothing to
;; say, and allocating a zeroed byte per frame to say it would be noise.
(let [store {"blk" {:data (js/Int16Array. #js [1 2 3]) :state nil}}
c {:animated? true :dense {:store "blk" :offset 0 :stride 1 :frames 3}}]
(is (= [1 2 3] (mapv #(ch/value-at c % store) (range 3))))))
;; ---- the cursor is the playback path and must agree exactly ----
(defn- via-cursor
"Sample one cursor at each of `fs` in the order given, which is the point: a
cursor carries state between calls."
[c fs]
(let [cur (ch/cursor c)]
(mapv #(ch/sample! cur %) fs)))
(deftest the-cursor-agrees-with-the-specification-in-any-frame-order
;; This is the assertion the cursor exists for. A cursor that drifts produces
;; the WRONG POSE rather than an error, so nothing would report it: the mouth
;; would simply be a beat behind on some frames and not others, which reads as
;; a bad take.
(doseq [[label c] [["sparse" (ch/keyed {0 :a, 4 :b, 12 :c, 13 :d, 40 :e})]
["one key" (ch/keyed {7 :only})]
["dense-ish" (ch/keyed (into {} (map (juxt identity #(* 10 %))) (range 40)))]
["framed" (ch/framed :static)]]]
(let [spec #(ch/value-at c %)
forward (range 0 45)
back (reverse forward)
jumpy [0 44 1 43 12 12 13 3 40 7 0 22 22 21 44]]
(testing label
(doseq [[order-name fs] [["forward" forward] ["backward" back] ["random access" jumpy]]]
(is (= (mapv spec fs) (via-cursor c fs))
(str label " / " order-name)))))))
(deftest the-cursor-reads-a-dense-block-too
(let [store {"blk" {:data (js/Float32Array. #js [1 2 3 4 5]) :state nil}}
c {:animated? true :dense {:store "blk" :offset 0 :stride 1 :frames 5}}
cur (ch/cursor c store)]
(is (= [1 2 3 4 5] (mapv #(ch/sample! cur %) (range 5))))
(is (= [5 1] (mapv #(ch/sample! cur %) [4 0])) "and seeks")))
;; ---- what is deliberately not built has to fail loudly ----
(deftest an-override-layer-is-refused-rather-than-ignored
;; :over is specified in docs/animation-model.md and out of scope for this
;; step. Dropping one silently would present as a hand correction that did not
;; take — a correction the user made once, watched fail, and has no reason to
;; trust again.
(let [c (assoc (ch/keyed {0 [0 0]}) :over [{:blend :offset :keys {0 [2 0]}}])]
(is (thrown-with-msg? ExceptionInfo #":over" (ch/value-at c 0)))
(is (thrown-with-msg? ExceptionInfo #":over" (ch/cursor c)))
(is (seq (ch/problems c)))))
(deftest an-empty-over-is-fine-and-is-what-scenes-carry
(is (empty? (ch/problems (ch/keyed {0 1}))))
(is (= 1 (ch/value-at (ch/keyed {0 1}) 0))))
;; ---- shape validation ----
(deftest problems-names-the-ways-a-channel-is-malformed
(is (empty? (ch/problems (ch/framed 1))))
(is (empty? (ch/problems (ch/keyed {0 1}))))
(testing "keys as a vector is the mistake most worth catching"
(is (seq (ch/problems {:animated? true :keys [[0 1]]}))))
(is (seq (ch/problems {:value 1})) "no :animated?")
(is (seq (ch/problems {:animated? true})) "animated with nothing to read")
(is (seq (ch/problems {:animated? true :keys {0 1}
:dense {:store "x" :offset 0 :stride 1 :frames 1}}))
"one shape at a time")
(is (seq (ch/problems {:animated? true :interp :linear :keys {0 1}}))
"only :hold is implemented"))
(deftest component-reads-vectors-and-typed-arrays-the-same-way
(is (= 3 (ch/component [3 4] 0)))
(is (= 4 (ch/component [3 4] 1)))
(is (= 3 (ch/component (js/Int16Array. #js [3 4]) 0)))
(is (= 4 (ch/component (js/Int16Array. #js [3 4]) 1))))
(deftest generated-is-provenance-and-nothing-reads-it
;; The flag lives on the CHANNEL, not the node, because a mouth wants a
;; rotoscoped [:geom :pts] and a hand-animated [:xform :pos] at the same time.
;; What this asserts is that sampling does not depend on it: strip :generated
;; and every frame is identical.
(let [store {"blk" {:data (js/Int16Array. #js [1 2 3]) :state nil}}
base {:animated? true :dense {:store "blk" :offset 0 :stride 1 :frames 3}}
with (assoc base :generated {:by :roto/lips-outer :params {:verts 8}})]
(is (= (mapv #(ch/value-at base % store) (range 3))
(mapv #(ch/value-at with % store) (range 3))))))

185
frontend/test/arthur/domain/node_test.cljs Normal file
View file

@ -0,0 +1,185 @@
(ns arthur.domain.node-test
"The transform and the time map. Both are places where a wrong answer looks
like a plausible different answer, which is why they are asserted numerically
rather than looked at."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.node :as node]))
(defn- pt [m x y]
(let [out (js/Float64Array. 2)]
(node/apply-pt! out 0 m x y)
[(aget out 0) (aget out 1)]))
(defn- close? [a b] (< (js/Math.abs (- a b)) 1e-12))
(defn- close-pt? [[ax ay] [bx by]] (and (close? ax bx) (close? ay by)))
(defn- local [& {:keys [pos rot scale skew anchor]
:or {pos [0 0] rot 0 scale [1 1] skew [0 0] anchor [0 0]}}]
(node/local! (node/mat) pos rot scale skew anchor))
;; ---- the transform, component by component ----
(deftest the-identity-transform-moves-nothing
(is (= [5 7] (pt (local) 5 7))))
(deftest translation-rotation-and-scale-each-do-their-own-job
(is (= [15 27] (pt (local :pos [10 20]) 5 7)))
(is (close-pt? [0 10] (pt (local :rot (/ js/Math.PI 2)) 10 0)))
(is (= [20 21] (pt (local :scale [2 3]) 10 7))))
(deftest rotation-and-scale-happen-about-the-anchor
;; :anchor is Flash's registration point and Blender's origin. Getting it wrong
;; is why hand-placed parts SWING rather than turn, and a swing looks like a
;; parenting bug rather than like a wrong pivot.
(let [m (local :rot (/ js/Math.PI 2) :anchor [10 0])]
(is (close-pt? [10 0] (pt m 10 0)) "the anchor itself is a fixed point")
(is (close-pt? [10 10] (pt m 20 0)) "and the rest turns about it"))
(let [m (local :scale [2 2] :anchor [10 10])]
(is (close-pt? [10 10] (pt m 10 10)))
(is (close-pt? [30 30] (pt m 20 20)))))
(deftest skew-is-shear-factors-so-the-identity-is-zero
;; Stored as factors rather than angles: kx is x gained per unit y, so a
;; decomposition round-trips without a tangent, and 0 means "none" rather than
;; needing atan of something.
(is (= [5 7] (pt (local :skew [0 0]) 5 7)))
(is (= [12 7] (pt (local :skew [1 0]) 5 7)) "kx adds y into x")
(is (= [5 12] (pt (local :skew [0 1]) 5 7)) "ky adds x into y"))
(deftest the-composition-order-is-the-one-the-model-specifies
;; local = T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor)
;;
;; Asserted against the product of the five matrices built separately, so the
;; closed form in node/local! is checked rather than trusted. Every other order
;; produces a transform that is right at the origin and wrong everywhere else,
;; which is exactly the kind of wrong that survives inspection.
(let [pos [3 -4] rot 0.7 scale [1.5 0.5] skew [0.25 -0.1] anchor [11 -6]
T (fn [x y] (js/Float64Array. #js [1 0 0 1 x y]))
R (fn [t] (js/Float64Array. #js [(js/Math.cos t) (js/Math.sin t)
(- (js/Math.sin t)) (js/Math.cos t) 0 0]))
K (fn [[kx ky]] (js/Float64Array. #js [1 ky kx 1 0 0]))
S (fn [[sx sy]] (js/Float64Array. #js [sx 0 0 sy 0 0]))
step (fn [acc m] (node/mul! (node/mat) acc m))
want (reduce step (T (nth pos 0) (nth pos 1))
[(T (nth anchor 0) (nth anchor 1))
(R rot) (K skew) (S scale)
(T (- (nth anchor 0)) (- (nth anchor 1)))])
got (local :pos pos :rot rot :scale scale :skew skew :anchor anchor)]
(is (every? (fn [i] (close? (aget want i) (aget got i))) (range 6))
(str (vec (array-seq want)) " vs " (vec (array-seq got))))))
(deftest mul-may-write-into-either-operand
;; Evaluation composes world := parent · local with dest aliasing local, so
;; that a node's world transform needs no scratch. If mul! wrote before reading,
;; the bug would be a node in the right place whose CHILDREN are wrong.
(let [a (js/Float64Array. #js [2 0 0 3 5 7])
b (js/Float64Array. #js [1 0.5 -0.5 1 -2 4])
want (node/mul! (node/mat) a b)
into-b (node/mul! b a b)]
(is (= (vec (array-seq want)) (vec (array-seq into-b))))))
(deftest world-composes-through-the-parent
(let [parent (local :pos [100 50] :scale [2 2])
child (local :pos [10 0])
w (node/world! (node/mat) parent nil child (node/mat))]
(is (close-pt? [120 50] (pt w 0 0)))))
(deftest pinv-keeps-a-child-from-jumping-when-it-acquires-a-parent
;; Blender's parent_inverse. Nothing produces one yet; what is asserted is that
;; the field is in the composition, because its absence is the kind of thing
;; that makes a parenting feature feel broken and the fix is a migration.
(let [parent (local :pos [100 50])
child (local :pos [10 0])
before (pt child 0 0)
;; the inverse of the parent at the moment of parenting
pinv (js/Float64Array. #js [1 0 0 1 -100 -50])
after (pt (node/world! (node/mat) parent pinv child (node/mat)) 0 0)]
(is (close-pt? before after))))
(deftest mean-scale-is-exact-for-a-similarity
;; A disc under a non-uniform transform is an ellipse and the rasteriser has no
;; ellipse, so a disc's radius takes sqrt|det|. For the similarity the anchor
;; fit produces — the only transform that reaches a disc today — that is exact.
(is (close? 1.0 (node/mean-scale (local))))
(is (close? 3.0 (node/mean-scale (local :scale [3 3]))))
(is (close? 3.0 (node/mean-scale (local :scale [3 3] :rot 1.234)))
"and rotation does not change it"))
;; ---- time maps ----
(deftest exposure-floors-and-never-rounds
;; Rounding would let an output frame read a pose from the FUTURE, which is a
;; lead — a separate control, applied after this one, for a separate reason.
(is (= [0 1 2 3 4 5] (mapv #(node/expose % 1) (range 6))))
(is (= [0 0 2 2 4 4] (mapv #(node/expose % 2) (range 6))))
(is (= [0 0 0 3 3 3] (mapv #(node/expose % 3) (range 6))))
(is (= 4 (node/expose 5 2)) "frame 5 at exposure 2 reads frame 4, not 6"))
(deftest exposure-comes-before-offset-and-the-order-is-visible
;; THE INVARIANT: flooring onto a grid and shifting against the clock do not
;; commute. Shift first and the floor discards it on most frames, so the lead
;; slider appears to do nothing at any exposure above 1 — which is
;; indistinguishable from the slider being unwired.
(let [n {:id :m :time {:mode :map :expose 2 :offset 1}}
got (mapv #(node/local-frame n %) (range 8))
wrong-way (mapv #(node/expose (+ % 1) 2) (range 8))]
(is (= [1 1 3 3 5 5 7 7] got))
(is (= [0 2 2 4 4 6 6 8] wrong-way))
(is (not= got wrong-way) "and the two orders really do differ")))
(deftest inherit-is-the-default-and-changes-nothing
(is (= (vec (range 8)) (mapv #(node/local-frame {:id :x} %) (range 8))))
(is (= (vec (range 8)) (mapv #(node/local-frame {:id :x :time {:mode :inherit}} %) (range 8)))))
(deftest a-retimed-instance-is-refused-rather-than-ignored
;; :rate is a symbol instance's timing and symbols are out of scope. Silently
;; dropping it would be a retimed blink playing at the wrong speed, which looks
;; like a bad blink and not like a missing feature.
(is (thrown-with-msg? ExceptionInfo #":rate"
(node/local-frame {:id :x :time {:mode :map :rate 0.5}} 0)))
(is (= 4 (node/local-frame {:id :x :time {:mode :map :expose 2 :rate 1.0}} 5))
"rate 1.0 is the identity and is allowed, because it appears in the spec's example"))
;; ---- the shape ----
(deftest transform-channels-default-to-the-identity
(let [chs (node/channels {:id :x :kind :group})]
(is (= [0.0 0.0] (ch/value-at (get chs [:xform :pos]) 0)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0)))
(is (= true (ch/value-at (get chs [:vis]) 0))))
(testing "and a node's own channels win"
(let [chs (node/channels {:id :x :kind :group
:channels {[:xform :pos] (ch/framed [5 5])}})]
(is (= [5 5] (ch/value-at (get chs [:xform :pos]) 0)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0))))))
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
;; A decomposition is not extensible after the fact: adding a component later
;; means migrating every stored transform. So both are present from the start,
;; on every kind.
(doseq [k node/implemented-kinds]
(is (contains? (get node/valid-paths k) [:xform :skew]) (str k))
(is (contains? (get node/valid-paths k) [:xform :anchor]) (str k))))
(deftest valid-paths-follow-from-the-kind
(is (contains? (:poly node/valid-paths) [:geom :pts]))
(is (not (contains? (:poly node/valid-paths) [:geom :radius])))
(is (contains? (:disc node/valid-paths) [:geom :radius]))
(is (contains? (:rect node/valid-paths) [:geom :size]))
(is (not (contains? (:group node/valid-paths) [:geom :pts]))
"a group is a pure transform node"))
(deftest problems-names-the-ways-a-node-is-malformed
(is (empty? (node/problems {:id :x :kind :group :z "a1"})))
(is (seq (node/problems {:kind :group :z "a1"})) "no :id")
(is (seq (node/problems {:id :x :kind :blob :z "a1"})) "not a kind")
(is (seq (node/problems {:id :x :kind :symbol :z "a1"})) "a kind that is not built")
(is (seq (node/problems {:id :x :kind :group})) "no :z")
(is (seq (node/problems {:id :x :kind :group :z "a1" :span [3]})) "a malformed span")
(is (seq (node/problems {:id :x :kind :group :z "a1"
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])}}))
"a channel that is not valid on this kind")
(is (seq (node/problems {:id :x :kind :poly :z "a1"
:channels {[:geom :pts] {:animated? true}}}))
"and a channel that is malformed in itself"))

58
frontend/test/arthur/domain/raster_test.cljs
View file

@ -131,3 +131,61 @@
(is (= [18 20 28] (pal/hex->rgb "#12141c")))
(testing "index-of round-trips against the ordered vector"
(is (every? (fn [[k i]] (= k (:name (nth pal/entries i)))) pal/index-of))))
;; ---- the flat buffer path is the same scanline fill ----
(deftest the-flat-and-map-polygon-forms-fill-identically
;; fill-poly! is a thin wrapper over fill-poly-buf! rather than a second
;; implementation. ONE scanline fill serves the analysis stages, which speak
;; {:x :y}, and frame evaluation, which hands over a preallocated flat buffer.
;; Two would drift, and the drift would read as a rendering bug rather than as
;; two functions disagreeing.
(doseq [[label pts] [["axis-aligned rect" [{:x 8 :y 8} {:x 56 :y 8} {:x 56 :y 40} {:x 8 :y 40}]]
["fractional" [{:x 3.5 :y 2.25} {:x 40.75 :y 5.5}
{:x 30.5 :y 44.5} {:x 6.25 :y 20.5}]]
["concave" [{:x 4 :y 4} {:x 60 :y 4} {:x 60 :y 44}
{:x 32 :y 20} {:x 4 :y 44}]]
["off the edges" [{:x -20 :y -10} {:x 80 :y 4} {:x 70 :y 60}
{:x -5 :y 50}]]
["degenerate" [{:x 5 :y 5} {:x 20 :y 5}]]]]
(let [flat (js/Float64Array. (mapcat (juxt :x :y) pts))
a (-> (r/make 64 48) (r/clear! 0) (r/fill-poly! pts 3))
b (-> (r/make 64 48) (r/clear! 0) (r/fill-poly-buf! flat (count pts) 3))]
(is (= (vec (array-seq (:buf a))) (vec (array-seq (:buf b)))) label))))
(deftest fill-poly-buf-uses-only-the-first-n-points
;; The buffer is preallocated at the node's vertex capacity, so a channel
;; carrying fewer points than the buffer holds must not read the stale tail of
;; the previous frame.
(let [big (js/Float64Array. 32)]
(doseq [[i v] (map-indexed vector [4 4, 20 4, 20 20, 4 20])]
(aset big i v))
;; leave garbage past the triangle
(aset big 8 999) (aset big 9 999)
(let [tri (-> (r/make 32 32) (r/clear! 0) (r/fill-poly-buf! big 3 1))]
(is (pos? (count-index tri 1)))
(is (zero? (aget (:buf tri) (+ (* 31 32) 31))) "and nothing leaked to the far corner"))))
(deftest rgba-can-write-into-a-buffer-it-was-given
;; At 320x200 the expanded buffer is 256KB; allocating and discarding that
;; thirty times a second is exactly the per-frame allocation the model is
;; arranged to avoid, so ui/canvas hands over the live ImageData's own array.
(let [ras (-> (r/make 4 4) (r/clear! 2))
dest (js/Uint8ClampedArray. (* 4 4 4))
{:keys [data]} (r/->rgba ras pal/rgb 1 dest)]
(is (identical? dest data))
(is (= (pal/rgb 2) [(aget dest 0) (aget dest 1) (aget dest 2)]))))
(deftest draw-ops-is-the-boundary-with-the-model
;; An op carries raster-space points and a PALETTE INDEX, and the rasteriser
;; knows nothing about nodes, channels, time maps or provenance. So a
;; hand-written op list rasterises, and an op kind it cannot draw says so.
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/draw-ops! ras
[{:kind :poly :pts (js/Float64Array. #js [10 10 30 10 30 20 10 20]) :n 4
:color 1 :stencil nil}
{:kind :disc :cx 28 :cy 15 :r 9 :color 2 :stencil 1}
{:kind :rect :cx 28 :cy 15 :size 5 :color 4 :stencil 2}])
(is (= #{0 1 2 4} (set (array-seq (:buf ras)))))
(is (thrown-with-msg? ExceptionInfo #"not rasterisable"
(r/draw-ops! ras [{:kind :bitmap}])))))

394
frontend/test/arthur/domain/scene_test.cljs Normal file
View file

@ -0,0 +1,394 @@
(ns arthur.domain.scene-test
"Frame evaluation, and the hand-written scene.
port-plan step 2 exists to find out whether the data model works BEFORE nine
hundred lines of measurement are ported into it, so these assertions are about
the model's claims rather than about a look: that structure is flat and
addressable, that draw order is authored, that time maps compose, that
presence and visibility are different questions, and that the fast path and the
specification give the same frame."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo :as demo]
[arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.scene :as scene]))
(defn- poly [id parent z pts color & [extra]]
(merge {:id id :kind :poly :parent parent :z z
:channels {[:geom :pts] (ch/framed pts)
[:style :color] (ch/framed color)}}
extra))
(defn- sc [& nodes]
{:nodes (into {} (map (juxt :id identity)) nodes)})
(defn- ids-at [scene f]
(mapv :node (scene/eval-frame scene f)))
(defn- pts-of [op]
(mapv (fn [i] [(aget (:pts op) (* 2 i)) (aget (:pts op) (inc (* 2 i)))])
(range (:n op))))
;; ---- structure ----
(deftest depth-order-puts-every-node-after-its-parent
(let [s (sc {:id :a :kind :group :z "a1"}
{:id :b :kind :group :parent :a :z "a1"}
{:id :c :kind :group :parent :b :z "a1"}
{:id :d :kind :group :parent :a :z "a2"})
ord (scene/order (:nodes s))]
(is (= 0 (scene/depth (:nodes s) :a)))
(is (= 2 (scene/depth (:nodes s) :c)))
(let [pos (into {} (map-indexed (fn [i id] [id i])) ord)]
(doseq [[id p] [[:b :a] [:c :b] [:d :a]]]
(is (< (get pos p) (get pos id)) (str p " must come before " id))))))
(deftest a-parent-cycle-throws-instead-of-hanging
;; Reachable from one bad :node/set-parent, and a hung tab is a far worse
;; diagnostic than a stack trace naming the nodes.
(let [s (sc {:id :a :kind :group :parent :b :z "a1"}
{:id :b :kind :group :parent :a :z "a1"})]
(is (thrown-with-msg? ExceptionInfo #"cycle" (scene/order (:nodes s))))
(is (seq (scene/problems s)))))
(deftest a-missing-parent-is-named-rather-than-silently-orphaning
(let [s (sc {:id :a :kind :group :parent :nope :z "a1"})]
(is (seq (scene/problems s)))))
(deftest reparenting-is-one-field-and-does-not-move-a-subtree
;; The flat-with-pointers claim, asserted as the thing it buys: a reparent is an
;; assoc-in at one node, and nothing else in the map changes identity — which is
;; what keeps re-frame's ancestor subs from invalidating.
(let [s (sc {:id :a :kind :group :z "a1"}
{:id :b :kind :group :z "a2" :channels {[:xform :pos] (ch/framed [100 0])}}
(poly :c :a "a1" [0 0 10 0 10 10] :brow))
s' (assoc-in s [:nodes :c :parent] :b)]
(is (identical? (get-in s [:nodes :a]) (get-in s' [:nodes :a]))
"the old parent is the same object")
(is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b]))
"and so is the new one")
(is (= [[0 0] [10 0] [10 10]]
(pts-of (first (filter #(= :c (:node %)) (scene/eval-frame s 0))))))
(is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (scene/eval-frame s' 0))))))))
;; ---- draw order ----
(deftest draw-order-is-depth-first-by-sibling-z
;; z is a fractional index among siblings, so the sort key is the chain of z
;; values from the root. A parent's chain is a PREFIX of its child's, which is
;; why a parent draws before its children without that being a special case.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :under :root "a0" [0 0 1 0 1 1] :bg)
{:id :mid :kind :group :parent :root :z "a1"}
(poly :deep :mid "a5" [0 0 1 0 1 1] :brow)
(poly :over :root "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:under :deep :over] (ids-at s 0)))))
(deftest a-deep-child-of-an-early-sibling-still-draws-before-a-later-sibling
;; The failure this guards: comparing z paths with `compare` would compare
;; COUNT first, so a painted cel three levels under "a1" would jump in front of
;; a bare "a2". It reads as a layer order that mostly works.
(let [s (sc {:id :root :kind :group :z "a1"}
{:id :g1 :kind :group :parent :root :z "a1"}
{:id :g2 :kind :group :parent :g1 :z "a1"}
(poly :deep :g2 "a1" [0 0 1 0 1 1] :brow)
(poly :shallow :root "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:deep :shallow] (ids-at s 0)))))
(deftest a-fractional-index-inserts-between-two-siblings-without-renumbering
(let [base (sc {:id :root :kind :group :z "a1"}
(poly :a :root "a1" [0 0 1 0 1 1] :bg)
(poly :c :root "a3" [0 0 1 0 1 1] :teeth))
with (assoc-in base [:nodes :b] (poly :b :root "a2" [0 0 1 0 1 1] :brow))]
(is (= [:a :c] (ids-at base 0)))
(is (= [:a :b :c] (ids-at with 0)))
(is (= (get-in base [:nodes :a]) (get-in with [:nodes :a])) "and :a is untouched")))
;; ---- transform composition through the tree ----
(deftest geometry-lands-in-the-parents-space
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] (ch/framed [100 50])
[:xform :scale] (ch/framed [2 2])}}
(poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base))
op (first (scene/eval-frame s 0))]
(is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op)))))
(deftest a-keyed-group-position-moves-its-children-and-holds-between-keys
;; This is the scene the plan asks for, minimally: a rectangle parented to a
;; group whose [:xform :pos] is keyed on four frames.
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos]
(ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]})}}
(poly :p :g "a1" [0 0 2 0 2 2] :skin-base))
at #(first (pts-of (first (scene/eval-frame s %))))]
(is (= [0 0] (at 0)))
(is (= [0 0] (at 3)) "held")
(is (= [10 0] (at 4)))
(is (= [10 10] (at 8)))
(is (= [0 10] (at 12)))
(is (= [0 10] (at 99)) "and holds the last key")))
;; ---- time maps compose along the chain ----
(deftest exposure-on-the-root-is-inherited-by-everything-under-it
;; docs/design.md is emphatic that everything rides ONE grid: a head cutting on
;; odd frames against a mouth cutting on even ones reads as two performances.
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}}
{:id :g :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (scene/eval-frame s %)))))]
(is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12)))))
(testing "and a node may set its own grid, which the model permits deliberately"
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}}
{:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4}
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (scene/eval-frame s %)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
;; Lead applies to performance nodes and NOT to the plate. If it were a clip
;; property the mouth would drag the whole head forward with it.
(let [keys (into {} (map (juxt identity #(vector % 0))) (range 12))
s (sc {:id :root :kind :group :z "a1"}
{:id :plate :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed keys)}}
(poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base)
{:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2}
:channels {[:xform :pos] (ch/keyed keys)}}
(poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark))
x-of (fn [f id] (->> (scene/eval-frame s f)
(filter #(= id (:node %))) first pts-of first first))]
(is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4))))
(is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead")))
;; ---- span and visibility are different questions ----
(deftest span-removes-a-node-and-vis-switches-it-off
;; :span is Lottie's ip/op and Flash's PlaceObject/RemoveObject: the range over
;; which the node EXISTS. [:vis] blinks an existing node on and off. Conflating
;; them is how you end up with a part that holds a stale pose outside its range.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 1 0 1 1] :brow
{:span [2 5]
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])
[:style :color] (ch/framed :brow)
[:vis] (ch/keyed {0 true, 3 false, 4 true})}}))]
(is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7))))))
(deftest a-hidden-group-takes-its-children-with-it
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:vis] (ch/keyed {0 true, 2 false})}}
(poly :p :g "a1" [0 0 1 0 1 1] :brow))]
(is (= [:p] (ids-at s 0)))
(is (= [] (ids-at s 2)))))
(deftest an-absent-transform-drops-the-subtree-and-an-absent-geometry-does-not
;; The asymmetry is the whole reason presence is tracked per CHANNEL rather than
;; per node. An absent mouth outline has nothing to draw, but the head it hangs
;; off is still exactly where it was.
(let [state (js/Uint8Array. #js [ch/present ch/absent-bit])
store {"pos" {:data (js/Float32Array. #js [0 0, 0 0]) :state state}
"pts" {:data (js/Int16Array. #js [0 0 1 0 1 1, 0 0 1 0 1 1]) :state state}}
absent-pos (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] {:animated? true
:dense {:store "pos" :offset 0 :stride 2 :frames 2}}}}
(poly :child :g "a1" [0 0 1 0 1 1] :brow))
absent-pts (sc {:id :g :kind :group :z "a1"}
{:id :m :kind :poly :parent :g :z "a1"
:channels {[:geom :pts] {:animated? true
:dense {:store "pts" :offset 0 :stride 6 :frames 2}}
[:style :color] (ch/framed :mouth-dark)}}
(poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:child] (mapv :node (scene/eval-frame absent-pos 0 store))))
(is (= [] (mapv :node (scene/eval-frame absent-pos 1 store)))
"an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (scene/eval-frame absent-pts 0 store))))
(is (= [:teeth] (mapv :node (scene/eval-frame absent-pts 1 store)))
"an absent outline removes only itself")))
;; ---- stencils ----
(deftest a-stencil-resolves-to-the-stencil-nodes-palette-index
;; A stencil is a COLOUR KEY, not a node reference — the take format's clip= —
;; and the indexed buffer being its own clip mask is what keeps the iris inside
;; the eye at any gaze and any radius with no clamp anywhere.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white)
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})
ops (scene/eval-frame s 0)]
(is (= [:sclera :iris] (mapv :node ops)))
(is (= (:eye-white pal/index-of) (:stencil (second ops))))))
(deftest a-node-stencilled-by-something-that-drew-nothing-is-dropped
;; Unclipped would be an iris floating over the cheek on exactly the frames
;; where the eye is missing, which is worse than a missing iris.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white
{:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10])
[:style :color] (ch/framed :eye-white)
[:vis] (ch/keyed {0 true, 1 false})}})
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})]
(is (= [:sclera :iris] (ids-at s 0)))
(is (= [] (ids-at s 1)))))
;; ---- discs and rects ----
(deftest a-discs-radius-takes-the-mean-scale-and-a-rects-size-is-rounded
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] (ch/framed [50 60]) [:xform :scale] (ch/framed [2 2])}}
{:id :d :kind :disc :parent :g :z "a1"
:channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}}
{:id :r :kind :rect :parent :g :z "a2"
:channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}})
[d r] (scene/eval-frame s 0)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
;; 1.7 x 2 is 3.4, and a block 3.4px wide would be 3px on one frame and 4 on
;; the next, which reads as the pupil breathing.
(is (= 3 (:size r)))))
;; ---- the fast path and the specification agree ----
(deftest the-resolver-agrees-with-eval-frame-in-any-frame-order
;; THE assertion of this step. The resolver caches the topological order and the
;; z paths, holds a cursor per channel and reuses one point buffer per node, and
;; every one of those is a way to be subtly wrong on some frames and not others
;; — which presents as a bad take rather than as an error.
(let [s demo/scene
res (scene/resolver s)
n (:frames s)
snapshot (fn [ops]
(mapv (fn [op]
(cond-> (dissoc op :pts :i)
(:pts op) (assoc :points (pts-of op))))
ops))]
(doseq [[label fs] [["forward" (range n)]
["backward" (reverse (range n))]
["random access" [0 71 5 5 40 6 70 1 23 24 25 24 23 0 47 48]]
["every third" (range 0 n 3)]]]
(testing label
(doseq [f fs]
(is (= (snapshot (scene/eval-frame s f)) (snapshot (res f)))
(str label " at frame " f)))))))
(deftest the-resolver-reuses-one-buffer-per-node
;; At 30fps per-frame allocation is the only thing that will make this stutter,
;; and fixed topology is what makes the buffer size knowable at all.
(let [res (scene/resolver demo/scene)
buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))]
(is (identical? (buf-of 0 :card) (buf-of 30 :card)))))
;; ---- the hand-written scene, end to end ----
(deftest the-hand-written-scene-is-valid
(is (= "" (scene/problems-str demo/scene)))
(is (pos? (:frames demo/scene))))
(deftest the-hand-written-scene-renders-and-moves
;; port-plan step 2's done condition, as an assertion rather than a look: the
;; scene rasterises, it writes only palette indices, and the pixels are not the
;; same on every frame.
(let [res (scene/resolver demo/scene)
render (fn [f]
(let [r (raster/make demo/width demo/height)]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
r))
frames (mapv render (range 0 (:frames demo/scene) 6))
sig (fn [r] (vec (array-seq (:buf r))))]
(is (every? (fn [r] (every? #(< % (count pal/rgb)) (array-seq (:buf r)))) frames)
"every byte written is a real palette index")
(is (> (count (distinct (map sig frames))) 1) "something moves")
(testing "the mark actually covers pixels"
(is (pos? (count (remove zero? (sig (first frames)))))))))
(deftest the-hand-written-scene-steps-on-the-exposure-grid
;; Exposure 2 on the clip root, inherited, so odd frames are identical to the
;; even frame before them. If this fails, exposure is being applied somewhere
;; other than the frame the channels are sampled at.
(let [res (scene/resolver demo/scene)
render (fn [f]
(let [r (raster/make demo/width demo/height)]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
(vec (array-seq (:buf r)))))]
(doseq [f (range 0 (:frames demo/scene) 2)]
(is (= (render f) (render (inc f))) (str "frame " (inc f) " must hold frame " f)))
;; Two grid slots that straddle a key, not two adjacent ones: between keys
;; nothing changes, because that is what hold MEANS. The scene's second key
;; is at 57, and exposure 2 floors that onto 58 — which is itself the
;; expose-before-anything-else rule showing up in pixels.
(is (not= (render 56) (render 58)) "and a key on the grid is seen")))
(deftest the-hand-written-scene-keeps-the-iris-and-pupil-inside-the-card
;; The stencil chain, on real pixels: the iris is clipped by the card and the
;; pupil by the iris, and neither is expressed anywhere as a chain.
(let [res (scene/resolver demo/scene)]
(doseq [f (range 0 (:frames demo/scene) 4)]
(let [before (raster/make demo/width demo/height)
after (raster/make demo/width demo/height)
ops (res f)
card? (fn [op] (= :card (:node op)))]
(raster/clear! before (:bg pal/index-of))
(raster/draw-ops! before (filter card? ops))
(raster/clear! after (:bg pal/index-of))
(raster/draw-ops! after ops)
(let [ci (:skin-base pal/index-of)
card (set (for [i (range (alength (:buf before)))
:when (= ci (aget (:buf before) i))]
i))
eye (set (for [i (range (alength (:buf after)))
:when (#{(:iris pal/index-of) (:pupil pal/index-of)}
(aget (:buf after) i))]
i))]
(is (pos? (count eye)) (str "frame " f ": the iris drew something"))
(is (empty? (remove card eye))
(str "frame " f ": " (count (remove card eye)) " pixels outside the card")))))))
;; ---- the palette is a parameter, not a global ----
(deftest the-same-scene-resolves-differently-under-a-different-ramp
;; A node names a TONE; which ramp that tone is read in belongs to the timeline
;; it sits in. So resolution must not reach for one ambient answer — the same
;; drawing has to read day or night without a stored value changing, which is
;; the entire payoff of indexed colour.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))
day {:skin-base 1}
night {:skin-base 17}]
(is (= 1 (:color (first (scene/eval-frame s 0 nil day)))))
(is (= 17 (:color (first (scene/eval-frame s 0 nil night)))))
(is (= 17 (:color (first ((scene/resolver s nil night) 0))))
"and the playback path agrees")))
(deftest a-tone-the-ramp-does-not-define-is-loudly-wrong
;; 255 renders magenta. Naming a colour the ramp has no entry for is a bug in
;; authored data and should be impossible to miss.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))]
(is (= 255 (:color (first (scene/eval-frame s 0 nil {})))))))
(deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil
;; A stencil is a colour key, so two nodes sharing a tone share a stencil —
;; a real weakness of the technique. Concatenating the named palettes into one
;; index space means two nodes in DIFFERENT palettes cannot collide at all.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 20 0 20 20] :eye-white)
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})
;; :night's tones sit above :day's in one concatenated space
night {:eye-white 14 :iris 15}
ops (scene/eval-frame s 0 nil night)]
(is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in")))