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

Split clips from timelines

Browse source
This commit is contained in:
Olive Vaughn 2026-09-28 02:33:26 -04:00
parent 27bfe18bee
commit 9778b9023b
31 changed files with 794 additions and 444 deletions
Download patch file Download diff file Expand all files Collapse all files

2
docs/architecture.md
View file

@ -239,7 +239,7 @@ src/arthur/
ring.cljs ordered traversal: subsample, offset, simplicity ring.cljs ordered traversal: subsample, offset, simplicity
geom.cljs similarity fit, procrustes, moving average geom.cljs similarity fit, procrustes, moving average
node.cljs scene node: source, parent, stencil, z node.cljs scene node: source, parent, stencil, z
scene.cljs node tree: topo order, transform composition timeline.cljs node tree: topo order, transform composition
channel.cljs keyframe stream: active-key-at, hold semantics channel.cljs keyframe stream: active-key-at, hold semantics
clip.cljs clip entity; the frame-space conversions clip.cljs clip entity; the frame-space conversions
cel.cljs painted vector layers cel.cljs painted vector layers

6
frontend/README.md
View file

@ -244,12 +244,12 @@ them is `clips/templates/clips/index.html`.
## Two evaluators, on purpose ## Two evaluators, on purpose
`domain/scene` has both `eval-frame` and `resolver`, and they are not `domain/timeline` has both `eval-frame` and `resolver`, and they are not
alternatives: alternatives:
- **`(eval-frame scene f store)`** is the specification. Allocating, order-free, - **`(eval-frame timeline f store)`** is the specification. Allocating, order-free,
obviously correct. Tests and one-off renders use it. obviously correct. Tests and one-off renders use it.
- **`(resolver scene store)` -> `(fn [f] ops)`** is what playback uses. It caches - **`(resolver timeline store)` -> `(fn [f] ops)`** is what playback uses. It caches
the topological order and the z paths, holds a cursor per channel and reuses the topological order and the z paths, holds a cursor per channel and reuses
one point buffer per node, so a frame allocates the op maps and nothing else. one point buffer per node, so a frame allocates the op maps and nothing else.

43
frontend/src/arthur/db.cljs
View file

@ -6,34 +6,37 @@
affordable over authored data, and cheap writes, since every edit `assoc`es affordable over authored data, and cheap writes, since every edit `assoc`es
into this map and every mounted layer-2 sub compares the result. into this map and every mounted layer-2 sub compares the result.
So the scene is here (it is a document — a human placed every node) and dense So the clip is here (it is a document — a human placed every node) and dense
channel blocks are not; they live behind a handle in `store`. The hand-written channel blocks are not; they live behind a handle in `store`. The hand-written
demo scene has no dense blocks and its store is empty; the swarm and the take demo clip has no dense blocks and its store is empty; the swarm and the take
are entirely dense." are entirely dense."
(:require [arthur.demo :as demo] (:require [arthur.demo :as demo]
[arthur.domain.clip :as domain-clip]
[arthur.demo.swarm :as swarm] [arthur.demo.swarm :as swarm]
[arthur.demo.take :as take])) [arthur.demo.take :as take]))
(defn- clip (defn- entry
"A scene plus the clip-level facts the transport and the stage need. "A clip plus what the transport and the stage read off it.
Read OFF the scene rather than written again beside it. `:fps`, `:frames` and the Read OFF the clip rather than written again beside it: copying a number by hand
stage dimensions belong to the CLIP and not to the timeline — a timeline has a into this table is how it comes to disagree with the document it describes.
frame space, not a rate and not a size — and they sit on the scene map only `:frames` comes from the ROOT TIMELINE and `:fps` from the clip, which is the
because there is one clip per scene today. Copying them by hand into this table split `arthur.domain.clip` exists to make — a timeline is a frame space, a clip
is how one of them comes to disagree with the scene it describes." is a rate — and an earlier version of this docstring noted that they sat on one
[label-key label scene store] map \"only because there is one clip per scene today\". They do not any more."
(merge {:label label :scene scene :store store [label-key label clip store]
(merge {:label label :clip clip :store store
;; A static asset since step 9, and not the repo root's `audio.wav`. ;; A static asset since step 9, and not the repo root's `audio.wav`.
;; That file is `extract.sh`'s output — tier 3, which the backend now ;; That file is `extract.sh`'s output — tier 3, which the backend now
;; serves by hash — and the synthetic take needs a sound of its own so ;; serves by hash — and the synthetic take needs a sound of its own so
;; that the clock has something to run against with no footage ingested. ;; that the clock has something to run against with no footage ingested.
:audio "/static/arthur/audio.wav" :audio "/static/arthur/audio.wav"
:cid (name label-key) :cid (name label-key)
:display-fps (:fps scene)} :display-fps (:fps clip)
(select-keys scene [:fps :frames :width :height]))) :frames (domain-clip/frames clip)}
(select-keys clip [:fps :width :height])))
(def scenes (def clips
"The hand-made clips, selectable from the transport. "The hand-made clips, selectable from the transport.
`:swarm` is the load test: a hundred and twenty nodes, entirely dense. The two `:swarm` is the load test: a hundred and twenty nodes, entirely dense. The two
@ -41,14 +44,14 @@
`:head` written as a dense track in one and as framed identity in the other, so `:head` written as a dense track in one and as framed identity in the other, so
the button that switches between them switches a document field and nothing the button that switches between them switches a document field and nothing
else." else."
{:demo (clip :demo "demo" demo/scene nil) {:demo (entry :demo "demo" demo/clip nil)
:swarm (clip :swarm "swarm" @swarm/scene @swarm/store) :swarm (entry :swarm "swarm" @swarm/clip @swarm/store)
:take (clip :take "take" @take/scene @take/store) :take (entry :take "take" @take/clip @take/store)
:take-locked (clip :take-locked "locked" @take/locked @take/store)}) :take-locked (entry :take-locked "locked" @take/locked @take/store)})
(def default (def default
{;; --- the document --- {;; --- the document ---
:scene/current :take :clip/current :take
:palette :arthur/default ; a NAME; the ramp itself is project data :palette :arthur/default ; a NAME; the ramp itself is project data
;; --- the clip --- ;; --- the clip ---
@ -57,7 +60,7 @@
;; footage's. That is what deleting `makeXform` buys — the framing became a ;; footage's. That is what deleting `makeXform` buys — the framing became a
;; transform on a node, so nothing downstream of the freeze knows the frame ;; transform on a node, so nothing downstream of the freeze knows the frame
;; size — and it is why ui/player no longer hardcodes 320x200. ;; size — and it is why ui/player no longer hardcodes 320x200.
:clip (select-keys (:take scenes) [:fps :frames :width :height :audio :display-fps]) :clip (select-keys (:take clips) [:fps :frames :width :height :audio :display-fps])
;; Which ingested footage to detect, and what the last load said. The list ;; Which ingested footage to detect, and what the last load said. The list
;; comes from the server — tier 3 is the backend's since step 9 — so there is ;; comes from the server — tier 3 is the backend's since step 9 — so there is

19
frontend/src/arthur/demo.cljs
View file

@ -1,23 +1,28 @@
(ns arthur.demo (ns arthur.demo
"The hand-written scene from port-plan step 2, and nothing else. "The hand-written clip from port-plan step 2, and nothing else.
The EDN is a resource rather than a literal in this file so that the test and The EDN is a resource rather than a literal in this file so that the test and
the page read the SAME bytes. If the scene were written twice, the one the test the page read the SAME bytes. If the scene were written twice, the one the test
validates would not be the one that renders, and the model would be validated validates would not be the one that renders, and the model would be validated
against a scene nobody ever looked at." against a scene nobody ever looked at."
(:require [arthur.domain.scene :as scene] (:require [arthur.domain.clip :as domain-clip]
[arthur.domain.timeline :as timeline]
[cljs.reader :as reader] [cljs.reader :as reader]
[shadow.resource :as rc])) [shadow.resource :as rc]))
(def source (rc/inline "arthur/demo/scene.edn")) (def source (rc/inline "arthur/demo/scene.edn"))
(def scene (reader/read-string source)) (def clip (reader/read-string source))
(def fps (:fps scene)) (def timeline
(def frames (:frames scene)) "The clip's root timeline: what an evaluator takes. `clip` is the document."
(domain-clip/root clip))
(def fps (:fps clip))
(def frames (domain-clip/frames clip))
(defn ops-at (defn ops-at
"Draw ops for one frame, via the specification path. The page uses "Draw ops for one frame, via the specification path. The page uses
`scene/resolver` instead; this is here for the REPL." `timeline/resolver` instead; this is here for the REPL."
[f] [f]
(scene/eval-frame scene f)) (timeline/eval-frame timeline f))

7
frontend/src/arthur/demo/scene.edn
View file

@ -24,7 +24,6 @@
;; 229 frames at 30fps is 7.63s, which covers audio.wav (7.601s) with a frame to ;; 229 frames at 30fps is 7.63s, which covers audio.wav (7.601s) with a frame to
;; spare. fps belongs to the CLIP rather than to the timeline — a timeline has a ;; spare. fps belongs to the CLIP rather than to the timeline — a timeline has a
;; frame space, not a rate — and it is here only because there is one clip. ;; frame space, not a rate — and it is here only because there is one clip.
:frames 229
:fps 30 :fps 30
;; The STAGE, in pixels. The project's dimensions, not the footage's — which is ;; The STAGE, in pixels. The project's dimensions, not the footage's — which is
;; what makes `makeXform` deletable: placement is a transform on a node and the ;; what makes `makeXform` deletable: placement is a transform on a node and the
@ -33,6 +32,10 @@
:width 320 :width 320
:height 200 :height 200
:timelines
{:main
{:id :main
:frames 229
:nodes :nodes
{;; The clip root. EXPOSURE LIVES HERE and is inherited, because {;; The clip root. EXPOSURE LIVES HERE and is inherited, because
;; docs/design.md is emphatic that everything rides one grid: a head cutting on ;; docs/design.md is emphatic that everything rides one grid: a head cutting on
@ -96,4 +99,4 @@
{:id :pupil :name "pupil" :kind :rect :parent :iris :stencil :iris :z "a3" {:id :pupil :name "pupil" :kind :rect :parent :iris :stencil :iris :z "a3"
:channels :channels
{[:geom :size] {:animated? false :value 5.0} {[:geom :size] {:animated? false :value 5.0}
[:style :color] {:animated? false :value :pupil}}}}} [:style :color] {:animated? false :value :pupil}}}}}}}

9
frontend/src/arthur/demo/swarm.cljs
View file

@ -147,13 +147,16 @@
(def store (def store
(delay (merge (orbit-blocks) (shape-blocks)))) (delay (merge (orbit-blocks) (shape-blocks))))
(def scene (def clip
(delay (delay
{:name "swarm" {:name "swarm"
:frames frames
:fps fps :fps fps
:width 320 :width 320
:height 200 :height 200
:timelines
{:main
{:id :main
:frames frames
:nodes :nodes
(into {:root {:id :root :kind :group :parent nil :z "a1" (into {:root {:id :root :kind :group :parent nil :z "a1"
;; On 2s, like everything else. A hundred and twenty shapes ;; On 2s, like everything else. A hundred and twenty shapes
@ -162,4 +165,4 @@
;; argument for exposure inheriting strictly. ;; argument for exposure inheriting strictly.
:time {:mode :map :expose 2}}} :time {:mode :map :expose 2}}}
(concat (map (juxt :id identity) (map orbit-node (range n-orbits))) (concat (map (juxt :id identity) (map orbit-node (range n-orbits)))
(map (juxt :id identity) (map shape-node (range n-shapes)))))})) (map (juxt :id identity) (map shape-node (range n-shapes)))))}}}))

6
frontend/src/arthur/demo/take.cljs
View file

@ -12,7 +12,7 @@
│ │
FREEZE ──▶ channels on nodes FREEZE ──▶ channels on nodes
│ │
scene/resolver ──▶ raster timeline/resolver ──▶ raster
— and the order of that diagram is the whole argument for the stage split. The — and the order of that diagram is the whole argument for the stage split. The
anchor fit is knob-free. Conditioning smooths its four parameters. The rings are anchor fit is knob-free. Conditioning smooths its four parameters. The rings are
@ -21,7 +21,7 @@
anything that reads a source pixel, because that part takes the landmarks and anything that reads a source pixel, because that part takes the landmarks and
the frames and never the transform. the frames and never the transform.
TWO SCENES, ONE STORE. `:take` carries the head as filmed and `:take-locked` TWO CLIPS, ONE STORE. `:take` carries the head as filmed and `:take-locked`
carries it locked, and they are the same dense blocks with one node's channels carries it locked, and they are the same dense blocks with one node's channels
written two ways. That is the claim \"stabilisation is a channel, not a mode\" written two ways. That is the claim \"stabilisation is a channel, not a mode\"
made checkable by eye: switching between them is a document edit, tier 1, and made checkable by eye: switching between them is a document edit, tier 1, and
@ -91,7 +91,7 @@
(def store (delay (:store @frozen))) (def store (delay (:store @frozen)))
(def scene (delay (:scene @frozen))) (def clip (delay (:clip @frozen)))
(def locked (def locked
"The same blocks, with `:head` written as framed identity instead." "The same blocks, with `:head` written as framed identity instead."

110
frontend/src/arthur/domain/clip.cljs Normal file
View file

@ -0,0 +1,110 @@
(ns arthur.domain.clip
"A CLIP: the unit of work, and a library of timelines.
{:name \"take\"
:fps 30
:width 320 :height 200
:analysis {...}
:subjects {...} :features {...} :groups {...}
:timelines {:main {:id :main :frames 229 :nodes {...}}}}
Every field here is a fact about the clip and NOT about a bag of nodes, which is
the cut this namespace exists to make. Before it, one map carried both: `:fps`,
the stage dimensions, the analysis record and the tracking identities sat beside
`:nodes`, and `arthur.db` said of it — correctly — that they \"sit on the scene
map only because there is one clip per scene today\". The cost of leaving them
together was not untidiness. It was that a SYMBOL had nowhere to live: a library
timeline is a bag of nodes with a frame space and nothing else, so under the old
shape it would have had to be a clip with seven meaningless fields, or a second
structure with the same `:nodes` key that every walk had to be taught about.
Now there is one node-holding type — `arthur.domain.timeline` — and a clip holds
a MAP of them. `:kind :symbol` is still unimplemented and this is the shape it
was waiting for: an instance names a timeline in `:timelines`, and the resolver
recurses into a type it already knows how to evaluate.
THE ROOT TIMELINE HAS A RESERVED ID, `:main`, rather than the clip carrying a
pointer to it. A pointer is a field that can be wrong — it can name a timeline
that is not there, and then every reader needs a fallback — where a reserved name
can only be absent, which `problems` reports once. Flash reserves `_root` the
same way and for the same reason. Nothing else about `:main` is special: it is an
ordinary entry in the map, and a symbol is another one.
WHY :fps IS HERE AND :frames IS NOT. A rate is how fast the whole clip plays
against its audio, and a nested timeline cannot have one of its own — retiming an
instance is `:rate` on its `:time` map, which is a factor and not a rate. A
frame COUNT is a property of a frame space, so every timeline has its own."
(:require [arthur.domain.feature :as feature]
[arthur.domain.timeline :as timeline]))
(def ^:const root-id
"The reserved id of the timeline a clip plays. See the namespace docstring."
:main)
(def clip-keys
"Every top-level field of a clip, and the reason `arthur.domain.leaf` refuses
one it does not know: a field added to the clip without a leaf to save it in is
a field that saves silently and comes back missing. The failure is a document
that loses something on every round trip, which is the one bug a persistence
layer must not be able to have. Add the field here and to `leaf/leaves` and
`leaf/clip` in the same commit."
#{:name :fps :analysis :subjects :features :groups :width :height :timelines})
(defn timeline
"One of the clip's timelines, by id."
[clip id]
(get-in clip [:timelines id]))
(defn root
"The timeline the clip plays."
[clip]
(timeline clip root-id))
(defn frames
"The clip's length, which is its root timeline's frame space and is not written
down twice. Reading it off the root is what stops the two from disagreeing."
[clip]
(:frames (root clip)))
(defn update-timeline
"Apply f to one timeline in place."
[clip id f & args]
(apply update-in clip [:timelines id] f args))
(defn update-root [clip f & args]
(apply update-timeline clip root-id f args))
(defn nodes
"The root timeline's nodes. A convenience for the many callers that mean the
root and would otherwise spell it out; anything that could mean a symbol says
which timeline instead."
[clip]
(:nodes (root clip)))
(defn problems
"Human-readable reasons this clip will not evaluate or will not save. Empty
means it will.
The tracking identities are checked HERE and not in `domain/timeline`, because a
feature names nodes and only the root timeline's nodes were tracked into: a
library symbol is drawn, not detected. So `feature/problems` is asked about the
root, once, rather than about every timeline."
[clip]
(vec
(concat
(for [k (remove clip-keys (keys clip))]
(str "clip has a field with no leaf to save it in: " (pr-str k)))
(when-not (map? (:timelines clip))
[":timelines must be a map of id -> timeline"])
(when (and (map? (:timelines clip)) (nil? (root clip)))
[(str "no " (pr-str root-id) " timeline — a clip plays the one with the reserved id")])
(when-not (or (nil? (:fps clip)) (and (number? (:fps clip)) (pos? (:fps clip))))
[(str ":fps is " (pr-str (:fps clip)) " — a rate is a positive number")])
(for [[id tl] (:timelines clip)
:when (not= id (:id tl))]
(str "timeline under key " (pr-str id) " has :id " (pr-str (:id tl))))
(for [[id tl] (:timelines clip)
p (timeline/problems tl)]
(str "timeline " (pr-str id) ": " p))
(when (map? (root clip))
(feature/problems clip (nodes clip))))))

48
frontend/src/arthur/domain/feature.cljs
View file

@ -1,22 +1,28 @@
(ns arthur.domain.feature (ns arthur.domain.feature
"Stable tracked identities and explicit eye-pair settings associations. "Stable tracked identities and explicit eye-pair settings associations.
These maps are document data. Rendering only reads the nodes and channels."
These maps are the CLIP's — `:subjects`, `:features`, `:groups` — and not a
timeline's, because they describe what a camera saw and a library symbol is
drawn rather than detected. Rendering never reads them; it reads nodes and
channels. `problems` therefore takes the clip AND the node map to check
references against, rather than reaching for `(:nodes clip)`: a clip holds
several timelines and only the root one was tracked into."
(:require [arthur.domain.params :as params])) (:require [arthur.domain.params :as params]))
(defn group-for [scene feature-id] (defn group-for [clip feature-id]
(first (filter (fn [[_ group]] (some #{feature-id} (:members group))) (first (filter (fn [[_ group]] (some #{feature-id} (:members group)))
(:groups scene)))) (:groups clip))))
(defn effective-params (defn effective-params
"Resolve static settings for one feature. A future parameter channel can "Resolve static settings for one feature. A future parameter channel can
replace a scalar at this boundary without changing feature or pair identity." replace a scalar at this boundary without changing feature or pair identity."
[scene feature-id] [clip feature-id]
(let [{:keys [subject area params] :as feature} (get-in scene [:features feature-id]) (let [{:keys [subject area params] :as feature} (get-in clip [:features feature-id])
[_ group] (group-for scene feature-id)] [_ group] (group-for clip feature-id)]
(when-not feature (when-not feature
(throw (ex-info "unknown feature" {:feature feature-id}))) (throw (ex-info "unknown feature" {:feature feature-id})))
(merge (params/for-area :subject) (merge (params/for-area :subject)
(get-in scene [:subjects subject :params]) (get-in clip [:subjects subject :params])
(params/for-area area) (params/for-area area)
(:params group) (:params group)
params))) params)))
@ -24,26 +30,30 @@
(defn remove-from-pair (defn remove-from-pair
"Keep the eye's current settings when its association is removed. Empty pairs "Keep the eye's current settings when its association is removed. Empty pairs
are removed; a one-eye pair remains valid and can acquire a partner later." are removed; a one-eye pair remains valid and can acquire a partner later."
[scene feature-id] [clip feature-id]
(if-let [[group-id group] (group-for scene feature-id)] (if-let [[group-id group] (group-for clip feature-id)]
(let [area (get-in scene [:features feature-id :area]) (let [area (get-in clip [:features feature-id :area])
values (select-keys (effective-params scene feature-id) values (select-keys (effective-params clip feature-id)
(keys (params/for-area area))) (keys (params/for-area area)))
members (vec (remove #{feature-id} (:members group)))] members (vec (remove #{feature-id} (:members group)))]
(-> scene (-> clip
(assoc-in [:features feature-id :params] values) (assoc-in [:features feature-id :params] values)
(update :groups (fn [groups] (update :groups (fn [groups]
(if (seq members) (if (seq members)
(assoc-in groups [group-id :members] members) (assoc-in groups [group-id :members] members)
(dissoc groups group-id)))))) (dissoc groups group-id))))))
scene)) clip))
(defn problems (defn problems
"Check identity references and pair membership before storing a scene." "Check identity references and pair membership before storing a clip.
[scene]
(let [subjects (:subjects scene) `nodes` is the node map a feature's `:nodes` are resolved against — the root
features (:features scene) timeline's, passed in rather than looked up, so this namespace does not have to
groups (:groups scene) know which timeline a clip plays."
[clip nodes]
(let [subjects (:subjects clip)
features (:features clip)
groups (:groups clip)
memberships (mapcat (comp :members val) groups) memberships (mapcat (comp :members val) groups)
node-owners (mapcat (comp :nodes val) features)] node-owners (mapcat (comp :nodes val) features)]
(vec (vec
@ -63,7 +73,7 @@
:when (not (params/valid-settings? (:area f) (or (:params f) {})))] :when (not (params/valid-settings? (:area f) (or (:params f) {})))]
(str "feature " (pr-str id) " has invalid settings for " (pr-str (:area f)))) (str "feature " (pr-str id) " has invalid settings for " (pr-str (:area f))))
(for [[id f] features node-id (:nodes f) (for [[id f] features node-id (:nodes f)
:when (not (contains? (:nodes scene) node-id))] :when (not (contains? nodes node-id))]
(str "feature " (pr-str id) " refers to missing node " (pr-str node-id))) (str "feature " (pr-str id) " refers to missing node " (pr-str node-id)))
(for [[id n] (frequencies node-owners) :when (> n 1)] (for [[id n] (frequencies node-owners) :when (> n 1)]
(str "node " (pr-str id) " belongs to more than one feature")) (str "node " (pr-str id) " belongs to more than one feature"))

164
frontend/src/arthur/domain/leaf.cljs
View file

@ -8,15 +8,28 @@
once. once.
clip/<cid>/name a label clip/<cid>/name a label
clip/<cid>/timing fps, frames clip/<cid>/timing fps
clip/<cid>/stage width, height clip/<cid>/stage width, height
clip/<cid>/source the analysis record this came out of clip/<cid>/source the analysis record this came out of
clip/<cid>/subject/<sid> a tracked subject and its params clip/<cid>/subject/<sid> a tracked subject and its params
clip/<cid>/feature/<fid> one feature: area, nodes, params clip/<cid>/feature/<fid> one feature: area, nodes, params
clip/<cid>/group/<gid> an eye pair and its shared params clip/<cid>/group/<gid> an eye pair and its shared params
clip/<cid>/node/<nid> one node: kind, parent, stencil, z, time clip/<cid>/timeline/<tid> frames, and a palette one day
clip/<cid>/channel/<nid>/<prop> one channel clip/<cid>/timeline/<tid>/node/<nid> kind, parent, stencil, z, time
clip/<cid>/measured/<nid> the measured channels a re-freeze owns clip/<cid>/timeline/<tid>/channel/<nid>/<prop>
clip/<cid>/timeline/<tid>/measured/<nid> the channels a re-freeze owns
WHY NODES SIT UNDER A TIMELINE. They did not until the clip and the timeline came
apart, and the flat `clip/<cid>/node/<nid>` was the persistence half of the same
conflation: it could only ever address the nodes of the one bag a clip had. A
library symbol is a timeline, an instance references one, and both need their
nodes addressed — so the timeline id is a segment, the root is `main`, and a
symbol's nodes are reachable by the same path shape as the clip's own. Adding it
later would have meant rewriting every stored path.
`:frames` MOVED OFF `timing` onto the timeline. A timeline is a frame space and a
clip is a rate, so `timing` holds `:fps` alone. Both used to be in one leaf, which
is how a nested timeline's length would have had nowhere to go.
WHY THESE BOUNDARIES. Last-writer-wins only clobbers when its unit is too big, WHY THESE BOUNDARIES. Last-writer-wins only clobbers when its unit is too big,
so the cut is chosen so that the things people do simultaneously land on so the cut is chosen so that the things people do simultaneously land on
@ -43,7 +56,9 @@
— docs/architecture.md draws one as `:eye-r/iris` — is written `eye-r~iris`. — docs/architecture.md draws one as `:eye-r/iris` — is written `eye-r~iris`.
`~` is then refused inside a name, which is the whole of the escaping and is why `~` is then refused inside a name, which is the whole of the escaping and is why
it is one character rather than a scheme." it is one character rather than a scheme."
(:require [arthur.domain.sha256 :as sha] (:require [arthur.domain.clip :as clip]
[arthur.domain.sha256 :as sha]
[arthur.domain.timeline :as timeline]
[clojure.string :as str])) [clojure.string :as str]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -80,57 +95,80 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the split ;; the split
(def scene-keys
"Every top-level field of a scene, and the reason `leaves` refuses one it does
not know: a field added to the scene without a leaf is a field that saves
silently and comes back missing. The failure is a document that loses something
on every round trip, which is the one bug a persistence layer must not be able
to have. Add the field here and to `leaves` and `scene` in the same commit."
#{:name :frames :fps :analysis :subjects :features :groups :width :height :nodes})
(def ^:private node-channel-keys #{:channels :measured}) (def ^:private node-channel-keys #{:channels :measured})
(defn leaves (defn leaves
"One clip's scene -> path -> value. "One clip -> path -> value.
A leaf whose value would be empty is OMITTED rather than written as `{}`, and A leaf whose value would be empty is OMITTED rather than written as `{}`, and
that is what makes the round trip exact: the demo scene has no `:fps` and the that is what makes the round trip exact: the demo clip has no `:fps` and its root
root node has no `:channels`, and a codec that invented them would hand back a node has no `:channels`, and a codec that invented them would hand back a clip
scene that is not `=` to the one it was given." that is not `=` to the one it was given."
[cid scene] [cid clip]
(let [unknown (remove scene-keys (keys scene))] (let [unknown (remove clip/clip-keys (keys clip))]
(when (seq unknown) (when (seq unknown)
(throw (ex-info "the scene has a field with no leaf to save it in; see arthur.domain.leaf/scene-keys" (throw (ex-info "the clip has a field with no leaf to save it in; see arthur.domain.clip/clip-keys"
{:unknown (vec (sort-by str unknown))})))) {:unknown (vec (sort-by str unknown))}))))
(doseq [[id tl] (:timelines clip)]
(let [unknown (remove timeline/timeline-keys (keys tl))]
(when (seq unknown)
(throw (ex-info "a timeline has a field with no leaf to save it in; see arthur.domain.timeline/timeline-keys"
{:timeline id :unknown (vec (sort-by str unknown))})))))
(let [at (fn [& parts] (str/join "/" (into ["clip" (segment cid)] parts))) (let [at (fn [& parts] (str/join "/" (into ["clip" (segment cid)] parts)))
some-leaf (fn [path v] (when (seq v) {path v}))] some-leaf (fn [path v] (when (seq v) {path v}))]
(apply merge (apply merge
(some-leaf (at "name") (select-keys scene [:name])) (some-leaf (at "name") (select-keys clip [:name]))
(some-leaf (at "timing") (select-keys scene [:fps :frames])) (some-leaf (at "timing") (select-keys clip [:fps]))
(some-leaf (at "stage") (select-keys scene [:width :height])) (some-leaf (at "stage") (select-keys clip [:width :height]))
(some-leaf (at "source") (:analysis scene)) (some-leaf (at "source") (:analysis clip))
(concat (concat
(for [[id v] (:subjects scene)] {(at "subject" (segment id)) v}) (for [[id v] (:subjects clip)] {(at "subject" (segment id)) v})
(for [[id v] (:features scene)] {(at "feature" (segment id)) v}) (for [[id v] (:features clip)] {(at "feature" (segment id)) v})
(for [[id v] (:groups scene)] {(at "group" (segment id)) v}) (for [[id v] (:groups clip)] {(at "group" (segment id)) v})
(for [[id n] (:nodes scene)] {(at "node" (segment id)) ;; The timeline's own facts. `:id` is the path segment, so writing it
;; into the value as well would be the one field a rename could
;; disagree with itself about; `clip` puts it back.
(for [[tid tl] (:timelines clip)]
{(at "timeline" (segment tid))
(select-keys tl [:frames :palette])})
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)]
{(at "timeline" (segment tid) "node" (segment id))
(apply dissoc n node-channel-keys)}) (apply dissoc n node-channel-keys)})
(for [[id n] (:nodes scene) (for [[tid tl] (:timelines clip)
:when (seq (:measured n))] {(at "measured" (segment id)) (:measured n)}) [id n] (:nodes tl)
(for [[id n] (:nodes scene) :when (seq (:measured n))]
{(at "timeline" (segment tid) "measured" (segment id)) (:measured n)})
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)
[prop ch] (:channels n)] [prop ch] (:channels n)]
{(at "channel" (segment id) (prop->path prop)) ch}))))) {(at "timeline" (segment tid) "channel" (segment id) (prop->path prop)) ch})))))
(defn scene (defn clip
"The inverse of `leaves`, for one clip. Paths belonging to another clip are "The inverse of `leaves`, for one clip. Paths belonging to another clip are
ignored, so a project's whole leaf map can be handed straight in." ignored, so a project's whole leaf map can be handed straight in.
A timeline's `:id` is restored from its path segment rather than read out of the
value, which is why `leaves` does not write it: a segment and a field that both
claim to be the id are two places for one fact."
[cid leaves] [cid leaves]
(let [want (segment cid)] (let [want (segment cid)]
(reduce (reduce
(fn [acc [path v]] (fn [acc [path v]]
(let [[kind a b] (drop 2 (str/split path #"/"))] (let [[_ found kind a b c] (str/split path #"/")]
(if-not (= want (second (str/split path #"/"))) (if-not (= want found)
acc acc
(if (= "timeline" kind)
(let [tid (unsegment a)
acc (assoc-in acc [:timelines tid :id] tid)]
(case b
nil (update-in acc [:timelines tid] merge v)
"node" (update-in acc [:timelines tid :nodes (unsegment c)] merge v)
"measured" (assoc-in acc [:timelines tid :nodes (unsegment c) :measured] v)
"channel" (assoc-in acc [:timelines tid :nodes (unsegment c)
:channels (path->prop (nth (str/split path #"/") 6))]
v)
(throw (ex-info "not a leaf path" {:path path}))))
(case kind (case kind
"name" (merge acc v) "name" (merge acc v)
"timing" (merge acc v) "timing" (merge acc v)
@ -139,10 +177,7 @@
"subject" (assoc-in acc [:subjects (unsegment a)] v) "subject" (assoc-in acc [:subjects (unsegment a)] v)
"feature" (assoc-in acc [:features (unsegment a)] v) "feature" (assoc-in acc [:features (unsegment a)] v)
"group" (assoc-in acc [:groups (unsegment a)] v) "group" (assoc-in acc [:groups (unsegment a)] v)
"node" (update-in acc [:nodes (unsegment a)] merge v) (throw (ex-info "not a leaf path" {:path path})))))))
"measured" (assoc-in acc [:nodes (unsegment a) :measured] v)
"channel" (assoc-in acc [:nodes (unsegment a) :channels (path->prop b)] v)
(throw (ex-info "not a leaf path" {:path path}))))))
{} {}
;; Sorted, so `node` lands before `channel` and `measured` under one id and ;; Sorted, so `node` lands before `channel` and `measured` under one id and
;; the node map is merged INTO rather than over. `update-in ... merge` makes ;; the node map is merged INTO rather than over. `update-in ... merge` makes
@ -159,25 +194,42 @@
on the machine that produced it, and the whole point of tier 2 being on the machine that produced it, and the whole point of tier 2 being
content-addressed is that it does not have to travel with tier 1 to be found." content-addressed is that it does not have to travel with tier 1 to be found."
[leaves] [leaves]
(let [nodes (into #{} (keep (fn [path] (let [parts (into {} (map (juxt identity #(vec (str/split % #"/")))) (keys leaves))
(let [[_ cid kind id] (str/split path #"/")] ;; A node leaf, by (clip, timeline, node). Under a timeline id, because a
(when (= "node" kind) [cid id])))) ;; symbol and the root may both hold a `:mouth` and a channel of one is not
(keys leaves))] ;; a channel of the other.
nodes (into #{} (keep (fn [[_ p]]
(when (and (= 6 (count p)) (= "timeline" (nth p 2))
(= "node" (nth p 4)))
[(nth p 1) (nth p 3) (nth p 5)])))
parts)
;; Which segment index holds the kind, and what shapes are legal.
legal? (fn [p]
(and (= "clip" (first p)) (second p)
(if (= "timeline" (nth p 2 nil))
(case (count p)
4 true ; the timeline itself
6 (#{"node" "measured"} (nth p 4))
7 (= "channel" (nth p 4))
false)
(case (count p)
;; The clip's own facts carry no id.
3 (#{"name" "timing" "stage" "source"} (nth p 2))
4 (#{"subject" "feature" "group"} (nth p 2))
false))))]
(vec (vec
(concat (concat
(for [[path v] (sort-by key leaves) (for [[path p] (sort-by key parts)
:let [[root cid kind id prop] (str/split path #"/")] :when (not (legal? p))]
:when (or (not= "clip" root) (nil? cid)
(not (#{"name" "timing" "stage" "source" "subject" "feature"
"group" "node" "channel" "measured"} kind)))]
(str (pr-str path) " is not a leaf path")) (str (pr-str path) " is not a leaf path"))
(for [[path _] (sort-by key leaves) (for [[path p] (sort-by key parts)
:let [[_ cid kind id] (str/split path #"/")] :when (and (legal? p) (= "timeline" (nth p 2 nil)) (>= (count p) 6)
:when (and (#{"channel" "measured"} kind) (not (contains? nodes [cid id])))] (#{"channel" "measured"} (nth p 4))
(not (contains? nodes [(nth p 1) (nth p 3) (nth p 5)])))]
(str (pr-str path) " addresses a node with no node leaf")) (str (pr-str path) " addresses a node with no node leaf"))
(for [[path v] (sort-by key leaves) (for [[path p] (sort-by key parts)
:let [[_ _ kind] (str/split path #"/")] :let [v (get leaves path)]
:when (and (= "channel" kind) (:dense v) :when (and (legal? p) (= "timeline" (nth p 2 nil)) (= 7 (count p))
(not (sha/key? (:store (:dense v)))))] (:dense v) (not (sha/key? (:store (:dense v)))))]
(str (pr-str path) " names tier 2 as " (pr-str (:store (:dense v))) (str (pr-str path) " names tier 2 as " (pr-str (:store (:dense v)))
" — a dense channel in a saved document names a content address")))))) " — a dense channel in a saved document names a content address"))))))

2
frontend/src/arthur/domain/node.cljs
View file

@ -109,7 +109,7 @@
it on most frames, so the lead slider reads as doing nothing at exposures above it on most frames, so the lead slider reads as doing nothing at exposures above
1, which is indistinguishable from the slider being unwired. 1, which is indistinguishable from the slider being unwired.
Composed along the nesting chain, outermost first, by scene/eval-frame. Two Composed along the parent chain, outermost first, by timeline/eval-frame. Two
rules fall out and they are different rules: exposure INHERITS STRICTLY, rules fall out and they are different rules: exposure INHERITS STRICTLY,
because a head cutting on odd frames against a mouth cutting on even ones reads because a head cutting on odd frames against a mouth cutting on even ones reads
as two performances; offset is PER-NODE by design, because mouth lead applies as two performances; offset is PER-NODE by design, because mouth lead applies

18
frontend/src/arthur/domain/project.cljs
View file

@ -1,12 +1,12 @@
(ns arthur.domain.project (ns arthur.domain.project
"A clip <-> the document that travels. The tier split, as a pair of functions. "A clip <-> the document that travels. The tier split, as a pair of functions.
`save` takes what `flow/freeze` produced — `{:scene ... :store ...}` — and `save` takes what `flow/freeze` produced — `{:clip ... :store ...}` — and
returns two things that are allowed on the wire for different reasons: returns two things that are allowed on the wire for different reasons:
:leaves TIER 1. The document. Nodes, channels, subjects, features, groups, :leaves TIER 1. The document. Timelines, nodes, channels, subjects,
time maps, the analysis record. Kilobytes, and every byte of it features, groups, time maps, the analysis record. Kilobytes, and
authored or authorable. every byte of it authored or authorable.
:blocks TIER 2. The dense blocks the document NAMES, each with the :blocks TIER 2. The dense blocks the document NAMES, each with the
descriptor its key is the hash of. Megabytes, content-addressed, descriptor its key is the hash of. Megabytes, content-addressed,
@ -57,11 +57,11 @@
\"clip/\" would be lost on the way back in. \"clip/\" would be lost on the way back in.
Refuses a document `domain/leaf` calls unaddressable, which is where a hand-made Refuses a document `domain/leaf` calls unaddressable, which is where a hand-made
scene with placeholder store keys — `demo/swarm`'s \"swarm/pos\" — stops rather clip with placeholder store keys — `demo/swarm`'s \"swarm/pos\" — stops rather
than being uploaded as a project that means something only on the machine that than being uploaded as a project that means something only on the machine that
made it." made it."
[cid {:keys [scene store]}] [cid {:keys [clip store]}]
(let [leaves (leaf/leaves cid scene) (let [leaves (leaf/leaves cid clip)
ps (leaf/problems leaves)] ps (leaf/problems leaves)]
(when (seq ps) (when (seq ps)
(throw (ex-info (str "this clip cannot be saved: " (first ps)) (throw (ex-info (str "this clip cannot be saved: " (first ps))
@ -83,13 +83,13 @@
(block-keys leaves)))}))) (block-keys leaves)))})))
(defn load (defn load
"The parsed response -> `{:scene :store}`, which is what `flow/freeze` returns "The parsed response -> `{:clip :store}`, which is what `flow/freeze` returns
and therefore what the player already knows how to play." and therefore what the player already knows how to play."
[cid ^js doc] [cid ^js doc]
(let [leaves (.-leaves doc) (let [leaves (.-leaves doc)
tier1 (into {} (map (fn [path] [path (wire/decode-json (aget leaves path))])) tier1 (into {} (map (fn [path] [path (wire/decode-json (aget leaves path))]))
(js-keys leaves))] (js-keys leaves))]
{:scene (leaf/scene cid tier1) {:clip (leaf/clip cid tier1)
:store (into {} :store (into {}
(map (fn [^js b] (map (fn [^js b]
[(.-key b) [(.-key b)

2
frontend/src/arthur/domain/raster.cljs
View file

@ -30,7 +30,7 @@
edge landing exactly on a pixel boundary resolves consistently. edge landing exactly on a pixel boundary resolves consistently.
Flat and preallocated because this is the per-frame path: fixed topology means Flat and preallocated because this is the per-frame path: fixed topology means
a node's vertex count is known at freeze time, so scene/resolver hands the same a node's vertex count is known at freeze time, so timeline/resolver hands the same
buffer back every frame and a frame allocates nothing. At 30fps per-frame buffer back every frame and a frame allocates nothing. At 30fps per-frame
allocation is the only thing that will make this stutter. allocation is the only thing that will make this stutter.

123
frontend/src/arthur/domain/scene.cljs → frontend/src/arthur/domain/timeline.cljs
View file

@ -1,12 +1,38 @@
(ns arthur.domain.scene (ns arthur.domain.timeline
"The scene: a flat map of id -> node, and the two ways to evaluate it at a "A TIMELINE: an ordered bag of nodes in its own frame space, and the two ways to
frame. evaluate it at a frame.
(eval-frame scene f store) THE SPECIFICATION. Allocating, order-free, {:id :main :frames 229 :nodes {id -> node} :palette nil}
That is the whole type, and EVERYTHING THAT HOLDS NODES IS ONE OF THESE. A
clip's root timeline is one; a symbol in the library is one; a `:kind :symbol`
node is an INSTANCE of one. An earlier arrangement had the clip's node tree and
a library symbol as two structures with the same fields and never said they were
the same thing — the clip map carried `:fps`, `:width`, `:height`, `:analysis`
and the tracking identities alongside `:nodes`, so a symbol had nowhere to live
that was not a clip with seven meaningless fields. Flash's `_root` is a
MovieClip and After Effects' pre-comp is just a layer; collapsing them is what
makes nesting arbitrary and free rather than a feature to be added.
The clip-level facts are in `arthur.domain.clip`. A timeline has a FRAME SPACE,
not a rate and not a size: `:fps` is the clip's, because a rate is a fact about
how fast the whole thing plays, and a nested timeline cannot have its own.
TWO AXES OF NESTING, and conflating them is why \"nested\" and \"flat with parent
pointers\" sound contradictory when they are not. Parent/child is transform
composition WITHIN one timeline and is stored flat with pointers. Instance is a
timeline inside another timeline and is stored by reference into the library.
Each timeline is flat; timelines nest. Every argument for flat storage —
addressability, one-field reparenting, structural sharing, per-node sync leaves —
is about the first axis and is untouched by the second.
Two ways to evaluate one at a frame:
(eval-frame tl f store) THE SPECIFICATION. Allocating, order-free,
obviously correct. Use it in tests and for a obviously correct. Use it in tests and for a
one-off render. one-off render.
(resolver scene store) -> (fn [f] ops). What playback uses. Caches the (resolver tl store) -> (fn [f] ops). What playback uses. Caches the
topological order and the z paths, holds one topological order and the z paths, holds one
CURSOR per channel and one PREALLOCATED point CURSOR per channel and one PREALLOCATED point
buffer per node, so a frame allocates the op buffer per node, so a frame allocates the op
@ -16,8 +42,8 @@
read and where points are written. That is deliberate: two independent read and where points are written. That is deliberate: two independent
implementations of frame evaluation would drift, and the drift would look like implementations of frame evaluation would drift, and the drift would look like
a rendering bug rather than like two functions disagreeing. What differs a rendering bug rather than like two functions disagreeing. What differs
between them is exactly the part that can be wrong, and scene-test asserts they between them is exactly the part that can be wrong, and timeline-test asserts
agree frame for frame in forward, backward and random order. they agree frame for frame in forward, backward and random order.
The output is a list of DRAW OPS, and it is the boundary with the rasteriser: The output is a list of DRAW OPS, and it is the boundary with the rasteriser:
ops carry palette indices and raster-space points, and the rasteriser knows ops carry palette indices and raster-space points, and the rasteriser knows
@ -28,7 +54,6 @@
vector of numbers, and they read the same way, which is what makes freezing vector of numbers, and they read the same way, which is what makes freezing
fill in the same channel rather than convert into a second format." fill in the same channel rather than convert into a second format."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.feature :as feature]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal])) [arthur.domain.palette :as pal]))
@ -50,12 +75,12 @@
(when-let [p (:parent (get nodes i))] (when-let [p (:parent (get nodes i))]
(if (contains? nodes p) (if (contains? nodes p)
p p
(throw (ex-info "node's :parent is not in the scene" (throw (ex-info "node's :parent is not in the timeline"
{:node i :parent p}))))) {:node i :parent p})))))
chain (into [] (comp (take-while some?) (take (inc (count nodes)))) chain (into [] (comp (take-while some?) (take (inc (count nodes))))
(iterate up id))] (iterate up id))]
(when (> (count chain) (count nodes)) (when (> (count chain) (count nodes))
(throw (ex-info "parent cycle in scene" {:node id :chain chain}))) (throw (ex-info "parent cycle in timeline" {:node id :chain chain})))
chain)) chain))
(defn depth (defn depth
@ -103,9 +128,9 @@
"id -> its position in draw order. "id -> its position in draw order.
Computed ONCE. Draw order is a function of the z paths, which are structural — Computed ONCE. Draw order is a function of the z paths, which are structural —
they change when the scene changes and never because the playhead moved — so they change when the timeline changes and never because the playhead moved — so
sorting ops by z on every frame was re-deriving a constant thirty times a sorting ops by z on every frame was re-deriving a constant thirty times a
second. Here it is derived when the scene is, and a frame sorts small integers. second. Here it is derived when the timeline is, and a frame sorts small integers.
`sort-by` is stable and `ord` is topological, so nodes sharing a z path keep `sort-by` is stable and `ord` is topological, so nodes sharing a z path keep
parent-before-child order without a tiebreak field on every op." parent-before-child order without a tiebreak field on every op."
@ -203,7 +228,7 @@
flow/freeze writes it KEYED, because a threshold crossing is a handful of flow/freeze writes it KEYED, because a threshold crossing is a handful of
transitions and hold is the default, and because a human has to be able to fix transitions and hold is the default, and because a human has to be able to fix
one frame of it. When something does want a dense one it will land here loudly one frame of it. When something does want a dense one it will land here loudly
instead of blanking the scene. instead of blanking the timeline.
Absence is not a boolean and is not an error: a subject that is not on the Absence is not a boolean and is not an error: a subject that is not on the
frame has nothing to show." frame has nothing to show."
@ -291,6 +316,23 @@
(throw (ex-info "node kind is not implemented" (throw (ex-info "node kind is not implemented"
{:node (:id n) :kind (:kind n)}))))) {:node (:id n) :kind (:kind n)})))))
(defn- nodes-of
"The timeline's node map, REFUSING a map that has none.
A clip and a timeline both have an `:id` and both are maps, so handing a CLIP to
an evaluator is the one mistake this type split makes easy — and the result is
not an error, it is `(:nodes clip)` being nil and a frame resolving to no ops at
all. That reads as a black stage, or, in a benchmark, as \"0 nodes\" and a
flattering number. It happened once while the split was being made, which is why
this is a guard and not a comment."
[tl]
(let [nodes (:nodes tl)]
(when-not (map? nodes)
(throw (ex-info (str "not a timeline: :nodes is " (pr-str nodes)
" — a clip is not a timeline, its `:timelines` hold them")
{:keys (vec (sort-by str (keys tl)))})))
nodes))
(defn- eval-into (defn- eval-into
"One frame, as a fold over the nodes in topological order. "One frame, as a fold over the nodes in topological order.
@ -327,13 +369,17 @@
;; the specification ;; the specification
(defn eval-frame (defn eval-frame
"Scene at clip frame f -> draw ops in z order. Pure, and allocates freely. "Timeline at frame f -> draw ops in z order. Pure, and allocates freely.
`f` is in THIS timeline's frame space. At the clip's root that is clip frames;
inside an instance it is the instance's own space, and the instance boundary is
the only place the space changes.
This is the definition of what a frame means. `resolver` is what plays it." This is the definition of what a frame means. `resolver` is what plays it."
([scene f] (eval-frame scene f nil pal/index-of)) ([tl f] (eval-frame tl f nil pal/index-of))
([scene f store] (eval-frame scene f store pal/index-of)) ([tl f store] (eval-frame tl f store pal/index-of))
([scene f store palette] ([tl f store palette]
(let [nodes (:nodes scene) (let [nodes (nodes-of tl)
ord (order nodes)] ord (order nodes)]
(eval-into {:read (fn [_id _path c lf] (ch/value-at c lf store)) (eval-into {:read (fn [_id _path c lf] (ch/value-at c lf store))
:palette palette :palette palette
@ -385,10 +431,10 @@
The op maps themselves are allocated fresh, and deliberately: there are a dozen The op maps themselves are allocated fresh, and deliberately: there are a dozen
of them per frame against hundreds of points, so pooling them would buy of them per frame against hundreds of points, so pooling them would buy
nothing and cost the ability to hand an op list around as plain data." nothing and cost the ability to hand an op list around as plain data."
([scene] (resolver scene nil pal/index-of)) ([tl] (resolver tl nil pal/index-of))
([scene store] (resolver scene store pal/index-of)) ([tl store] (resolver tl store pal/index-of))
([scene store palette] ([tl store palette]
(let [nodes (:nodes scene) (let [nodes (nodes-of tl)
ord (order nodes) ord (order nodes)
rank (draw-rank nodes ord) rank (draw-rank nodes ord)
cursors (into {} cursors (into {}
@ -427,14 +473,31 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
(def timeline-keys
"Every field a timeline may carry, and the reason `arthur.domain.leaf` refuses
one it does not know: a field added without a leaf to save it in is a field that
saves silently and comes back missing.
`:palette` is in the vocabulary and nothing writes one yet. A timeline is where
a ramp belongs — `domain/timeline` takes the palette as a PARAMETER rather than
reaching for a global precisely so that a nested timeline can carry its own —
and leaving the field out would make the first one a migration instead of a
write."
#{:id :frames :nodes :palette})
(defn problems (defn problems
"Human-readable reasons this scene will not evaluate. Empty means it will. "Human-readable reasons this timeline will not evaluate. Empty means it will.
Node structure only. The tracking identities — subjects, features, groups — are
the CLIP's and are checked by `arthur.domain.clip/problems`, which is not a
layering nicety: a feature names nodes, and a library symbol's nodes are not
the ones a face was tracked into.
Total by construction — it reports a cycle rather than looping on one — because Total by construction — it reports a cycle rather than looping on one — because
its whole job is to be safe to run over authored data before that data is its whole job is to be safe to run over authored data before that data is
trusted." trusted."
[scene] [tl]
(let [nodes (:nodes scene)] (let [nodes (:nodes tl)]
(if-not (map? nodes) (if-not (map? nodes)
[":nodes must be a map of id -> node"] [":nodes must be a map of id -> node"]
(-> [] (-> []
@ -444,15 +507,19 @@
(into (for [[id n] nodes (into (for [[id n] nodes
:when (and (:parent n) (not (contains? nodes (:parent n))))] :when (and (:parent n) (not (contains? nodes (:parent n))))]
(str "node " (pr-str id) " has :parent " (pr-str (:parent n)) (str "node " (pr-str id) " has :parent " (pr-str (:parent n))
" which is not in the scene"))) " which is not in the timeline")))
(into (for [[id n] nodes (into (for [[id n] nodes
:when (and (:stencil n) (not (contains? nodes (:stencil n))))] :when (and (:stencil n) (not (contains? nodes (:stencil n))))]
(str "node " (pr-str id) " has :stencil " (pr-str (:stencil n)) (str "node " (pr-str id) " has :stencil " (pr-str (:stencil n))
" which is not in the scene"))) " which is not in the timeline")))
(into (for [[id n] nodes (into (for [[id n] nodes
p (node/problems n)] p (node/problems n)]
(str "node " (pr-str id) ": " p))) (str "node " (pr-str id) ": " p)))
(into (feature/problems scene)) (into (for [k (remove timeline-keys (keys tl))]
(str "timeline has a field with no leaf to save it in: " (pr-str k))))
(into (when-not (or (nil? (:frames tl)) (and (integer? (:frames tl)) (pos? (:frames tl))))
[(str ":frames is " (pr-str (:frames tl))
" — a timeline is a frame SPACE, so its length is a positive integer")]))
(into (try (into (try
(doall (map #(depth nodes %) (keys nodes))) (doall (map #(depth nodes %) (keys nodes)))
nil nil

14
frontend/src/arthur/events/footage.cljs
View file

@ -4,7 +4,8 @@
The frames come from the server by URL since step 9 — see `flow/ingest` — and the The frames come from the server by URL since step 9 — see `flow/ingest` — and the
detector's identity comes from the server too, because it goes into the content detector's identity comes from the server too, because it goes into the content
address of every block this produces." address of every block this produces."
(:require [arthur.events.playback :as pb] (:require [arthur.domain.clip :as clip]
[arthur.events.playback :as pb]
[arthur.flow.detect :as detect] [arthur.flow.detect :as detect]
[arthur.flow.ingest :as ingest] [arthur.flow.ingest :as ingest]
[arthur.flow.measure.interior :as interior] [arthur.flow.measure.interior :as interior]
@ -65,10 +66,11 @@
:dimensions dimensions :interior interior :dimensions dimensions :interior interior
:presence (:presence manifest) :presence (:presence manifest)
:detector detector}) :detector detector})
scene (:scene frozen)] built (:clip frozen)]
(assoc (select-keys scene [:fps :frames :width :height]) (assoc (select-keys built [:fps :width :height])
:display-fps (:fps scene) :frames (clip/frames built)
:scene scene :store (:store frozen) :display-fps (:fps built)
:clip built :store (:store frozen)
;; No cache-buster. The audio is a blob named by the hash of its own ;; No cache-buster. The audio is a blob named by the hash of its own
;; bytes, so re-extracting gives it a different URL rather than ;; bytes, so re-extracting gives it a different URL rather than
;; overwriting this one — which is what the `?v=` here used to work ;; overwriting this one — which is what the `?v=` here used to work
@ -156,7 +158,7 @@
(fn [{:keys [db]} [_ id summary]] (fn [{:keys [db]} [_ id summary]]
(let [clip (store/entry id)] (let [clip (store/entry id)]
{:db (-> db {:db (-> db
(assoc :scene/current id (assoc :clip/current id
:clip (select-keys clip [:fps :frames :width :height :audio :display-fps]) :clip (select-keys clip [:fps :frames :width :height :audio :display-fps])
:footage (assoc (:footage db) :id id :label (:label clip) :footage (assoc (:footage db) :id id :label (:label clip)
:loading? false :status summary)) :loading? false :status summary))

4
frontend/src/arthur/events/playback.cljs
View file

@ -94,14 +94,14 @@
{:db (assoc-in db [:playback :muted?] on?) ::mute! on?}))) {:db (assoc-in db [:playback :muted?] on?) ::mute! on?})))
(rf/reg-event-fx (rf/reg-event-fx
::select-scene ::select-clip
(fn [{:keys [db]} [_ id]] (fn [{:keys [db]} [_ id]]
;; Changing the clip changes the resolver, the frame count and the rate all ;; Changing the clip changes the resolver, the frame count and the rate all
;; at once, so the playhead goes home rather than being left pointing at a ;; at once, so the playhead goes home rather than being left pointing at a
;; frame the new clip may not have. ;; frame the new clip may not have.
(let [{:keys [fps frames] :as clip} (footage/entry id)] (let [{:keys [fps frames] :as clip} (footage/entry id)]
{:db (-> db {:db (-> db
(assoc :scene/current id) (assoc :clip/current id)
;; The stage travels with the clip: two clips may be different ;; The stage travels with the clip: two clips may be different
;; sizes, and the raster the loop paints into is the clip's, not ;; sizes, and the raster the loop paints into is the clip's, not
;; the app's. ;; the app's.

24
frontend/src/arthur/events/project.cljs
View file

@ -21,7 +21,8 @@
Nothing here touches app-db except through events. The promise chain lives in an Nothing here touches app-db except through events. The promise chain lives in an
fx, which is the only thing in this namespace that is not pure." fx, which is the only thing in this namespace that is not pure."
(:require [arthur.domain.project :as project] (:require [arthur.domain.clip :as clip]
[arthur.domain.project :as project]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.footage.store :as store] [arthur.footage.store :as store]
[arthur.flow.address :as address] [arthur.flow.address :as address]
@ -67,7 +68,7 @@
(rf/reg-fx (rf/reg-fx
::save! ::save!
(fn [{:keys [id cid label clip]}] (fn [{:keys [id cid label clip]}]
(let [analysis (:analysis (:scene clip)) (let [analysis (:analysis (:clip clip))
doc (project/save cid clip)] doc (project/save cid clip)]
(-> (ensure-project! id label) (-> (ensure-project! id label)
(.then (fn [pid] (.then (fn [pid]
@ -114,18 +115,19 @@
(.then (fn [blocks] (.then (fn [blocks]
(let [doc #js {:leaves (.-leaves clip-json) :blocks blocks} (let [doc #js {:leaves (.-leaves clip-json) :blocks blocks}
cid (.-cid clip-json) cid (.-cid clip-json)
clip (project/load cid doc) loaded' (project/load cid doc)
scene (:scene clip) built (:clip loaded')
entry (merge entry (merge
(select-keys scene [:fps :frames :width :height]) (select-keys built [:fps :width :height])
{:label (str (or (.-name clip-json) cid) " (saved)") {:label (str (or (.-name clip-json) cid) " (saved)")
:cid cid :cid cid
:display-fps (:fps scene) :frames (clip/frames built)
:scene scene :display-fps (:fps built)
:store (:store clip) :clip built
:store (:store loaded')
;; The audio is the clip's, and a ;; The audio is the clip's, and a
;; document does not carry it: tier 3 ;; document does not carry it: tier 3
;; is by hash and the scene names the ;; is by hash and the clip names the
;; analysis, not the sound. Until the ;; analysis, not the sound. Until the
;; footage id is in the document, the ;; footage id is in the document, the
;; synthetic take's is the one that ;; synthetic take's is the one that
@ -146,7 +148,7 @@
(rf/reg-event-fx (rf/reg-event-fx
::save ::save
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
(let [id (:scene/current db) (let [id (:clip/current db)
clip (store/entry id)] clip (store/entry id)]
(if (or (:busy? (:project db)) (nil? clip)) (if (or (:busy? (:project db)) (nil? clip))
{} {}
@ -179,7 +181,7 @@
(fn [{:keys [db]} [_ clip-id project-id name seq]] (fn [{:keys [db]} [_ clip-id project-id name seq]]
(let [clip (store/entry clip-id)] (let [clip (store/entry clip-id)]
{:db (-> db {:db (-> db
(assoc :scene/current clip-id (assoc :clip/current clip-id
:clip (select-keys clip [:fps :frames :width :height :audio :display-fps])) :clip (select-keys clip [:fps :frames :width :height :audio :display-fps]))
(update :project merge (update :project merge
{:id project-id :name name :seq seq :cid (:cid clip) {:id project-id :name name :seq seq :cid (:cid clip)

28
frontend/src/arthur/flow/freeze.cljs
View file

@ -33,6 +33,7 @@
plate, which a human draws, is worth decimating. Sparse visibility keys capture plate, which a human draws, is worth decimating. Sparse visibility keys capture
decisions about the mouth cavity, blink and teeth without thinning geometry." decisions about the mouth cavity, blink and teeth without thinning geometry."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.geom :as geom] [arthur.domain.geom :as geom]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.flow.address :as address])) [arthur.flow.address :as address]))
@ -276,11 +277,11 @@
vectors. It may not store what `value-at` handed it: a wide dense read is a vectors. It may not store what `value-at` handed it: a wide dense read is a
VIEW into the block, and a view into tier 2 sitting in the document is a value VIEW into the block, and a view into tier 2 sitting in the document is a value
that changes when a re-freeze rewrites the array under it." that changes when a re-freeze rewrites the array under it."
[{:keys [mode kept]} {:keys [scene store]}] [{:keys [mode kept]} {:keys [clip store]}]
(when-not (contains? head-modes mode) (when-not (contains? head-modes mode)
(throw (ex-info "head mode is not one of the three channel shapes" (throw (ex-info "head mode is not one of the three channel shapes"
{:mode mode :modes head-modes}))) {:mode mode :modes head-modes})))
(let [base (get-in scene [:nodes :head :measured]) (let [base (get-in (clip/root clip) [:nodes :head :measured])
at (fn [path f] at (fn [path f]
(let [v (ch/value-at (get base path) f store) (let [v (ch/value-at (get base path) f store)
n (:stride (:dense (get base path)))] n (:stride (:dense (get base path)))]
@ -292,7 +293,7 @@
(when (and (= mode :per-plate) (empty? kept)) (when (and (= mode :per-plate) (empty? kept))
(throw (ex-info "the per-plate head mode needs a kept-frame set; it is the plate strip's, not measurement's" (throw (ex-info "the per-plate head mode needs a kept-frame set; it is the plate strip's, not measurement's"
{:mode mode}))) {:mode mode})))
(assoc-in scene [:nodes :head :channels] (assoc-in clip [:timelines clip/root-id :nodes :head :channels]
(case mode (case mode
;; No `:generated` on the locked shape, and that is not an ;; No `:generated` on the locked shape, and that is not an
;; oversight: nothing generated this identity. It is a decision, ;; oversight: nothing generated this identity. It is a decision,
@ -655,8 +656,7 @@
roto (fn [by] (prov by {:verts verts :contour-avg contour-avg})) roto (fn [by] (prov by {:verts verts :contour-avg contour-avg}))
features (when (and eyes brows) (feature-parts absent? obs params inputs)) features (when (and eyes brows) (feature-parts absent? obs params inputs))
interior (when teeth (interior-part params absent? obs teeth)) interior (when teeth (interior-part params absent? obs teeth))
scene {:name name built {:name name
:frames nf
:fps fps :fps fps
;; Tier 1 says which analysis its channels came out of, in full. ;; Tier 1 says which analysis its channels came out of, in full.
;; The id alone would make the document unreadable the first time ;; The id alone would make the document unreadable the first time
@ -688,6 +688,14 @@
;; face-placement: nothing below here knows the frame size. ;; face-placement: nothing below here knows the frame size.
:width (first stage) :width (first stage)
:height (second stage) :height (second stage)
;; ONE TIMELINE, and the frame count is ITS. A clip is a rate and
;; a timeline is a frame space — see arthur.domain.clip — so `nf`
;; lands here and `:fps` above, and the library a symbol will live
;; in is this same map with a second entry.
:timelines
{clip/root-id
{:id clip/root-id
:frames nf
:nodes :nodes
(merge (merge
{:root {:root
@ -721,7 +729,7 @@
[:vis] (visibility params inputs [:vis] (visibility params inputs
(prov :roto/mouth-aperture (prov :roto/mouth-aperture
{:aperture-cut aperture-cut}))}}} {:aperture-cut aperture-cut}))}}}
(:nodes features) (:nodes interior))} (:nodes features) (:nodes interior))}}}
;; Tier 2, behind a handle, and now behind a content address: every key is ;; Tier 2, behind a handle, and now behind a content address: every key is
;; a sha256 over the analysis, the settings and the absence data that ;; a sha256 over the analysis, the settings and the absence data that
;; produced the bytes under it. Nothing above this line changed when they ;; produced the bytes under it. Nothing above this line changed when they
@ -729,8 +737,8 @@
store (merge (stored rings pos rot scale) store (merge (stored rings pos rot scale)
(:store features) (:store interior))] (:store features) (:store interior))]
(doseq [id (keys presence)] (doseq [id (keys presence)]
(when-not (contains? (:features scene) id) (when-not (contains? (:features built) id)
(throw (ex-info "presence track names no feature in this scene" (throw (ex-info "presence track names no feature in this clip"
{:feature id :features (keys (:features scene))})))) {:feature id :features (keys (:features built))}))))
{:store store {:store store
:scene (head-mode {:mode head :kept kept} {:scene scene :store store})})) :clip (head-mode {:mode head :kept kept} {:clip built :store store})}))

8
frontend/src/arthur/footage/store.cljs
View file

@ -3,9 +3,9 @@
Two things arrive this way and they are the same kind of thing: footage that has Two things arrive this way and they are the same kind of thing: footage that has
been detected and frozen, and a project opened from the server. Both are been detected and frozen, and a project opened from the server. Both are
`{:scene ... :store ...}` — which is what `flow/freeze` returns — plus the clip `{:clip ... :store ...}` — which is what `flow/freeze` returns — plus what the
facts the transport needs, and both hold typed arrays that have no business being transport reads off the clip, and both hold typed arrays that have no business
in a map every mounted subscription compares." being in a map every mounted subscription compares."
(:require [arthur.db :as db])) (:require [arthur.db :as db]))
(defonce ^:private loaded (atom nil)) (defonce ^:private loaded (atom nil))
@ -27,4 +27,4 @@
(defn entry [id] (defn entry [id]
(if (= id (:id @loaded)) (if (= id (:id @loaded))
@loaded @loaded
(get db/scenes id))) (get db/clips id)))

60
frontend/src/arthur/subs/render.cljs
View file

@ -7,47 +7,55 @@
CLOSURE that produces geometry at a frame. So a scene edit costs one CLOSURE that produces geometry at a frame. So a scene edit costs one
recomputation here and a frame costs a lookup and a blit — and, crucially, the recomputation here and a frame costs a lookup and a blit — and, crucially, the
playhead is not an input, so moving it cannot invalidate this." playhead is not an input, so moving it cannot invalidate this."
(:require [arthur.domain.palette :as pal] (:require [arthur.domain.clip :as clip]
[arthur.domain.scene :as scene] [arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]
[arthur.footage.store :as footage] [arthur.footage.store :as footage]
[arthur.subs.playback :as playback] [arthur.subs.playback :as playback]
[re-frame.core :as rf])) [re-frame.core :as rf]))
(rf/reg-sub ::scene-id (fn [db _] (:scene/current db))) (rf/reg-sub ::clip-id (fn [db _] (:clip/current db)))
(rf/reg-sub (rf/reg-sub
::base-scene ::clip
:<- [::scene-id] :<- [::clip-id]
(fn [id _] (:scene (footage/entry id)))) (fn [id _] (:clip (footage/entry id))))
(rf/reg-sub (rf/reg-sub
::scene ::timeline
:<- [::base-scene] :<- [::clip]
:<- [::playback/display-fps] :<- [::playback/display-fps]
(fn [[scene picture-fps] _] (fn [[clip picture-fps] _]
;; This changes only the scene's root time map. The dense source track stays ;; The ROOT timeline, with picture sampling written onto its root node's time
;; at its native rate, and the audio clock still advances through source time. ;; map. Only that node's time map changes: the dense source track stays at its
(if (and scene picture-fps (< picture-fps (:fps scene))) ;; native rate and the audio clock still advances through source time.
(-> scene ;;
(assoc-in [:nodes :root :time :source-fps] (:fps scene)) ;; `:fps` is read off the CLIP and `:frames` off the timeline, which is the
;; whole reason the two came apart — the source cadence is a fact about how fast
;; the clip plays against its audio, and a nested timeline will not have one.
(when-let [tl (clip/root clip)]
(if (and picture-fps (< picture-fps (:fps clip)))
(-> tl
(assoc-in [:nodes :root :time :source-fps] (:fps clip))
(assoc-in [:nodes :root :time :sample-fps] picture-fps)) (assoc-in [:nodes :root :time :sample-fps] picture-fps))
scene))) tl))))
(rf/reg-sub (rf/reg-sub
::exposure ::exposure
:<- [::scene] :<- [::timeline]
(fn [scene _] (fn [tl _]
;; Exposure lives on the clip root and is INHERITED, so reading it there is ;; Exposure lives on the timeline's root node and is INHERITED, so reading it
;; reading it everywhere. The transport shows it so that `exposure 2` is ;; there is reading it everywhere. The transport shows it so that `exposure 2`
;; visibly doing something at the transport rather than only inside the scene. ;; is visibly doing something at the transport rather than only inside the
(or (get-in scene [:nodes :root :time :expose]) 1))) ;; document.
(or (get-in tl [:nodes :root :time :expose]) 1)))
(rf/reg-sub (rf/reg-sub
::palette ::palette
(fn [db _] (fn [db _]
;; A NAME resolves to a ramp. One today; when timelines carry a `:palette` ;; A NAME resolves to a ramp. One today; when timelines carry a `:palette`
;; channel this becomes the project's table and the walk carries the ramp in ;; channel this becomes the project's table and the walk carries the ramp in
;; scope, which is why domain/scene takes the palette as a parameter rather ;; scope, which is why domain/timeline takes the palette as a parameter rather
;; than reaching for a global. ;; than reaching for a global.
(get {:arthur/default pal/index-of} (:palette db) pal/index-of))) (get {:arthur/default pal/index-of} (:palette db) pal/index-of)))
@ -62,7 +70,7 @@
(rf/reg-sub (rf/reg-sub
::store ::store
:<- [::scene-id] :<- [::clip-id]
(fn [id _] (fn [id _]
;; Tier 2, behind a handle, and never in app-db itself — what is in the db is ;; Tier 2, behind a handle, and never in app-db itself — what is in the db is
;; the id of the clip whose blocks these are. The hand-written demo has none; ;; the id of the clip whose blocks these are. The hand-written demo has none;
@ -71,8 +79,8 @@
(rf/reg-sub (rf/reg-sub
::resolver ::resolver
:<- [::scene] :<- [::timeline]
:<- [::store] :<- [::store]
:<- [::palette] :<- [::palette]
(fn [[scene store palette] _] (fn [[tl store palette] _]
(scene/resolver scene store palette))) (when tl (timeline/resolver tl store palette))))

2
frontend/src/arthur/ui/player.cljs
View file

@ -10,7 +10,7 @@
canvas from an animation frame; it is a sink, not a view that re-renders, and canvas from an animation frame; it is a sink, not a view that re-renders, and
the actual content of the folklore about re-frame and canvas is that expensive the actual content of the folklore about re-frame and canvas is that expensive
work must not live in a layer-2 sub. The resolver is a layer-3 sub over the work must not live in a layer-2 sub. The resolver is a layer-3 sub over the
scene, so the playhead moving cannot invalidate it. timeline, so the playhead moving cannot invalidate it.
The one dispatch is `::playback/tick`, and it is deliberately NOT what the The one dispatch is `::playback/tick`, and it is deliberately NOT what the
picture waits on: the frame is painted from the clock directly, and the tick picture waits on: the frame is painted from the clock directly, and the tick

12
frontend/src/arthur/ui/shell.cljs
View file

@ -37,7 +37,7 @@
frames @(rf/subscribe [::sub/frames]) frames @(rf/subscribe [::sub/frames])
fps @(rf/subscribe [::sub/fps]) fps @(rf/subscribe [::sub/fps])
picture-fps @(rf/subscribe [::sub/display-fps]) picture-fps @(rf/subscribe [::sub/display-fps])
current @(rf/subscribe [::render/scene-id]) current @(rf/subscribe [::render/clip-id])
expose @(rf/subscribe [::render/exposure]) expose @(rf/subscribe [::render/exposure])
{:keys [id label loading? status available chosen]} @(rf/subscribe [::sub/footage]) {:keys [id label loading? status available chosen]} @(rf/subscribe [::sub/footage])
{project-name :name :keys [busy?] project-status :status {project-name :name :keys [busy?] project-status :status
@ -55,14 +55,14 @@
:on-click #(rf/dispatch [::pb/toggle-mute])} "mute"] :on-click #(rf/dispatch [::pb/toggle-mute])} "mute"]
[:span.gap] [:span.gap]
(doall (doall
(for [[id {:keys [label]}] db/scenes] (for [[id {:keys [label]}] db/clips]
^{:key id} ^{:key id}
[:button {:class (when (= id @(rf/subscribe [::render/scene-id])) "on") [:button {:class (when (= id @(rf/subscribe [::render/clip-id])) "on")
:on-click #(rf/dispatch [::pb/select-scene id])} :on-click #(rf/dispatch [::pb/select-clip id])}
label])) label]))
(when id (when id
[:button {:class (when (= id @(rf/subscribe [::render/scene-id])) "on") [:button {:class (when (= id @(rf/subscribe [::render/clip-id])) "on")
:on-click #(rf/dispatch [::pb/select-scene id])} :on-click #(rf/dispatch [::pb/select-clip id])}
(or label "footage")]) (or label "footage")])
[:button {:disabled (or loading? (nil? chosen)) [:button {:disabled (or loading? (nil? chosen))
:on-click #(rf/dispatch [::footage/load])} :on-click #(rf/dispatch [::footage/load])}

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

@ -10,9 +10,10 @@
here would fail on a loaded CI box and teach everyone to ignore it." here would fail on a loaded CI box and teach everyone to ignore it."
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is]]
[arthur.demo.swarm :as swarm] [arthur.demo.swarm :as swarm]
[arthur.domain.clip :as clip]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.raster :as raster] [arthur.domain.raster :as raster]
[arthur.domain.scene :as scene])) [arthur.domain.timeline :as timeline]))
(defn- ms [label n f] (defn- ms [label n f]
(let [t0 (js/Date.now)] (let [t0 (js/Date.now)]
@ -23,11 +24,11 @@
(/ dt n)))) (/ dt n))))
(deftest bench (deftest bench
(let [res (scene/resolver @swarm/scene @swarm/store pal/index-of) (let [res (timeline/resolver (clip/root @swarm/clip) @swarm/store pal/index-of)
ras (raster/make 320 200) ras (raster/make 320 200)
dest (js/Uint8ClampedArray. (* 320 200 4)) dest (js/Uint8ClampedArray. (* 320 200 4))
n 120] n 120]
(println "\nswarm:" (count (:nodes @swarm/scene)) "nodes") (println "\nswarm:" (count (clip/nodes @swarm/clip)) "nodes")
(let [a (ms "resolve " n (fn [i] (res (mod i 229)))) (let [a (ms "resolve " n (fn [i] (res (mod i 229))))
b (ms "resolve+draw " n (fn [i] b (ms "resolve+draw " n (fn [i]
(raster/clear! ras 0) (raster/clear! ras 0)

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

@ -4,74 +4,97 @@
subtly smaller, and the loss is discovered later, by somebody whose work is subtly smaller, and the loss is discovered later, by somebody whose work is
already gone. already gone.
So the assertion is exact equality on the real scenes — the frozen take in both 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 head modes, the hand-written demo, the swarm — rather than on a fixture, and
`scene-keys` makes a field added without a leaf fail loudly instead." `clip/clip-keys` plus `timeline/timeline-keys` make a field added without a leaf
fail loudly instead."
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[arthur.demo :as demo] [arthur.demo :as demo]
[arthur.demo.swarm :as swarm] [arthur.demo.swarm :as swarm]
[arthur.demo.take :as take] [arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf])) [arthur.domain.leaf :as leaf]))
(deftest every-real-scene-survives-the-split-exactly (defn- one-timeline
(doseq [[label scene] [["the frozen take" @take/scene] "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}}})
(deftest every-real-clip-survives-the-split-exactly
(doseq [[label c] [["the frozen take" @take/clip]
["the locked take" @take/locked] ["the locked take" @take/locked]
["the hand-written demo" demo/scene] ["the hand-written demo" demo/clip]
["the swarm" @swarm/scene]]] ["the swarm" @swarm/clip]]]
(testing label (testing label
(is (= scene (leaf/scene :c1 (leaf/leaves :c1 scene))))))) (is (= c (leaf/clip :c1 (leaf/leaves :c1 c)))))))
(deftest the-leaves-are-the-paths-the-sync-design-names (deftest the-leaves-are-the-paths-the-sync-design-names
(let [ls (leaf/leaves :c7 @take/scene)] (let [ls (leaf/leaves :c7 @take/clip)]
(is (contains? ls "clip/c7/timing")) (is (contains? ls "clip/c7/timing"))
(is (contains? ls "clip/c7/stage")) (is (contains? ls "clip/c7/stage"))
(is (contains? ls "clip/c7/source")) (is (contains? ls "clip/c7/source"))
(is (contains? ls "clip/c7/node/mouth")) ;; A TIMELINE ID IS A SEGMENT, which is what lets a symbol's nodes be
(is (contains? ls "clip/c7/channel/mouth/geom.pts")) ;; addressed by the same path shape as the clip's own. `main` is the root.
(is (contains? ls "clip/c7/channel/mouth-in/vis")) (is (contains? ls "clip/c7/timeline/main"))
(is (= {:frames 229} (get ls "clip/c7/timeline/main"))
"a timeline's leaf is its frame space; :fps is the clip's")
(is (contains? ls "clip/c7/timeline/main/node/mouth"))
(is (contains? ls "clip/c7/timeline/main/channel/mouth/geom.pts"))
(is (contains? ls "clip/c7/timeline/main/channel/mouth-in/vis"))
(is (contains? ls "clip/c7/feature/eye-r")) (is (contains? ls "clip/c7/feature/eye-r"))
(is (contains? ls "clip/c7/group/eyes-1")) (is (contains? ls "clip/c7/group/eyes-1"))
(is (contains? ls "clip/c7/subject/face-1")) (is (contains? ls "clip/c7/subject/face-1"))
;; `:head`'s measured channels are written together by a freeze and replaced ;; `: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. ;; together by a re-freeze, so they are one leaf and not three.
(is (contains? ls "clip/c7/measured/head")) (is (contains? ls "clip/c7/timeline/main/measured/head"))
(is (= 3 (count (get ls "clip/c7/measured/head")))))) (is (= 3 (count (get ls "clip/c7/timeline/main/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.
(is (= {:fps 30} (get ls "clip/c7/timing")))))
(deftest a-node-and-its-channels-are-different-leaves (deftest a-node-and-its-channels-are-different-leaves
;; The boundary that lets two people key different parts without meeting. A node ;; The boundary that lets two people key different parts without meeting. A node
;; leaf carries structure and no geometry. ;; leaf carries structure and no geometry.
(let [ls (leaf/leaves :c1 @take/scene) (let [ls (leaf/leaves :c1 @take/clip)
n (get ls "clip/c1/node/mouth")] n (get ls "clip/c1/timeline/main/node/mouth")]
(is (= {:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"} n)) (is (= {:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"} n))
(is (nil? (:channels n))) (is (nil? (:channels n)))
(is (:animated? (get ls "clip/c1/channel/mouth/geom.pts"))))) (is (:animated? (get ls "clip/c1/timeline/main/channel/mouth/geom.pts")))))
(deftest a-field-with-no-leaf-is-refused-rather-than-dropped (deftest a-field-with-no-leaf-is-refused-rather-than-dropped
;; The invariant that keeps the round trip exact as the model grows: a scene ;; The invariant that keeps the round trip exact as the model grows: a field
;; field nobody gave a leaf to would save silently and come back missing. ;; nobody gave a leaf to would save silently and come back missing. Asserted at
;; BOTH levels now, because there are two types that can grow one.
(is (thrown-with-msg? ExceptionInfo #"no leaf to save it in" (is (thrown-with-msg? ExceptionInfo #"no leaf to save it in"
(leaf/leaves :c1 (assoc @take/scene :sequences [])))) (leaf/leaves :c1 (assoc @take/clip :sequences []))))
(is (= leaf/scene-keys (set (keys (assoc @take/scene :name "x")))) (is (thrown-with-msg? ExceptionInfo #"no leaf to save it in"
"scene-keys has drifted from what a frozen scene actually holds")) (leaf/leaves :c1 (assoc-in @take/clip
[:timelines :main :markers] []))))
(is (= clip/clip-keys (set (keys (assoc @take/clip :name "x"))))
"clip-keys has drifted from what a frozen clip actually holds"))
(deftest an-absent-field-stays-absent (deftest an-absent-field-stays-absent
;; A scene with no fps must not come back with `:fps nil`. `=` is the test, and ;; A clip with no analysis must not come back with `:analysis nil`. `=` is the
;; the demo scene is the case: it has no analysis record and its root has no ;; test, and the demo is the case: no analysis record, and its root node has no
;; channels. ;; channels.
(let [ls (leaf/leaves :c1 demo/scene)] (let [ls (leaf/leaves :c1 demo/clip)]
(is (not (contains? ls "clip/c1/source"))) (is (not (contains? ls "clip/c1/source")))
(is (not (contains? (leaf/scene :c1 ls) :analysis))) (is (not (contains? (leaf/clip :c1 ls) :analysis)))
(is (not (contains? (get-in (leaf/scene :c1 ls) [:nodes :root]) :channels))))) (is (not (contains? (get-in (leaf/clip :c1 ls)
[:timelines :main :nodes :root])
:channels)))))
(deftest a-namespaced-id-is-one-path-segment (deftest a-namespaced-id-is-one-path-segment
;; docs/architecture.md draws a node as `:eye-r/iris`, and a leaf path is ;; docs/architecture.md draws a node as `:eye-r/iris`, and a leaf path is
;; "/"-delimited, so the two have to be reconciled somewhere. ;; "/"-delimited, so the two have to be reconciled somewhere.
(let [scene {:nodes {:eye-r/iris {:id :eye-r/iris :kind :disc :parent nil :z "a1" (let [c (one-timeline {:eye-r/iris {:id :eye-r/iris :kind :disc :parent nil :z "a1"
:channels {[:geom :radius] (ch/framed 2)}}}} :channels {[:geom :radius] (ch/framed 2)}}})
ls (leaf/leaves :c1 scene)] ls (leaf/leaves :c1 c)]
(is (contains? ls "clip/c1/node/eye-r~iris")) (is (contains? ls "clip/c1/timeline/main/node/eye-r~iris"))
(is (= scene (leaf/scene :c1 ls)))) (is (= c (leaf/clip :c1 ls))))
;; `(keyword "a~b")` rather than a literal: ~ is unquote in CLJS source. ;; `(keyword "a~b")` rather than a literal: ~ is unquote in CLJS source.
(is (thrown-with-msg? ExceptionInfo #"cannot contain ~" (is (thrown-with-msg? ExceptionInfo #"cannot contain ~"
(leaf/segment (keyword "a~b"))))) (leaf/segment (keyword "a~b")))))
@ -79,10 +102,10 @@
(deftest another-clips-leaves-are-ignored-rather-than-merged (deftest another-clips-leaves-are-ignored-rather-than-merged
;; A project's whole leaf map can be handed in for one clip, which is what makes ;; A project's whole leaf map can be handed in for one clip, which is what makes
;; a two-clip project one fetch. ;; a two-clip project one fetch.
(let [a (leaf/leaves :a @take/scene) (let [a (leaf/leaves :a @take/clip)
b (leaf/leaves :b demo/scene)] b (leaf/leaves :b demo/clip)]
(is (= @take/scene (leaf/scene :a (merge a b)))) (is (= @take/clip (leaf/clip :a (merge a b))))
(is (= demo/scene (leaf/scene :b (merge a b)))))) (is (= demo/clip (leaf/clip :b (merge a b))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; what a document may not contain ;; what a document may not contain
@ -91,20 +114,33 @@
;; `demo/swarm` names its blocks "swarm/pos", which is exactly the descriptive ;; `demo/swarm` names its blocks "swarm/pos", which is exactly the descriptive
;; key content addressing replaced: a handle that only means something on the ;; key content addressing replaced: a handle that only means something on the
;; machine that made it. It is a fine load test and not a document. ;; machine that made it. It is a fine load test and not a document.
(let [ps (leaf/problems (leaf/leaves :c1 @swarm/scene))] (let [ps (leaf/problems (leaf/leaves :c1 @swarm/clip))]
(is (seq ps)) (is (seq ps))
(is (some #(re-find #"names tier 2 as \"swarm/pos\"" %) ps) (pr-str (first ps))))) (is (some #(re-find #"names tier 2 as \"swarm/pos\"" %) ps) (pr-str (first ps)))))
(deftest a-frozen-clip-has-no-problems (deftest a-frozen-clip-has-no-problems
(is (empty? (leaf/problems (leaf/leaves :c1 @take/scene)))) (is (empty? (leaf/problems (leaf/leaves :c1 @take/clip))))
(is (empty? (leaf/problems (leaf/leaves :c1 @take/locked))))) (is (empty? (leaf/problems (leaf/leaves :c1 @take/locked)))))
(deftest a-channel-leaf-for-a-node-that-is-not-there-is-named (deftest a-channel-leaf-for-a-node-that-is-not-there-is-named
(let [ls (dissoc (leaf/leaves :c1 @take/scene) "clip/c1/node/mouth")] (let [ls (dissoc (leaf/leaves :c1 @take/clip) "clip/c1/timeline/main/node/mouth")]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-node-leaf-is-scoped-to-its-own-timeline
;; 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"
{:id :mouth :kind :poly :parent nil :z "a1"})
(dissoc "clip/c1/timeline/main/node/mouth"))]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls))))) (is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-property-with-path-punctuation-in-it-is-refused (deftest a-property-with-path-punctuation-in-it-is-refused
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"cannot contain . or /" ExceptionInfo #"cannot contain . or /"
(leaf/leaves :c1 {:nodes {:a {:id :a :kind :poly :parent nil :z "a1" (leaf/leaves :c1 (one-timeline
:channels {[:geom :pts.x] (ch/framed [0 0])}}}})))) {:a {:id :a :kind :poly :parent nil :z "a1"
:channels {[:geom :pts.x] (ch/framed [0 0])}}})))))

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

@ -9,9 +9,9 @@
back as a slightly wrong performance rather than as an error. back as a slightly wrong performance rather than as an error.
So what is compared is the OPS, frame for frame, through both evaluators, in So what is compared is the OPS, frame for frame, through both evaluators, in
every frame order — the same machinery scene-test uses to hold `eval-frame` and every frame order — the same machinery timeline-test uses to hold `eval-frame`
`resolver` to each other, which is the strictest statement available about two and `resolver` to each other, which is the strictest statement available about
scenes being the same scene. two documents being the same document.
This runs the conversion the network runs — `JSON.parse(JSON.stringify(...))` — This runs the conversion the network runs — `JSON.parse(JSON.stringify(...))` —
and not the network. `clips/tests.py` puts the same document through Django, and and not the network. `clips/tests.py` puts the same document through Django, and
@ -20,8 +20,9 @@
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take] [arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.project :as project] [arthur.domain.project :as project]
[arthur.domain.scene :as scene] [arthur.domain.timeline :as timeline]
[arthur.flow.freeze :as freeze] [arthur.flow.freeze :as freeze]
[arthur.support.ops :as ops])) [arthur.support.ops :as ops]))
@ -33,28 +34,31 @@
(def ^:private before (delay @take/frozen)) (def ^:private before (delay @take/frozen))
(def ^:private after (delay (wired :c1 @before))) (def ^:private after (delay (wired :c1 @before)))
(deftest what-comes-back-is-a-valid-scene (deftest what-comes-back-is-a-valid-clip
(let [ps (scene/problems (:scene @after))] ;; `clip/problems` and not `timeline/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))]
(is (empty? ps) (pr-str ps)))) (is (empty? ps) (pr-str ps))))
(deftest the-document-comes-back-equal (deftest the-document-comes-back-equal
;; Stronger than it needs to be and worth having: not merely equivalent, EQUAL. ;; Stronger than it needs to be and worth having: not merely equivalent, EQUAL.
;; Any drift here is a field the codec is rewriting, and a field that is ;; Any drift here is a field the codec is rewriting, and a field that is
;; rewritten once is rewritten again on every save. ;; rewritten once is rewritten again on every save.
(is (= (:scene @before) (:scene @after)))) (is (= (:clip @before) (:clip @after))))
(deftest every-frame-resolves-to-the-same-ops-before-and-after (deftest every-frame-resolves-to-the-same-ops-before-and-after
;; The assertion. Both evaluators, both scenes, every frame order — so a block ;; 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 ;; that came back with its offsets shifted, or a cursor that seeks differently
;; over a rebuilt key map, has nowhere to hide. ;; over a rebuilt key map, has nowhere to hide.
(let [n (:frames (:scene @before)) (let [n (clip/frames (:clip @before))
paths {"specification" [ops/specified ops/specified] paths {"specification" [ops/specified ops/specified]
"playback" [ops/resolved ops/resolved] "playback" [ops/resolved ops/resolved]
"spec vs playback, after" [ops/specified ops/resolved]}] "spec vs playback, after" [ops/specified ops/resolved]}]
(doseq [[label [f g]] paths (doseq [[label [f g]] paths
[order fs] (ops/orders n)] [order fs] (ops/orders n)]
(let [a (f (:scene @before) (:store @before)) (let [a (f (clip/root (:clip @before)) (:store @before))
b (g (:scene @after) (:store @after))] b (g (clip/root (:clip @after)) (:store @after))]
(testing (str label ", " order) (testing (str label ", " order)
(doseq [frame fs] (doseq [frame fs]
(is (= (a frame) (b frame)) (is (= (a frame) (b frame))
@ -76,11 +80,11 @@
;; The other head mode, because it is the one whose `:head` channels are FRAMED ;; The other head mode, because it is the one whose `:head` channels are FRAMED
;; rather than dense: a codec that only handled dense channels would pass ;; rather than dense: a codec that only handled dense channels would pass
;; everything above and lose the locked take's identity transform. ;; everything above and lose the locked take's identity transform.
(let [locked {:scene @take/locked :store @take/store} (let [locked {:clip @take/locked :store @take/store}
back (wired :c1 locked) back (wired :c1 locked)
a (ops/resolved (:scene locked) (:store locked)) a (ops/resolved (clip/root (:clip locked)) (:store locked))
b (ops/resolved (:scene back) (:store back))] b (ops/resolved (clip/root (:clip back)) (:store back))]
(is (= (:scene locked) (:scene back))) (is (= (:clip locked) (:clip back)))
(doseq [frame (range 0 take/frames 7)] (doseq [frame (range 0 take/frames 7)]
(is (= (a frame) (b frame)) (str "frame " frame))))) (is (= (a frame) (b frame)) (str "frame " frame)))))
@ -109,9 +113,9 @@
(deftest an-absence-mask-survives-the-wire (deftest an-absence-mask-survives-the-wire
(let [back (wired :c1 @gappy) (let [back (wired :c1 @gappy)
at (fn [clip id path f] at (fn [entry id path f]
(ch/value-at (get-in (:scene clip) [:nodes id :channels path]) (ch/value-at (get-in (clip/nodes (:clip entry)) [id :channels path])
f (:store clip))) f (:store entry)))
;; Every dense track of the eye, iris, brow and brow-position blocks, and ;; Every dense track of the eye, iris, brow and brow-position blocks, and
;; the feature whose gap it must follow — the same table ;; the feature whose gap it must follow — the same table
;; `each-dense-track-follows-its-own-features-presence` pins. ;; `each-dense-track-follows-its-own-features-presence` pins.
@ -140,7 +144,8 @@
;; Presence is not visibility, on the far side too: the node is dropped from the ;; Presence is not visibility, on the far side too: the node is dropped from the
;; frame rather than hidden, and its partner is not. ;; frame rather than hidden, and its partner is not.
(let [back (wired :c1 @gappy) (let [back (wired :c1 @gappy)
drawn (into #{} (map :node) ((scene/resolver (:scene back) (:store back)) 12))] drawn (into #{} (map :node)
((timeline/resolver (clip/root (:clip back)) (:store back)) 12))]
(is (not (contains? drawn :eye-r))) (is (not (contains? drawn :eye-r)))
(is (contains? drawn :eye-l)) (is (contains? drawn :eye-l))
(is (contains? drawn :mouth)))) (is (contains? drawn :mouth))))

101
frontend/test/arthur/domain/scene_test.cljs → frontend/test/arthur/domain/timeline_test.cljs
View file

@ -1,4 +1,4 @@
(ns arthur.domain.scene-test (ns arthur.domain.timeline-test
"Frame evaluation, and the hand-written scene. "Frame evaluation, and the hand-written scene.
port-plan step 2 exists to find out whether the data model works BEFORE nine port-plan step 2 exists to find out whether the data model works BEFORE nine
@ -13,7 +13,8 @@
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.raster :as raster] [arthur.domain.raster :as raster]
[arthur.domain.scene :as scene] [arthur.domain.clip :as clip]
[arthur.domain.timeline :as timeline]
[arthur.support.ops :as ops])) [arthur.support.ops :as ops]))
(defn- poly [id parent z pts color & [extra]] (defn- poly [id parent z pts color & [extra]]
@ -26,7 +27,7 @@
{:nodes (into {} (map (juxt :id identity)) nodes)}) {:nodes (into {} (map (juxt :id identity)) nodes)})
(defn- ids-at [scene f] (defn- ids-at [scene f]
(mapv :node (scene/eval-frame scene f))) (mapv :node (timeline/eval-frame scene f)))
(def ^:private pts-of ops/points) (def ^:private pts-of ops/points)
@ -37,9 +38,9 @@
{:id :b :kind :group :parent :a :z "a1"} {:id :b :kind :group :parent :a :z "a1"}
{:id :c :kind :group :parent :b :z "a1"} {:id :c :kind :group :parent :b :z "a1"}
{:id :d :kind :group :parent :a :z "a2"}) {:id :d :kind :group :parent :a :z "a2"})
ord (scene/order (:nodes s))] ord (timeline/order (:nodes s))]
(is (= 0 (scene/depth (:nodes s) :a))) (is (= 0 (timeline/depth (:nodes s) :a)))
(is (= 2 (scene/depth (:nodes s) :c))) (is (= 2 (timeline/depth (:nodes s) :c)))
(let [pos (into {} (map-indexed (fn [i id] [id i])) ord)] (let [pos (into {} (map-indexed (fn [i id] [id i])) ord)]
(doseq [[id p] [[:b :a] [:c :b] [:d :a]]] (doseq [[id p] [[:b :a] [:c :b] [:d :a]]]
(is (< (get pos p) (get pos id)) (str p " must come before " id)))))) (is (< (get pos p) (get pos id)) (str p " must come before " id))))))
@ -49,12 +50,12 @@
;; diagnostic than a stack trace naming the nodes. ;; diagnostic than a stack trace naming the nodes.
(let [s (sc {:id :a :kind :group :parent :b :z "a1"} (let [s (sc {:id :a :kind :group :parent :b :z "a1"}
{:id :b :kind :group :parent :a :z "a1"})] {:id :b :kind :group :parent :a :z "a1"})]
(is (thrown-with-msg? ExceptionInfo #"cycle" (scene/order (:nodes s)))) (is (thrown-with-msg? ExceptionInfo #"cycle" (timeline/order (:nodes s))))
(is (seq (scene/problems s))))) (is (seq (timeline/problems s)))))
(deftest a-missing-parent-is-named-rather-than-silently-orphaning (deftest a-missing-parent-is-named-rather-than-silently-orphaning
(let [s (sc {:id :a :kind :group :parent :nope :z "a1"})] (let [s (sc {:id :a :kind :group :parent :nope :z "a1"})]
(is (seq (scene/problems s))))) (is (seq (timeline/problems s)))))
(deftest reparenting-is-one-field-and-does-not-move-a-subtree (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 ;; The flat-with-pointers claim, asserted as the thing it buys: a reparent is an
@ -69,9 +70,9 @@
(is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b])) (is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b]))
"and so is the new one") "and so is the new one")
(is (= [[0 0] [10 0] [10 10]] (is (= [[0 0] [10 0] [10 10]]
(pts-of (first (filter #(= :c (:node %)) (scene/eval-frame s 0)))))) (pts-of (first (filter #(= :c (:node %)) (timeline/eval-frame s 0))))))
(is (= [[100 0] [110 0] [110 10]] (is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (scene/eval-frame s' 0)))))))) (pts-of (first (filter #(= :c (:node %)) (timeline/eval-frame s' 0))))))))
;; ---- draw order ---- ;; ---- draw order ----
@ -113,7 +114,7 @@
:channels {[:xform :pos] (ch/framed [100 50]) :channels {[:xform :pos] (ch/framed [100 50])
[:xform :scale] (ch/framed [2 2])}} [:xform :scale] (ch/framed [2 2])}}
(poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base)) (poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base))
op (first (scene/eval-frame s 0))] op (first (timeline/eval-frame s 0))]
(is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op))))) (is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op)))))
(deftest a-keyed-group-position-moves-its-children-and-holds-between-keys (deftest a-keyed-group-position-moves-its-children-and-holds-between-keys
@ -123,7 +124,7 @@
:channels {[:xform :pos] :channels {[:xform :pos]
(ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]})}} (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)) (poly :p :g "a1" [0 0 2 0 2 2] :skin-base))
at #(first (pts-of (first (scene/eval-frame s %))))] at #(first (pts-of (first (timeline/eval-frame s %))))]
(is (= [0 0] (at 0))) (is (= [0 0] (at 0)))
(is (= [0 0] (at 3)) "held") (is (= [0 0] (at 3)) "held")
(is (= [10 0] (at 4))) (is (= [10 0] (at 4)))
@ -140,7 +141,7 @@
{:id :g :kind :group :parent :root :z "a1" {:id :g :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}} :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)) (poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (scene/eval-frame s %)))))] 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))))) (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" (testing "and a node may set its own grid, which the model permits deliberately"
@ -148,7 +149,7 @@
{:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4} {: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)))}} :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)) (poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (scene/eval-frame s %)))))] 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))))))) (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 (deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
@ -162,7 +163,7 @@
{:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2} {:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2}
:channels {[:xform :pos] (ch/keyed keys)}} :channels {[:xform :pos] (ch/keyed keys)}}
(poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark)) (poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark))
x-of (fn [f id] (->> (scene/eval-frame s f) x-of (fn [f id] (->> (timeline/eval-frame s f)
(filter #(= id (:node %))) first pts-of first first))] (filter #(= id (:node %))) first pts-of first first))]
(is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4)))) (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"))) (is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead")))
@ -205,11 +206,11 @@
:dense {:store "pts" :offset 0 :stride 6 :frames 2}} :dense {:store "pts" :offset 0 :stride 6 :frames 2}}
[:style :color] (ch/framed :mouth-dark)}} [:style :color] (ch/framed :mouth-dark)}}
(poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))] (poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:child] (mapv :node (scene/eval-frame absent-pos 0 store)))) (is (= [:child] (mapv :node (timeline/eval-frame absent-pos 0 store))))
(is (= [] (mapv :node (scene/eval-frame absent-pos 1 store))) (is (= [] (mapv :node (timeline/eval-frame absent-pos 1 store)))
"an absent transform gives the children nowhere to be") "an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (scene/eval-frame absent-pts 0 store)))) (is (= [:m :teeth] (mapv :node (timeline/eval-frame absent-pts 0 store))))
(is (= [:teeth] (mapv :node (scene/eval-frame absent-pts 1 store))) (is (= [:teeth] (mapv :node (timeline/eval-frame absent-pts 1 store)))
"an absent outline removes only itself"))) "an absent outline removes only itself")))
;; ---- stencils ---- ;; ---- stencils ----
@ -223,7 +224,7 @@
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2" {:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4) :channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}}) [:style :color] (ch/framed :iris)}})
ops (scene/eval-frame s 0)] ops (timeline/eval-frame s 0)]
(is (= [:sclera :iris] (mapv :node ops))) (is (= [:sclera :iris] (mapv :node ops)))
(is (= (:eye-white pal/index-of) (:stencil (second ops)))))) (is (= (:eye-white pal/index-of) (:stencil (second ops))))))
@ -250,7 +251,7 @@
:channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}} :channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}}
{:id :r :kind :rect :parent :g :z "a2" {:id :r :kind :rect :parent :g :z "a2"
:channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}}) :channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}})
[d r] (scene/eval-frame s 0)] [d r] (timeline/eval-frame s 0)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)])) (is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
;; 1.7 x 2 is 3.4, and a block 3.4px wide would be 3px on one frame and 4 on ;; 1.7 x 2 is 3.4, and a block 3.4px wide would be 3px on one frame and 4 on
;; the next, which reads as the pupil breathing. ;; the next, which reads as the pupil breathing.
@ -266,7 +267,7 @@
;; The frame orders and the snapshot live in `arthur.support.ops`, because the ;; The frame orders and the snapshot live in `arthur.support.ops`, because the
;; same comparison is what proves a scene survived the server — see ;; same comparison is what proves a scene survived the server — see
;; flow/project-test. ;; flow/project-test.
(let [s demo/scene (let [s demo/timeline
spec (ops/specified s nil) spec (ops/specified s nil)
fast (ops/resolved s nil)] fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders (:frames s))] (doseq [[label fs] (ops/orders (:frames s))]
@ -277,28 +278,38 @@
(deftest the-resolver-reuses-one-buffer-per-node (deftest the-resolver-reuses-one-buffer-per-node
;; At 30fps per-frame allocation is the only thing that will make this stutter, ;; 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. ;; and fixed topology is what makes the buffer size knowable at all.
(let [res (scene/resolver demo/scene) (let [res (timeline/resolver demo/timeline)
buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))] buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))]
(is (identical? (buf-of 0 :card) (buf-of 30 :card))))) (is (identical? (buf-of 0 :card) (buf-of 30 :card)))))
;; ---- the hand-written scene, end to end ---- ;; ---- the hand-written scene, end to end ----
(deftest the-hand-written-scene-is-valid (deftest the-hand-written-clip-is-valid
(let [ps (scene/problems demo/scene)] ;; `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 (empty? ps) (pr-str ps)))
(is (pos? (:frames demo/scene)))) (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-scene-renders-and-moves (deftest the-hand-written-clip-renders-and-moves
;; port-plan step 2's done condition, as an assertion rather than a look: the ;; 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 ;; scene rasterises, it writes only palette indices, and the pixels are not the
;; same on every frame. ;; same on every frame.
(let [res (scene/resolver demo/scene) (let [res (timeline/resolver demo/timeline)
render (fn [f] render (fn [f]
(let [r (raster/make (:width demo/scene) (:height demo/scene))] (let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of)) (raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f)) (raster/draw-ops! r (res f))
r)) r))
frames (mapv render (range 0 (:frames demo/scene) 6)) frames (mapv render (range 0 demo/frames 6))
sig (fn [r] (vec (array-seq (:buf r))))] sig (fn [r] (vec (array-seq (:buf r))))]
(is (every? (fn [r] (every? #(< % (count pal/rgb)) (array-seq (:buf r)))) frames) (is (every? (fn [r] (every? #(< % (count pal/rgb)) (array-seq (:buf r)))) frames)
"every byte written is a real palette index") "every byte written is a real palette index")
@ -306,17 +317,17 @@
(testing "the mark actually covers pixels" (testing "the mark actually covers pixels"
(is (pos? (count (remove zero? (sig (first frames))))))))) (is (pos? (count (remove zero? (sig (first frames)))))))))
(deftest the-hand-written-scene-steps-on-the-exposure-grid (deftest the-hand-written-clip-steps-on-the-exposure-grid
;; Exposure 2 on the clip root, inherited, so odd frames are identical to the ;; 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 ;; even frame before them. If this fails, exposure is being applied somewhere
;; other than the frame the channels are sampled at. ;; other than the frame the channels are sampled at.
(let [res (scene/resolver demo/scene) (let [res (timeline/resolver demo/timeline)
render (fn [f] render (fn [f]
(let [r (raster/make (:width demo/scene) (:height demo/scene))] (let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of)) (raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f)) (raster/draw-ops! r (res f))
(vec (array-seq (:buf r)))))] (vec (array-seq (:buf r)))))]
(doseq [f (range 0 (:frames demo/scene) 2)] (doseq [f (range 0 demo/frames 2)]
(is (= (render f) (render (inc f))) (str "frame " (inc f) " must hold frame " f))) (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 ;; 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 ;; nothing changes, because that is what hold MEANS. The scene's second key
@ -324,13 +335,13 @@
;; expose-before-anything-else rule showing up in pixels. ;; expose-before-anything-else rule showing up in pixels.
(is (not= (render 56) (render 58)) "and a key on the grid is seen"))) (is (not= (render 56) (render 58)) "and a key on the grid is seen")))
(deftest the-hand-written-scene-keeps-the-iris-and-pupil-inside-the-card (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 ;; 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. ;; pupil by the iris, and neither is expressed anywhere as a chain.
(let [res (scene/resolver demo/scene)] (let [res (timeline/resolver demo/timeline)]
(doseq [f (range 0 (:frames demo/scene) 4)] (doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/scene) (:height demo/scene)) (let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/scene) (:height demo/scene)) after (raster/make (:width demo/clip) (:height demo/clip))
ops (res f) ops (res f)
card? (fn [op] (= :card (:node op)))] card? (fn [op] (= :card (:node op)))]
(raster/clear! before (:bg pal/index-of)) (raster/clear! before (:bg pal/index-of))
@ -360,9 +371,9 @@
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base)) (poly :p :root "a1" [0 0 10 0 10 10] :skin-base))
day {:skin-base 1} day {:skin-base 1}
night {:skin-base 17}] night {:skin-base 17}]
(is (= 1 (:color (first (scene/eval-frame s 0 nil day))))) (is (= 1 (:color (first (timeline/eval-frame s 0 nil day)))))
(is (= 17 (:color (first (scene/eval-frame s 0 nil night))))) (is (= 17 (:color (first (timeline/eval-frame s 0 nil night)))))
(is (= 17 (:color (first ((scene/resolver s nil night) 0)))) (is (= 17 (:color (first ((timeline/resolver s nil night) 0))))
"and the playback path agrees"))) "and the playback path agrees")))
(deftest a-tone-the-ramp-does-not-define-is-loudly-wrong (deftest a-tone-the-ramp-does-not-define-is-loudly-wrong
@ -370,7 +381,7 @@
;; authored data and should be impossible to miss. ;; authored data and should be impossible to miss.
(let [s (sc {:id :root :kind :group :z "a1"} (let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))] (poly :p :root "a1" [0 0 10 0 10 10] :skin-base))]
(is (= 255 (:color (first (scene/eval-frame s 0 nil {}))))))) (is (= 255 (:color (first (timeline/eval-frame s 0 nil {})))))))
(deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil (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 stencil is a colour key, so two nodes sharing a tone share a stencil —
@ -383,6 +394,6 @@
[:style :color] (ch/framed :iris)}}) [:style :color] (ch/framed :iris)}})
;; :night's tones sit above :day's in one concatenated space ;; :night's tones sit above :day's in one concatenated space
night {:eye-white 14 :iris 15} night {:eye-white 14 :iris 15}
ops (scene/eval-frame s 0 nil night)] ops (timeline/eval-frame s 0 nil night)]
(is (= 14 (:stencil (second ops))) (is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in"))) "the stencil resolves to the index the stencil node actually drew in")))

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

@ -54,7 +54,7 @@
(deftest a-whole-leaf-map-round-trips-through-parsed-json (deftest a-whole-leaf-map-round-trips-through-parsed-json
;; What a save actually does: transit, then parsed so the column holds JSON. ;; What a save actually does: transit, then parsed so the column holds JSON.
(let [ls (leaf/leaves :c1 @take/scene)] (let [ls (leaf/leaves :c1 @take/clip)]
(is (= ls (into {} (map (fn [[p v]] [p (round-json v)])) ls))))) (is (= ls (into {} (map (fn [[p v]] [p (round-json v)])) ls)))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------

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

@ -2,9 +2,10 @@
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is]]
[arthur.demo.take :as take] [arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.landmarks :as lm] [arthur.domain.landmarks :as lm]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.scene :as scene] [arthur.domain.timeline :as timeline]
[arthur.flow.condition.eyes :as condition-eyes] [arthur.flow.condition.eyes :as condition-eyes]
[arthur.flow.ingest :as ingest] [arthur.flow.ingest :as ingest]
[arthur.flow.measure.eyes :as eyes] [arthur.flow.measure.eyes :as eyes]
@ -45,20 +46,20 @@
(deftest the-full-take-hides-only-the-annotated-eye-and-returns-to-the-same-id (deftest the-full-take-hides-only-the-annotated-eye-and-returns-to-the-same-id
(let [presence (ingest/feature-presence take/frames {:eye-r [[10 14]]}) (let [presence (ingest/feature-presence take/frames {:eye-r [[10 14]]})
{:keys [scene store]} (flow-take/build {:keys [clip store]} (flow-take/build
(assoc take/params :aspect 1 :name "observed-gap") (assoc take/params :aspect 1 :name "observed-gap")
{:dense @take/analysis :presence presence}) {:dense @take/analysis :presence presence})
sample (fn [id frame] sample (fn [id frame]
(ch/value-at (get-in scene [:nodes id :channels [:geom :pts]]) (ch/value-at (get-in (clip/nodes clip) [id :channels [:geom :pts]])
frame store))] frame store))]
(is (empty? (scene/problems scene))) (is (empty? (clip/problems clip)))
(is (= [:eye-r :eye-l] (get-in scene [:groups :eyes-1 :members]))) (is (= [:eye-r :eye-l] (get-in clip [:groups :eyes-1 :members])))
(doseq [f (range 9 14)] (doseq [f (range 9 14)]
(is (ch/nothing? (sample :eye-r f))) (is (ch/nothing? (sample :eye-r f)))
(is (not (ch/nothing? (sample :eye-l f)))) (is (not (ch/nothing? (sample :eye-l f))))
(is (not (ch/nothing? (sample :mouth f))))) (is (not (ch/nothing? (sample :mouth f)))))
(let [drawn (into #{} (map :node) (let [drawn (into #{} (map :node)
((scene/resolver scene store pal/index-of) 11))] ((timeline/resolver (clip/root clip) store pal/index-of) 11))]
(is (not (contains? drawn :eye-r))) (is (not (contains? drawn :eye-r)))
(is (not (contains? drawn :iris-r))) (is (not (contains? drawn :iris-r)))
(is (contains? drawn :eye-l)) (is (contains? drawn :eye-l))

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

@ -11,12 +11,13 @@
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take] [arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.geom :as geom] [arthur.domain.geom :as geom]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.raster :as raster] [arthur.domain.raster :as raster]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.domain.scene :as scene] [arthur.domain.timeline :as timeline]
[arthur.flow.freeze :as freeze])) [arthur.flow.freeze :as freeze]))
(def ^:private W 320) (def ^:private W 320)
@ -24,13 +25,17 @@
;; The whole vertical slice, exactly as the page builds it. Asserting against the ;; The whole vertical slice, exactly as the page builds it. Asserting against the
;; page's own clip rather than against a fixture built here is deliberate: a ;; page's own clip rather than against a fixture built here is deliberate: a
;; fixture is a second scene nobody looks at, and the one that renders is the one ;; fixture is a second document nobody looks at, and the one that renders is the one
;; that has to be right. ;; that has to be right.
(def clip (delay @take/frozen)) (def frozen (delay @take/frozen))
(def scene* (delay (:scene @clip))) (def clip* (delay (:clip @frozen)))
(def store (delay (:store @clip))) ;; The ROOT TIMELINE, which is what an evaluator takes. `clip*` is the document —
;; `:fps`, the stage, the analysis, the tracking identities — and `tl*` is the bag
;; of nodes in its frame space. `timeline/resolver` refuses the wrong one loudly.
(def tl* (delay (clip/root @clip*)))
(def store (delay (:store @frozen)))
(defn- node [id] (get-in @scene* [:nodes id])) (defn- node [id] (get-in @tl* [:nodes id]))
(defn- chan [id path] (get-in (node id) [:channels path])) (defn- chan [id path] (get-in (node id) [:channels path]))
(defn- block-of (defn- block-of
@ -44,16 +49,19 @@
(let [v (ch/value-at (chan id [:geom :pts]) f @store)] (let [v (ch/value-at (chan id [:geom :pts]) f @store)]
(mapv #(ch/component v %) (range (.-length v))))) (mapv #(ch/component v %) (range (.-length v)))))
(defn- ops-at [sc f] (defn- ops-at
((scene/resolver sc @store pal/index-of) f)) "Ops for one frame of a TIMELINE."
[tl f]
((timeline/resolver tl @store pal/index-of) f))
(defn- render (defn- render
"One frame of a scene into a byte buffer. The stage's size comes off the clip, "One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
because project dimensions are the project's and not the footage's." the ops off its root timeline, because project dimensions are the project's and
[sc f] not the footage's — and not a timeline's either."
(let [r (raster/make (:width sc) (:height sc))] [c f]
(let [r (raster/make (:width c) (:height c))]
(raster/clear! r (get pal/index-of :bg)) (raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r (ops-at sc f)) (raster/draw-ops! r (ops-at (clip/root c) f))
(vec (array-seq (:buf r))))) (vec (array-seq (:buf r)))))
(defn- drawn (defn- drawn
@ -64,25 +72,27 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the shape of what came out ;; the shape of what came out
(deftest the-frozen-take-is-a-valid-scene-in-every-head-mode (deftest the-frozen-take-is-a-valid-clip-in-every-head-mode
;; `scene/problems` is total by construction, so this is safe to run over data ;; `clip/problems` is total by construction, so this is safe to run over data
;; before the data is trusted — which is what it is for. ;; before the data is trusted — which is what it is for. It checks the clip's
;; fields, every timeline in it and the tracking identities, so it is the whole
;; of what a save would refuse.
(doseq [mode [:as-filmed :locked]] (doseq [mode [:as-filmed :locked]]
(let [sc (freeze/head-mode {:mode mode} @clip)] (let [c (freeze/head-mode {:mode mode} @frozen)]
(is (empty? (scene/problems sc)) (str mode ": " (pr-str (scene/problems sc)))))) (is (empty? (clip/problems c)) (str mode ": " (pr-str (clip/problems c))))))
(let [sc (freeze/head-mode {:mode :per-plate :kept #{0 12 40 88 150}} @clip)] (let [c (freeze/head-mode {:mode :per-plate :kept #{0 12 40 88 150}} @frozen)]
(is (empty? (scene/problems sc)) (pr-str (scene/problems sc))))) (is (empty? (clip/problems c)) (pr-str (clip/problems c)))))
(deftest the-tree-is-the-one-the-model-specifies (deftest the-tree-is-the-one-the-model-specifies
;; :face is AUTHORED and :head is MEASURED, and they are two nodes because two ;; :face is AUTHORED and :head is MEASURED, and they are two nodes because two
;; different things want that transform. A group node is free; keeping the ;; different things want that transform. A group node is free; keeping the
;; hand-placed and the measured transform apart is the whole reason the ;; hand-placed and the measured transform apart is the whole reason the
;; transform is decomposed in the first place. ;; transform is decomposed in the first place.
(is (= [:face :root] (scene/lineage (:nodes @scene*) :face))) (is (= [:face :root] (timeline/lineage (:nodes @tl*) :face)))
(is (= [:head :face :root] (scene/lineage (:nodes @scene*) :head))) (is (= [:head :face :root] (timeline/lineage (:nodes @tl*) :head)))
(is (= [:mouth :head :face :root] (scene/lineage (:nodes @scene*) :mouth))) (is (= [:mouth :head :face :root] (timeline/lineage (:nodes @tl*) :mouth)))
(is (= [:mouth-in :mouth :head :face :root] (is (= [:mouth-in :mouth :head :face :root]
(scene/lineage (:nodes @scene*) :mouth-in))) (timeline/lineage (:nodes @tl*) :mouth-in)))
;; Exposure lives on the clip root and inherits strictly. ;; Exposure lives on the clip root and inherits strictly.
(is (= {:mode :map :expose 2} (:time (node :root)))) (is (= {:mode :map :expose 2} (:time (node :root))))
(is (every? #(nil? (:time (node %))) [:face :head :mouth :mouth-in]))) (is (every? #(nil? (:time (node %))) [:face :head :mouth :mouth-in])))
@ -186,8 +196,8 @@
;; of the two says it is. A test that recomputed the chain would only be ;; of the two says it is. A test that recomputed the chain would only be
;; checking arithmetic against itself; this checks `node/local!`, `node/world!` ;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
;; and `emit` as well. ;; and `emit` as well.
(let [sc (freeze/head-mode {:mode :as-filmed} @clip) (let [c (freeze/head-mode {:mode :as-filmed} @frozen)
res (scene/resolver sc @store pal/index-of) res (timeline/resolver (clip/root c) @store pal/index-of)
k (first (:value (chan :face [:xform :scale]))) k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor])) anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos])) pos (:value (chan :face [:xform :pos]))
@ -228,9 +238,9 @@
(deftest the-three-head-modes-are-the-three-channel-shapes (deftest the-three-head-modes-are-the-three-channel-shapes
(let [kept #{0 12 40 88 150} (let [kept #{0 12 40 88 150}
of (fn [sc path] (get-in sc [:nodes :head :channels path]))] of (fn [c path] (get-in (clip/nodes c) [:head :channels path]))]
(testing "locked is framed identity" (testing "locked is framed identity"
(let [sc (freeze/head-mode {:mode :locked} @clip)] (let [sc (freeze/head-mode {:mode :locked} @frozen)]
(is (= [:framed :framed :framed] (is (= [:framed :framed :framed]
(mapv #(ch/describe (of sc %)) (mapv #(ch/describe (of sc %))
[[:xform :pos] [:xform :rot] [:xform :scale]]))) [[:xform :pos] [:xform :rot] [:xform :scale]])))
@ -238,12 +248,12 @@
(is (= 0.0 (:value (of sc [:xform :rot])))) (is (= 0.0 (:value (of sc [:xform :rot]))))
(is (= [1.0 1.0] (:value (of sc [:xform :scale])))))) (is (= [1.0 1.0] (:value (of sc [:xform :scale]))))))
(testing "as filmed is dense" (testing "as filmed is dense"
(let [sc (freeze/head-mode {:mode :as-filmed} @clip)] (let [sc (freeze/head-mode {:mode :as-filmed} @frozen)]
(is (= [:dense :dense :dense] (is (= [:dense :dense :dense]
(mapv #(ch/describe (of sc %)) (mapv #(ch/describe (of sc %))
[[:xform :pos] [:xform :rot] [:xform :scale]]))))) [[:xform :pos] [:xform :rot] [:xform :scale]])))))
(testing "per plate is keyed at exactly the kept frames" (testing "per plate is keyed at exactly the kept frames"
(let [sc (freeze/head-mode {:mode :per-plate :kept kept} @clip)] (let [sc (freeze/head-mode {:mode :per-plate :kept kept} @frozen)]
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]] (doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :keyed (ch/describe (of sc path)))) (is (= :keyed (ch/describe (of sc path))))
(is (= (sort kept) (sort (keys (:keys (of sc path)))))) (is (= (sort kept) (sort (keys (:keys (of sc path))))))
@ -262,25 +272,29 @@
;; It has to be impossible for the toggle to move something a hand placed, and ;; It has to be impossible for the toggle to move something a hand placed, and
;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a ;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a
;; reason to re-analyse. ;; reason to re-analyse.
(let [a (freeze/head-mode {:mode :as-filmed} @clip) (let [a (freeze/head-mode {:mode :as-filmed} @frozen)
b (freeze/head-mode {:mode :locked} @clip) b (freeze/head-mode {:mode :locked} @frozen)
c (freeze/head-mode {:mode :per-plate :kept #{0 40}} @clip)] c (freeze/head-mode {:mode :per-plate :kept #{0 40}} @frozen)]
(doseq [sc [b c]] (doseq [x [b c]]
(is (= (get-in a [:nodes :face]) (get-in sc [:nodes :face])) (is (= (get (clip/nodes a) :face) (get (clip/nodes x) :face))
":face moved") ":face moved")
(is (= (dissoc (:nodes a) :head) (dissoc (:nodes sc) :head)) (is (= (dissoc (clip/nodes a) :head) (dissoc (clip/nodes x) :head))
"a node other than :head changed") "a node other than :head changed")
;; The measurement does not go away when the head is locked: always measure, ;; The measurement does not go away when the head is locked: always measure,
;; always store factored, toggle the parent. ;; always store factored, toggle the parent.
(is (= (get-in a [:nodes :head :measured]) (get-in sc [:nodes :head :measured])))))) (is (= (get-in (clip/nodes a) [:head :measured])
(get-in (clip/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))))))
(deftest a-head-mode-that-is-not-one-of-the-three-is-refused (deftest a-head-mode-that-is-not-one-of-the-three-is-refused
(is (thrown-with-msg? ExceptionInfo #"not one of the three channel shapes" (is (thrown-with-msg? ExceptionInfo #"not one of the three channel shapes"
(freeze/head-mode {:mode :stabilised} @clip))) (freeze/head-mode {:mode :stabilised} @frozen)))
;; The kept-frame set belongs to the plate strip, not to measurement, so freeze ;; The kept-frame set belongs to the plate strip, not to measurement, so freeze
;; cannot invent one. ;; cannot invent one.
(is (thrown-with-msg? ExceptionInfo #"kept-frame set" (is (thrown-with-msg? ExceptionInfo #"kept-frame set"
(freeze/head-mode {:mode :per-plate} @clip)))) (freeze/head-mode {:mode :per-plate} @frozen))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the face: authored, and what makes makeXform deletable ;; the face: authored, and what makes makeXform deletable
@ -290,7 +304,7 @@
;; transform on a node, which a hand can revise, and it claims no generator that ;; transform on a node, which a hand can revise, and it claims no generator that
;; would offer to overwrite it. ;; would offer to overwrite it.
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale] [:xform :anchor]]] (doseq [path [[:xform :pos] [:xform :rot] [:xform :scale] [:xform :anchor]]]
(let [c (get (node/channels (get-in @scene* [:nodes :face])) path)] (let [c (get (node/channels (node :face)) path)]
(is (= :framed (ch/describe c)) (str path " is not framed")) (is (= :framed (ch/describe c)) (str path " is not framed"))
(is (nil? (:generated c)) (str path " claims provenance"))))) (is (nil? (:generated c)) (str path " claims provenance")))))
@ -314,18 +328,20 @@
;; re-measuring anything. ;; re-measuring anything.
(let [big (freeze/clip (assoc take/params :stage [640 480] :name "big") (let [big (freeze/clip (assoc take/params :stage [640 480] :name "big")
@take/measured) @take/measured)
key-of (fn [sc] (:store (:dense (get-in sc [:nodes :mouth :channels [:geom :pts]]))))] key-of (fn [c] (:store (:dense (get-in (clip/nodes c)
(is (= [640 480] [(:width (:scene big)) (:height (:scene big))])) [:mouth :channels [:geom :pts]]))))]
(is (= [640 480] [(:width (:clip big)) (:height (:clip big))]))
;; Stronger than it was, and for free: the stage is not an input to tier 2, so ;; Stronger than it was, and for free: the stage is not an input to tier 2, so
;; the two clips do not merely hold equal bytes — they name the SAME BLOCK, and ;; the two clips do not merely hold equal bytes — they name the SAME BLOCK, and
;; a stage change cannot invalidate a bake. The clip's name is not an input ;; a stage change cannot invalidate a bake. The clip's name is not an input
;; either, which is why "big" and "take" still agree. ;; either, which is why "big" and "take" still agree.
(is (= (key-of @scene*) (key-of (:scene big))) (is (= (key-of @clip*) (key-of (:clip big)))
"a different stage is a different document over the same tier 2") "a different stage is a different document over the same tier 2")
(is (= (vec (array-seq (:data (get @store (key-of @scene*))))) (is (= (vec (array-seq (:data (get @store (key-of @clip*)))))
(vec (array-seq (:data (get (:store big) (key-of (:scene big))))))) (vec (array-seq (:data (get (:store big) (key-of (:clip big)))))))
"the geometry is the same numbers at either stage size") "the geometry is the same numbers at either stage size")
(is (not= (:value (get-in (:scene big) [:nodes :face :channels [:xform :scale]])) (is (not= (:value (get-in (clip/nodes (:clip big))
[:face :channels [:xform :scale]]))
(:value (chan :face [:xform :scale])))))) (:value (chan :face [:xform :scale]))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -355,7 +371,7 @@
;; interior comes and goes. ;; interior comes and goes.
(is (nil? (chan :mouth [:vis]))) (is (nil? (chan :mouth [:vis])))
(doseq [f (range 0 take/frames 9)] (doseq [f (range 0 take/frames 9)]
(is (some #(= :mouth (:node %)) (ops-at @scene* f)) (is (some #(= :mouth (:node %)) (ops-at @tl* f))
(str "frame " f " drew no mouth outline")))) (str "frame " f " drew no mouth outline"))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -384,13 +400,15 @@
;; `:generated` out of the document and the frame is the same bytes. If this ;; `:generated` out of the document and the frame is the same bytes. If this
;; ever fails, a rotoscoped part and a hand-drawn one have stopped being the ;; ever fails, a rotoscoped part and a hand-drawn one have stopped being the
;; same data. ;; same data.
(let [stripped (update @scene* :nodes (let [strip-node (fn [n]
(fn [ns] (into {} (map (fn [[id n]] (update n :channels
[id (update n :channels #(into {} (map (fn [[p c]] [p (dissoc c :generated)])) %)))
#(into {} (map (fn [[p c]] [p (dissoc c :generated)])) %))])) stripped (clip/update-root
ns)))] @clip*
update :nodes
#(into {} (map (fn [[id n]] [id (strip-node n)])) %))]
(doseq [f (range 0 take/frames 17)] (doseq [f (range 0 take/frames 17)]
(is (= (render @scene* f) (render stripped f)) (is (= (render @clip* f) (render stripped f))
(str "frame " f " differs with provenance removed"))))) (str "frame " f " differs with provenance removed")))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -401,21 +419,23 @@
presence {:eye-r (mapv #(not (contains? gap %)) (range take/frames))} presence {:eye-r (mapv #(not (contains? gap %)) (range take/frames))}
c (freeze/clip (assoc take/params :name "one-eye-gappy") c (freeze/clip (assoc take/params :name "one-eye-gappy")
(assoc @take/measured :presence presence)) (assoc @take/measured :presence presence))
sc (:scene c) tl (clip/root (:clip c))
at (fn [id f] at (fn [id f]
(ch/value-at (get-in sc [:nodes id :channels [:geom :pts]]) f (:store c)))] (ch/value-at (get-in (:nodes tl) [id :channels [:geom :pts]]) f (:store c)))]
(is (= [:eye-r :eye-l] (get-in sc [:groups :eyes-1 :members]))) ;; The identities are the CLIP's, and a gap does not touch them: a feature keeps
(is (= :eye-r (get-in sc [:features :eye-r :id]))) ;; its id and its pair membership across the frames it was not observed on.
(is (= [:eye-r :eye-l] (get-in (:clip c) [:groups :eyes-1 :members])))
(is (= :eye-r (get-in (:clip c) [:features :eye-r :id])))
(is (not (ch/nothing? (at :eye-r 39)))) (is (not (ch/nothing? (at :eye-r 39))))
(is (ch/nothing? (at :eye-r 50))) (is (ch/nothing? (at :eye-r 50)))
(is (not (ch/nothing? (at :eye-r 60)))) (is (not (ch/nothing? (at :eye-r 60))))
(is (not (ch/nothing? (at :eye-l 50)))) (is (not (ch/nothing? (at :eye-l 50))))
(is (not (ch/nothing? (at :mouth 50)))) (is (not (ch/nothing? (at :mouth 50))))
(let [drawn-nodes (into #{} (map :node) ((scene/resolver sc (:store c) pal/index-of) 50))] (let [drawn-nodes (into #{} (map :node) ((timeline/resolver tl (:store c) pal/index-of) 50))]
(is (not (contains? drawn-nodes :eye-r))) (is (not (contains? drawn-nodes :eye-r)))
(is (contains? drawn-nodes :eye-l)) (is (contains? drawn-nodes :eye-l))
(is (contains? drawn-nodes :mouth))) (is (contains? drawn-nodes :mouth)))
(is (empty? (scene/problems sc))))) (is (empty? (clip/problems (:clip c))))))
(deftest each-dense-track-follows-its-own-features-presence (deftest each-dense-track-follows-its-own-features-presence
;; Every feature is given a DIFFERENT gap, so a track wired to the wrong one ;; Every feature is given a DIFFERENT gap, so a track wired to the wrong one
@ -437,9 +457,9 @@
windows) windows)
c (freeze/clip (assoc take/params :name "per-track-gaps") c (freeze/clip (assoc take/params :name "per-track-gaps")
(assoc @take/measured :presence presence)) (assoc @take/measured :presence presence))
sc (:scene c) tl (clip/root (:clip c))
at (fn [id path f] at (fn [id path f]
(ch/value-at (get-in sc [:nodes id :channels path]) f (:store c))) (ch/value-at (get-in (:nodes tl) [id :channels path]) f (:store c)))
;; Node, channel, and the feature whose gap it must follow. Every dense ;; Node, channel, and the feature whose gap it must follow. Every dense
;; track of the eye, iris, brow and brow-position blocks appears once. ;; track of the eye, iris, brow and brow-position blocks appears once.
tracks [[:eye-r [:geom :pts] :eye-r] tracks [[:eye-r [:geom :pts] :eye-r]
@ -452,7 +472,7 @@
[:brow-l [:geom :pts] :brow-l] [:brow-l [:geom :pts] :brow-l]
[:brow-r [:xform :pos] :brow-r] [:brow-r [:xform :pos] :brow-r]
[:brow-l [:xform :pos] :brow-l]]] [:brow-l [:xform :pos] :brow-l]]]
(is (empty? (scene/problems sc))) (is (empty? (clip/problems (:clip c))))
(doseq [[id path owner] tracks (doseq [[id path owner] tracks
[feature gap] windows [feature gap] windows
f gap] f gap]
@ -465,10 +485,10 @@
(deftest teeth-follow-the-mouth-through-their-stencil-and-not-through-a-mask (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 ;; 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 ;; parameters — which means an occluded MOUTH sets no absence bit on them. They
;; do not need one: they are stencilled by :mouth-in, and scene/finish drops a ;; do not need one: they are stencilled by :mouth-in, and timeline/finish drops a
;; node whose stencil drew nothing. So the coupling is real, and it is the ;; 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 ;; stencil rule rather than the mask that enforces it. The rule itself is
;; asserted in scene-test; what is pinned here is the wiring that relies on it. ;; asserted in timeline-test; what is pinned here is the wiring that relies on it.
(let [gap (set (range 40 60)) (let [gap (set (range 40 60))
teeth-in {;; The mouth's own inner ring standing in for a pixel-derived teeth-in {;; The mouth's own inner ring standing in for a pixel-derived
;; contour: real geometry and no nils, so every frame has a ;; contour: real geometry and no nils, so every frame has a
@ -485,7 +505,7 @@
;; Hoisted: the resolver caches its order and reuses its buffers, so the ;; Hoisted: the resolver caches its order and reuses its buffers, so the
;; node ids come out before the next frame is asked for. ;; node ids come out before the next frame is asked for.
nodes-at (fn [c] nodes-at (fn [c]
(let [r (scene/resolver (:scene c) (:store c) pal/index-of)] (let [r (timeline/resolver (clip/root (:clip c)) (:store c) pal/index-of)]
(fn [f] (into #{} (map :node) (r f))))) (fn [f] (into #{} (map :node) (r f)))))
ref-at (nodes-at ref) ref-at (nodes-at ref)
occ-at (nodes-at occ) occ-at (nodes-at occ)
@ -495,7 +515,7 @@
open (filter #(contains? (ref-at %) :teeth) (range take/frames)) open (filter #(contains? (ref-at %) :teeth) (range take/frames))
inside (first (filter gap open)) inside (first (filter gap open))
outside (first (remove gap open))] outside (first (remove gap open))]
(is (= :mouth-in (get-in (:scene occ) [:nodes :teeth :stencil])) (is (= :mouth-in (get-in (clip/nodes (:clip occ)) [:teeth :stencil]))
"teeth stop inheriting the mouth's absence if this stops being their stencil") "teeth stop inheriting the mouth's absence if this stops being their stencil")
(is (some? inside) "no open-mouth frame inside the gap to test with") (is (some? inside) "no open-mouth frame inside the gap to test with")
(is (some? outside) "no open-mouth frame outside the gap to test with") (is (some? outside) "no open-mouth frame outside the gap to test with")
@ -503,14 +523,14 @@
;; Annotating the MOUTH sets no bit on the teeth: they are a feature of ;; Annotating the MOUTH sets no bit on the teeth: they are a feature of
;; their own and nothing named them. ;; their own and nothing named them.
(is (not (ch/nothing? (is (not (ch/nothing?
(ch/value-at (get-in (:scene occ) [:nodes :teeth :channels [:geom :pts]]) (ch/value-at (get-in (clip/nodes (:clip occ)) [:teeth :channels [:geom :pts]])
inside (:store occ))))) inside (:store occ)))))
;; They are dropped anyway — :mouth-in drew nothing to clip them against. ;; They are dropped anyway — :mouth-in drew nothing to clip them against.
(is (not (contains? (occ-at inside) :mouth-in))) (is (not (contains? (occ-at inside) :mouth-in)))
(is (not (contains? (occ-at inside) :teeth))) (is (not (contains? (occ-at inside) :teeth)))
;; And the same articulation outside the gap still draws them. ;; And the same articulation outside the gap still draws them.
(is (contains? (occ-at outside) :teeth))) (is (contains? (occ-at outside) :teeth)))
(is (empty? (scene/problems (:scene occ)))))) (is (empty? (clip/problems (:clip occ))))))
(deftest an-undetected-frame-has-no-pose-at-all (deftest an-undetected-frame-has-no-pose-at-all
;; A subject that was not on the frame has NO VALUE, which is different from a ;; A subject that was not on the frame has NO VALUE, which is different from a
@ -521,8 +541,8 @@
det (mapv #(not (contains? gap %)) (range take/frames)) det (mapv #(not (contains? gap %)) (range take/frames))
c (freeze/clip (assoc take/params :name "gappy") c (freeze/clip (assoc take/params :name "gappy")
(assoc @take/measured :detected det)) (assoc @take/measured :detected det))
sc (:scene c) tl (clip/root (:clip c))
res (scene/resolver sc (:store c) pal/index-of)] res (timeline/resolver tl (:store c) pal/index-of)]
(doseq [f [39 40 50 59 60]] (doseq [f [39 40 50 59 60]]
(let [ops (res f)] (let [ops (res f)]
(if (contains? gap f) (if (contains? gap f)
@ -531,7 +551,7 @@
;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is ;; 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 ;; unchanged across the gap, because hiding and absence are different
;; questions with different answers. ;; questions with different answers.
(is (= (mapv #(ch/value-at (get-in sc [:nodes :mouth-in :channels [:vis]]) %) (is (= (mapv #(ch/value-at (get-in (:nodes tl) [:mouth-in :channels [:vis]]) %)
(range take/frames)) (range take/frames))
(mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames)))))) (mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames))))))
@ -569,7 +589,7 @@
(deftest the-take-draws-something-on-every-frame (deftest the-take-draws-something-on-every-frame
(doseq [f (range 0 take/frames 5)] (doseq [f (range 0 take/frames 5)]
(let [n (drawn (render @scene* f))] (let [n (drawn (render @clip* f))]
(is (> n 200) (str "frame " f " drew only " n " pixels"))))) (is (> n 200) (str "frame " f " drew only " n " pixels")))))
(deftest the-mouth-moves (deftest the-mouth-moves
@ -577,10 +597,10 @@
;; from different beats are genuinely different mouths and frames inside one ;; from different beats are genuinely different mouths and frames inside one
;; beat are not. This is the numeric half of step 5's done-criterion; the other ;; beat are not. This is the numeric half of step 5's done-criterion; the other
;; half is a picture and lives in test/browser/take.mjs. ;; half is a picture and lives in test/browser/take.mjs.
(let [locked (freeze/head-mode {:mode :locked} @clip) (let [locked (freeze/head-mode {:mode :locked} @frozen)
shot (fn [f] shot (fn [f]
(let [r (raster/make W H) (let [r (raster/make W H)
mouth (filter #(= :mouth (:node %)) (ops-at locked f))] mouth (filter #(= :mouth (:node %)) (ops-at (clip/root locked) f))]
(raster/clear! r (get pal/index-of :bg)) (raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r mouth) (raster/draw-ops! r mouth)
(vec (array-seq (:buf r))))) (vec (array-seq (:buf r)))))
@ -594,6 +614,6 @@
(is (< (differ (shot 10) (shot 12)) 200) (is (< (differ (shot 10) (shot 12)) 200)
"a held pose is moving more than the detector noise it should have lost")) "a held pose is moving more than the detector noise it should have lost"))
;; As filmed, the head carries it around the stage as well. ;; As filmed, the head carries it around the stage as well.
(let [filmed (freeze/head-mode {:mode :as-filmed} @clip)] (let [filmed (freeze/head-mode {:mode :as-filmed} @frozen)]
(is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300) (is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300)
"the head does not move across the take"))) "the head does not move across the take")))

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

@ -1,10 +1,10 @@
(ns arthur.support.ops (ns arthur.support.ops
"Comparing two evaluations of a scene, frame for frame. "Comparing two evaluations of a timeline, frame for frame.
`domain/scene` has two evaluators on purpose — `eval-frame` is the `domain/timeline` has two evaluators on purpose — `eval-frame` is the
specification and `resolver` is what playback uses — and scene-test's central specification and `resolver` is what playback uses — and timeline-test's central
assertion is that they agree in forward, backward and random frame order. assertion is that they agree in forward, backward and random frame order.
Step 9 needs the same comparison for a different question: that a scene which Step 9 needs the same comparison for a different question: that a document which
has been through the server produces the same ops as the one that went in. has been through the server produces the same ops as the one that went in.
Shared rather than copied, because the interesting part is not the equality — Shared rather than copied, because the interesting part is not the equality —
@ -12,12 +12,15 @@
point buffer per node, so it can agree on a forward pass and disagree on a point buffer per node, so it can agree on a forward pass and disagree on a
scrub, and a copy of this list that forgot 'backward' would test the easy half. 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)`.
`snapshot` is what makes ops comparable at all: a resolved op carries `:pts` as `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 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 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." changes what the first one says. Reading the points out is what pins the frame."
(:require [arthur.domain.palette :as pal] (:require [arthur.domain.palette :as pal]
[arthur.domain.scene :as scene])) [arthur.domain.timeline :as timeline]))
(defn points (defn points
"An op's points as a vector of [x y], read out of its buffer." "An op's points as a vector of [x y], read out of its buffer."
@ -27,7 +30,7 @@
(defn snapshot (defn snapshot
"Ops -> comparable data. `:i` goes too: it is the draw-order index, and it is a "Ops -> comparable data. `:i` goes too: it is the draw-order index, and it is a
function of the scene rather than of the frame." function of the timeline rather than of the frame."
[ops] [ops]
(mapv (fn [op] (mapv (fn [op]
(cond-> (dissoc op :pts :i) (cond-> (dissoc op :pts :i)
@ -47,13 +50,13 @@
(defn specified (defn specified
"(fn [f] -> snapshot) through `eval-frame`, the specification." "(fn [f] -> snapshot) through `eval-frame`, the specification."
([scene store] (specified scene store pal/index-of)) ([tl store] (specified tl store pal/index-of))
([scene store palette] ([tl store palette]
(fn [f] (snapshot (scene/eval-frame scene f store palette))))) (fn [f] (snapshot (timeline/eval-frame tl f store palette)))))
(defn resolved (defn resolved
"(fn [f] -> snapshot) through `resolver`, the playback path." "(fn [f] -> snapshot) through `resolver`, the playback path."
([scene store] (resolved scene store pal/index-of)) ([tl store] (resolved tl store pal/index-of))
([scene store palette] ([tl store palette]
(let [res (scene/resolver scene store palette)] (let [res (timeline/resolver tl store palette)]
(fn [f] (snapshot (res f)))))) (fn [f] (snapshot (res f))))))

10
frontend/test/browser/take.mjs
View file

@ -186,7 +186,7 @@ const PROBE = `(() => {
cx: drawn ? cx / drawn : null, cy: drawn ? cy / drawn : null, cx: drawn ? cx / drawn : null, cy: drawn ? cy / drawn : null,
hash: h >>> 0, hash: h >>> 0,
frame: document.querySelector('.readout span')?.textContent ?? '', frame: document.querySelector('.readout span')?.textContent ?? '',
scene: [...document.querySelectorAll('.transport .row button')] selectedClip: [...document.querySelectorAll('.transport .row button')]
.filter((b) => b.classList.contains('on')).map((b) => b.textContent), .filter((b) => b.classList.contains('on')).map((b) => b.textContent),
}; };
})()`; })()`;
@ -235,9 +235,9 @@ async function main() {
} }
if (!probe) throw new Error('no canvas.stage on the page — is `shadow-cljs watch app` running?'); if (!probe) throw new Error('no canvas.stage on the page — is `shadow-cljs watch app` running?');
console.log(`\ncanvas ${probe.w}x${probe.h}, scene ${JSON.stringify(probe.scene)}`); console.log(`\ncanvas ${probe.w}x${probe.h}, clip ${JSON.stringify(probe.selectedClip)}`);
check(probe.scene.includes('take'), 'the take is the scene that opens'); check(probe.selectedClip.includes('take'), 'the take is the clip that opens');
check(probe.w === 320 && probe.h === 200, 'the canvas is the stage size', check(probe.w === 320 && probe.h === 200, 'the canvas is the stage size',
`${probe.w}x${probe.h}`); `${probe.w}x${probe.h}`);
check(probe.drawn > 200, 'the first frame is not blank', `${probe.drawn} px drawn`); check(probe.drawn > 200, 'the first frame is not blank', `${probe.drawn} px drawn`);
@ -384,8 +384,8 @@ async function main() {
'and the open mouth still has an interior on the far side'); 'and the open mouth still has an interior on the far side');
// The reopened clip is not one of the built-ins: this is the document that came // The reopened clip is not one of the built-ins: this is the document that came
// back from the server, not the one that was in the page all along. // back from the server, not the one that was in the page all along.
check(!back[0].scene.includes('take'), 'the picture is the reopened document', check(!back[0].selectedClip.includes('take'), 'the picture is the reopened document',
JSON.stringify(back[0].scene)); JSON.stringify(back[0].selectedClip));
check(page.logs.length === 0, 'no errors on the console', check(page.logs.length === 0, 'no errors on the console',
page.logs.slice(0, 3).join(' | ')); page.logs.slice(0, 3).join(' | '));