704 lines
38 KiB
Clojure
704 lines
38 KiB
Clojure
(ns arthur.flow.freeze-test
|
|
"The freeze is where the model's central claim is either true or false:
|
|
measurement and a hand produce THE SAME DATA, and the only difference is a flag
|
|
nothing in the renderer reads. Most of what is asserted here is that claim,
|
|
taken apart into the pieces that could quietly stop holding.
|
|
|
|
It is also the first step whose done-criterion is a PICTURE, so nothing in here
|
|
is the proof that step 5 is done — a take that resolves to the right numbers and
|
|
draws nothing would pass every assertion below. See test/browser/take.mjs, which
|
|
drives a real Chrome."
|
|
(:require [cljs.test :refer [deftest is testing]]
|
|
[arthur.demo.take :as take]
|
|
[arthur.domain.channel :as ch]
|
|
[arthur.domain.clip :as clip]
|
|
[arthur.domain.geom :as geom]
|
|
[arthur.domain.gesture :as gesture]
|
|
[arthur.domain.leaf :as leaf]
|
|
[arthur.domain.node :as node]
|
|
[arthur.domain.palette :as pal]
|
|
[arthur.domain.pick :as pick]
|
|
[arthur.domain.raster :as raster]
|
|
[arthur.domain.ring :as ring]
|
|
[arthur.domain.symbol :as symbol]
|
|
[arthur.flow.freeze :as freeze]))
|
|
|
|
(def ^:private W 320)
|
|
(def ^:private H 200)
|
|
|
|
;; The whole vertical slice, exactly as the page builds it. Asserting against the
|
|
;; page's own clip rather than against a fixture built here is deliberate: a
|
|
;; fixture is a second document nobody looks at, and the one that renders is the one
|
|
;; that has to be right.
|
|
(def frozen (delay @take/frozen))
|
|
(def clip* (delay (:clip @frozen)))
|
|
;; Geometry assertions read the face timeline. Rendering assertions resolve
|
|
;; the whole clip, including placement and inherited exposure.
|
|
(defn- face-symbol [c] (clip/symbol c :face-1))
|
|
(defn- nodes [c] (merge (:nodes (clip/symbol c :main)) (:nodes (face-symbol c))))
|
|
(def sym* (delay (face-symbol @clip*)))
|
|
(def store (delay (:store @frozen)))
|
|
|
|
(defn- node [id] (get (nodes @clip*) id))
|
|
(defn- chan [id path] (get-in (node id) [:channels path]))
|
|
|
|
(defn- block-of
|
|
"The typed array a dense channel reads, through its own handle."
|
|
[ch]
|
|
(:data (get @store (:store (:dense ch)))))
|
|
|
|
(defn- pts-at
|
|
"The mouth's [:geom :pts] at frame f, as a flat CLJS vector."
|
|
[id f]
|
|
(let [v (ch/value-at (chan id [:geom :pts]) f @store)]
|
|
(mapv #(ch/component v %) (range (.-length v)))))
|
|
|
|
(defn- ops-at
|
|
"Ops for one frame of a TIMELINE."
|
|
[sym f]
|
|
((symbol/resolver sym @store pal/index-of nil) f))
|
|
|
|
(defn- render
|
|
"One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
|
|
the ops from the complete clip, including nested face timelines."
|
|
[c f]
|
|
(let [r (raster/make (:width c) (:height c))]
|
|
(raster/clear! r (get pal/index-of :bg))
|
|
(raster/draw-ops! r ((clip/resolver c :main @store pal/index-of nil) f))
|
|
(vec (array-seq (:buf r)))))
|
|
|
|
(defn- drawn
|
|
"How many pixels are not background."
|
|
[buf]
|
|
(count (remove #(= % (get pal/index-of :bg)) buf)))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; the shape of what came out
|
|
|
|
(deftest the-frozen-take-is-a-valid-clip-in-every-head-mode
|
|
;; `clip/problems` is total by construction, so this is safe to run over data
|
|
;; before the data is trusted — which is what it is for. It checks the clip's
|
|
;; fields, every timeline in it and the tracking identities, so it is the whole
|
|
;; of what a save would refuse.
|
|
(doseq [spec [{} {:trace {:origin :start}} {:trace {:origin :continuous :frames [4]}}
|
|
{:trace {:origin :keys :frames [12 88 150]}}]]
|
|
(let [c (freeze/head-mode spec @frozen)]
|
|
(is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c)))))))
|
|
|
|
(deftest the-tree-is-the-one-the-model-specifies
|
|
;; :main HOLDS INSTANCES AND NOTHING ELSE. The source-to-stage placement used
|
|
;; to be a `:face` group here, above them all; it is each face's own `:place`
|
|
;; now, so the take is a container that knows nothing and a face is the right
|
|
;; size wherever it is put. Same transform, same subtree, one level lower.
|
|
(is (= [:face-1 :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face-1)))
|
|
(is (nil? (get-in @clip* [:symbols :main :nodes :face])))
|
|
(is (= #{:face-1} (node/sources (get-in @clip* [:symbols :main :nodes :face-1]))))
|
|
(is (= [:place] (symbol/lineage (:nodes @sym*) :place)))
|
|
(is (= [:head :place] (symbol/lineage (:nodes @sym*) :head)))
|
|
(is (= [:mouth :head :place] (symbol/lineage (:nodes @sym*) :mouth)))
|
|
(is (= [:mouth-in :mouth :head :place] (symbol/lineage (:nodes @sym*) :mouth-in)))
|
|
(is (= {:mode :map :expose 2} (:time (node :root))))
|
|
(is (every? #(nil? (:time (node %))) [:place :head :mouth :mouth-in])))
|
|
|
|
(deftest geometry-is-flat-and-dense-and-the-interior-shares-the-outline-s-block
|
|
(doseq [id [:mouth :mouth-in]]
|
|
(is (= :dense (ch/describe (chan id [:geom :pts])))))
|
|
;; ONE block, two tracks, node-major. offset(track 1) = frames · stride, which
|
|
;; is the layout demo/swarm holds and the reason a frame is a rectangular slice
|
|
;; at an arithmetic offset rather than a lookup into a table.
|
|
(let [a (:dense (chan :mouth [:geom :pts]))
|
|
b (:dense (chan :mouth-in [:geom :pts]))]
|
|
(is (= (:store a) (:store b)))
|
|
(is (zero? (:offset a)))
|
|
(is (= (* (:frames a) (:stride a)) (:offset b))))
|
|
;; Flat: [x0 y0 x1 y1 …], so stride is twice the vertex budget and a value reads
|
|
;; the same way an authored vector does.
|
|
(is (= (* 2 8) (:stride (:dense (chan :mouth [:geom :pts])))))
|
|
(is (= (* 2 8) (count (pts-at :mouth 0)))))
|
|
|
|
(deftest the-fixed-point-block-round-trips-to-within-its-own-quantum
|
|
;; The one thing fixed point can cost is precision, so it is measured rather
|
|
;; than assumed. `rings->flat` is re-run here against the same measured rings,
|
|
;; which is what the block was written from.
|
|
(let [want (freeze/rings->flat (:outer @take/measured) 8)
|
|
q (/ 1.0 freeze/geom-scale)
|
|
gap (reduce max (for [f (range 0 take/frames 7)
|
|
[a b] (map vector (pts-at :mouth f) (nth want f))]
|
|
(abs (- a b))))]
|
|
(is (<= gap (/ q 2))
|
|
(str "worst quantisation error " gap " against a quantum of " q))
|
|
;; And in stage pixels, which is the unit anyone can judge. `:place`'s scale is
|
|
;; stage px per image height, so the whole quantum is q·k — a twentieth of a
|
|
;; pixel at this placement, two orders below anything the rasteriser can
|
|
;; express, which is the argument for Int16 geometry stated as a measurement.
|
|
(let [k (first (:value (chan :place [:xform :scale])))]
|
|
(is (< (* q k) 0.1)
|
|
(str "the quantum is " (* q k) " stage pixels at " k " px per image height"))
|
|
(is (< (* gap k) (* q k))))))
|
|
|
|
(deftest the-scale-is-in-the-header-and-not-agreed-by-convention
|
|
;; A block in image-height units and a block in stage pixels want different
|
|
;; scales, which is why it is a field. Transform blocks carry none at all: they
|
|
;; are Float32, because an angle and a scale factor have no natural fixed point
|
|
;; and there are four numbers a frame of them rather than forty.
|
|
(is (= freeze/geom-scale (:scale (:dense (chan :mouth [:geom :pts])))))
|
|
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
|
|
(is (nil? (:scale (:dense (get-in (node :head) [:measured path]))))
|
|
(str path " should be plain Float32")))
|
|
;; Reached through the channel's own handle rather than by naming a key. A key
|
|
;; is a hash now, so a test that wrote one out would be asserting a digest.
|
|
(is (instance? js/Int16Array (block-of (chan :mouth [:geom :pts]))))
|
|
(is (instance? js/Float32Array
|
|
(block-of (get-in (node :head) [:measured [:xform :pos]])))))
|
|
|
|
(deftest a-value-past-the-block-s-range-is-refused-rather-than-saturated
|
|
;; Saturating reads as articulation flattening off at the extremes — a bad
|
|
;; detection, not a bad scale — so it has to be loud. A ring three image heights
|
|
;; wide cannot be real, and that is the point: if it happens, the block's space
|
|
;; is wrong and there is nothing to be gained by drawing something.
|
|
(is (thrown-with-msg?
|
|
ExceptionInfo #"does not fit the block's fixed point"
|
|
(freeze/clip (assoc take/params :name "huge")
|
|
{:face-1 (update @take/measured :outer
|
|
(fn [rings]
|
|
(mapv (fn [r] (mapv #(update % :x + 3) r)) rings)))}))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; the anchor: three channels, and the inverse
|
|
|
|
(deftest the-similarity-inverse-undoes-the-fit-exactly
|
|
;; The fit takes the head's motion OUT and geometry is stored in the space it
|
|
;; produces, so putting the motion back — "as filmed" — is the fit's inverse.
|
|
;; Still factored, because the three components land on three independently
|
|
;; keyframable channels.
|
|
(let [gap (reduce max
|
|
(for [tf (:transforms @take/measured)
|
|
p [{:x 0.5 :y 0.6} {:x 0.0 :y 0.0} {:x -0.3 :y 1.2}]]
|
|
(let [q (geom/apply-sim (freeze/invert tf) (geom/apply-sim tf p))]
|
|
(js/Math.hypot (- (:x q) (:x p)) (- (:y q) (:y p))))))]
|
|
(is (< gap 1e-12) (str "invert ∘ fit is off by " gap))))
|
|
|
|
(deftest the-head-carries-the-inverse-fit-split-into-its-three-components
|
|
;; Float32 storage, so this is a tolerance and not equality — four bytes a
|
|
;; number is the spec's choice for transform blocks and it costs about seven
|
|
;; decimal digits, which at 850 stage pixels per image height is far below a
|
|
;; pixel.
|
|
(let [measured (get-in (node :head) [:measured])
|
|
at (fn [path f] (ch/value-at (get measured path) f @store))]
|
|
(doseq [f (range 0 take/frames 11)]
|
|
(let [want (freeze/invert (nth (:transforms @take/measured) f))
|
|
pos (at [:xform :pos] f)]
|
|
(is (< (abs (- (ch/component pos 0) (:tx want))) 1e-5))
|
|
(is (< (abs (- (ch/component pos 1) (:ty want))) 1e-5))
|
|
(is (< (abs (- (at [:xform :rot] f) (:theta want))) 1e-6))
|
|
(is (< (abs (- (ch/component (at [:xform :scale] f) 0) (:s want))) 1e-6))))))
|
|
|
|
(deftest head-local-geometry-composed-through-head-and-face-lands-on-the-stage
|
|
;; The end-to-end claim of the split, asserted against the OPS the resolver
|
|
;; actually emits rather than against an intermediate: stored head-local, put
|
|
;; back through `:head`, placed by `:place`, the mouth is where the composition
|
|
;; of the two says it is. A test that recomputed the chain would only be
|
|
;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
|
|
;; and `emit` as well.
|
|
(let [c (freeze/head-mode {} @frozen)
|
|
res (clip/resolver c :main @store pal/index-of nil)
|
|
k (first (:value (chan :place [:xform :scale])))
|
|
anc (:value (chan :place [:xform :anchor]))
|
|
pos (:value (chan :place [:xform :pos]))
|
|
tfs (:transforms @take/measured)]
|
|
(doseq [f (range 0 take/frames 13)]
|
|
(let [ops (res f)
|
|
op (first (filter #(= [:face-1 :mouth] (:node %)) ops))
|
|
;; EXPOSURE FIRST. The clip root is on 2s and exposure inherits
|
|
;; strictly, so frame 13 shows frame 12's pose — which is also the
|
|
;; cheapest place to assert that the grid is actually being applied,
|
|
;; since reading the unexposed frame here misses by half a pixel and
|
|
;; looks like a rounding problem.
|
|
ef (node/expose f 2)
|
|
;; The frozen, quantised vertex — so the fixed point is not part of
|
|
;; what is being asserted here; it has its own test.
|
|
flat (pts-at :mouth ef)
|
|
g {:x (nth flat 0) :y (nth flat 1)}
|
|
;; Where the anchor fit says that head-local point was in the image:
|
|
;; the fit removed the head's motion, so putting it back is the fit's
|
|
;; inverse. Node :head carries exactly this.
|
|
im (geom/apply-sim (freeze/invert (nth tfs ef)) g)
|
|
;; And where :place puts it: scaled about the anchor, then translated,
|
|
;; which is p ↦ k(p - anchor) + anchor + pos.
|
|
wx (+ (* k (- (:x im) (nth anc 0))) (nth anc 0) (nth pos 0))
|
|
wy (+ (* k (- (:y im) (nth anc 1))) (nth anc 1) (nth pos 1))]
|
|
(is (some? op) (str "frame " f " emitted no mouth op"))
|
|
;; Tolerance is the Float32 transform block's, scaled to stage pixels, and
|
|
;; it is three orders below a pixel.
|
|
(is (< (js/Math.hypot (- (aget (:pts op) 0) wx)
|
|
(- (aget (:pts op) 1) wy))
|
|
0.01)
|
|
(str "frame " f ": op has ["
|
|
(aget (:pts op) 0) " " (aget (:pts op) 1)
|
|
"], the composition says [" wx " " wy "]"))))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; one dense measurement, with optional held trace frames
|
|
|
|
(deftest a-head-trace-selects-measured-frames-without-copying-channels
|
|
(let [free (freeze/head-mode {} @frozen)
|
|
one (freeze/head-mode {:trace {:origin :keys :frames [12]}} @frozen)
|
|
keyed (freeze/head-mode {:trace {:origin :keys :frames [12 88 150]}} @frozen)
|
|
of (fn [c path] (get-in (nodes c) [:head :channels path]))]
|
|
(doseq [c [free one keyed]
|
|
path [[:xform :pos] [:xform :rot] [:xform :scale]]]
|
|
(is (= :dense (ch/describe (of c path))))
|
|
(is (= (of free path) (of c path)) "a trace does not copy measurements"))
|
|
(is (nil? (get-in (nodes free) [:head :trace])))
|
|
(is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace])))
|
|
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
|
|
"the trace survives the document round trip")))
|
|
|
|
(deftest trace-keys-hold-the-whole-measured-transform
|
|
(let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen)) @store pal/index-of nil)
|
|
held (symbol/resolver (face-symbol
|
|
(freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen)) @store pal/index-of nil)
|
|
start (symbol/resolver (face-symbol
|
|
(freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen)) @store pal/index-of nil)
|
|
world (fn [resolver frame]
|
|
(resolver frame)
|
|
(vec (array-seq (symbol/world-of resolver :head))))]
|
|
(is (= (world free 12) (world held 0)) "before the first key, the first holds")
|
|
(is (= (world free 12) (world held 87)))
|
|
(is (= (world free 88) (world held 88)) "a jump, not a tween")
|
|
(is (= (world free 88) (world held 100)))
|
|
(is (not= (world free 0) (world free 100)) "the head does move, so the above says something")
|
|
(is (= (world free 0) (world start 50) (world start 100)))))
|
|
|
|
(deftest switching-modes-rewrites-the-head-and-nothing-else
|
|
;; It has to be impossible for the toggle to move something a hand placed, and
|
|
;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a
|
|
;; reason to re-analyse.
|
|
(let [a (freeze/head-mode {} @frozen)
|
|
b (freeze/head-mode {:trace {:origin :start}} @frozen)
|
|
c (freeze/head-mode {:trace {:origin :keys :frames [0 40]}} @frozen)]
|
|
(doseq [x [b c]]
|
|
(is (= (get (nodes a) :place) (get (nodes x) :place))
|
|
":place moved")
|
|
(is (= (dissoc (nodes a) :head) (dissoc (nodes x) :head))
|
|
"a node other than :head changed")
|
|
;; The measurement does not go away when the head is locked: always measure,
|
|
;; always store factored, toggle the parent.
|
|
(is (= (get-in (nodes a) [:head :measured])
|
|
(get-in (nodes x) [:head :measured])))
|
|
;; And nothing above the timeline moved either: the toggle is one node's
|
|
;; channels, so the clip's own fields and its other timelines are untouched.
|
|
(is (= (dissoc a :symbols) (dissoc x :symbols))))))
|
|
|
|
(deftest invalid-head-traces-are-refused
|
|
(doseq [t [{} {:origin :stabilised} {:origin :keys :frames [take/frames]}
|
|
{:origin :keys :frames [-1]} {:origin :keys :frames [12 4]}
|
|
{:origin :keys :frames [4 4]} {:origin :keys :frames '(4)}]]
|
|
(is (thrown-with-msg? ExceptionInfo #"trace is not one this take can hold"
|
|
(freeze/head-mode {:trace t} @frozen))
|
|
(pr-str t)))
|
|
(is (seq (clip/problems (assoc-in (freeze/head-mode {} @frozen)
|
|
[:symbols :face-1 :nodes :head :trace]
|
|
{:origin :keys :frames [take/frames]})))
|
|
"and a document holding one will not save"))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; the face: authored, and what makes makeXform deletable
|
|
|
|
(deftest the-face-is-authored-and-carries-no-provenance
|
|
;; The difference from `makeXform` in one assertion: the placement is a FRAMED
|
|
;; transform on a node, which a hand can revise, and it claims no generator that
|
|
;; would offer to overwrite it.
|
|
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale] [:xform :anchor]]]
|
|
(let [c (get (node/channels (node :place)) path)]
|
|
(is (= :framed (ch/describe c)) (str path " is not framed"))
|
|
(is (nil? (:generated c)) (str path " claims provenance")))))
|
|
|
|
(deftest a-part-has-a-pivot-exactly-when-a-hand-can-use-one
|
|
;; The face's anchor was always the head's centre — the test below — and the
|
|
;; parts underneath it had none at all, so each one turned and scaled about ITS
|
|
;; OWN origin, which is the top-left corner of the FOOTAGE. On a 320x200 stage
|
|
;; the mouth's pivot sat at (-234, -395): off the stage by more than a stage,
|
|
;; so a corner drag slid the mouth about instead of resizing it.
|
|
;;
|
|
;; BY BICONDITIONAL, over every node the freeze makes, rather than against a
|
|
;; list of the ones that happen to have geometry today. The rule `pivoted` goes
|
|
;; by is `node/measured?` — the one `gesture/refusal` refuses a hand edit by —
|
|
;; so the two have to agree exactly: a pivot is written where a hand could use
|
|
;; it and nowhere else. A brow has a dense `[:xform :pos]` and so gets none,
|
|
;; which is not an exception to the rule, it is the rule.
|
|
(let [c @clip*]
|
|
(doseq [sid [:main :face-1]
|
|
id (keys (get-in c [:symbols sid :nodes]))
|
|
;; `:place` authors its own in `face-placement`, upstream of this.
|
|
:when (not= [:face-1 :place] [sid id])]
|
|
(let [n (get-in c [:symbols sid :nodes id])
|
|
frames (range (get-in c [:symbols sid :frames]))
|
|
anchor (:value (get-in n [:channels [:xform :anchor]]))
|
|
usable (and (not (node/measured? n))
|
|
(some? (pick/pivot c @store sid n frames)))]
|
|
(is (= usable (some? anchor))
|
|
(str sid "/" id " has a pivot: " (some? anchor)
|
|
", but a hand can use one: " usable))
|
|
(is (= (nil? (gesture/refusal n)) (not (node/measured? n)))
|
|
(str sid "/" id ": `refusal` and `measured?` disagree"))
|
|
(when anchor
|
|
(let [bounds (pick/bounds-of c @store sid n)
|
|
[x0 y0 x1 y1] (reduce #(let [k (bounds %2)]
|
|
(cond (nil? %1) k (nil? k) %1
|
|
:else (mapv (fn [op i] (op (nth %1 i) (nth k i)))
|
|
[min min max max] (range 4))))
|
|
nil frames)]
|
|
(is (and (<= x0 (nth anchor 0) x1) (<= y0 (nth anchor 1) y1))
|
|
(str sid "/" id "'s pivot " (pr-str anchor) " is outside what it draws, "
|
|
(pr-str [x0 y0 x1 y1])))))))))
|
|
|
|
(deftest the-head-keeps-no-pivot-of-its-own
|
|
;; The case that makes `measured?` the right predicate rather than "draws
|
|
;; nothing": `:head` carries the measured similarity, so its scale is nowhere
|
|
;; near 1 and an anchor on it would NOT cancel out of `node/local!` — it would
|
|
;; move the whole face. It is skipped for that reason, and would still be
|
|
;; skipped if it were ever given geometry.
|
|
(is (node/measured? (node :head)))
|
|
(is (nil? (get-in (node :head) [:channels [:xform :anchor]]))))
|
|
|
|
(deftest giving-every-part-its-pivot-moves-nothing-on-screen
|
|
;; The claim `pivoted`'s docstring makes, asserted in pixels rather than
|
|
;; trusted: rotation and scale are the identity on a node a freeze has just
|
|
;; made, and at the identity the anchor cancels out of `node/local!`. So the
|
|
;; pass decides where a part PIVOTS and nothing else — if it ever renders
|
|
;; differently, it has been applied to a node whose transform is not the
|
|
;; identity, which is the one way it could go wrong.
|
|
(let [c @clip*
|
|
;; Every node the freeze makes EXCEPT `:place`, whose anchor
|
|
;; `face-placement` authors — which is the set `pivoted` writes.
|
|
every (for [sid [:main :face-1]
|
|
id (keys (get-in c [:symbols sid :nodes]))
|
|
:when (and (not= [:face-1 :place] [sid id])
|
|
(seq (get-in c [:symbols sid :nodes id :channels])))]
|
|
[sid id])
|
|
anchors #(into {} (for [[sid id] every]
|
|
[[sid id] (get-in % [:symbols sid :nodes id
|
|
:channels [:xform :anchor]])]))
|
|
bare (reduce (fn [c [sid id]]
|
|
(update-in c [:symbols sid :nodes id :channels]
|
|
dissoc [:xform :anchor]))
|
|
c every)
|
|
again (freeze/pivoted bare @store)]
|
|
(is (every? nil? (vals (anchors bare))) "stripped")
|
|
(is (= (anchors c) (anchors again)) "the pass puts back exactly what the freeze wrote")
|
|
(doseq [f (range 0 take/frames 17)]
|
|
(is (= (render bare f) (render again f))
|
|
(str "frame " f " draws differently once every part has a pivot")))))
|
|
|
|
(deftest the-place-puts-the-head-s-centre-where-it-says-it-does
|
|
;; anchor + pos is where the anchor lands in the parent, which is what makes
|
|
;; `:anchor` the registration point: scale and rotation happen about the head's
|
|
;; centre rather than about the corner of the footage, where MediaPipe's
|
|
;; normalised space has its origin.
|
|
(let [anc (:value (chan :place [:xform :anchor]))
|
|
pos (:value (chan :place [:xform :pos]))
|
|
c (geom/centroid (:ref @take/measured))]
|
|
(is (< (abs (- (nth anc 0) (:x c))) 1e-12))
|
|
(is (< (abs (- (nth anc 1) (:y c))) 1e-12))
|
|
(is (< (abs (- (+ (nth anc 0) (nth pos 0)) (/ W 2))) 1e-9))
|
|
(is (< (abs (- (+ (nth anc 1) (nth pos 1)) (* 0.25 H))) 1e-9))))
|
|
|
|
(deftest the-stage-is-the-clip-s-and-not-the-footage-s
|
|
;; Project dimensions are independent of the footage, which is precisely what
|
|
;; dropping makeXform buys. Nothing below the freeze knows the frame size, so
|
|
;; asking for a different stage moves and rescales the same geometry rather than
|
|
;; re-measuring anything.
|
|
(let [big (freeze/clip (assoc take/params :stage [640 480] :name "big")
|
|
{:face-1 @take/measured})
|
|
key-of (fn [c] (:store (:dense (get-in (nodes c)
|
|
[:mouth :channels [:geom :pts]]))))]
|
|
(is (= [640 480] [(:width (:clip big)) (:height (:clip big))]))
|
|
;; Stronger than it was, and for free: the stage is not an input to tier 2, so
|
|
;; the two clips do not merely hold equal bytes — they name the SAME BLOCK, and
|
|
;; a stage change cannot invalidate a bake. The clip's name is not an input
|
|
;; either, which is why "big" and "take" still agree.
|
|
(is (= (key-of @clip*) (key-of (:clip big)))
|
|
"a different stage is a different document over the same tier 2")
|
|
(is (= (vec (array-seq (:data (get @store (key-of @clip*)))))
|
|
(vec (array-seq (:data (get (:store big) (key-of (:clip big)))))))
|
|
"the geometry is the same numbers at either stage size")
|
|
(is (not= (:value (get-in (nodes (:clip big))
|
|
[:place :channels [:xform :scale]]))
|
|
(:value (chan :place [:xform :scale]))))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; the aperture, as [:vis]
|
|
|
|
(deftest the-mouth-interior-is-hidden-below-the-aperture-cut
|
|
(let [c (chan :mouth-in [:vis])
|
|
ap (:aperture @take/measured)
|
|
peak (reduce max ap)
|
|
want (mapv #(>= (/ % peak) 0.12) ap)]
|
|
(is (= :keyed (ch/describe c)))
|
|
(is (= want (mapv #(ch/value-at c % nil) (range take/frames)))
|
|
"the held keys do not reproduce the threshold")
|
|
;; The reason it is keyed: a threshold crossing is a handful of transitions,
|
|
;; hold is the default, and keys are the shape a human can correct. A dense
|
|
;; block would be 229 bytes in tier 2 to say the same thing, un-editable.
|
|
(is (< (count (:keys c)) 40)
|
|
(str (count (:keys c)) " keys for " take/frames " frames"))
|
|
(is (contains? (:keys c) 0) "the first key is the pose the part starts in")
|
|
;; It really does both, or the assertion above is vacuous.
|
|
(is (some true? want))
|
|
(is (some false? want))))
|
|
|
|
(deftest the-mouth-outline-is-never-hidden
|
|
;; The dark band OUTSIDE the interior is what makes a flat shape read as an
|
|
;; opening rather than a blob, so the outline keeps every frame; only the
|
|
;; interior comes and goes.
|
|
(is (nil? (chan :mouth [:vis])))
|
|
(doseq [f (range 0 take/frames 9)]
|
|
(is (some #(= :mouth (:node %)) (ops-at @sym* f))
|
|
(str "frame " f " drew no mouth outline"))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; provenance
|
|
|
|
(deftest every-generated-channel-says-who-generated-it-and-under-which-knobs
|
|
;; `:generated` is what lets the UI offer a parameter panel and a re-freeze
|
|
;; instead of raw keys, and which knobs it names is the invalidation table
|
|
;; written where a re-freeze can read it.
|
|
(is (= :roto/lips-outer (:by (:generated (chan :mouth [:geom :pts])))))
|
|
(is (= :roto/lips-inner (:by (:generated (chan :mouth-in [:geom :pts])))))
|
|
(is (= :roto/mouth-aperture (:by (:generated (chan :mouth-in [:vis])))))
|
|
(is (= :anchor/similarity
|
|
(:by (:generated (get-in (node :head) [:measured [:xform :pos]])))))
|
|
(is (= {:anchor-avg 2 :contour-avg 1 :verts 8}
|
|
(:params (:generated (chan :mouth [:geom :pts])))))
|
|
;; The aperture does NOT depend on `contour avg`: measure reports the inner
|
|
;; ring's own height and nothing smooths it.
|
|
(is (= {:anchor-avg 2 :aperture-cut 0.12}
|
|
(:params (:generated (chan :mouth-in [:vis])))))
|
|
(is (every? #(some? (:analysis (:generated %)))
|
|
[(chan :mouth [:geom :pts]) (chan :mouth-in [:vis])])))
|
|
|
|
(deftest the-renderer-never-reads-provenance
|
|
;; The load-bearing claim, asserted rather than trusted: strip every
|
|
;; `:generated` out of the document and the frame is the same bytes. If this
|
|
;; ever fails, a rotoscoped part and a hand-drawn one have stopped being the
|
|
;; same data.
|
|
(let [strip-node (fn [n]
|
|
(update n :channels
|
|
#(into {} (map (fn [[p c]] [p (dissoc c :generated)])) %)))
|
|
stripped (clip/update-symbol
|
|
@clip* :main
|
|
update :nodes
|
|
#(into {} (map (fn [[id n]] [id (strip-node n)])) %))]
|
|
(doseq [f (range 0 take/frames 17)]
|
|
(is (= (render @clip* f) (render stripped f))
|
|
(str "frame " f " differs with provenance removed")))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; presence is not visibility
|
|
|
|
(deftest an-eye-can-disappear-and-return-under-the-same-identity
|
|
(let [gap (set (range 40 60))
|
|
presence {:eye-r (mapv #(not (contains? gap %)) (range take/frames))}
|
|
c (freeze/clip (assoc take/params :name "one-eye-gappy")
|
|
{:face-1 (assoc @take/measured :presence presence)})
|
|
sym (face-symbol (:clip c))
|
|
at (fn [id f]
|
|
(ch/value-at (get-in (:nodes sym) [id :channels [:geom :pts]]) f (:store c)))]
|
|
;; The identities are the CLIP's, and a gap does not touch them: a feature keeps
|
|
;; its id and its pair membership across the frames it was not observed on.
|
|
(is (= [:face-1/eye-r :face-1/eye-l] (get-in (:clip c) [:groups :face-1/eyes :members])))
|
|
(is (= :face-1/eye-r (get-in (:clip c) [:features :face-1/eye-r :id])))
|
|
(is (not (ch/nothing? (at :eye-r 39))))
|
|
(is (ch/nothing? (at :eye-r 50)))
|
|
(is (not (ch/nothing? (at :eye-r 60))))
|
|
(is (not (ch/nothing? (at :eye-l 50))))
|
|
(is (not (ch/nothing? (at :mouth 50))))
|
|
(let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of nil) 50))]
|
|
(is (not (contains? drawn-nodes :eye-r)))
|
|
(is (contains? drawn-nodes :eye-l))
|
|
(is (contains? drawn-nodes :mouth)))
|
|
(is (empty? (clip/problems (:clip c))))))
|
|
|
|
(deftest each-dense-track-follows-its-own-features-presence
|
|
;; Every feature is given a DIFFERENT gap, so a track wired to the wrong one
|
|
;; shows up as absence inside somebody else's window. One shared gap would pass
|
|
;; under any permutation of the four tracks in the eye block, and that is the
|
|
;; failure docs/port-plan.md warns about twice: swap left for right and every
|
|
;; part is still roughly where it belongs, so it survives inspection.
|
|
;;
|
|
;; This is the mapping `pack` cannot check for itself. Each block hands it an
|
|
;; :absent predicate that derives a feature from a track INDEX, so the predicate
|
|
;; and the vector literal beside it have to agree by hand, in four places.
|
|
(let [windows {:eye-r (set (range 10 15))
|
|
:eye-l (set (range 20 25))
|
|
:brow-r (set (range 30 35))
|
|
:brow-l (set (range 40 45))}
|
|
presence (into {} (map (fn [[id gap]]
|
|
[id (mapv #(not (contains? gap %))
|
|
(range take/frames))]))
|
|
windows)
|
|
c (freeze/clip (assoc take/params :name "per-track-gaps")
|
|
{:face-1 (assoc @take/measured :presence presence)})
|
|
sym (face-symbol (:clip c))
|
|
at (fn [id path f]
|
|
(ch/value-at (get-in (:nodes sym) [id :channels path]) f (:store c)))
|
|
;; Node, channel, and the feature whose gap it must follow. Every dense
|
|
;; track of the eye, iris, brow and brow-position blocks appears once.
|
|
tracks [[:eye-r [:geom :pts] :eye-r]
|
|
[:eye-r-in [:geom :pts] :eye-r]
|
|
[:eye-l [:geom :pts] :eye-l]
|
|
[:eye-l-in [:geom :pts] :eye-l]
|
|
[:iris-r [:xform :pos] :eye-r]
|
|
[:iris-l [:xform :pos] :eye-l]
|
|
[:brow-r [:geom :pts] :brow-r]
|
|
[:brow-l [:geom :pts] :brow-l]
|
|
[:brow-r [:xform :pos] :brow-r]
|
|
[:brow-l [:xform :pos] :brow-l]]]
|
|
(is (empty? (clip/problems (:clip c))))
|
|
(doseq [[id path owner] tracks
|
|
[feature gap] windows
|
|
f gap]
|
|
(if (= feature owner)
|
|
(is (ch/nothing? (at id path f))
|
|
(str id " " path " is not absent at " f " with " feature " occluded"))
|
|
(is (not (ch/nothing? (at id path f)))
|
|
(str id " " path " follows " feature "'s gap at frame " f))))))
|
|
|
|
(deftest teeth-follow-the-mouth-through-their-stencil-and-not-through-a-mask
|
|
;; Teeth are their own feature, so that they can carry their own :area :teeth
|
|
;; parameters — which means an occluded MOUTH sets no absence bit on them. They
|
|
;; do not need one: they are stencilled by :mouth-in, and symbol/finish drops a
|
|
;; node whose stencil drew nothing. So the coupling is real, and it is the
|
|
;; stencil rule rather than the mask that enforces it. The rule itself is
|
|
;; asserted in timeline-test; what is pinned here is the wiring that relies on it.
|
|
(let [gap (set (range 40 60))
|
|
teeth-in {;; The mouth's own inner ring standing in for a pixel-derived
|
|
;; contour: real geometry and no nils, so every frame has a
|
|
;; value that could be dropped.
|
|
:contours (:inner @take/measured)
|
|
:shown (vec (repeat take/frames true))}
|
|
clip (fn [nm extra]
|
|
(freeze/clip (assoc take/params :name nm)
|
|
{:face-1 (merge (assoc @take/measured :teeth teeth-in)
|
|
extra)}))
|
|
ref (clip "teeth-reference" nil)
|
|
occ (clip "teeth-mouth-gap"
|
|
{:presence {:mouth (mapv #(not (contains? gap %))
|
|
(range take/frames))}})
|
|
;; Hoisted: the resolver caches its order and reuses its buffers, so the
|
|
;; node ids come out before the next frame is asked for.
|
|
nodes-at (fn [c]
|
|
(let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of nil)]
|
|
(fn [f] (into #{} (map :node) (r f)))))
|
|
ref-at (nodes-at ref)
|
|
occ-at (nodes-at occ)
|
|
;; The interior only draws on an OPEN mouth, so both frames are picked
|
|
;; from the UNANNOTATED clip. Same articulation either side of the gap,
|
|
;; which is what stops this passing on a frame the mouth was shut anyway.
|
|
open (filter #(contains? (ref-at %) :teeth) (range take/frames))
|
|
inside (first (filter gap open))
|
|
outside (first (remove gap open))]
|
|
(is (= :mouth-in (get-in (nodes (:clip occ)) [:teeth :stencil]))
|
|
"teeth stop inheriting the mouth's absence if this stops being their stencil")
|
|
(is (some? inside) "no open-mouth frame inside the gap to test with")
|
|
(is (some? outside) "no open-mouth frame outside the gap to test with")
|
|
(when (and inside outside)
|
|
;; Annotating the MOUTH sets no bit on the teeth: they are a feature of
|
|
;; their own and nothing named them.
|
|
(is (not (ch/nothing?
|
|
(ch/value-at (get-in (nodes (:clip occ)) [:teeth :channels [:geom :pts]])
|
|
inside (:store occ)))))
|
|
;; They are dropped anyway — :mouth-in drew nothing to clip them against.
|
|
(is (not (contains? (occ-at inside) :mouth-in)))
|
|
(is (not (contains? (occ-at inside) :teeth)))
|
|
;; And the same articulation outside the gap still draws them.
|
|
(is (contains? (occ-at outside) :teeth)))
|
|
(is (empty? (clip/problems (:clip occ))))))
|
|
|
|
(deftest an-undetected-frame-has-no-pose-at-all
|
|
;; A subject that was not on the frame has NO VALUE, which is different from a
|
|
;; part being switched off. The mask lands on every block of the freeze, so an
|
|
;; absent frame takes the head's transform with it — and a node with no
|
|
;; transform gives its children nowhere to be, so the whole face goes.
|
|
(let [gap (set (range 40 60))
|
|
det (mapv #(not (contains? gap %)) (range take/frames))
|
|
c (freeze/clip (assoc take/params :name "gappy")
|
|
{:face-1 (assoc @take/measured :detected det)})
|
|
sym (face-symbol (:clip c))
|
|
res (symbol/resolver sym (:store c) pal/index-of nil)]
|
|
(doseq [f [39 40 50 59 60]]
|
|
(let [ops (res f)]
|
|
(if (contains? gap f)
|
|
(is (empty? ops) (str "frame " f " is absent and drew " (count ops) " ops"))
|
|
(is (seq ops) (str "frame " f " is present and drew nothing")))))
|
|
;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is
|
|
;; unchanged across the gap, because hiding and absence are different
|
|
;; questions with different answers.
|
|
(is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) % nil)
|
|
(range take/frames))
|
|
(mapv #(ch/value-at (chan :mouth-in [:vis]) % nil) (range take/frames))))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; the rings are still rings
|
|
|
|
(deftest a-frozen-ring-is-simple-at-every-vertex-budget
|
|
;; Because hold parts CUT between poses rather than interpolating, a ring whose
|
|
;; vertex order is wrong renders as blocks meeting at corners rather than as an
|
|
;; error. It is invisible at odd vertex counts and obvious at even ones, so it
|
|
;; needs an assertion rather than an eyeball — and the subsample is the one
|
|
;; operation in the freeze that could reorder a traversal.
|
|
(doseq [verts [4 6 8 10 16 20]
|
|
which [:outer :inner]]
|
|
(let [flat (freeze/rings->flat (get @take/measured which) verts)
|
|
bad (first (for [f (range 0 take/frames 3)
|
|
:let [r (mapv (fn [k] {:x (nth (nth flat f) (* 2 k))
|
|
:y (nth (nth flat f) (inc (* 2 k)))})
|
|
(range verts))
|
|
hits (ring/self-intersections r)]
|
|
:when (seq hits)]
|
|
{:verts verts :ring which :frame f :edges (first hits)}))]
|
|
(is (nil? bad) (str "self-intersection: " (pr-str bad))))))
|
|
|
|
(deftest an-odd-vertex-budget-is-refused
|
|
;; It lands off the cardinal slots, and it is the one setting at which the
|
|
;; simplicity assertion above stops protecting anything.
|
|
(doseq [bad [3 5 7 2 22 8.5]]
|
|
(is (thrown-with-msg? ExceptionInfo #"vertex budget"
|
|
(freeze/rings->flat (:outer @take/measured) bad))
|
|
(str bad " was accepted"))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; it draws, and it moves
|
|
|
|
(deftest the-take-draws-something-on-every-frame
|
|
(doseq [f (range 0 take/frames 5)]
|
|
(let [n (drawn (render @clip* f))]
|
|
(is (> n 200) (str "frame " f " drew only " n " pixels")))))
|
|
|
|
(deftest the-mouth-moves
|
|
;; The synth holds each pose for nine frames in a four-beat cycle, so frames
|
|
;; from different beats are genuinely different mouths and frames inside one
|
|
;; beat are not. This is the numeric half of step 5's done-criterion; the other
|
|
;; half is a picture and lives in test/browser/take.mjs.
|
|
(let [locked (freeze/head-mode {:trace {:origin :start}} @frozen)
|
|
shot (fn [f]
|
|
(let [r (raster/make W H)
|
|
mouth (filter #(= [:face-1 :mouth] (:node %))
|
|
((clip/resolver locked :main @store pal/index-of nil) f))]
|
|
(raster/clear! r (get pal/index-of :bg))
|
|
(raster/draw-ops! r mouth)
|
|
(vec (array-seq (:buf r)))))
|
|
differ (fn [a b] (count (remove true? (map = a b))))]
|
|
;; Beat 1 is wide open and beat 3 is shut. Compare only the mouth outline:
|
|
;; eyes and brows added in step 7 have their own motion within the beat.
|
|
(is (> (differ (shot 10) (shot 28)) 300)
|
|
"the open and the shut mouth rasterise the same")
|
|
;; And within a beat, on the exposure grid, it holds.
|
|
(is (= (shot 10) (shot 10)))
|
|
(is (< (differ (shot 10) (shot 12)) 200)
|
|
"a held pose is moving more than the detector noise it should have lost"))
|
|
;; As filmed, the head carries it around the stage as well.
|
|
(let [filmed (freeze/head-mode {} @frozen)]
|
|
(is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300)
|
|
"the head does not move across the take")))
|