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

Trace a face over its footage, and choose where its origin goes

Browse source 
A face's :head carries :trace {:frames :origin}: the frames its photo holds
on, and whether the head reads every frame, jumps to the trace frames, or
holds frame 0. It replaces :anchors, so which measured frame a head reads is
one stored fact. An instance's :underlay shows the tracing stills over every
face at or below it, registered through each face's own head, at an opacity,
unkeyed. The clip resolver answers where a row path went on its last frame,
so the paint loop reads the photo's matrix instead of resolving again.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-30 02:49:06 -04:00
parent 550cfe91e5
commit 309c47e0a7
23 changed files with 639 additions and 164 deletions
Download patch file Download diff file Expand all files Collapse all files

3
docs/timing-model.md
View file

@ -78,7 +78,8 @@ candidate poses so stage cuts can still select any of them.
| --- | --- | --- | | --- | --- | --- |
| Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work | | Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work |
| Head anchor map | `:head` node | Implemented, stored with the node | | Head anchor map | `:head` node | Implemented, stored with the node |
| Tracing cel starts and photo address | Authored cel | Separate future work | | Trace frames (photo address) and origin | Face symbol's `:head` `:trace`, written through `:anchors` | Implemented, see `domain/trace` |
| Showing the tracing photo, and its opacity | Face instance's `:underlay` | Implemented; a drawing aid, not keyed |
| Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work | | Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work |
| Stage pose cuts | Symbol instance | Implemented, stored with the instance | | Stage pose cuts | Symbol instance | Implemented, stored with the instance |

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

@ -95,4 +95,4 @@
(def locked (def locked
"The same blocks, with `:head` held at measured frame zero." "The same blocks, with `:head` held at measured frame zero."
(delay (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen))) (delay (freeze/head-mode {:trace {:origin :start}} @frozen)))

71
frontend/src/arthur/domain/clip.cljs
View file

@ -166,7 +166,14 @@
Any symbol can be resolved and none is the default: the frame space is the Any symbol can be resolved and none is the default: the frame space is the
resolved symbol's own `:frames`, and nested instances inside it still resolve, resolved symbol's own `:frames`, and nested instances inside it still resolve,
because this is the function that knows how to do that." because this is the function that knows how to do that.
It answers `symbol/world-of` and `symbol/frame-of` for a ROW PATH — the ids
from `sid` down through instances, as a timeline row names a node — as of the
frame it last resolved: the matrix into `sid`'s coordinates, and the node's
own frame. Nil for a node that was not on that frame. It is how something
drawn beside the picture, like a tracing photo, rides a node inside it without
resolving anything a second time."
([clip store palette sid] (resolver clip store palette sid nil)) ([clip store palette sid] (resolver clip store palette sid nil))
([clip store palette sid {:keys [picture-fps] :as opts}] ([clip store palette sid {:keys [picture-fps] :as opts}]
(letfn [(build [sid chain pose-tracks] (letfn [(build [sid chain pose-tracks]
@ -182,27 +189,47 @@
children (into {} children (into {}
(for [[id n] nodes :when (= :instance (:kind n))] (for [[id n] nodes :when (= :instance (:kind n))]
[id (build (:of n) (conj chain sid) [id (build (:of n) (conj chain sid)
(get-in n [:playback :tracks]))]))] (get-in n [:playback :tracks]))]))
(fn [f] ;; The instances that were on the last frame. Their resolvers
(let [by-id (into {} (map (juxt :node identity)) (own f))] ;; still hold the frame before whenever they were not.
(into [] entered (volatile! #{})
(mapcat step (fn [f]
(fn [id] (vreset! entered #{})
(let [n (get nodes id)] (let [by-id (into {} (map (juxt :node identity)) (own f))]
(if (= :instance (:kind n)) (into []
(let [m (symbol/world-of own id) (mapcat
local (symbol/frame-of own id) (fn [id]
target (symbol clip (:of n)) (let [n (get nodes id)]
length (:frames target) (if (= :instance (:kind n))
frame (when (and m (number? local)) (let [m (symbol/world-of own id)
(if (get-in n [:time :loop?]) local (symbol/frame-of own id)
(mod local length) target (symbol clip (:of n))
local))] length (:frames target)
(if (and frame (<= 0 frame) (< frame length)) frame (when (and m (number? local))
(map #(transform-op % m [id]) ((get children id) frame)) (if (get-in n [:time :loop?])
[])) (mod local length)
(when-let [op (get by-id id)] [op])))) local))]
ids))))))] (if (and frame (<= 0 frame) (< frame length))
(do (vswap! entered conj id)
(map #(transform-op % m [id]) ((get children id) frame)))
[]))
(when-let [op (get by-id id)] [op]))))
ids))))]
(reify
IFn
(-invoke [_ f] (step f))
symbol/IResolver
(world-of [_ [id & more]]
(if more
(when-let [w (and (contains? @entered id)
(symbol/world-of (get children id) (vec more)))]
(node/mul! (node/mat) (symbol/world-of own id) w))
(symbol/world-of own id)))
(frame-of [_ [id & more]]
(if more
(when (contains? @entered id)
(symbol/frame-of (get children id) (vec more)))
(symbol/frame-of own id))))))]
(build sid [] nil)))) (build sid [] nil))))
(defn center (defn center

8
frontend/src/arthur/domain/gesture.cljs
View file

@ -12,7 +12,6 @@
After Effects' stopwatch — there is no mode to be in, and nothing snaps back After Effects' stopwatch — there is no mode to be in, and nothing snaps back
on the next frame as an unkeyed change does in Blender." on the next frame as an unkeyed change does in Blender."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node])) [arthur.domain.node :as node]))
(defn values (defn values
@ -28,7 +27,6 @@
it would throw the measurement away." it would throw the measurement away."
[n] [n]
(cond (cond
(seq (:anchors n)) "its motion is measured — place the instance it is in"
(some #(let [c (get-in n [:channels [:xform %]])] (or (:dense c) (:generated c))) (some #(let [c (get-in n [:channels [:xform %]])] (or (:dense c) (:generated c)))
[:pos :rot :scale]) [:pos :rot :scale])
"its transform is measured — place the instance it is in")) "its transform is measured — place the instance it is in"))
@ -41,14 +39,14 @@
(defn move (defn move
"The node's position with its pivot carried from stage point `p0` to `p1`." "The node's position with its pivot carried from stage point `p0` to `p1`."
[{:keys [parent]} {:keys [pos]} p0 p1] [{:keys [parent]} {:keys [pos]} p0 p1]
(when-let [inv (nest/invert parent)] (when-let [inv (node/invert parent)]
{[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))})) {[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))}))
(defn angle (defn angle
"The angle of stage point `p` about the node's pivot, in the space its "The angle of stage point `p` about the node's pivot, in the space its
rotation is in." rotation is in."
[{:keys [parent]} {:keys [pos anchor]} p] [{:keys [parent]} {:keys [pos anchor]} p]
(when-let [inv (nest/invert parent)] (when-let [inv (node/invert parent)]
(let [[x y] (mapv - (through inv p) (mapv + pos anchor))] (let [[x y] (mapv - (through inv p) (mapv + pos anchor))]
(js/Math.atan2 y x)))) (js/Math.atan2 y x))))
@ -61,7 +59,7 @@
"The node's scale with the point under stage `p0` taken to `p1`, about its "The node's scale with the point under stage `p0` taken to `p1`, about its
pivot, along its own axes — or by the same factor on both when `uniform?`." pivot, along its own axes — or by the same factor on both when `uniform?`."
[{:keys [world]} {:keys [anchor] s :scale} p0 p1 uniform?] [{:keys [world]} {:keys [anchor] s :scale} p0 p1 uniform?]
(when-let [inv (nest/invert world)] (when-let [inv (node/invert world)]
(let [a (mapv - (through inv p0) anchor) (let [a (mapv - (through inv p0) anchor)
b (mapv - (through inv p1) anchor) b (mapv - (through inv p1) anchor)
k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a))) k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a)))

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

@ -45,8 +45,8 @@
WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are
not authored: they are written together by a freeze and replaced together by a not authored: they are written together by a freeze and replaced together by a
re-freeze, and `head-mode` exposes them through `:channels`. The optional re-freeze, and `head-mode` exposes them through `:channels`. The optional
`:anchors` map on the head node chooses which measured frame those channels `:trace` on the head node chooses which measured frame those channels read.
read. A leaf per measured A leaf per measured
channel would offer a write nobody can make. The authored channels beside them channel would offer a write nobody can make. The authored channels beside them
are one leaf each, because a hand writes one at a time. are one leaf each, because a hand writes one at a time.

14
frontend/src/arthur/domain/nest.cljs
View file

@ -23,16 +23,6 @@
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
(defn invert
"The inverse of a 2x3 affine, or nil when it has none — an instance scaled to
nothing has no inside to draw into."
[^js m]
(let [[a b c d e f] (array-seq m)
det (- (* a d) (* b c))]
(when-not (zero? det)
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
(defn- resolved (defn- resolved
"Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then "Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then
answers `symbol/world-of` and `symbol/frame-of` for it on that frame. answers `symbol/world-of` and `symbol/frame-of` for it on that frame.
@ -110,7 +100,7 @@
`{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside." `{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside."
[clip store sid path f pts] [clip store sid path f pts]
(when-let [{:keys [matrix] :as at} (inside clip store sid path f)] (when-let [{:keys [matrix] :as at} (inside clip store sid path f)]
(when-let [inv (invert matrix)] (when-let [inv (node/invert matrix)]
(let [out (js/Float64Array. 2)] (let [out (js/Float64Array. 2)]
(assoc (select-keys at [:sid :frame]) (assoc (select-keys at [:sid :frame])
:pts (into [] (mapcat (fn [[x y]] :pts (into [] (mapcat (fn [[x y]]
@ -243,7 +233,7 @@
there (inside clip store open to f) there (inside clip store open to f)
a (:time here) a (:time here)
b (:time there) b (:time there)
inv (some-> there :matrix invert)] inv (some-> there :matrix node/invert)]
(cond (cond
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) (nil? (get-in clip [:symbols (:sid here) :nodes (peek from)]))
{:refused "nothing to move"} {:refused "nothing to move"}

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

@ -294,6 +294,16 @@
pinv-m (mul! dest pinv-m local) pinv-m (mul! dest pinv-m local)
:else (doto dest (.set local)))) :else (doto dest (.set local))))
(defn invert
"The inverse of a 2x3 affine, or nil when it has none — a node scaled to
nothing has no inside to draw into."
[^js m]
(let [[a b c d e f] (array-seq m)
det (- (* a d) (* b c))]
(when-not (zero? det)
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
(defn apply-pt! (defn apply-pt!
"out[2i], out[2i+1] := m · (x, y)." "out[2i], out[2i+1] := m · (x, y)."
[^js out i ^js m x y] [^js out i ^js m x y]

45
frontend/src/arthur/domain/symbol.cljs
View file

@ -54,6 +54,7 @@
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.trace :as trace]
[arthur.domain.palette :as pal])) [arthur.domain.palette :as pal]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -351,11 +352,12 @@
nodes)) nodes))
(defn- channel-frame (defn- channel-frame
"Anchors select measured frames; marked channels read instance pose choices." "A trace selects the measured frames its node reads; marked channels read
[choices anchors nodes source-fps picture-fps id c lf] instance pose choices."
[choices traces nodes source-fps picture-fps id c lf]
(cond (cond
(contains? anchors id) (contains? traces id)
(pose/held-frame (get anchors id) lf lf) (trace/held-frame (get traces id) lf)
(:pose-sampled? c) (:pose-sampled? c)
(pose/source-frame choices (pose/source-frame choices
@ -367,10 +369,12 @@
:else lf)) :else lf))
(defn- prepared-anchors [nodes] (defn- prepared-traces [nodes]
(into {} (into {}
(for [[id n] nodes :when (seq (:anchors n))] (for [[id n] nodes
[id (vec (sort-by first (:anchors n)))]))) :let [p (trace/prepare (:trace n))]
:when p]
[id p])))
(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.
@ -422,11 +426,11 @@
([sym f store palette pose-tracks opts] ([sym f store palette pose-tracks opts]
(let [nodes (nodes-of sym) (let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
anchors (prepared-anchors nodes) traces (prepared-traces nodes)
{:keys [source-fps picture-fps]} opts {:keys [source-fps picture-fps]} opts
ord (order nodes)] ord (order nodes)]
(eval-into {:read (fn [id path c lf] (eval-into {:read (fn [id path c lf]
(ch/value-at c (channel-frame choices anchors nodes (ch/value-at c (channel-frame choices traces nodes
source-fps picture-fps id c lf) source-fps picture-fps id c lf)
store)) store))
:palette palette :palette palette
@ -486,7 +490,7 @@
([sym store palette pose-tracks {:keys [source-fps picture-fps]}] ([sym store palette pose-tracks {:keys [source-fps picture-fps]}]
(let [nodes (nodes-of sym) (let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
anchors (prepared-anchors nodes) traces (prepared-traces nodes)
ord (order nodes) ord (order nodes)
rank (draw-rank nodes ord) rank (draw-rank nodes ord)
cursors (into {} cursors (into {}
@ -510,7 +514,7 @@
placed (volatile! {}) placed (volatile! {})
ctx {:read (fn [id path c lf] ctx {:read (fn [id path c lf]
(ch/sample! (get-in cursors [id path]) (ch/sample! (get-in cursors [id path])
(channel-frame choices anchors nodes (channel-frame choices traces nodes
source-fps picture-fps id c lf))) source-fps picture-fps id c lf)))
:palette palette :palette palette
:mat-for (fn [id] (get mats id)) :mat-for (fn [id] (get mats id))
@ -578,19 +582,14 @@
(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)))
;; Anchors re-address the node's measurement, regardless of its name. ;; A trace re-addresses the node's measurement, regardless of its name.
(into (for [[id n] nodes (into (for [[id n] nodes
:let [anchors (:anchors n)] :when (some? (:trace n))
:when (some? anchors) p (if (and (integer? (:frames sym)) (seq (:measured n))
:when (not (and (map? anchors) (contains? anchors 0) (= (:channels n) (:measured n)))
(integer? (:frames sym)) (trace/problems (:trace n) (:frames sym))
(every? #(and (integer? %) (<= 0 %) ["a trace reads the node's own measured channels"])]
(< % (:frames sym))) (str "node " (pr-str id) ": " p)))
(concat (keys anchors) (vals anchors)))
(seq (:measured n))
(= (:channels n) (:measured n))))]
(str "node " (pr-str id)
": :anchors must start at frame 0, name valid measured frames, and read that node's own measured channels")))
(into (for [k (remove symbol-keys (keys sym))] (into (for [k (remove symbol-keys (keys sym))]
(str "symbol has a field with no leaf to save it in: " (pr-str k)))) (str "symbol has a field with no leaf to save it in: " (pr-str k))))
(into (when-not (or (nil? (:frames sym)) (and (integer? (:frames sym)) (pos? (:frames sym)))) (into (when-not (or (nil? (:frames sym)) (and (integer? (:frames sym)) (pos? (:frames sym))))

147
frontend/src/arthur/domain/trace.cljs Normal file
View file

@ -0,0 +1,147 @@
(ns arthur.domain.trace
"Tracing a face over its footage: which source frame the photo shows, where the
face's origin goes between those frames, and where the photo sits on stage.
TWO OWNERS, because they are two different kinds of decision. The trace frames
and the origin are the face's — they say how its drawings were made and how it
moves, so they live on its symbol's `:head`, and every instance of that face
shares them:
:trace {:frames [0 12 30] :origin :keys}
Whether the photo is showing, and how strongly, is a viewing aid for one
placement. It is on an INSTANCE, not keyed, and draws nothing into the picture.
It covers every face at or below that instance, and the nearest instance that
says anything decides, so a take shows its faces' footage and one face inside
it can still be switched off:
:underlay {:on? true :opacity 0.5}
THE TRACE IS THE ONE FACT about which measured frame a head reads. `:continuous`
reads the frame it is on, `:keys` jumps to each trace frame's measured head and
holds it — a hold, not a tween — and `:start` holds frame 0's forever. Before
the first trace frame, the first holds. `domain/symbol` reads the head through
`held-frame`, so nothing is derived from the trace and stored beside it.
Normalisation is per face because each face symbol has its own head."
(:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]))
(def origins [:continuous :keys :start])
(defn of
"The head's trace, a head that has none being one that moves freely."
[head]
(merge {:frames [] :origin :continuous} (:trace head)))
(defn prepare
"Trace `t` ready to be read every frame without allocating, or nil for a head
that reads the frame it is on."
[t]
(let [{:keys [frames origin]} (merge {:frames []} t)]
(case origin
:start {:entries [] :before 0}
:keys {:entries (mapv #(vector % %) frames) :before (or (first frames) 0)}
nil)))
(defn held-frame
"The measured frame a head with prepared trace `p` reads at its frame `f`."
[p f]
(pose/held-frame (:entries p) f (:before p)))
(defn problems
"Why `t` is not a trace for a symbol `frames` long. Empty when it is one."
[t frames]
(let [fs (:frames t)]
(cond-> []
(not (some #{(:origin t)} origins))
(conj (str ":origin is " (pr-str (:origin t)) ", not one of " (pr-str origins)))
(not (and (vector? fs) (= fs (vec (sort (distinct fs))))
(every? #(and (integer? %) (<= 0 %) (< % frames)) fs)))
(conj (str ":frames must be distinct frames of the symbol, in order: " (pr-str fs))))))
(defn toggle-frame
"A trace frame at `f`, or none there if there was one."
[t f]
(update t :frames
#(vec (sort (if (some #{f} %) (remove #{f} %) (conj % f))))))
(defn photo-frame
"Which of the face's own frames the photo shows at frame `f`: the last trace
frame at or before it, held, and before the first the first. With none, every
frame is its own."
[{:keys [frames]} f]
(if (seq frames)
(or (last (take-while #(<= % f) frames)) (first frames))
f))
(defn- measured-local
"The head's own measured transform at frame `p`, or nil where the face was not
found and there is none."
[head store p]
(let [[pos rot scale] (map #(ch/value-at (get (:measured head) %) p store)
[[:xform :pos] [:xform :rot] [:xform :scale]])]
(when-not (some ch/nothing? [pos rot scale])
(node/local! (node/mat) pos rot scale [0 0] [0 0]))))
(defn photo-matrix
"From the pixels of source frame `p`'s still, `image-h` pixels tall, to where
the head at world `world` puts them.
The landmarks were measured in image heights, so a pixel is 1/image-h of one;
the head's measured transform at `p` takes that frame's image space into the
head's; `world` takes the head's to the stage. When the head is showing frame
`p` itself the middle two cancel, and the photo sits exactly where the face
was filmed."
[world head store p image-h]
(when-let [inv (some-> (measured-local head store p) node/invert)]
(let [px (js/Float64Array. #js [(/ 1 image-h) 0 0 (/ 1 image-h) 0 0])]
(node/mul! (node/mat) (node/mul! (node/mat) world inv) px))))
(defn traceable?
"Does symbol `sid` have a measured head to trace over?"
[clip sid]
(seq (get-in clip [:symbols sid :nodes :head :measured])))
(defn faces
"The instances of faces inside symbol `sid`, at any depth, as `{:path :in
:face}`: the row path from `sid`, the symbol the instance is in, and the face
symbol it places."
[clip sid]
(letfn [(walk [sid path]
(mapcat (fn [[id n]]
(when (= :instance (:kind n))
(let [p (conj path id)]
(cond->> (walk (:of n) p)
(traceable? clip (:of n)) (cons {:path p :in sid :face (:of n)})))))
(sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))]
(vec (walk sid []))))
(defn underlay-at
"The underlay in force at the instance at row path `path` from symbol `sid`:
the nearest one set on it or above it, `:own?` saying which. Nil when none is."
[clip sid path]
(:u (reduce (fn [{:keys [sid u]} id]
(let [n (get-in clip [:symbols sid :nodes id])]
{:sid (:of n)
:u (if-let [own (:underlay n)]
(assoc own :own? true)
(some-> u (assoc :own? false)))}))
{:sid sid} path)))
(defn shown
"Every face whose footage shows from symbol `sid` down, as `{:path :face
:opacity}`: the row path of the face's instance, the face's symbol, and how
strongly to draw it."
[clip sid]
(letfn [(walk [sid path opacity]
(mapcat (fn [[id n]]
(when (= :instance (:kind n))
(let [path (conj path id)
u (:underlay n)
opacity (if u (when (:on? u) (:opacity u 0.5)) opacity)]
(cond->> (walk (:of n) path opacity)
(and opacity (traceable? clip (:of n)))
(cons {:path path :face (:of n) :opacity opacity})))))
(get-in clip [:symbols sid :nodes])))]
(vec (walk sid [] nil))))

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

@ -624,6 +624,19 @@
(fn [db [_ sid id path frame]] (fn [db [_ sid id path frame]]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame)))) (edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame))))
;; A face's trace frames and origin, on its symbol — see `domain/trace`.
(rf/reg-event-db
::set-trace
(fn [db [_ sid value]]
(edit/edit db #(assoc-in % [:symbols sid :nodes :head :trace] value))))
;; Whether one instance shows its face's footage under it. Not keyed: it is a
;; drawing aid, not part of the picture.
(rf/reg-event-db
::set-underlay
(fn [db [_ sid id underlay]]
(edit/edit db #(assoc-in % [:symbols sid :nodes id :underlay] underlay))))
(rf/reg-event-db (rf/reg-event-db
::set-segment-interp ::set-segment-interp
(fn [db [_ sid id path left interp]] (fn [db [_ sid id path left interp]]

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

@ -36,6 +36,7 @@
[arthur.domain.feature :as feature] [arthur.domain.feature :as feature]
[arthur.domain.geom :as geom] [arthur.domain.geom :as geom]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.domain.trace :as trace]
[arthur.flow.address :as address])) [arthur.flow.address :as address]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -245,47 +246,38 @@
:tx (* (- s') (+ (* c tx) (* sn ty))) :tx (* (- s') (+ (* c tx) (* sn ty)))
:ty (* (- s') (+ (* (- sn) tx) (* c ty)))})) :ty (* (- s') (+ (* (- sn) tx) (* c ty)))}))
(def ^:private head-modes #{:free :anchored})
(defn head-mode (defn head-mode
"Keep a subject's measured transform dense; optionally hold chosen source "Keep a subject's measured transform dense; optionally trace it.
frames.
A nil anchor map reads measured frame f at frame f (free movement). With no trace the head reads measured frame f at frame f (free movement).
`{0 12}` locks to the measured transform of source frame 12. `{0 12, 40 42}` `{:frames [12] :origin :keys}` holds the measured transform of source frame
cuts to source frame 42 at local frame 40. The same map selects position, 12, `{:frames [12 42] :origin :keys}` jumps to 42's at 42, and `{:origin
rotation and scale, so the head and registered photo cannot drift apart. :start}` holds frame 0's. See `domain/trace`. The trace selects position,
No analysis block or authored face placement changes. rotation and scale together, so the head and registered photo cannot drift
apart. No analysis block or authored face placement changes.
ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is
not. Two faces in one shot were filmed together and are posed apart: choosing not. Two faces in one shot were filmed together and are posed apart: choosing
frame 12 for the second face must leave the first one running, and it does, frame 12 for the second face must leave the first one running, and it does,
because an anchor map lives on that subject's own head node and because a trace lives on that subject's own head node and `domain/symbol`
`domain/symbol` reads anchors off whatever node carries them." reads it off whatever node carries it."
[{:keys [subject mode anchors]} {:keys [clip]}] [{:keys [subject] t :trace} {:keys [clip]}]
(when-not (contains? head-modes mode)
(throw (ex-info "head mode must be free or anchored"
{:mode mode :modes head-modes})))
(when (and (= mode :free) (some? anchors))
(throw (ex-info "free head motion has no anchors" {:anchors anchors})))
(when (and subject (not (contains? (:subjects clip) subject))) (when (and subject (not (contains? (:subjects clip) subject)))
(throw (ex-info "head mode names a subject this clip did not track" (throw (ex-info "head mode names a subject this clip did not track"
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))}))) {:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
(reduce (let [t (some->> t (merge {:frames []}))]
(fn [c sid] (reduce
(let [frames (get-in c [:symbols sid :frames])] (fn [c sid]
(when (and (= mode :anchored) (let [frames (get-in c [:symbols sid :frames])]
(not (and (map? anchors) (contains? anchors 0) (when-let [why (some-> t (trace/problems frames) first)]
(every? #(and (integer? %) (<= 0 %) (< % frames)) (throw (ex-info (str "a head's trace is not one this take can hold: " why)
(concat (keys anchors) (vals anchors)))))) {:subject sid :trace t :frames frames})))
(throw (ex-info "anchored head needs a frame-zero key and valid source frames" (update-in c [:symbols sid :nodes :head]
{:subject sid :anchors anchors :frames frames}))) (fn [n]
(update-in c [:symbols sid :nodes :head] (cond-> (assoc n :channels (:measured n))
(fn [n] t (assoc :trace t)
(cond-> (assoc n :channels (:measured n)) (nil? t) (dissoc :trace))))))
(= mode :anchored) (assoc :anchors anchors) clip (if subject [subject] (sort-by str (keys (:subjects clip)))))))
(= mode :free) (dissoc :anchors))))))
clip (if subject [subject] (sort-by str (keys (:subjects clip))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the aperture, onto [:vis] of :mouth-in ;; the aperture, onto [:vis] of :mouth-in
@ -688,9 +680,9 @@
existing instance scope. Features name local nodes in that subject's symbol; existing instance scope. Features name local nodes in that subject's symbol;
block descriptors still name globally distinct features. block descriptors still name globally distinct features.
Subjects share a source frame space. :head and :anchors may be overridden Subjects share a source frame space. :trace may be overridden per subject;
per subject; all other freeze settings come from params." all other freeze settings come from params."
[{:keys [name fps stage expose head anchors] :as params} subjects] [{:keys [name fps stage expose] :as params} subjects]
(when-not (and (map? subjects) (seq subjects) (when-not (and (map? subjects) (seq subjects)
(every? keyword? (keys subjects)) (every? keyword? (keys subjects))
(not-any? #{:main :root :face} (keys subjects))) (not-any? #{:main :root :face} (keys subjects)))
@ -729,7 +721,6 @@
{:subject subject :feature id :frames nf :actual (count track)})))) {:subject subject :feature id :frames nf :actual (count track)}))))
{:store (merged :store) {:store (merged :store)
:clip (reduce (fn [c [subject inputs]] :clip (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :mode (or (:head inputs) head) (head-mode {:subject subject :trace (get inputs :trace (:trace params))}
:anchors (get inputs :anchors anchors)}
{:clip c})) {:clip c}))
built ordered)})) built ordered)}))

2
frontend/src/arthur/flow/take.cljs
View file

@ -127,7 +127,7 @@
{:name (or (:source manifest) "footage") {:name (or (:source manifest) "footage")
:fps (:fps manifest) :aspect (/ w h) :fps (:fps manifest) :aspect (/ w h)
:stage [320 200] :fit-motion? true :stage [320 200] :fit-motion? true
:expose 1 :head :free :expose 1
;; The detector's identity comes from the server, which ;; The detector's identity comes from the server, which
;; hashes the model asset it serves rather than trusting a ;; hashes the model asset it serves rather than trusting a
;; version string somebody has to remember to bump. See ;; version string somebody has to remember to bump. See

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

@ -11,6 +11,8 @@
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[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]))
@ -130,9 +132,32 @@
(if (or (nil? resolve) (empty? solo)) (if (or (nil? resolve) (empty? solo))
resolve resolve
;; An op inside an instance is named by the path its row has; one at the ;; An op inside an instance is named by the path its row has; one at the
;; top by its bare id. ;; top by its bare id. Still the resolver underneath, so where a node
(fn [f] ;; went on the frame is still asked of it.
(filterv (fn [{n :node}] (reify
(let [p (if (vector? n) n [n])] IFn
(some #(= % (take (count %) p)) solo))) (-invoke [_ f]
(resolve f))))))) (filterv (fn [{n :node}]
(let [p (if (vector? n) n [n])]
(some #(= % (take (count %) p)) solo)))
(resolve f)))
symbol/IResolver
(world-of [_ path] (symbol/world-of resolve path))
(frame-of [_ path] (symbol/frame-of resolve path)))))))
(rf/reg-sub
::underlay
:<- [::clip-id]
:<- [::clip]
:<- [::store]
:<- [::open]
:<- [::solo]
(fn [[id document store open solo] _]
;; What `ui/underlay` needs to paint the footage under the faces being
;; traced, besides the resolver that says where they went. A face outside
;; every soloed row is not on stage, so neither is its footage.
(let [solo (filter #(placed? document open %) solo)]
{:document document :store store
:footage-id (:footage-id (footage/entry id))
:traces (cond->> (when document (trace/shown document open))
(seq solo) (filterv (fn [{:keys [path]}] (some #(= % (take (count %) path)) solo))))})))

71
frontend/src/arthur/ui/params.cljs
View file

@ -13,6 +13,7 @@
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.domain.trace :as trace]
[arthur.events.history :as history] [arthur.events.history :as history]
[arthur.events.paint :as paint-events] [arthur.events.paint :as paint-events]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
@ -232,6 +233,72 @@
[channel-control sid id path ch frame] [channel-control sid id path ch frame]
[:dd (channel-state ch)])]))])])) [:dd (channel-state ch)])]))])]))
;; ---------------------------------------------------------------------------
;; tracing a face
;;
;; Two owners in one section, and the heading says whose each is. Showing the
;; footage and how strongly is this INSTANCE's, a drawing aid that is not keyed,
;; and it covers every face at or below it — so a take shows its faces' footage.
;; The trace keys and the origin are the FACE's — its symbol's head — so they are
;; the same in every placement of it. See `domain/trace`.
(defn- face-trace [face]
(let [t (trace/of (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head]))
{:keys [frame time]} @(rf/subscribe [::sub/selected-local])
put #(rf/dispatch [::project/set-trace face %])]
[:<>
[:div.row {:style {:margin "5px 0"}}
[:button {:disabled (nil? frame)
:on-click #(put (trace/toggle-frame t frame))}
(if (some #{frame} (:frames t)) "remove trace key" "trace key here")]]
(when (seq (:frames t))
[:div.row
[:span.dim "keys"]
(doall
(for [f (:frames t)]
^{:key f}
[:button {:class (when (= frame f) "on")
:disabled (nil? time)
:on-click #(rf/dispatch [::pb/seek (js/Math.round
(+ (:at time) (/ f (:rate time))))])}
(str f)]))])
[:div.row {:style {:margin-top "5px"}}
[:span.dim "origin"]
(doall
(for [[o label] (map vector trace/origins ["continuous" "at keys" "start"])]
^{:key o}
[:button {:class (when (= o (:origin t)) "on")
:on-click #(put (assoc t :origin o))}
label]))]]))
(defn- tracing-section [[sid id n] faces]
(let [clip @(rf/subscribe [::render/clip])
open @(rf/subscribe [::render/open])
[_ _ _ path] @(rf/subscribe [::sub/selection])
path (or path [id])
{:keys [on? opacity own?] :or {opacity 0.5} :as u} (trace/underlay-at clip open path)
show #(rf/dispatch [::project/set-underlay sid id (merge {:on? (boolean on?) :opacity opacity} %)])]
[section (str "tracing · " (name (:of n)))
[:div.row
[:label.dim [:input {:type "checkbox" :checked (boolean on?)
:on-change #(show {:on? (.. % -target -checked)})}]
" footage"
(when (and u (not own?)) " · as above")]
[:input {:type "range" :min 0 :max 1 :step 0.05 :value opacity
:disabled (not on?)
:on-focus #(rf/dispatch [::history/hold])
:on-blur #(rf/dispatch [::history/settle])
:on-change #(show {:opacity (js/parseFloat (.. % -target -value))})}]]
(when (trace/traceable? clip (:of n)) [face-trace (:of n)])
(when (seq faces)
[:div.row {:style {:margin-top "5px"}}
[:span.dim "faces"]
(doall
(for [{p :path in :in face :face} faces]
^{:key (str p)}
[:button {:on-click #(rf/dispatch [::ui/select [:node in (peek p) (into path p)]])}
(name face)]))])]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; a symbol ;; a symbol
@ -357,5 +424,9 @@
[:div {:style {:min-height 0}} [:div {:style {:min-height 0}}
[clip-section] [clip-section]
(when node [node-section node]) (when node [node-section node])
(when-let [of (:of (peek node))]
(let [faces (trace/faces clip of)]
(when (or (trace/traceable? clip of) (seq faces))
[tracing-section node faces])))
(when (= :symbol (first selection)) [symbol-section (second selection)]) (when (= :symbol (first selection)) [symbol-section (second selection)])
(when tracked? [tracking-section])]])) (when tracked? [tracking-section])]]))

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

@ -25,6 +25,7 @@
[arthur.subs.playback :as sub] [arthur.subs.playback :as sub]
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.ui.canvas :as canvas] [arthur.ui.canvas :as canvas]
[arthur.ui.underlay :as underlay]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.ratom :as ratom])) [reagent.ratom :as ratom]))
@ -110,6 +111,7 @@
:frames @(rf/subscribe [::render/frames]) :frames @(rf/subscribe [::render/frames])
:width @(rf/subscribe [::sub/width]) :width @(rf/subscribe [::sub/width])
:height @(rf/subscribe [::sub/height]) :height @(rf/subscribe [::sub/height])
:underlay @(rf/subscribe [::render/underlay])
:frame @(rf/subscribe [::sub/frame]) :frame @(rf/subscribe [::sub/frame])
:playing? @(rf/subscribe [::sub/playing?])}) :playing? @(rf/subscribe [::sub/playing?])})
;; A new resolver means a new scene or a new palette, and neither ;; A new resolver means a new scene or a new palette, and neither
@ -144,7 +146,7 @@
rasterised before the next frame is asked for." rasterised before the next frame is asked for."
[f] [f]
(let [{:keys [canvas]} @state (let [{:keys [canvas]} @state
{:keys [resolver palette ramp width height]} @snapshot] {:keys [resolver palette ramp width height underlay]} @snapshot]
(when (and canvas resolver width height) (when (and canvas resolver width height)
;; User Timing, so a profile in the DevTools performance panel has named ;; User Timing, so a profile in the DevTools performance panel has named
;; spans in the Timings track instead of a wall of anonymous frames. Three ;; spans in the Timings track instead of a wall of anonymous frames. Three
@ -160,7 +162,8 @@
(raster/clear! (get palette :bg 0)) (raster/clear! (get palette :bg 0))
(raster/draw-ops! ops))) (raster/draw-ops! ops)))
(js/performance.mark "arthur/blit:start") (js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras ramp)) (canvas/blit! canvas ras ramp)
(underlay/paint! (assoc underlay :width width) resolver repaint!))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start") (js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start") (js/performance.measure "arthur/paint" "arthur/paint:start")
;; User Timing entries otherwise accumulate forever in the browser's ;; User Timing entries otherwise accumulate forever in the browser's

5
frontend/src/arthur/ui/stage.cljs
View file

@ -23,6 +23,7 @@
[arthur.subs.ui :as sub] [arthur.subs.ui :as sub]
[arthur.ui.drag :as drag] [arthur.ui.drag :as drag]
[arthur.ui.player :as player] [arthur.ui.player :as player]
[arthur.ui.underlay :as underlay]
[re-frame.core :as rf])) [re-frame.core :as rf]))
(def ^:const zoom (def ^:const zoom
@ -266,7 +267,7 @@
[:g [:g
[:polygon {:points (points-text pts) :fill "none" [:polygon {:points (points-text pts) :fill "none"
:stroke "#e6ca8b" :stroke-width 1}] :stroke "#e6ca8b" :stroke-width 1}]
(when-let [inv (when editable? (nest/invert matrix))] (when-let [inv (when editable? (node/invert matrix))]
(doall (doall
(for [[i [x y]] (map-indexed vector (pairs pts))] (for [[i [x y]] (map-indexed vector (pairs pts))]
^{:key i} ^{:key i}
@ -309,4 +310,6 @@
:width w :height h :width w :height h
:style {:width (str (* zoom w) "px") :style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}] :height (str (* zoom h) "px")}}]
[:canvas.underlay {:ref #(underlay/set-canvas! %)
:width (* zoom w) :height (* zoom h)}]
[overlay w h]]])) [overlay w h]]]))

81
frontend/src/arthur/ui/underlay.cljs Normal file
View file

@ -0,0 +1,81 @@
(ns arthur.ui.underlay
"The footage a face is traced over, on its own canvas above the stage.
A REFERENCE, NOT OUTPUT. The tracing still never enters the indexed raster, so
it cannot reach an export, and it is drawn OVER the picture at the instance's
opacity rather than under it, because the raster clears to an opaque ground.
The canvas is the stage's size on screen, not the raster's, so a 1280px still
is not squeezed through a 320px stage on its way to being seen.
Painted by `ui/player` straight after each frame, from the same snapshot, so
it moves with the face it registers to — see `domain/trace/photo-matrix`."
(:require [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.flow.ingest :as ingest]))
(defonce ^:private state (atom {:canvas nil :urls {} :images {}}))
(defn set-canvas! [el] (swap! state assoc :canvas el))
(defn- urls
"The footage's still URLs, or nil until its manifest has come back."
[footage-id on-ready]
(let [u (get-in @state [:urls footage-id])]
(when (nil? u)
(swap! state assoc-in [:urls footage-id] :loading)
(-> (ingest/manifest! footage-id)
(.then (fn [m]
(swap! state assoc-in [:urls footage-id] (:urls m))
(on-ready)))
(.catch (fn [error]
(swap! state assoc-in [:urls footage-id] :failed)
(js/console.error "arthur: no stills for footage" footage-id error)))))
(when (vector? u) u)))
(def ^:private ^:const kept
"Decoded stills held at once. A 1280px still is about 5MB decoded, and
scrubbing a face with no trace keys asks for every frame of the take."
48)
(defn- image
"The still at `url`, or nil until it has loaded."
[url on-ready]
(let [img (or (get-in @state [:images url])
(let [img (js/Image.)]
(set! (.-onload img) on-ready)
(set! (.-src img) url)
(swap! state update :images
#(assoc (if (< (count %) kept) % {}) url img))
img))]
(when (and (.-complete img) (pos? (.-naturalHeight img))) img)))
(defn paint!
"Draw every switched-on underlay on the frame `resolver` last resolved. It
says where each face's head went and which of its frames it was on, so this
reads the frame rather than resolving it again. `on-ready` is called when a
still or a manifest that was missing arrives, to paint again."
[{:keys [document store footage-id traces width]} resolver on-ready]
(when-let [^js canvas (:canvas @state)]
(let [ctx (.getContext canvas "2d")
zoom (/ (.-width canvas) width)]
(.setTransform ctx 1 0 0 1 0 0)
(.clearRect ctx 0 0 (.-width canvas) (.-height canvas))
(when-let [us (and (seq traces) footage-id (urls footage-id on-ready))]
(let [start (first (get-in document [:analysis :range] [0]))]
(doseq [{:keys [path face opacity]} traces
:let [at (conj path :head)
world (symbol/world-of resolver at)
frame (symbol/frame-of resolver at)]
:when (and world (number? frame))
:let [head (get-in document [:symbols face :nodes :head])
p (trace/photo-frame (trace/of head) (js/Math.floor frame))
img (some-> (get us (+ start p)) (image on-ready))
m (when img
(trace/photo-matrix world head store p (.-naturalHeight img)))]
:when m]
(set! (.-globalAlpha ctx) opacity)
(.setTransform ctx
(* zoom (aget m 0)) (* zoom (aget m 1))
(* zoom (aget m 2)) (* zoom (aget m 3))
(* zoom (aget m 4)) (* zoom (aget m 5)))
(.drawImage ctx img 0 0)))))))

1
frontend/test/arthur/domain/gesture_test.cljs
View file

@ -90,7 +90,6 @@
(deftest a-measured-transform-is-not-set-by-hand (deftest a-measured-transform-is-not-set-by-hand
(is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}}))) (is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
(is (string? (gesture/refusal {:anchors {0 12}})))
(is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]})}})))) (is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]})}}))))
(deftest a-click-selects-the-level-figma-would (deftest a-click-selects-the-level-figma-would

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

@ -69,7 +69,7 @@
out (js/Float64Array. 2) out (js/Float64Array. 2)
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y)))) seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
(partition 2 [0 0 10 0 5 10])) (partition 2 [0 0 10 0 5 10]))
[x y] (array-seq (node/apply-pt! out 0 (nest/invert matrix) 7 3)) [x y] (array-seq (node/apply-pt! out 0 (node/invert matrix) 7 3))
moved (paint/set-vertex c :box :shape frame 0 [x y]) moved (paint/set-vertex c :box :shape frame 0 [x y])
keyed (paint/add-key c :box :shape (:frame (nest/inside c nil :main [u v :shape] 20)))] keyed (paint/add-key c :box :shape (:frame (nest/inside c nil :main [u v :shape] 20)))]
(is (= 4 frame) "16 of main is 6 of mid, which is 4 of box and of the shape in it") (is (= 4 frame) "16 of main is 6 of mid, which is 4 of box and of the shape in it")

114
frontend/test/arthur/domain/trace_test.cljs Normal file
View file

@ -0,0 +1,114 @@
(ns arthur.domain.trace-test
(:require [cljs.test :refer [deftest is]]
[arthur.demo.take :as take]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.flow.freeze :as freeze]))
(def ^:private frozen (delay (freeze/head-mode {} @take/frozen)))
(def ^:private store (delay (:store @take/frozen)))
(defn- traced
"The synthetic take with face-1's trace set to `t`."
[t]
(assoc-in @frozen [:symbols :face-1 :nodes :head :trace] t))
(defn- head [c] (get-in c [:symbols :face-1 :nodes :head]))
(defn- near? [a b]
(every? #(< (js/Math.abs %) 1e-9) (map - a b)))
(deftest the-origin-picks-the-measured-frame-a-head-reads
(let [at (fn [t fs] (map #(trace/held-frame (trace/prepare t) %) fs))]
(is (nil? (trace/prepare {:frames [4 9] :origin :continuous})))
(is (nil? (trace/prepare nil)))
(is (= [0 0 0] (at {:frames [4 9] :origin :start} [0 5 50])))
(is (= [4 4 4 4 9 9] (at {:frames [4 9] :origin :keys} [0 3 4 8 9 50]))
"a jump at each key, and before the first the first")
(is (= [0 0] (at {:frames [] :origin :keys} [0 30])))))
(deftest every-origin-is-a-valid-document-that-saves
(doseq [origin trace/origins
:let [c (traced {:frames [0 12 40] :origin origin})]]
(is (empty? (clip/problems c)) (str origin ": " (pr-str (clip/problems c))))
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) (str origin " round-trips"))))
(deftest a-trace-the-take-cannot-hold-will-not-save
(doseq [t [{:frames [0] :origin :sideways} {:frames [9 3] :origin :keys}
{:frames [9999] :origin :keys}]]
(is (seq (clip/problems (traced t))) (pr-str t))))
(deftest the-photo-holds-each-trace-frame-until-the-next
(let [t {:frames [5 20]}]
(is (= [5 5 5 5 20 20] (map #(trace/photo-frame t %) [0 4 5 19 20 90]))))
(is (= 33 (trace/photo-frame {:frames []} 33)) "no keys: every frame is its own")
(is (= [3 7] (:frames (trace/toggle-frame {:frames [7]} 3))))
(is (= [] (:frames (trace/toggle-frame {:frames [7]} 7)))))
(defn- photo-at
"The photo matrix of face-1 alone at frame `f`, the still being 1000px tall."
[c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of)
h (head c)]
(r f)
(vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store
(trace/photo-frame (trace/of h) f) 1000)))))
(deftest the-photo-registers-to-the-face-it-was-filmed-with
;; Face-1 is its own symbol and its head is its root, so a photo sitting where
;; it was filmed is image pixels over image height and nothing else.
(let [filmed [0.001 0 0 0.001 0 0]]
(is (near? filmed (photo-at (traced {:frames [] :origin :continuous}) 30))
"a head showing the photo's own frame cancels out")
(is (near? filmed (photo-at (traced {:frames [12] :origin :keys}) 30))
"held at the trace frame, face and photo both stand still")
(is (not (near? filmed (photo-at (traced {:frames [12] :origin :continuous}) 30)))
"a continuous head carries the held photo along with it")))
(defn- wrapped
"Face-1's take placed, moved, inside a symbol :wrap, with `underlays` on the
instances named."
[{:keys [outer inner]}]
(-> @frozen
(assoc-in [:symbols :wrap] {:id :wrap :frames 200
:nodes {:m (cond-> {:id :m :kind :instance :of :main :z "a0"
:channels {[:xform :pos] {:animated? false
:value [30 -10]}}}
outer (assoc :underlay outer))}})
(cond-> inner (assoc-in [:symbols :main :nodes :face-1 :underlay] inner))))
(deftest an-underlay-covers-the-faces-below-it-and-the-nearest-decides
(is (= [{:path [:m :face-1] :face :face-1 :opacity 0.3}]
(trace/shown (wrapped {:outer {:on? true :opacity 0.3}}) :wrap))
"switched on at the take, its face shows")
(is (= [] (trace/shown (wrapped {:outer {:on? true} :inner {:on? false}}) :wrap))
"and the face can still be switched off inside it")
(is (= [{:path [:m :face-1] :face :face-1 :opacity 0.8}]
(trace/shown (wrapped {:inner {:on? true :opacity 0.8}}) :wrap)))
(let [c (wrapped {:outer {:on? true :opacity 0.3}})]
(is (= {:on? true :opacity 0.3 :own? false} (trace/underlay-at c :wrap [:m :face-1])))
(is (= {:on? true :opacity 0.3 :own? true} (trace/underlay-at c :wrap [:m])))
(is (nil? (trace/underlay-at @frozen :main [:face-1])))))
(deftest a-take-lists-the-faces-in-it
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/faces @frozen :main)))
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/faces (wrapped {}) :wrap)))
(is (= [] (trace/faces @frozen :face-1))))
(deftest the-resolver-says-where-a-nested-head-went-on-its-last-frame
;; The same answer as `nest/placement`, which walks and resolves the path all
;; over again — the resolver has it already, from drawing the frame.
(let [c (wrapped {})
r (clip/resolver c @store pal/index-of :wrap)
path [:m :face-1 :head]]
(doseq [f [0 17 60]]
(r f)
(let [pl (nest/placement c @store :wrap path f)]
(is (near? (array-seq (:world pl)) (array-seq (symbol/world-of r path))) (str f))
(is (= (:frame pl) (js/Math.floor (symbol/frame-of r path))) (str f))))
(r 500)
(is (nil? (symbol/world-of r path)) "not on the frame, not anywhere")))

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

@ -78,12 +78,10 @@
;; before the data is trusted — which is what it is for. It checks the clip's ;; 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 ;; fields, every timeline in it and the tracking identities, so it is the whole
;; of what a save would refuse. ;; of what a save would refuse.
(doseq [spec [{:mode :free} {:mode :anchored :anchors {0 0}}]] (doseq [spec [{} {:trace {:origin :start}} {:trace {:origin :continuous :frames [4]}}
{:trace {:origin :keys :frames [12 88 150]}}]]
(let [c (freeze/head-mode spec @frozen)] (let [c (freeze/head-mode spec @frozen)]
(is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c)))))) (is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c)))))))
(let [c (freeze/head-mode {:mode :anchored
:anchors {0 12, 40 88, 150 150}} @frozen)]
(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
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face))) (is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
@ -194,7 +192,7 @@
;; 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 [c (freeze/head-mode {:mode :free} @frozen) (let [c (freeze/head-mode {} @frozen)
res (clip/resolver c @store pal/index-of :main) res (clip/resolver c @store pal/index-of :main)
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]))
@ -232,48 +230,48 @@
"], the composition says [" wx " " wy "]")))))) "], the composition says [" wx " " wy "]"))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; one dense measurement, with optional held anchor frames ;; one dense measurement, with optional held trace frames
(deftest head-anchors-select-measured-frames-without-copying-channels (deftest a-head-trace-selects-measured-frames-without-copying-channels
(let [free (freeze/head-mode {:mode :free} @frozen) (let [free (freeze/head-mode {} @frozen)
one (freeze/head-mode {:mode :anchored :anchors {0 12}} @frozen) one (freeze/head-mode {:trace {:origin :keys :frames [12]}} @frozen)
keyed (freeze/head-mode {:mode :anchored keyed (freeze/head-mode {:trace {:origin :keys :frames [12 88 150]}} @frozen)
:anchors {0 12, 40 88, 150 150}} @frozen)
of (fn [c path] (get-in (nodes c) [:head :channels path]))] of (fn [c path] (get-in (nodes c) [:head :channels path]))]
(doseq [c [free one keyed] (doseq [c [free one keyed]
path [[:xform :pos] [:xform :rot] [:xform :scale]]] path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :dense (ch/describe (of c path)))) (is (= :dense (ch/describe (of c path))))
(is (= (of free path) (of c path)) "anchor edits do not copy measurements")) (is (= (of free path) (of c path)) "a trace does not copy measurements"))
(is (nil? (get-in (nodes free) [:head :anchors]))) (is (nil? (get-in (nodes free) [:head :trace])))
(is (= {0 12} (get-in (nodes one) [:head :anchors]))) (is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace])))
(is (= {0 12, 40 88, 150 150}
(get-in (nodes keyed) [:head :anchors])))
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed))) (is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
"anchor source addresses survive the document round trip"))) "the trace survives the document round trip")))
(deftest head-anchor-keys-hold-the-whole-measured-transform (deftest trace-keys-hold-the-whole-measured-transform
(let [free (symbol/resolver (face-symbol (let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen))
(freeze/head-mode {:mode :free} @frozen)) @store pal/index-of)
@store pal/index-of)
held (symbol/resolver (face-symbol held (symbol/resolver (face-symbol
(freeze/head-mode {:mode :anchored (freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen))
:anchors {0 12, 40 88}} @frozen)) @store pal/index-of)
@store pal/index-of) start (symbol/resolver (face-symbol
(freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen))
@store pal/index-of)
world (fn [resolver frame] world (fn [resolver frame]
(resolver frame) (resolver frame)
(vec (array-seq (symbol/world-of resolver :head))))] (vec (array-seq (symbol/world-of resolver :head))))]
(is (= (world free 12) (world held 0))) (is (= (world free 12) (world held 0)) "before the first key, the first holds")
(is (= (world free 12) (world held 38))) (is (= (world free 12) (world held 87)))
(is (= (world free 88) (world held 40))) (is (= (world free 88) (world held 88)) "a jump, not a tween")
(is (= (world free 88) (world held 100))))) (is (= (world free 88) (world held 100)))
(is (not= (world free 0) (world free 100)) "the head does move, so the above says something")
(is (= (world free 0) (world start 50) (world start 100)))))
(deftest switching-modes-rewrites-the-head-and-nothing-else (deftest switching-modes-rewrites-the-head-and-nothing-else
;; It has to be impossible for the toggle to move something a hand placed, and ;; It has to be 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 :free} @frozen) (let [a (freeze/head-mode {} @frozen)
b (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen) b (freeze/head-mode {:trace {:origin :start}} @frozen)
c (freeze/head-mode {:mode :anchored :anchors {0 0, 40 40}} @frozen)] c (freeze/head-mode {:trace {:origin :keys :frames [0 40]}} @frozen)]
(doseq [x [b c]] (doseq [x [b c]]
(is (= (get (nodes a) :face) (get (nodes x) :face)) (is (= (get (nodes a) :face) (get (nodes x) :face))
":face moved") ":face moved")
@ -287,14 +285,17 @@
;; channels, so the clip's own fields and its other timelines are untouched. ;; channels, so the clip's own fields and its other timelines are untouched.
(is (= (dissoc a :symbols) (dissoc x :symbols)))))) (is (= (dissoc a :symbols) (dissoc x :symbols))))))
(deftest invalid-head-anchor-maps-are-refused (deftest invalid-head-traces-are-refused
(is (thrown-with-msg? ExceptionInfo #"free or anchored" (doseq [t [{} {:origin :stabilised} {:origin :keys :frames [take/frames]}
(freeze/head-mode {:mode :stabilised} @frozen))) {:origin :keys :frames [-1]} {:origin :keys :frames [12 4]}
(doseq [anchors [nil {} {12 12} {0 take/frames} {0 0, 10 -1}]] {:origin :keys :frames [4 4]} {:origin :keys :frames '(4)}]]
(is (thrown-with-msg? ExceptionInfo #"frame-zero key" (is (thrown-with-msg? ExceptionInfo #"trace is not one this take can hold"
(freeze/head-mode {:mode :anchored :anchors anchors} @frozen)))) (freeze/head-mode {:trace t} @frozen))
(is (thrown-with-msg? ExceptionInfo #"has no anchors" (pr-str t)))
(freeze/head-mode {:mode :free :anchors {0 0}} @frozen)))) (is (seq (clip/problems (assoc-in (freeze/head-mode {} @frozen)
[:symbols :face-1 :nodes :head :trace]
{:origin :keys :frames [take/frames]})))
"and a document holding one will not save"))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the face: authored, and what makes makeXform deletable ;; the face: authored, and what makes makeXform deletable
@ -598,7 +599,7 @@
;; 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 :anchored :anchors {0 0}} @frozen) (let [locked (freeze/head-mode {:trace {:origin :start}} @frozen)
shot (fn [f] shot (fn [f]
(let [r (raster/make W H) (let [r (raster/make W H)
mouth (filter #(= [:face-1 :mouth] (:node %)) mouth (filter #(= [:face-1 :mouth] (:node %))
@ -616,6 +617,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 :free} @frozen)] (let [filmed (freeze/head-mode {} @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")))

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

@ -20,7 +20,7 @@
(def frames 40) (def frames 40)
(def settings (def settings
(merge take/knobs {:name "two faces" :fps 30 :aspect 1 :stage [320 200] (merge take/knobs {:name "two faces" :fps 30 :aspect 1 :stage [320 200]
:fit-motion? true :expose 1 :head :anchored :anchors {0 0} :fit-motion? true :expose 1 :trace {:origin :start}
:analysis (address/analysis {:detector "synth" :version "two-faces-v1" :analysis (address/analysis {:detector "synth" :version "two-faces-v1"
:seed 9 :frames frames :fps 30 :aspect 1})})) :seed 9 :frames frames :fps 30 :aspect 1})}))
(def inputs (def inputs
@ -62,13 +62,13 @@
(assoc-in clip [:features :duplicate] (assoc-in clip [:features :duplicate]
(assoc (get-in clip [:features :face-2/mouth]) :id :duplicate))))))) (assoc (get-in clip [:features :face-2/mouth]) :id :duplicate)))))))
(deftest one-subjects-edit-and-anchor-do-not-change-its-neighbor (deftest one-subjects-edit-and-trace-do-not-change-its-neighbor
(let [before @initial (let [before @initial
at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]] at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]]
before (assoc-in before at (ch/framed :brow)) before (assoc-in before at (ch/framed :brow))
after (regenerate/change before {:scope :feature :id :face-2/eye-r after (regenerate/change before {:scope :feature :id :face-2/eye-r
:knob :gaze-gain :value 2}) :knob :gaze-gain :value 2})
anchored (freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 12}} after)] anchored (freeze/head-mode {:subject :face-2 :trace {:origin :keys :frames [12]}} after)]
(is (= (get-in before at) (get-in after at)) "authored channels survive regeneration") (is (= (get-in before at) (get-in after at)) "authored channels survive regeneration")
(is (= (get-in before [:clip :symbols :face-1]) (is (= (get-in before [:clip :symbols :face-1])
(get-in after [:clip :symbols :face-1]) (get-in after [:clip :symbols :face-1])
@ -77,7 +77,7 @@
(channel after :face-2 :iris-r [:xform :pos]))) (channel after :face-2 :iris-r [:xform :pos])))
(is (= (channel before :face-2 :iris-l [:xform :pos]) (is (= (channel before :face-2 :iris-l [:xform :pos])
(channel after :face-2 :iris-l [:xform :pos]))) (channel after :face-2 :iris-l [:xform :pos])))
(is (= {0 12} (get-in anchored [:symbols :face-2 :nodes :head :anchors]))) (is (= {:origin :keys :frames [12]} (get-in anchored [:symbols :face-2 :nodes :head :trace])))
(is (empty? (clip/problems anchored))))) (is (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage (deftest the-second-subject-regenerates-inside-a-composed-stage
@ -92,9 +92,9 @@
(get-in after [:clip :symbols sid])))) (get-in after [:clip :symbols sid]))))
(is (empty? (clip/problems (:clip after)))) (is (empty? (clip/problems (:clip after))))
(is (thrown? ExceptionInfo (is (thrown? ExceptionInfo
(freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 frames}} (freeze/head-mode {:subject :face-2 :trace {:origin :keys :frames [frames]}}
after)) after))
"anchors are bounded by the source timeline, even on a longer stage"))) "trace frames are bounded by the source timeline, even on a longer stage")))
(deftest an-instance-pose-cut-only-holds-that-faces-mouth (deftest an-instance-pose-cut-only-holds-that-faces-mouth
(let [{:keys [clip store]} @initial (let [{:keys [clip store]} @initial
@ -114,7 +114,7 @@
(assoc-in [:face-2 :presence :eye-r] (assoc-in [:face-2 :presence :eye-r]
(assoc (vec (repeat frames true)) 12 false))) (assoc (vec (repeat frames true)) 12 false)))
{:keys [clip store]} (take/build settings inputs) {:keys [clip store]} (take/build settings inputs)
clip (freeze/head-mode {:mode :free} {:clip clip}) clip (freeze/head-mode {} {:clip clip})
at8 (by-node clip store 8) at8 (by-node clip store 8)
at12 (by-node clip store 12)] at12 (by-node clip store 12)]
(is (some? (get at8 [:face-1 :mouth]))) (is (some? (get at8 [:face-1 :mouth])))

2
static/arthur/app.css
View file

@ -502,6 +502,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.stage { display: block; background: var(--stage); } .stage { display: block; background: var(--stage); }
.paint-overlay { position: absolute; inset: 0; touch-action: none; } .paint-overlay { position: absolute; inset: 0; touch-action: none; }
/* The footage traced over: a reference above the picture, never part of it. */
.underlay { position: absolute; inset: 0; pointer-events: none; }
.paint-overlay.drawing { cursor: crosshair; } .paint-overlay.drawing { cursor: crosshair; }
.paint-overlay circle { cursor: grab; } .paint-overlay circle { cursor: grab; }