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

Symbols, not timelines; no symbol is special

Browse source 
Everything that holds nodes is a symbol (domain/timeline -> domain/symbol,
:timelines -> :symbols) and a node that places one is :kind :instance. The
reserved :main root is gone: which symbol is on screen is editor state
([:ui :open]), every domain function that needs a symbol is told which, and
a document opens on the longest symbol nothing else places.

Saved projects move to schema 2 through migration 0007, which rewrites leaf
paths, instance kinds and the feature :symbol key; the client refuses a
schema it does not read.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-29 12:46:42 -04:00
parent 179770d7d4
commit 5dff490162
61 changed files with 1587 additions and 1431 deletions
Download patch file Download diff file Expand all files Collapse all files

6
frontend/test/arthur/bench_test.cljs
View file

@ -13,7 +13,7 @@
[arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.timeline :as timeline]))
[arthur.domain.symbol :as symbol]))
(defn- ms [label n f]
(let [t0 (js/Date.now)]
@ -24,11 +24,11 @@
(/ dt n))))
(deftest bench
(let [res (timeline/resolver (clip/root @swarm/clip) @swarm/store pal/index-of)
(let [res (symbol/resolver (clip/symbol @swarm/clip :main) @swarm/store pal/index-of)
ras (raster/make 320 200)
dest (js/Uint8ClampedArray. (* 320 200 4))
n 120]
(println "\nswarm:" (count (clip/nodes @swarm/clip)) "nodes")
(println "\nswarm:" (count (:nodes (clip/symbol @swarm/clip :main))) "nodes")
(let [a (ms "resolve " n (fn [i] (res (mod i 229))))
b (ms "resolve+draw " n (fn [i]
(raster/clear! ras 0)

4
frontend/test/arthur/domain/feature_test.cljs
View file

@ -11,14 +11,14 @@
{:subjects (into {} (map (fn [id] [id {:id id :params {}}]) people))
:features (into {} (map-indexed (fn [i id]
[id {:id id :subject (nth people (quot i 2))
:timeline (nth people (quot i 2))
:symbol (nth people (quot i 2))
:area :eye :nodes [] :params {}}]) eyes))
:groups (into {} (map-indexed (fn [i ids]
(let [id (keyword (str "pair-" i))]
[id {:id id :kind :eye-pair
:subject (nth people i)
:members ids :params {}}])) members))
:timelines (into {} (map (fn [id]
:symbols (into {} (map (fn [id]
[id {:id id :frames 1
:nodes {:head {:id :head :kind :group :z "a1"
:measured {[:xform :rot]

236
frontend/test/arthur/domain/instance_test.cljs Normal file
View file

@ -0,0 +1,236 @@
(ns arthur.domain.instance-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.stage :as stage]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]))
(def source
{:name "source" :fps 30 :width 320 :height 200
:symbols
{:main {:id :main :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
2 [20 0] 3 [30 0]})
[:geom :size] (ch/framed 4)
[:style :color] (ch/framed :brow)}}}}}})
(deftest two-instances-own-their-frame-and-placement
(let [document
(-> source
(assoc-in [:symbols :main]
{:id :main :frames 6
:nodes {:root {:id :root :kind :group :z "a1"}
:left {:id :left :kind :instance :of :sym/test
:parent :root :z "a1" :span [0 4]
:channels {[:xform :pos] (ch/framed [100 50])}}
:right {:id :right :kind :instance :of :sym/test
:parent :root :z "a2" :span [2 6]
:time {:mode :map :at 2 :in 0 :rate 1}
:channels {[:xform :pos] (ch/framed [120 50])}}}})
(assoc-in [:symbols :sym/test]
(assoc (get-in source [:symbols :main]) :id :sym/test)))
resolve (clip/resolver document nil pal/index-of :main)
at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
(is (empty? (clip/problems document)))
(is (= [[[:left :mark] 110]] (at 1)))
(is (= [[[:left :mark] 120] [[:right :mark] 120]] (at 2)))
(is (= [[[:right :mark] 150]] (at 5)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(deftest a-placement-holds-and-cuts-each-generated-shape-independently
(let [values (js/Int16Array. (clj->js (range 2 32)))
visible (ch/keyed {0 true 20 true 21 false})
dense {:animated? true :interp :hold
:dense {:store "sizes" :offset 0 :stride 1 :frames 30}
:pose-sampled? true}
shape (fn [id z group]
{:id id :kind :rect :parent :root :z z :pose-group group
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]})
[:geom :size] dense
[:vis] (assoc visible :pose-sampled? true)
[:style :color] (ch/framed :brow)}})
symbol {:id :sym/poses :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:mouth (shape :mouth "a1" :mouth)
:mouth-detail (shape :mouth-detail "a2" :mouth)
:eye (shape :eye "a3" :eye)
:brow (shape :brow "a4" :brow)}}
document {:fps 30 :width 320 :height 200
:symbols
{:main {:id :main :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:first {:id :first :kind :instance :of :sym/poses
:parent :root :z "a1"
:playback {:tracks {:mouth {0 0, 8 20, 9 21}
[:node :mouth-detail] {0 0, 8 4}
:eye {0 0, 4 4}}}}
:second {:id :second :kind :instance :of :sym/poses
:parent :root :z "a2"
:playback {:tracks {:mouth {0 0, 8 8}}}}}}
:sym/poses symbol}}
resolve (clip/resolver document {"sizes" {:data values}} pal/index-of :main)
low-resolve (clip/resolver document {"sizes" {:data values}}
pal/index-of :main {:picture-fps 8})
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))
low-at (fn [f] (into {} (map (fn [op] [(:node op) op])) (low-resolve f)))]
(is (empty? (clip/problems document)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (= 2 (:size (get (at 7) [:first :mouth]))) "eight static frames")
(is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20")
(is (= 6 (:size (get (at 8) [:first :mouth-detail])))
"one node may depart from its shared mouth group")
(is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8")
(is (= 6 (:size (get (at 7) [:first :eye]))) "eye has its own timing")
(is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time")
(is (nil? (get (at 9) [:first :mouth]))
"generated visibility is read from the same selected pose")
(is (some? (get (at 9) [:second :mouth])))
(is (= 5 (:size (get (low-at 7) [:first :brow])))
"picture rate samples only generated motion")
(is (= 22 (:size (get (low-at 8) [:first :mouth])))
"an explicit cut occurs at its exact local frame, even off the picture grid")
(is (= 8 (:cx (get (low-at 8) [:first :eye])))
"authored position ignores the picture grid")
(let [sym (get-in document [:symbols :sym/poses])
opts {:source-fps 30 :picture-fps 8}]
(is (= (mapv #(select-keys % [:node :cx :size])
(symbol/eval-frame sym 8 {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts))
(mapv #(select-keys % [:node :cx :size])
((symbol/resolver sym {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts) 8)))
"pure evaluation and playback apply the same pose choice"))))
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
(let [document (-> source
(assoc-in [:symbols :main :nodes :placed]
{:id :placed :kind :instance :of :sym/test :parent :root
:z "a2"})
(assoc-in [:symbols :sym/test]
{:id :sym/test :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root
:z "a1" :pose-group :mark
:channels {[:geom :size]
{:animated? true :interp :hold
:keys {0 2 1 3 2 4 3 5}
:pose-sampled? true}}}}})
(pose/put-cut :main :placed :mark 2 3))
cuts (get-in document [:symbols :main :nodes :placed :playback :tracks :mark])]
(is (= {2 3} cuts))
(is (= 1 (pose/source-frame (pose/prepare {:mark cuts}) :mark 1 1))
"before the first cut, dense motion continues")
(is (= 3 (pose/source-frame (pose/prepare {:mark cuts}) :mark 2 2)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (nil? (get-in (pose/remove-cut document :main :placed :mark 2)
[:symbols :main :nodes :placed :playback :tracks :mark])))
(is (seq (clip/problems (assoc-in document
[:symbols :main :nodes :placed :playback :tracks :mark]
{4 3}))))))
(defn- uuid-of
"The uuid the layout authors for the placement whose handle is `id`.
Read out of `stage/layout` rather than written here as a literal: what this test
is about is the mapping `compose` performs, and nine copied uuids would assert
that someone copied them correctly."
[id]
(or (->> (concat (:instances stage/layout) (:audio stage/layout))
(some (fn [p] (when (= id (:id p)) (:uuid p)))))
(throw (ex-info "no such placement in the layout" {:id id}))))
(defn- placement
"The composed node for the placement the layout calls `id`."
[document id]
(get-in document [:symbols :main :nodes (uuid-of id)]))
(deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)]
(is (empty? (clip/problems document)))
(is (= #{:main :sym/face-8625} (set (keys (:symbols document)))))
(is (= :sym/face-8625 (:of (placement document :left))))
(is (= :sym/face-8625 (:of (placement document :right))))
(testing "every placement is keyed by its own uuid"
;; The identity change: seven placements of one drawing are seven things,
;; and each is named by something that means only itself. Sharing a key, or
;; keying by a description of where a thing sits, is what this rules out.
(let [symbols (filter (comp #{:instance} :kind val)
(get-in document [:symbols :main :nodes]))]
(is (= 7 (count symbols)))
(is (every? uuid? (map key symbols)))
(is (= 7 (count (distinct (map key symbols)))))
(testing "and each still says which drawing it plays and what to call it"
(is (every? #(= :sym/face-8625 (:of (val %))) symbols))
(is (every? #(string? (:name (val %))) symbols))
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :instance (:kind %))
(vals (get-in document [:symbols :main :nodes]))))))
(is (= [48 280] (:span (placement document :right))))
(let [left (placement document :left)
scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0)]
(is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0)))
(is (= [0.56 0.56] (ch/value-at scale 12)))
(is (= [0.52 0.52] (ch/value-at scale 48)))
(doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f) [0 0] anchor)
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales"))))
(testing "the editorial link resolves to the placement's uuid"
;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
;; resolves to a node at all; this checks it resolves to the RIGHT one.
(is (= (uuid-of :right) (:linked-to (placement document :voice-right))))
(is (uuid? (:linked-to (placement document :voice-right)))))
(is (= [48 260] (:span (placement document :voice-right))))
(is (= 0.5 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :gain]]) 54)))
(is (< -0.8 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :pan]]) 110) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
[]
(-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol :outer :inner 5 (random-uuid) [0 0])))
(deftest no-symbol-is-special
(let [c (nested)]
(testing "a document opens on the longest symbol nothing places"
(is (= [:loose :main :outer] (clip/unplaced c)))
(is (= :outer (clip/opens-on c)))
(is (= :main (clip/opens-on (clip/blank)))))
(testing "an instance can go into any symbol, and spans that symbol's frames"
(let [[n] (vals (get-in c [:symbols :outer :nodes]))]
(is (= :inner (:of n)))
(is (= [5 15] (:span n)) "as long as what it places, not as the space it is in")))
(testing "placing is refused when it would make a cycle"
(is (clip/contains-symbol? c :outer :inner))
(is (not (clip/contains-symbol? c :inner :outer)))
(is (= c (clip/place-symbol c :inner :outer 0 (random-uuid) [0 0]))
"outer inside inner, which is inside outer")
(is (= c (clip/place-symbol c :inner :inner 0 (random-uuid) [0 0]))
"a symbol inside itself"))
(testing "and the result is a valid document whose instance saves"
(is (empty? (clip/problems c)))
(is (= (get-in c [:symbols :outer :nodes])
(get-in (leaf/clip "c" (leaf/leaves "c" c)) [:symbols :outer :nodes]))))))

50
frontend/test/arthur/domain/leaf_test.cljs
View file

@ -6,7 +6,7 @@
So the assertion is exact equality on the real clips — the frozen take in both
head modes, the hand-written demo, the swarm — rather than on a fixture, and
`clip/clip-keys` plus `timeline/timeline-keys` make a field added without a leaf
`clip/clip-keys` plus `symbol/symbol-keys` make a field added without a leaf
fail loudly instead."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo :as demo]
@ -16,11 +16,11 @@
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]))
(defn- one-timeline
(defn- one-symbol
"A minimal clip holding one timeline of these nodes, for the cases that are
about a path rather than about a take."
[nodes]
{:timelines {:main {:id :main :frames 1 :nodes nodes}}})
{:symbols {:main {:id :main :frames 1 :nodes nodes}}})
(deftest every-real-clip-survives-the-split-exactly
(doseq [[label c] [["the frozen take" @take/clip]
@ -37,20 +37,20 @@
(is (contains? ls "clip/c7/source"))
;; A TIMELINE ID IS A SEGMENT, which is what lets a symbol's nodes be
;; addressed by the same path shape as the clip's own. `main` is the root.
(is (contains? ls "clip/c7/timeline/main"))
(is (= {:frames 229} (get ls "clip/c7/timeline/main"))
(is (contains? ls "clip/c7/symbol/main"))
(is (= {:frames 229} (get ls "clip/c7/symbol/main"))
"a timeline's leaf is its frame space; :fps is the clip's")
;; Nodes are local to the face timeline; feature and group ids are clip-wide.
(is (contains? ls "clip/c7/timeline/face-1/node/mouth"))
(is (contains? ls "clip/c7/timeline/face-1/channel/mouth/geom.pts"))
(is (contains? ls "clip/c7/timeline/face-1/channel/mouth-in/vis"))
(is (contains? ls "clip/c7/symbol/face-1/node/mouth"))
(is (contains? ls "clip/c7/symbol/face-1/channel/mouth/geom.pts"))
(is (contains? ls "clip/c7/symbol/face-1/channel/mouth-in/vis"))
(is (contains? ls "clip/c7/feature/face-1~eye-r"))
(is (contains? ls "clip/c7/group/face-1~eyes"))
(is (contains? ls "clip/c7/subject/face-1"))
;; A head's measured channels are written together by a freeze and replaced
;; together by a re-freeze, so they are one leaf and not three.
(is (contains? ls "clip/c7/timeline/face-1/measured/head"))
(is (= 3 (count (get ls "clip/c7/timeline/face-1/measured/head"))))
(is (contains? ls "clip/c7/symbol/face-1/measured/head"))
(is (= 3 (count (get ls "clip/c7/symbol/face-1/measured/head"))))
;; :frames is NOT in `timing` any more. A timeline is a frame space and a clip
;; is a rate, so the one leaf that held both was the persistence half of the
;; conflation `domain/clip` exists to undo.
@ -60,11 +60,11 @@
;; The boundary that lets two people key different parts without meeting. A node
;; leaf carries structure and no geometry.
(let [ls (leaf/leaves :c1 @take/clip)
n (get ls "clip/c1/timeline/face-1/node/mouth")]
n (get ls "clip/c1/symbol/face-1/node/mouth")]
(is (= {:id :mouth :name "mouth" :kind :poly :parent :head
:z "a1" :pose-group :mouth} n))
(is (nil? (:channels n)))
(is (:animated? (get ls "clip/c1/timeline/face-1/channel/mouth/geom.pts")))))
(is (:animated? (get ls "clip/c1/symbol/face-1/channel/mouth/geom.pts")))))
(deftest a-field-with-no-leaf-is-refused-rather-than-dropped
;; The invariant that keeps the round trip exact as the model grows: a field
@ -74,7 +74,7 @@
(leaf/leaves :c1 (assoc @take/clip :sequences []))))
(is (thrown-with-msg? ExceptionInfo #"no leaf to save it in"
(leaf/leaves :c1 (assoc-in @take/clip
[:timelines :main :markers] []))))
[:symbols :main :markers] []))))
(is (= clip/clip-keys (set (keys (assoc @take/clip :name "x"))))
"clip-keys has drifted from what a frozen clip actually holds"))
@ -86,16 +86,16 @@
(is (not (contains? ls "clip/c1/source")))
(is (not (contains? (leaf/clip :c1 ls) :analysis)))
(is (not (contains? (get-in (leaf/clip :c1 ls)
[:timelines :main :nodes :root])
[:symbols :main :nodes :root])
:channels)))))
(deftest a-namespaced-id-is-one-path-segment
;; docs/architecture.md draws a node as `:eye-r/iris`, and a leaf path is
;; "/"-delimited, so the two have to be reconciled somewhere.
(let [c (one-timeline {:eye-r/iris {:id :eye-r/iris :kind :disc :parent nil :z "a1"
(let [c (one-symbol {:eye-r/iris {:id :eye-r/iris :kind :disc :parent nil :z "a1"
:channels {[:geom :radius] (ch/framed 2)}}})
ls (leaf/leaves :c1 c)]
(is (contains? ls "clip/c1/timeline/main/node/eye-r~iris"))
(is (contains? ls "clip/c1/symbol/main/node/eye-r~iris"))
(is (= c (leaf/clip :c1 ls))))
;; `(keyword "a~b")` rather than a literal: ~ is unquote in CLJS source.
(is (thrown-with-msg? ExceptionInfo #"cannot contain ~"
@ -109,13 +109,13 @@
;; right in a log and resolves nothing: `:linked-to` dangles and an export target
;; matches no node, with no error anywhere.
(let [u #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
c (one-timeline {u {:id u :kind :symbol :of :sym/face-8625 :parent nil
c (one-symbol {u {:id u :kind :instance :of :sym/face-8625 :parent nil
:z "a1" :name "8625 bottom left"}})
ls (leaf/leaves :c1 c)]
(is (contains? ls (str "clip/c1/timeline/main/node/" u))
(is (contains? ls (str "clip/c1/symbol/main/node/" u))
"written plainly, with no sigil")
(is (= c (leaf/clip :c1 ls)))
(is (uuid? (first (keys (get-in (leaf/clip :c1 ls) [:timelines :main :nodes])))))))
(is (uuid? (first (keys (get-in (leaf/clip :c1 ls) [:symbols :main :nodes])))))))
(deftest only-a-whole-canonical-uuid-reads-as-one
;; The id encoding decides by SHAPE, so the boundaries of that shape are the
@ -155,24 +155,24 @@
(is (empty? (leaf/problems (leaf/leaves :c1 @take/locked)))))
(deftest a-channel-leaf-for-a-node-that-is-not-there-is-named
(let [ls (dissoc (leaf/leaves :c1 @take/clip) "clip/c1/timeline/face-1/node/mouth")]
(let [ls (dissoc (leaf/leaves :c1 @take/clip) "clip/c1/symbol/face-1/node/mouth")]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-node-leaf-is-scoped-to-its-own-timeline
(deftest a-node-leaf-is-scoped-to-its-own-symbol
;; The reason the node index in `problems` is keyed by (clip, timeline, node)
;; rather than by node alone: two timelines may each hold a `:mouth`, and a
;; channel of one is not a channel of the other. Keyed by node alone, deleting
;; the root's node leaf would have been excused by the symbol's.
(let [ls (-> (leaf/leaves :c1 @take/clip)
(assoc "clip/c1/timeline/sym~blink" {:frames 3}
"clip/c1/timeline/sym~blink/node/mouth"
(assoc "clip/c1/symbol/sym~blink" {:frames 3}
"clip/c1/symbol/sym~blink/node/mouth"
{:id :mouth :kind :poly :parent nil :z "a1"})
(dissoc "clip/c1/timeline/face-1/node/mouth"))]
(dissoc "clip/c1/symbol/face-1/node/mouth"))]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-property-with-path-punctuation-in-it-is-refused
(is (thrown-with-msg?
ExceptionInfo #"cannot contain . or /"
(leaf/leaves :c1 (one-timeline
(leaf/leaves :c1 (one-symbol
{:a {:id :a :kind :poly :parent nil :z "a1"
:channels {[:geom :pts.x] (ch/framed [0 0])}}})))))

2
frontend/test/arthur/domain/node_test.cljs
View file

@ -174,7 +174,7 @@
(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 :instance :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"

22
frontend/test/arthur/domain/paint_test.cljs
View file

@ -4,22 +4,22 @@
[arthur.domain.channel :as channel]
[arthur.domain.leaf :as leaf]
[arthur.domain.paint :as paint]
[arthur.domain.timeline :as timeline]))
[arthur.domain.symbol :as symbol]))
(defn- geometry [clip]
(get-in clip [:timelines :main :nodes :paint-test :channels paint/geometry]))
(get-in clip [:symbols :main :nodes :paint-test :channels paint/geometry]))
(deftest drawing-keys-hold-and-tween-on-the-timeline-clock
(deftest drawing-keys-hold-and-tween-on-the-symbol-clock
(let [a [10 10 30 10 20 30]
c0 (paint/new-shape demo/clip :paint-test 3 a :brow)
c1 (paint/add-key c0 :paint-test 9)
c2 (paint/set-vertex c1 :paint-test 9 0 [22 10])
c3 (paint/add-key c2 :paint-test 15)
c4 (paint/set-vertex c3 :paint-test 15 0 [34 10])
c0 (paint/new-shape demo/clip :main :paint-test 3 a :brow)
c1 (paint/add-key c0 :main :paint-test 9)
c2 (paint/set-vertex c1 :main :paint-test 9 0 [22 10])
c3 (paint/add-key c2 :main :paint-test 15)
c4 (paint/set-vertex c3 :main :paint-test 15 0 [34 10])
held (geometry c4)
mixed-clip (paint/set-segment-interp c4 :paint-test 9 :linear)
mixed-clip (paint/set-segment-interp c4 :main :paint-test 9 :linear)
mixed (geometry mixed-clip)]
(is (= [3 229] (get-in c2 [:timelines :main :nodes :paint-test :span])))
(is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span])))
(is (= a (channel/value-at held 8)))
(is (= 10 (first (channel/value-at held 8))))
(is (= 22 (first (channel/value-at held 9))))
@ -28,5 +28,5 @@
(is (empty? (channel/problems mixed)))
;; The demo's root is exposed on 2s. Paint at frame 3 must still appear at 3.
(is (some #(= :paint-test (:node %))
(timeline/eval-frame (get-in c2 [:timelines :main]) 3)))
(symbol/eval-frame (get-in c2 [:symbols :main]) 3)))
(is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))

20
frontend/test/arthur/domain/project_test.cljs
View file

@ -22,11 +22,11 @@
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.project :as project]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[arthur.flow.freeze :as freeze]
[arthur.support.ops :as ops]))
(defn- face-timeline [c] (clip/timeline c :face-1))
(defn- face-symbol [c] (clip/symbol c :face-1))
(defn- wired
"A clip out and back, over a wire that is really only JSON."
@ -37,7 +37,7 @@
(def ^:private after (delay (wired :c1 @before)))
(deftest what-comes-back-is-a-valid-clip
;; `clip/problems` and not `timeline/problems`: the round trip has to preserve
;; `clip/problems` and not `symbol/problems`: the round trip has to preserve
;; the tracking identities and the timeline map as well as the nodes, and only
;; the clip-level check looks at those.
(let [ps (clip/problems (:clip @after))]
@ -53,14 +53,14 @@
;; The assertion. Both evaluators, both scenes, every frame order — so a block
;; that came back with its offsets shifted, or a cursor that seeks differently
;; over a rebuilt key map, has nowhere to hide.
(let [n (clip/frames (:clip @before))
(let [n (clip/frames (:clip @before) :main)
paths {"specification" [ops/specified ops/specified]
"playback" [ops/resolved ops/resolved]
"spec vs playback, after" [ops/specified ops/resolved]}]
(doseq [[label [f g]] paths
[order fs] (ops/orders n)]
(let [a (f (face-timeline (:clip @before)) (:store @before))
b (g (face-timeline (:clip @after)) (:store @after))]
(let [a (f (face-symbol (:clip @before)) (:store @before))
b (g (face-symbol (:clip @after)) (:store @after))]
(testing (str label ", " order)
(doseq [frame fs]
(is (= (a frame) (b frame))
@ -84,8 +84,8 @@
;; everything above and lose the locked take's identity transform.
(let [locked {:clip @take/locked :store @take/store}
back (wired :c1 locked)
a (ops/resolved (face-timeline (:clip locked)) (:store locked))
b (ops/resolved (face-timeline (:clip back)) (:store back))]
a (ops/resolved (face-symbol (:clip locked)) (:store locked))
b (ops/resolved (face-symbol (:clip back)) (:store back))]
(is (= (:clip locked) (:clip back)))
(doseq [frame (range 0 take/frames 7)]
(is (= (a frame) (b frame)) (str "frame " frame)))))
@ -116,7 +116,7 @@
(deftest an-absence-mask-survives-the-wire
(let [back (wired :c1 @gappy)
at (fn [entry id path f]
(ch/value-at (get-in (:nodes (face-timeline (:clip entry))) [id :channels path])
(ch/value-at (get-in (:nodes (face-symbol (:clip entry))) [id :channels path])
f (:store entry)))
;; Every dense track of the eye, iris, brow and brow-position blocks, and
;; the feature whose gap it must follow — the same table
@ -147,7 +147,7 @@
;; frame rather than hidden, and its partner is not.
(let [back (wired :c1 @gappy)
drawn (into #{} (map :node)
((timeline/resolver (face-timeline (:clip back)) (:store back)) 12))]
((symbol/resolver (face-symbol (:clip back)) (:store back)) 12))]
(is (not (contains? drawn :eye-r)))
(is (contains? drawn :eye-l))
(is (contains? drawn :mouth))))

576
frontend/test/arthur/domain/symbol_test.cljs
View file

@ -1,205 +1,397 @@
(ns arthur.domain.symbol-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.stage :as stage]
[arthur.demo :as demo]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]
[arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]))
[arthur.domain.raster :as raster]
[arthur.domain.clip :as clip]
[arthur.domain.symbol :as symbol]
[arthur.support.ops :as ops]))
(def source
{:name "source" :fps 30 :width 320 :height 200
:timelines
{:main {:id :main :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
2 [20 0] 3 [30 0]})
[:geom :size] (ch/framed 4)
[:style :color] (ch/framed :brow)}}}}}})
(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))
(deftest two-instances-own-their-frame-and-placement
(let [document
(-> source
(assoc-in [:timelines :main]
{:id :main :frames 6
:nodes {:root {:id :root :kind :group :z "a1"}
:left {:id :left :kind :symbol :of :sym/test
:parent :root :z "a1" :span [0 4]
:channels {[:xform :pos] (ch/framed [100 50])}}
:right {:id :right :kind :symbol :of :sym/test
:parent :root :z "a2" :span [2 6]
:time {:mode :map :at 2 :in 0 :rate 1}
:channels {[:xform :pos] (ch/framed [120 50])}}}})
(assoc-in [:timelines :sym/test]
(assoc (get-in source [:timelines :main]) :id :sym/test)))
resolve (clip/resolver document nil)
at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
(is (empty? (clip/problems document)))
(is (= [[[:left :mark] 110]] (at 1)))
(is (= [[[:left :mark] 120] [[:right :mark] 120]] (at 2)))
(is (= [[[:right :mark] 150]] (at 5)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- sc [& nodes]
{:nodes (into {} (map (juxt :id identity)) nodes)})
(deftest a-placement-holds-and-cuts-each-generated-shape-independently
(let [values (js/Int16Array. (clj->js (range 2 32)))
visible (ch/keyed {0 true 20 true 21 false})
dense {:animated? true :interp :hold
:dense {:store "sizes" :offset 0 :stride 1 :frames 30}
:pose-sampled? true}
shape (fn [id z group]
{:id id :kind :rect :parent :root :z z :pose-group group
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]})
[:geom :size] dense
[:vis] (assoc visible :pose-sampled? true)
[:style :color] (ch/framed :brow)}})
symbol {:id :sym/poses :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:mouth (shape :mouth "a1" :mouth)
:mouth-detail (shape :mouth-detail "a2" :mouth)
:eye (shape :eye "a3" :eye)
:brow (shape :brow "a4" :brow)}}
document {:fps 30 :width 320 :height 200
:timelines
{:main {:id :main :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:first {:id :first :kind :symbol :of :sym/poses
:parent :root :z "a1"
:playback {:tracks {:mouth {0 0, 8 20, 9 21}
[:node :mouth-detail] {0 0, 8 4}
:eye {0 0, 4 4}}}}
:second {:id :second :kind :symbol :of :sym/poses
:parent :root :z "a2"
:playback {:tracks {:mouth {0 0, 8 8}}}}}}
:sym/poses symbol}}
resolve (clip/resolver document {"sizes" {:data values}})
low-resolve (clip/resolver document {"sizes" {:data values}}
pal/index-of :main {:picture-fps 8})
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))
low-at (fn [f] (into {} (map (fn [op] [(:node op) op])) (low-resolve f)))]
(is (empty? (clip/problems document)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (= 2 (:size (get (at 7) [:first :mouth]))) "eight static frames")
(is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20")
(is (= 6 (:size (get (at 8) [:first :mouth-detail])))
"one node may depart from its shared mouth group")
(is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8")
(is (= 6 (:size (get (at 7) [:first :eye]))) "eye has its own timing")
(is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time")
(is (nil? (get (at 9) [:first :mouth]))
"generated visibility is read from the same selected pose")
(is (some? (get (at 9) [:second :mouth])))
(is (= 5 (:size (get (low-at 7) [:first :brow])))
"picture rate samples only generated motion")
(is (= 22 (:size (get (low-at 8) [:first :mouth])))
"an explicit cut occurs at its exact local frame, even off the picture grid")
(is (= 8 (:cx (get (low-at 8) [:first :eye])))
"authored position ignores the picture grid")
(let [tl (get-in document [:timelines :sym/poses])
opts {:source-fps 30 :picture-fps 8}]
(is (= (mapv #(select-keys % [:node :cx :size])
(timeline/eval-frame tl 8 {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts))
(mapv #(select-keys % [:node :cx :size])
((timeline/resolver tl {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts) 8)))
"pure evaluation and playback apply the same pose choice"))))
(defn- ids-at [scene f]
(mapv :node (symbol/eval-frame scene f)))
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
(let [document (-> source
(assoc-in [:timelines :main :nodes :placed]
{:id :placed :kind :symbol :of :sym/test :parent :root
:z "a2"})
(assoc-in [:timelines :sym/test]
{:id :sym/test :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root
:z "a1" :pose-group :mark
:channels {[:geom :size]
{:animated? true :interp :hold
:keys {0 2 1 3 2 4 3 5}
:pose-sampled? true}}}}})
(pose/put-cut :placed :mark 2 3))
cuts (get-in document [:timelines :main :nodes :placed :playback :tracks :mark])]
(is (= {2 3} cuts))
(is (= 1 (pose/source-frame (pose/prepare {:mark cuts}) :mark 1 1))
"before the first cut, dense motion continues")
(is (= 3 (pose/source-frame (pose/prepare {:mark cuts}) :mark 2 2)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (nil? (get-in (pose/remove-cut document :placed :mark 2)
[:timelines :main :nodes :placed :playback :tracks :mark])))
(is (seq (clip/problems (assoc-in document
[:timelines :main :nodes :placed :playback :tracks :mark]
{4 3}))))))
(def ^:private pts-of ops/points)
(defn- uuid-of
"The uuid the layout authors for the placement whose handle is `id`.
;; ---- structure ----
Read out of `stage/layout` rather than written here as a literal: what this test
is about is the mapping `compose` performs, and nine copied uuids would assert
that someone copied them correctly."
[id]
(or (->> (concat (:instances stage/layout) (:audio stage/layout))
(some (fn [p] (when (= id (:id p)) (:uuid p)))))
(throw (ex-info "no such placement in the layout" {:id id}))))
(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 (symbol/order (:nodes s))]
(is (= 0 (symbol/depth (:nodes s) :a)))
(is (= 2 (symbol/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))))))
(defn- placement
"The composed node for the placement the layout calls `id`."
[document id]
(get-in document [:timelines :main :nodes (uuid-of 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" (symbol/order (:nodes s))))
(is (seq (symbol/problems s)))))
(deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)]
(is (empty? (clip/problems document)))
(is (= #{:main :sym/face-8625} (set (keys (:timelines document)))))
(is (= :sym/face-8625 (:of (placement document :left))))
(is (= :sym/face-8625 (:of (placement document :right))))
(testing "every placement is keyed by its own uuid"
;; The identity change: seven placements of one drawing are seven things,
;; and each is named by something that means only itself. Sharing a key, or
;; keying by a description of where a thing sits, is what this rules out.
(let [symbols (filter (comp #{:symbol} :kind val)
(get-in document [:timelines :main :nodes]))]
(is (= 7 (count symbols)))
(is (every? uuid? (map key symbols)))
(is (= 7 (count (distinct (map key symbols)))))
(testing "and each still says which drawing it plays and what to call it"
(is (every? #(= :sym/face-8625 (:of (val %))) symbols))
(is (every? #(string? (:name (val %))) symbols))
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :symbol (:kind %))
(vals (get-in document [:timelines :main :nodes]))))))
(is (= [48 280] (:span (placement document :right))))
(let [left (placement document :left)
scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0)]
(is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0)))
(is (= [0.56 0.56] (ch/value-at scale 12)))
(is (= [0.52 0.52] (ch/value-at scale 48)))
(doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f) [0 0] anchor)
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales"))))
(testing "the editorial link resolves to the placement's uuid"
;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
;; resolves to a node at all; this checks it resolves to the RIGHT one.
(is (= (uuid-of :right) (:linked-to (placement document :voice-right))))
(is (uuid? (:linked-to (placement document :voice-right)))))
(is (= [48 260] (:span (placement document :voice-right))))
(is (= 0.5 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :gain]]) 54)))
(is (< -0.8 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :pan]]) 110) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(deftest a-missing-parent-is-named-rather-than-silently-orphaning
(let [s (sc {:id :a :kind :group :parent :nope :z "a1"})]
(is (seq (symbol/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 %)) (symbol/eval-frame s 0))))))
(is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/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 (symbol/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 (symbol/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 (symbol/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 (symbol/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] (->> (symbol/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 (symbol/eval-frame absent-pos 0 store))))
(is (= [] (mapv :node (symbol/eval-frame absent-pos 1 store)))
"an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (symbol/eval-frame absent-pts 0 store))))
(is (= [:teeth] (mapv :node (symbol/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 (symbol/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 disc-and-rect-extents-retain-precision-for-enclosing-instances
(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] (symbol/eval-frame s 0)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
(is (= 3.4 (: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.
;; The frame orders and the snapshot live in `arthur.support.ops`, because the
;; same comparison is what proves a scene survived the server — see
;; flow/project-test.
(let [s demo/main
spec (ops/specified s nil)
fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders (:frames s))]
(testing label
(doseq [f fs]
(is (= (spec f) (fast 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 (symbol/resolver demo/main)
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-clip-is-valid
;; `clip/problems` rather than `symbol/problems`: it checks the clip's fields,
;; the timeline map and the tracking identities as well as the nodes, so it is
;; the check a save would make.
(let [ps (clip/problems demo/clip)]
(is (empty? ps) (pr-str ps)))
(is (pos? demo/frames))
(testing "a clip is not a symbol, and handing one over fails loudly"
;; The mistake this split makes easy: both are maps with an :id, and the wrong
;; one resolves to no ops rather than to an error.
(is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/resolver demo/clip)))
(is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/eval-frame demo/clip 0)))))
(deftest the-hand-written-clip-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 (symbol/resolver demo/main)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
r))
frames (mapv render (range 0 demo/frames 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-clip-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 (symbol/resolver demo/main)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
(vec (array-seq (:buf r)))))]
(doseq [f (range 0 demo/frames 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-clip-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 (symbol/resolver demo/main)]
(doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/clip) (:height demo/clip))
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 (symbol/eval-frame s 0 nil day)))))
(is (= 17 (:color (first (symbol/eval-frame s 0 nil night)))))
(is (= 17 (:color (first ((symbol/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 (symbol/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 (symbol/eval-frame s 0 nil night)]
(is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in")))

397
frontend/test/arthur/domain/timeline_test.cljs
View file

@ -1,397 +0,0 @@
(ns arthur.domain.timeline-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.clip :as clip]
[arthur.domain.timeline :as timeline]
[arthur.support.ops :as ops]))
(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 (timeline/eval-frame scene f)))
(def ^:private pts-of ops/points)
;; ---- 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 (timeline/order (:nodes s))]
(is (= 0 (timeline/depth (:nodes s) :a)))
(is (= 2 (timeline/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" (timeline/order (:nodes s))))
(is (seq (timeline/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 (timeline/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 %)) (timeline/eval-frame s 0))))))
(is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (timeline/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 (timeline/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 (timeline/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 (timeline/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 (timeline/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] (->> (timeline/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 (timeline/eval-frame absent-pos 0 store))))
(is (= [] (mapv :node (timeline/eval-frame absent-pos 1 store)))
"an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (timeline/eval-frame absent-pts 0 store))))
(is (= [:teeth] (mapv :node (timeline/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 (timeline/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 disc-and-rect-extents-retain-precision-for-enclosing-instances
(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] (timeline/eval-frame s 0)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
(is (= 3.4 (: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.
;; The frame orders and the snapshot live in `arthur.support.ops`, because the
;; same comparison is what proves a scene survived the server — see
;; flow/project-test.
(let [s demo/timeline
spec (ops/specified s nil)
fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders (:frames s))]
(testing label
(doseq [f fs]
(is (= (spec f) (fast 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 (timeline/resolver demo/timeline)
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-clip-is-valid
;; `clip/problems` rather than `timeline/problems`: it checks the clip's fields,
;; the timeline map and the tracking identities as well as the nodes, so it is
;; the check a save would make.
(let [ps (clip/problems demo/clip)]
(is (empty? ps) (pr-str ps)))
(is (pos? demo/frames))
(testing "a clip is not a timeline, and handing one over fails loudly"
;; The mistake this split makes easy: both are maps with an :id, and the wrong
;; one resolves to no ops rather than to an error.
(is (thrown-with-msg? ExceptionInfo #"not a timeline"
(timeline/resolver demo/clip)))
(is (thrown-with-msg? ExceptionInfo #"not a timeline"
(timeline/eval-frame demo/clip 0)))))
(deftest the-hand-written-clip-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 (timeline/resolver demo/timeline)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
r))
frames (mapv render (range 0 demo/frames 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-clip-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 (timeline/resolver demo/timeline)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
(vec (array-seq (:buf r)))))]
(doseq [f (range 0 demo/frames 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-clip-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 (timeline/resolver demo/timeline)]
(doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/clip) (:height demo/clip))
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 (timeline/eval-frame s 0 nil day)))))
(is (= 17 (:color (first (timeline/eval-frame s 0 nil night)))))
(is (= 17 (:color (first ((timeline/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 (timeline/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 (timeline/eval-frame s 0 nil night)]
(is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in")))

46
frontend/test/arthur/events/export_test.cljs
View file

@ -5,7 +5,7 @@
is NAMESPACED (`:sym/face-8625`) and a placement's is a UUID, and the panel puts
both into `<option value>`s and reads them back out of a change event. Writing
that value with `name` drops the `sym`, the id comes back `:face-8625`, it
matches no key in `:timelines`, and `export/run!` throws from inside re-frame's
matches no key in `:symbols`, and `export/run!` throws from inside re-frame's
`:do-fx` where nothing catches it: `:busy?` latches on and the readout sits at
\"frame 0 /\" forever with nothing in the status line.
@ -17,12 +17,12 @@
(def ^:private a-uuid #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218")
(deftest every-kind-of-target-survives-the-round-trip
(doseq [t [{:timeline :main}
{:timeline :sym/face-8625}
{:timeline :main :isolate a-uuid}
{:timeline :sym/face-8625 :isolate a-uuid}]]
(doseq [t [{:symbol :main}
{:symbol :sym/face-8625}
{:symbol :main :isolate a-uuid}
{:symbol :sym/face-8625 :isolate a-uuid}]]
(let [back (export/target-id (export/target-value t))]
(is (= (:timeline t) (:timeline back))
(is (= (:symbol t) (:symbol back))
(str (pr-str t) " -> " (pr-str (export/target-value t))))
(is (= (:isolate t) (:isolate back)))
(testing "and a placement comes back a uuid, not a string or a keyword"
@ -31,15 +31,15 @@
(deftest the-value-keeps-the-namespace-and-marks-the-two-kinds
;; Spelled out, because these are the strings that end up in the DOM.
(is (= "t:main" (export/target-value {:timeline :main})))
(is (= "t:sym/face-8625" (export/target-value {:timeline :sym/face-8625})))
(is (= "s:main" (export/target-value {:symbol :main})))
(is (= "s:sym/face-8625" (export/target-value {:symbol :sym/face-8625})))
(is (= (str "n:main:" a-uuid)
(export/target-value {:timeline :main :isolate a-uuid}))))
(export/target-value {:symbol :main :isolate a-uuid}))))
(deftest a-whole-timeline-has-no-isolate
(deftest a-whole-symbol-has-no-isolate
;; Switching from a placement back to the clip must clear it, or the new target
;; would still be filtered down to one node that may not even be in it.
(is (nil? (:isolate (export/target-id "t:main")))))
(is (nil? (:isolate (export/target-id "s:main")))))
(deftest the-old-encoding-is-the-bug
;; A guard against someone "simplifying" this back to `name`. `name` is lossy on
@ -55,37 +55,37 @@
"A clip with one symbol in its library, placed twice, plus a decoy: a node that
is not a symbol must not show up as a face."
{:fps 30 :width 320 :height 200
:timelines
:symbols
{:main {:frames 280
:nodes {:root {:id :root :kind :group :z "a1"}
#uuid "22222222-2222-4222-8222-222222222222"
{:id #uuid "22222222-2222-4222-8222-222222222222"
:kind :symbol :of :sym/face :parent :root :z "a2"
:kind :instance :of :sym/face :parent :root :z "a2"
:name "8625 right"}
#uuid "11111111-1111-4111-8111-111111111111"
{:id #uuid "11111111-1111-4111-8111-111111111111"
:kind :symbol :of :sym/face :parent :root :z "a1"
:kind :instance :of :sym/face :parent :root :z "a1"
:name "8625 left"}
:a-rect {:id :a-rect :kind :rect :parent :root :z "a3"}}}
:sym/face {:frames 40 :nodes {:root {:id :root :kind :group :z "a1"}}}}})
(deftest the-picker-offers-the-clip-the-drawing-and-every-placement
(let [ts (export/targets clip)]
(is (= ["main (the clip)" "face" "8625 left" "8625 right"] (mapv :label ts))
"the clip, then the library, then the placements")
(testing "the placements isolate a node on :main and the library ones do not"
(deftest the-picker-offers-every-symbol-then-every-instance-in-the-open-one
(let [ts (export/targets clip :main)]
(is (= ["main" "face" "8625 left" "8625 right"] (mapv :label ts))
"every symbol, then the instances in the open one")
(testing "the instances isolate a node in the open symbol and the symbols do not"
(is (= [nil nil] (mapv :isolate (take 2 ts))))
(is (every? uuid? (mapv :isolate (drop 2 ts))))
(is (every? #(= :main (:timeline %)) (drop 2 ts))))
(is (every? #(= :main (:symbol %)) (drop 2 ts))))
(testing "ordered by label, because a uuid sorts at random"
(is (= ["8625 left" "8625 right"] (mapv :label (drop 2 ts)))))
(testing "and a node that is not a symbol is not a placement"
(testing "and a node that is not an instance is not offered"
(is (not-any? #{"a-rect"} (map :label ts))))))
(deftest every-offered-target-round-trips
;; The picker and the encoding asserted against each other, so neither can drift
;; into offering something that cannot be selected.
(doseq [t (export/targets clip)]
(let [norm #(merge {:isolate nil} (select-keys % [:timeline :isolate]))
(doseq [t (export/targets clip :main)]
(let [norm #(merge {:isolate nil} (select-keys % [:symbol :isolate]))
back (export/target-id (export/target-value t))]
(is (= (norm t) (norm back)) (pr-str t)))))

2
frontend/test/arthur/export/frames_test.cljs
View file

@ -144,7 +144,7 @@
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest a-silent-timeline-produces-no-wav
(deftest a-silent-symbol-produces-no-wav
(async done
(-> (run-default! {:n 2 :audio nil})
(.then (fn [{:keys [entries]}]

62
frontend/test/arthur/export_test.cljs
View file

@ -24,7 +24,7 @@
{:id id :kind :poly :z z
:channels {[:geom :pts] (ch/framed pts) [:style :color] (ch/framed color)}})
(defn- a-timeline
(defn- a-symbol
"One authored square under a `:root` group. Picture sampling now applies to
marked generated channels in the shared resolver, leaving this square alone."
[frames]
@ -37,7 +37,7 @@
matters is its frame space — so it is the smallest thing that resolves to an op."
[{:keys [frames fps w h] :or {frames 10 fps 24 w 8 h 6}}]
{:name "t" :fps fps :width w :height h
:timelines {clip/root-id (a-timeline frames)}})
:symbols {:main (a-symbol frames)}})
(defn- recorder
"An `Exporter` that records the calls rather than encoding anything.
@ -57,7 +57,7 @@
"Run an export over `clip`, returning a promise of the recorded log."
[clip & {:as opts}]
(let [log (atom {})]
(-> (export/run! (merge {:clip clip :timeline clip/root-id :store {}
(-> (export/run! (merge {:clip clip :symbol :main :store {}
:palette pal/index-of :ramp pal/rgb :zoom 1
:name "t"}
opts)
@ -68,7 +68,7 @@
;; ---- plan ----
(deftest plan-reports-what-the-export-will-be
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24 :w 320 :h 200}) :timeline clip/root-id :zoom 3})]
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24 :w 320 :h 200}) :symbol :main :zoom 3})]
(is (= 48 (:frames p)))
(is (= 24 (:fps p)))
(is (= 3 (:zoom p)))
@ -78,7 +78,7 @@
(deftest the-zoom-is-an-integer-of-at-least-one
;; Anything else resamples, and a zoom of 0 would be a zero-byte picture.
(let [zoom-of #(:zoom (export/plan {:clip (a-clip {}) :timeline clip/root-id :zoom %}))]
(let [zoom-of #(:zoom (export/plan {:clip (a-clip {}) :symbol :main :zoom %}))]
(is (= 2 (zoom-of 2.7)) "truncated, not rounded")
(is (= 1 (zoom-of 0)))
(is (= 1 (zoom-of -4)))
@ -90,19 +90,19 @@
;; 12fps picture rate it is still 48 frames and two seconds, holding 24 poses.
;; If :frames ever tracks :poses here, every export at a reduced picture rate
;; comes out half length with the audio sliding off it.
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :timeline clip/root-id
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :symbol :main
:picture-fps 12})]
(is (= 48 (:frames p)) "the frame count does not move")
(is (= 2 (:seconds p)) "and neither does the duration")
(is (= 24 (:poses p)) "but the picture holds half as many poses"))
(testing "a picture rate at or above the clip's rate changes nothing"
(doseq [fps [24 48 nil]]
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :timeline clip/root-id
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :symbol :main
:picture-fps fps})]
(is (= 48 (:poses p)) (str "picture-fps " fps))))))
(deftest plan-of-a-timeline-that-is-not-there-is-nothing
(is (nil? (export/plan {:clip (a-clip {}) :timeline :nope :zoom 1}))))
(deftest plan-of-a-symbol-that-is-not-there-is-nothing
(is (nil? (export/plan {:clip (a-clip {}) :symbol :nope :zoom 1}))))
;; ---- the walk ----
@ -176,25 +176,25 @@
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest exporting-a-timeline-that-is-not-there-is-an-error
(deftest exporting-a-symbol-that-is-not-there-is-an-error
;; And it names the timelines that ARE there, because the id came from a UI and
;; "no such timeline" alone does not say what went wrong.
(let [thrown (try (export/run! {:clip (a-clip {}) :timeline :nope :store {}
(let [thrown (try (export/run! {:clip (a-clip {}) :symbol :nope :store {}
:palette pal/index-of :ramp pal/rgb}
(recorder (atom {})) nil)
nil
(catch :default e e))]
(is (some? thrown) "it throws rather than resolving to an empty archive")
(is (= [clip/root-id] (:timelines (ex-data thrown))))))
(is (= [:main] (:symbols (ex-data thrown))))))
(deftest a-symbol-is-exported-by-being-rooted-at-its-own-frame-space
;; "Render that symbol" is rooting the resolver at it, so the walk's length is
;; the SYMBOL's frame count and not the clip's.
(async done
(let [c (assoc-in (a-clip {:frames 30})
[:timelines :sym]
(a-timeline 4))]
(-> (run!* c :timeline :sym)
[:symbols :sym]
(a-symbol 4))]
(-> (run!* c :symbol :sym)
(.then (fn [{:keys [frames spec]}]
(is (= 4 (count frames)) "the symbol's four frames, not the clip's 30")
(is (= 4 (:frames spec)))
@ -218,23 +218,23 @@
it needs no clock."
[& {:keys [voice?]}]
{:name "stage" :fps 30 :width 8 :height 6
:timelines
{clip/root-id
:symbols
{:main
{:frames 12
:nodes (cond-> {:root {:id :root :kind :group :z "a1"}
p1 {:id p1 :kind :symbol :of :sym/face :parent :root :z "a1"
p1 {:id p1 :kind :instance :of :sym/face :parent :root :z "a1"
:name "left" :channels {[:xform :pos] (ch/framed [0 0])}}
p2 {:id p2 :kind :symbol :of :sym/face :parent :root :z "a2"
p2 {:id p2 :kind :instance :of :sym/face :parent :root :z "a2"
:name "right" :channels {[:xform :pos] (ch/framed [4 0])}}
:loose (assoc (poly :loose "a4" [0 0 1 0 1 1] :brow)
:parent :root)}
voice? (assoc v1 {:id v1 :kind :audio :parent :root :z "a3"
:linked-to p1 :source {:footage "f"} :span [0 12]}))}
:sym/face (a-timeline 6)}})
:sym/face (a-symbol 6)}})
(deftest isolating-keeps-the-placement-its-chain-and-its-voice
(let [tl (clip/timeline (staged :voice? true) clip/root-id)
kept (set (keys (:nodes (export/isolate tl p1))))]
(let [sym (clip/symbol (staged :voice? true) :main)
kept (set (keys (:nodes (export/isolate sym p1))))]
(is (contains? kept p1) "the placement itself")
(is (contains? kept :root) "and the root it hangs from, or it would move")
(is (contains? kept v1) "and the voice linked to it")
@ -246,24 +246,24 @@
(deftest isolating-the-other-placement-drops-the-first-s-voice
;; The voice is linked to p1, so isolating p2 must not carry it: an isolated
;; export that kept every track would have the whole stage's sound over one face.
(let [tl (clip/timeline (staged :voice? true) clip/root-id)
kept (set (keys (:nodes (export/isolate tl p2))))]
(let [sym (clip/symbol (staged :voice? true) :main)
kept (set (keys (:nodes (export/isolate sym p2))))]
(is (= #{:root p2} kept))))
(deftest isolating-nothing-leaves-the-timeline-alone
(let [tl (clip/timeline (staged :voice? true) clip/root-id)]
(is (= tl (export/isolate tl nil)))
(deftest isolating-nothing-leaves-the-symbol-alone
(let [sym (clip/symbol (staged :voice? true) :main)]
(is (= sym (export/isolate sym nil)))
(testing "and so does isolating a node that is not there"
(is (= tl (export/isolate tl (random-uuid)))))))
(is (= sym (export/isolate sym (random-uuid)))))))
(deftest isolating-keeps-the-frame-space
;; What makes this different from exporting the symbol the placement plays: the
;; STAGE's length and rate are what comes out, not the drawing's own.
(let [c (staged)]
(is (= 12 (:frames (export/plan {:clip c :timeline clip/root-id :isolate p1}))))
(is (= 6 (:frames (export/plan {:clip c :timeline :sym/face})))
(is (= 12 (:frames (export/plan {:clip c :symbol :main :isolate p1}))))
(is (= 6 (:frames (export/plan {:clip c :symbol :sym/face})))
"the drawing's own frame space is its own")
(is (= 30 (:fps (export/plan {:clip c :timeline clip/root-id :isolate p1}))))))
(is (= 30 (:fps (export/plan {:clip c :symbol :main :isolate p1}))))))
(deftest an-isolated-walk-emits-the-stage-s-frames
(async done

6
frontend/test/arthur/flow/eye_occlusion_test.cljs
View file

@ -5,7 +5,7 @@
[arthur.domain.clip :as clip]
[arthur.domain.landmarks :as lm]
[arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[arthur.flow.condition.eyes :as condition-eyes]
[arthur.flow.ingest :as ingest]
[arthur.flow.measure.eyes :as eyes]
@ -50,7 +50,7 @@
(assoc take/params :aspect 1 :name "observed-gap")
{:face-1 {:dense @take/analysis :presence presence}})
sample (fn [id frame]
(ch/value-at (get-in (:nodes (clip/timeline clip :face-1)) [id :channels [:geom :pts]])
(ch/value-at (get-in (:nodes (clip/symbol clip :face-1)) [id :channels [:geom :pts]])
frame store))]
(is (empty? (clip/problems clip)))
(is (= [:face-1/eye-r :face-1/eye-l] (get-in clip [:groups :face-1/eyes :members])))
@ -59,7 +59,7 @@
(is (not (ch/nothing? (sample :eye-l f))))
(is (not (ch/nothing? (sample :mouth f)))))
(let [drawn (into #{} (map :node)
((timeline/resolver (clip/timeline clip :face-1) store pal/index-of) 11))]
((symbol/resolver (clip/symbol clip :face-1) store pal/index-of) 11))]
(is (not (contains? drawn :eye-r)))
(is (not (contains? drawn :iris-r)))
(is (contains? drawn :eye-l))

62
frontend/test/arthur/flow/freeze_test.cljs
View file

@ -18,7 +18,7 @@
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.ring :as ring]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[arthur.flow.freeze :as freeze]))
(def ^:private W 320)
@ -32,9 +32,9 @@
(def clip* (delay (:clip @frozen)))
;; Geometry assertions read the face timeline. Rendering assertions resolve
;; the whole clip, including placement and inherited exposure.
(defn- face-timeline [c] (clip/timeline c :face-1))
(defn- nodes [c] (merge (clip/nodes c) (:nodes (face-timeline c))))
(def tl* (delay (face-timeline @clip*)))
(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))
@ -53,8 +53,8 @@
(defn- ops-at
"Ops for one frame of a TIMELINE."
[tl f]
((timeline/resolver tl @store pal/index-of) f))
[sym f]
((symbol/resolver sym @store pal/index-of) f))
(defn- render
"One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
@ -62,7 +62,7 @@
[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 @store pal/index-of) f))
(raster/draw-ops! r ((clip/resolver c @store pal/index-of :main) f))
(vec (array-seq (:buf r)))))
(defn- drawn
@ -86,11 +86,11 @@
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))))
(deftest the-tree-is-the-one-the-model-specifies
(is (= [:face :root] (timeline/lineage (clip/nodes @clip*) :face)))
(is (= :face-1 (get-in @clip* [:timelines :main :nodes :face-1 :of])))
(is (= [:head] (timeline/lineage (:nodes @tl*) :head)))
(is (= [:mouth :head] (timeline/lineage (:nodes @tl*) :mouth)))
(is (= [:mouth-in :mouth :head] (timeline/lineage (:nodes @tl*) :mouth-in)))
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
(is (= :face-1 (get-in @clip* [:symbols :main :nodes :face-1 :of])))
(is (= [:head] (symbol/lineage (:nodes @sym*) :head)))
(is (= [:mouth :head] (symbol/lineage (:nodes @sym*) :mouth)))
(is (= [:mouth-in :mouth :head] (symbol/lineage (:nodes @sym*) :mouth-in)))
(is (= {:mode :map :expose 2} (:time (node :root))))
(is (every? #(nil? (:time (node %))) [:face :head :mouth :mouth-in])))
@ -195,7 +195,7 @@
;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
;; and `emit` as well.
(let [c (freeze/head-mode {:mode :free} @frozen)
res (clip/resolver c @store pal/index-of)
res (clip/resolver c @store pal/index-of :main)
k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos]))
@ -252,16 +252,16 @@
"anchor source addresses survive the document round trip")))
(deftest head-anchor-keys-hold-the-whole-measured-transform
(let [free (timeline/resolver (face-timeline
(let [free (symbol/resolver (face-symbol
(freeze/head-mode {:mode :free} @frozen))
@store pal/index-of)
held (timeline/resolver (face-timeline
held (symbol/resolver (face-symbol
(freeze/head-mode {:mode :anchored
:anchors {0 12, 40 88}} @frozen))
@store pal/index-of)
world (fn [resolver frame]
(resolver frame)
(vec (array-seq (timeline/world-of resolver :head))))]
(vec (array-seq (symbol/world-of resolver :head))))]
(is (= (world free 12) (world held 0)))
(is (= (world free 12) (world held 38)))
(is (= (world free 88) (world held 40)))
@ -285,7 +285,7 @@
(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 :timelines) (dissoc x :timelines))))))
(is (= (dissoc a :symbols) (dissoc x :symbols))))))
(deftest invalid-head-anchor-maps-are-refused
(is (thrown-with-msg? ExceptionInfo #"free or anchored"
@ -371,7 +371,7 @@
;; interior comes and goes.
(is (nil? (chan :mouth [:vis])))
(doseq [f (range 0 take/frames 9)]
(is (some #(= :mouth (:node %)) (ops-at @tl* f))
(is (some #(= :mouth (:node %)) (ops-at @sym* f))
(str "frame " f " drew no mouth outline"))))
;; ---------------------------------------------------------------------------
@ -403,8 +403,8 @@
(let [strip-node (fn [n]
(update n :channels
#(into {} (map (fn [[p c]] [p (dissoc c :generated)])) %)))
stripped (clip/update-root
@clip*
stripped (clip/update-symbol
@clip* :main
update :nodes
#(into {} (map (fn [[id n]] [id (strip-node n)])) %))]
(doseq [f (range 0 take/frames 17)]
@ -419,9 +419,9 @@
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)})
tl (face-timeline (:clip c))
sym (face-symbol (:clip c))
at (fn [id f]
(ch/value-at (get-in (:nodes tl) [id :channels [:geom :pts]]) f (:store c)))]
(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])))
@ -431,7 +431,7 @@
(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) ((timeline/resolver tl (:store c) pal/index-of) 50))]
(let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of) 50))]
(is (not (contains? drawn-nodes :eye-r)))
(is (contains? drawn-nodes :eye-l))
(is (contains? drawn-nodes :mouth)))
@ -457,9 +457,9 @@
windows)
c (freeze/clip (assoc take/params :name "per-track-gaps")
{:face-1 (assoc @take/measured :presence presence)})
tl (face-timeline (:clip c))
sym (face-symbol (:clip c))
at (fn [id path f]
(ch/value-at (get-in (:nodes tl) [id :channels path]) f (:store c)))
(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]
@ -485,7 +485,7 @@
(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 timeline/finish drops a
;; 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.
@ -506,7 +506,7 @@
;; 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 (timeline/resolver (face-timeline (:clip c)) (:store c) pal/index-of)]
(let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of)]
(fn [f] (into #{} (map :node) (r f)))))
ref-at (nodes-at ref)
occ-at (nodes-at occ)
@ -542,8 +542,8 @@
det (mapv #(not (contains? gap %)) (range take/frames))
c (freeze/clip (assoc take/params :name "gappy")
{:face-1 (assoc @take/measured :detected det)})
tl (face-timeline (:clip c))
res (timeline/resolver tl (:store c) pal/index-of)]
sym (face-symbol (:clip c))
res (symbol/resolver sym (:store c) pal/index-of)]
(doseq [f [39 40 50 59 60]]
(let [ops (res f)]
(if (contains? gap f)
@ -552,7 +552,7 @@
;; 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 tl) [:mouth-in :channels [:vis]]) %)
(is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) %)
(range take/frames))
(mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames))))))
@ -602,7 +602,7 @@
shot (fn [f]
(let [r (raster/make W H)
mouth (filter #(= [:face-1 :mouth] (:node %))
((clip/resolver locked @store pal/index-of) f))]
((clip/resolver locked @store pal/index-of :main) f))]
(raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r mouth)
(vec (array-seq (:buf r)))))

43
frontend/test/arthur/flow/multi_face_test.cljs
View file

@ -4,6 +4,7 @@
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.feature :as feature]
[arthur.domain.palette :as pal]
[arthur.domain.pose :as pose]
[arthur.domain.project :as project]
[arthur.events.footage :as footage]
@ -33,20 +34,20 @@
(delay (assoc (take/build settings @inputs) :source-inputs {:subjects @inputs})))
(defn channel [entry subject node path]
(get-in entry [:clip :timelines subject :nodes node :channels path]))
(defn snapshot [c store f] (ops/snapshot ((clip/resolver c store) f)))
(get-in entry [:clip :symbols subject :nodes node :channels path]))
(defn snapshot [c store f] (ops/snapshot ((clip/resolver c store pal/index-of :main) f)))
(defn by-node [c store f] (into {} (map (juxt :node identity)) (snapshot c store f)))
(deftest subjects-share-local-names-without-sharing-blocks
(let [{:keys [clip store]} @initial
a (get-in clip [:timelines :face-1 :nodes])
b (get-in clip [:timelines :face-2 :nodes])]
a (get-in clip [:symbols :face-1 :nodes])
b (get-in clip [:symbols :face-2 :nodes])]
(is (empty? (clip/problems clip)))
(is (= (set (keys a)) (set (keys b))))
(is (= :head (get-in b [:mouth :parent])))
(is (= :eye-r-in (get-in b [:iris-r :stencil])))
(is (= :mouth (get-in b [:mouth :pose-group])))
(is (= :face-2 (get-in clip [:features :face-2/mouth :timeline])))
(is (= :face-2 (get-in clip [:features :face-2/mouth :symbol])))
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (not= (:store (:dense (get-in a [:head :measured path])))
(:store (:dense (get-in b [:head :measured path]))))))
@ -63,20 +64,20 @@
(deftest one-subjects-edit-and-anchor-do-not-change-its-neighbor
(let [before @initial
at [:clip :timelines :face-2 :nodes :iris-r :channels [:style :color]]
at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]]
before (assoc-in before at (ch/framed :brow))
after (regenerate/change before {:scope :feature :id :face-2/eye-r
:knob :gaze-gain :value 2})
anchored (freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 12}} after)]
(is (= (get-in before at) (get-in after at)) "authored channels survive regeneration")
(is (= (get-in before [:clip :timelines :face-1])
(get-in after [:clip :timelines :face-1])
(get-in anchored [:timelines :face-1])))
(is (= (get-in before [:clip :symbols :face-1])
(get-in after [:clip :symbols :face-1])
(get-in anchored [:symbols :face-1])))
(is (not= (channel before :face-2 :iris-r [:xform :pos])
(channel after :face-2 :iris-r [:xform :pos])))
(is (= (channel before :face-2 :iris-l [:xform :pos])
(channel after :face-2 :iris-l [:xform :pos])))
(is (= {0 12} (get-in anchored [:timelines :face-2 :nodes :head :anchors])))
(is (= {0 12} (get-in anchored [:symbols :face-2 :nodes :head :anchors])))
(is (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage
@ -84,11 +85,11 @@
after (regenerate/change before {:scope :subject :id :face-2
:knob :anchor-avg :value 4})
full (take/build (assoc settings :anchor-avg 4) @inputs)]
(is (= (get-in full [:clip :timelines :face-2 :nodes :head :measured])
(get-in after [:clip :timelines :face-2 :nodes :head :measured])))
(doseq [tid [:main :sym/face-8625 :face-1]]
(is (= (get-in before [:clip :timelines tid])
(get-in after [:clip :timelines tid]))))
(is (= (get-in full [:clip :symbols :face-2 :nodes :head :measured])
(get-in after [:clip :symbols :face-2 :nodes :head :measured])))
(doseq [sid [:main :sym/face-8625 :face-1]]
(is (= (get-in before [:clip :symbols sid])
(get-in after [:clip :symbols sid]))))
(is (empty? (clip/problems (:clip after))))
(is (thrown? ExceptionInfo
(freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 frames}}
@ -97,7 +98,7 @@
(deftest an-instance-pose-cut-only-holds-that-faces-mouth
(let [{:keys [clip store]} @initial
cut (pose/put-cut clip :face-2 :mouth 0 20)
cut (pose/put-cut clip :main :face-2 :mouth 0 20)
original (by-node clip store 4)
held (by-node cut store 4)
source (by-node clip store 20)]
@ -173,12 +174,12 @@
(deftest the-instance-boundary-preserves-the-single-face-geometry
(let [{:keys [clip store]} (take/build settings (select-keys @inputs [:face-1]))
flat (assoc-in clip [:timelines :main :nodes]
(merge (dissoc (clip/nodes clip) :face-1)
(assoc-in (get-in clip [:timelines :face-1 :nodes])
flat (assoc-in clip [:symbols :main :nodes]
(merge (dissoc (:nodes (clip/symbol clip :main)) :face-1)
(assoc-in (get-in clip [:symbols :face-1 :nodes])
[:head :parent] :face)))
nested (clip/resolver clip store)
reference (clip/resolver flat store)]
nested (clip/resolver clip store pal/index-of :main)
reference (clip/resolver flat store pal/index-of :main)]
(doseq [f [0 1 7 20 39]]
(let [a (ops/snapshot (nested f)) b (ops/snapshot (reference f))]
(is (= (mapv (comp second :node) a) (mapv :node b)))

36
frontend/test/arthur/flow/regenerate_test.cljs
View file

@ -33,7 +33,7 @@
{:face-1 @inputs}))
(defn- channel [entry node path]
(get-in entry [:clip :timelines :face-1 :nodes node :channels path]))
(get-in entry [:clip :symbols :face-1 :nodes node :channels path]))
(deftest eye-rebuild-is-confined-to-the-edited-feature
(let [before @initial
@ -45,8 +45,8 @@
(channel after :iris-l [:xform :pos])))
(is (= (channel before :mouth [:geom :pts])
(channel after :mouth [:geom :pts])))
(is (= (get-in before [:clip :timelines :main :nodes :face])
(get-in after [:clip :timelines :main :nodes :face])))
(is (= (get-in before [:clip :symbols :main :nodes :face])
(get-in after [:clip :symbols :main :nodes :face])))
(is (= (channel (full-at {:gaze-gain 2}) :iris-r [:xform :pos])
(channel after :iris-r [:xform :pos])))))
@ -68,8 +68,8 @@
{:scope :feature :id :face-1/mouth :knob :verts :value 10})]
(is (not= (channel before :mouth [:geom :pts])
(channel after :mouth [:geom :pts])))
(is (= (get-in before [:clip :timelines :face-1 :nodes :head])
(get-in after [:clip :timelines :face-1 :nodes :head])))
(is (= (get-in before [:clip :symbols :face-1 :nodes :head])
(get-in after [:clip :symbols :face-1 :nodes :head])))
(is (= (channel before :eye-r [:geom :pts])
(channel after :eye-r [:geom :pts])))
(is (= (channel (full-at {:verts 10}) :mouth [:geom :pts])
@ -80,19 +80,19 @@
after (regenerate/change before
{:scope :subject :id :face-1 :knob :anchor-avg :value 4})
full (full-at {:anchor-avg 4})]
(is (not= (get-in before [:clip :timelines :face-1 :nodes :head :measured])
(get-in after [:clip :timelines :face-1 :nodes :head :measured])))
(is (= (get-in full [:clip :timelines :face-1 :nodes :head :measured])
(get-in after [:clip :timelines :face-1 :nodes :head :measured])))
(is (= (get-in before [:clip :timelines :main :nodes :face])
(get-in after [:clip :timelines :main :nodes :face])))))
(is (not= (get-in before [:clip :symbols :face-1 :nodes :head :measured])
(get-in after [:clip :symbols :face-1 :nodes :head :measured])))
(is (= (get-in full [:clip :symbols :face-1 :nodes :head :measured])
(get-in after [:clip :symbols :face-1 :nodes :head :measured])))
(is (= (get-in before [:clip :symbols :main :nodes :face])
(get-in after [:clip :symbols :main :nodes :face])))))
(deftest contour-edit-does-not-rebuild-head-or-teeth
(let [before @initial
after (regenerate/change before
{:scope :subject :id :face-1 :knob :contour-avg :value 3})]
(is (= (get-in before [:clip :timelines :face-1 :nodes :head])
(get-in after [:clip :timelines :face-1 :nodes :head])))
(is (= (get-in before [:clip :symbols :face-1 :nodes :head])
(get-in after [:clip :symbols :face-1 :nodes :head])))
(is (= (channel before :teeth [:geom :pts])
(channel after :teeth [:geom :pts])))))
@ -215,7 +215,7 @@
"the composed stage keeps the analysis the edit needs")
(is (some? (:source-inputs entry)))
(testing "and the features still say which timeline they live in"
(is (every? #(= :face-1 (:timeline %))
(is (every? #(= :face-1 (:symbol %))
(vals (:features (:clip entry))))))))
(deftest a-stage-edit-plans-the-same-features-as-a-take-edit
@ -238,8 +238,8 @@
(sym-channel after :iris-l [:geom :radius]))
"and only the edited side of it")
(testing "the placements are left exactly as they were"
(is (= (get-in before [:clip :timelines :main :nodes])
(get-in after [:clip :timelines :main :nodes]))))
(is (= (get-in before [:clip :symbols :main :nodes])
(get-in after [:clip :symbols :main :nodes]))))
(testing "and the document is still a document"
(is (empty? (clip/problems (:clip after)))))))
@ -249,8 +249,8 @@
;; successful edit of the drawing.
(let [after (regenerate/change (staged)
{:scope :feature :id :face-1/eye-r :knob :iris-size :value 0.6})
nodes (get-in after [:clip :timelines :main :nodes])
syms (filter (comp #{:symbol} :kind val) nodes)]
nodes (get-in after [:clip :symbols :main :nodes])
syms (filter (comp #{:instance} :kind val) nodes)]
(is (= 7 (count syms)))
(is (every? uuid? (map key syms)))
(doseq [[_ n] (filter (comp #{:audio} :kind val) nodes)]

18
frontend/test/arthur/support/ops.cljs
View file

@ -1,7 +1,7 @@
(ns arthur.support.ops
"Comparing two evaluations of a timeline, frame for frame.
`domain/timeline` has two evaluators on purpose — `eval-frame` is the
`domain/symbol` has two evaluators on purpose — `eval-frame` is the
specification and `resolver` is what playback uses — and timeline-test's central
assertion is that they agree in forward, backward and random frame order.
Step 9 needs the same comparison for a different question: that a document which
@ -13,14 +13,14 @@
scrub, and a copy of this list that forgot 'backward' would test the easy half.
Every entry point takes a TIMELINE, not a clip: what produces ops is a bag of
nodes in a frame space, and a caller with a clip says `(clip/root c)`.
nodes in a frame space, and a caller with a clip says `(clip/symbol c :main)`.
`snapshot` is what makes ops comparable at all: a resolved op carries `:pts` as
a VIEW into a reused buffer, so two ops from different frames can be `=` while
naming the same array, and holding one and then asking for the next frame
changes what the first one says. Reading the points out is what pins the frame."
(:require [arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]))
[arthur.domain.symbol :as symbol]))
(defn points
"An op's points as a vector of [x y], read out of its buffer."
@ -50,13 +50,13 @@
(defn specified
"(fn [f] -> snapshot) through `eval-frame`, the specification."
([tl store] (specified tl store pal/index-of))
([tl store palette]
(fn [f] (snapshot (timeline/eval-frame tl f store palette)))))
([sym store] (specified sym store pal/index-of))
([sym store palette]
(fn [f] (snapshot (symbol/eval-frame sym f store palette)))))
(defn resolved
"(fn [f] -> snapshot) through `resolver`, the playback path."
([tl store] (resolved tl store pal/index-of))
([tl store palette]
(let [res (timeline/resolver tl store palette)]
([sym store] (resolved sym store pal/index-of))
([sym store palette]
(let [res (symbol/resolver sym store palette)]
(fn [f] (snapshot (res f))))))