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

Represent tracing media as symbols and add pool thumbnails

Browse source
This commit is contained in:
Olive Vaughn 2026-10-04 00:02:12 -04:00
parent 551d572347
commit 17e1b4f403
49 changed files with 1777 additions and 864 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -12,7 +12,6 @@
are entirely dense."
(:require [arthur.demo :as demo]
[arthur.domain.clip :as domain-clip]
[arthur.domain.trace :as trace]
[arthur.demo.swarm :as swarm]
[arthur.demo.take :as take]))
@ -49,6 +48,18 @@
(defn clip-entry [id]
(some-> (get-in clips [id :entry]) deref))
(def tracing
"How tracing layers show on the stage: all of them or none, how strongly, and
which ones are switched off, as `[symbol-id node-id]` — the symbol a tracing
placement is in and its id, so a face's footage is one layer wherever the face
is placed.
THE EDITOR'S, NOT THE DOCUMENT'S. Showing a reference is a way of looking at
the stage, like solo and zoom: not an undo step, not sent to collaborators,
and it cannot reach an export. A layer is shown unless it is in `:hidden`, so
footage brought in shows without being found and switched on first."
{:on? true :opacity 0.5 :hidden #{}})
(def default
{;; --- the document ---
;;
@ -165,7 +176,7 @@
:auto-key? false
:draft []
:knobs {}
:trace {:faces #{} :opacity trace/opacity-default}
:tracing tracing
:expanded #{}}})
(def rates

3
frontend/src/arthur/domain/bring.cljs
View file

@ -87,7 +87,8 @@
(keys (:subjects frozen)))))
(symbol-id label))
scoped (partial scope root)
wanted (into {:main root} (map (fn [subject] [subject (scoped subject)]))
wanted (into {:main root :footage (scoped :footage)}
(map (fn [subject] [subject (scoped subject)]))
(keys (:subjects frozen)))
{c :clip ids :ids} (symbols clip frozen [:main] wanted)
sid (ids :main)

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

@ -59,6 +59,12 @@
[clip sid]
(get-in clip [:symbols sid]))
(defn trace?
"Is `sym` a tracing symbol: footage or a still to draw over, which is placed and
moved like any symbol and never drawn into the picture? See `trace-op`."
[sym]
(= :trace (:type sym)))
(defn symbol-name
"What to call a symbol: its `:name`, or its id when it has none."
[clip sid]
@ -199,10 +205,13 @@
"The symbol a document opens on: the longest one nothing else places, ties
broken by id. The symbol that contains everything else is the longest of the
unplaced ones in every document made so far, and a reserved name is what this
replaces."
replaces.
Never a tracing symbol: it is footage nobody has placed yet, and as long as
the take it came from, so it would otherwise win."
[clip]
(first (sort-by (fn [sid] [(- (or (frames clip sid) 0)) (str sid)])
(unplaced clip))))
(remove #(trace? (symbol clip %)) (unplaced clip)))))
(defn set-root-fps
"Set the document/output rate and the root symbol's editing rate together.
@ -266,8 +275,31 @@
(assoc op :cx x :cy y :r (* scale (:r op))))
:rect (let [[x y] (at (:cx op) (:cy op))]
(assoc op :cx x :cy y :size (* scale (:size op))))
:trace (assoc op :m (node/mul! (node/mat) m (:m op)))
op)))
(defn- trace-op
"The one op an instance of tracing symbol `sym` makes, showing its frame `frame`
at world `m`, from node `id` of symbol `sid`.
NOT A PICTURE OP. Nothing indexed can show a photo, so the raster refuses this
kind and the player hands it to `ui/tracing` instead; and the resolver makes one
only when asked with `:tracing?`, which only the stage does. An export, a
symbol's centre and a thumbnail never ask, so a reference cannot reach the
picture by any path that forgets to filter it.
`:layer` is what the on/off switch for one layer is keyed by: the symbol the
placement is in and its id, so a face's plate is one layer wherever the face
is placed."
[sym frame m sid id]
{:kind :trace
:node id
:layer [sid id]
:media (:media sym)
:frame frame
:size [(:width sym) (:height sym)]
:m (js/Float64Array.from m)})
(defprotocol IActivePalette
(active-palette [this]
"The palette selected by this resolver's most recently resolved frame."))
@ -345,11 +377,13 @@
#(pal/render-index palette @active %)
palette)
(assoc opts :pose-tracks pose-tracks))
;; Each cel owns its source resolver and mutable buffers.
;; Each cel owns its source resolver and mutable buffers. A
;; tracing symbol has nothing to resolve: it is one op.
children (into {}
(for [[id n] nodes
:when (= :instance (:kind n))
child (sort-by str (node/sources n))]
child (sort-by str (node/sources n))
:when (not (trace? (symbol clip child)))]
[[id child] (build child (conj chain sid)
(get-in n [:playback :tracks]) false)]))
;; The instances that were on the last frame, and WHICH
@ -383,7 +417,15 @@
shown (when (and m (number? local))
(placed-frame clip sid n local))
frame (:frame shown)]
(if (and frame (<= 0 frame) (< frame length))
(cond
(not (and frame (<= 0 frame) (< frame length)))
[]
(trace? (symbol clip (:symbol shown)))
(when (:tracing? opts)
[(trace-op (symbol clip (:symbol shown)) frame m sid id)])
:else
(do (vswap! entered assoc id (:symbol shown))
(map #(transform-op % m [id])
((get children [id (:symbol shown)])
@ -403,8 +445,7 @@
(dec frame))
@active
(when (and context? (:palette n))
(selection-at n frame nil)))))
[]))
(selection-at n frame nil)))))))
(when-let [op (get by-id id)] [op]))))
ids))))]
(reify

7
frontend/src/arthur/domain/creation.cljs
View file

@ -50,12 +50,17 @@
but the occurrence chain that reaches the lane must still be valid. The empty
path always resolves to the open symbol.
A tracing symbol is never one: it holds a picture to draw over and no nodes,
so selecting a tracing layer creates beside it, as selecting a shape does.
Returns `{:kind :lane|:symbol :sid :path :frame :matrix :time}`."
[document store open selection frame]
(let [preferred (preferred-path document open selection)]
(some (fn [path]
(when-let [inside (nest/inside document store open path frame)]
(when-let [sid (:sid inside)]
(when-let [sid (and (:sid inside)
(not (clip/trace? (clip/symbol document (:sid inside))))
(:sid inside))]
(assoc inside :path path
:kind (if (symbol/lane? (clip/symbol document sid))
:lane :symbol)))))

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

@ -45,9 +45,10 @@
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
re-freeze, and `head-mode` exposes them through `:channels`. The optional
`:trace` on the head node chooses which measured frame those channels read.
A leaf per measured
re-freeze, and `head-mode` exposes them through `:channels`. The same is true
of a face's `:plate`, whose measured channels register its footage. Which
measured frame they read is the node's `:reads` and `:time :holds`, which
save with the node. A leaf per measured
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.
@ -149,7 +150,8 @@
(for [[sid sym] (:symbols clip)]
{(at "symbol" (segment sid))
(select-keys sym [:name :frames :fps :width :height :palette
:palette-track :palette-channel :type :palette-ref :display])})
:palette-track :palette-channel :type :palette-ref :display
:media])})
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)]
{(at "symbol" (segment sid) "node" (segment id))

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

@ -95,6 +95,23 @@
:matrix (node/mat) :time node/same-time}
path))
(defn own-time
"The time map from symbol `sid`'s frames to the OWN frames of the node at row
path `path` from it, with `sid` showing frame `f`: the frames its keys and
holds are written in. Nil where no affine map exists — through a loop or a
floor above the node, or where it is not on screen.
It STOPS AT THE NODE, where `inside` goes into what the node places, and it
leaves out the node's own floors: a hold is added on a frame the node's holds
would otherwise floor away."
[clip store sid path f]
(when-let [{inner :sid t :time} (inside clip store sid (pop path) f)]
(let [nodes (:nodes (clip/symbol clip inner))
n (get nodes (peek path))
up (symbol/frame-map nodes (:parent n))]
(when (and n t up)
(-> t (node/then-time up) (node/then-time (node/time-of n)))))))
(defn placement
"Where the node at row path `path` is, from symbol `sid` showing frame `f`, as
a transform would change it: `{:sid :id :frame :parent :world}` — the symbol it
@ -319,6 +336,8 @@
(nil? n) "nothing to move"
(or (nil? here) (nil? there)) "both have to be on screen at this frame"
(nil? (:sid there)) "only a symbol can take it"
(clip/trace? (clip/symbol clip (:sid there)))
"a tracing layer is a picture to draw over — nothing goes inside it"
(span/placement-refusal clip (:sid there) n)
(span/placement-refusal clip (:sid there) n)
(not (and (:time here) (:time there)))

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

@ -295,16 +295,33 @@
(defn finite-number? [v] (and (number? v) (js/Number.isFinite v)))
(defn hold
"Floor `f` onto the last of `holds` at or before it, and before the first onto
the first. Exposure on authored frames rather than on a grid: `[0 12 30]` shows
frame 12 from 12 until 30. What a tracing layer's held photos and a face's
trace keys are.
A `reduce` that stops at the first hold past `f`, because this runs per node
per frame and the list is sorted."
[f holds]
(if (seq holds)
(reduce (fn [held h] (if (<= h f) h (reduced held))) (first holds) holds)
f))
(defn local-frame
"Apply an artistic time map within one frame space: expose, then offset.
Frame-rate selection happens at symbol boundaries in domain/clip."
"Apply an artistic time map within one frame space: expose, hold, then offset.
Frame-rate selection happens at symbol boundaries in domain/clip.
Holds come after exposure and inherit the same way, strictly: they are a floor
of this node's own frame, and its children are handed the floored frame."
[n f]
(let [{:keys [mode at rate offset] ex :expose :or {mode :map at 0 rate 1}} (:time n)]
(let [{:keys [mode at rate offset holds] ex :expose :or {mode :map at 0 rate 1}} (:time n)]
(if (= mode :inherit)
f
(cond-> (* rate (- f at))
ex (expose ex)
offset (+ offset)))))
ex (expose ex)
(seq holds) (hold holds)
offset (+ offset)))))
;; ---------------------------------------------------------------------------
;; the transform
@ -468,7 +485,11 @@
(apply < (:span n)))))
(conj ":span must be a finite, increasing [in out]")
(some? (get-in n [:time :in]))
(conj ":time has an :in — an instance's first frame is the start of its own :span"))
(conj ":time has an :in — an instance's first frame is the start of its own :span")
(let [hs (get-in n [:time :holds])]
(and (some? hs) (not (and (vector? hs) (every? finite-number? hs)
(or (empty? hs) (apply < hs))))))
(conj ":time :holds must be a vector of increasing frames"))
(into (when valid
(for [[path _] (:channels n)

40
frontend/src/arthur/domain/pick.cljs
View file

@ -41,22 +41,44 @@
(range n))))
(some #(near-segment? x y (px %) (py %) (px (inc %)) (py (inc %))) (range n)))))
(defn- on? [{:keys [kind pts n cx cy r size]} x y]
(defn- trace-corners
"A trace op's image rectangle on the stage, as four [x y] corners."
[{[w h] :size m :m}]
(for [[x y] [[0 0] [w 0] [w h] [0 h]]]
[(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4))
(+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))]))
(defn- on? [{:keys [kind pts n cx cy r size m]} x y]
(case kind
:poly (on-poly? pts n x y)
:disc (<= (js/Math.hypot (- x cx) (- y cy)) (+ r slop))
:rect (let [h (+ slop (/ size 2))]
(and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h)))
;; Into the image's own pixels, where the test is a rectangle however the
;; layer is turned or scaled.
:trace (when-let [inv (node/invert m)]
(let [[w h] size
u (+ (* (aget inv 0) x) (* (aget inv 2) y) (aget inv 4))
v (+ (* (aget inv 1) x) (* (aget inv 3) y) (aget inv 5))]
(and (<= 0 u) (< u w) (<= 0 v) (< v h))))
false))
(defn hit
"The row path of the topmost op in `ops`, in draw order, at stage point `[x y]`,
or nil."
[ops [x y]]
(some #(when (on? % x y) (path-of %)) (rseq (vec ops))))
or nil.
(defn- op-bounds [{:keys [kind pts n cx cy r size]}]
WHAT IS DRAWN WINS OVER A REFERENCE. A tracing photo usually covers the whole
stage and is painted over the picture, so topmost-first would make every click
land on it; a trace is picked only where nothing drawn is under the pointer."
[ops [x y]]
(let [{traces true drawn false} (group-by #(= :trace (:kind %)) (rseq (vec ops)))]
(some #(when (on? % x y) (path-of %)) (concat drawn traces))))
(defn- op-bounds [{:keys [kind pts n cx cy r size] :as op}]
(case kind
:trace (let [cs (trace-corners op)]
[(apply min (map first cs)) (apply min (map second cs))
(apply max (map first cs)) (apply max (map second cs))])
:poly (reduce (fn [b i]
(let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))]
(if b (let [[x0 y0 x1 y1] b]
@ -121,7 +143,13 @@
(let [grow (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
at (fn [f p] (ch/value-at (get (node/channels n) p) f store))]
(case (:kind n)
(case (if (some->> (node/source n) (clip/symbol document) clip/trace?) :trace (:kind n))
;; A tracing symbol draws nothing to resolve: what it covers is its media's
;; pixels, in its own coordinates, on every frame it shows one.
:trace
(let [{:keys [width height]} (clip/symbol document (node/source n))]
(fn [f] (when (clip/placed-frame document sid n f) [0 0 width height])))
:instance
;; ONE RESOLVER PER DRAWING THE LANE CAN SHOW, built once for the reason
;; the single one used to be: a resolver costs the symbol to build and a

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

@ -65,7 +65,7 @@
"Frames worth landing on, per pose group: `{group -> ascending frames}`, or nil
where nothing is marked.
PRECOMPUTED WHEN THE RESOLVER IS BUILT, beside `prepare` and `trace/prepare`,
PRECOMPUTED WHEN THE RESOLVER IS BUILT, beside `prepare`,
and this is the reason it is a function rather than a line inside the snap. A
`[:vis]` channel is keys and not dense, so reading one per node per frame would
be cheap — but the snap needs the marks SORTED for a backward lookup, and

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

@ -29,7 +29,7 @@
(:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire]))
(def schema-version 5)
(def schema-version 6)
(defn block-keys
"Every tier-2 key a leaf map names, in a stable order."

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

@ -56,7 +56,6 @@
(:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]
[arthur.domain.trace :as trace]
[arthur.domain.palette :as pal]))
;; ---------------------------------------------------------------------------
@ -137,7 +136,8 @@
(let [n (get nodes id) t (:time n)]
(when (and n (not (contains? seen id))
(not (:loop? t))
(<= (or (:expose t) 1) 1))
(<= (or (:expose t) 1) 1)
(empty? (:holds t)))
(recur (:parent n) (conj seen id) (conj chain n)))))))
(defn lane?
@ -457,7 +457,7 @@
(into {} (remove #(= :audio (:kind (val %)))) nodes)))
(defn- base-channel-frame
"A trace selects the measured frames its node reads; marked channels read
"`:reads` holds the frames a node's own channels read; marked channels read
instance pose choices, and the preserve-snap where nobody has made one.
`lf` is this slot's local frame and `plf` the PREVIOUS slot's, both already
@ -466,10 +466,10 @@
snap needs from the grid, and it is why the pair is threaded this far down
instead of the snap happening where the grid becomes a native frame: the snap is
per pose group, and a group is a fact that only exists here."
[choices marks traces nodes id c lf plf]
[choices marks reads nodes id c lf plf]
(cond
(contains? traces id)
(trace/held-frame (get traces id) lf)
(contains? reads id)
(node/hold (js/Math.floor lf) (get reads id))
(:pose-sampled? c)
(let [group (or (:pose-group (get nodes id)) id)]
@ -487,12 +487,19 @@
:else (js/Math.floor lf)))
(defn- prepared-traces [nodes]
(into {}
(for [[id n] nodes
:let [p (trace/prepare (:trace n))]
:when p]
[id p])))
(defn- holds-read
"The frames node `n` reads its OWN channels at, held — not its children's,
which is what makes this different from `:time :holds` — or nil for every
frame. `{:holds [0]}` is a face's head at its start, and `{:holds-of :plate}`
is the head holding wherever its footage holds, which is one list of frames
read by two nodes rather than two lists kept in step."
[nodes n]
(let [{:keys [holds holds-of]} (:reads n)
hs (if holds-of (get-in nodes [holds-of :time :holds]) holds)]
(when (seq hs) hs)))
(defn- prepared-reads [nodes]
(into {} (keep (fn [[id n]] (some->> (holds-read nodes n) (vector id)))) nodes))
(defn- eval-into
"One frame, as a fold over the nodes in topological order.
@ -550,10 +557,10 @@
choices (pose/prepare pose-tracks)
marks (when (and snap (snap (:id sym)))
(pose/marks nodes (:frames sym) store))
traces (prepared-traces nodes)
reads (prepared-reads nodes)
ord (order nodes)]
(eval-into {:read (fn [id path c lf plf]
(ch/value-at c (base-channel-frame choices marks traces
(ch/value-at c (base-channel-frame choices marks reads
nodes id c lf plf)
lf store))
:palette palette
@ -636,11 +643,11 @@
;; argument, and any predicate on one will do.
;;
;; One option, and it is the snap's alone. The plate side will never want
;; one — its proposal is materialised into `:trace :frames` rather than
;; one — its proposal is materialised into the plate's `:time :holds` rather than
;; computed on the render path — so this is not half of a pair.
marks (when (and snap (snap (:id sym)))
(pose/marks nodes (:frames sym) store))
traces (prepared-traces nodes)
reads (prepared-reads nodes)
ord (order nodes)
rank (draw-rank nodes ord)
cursors (into {}
@ -665,7 +672,7 @@
ctx {:read (fn [id path c lf plf]
(when-let [cursor (get-in cursors [id path])]
(ch/sample! cursor
(base-channel-frame choices marks traces
(base-channel-frame choices marks reads
nodes id c lf plf)
lf)))
:palette palette
@ -708,9 +715,34 @@
`:display` is how the TIMELINE draws the symbol — `:lane` for its clips as
blocks on one row — and is saved because two people editing one document must
play by the same editing rules. See `lane?`."
play by the same editing rules. See `lane?`.
`:media` is what a `:type :trace` symbol shows — `{:footage id :range [in
out]}` or `{:image sha256}` — and such a symbol has no nodes: its frames are
the footage's, its `:fps` the footage's own and its `:width`/`:height` its
pixels. A still shows the same picture on every one of its frames, so how many
it has is only how long it was made to last, and trimming its placement is
how that changes. See `clip/trace-op`."
#{:id :name :frames :fps :width :height :nodes :palette :palette-track
:palette-channel :type :palette-ref :display})
:palette-channel :type :palette-ref :display :media})
(defn- media-problems
"Why `sym`, a tracing symbol, does not say what it shows. Empty when it does."
[{:keys [media frames width height nodes]}]
(let [{:keys [footage image range]} media]
(cond-> []
(seq nodes)
(conj "a tracing symbol cannot contain nodes")
(not (= 1 (count (filter some? [footage image]))))
(conj ":media must name exactly one of :footage or :image")
(and footage (not (and (vector? range) (= 2 (count range))
(every? integer? range) (apply < range)
(= frames (- (second range) (first range))))))
(conj "a footage :media needs a [in out) :range as long as the symbol's :frames")
(not (and (integer? frames) (pos? frames)))
(conj "a tracing symbol is a positive whole number of frames")
(not (and (pos? width) (pos? height)))
(conj "a tracing symbol needs its media's pixel :width and :height"))))
(defn problems
"Human-readable reasons this symbol will not evaluate. Empty means it will.
@ -731,6 +763,7 @@
(cond->
(and (= :palette (:type sym)) (seq nodes))
(conj "a palette symbol cannot contain nodes"))
(into (when (= :trace (:type sym)) (media-problems sym)))
(into (for [[id n] nodes
:when (not= id (:id n))]
(str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))
@ -745,13 +778,30 @@
(into (for [[id n] nodes
p (node/problems n)]
(str "node " (pr-str id) ": " p)))
;; A trace re-addresses the node's measurement, regardless of its name.
(into (for [[id n] nodes
:when (some? (:trace n))
p (if (and (integer? (:frames sym)) (seq (:measured n))
(= (:channels n) (:measured n)))
(trace/problems (:trace n) (:frames sym))
["a trace reads the node's own measured channels"])]
:when (some? (:trace n))]
(str "node " (pr-str id) ": :trace is gone — trace keys are the "
"footage placement's :time :holds, and a head follows them "
"with :reads {:holds-of …}; make the face again from its footage")))
;; `:reads` names its holds or another node's, the way `:stencil` names
;; a node: one that is here, and never one whose frame depends on the
;; reader's own channels being read first.
(into (for [[id n] nodes
:let [{:keys [holds holds-of] :as r} (:reads n)]
:when (some? r)
p (cond
(and holds holds-of)
[":reads names its own :holds or a node's, not both"]
holds-of
(cond
(not (contains? nodes holds-of))
[(str ":reads :holds-of " (pr-str holds-of) " is not in the symbol")]
(some #{holds-of} (lineage nodes id))
[":reads :holds-of names the node itself or one above it"])
:else
(when-not (and (vector? holds) (every? node/finite-number? holds)
(or (empty? holds) (apply < holds)))
[":reads :holds must be a vector of increasing frames"]))]
(str "node " (pr-str id) ": " p)))
(into (for [k (remove symbol-keys (keys sym))]
(str "symbol has a field with no leaf to save it in: " (pr-str k))))

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

@ -1,164 +0,0 @@
(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 not the document's at all.
It is a viewing aid, like soloing a row, so it lives in the editor's own state
— `[:ui :trace]`, a set of face symbols switched on and one opacity — and is
never keyed, saved or exported. A face is the same face wherever it is placed,
so one switch shows it in the take it is placed in AND in its own tab, which is
where it is drawn over; nothing has to be switched on twice or per placement.
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])
(def ^:const opacity-default
"How strongly a switched-on photo draws until someone moves the slider."
0.5)
(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))
;; Every drawing the lane can show, not only the one it
;; happens to be on: a face traced in one cel is the same
;; face when the lane cuts to another.
(let [p (conj path id)]
(mapcat (fn [child]
(cond->> (walk child p)
(traceable? clip child)
(cons {:path p :in sid :face child})))
(sort-by str (node/sources n))))))
(sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))]
(vec (walk sid []))))
(defn traceable-faces
"Every face that can be traced while symbol `sid` is open, each once: `sid`
itself when it is a face — open in its own tab, to be drawn over — and the
faces placed inside it at any depth."
[clip sid]
(into [] (distinct)
(cond->> (map :face (faces clip sid))
(traceable? clip sid) (cons sid))))
(defn showing-for
"The faces showing their footage once `sid` is the open symbol, given the ones
`on` already showing.
OPENING A FACE IS ASKING TO DRAW OVER IT: a symbol has measured footage behind
it only because it was traced from that footage, so its own tab starts with the
footage showing rather than with a switch to be found first. A take or a scene
is the picture itself, and a reference drawn over one would read as part of it,
so nothing is switched on for those. Either way it is switched by hand
afterwards, from the inspector's footage section or from a face's own timeline
row."
[clip sid on]
(cond-> (set on) (traceable? clip sid) (conj sid)))
(defn shown
"The faces whose footage is showing while symbol `sid` is open, as `faces` lists
them — the row path of the face's instance from `sid`, and the face — filtered
to the `showing` set.
The open symbol itself is in the list, at the EMPTY path, when it is a face:
that is a face open in its own tab to be drawn over, and the one place tracing
matters most. There is no inheritance to work out and no opacity to carry
because the switch is the face's, not a placement's."
[clip sid showing]
(into [] (filter (comp (set showing) :face))
(cond->> (faces clip sid)
(traceable? clip sid) (cons {:path [] :in sid :face sid}))))

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

@ -315,8 +315,10 @@
(fn [_]
(-> (js/Promise.all #js [(ingest/available!)
(.then (http/GET "/api/sounds")
#(:sounds (js->clj % :keywordize-keys true)))])
(.then (fn [[footage sounds]] (rf/dispatch [::listed footage sounds])))
#(:sounds (js->clj % :keywordize-keys true)))
(.then (http/GET "/api/images")
#(:images (js->clj % :keywordize-keys true)))])
(.then (fn [[footage sounds images]] (rf/dispatch [::listed footage sounds images])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
@ -356,17 +358,34 @@
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(rf/reg-fx
::upload-image!
(fn [file]
(let [form (js/FormData.)]
(.append form "file" file)
(-> (http/POST-form "/api/images" form)
(.then (fn [^js image] (rf/dispatch [::uploaded (.-id image) "image imported"])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(rf/reg-event-fx
::upload
(fn [{:keys [db]} [_ ^js file]]
;; By type, and by name for a browser that leaves the type empty.
(let [sound? (and file (or (string/starts-with? (.-type file) "audio/")
(re-find #"(?i)\.(mp3|wav|aiff?|flac|ogg|m4a|aac)$" (.-name file))))]
(let [kind (when file
(cond
(or (string/starts-with? (.-type file) "audio/")
(re-find #"(?i)\.(mp3|wav|aiff?|flac|ogg|m4a|aac)$" (.-name file)))
:sound
(or (string/starts-with? (.-type file) "image/")
(re-find #"(?i)\.(png|jpe?g|gif|webp)$" (.-name file)))
:image
:else :video))]
(if (or (nil? file) (get-in db [:footage :loading?]))
{}
{:db (update db :footage merge {:loading? true
:status (if sound? "uploading sound…" "uploading video…")})
(if sound? ::upload-sound! ::upload!) file}))))
:status (str "uploading " (name kind) "…")})
(case kind :sound ::upload-sound! :image ::upload-image! ::upload!) file}))))
(rf/reg-event-fx
::uploaded
@ -386,10 +405,11 @@
(rf/reg-event-db
::listed
(fn [db [_ footage sounds]]
(fn [db [_ footage sounds images]]
(update db :footage merge
(cond-> {:available (vec footage)
:sounds (vec sounds)
:images (vec images)
:chosen (or (:chosen (:footage db)) (:id (first footage)))}
(empty? footage) (assoc :status "upload a video to begin")))))
@ -438,12 +458,13 @@
(rf/reg-event-fx
::relabel
(fn [{:keys [db]} [_ kind id value]]
;; `kind` is `:footage` or `:sound`: two resources with one field between
;; `kind` is `:footage`, `:sound` or `:image`: resources with one field between
;; them, and one event rather than two that differ by a path and a URL.
(let [label (string/trim (str value))
[key url] (case kind
:footage [:available (str "/api/footage/" id)]
:sound [:sounds (str "/api/sounds/" id)]
:image [:images (str "/api/images/" id)]
[nil nil])]
(if (or (nil? id) (nil? key))
{}
@ -474,7 +495,7 @@
::ask-convert
(fn [db [_ {:keys [frames label] :as footage} frame point target]]
(assoc-in db [:ui :convert]
(merge (select-keys footage [:id :label :frames :fps :video])
(merge (select-keys footage [:id :label :frames :fps :video :width :height])
{:range [0 frames]
:name (string/replace (str label) #"\.[^.]*$" "")
:host (get-in db [:ui :open]) :frame frame :point point
@ -499,6 +520,25 @@
::pb/pause! nil
::convert! {:footage-id id :range range :request request}}))))
(rf/reg-event-fx
::convert-tracing
;; The same question answered the other way: the chosen frames become a tracing
;; layer to draw over, with nothing detected and nothing measured. Its frames
;; are the footage's own and its rate the footage's, so it plays at the speed it
;; was filmed in a project at any rate.
(fn [{:keys [db]} _]
(let [{:keys [id range fps width height name frame point target] :as request}
(get-in db [:ui :convert])]
(if (or (nil? request) (get-in db [:footage :loading?]))
{}
{:db (update db :ui dissoc :convert)
:dispatch [::ui/drop-tracing
{:name name :type :trace
:media {:footage id :range range}
:frames (- (second range) (first range)) :fps fps
:width width :height height :nodes {}}
frame point target]}))))
(rf/reg-event-fx
::converted
;; A TAKE IS A CLIP LIKE ANY OTHER, placed into whichever symbol the drop names

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

@ -13,7 +13,7 @@
(:require [arthur.audio.mix :as mix]
[arthur.clock :as clock]
[arthur.domain.clip :as clip]
[arthur.domain.trace :as trace]
[arthur.db :as app-db]
[arthur.footage.store :as footage]
[re-frame.core :as rf]))
@ -39,11 +39,10 @@
:clip (select-keys entry [:fps :width :height :audio]))
(update :ui merge
{:open sid :tabs (if sid [sid] [])
;; From scratch, not merged: the faces switched on were another
;; document's, and a face id means nothing in this one.
:trace {:faces (trace/showing-for (:clip entry) sid #{})
:opacity (or (get-in db [:ui :trace :opacity])
trace/opacity-default)}})
;; The layers switched off were another document's, and their
;; ids mean nothing in this one. Whether tracing shows at all,
;; and how strongly, is the person's and carries over.
:tracing (assoc (get-in db [:ui :tracing] app-db/tracing) :hidden #{})})
;; Occurrence addresses belong to the document being left. Creation is
;; derived from the primary selection, so carrying one across documents
;; could otherwise make a coincidentally equal id a nested destination.
@ -212,7 +211,10 @@
::open-symbol
(fn [{:keys [db]} [_ sid]]
(let [clip (:clip (footage/entry (:clip/current db)))]
(if (or (nil? (clip/symbol clip sid)) (= sid (get-in db [:ui :open])))
;; A tracing symbol has no inside to open: it is footage, which is seen by
;; placing it.
(if (or (nil? (clip/symbol clip sid)) (= sid (get-in db [:ui :open]))
(clip/trace? (clip/symbol clip sid)))
{}
{:db (-> db
(update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid)))
@ -224,7 +226,6 @@
(cond-> ui
(= :node (first (:selection ui)))
(dissoc :selection :selections))))
(update-in [:ui :trace :faces] #(trace/showing-for clip sid %))
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pause! nil

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

@ -801,11 +801,28 @@
(let [st (:store (store/entry (:clip/current db)))]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame st)))))
;; A face's trace frames and origin, on its symbol — see `domain/trace`.
;; A hold on node `id`'s own frame `frame`, or none there if there was one: the
;; frames a tracing layer holds its picture on — a face's trace keys are its
;; plate's — and, for any node, `node/hold`. Taking the last one off removes the
;; floor rather than leaving an empty list behind.
(rf/reg-event-db
::set-trace
(fn [db [_ sid value]]
(edit/edit db #(assoc-in % [:symbols sid :nodes :head :trace] value))))
::toggle-hold
(fn [db [_ sid id frame]]
(edit/edit db #(update-in % [:symbols sid :nodes id :time]
(fn [t]
(let [hs (get t :holds [])
hs (vec (sort (if (some #{frame} hs)
(remove #{frame} hs)
(conj hs frame))))]
(if (seq hs) (assoc t :holds hs) (dissoc t :holds))))))))
;; How a face's head moves between its footage's holds — `symbol`'s `:reads`.
;; Nil reads every frame.
(rf/reg-event-db
::set-reads
(fn [db [_ sid reads]]
(edit/edit db #(update-in % [:symbols sid :nodes :head]
(fn [n] (if reads (assoc n :reads reads) (dissoc n :reads)))))))
(rf/reg-event-db

94
frontend/src/arthur/events/ui.cljs
View file

@ -369,30 +369,28 @@
:else #{path})))))
(rf/reg-event-db
::trace-face
;; Showing the footage under a face is a viewing aid, like solo: editor state
;; rather than the document, so it is not an undo step, does not travel to a
;; collaborator and cannot reach an export. Per FACE and not per placement — a
;; face is the same face wherever it is placed, and it is the face being traced
;; — so one switch shows it in the take and in its own tab both.
(fn [db [_ face]]
(update-in db [:ui :trace :faces]
#(if (contains? % face) (disj % face) (conj (set %) face)))))
::show-trace
;; One tracing layer on or off — `layer` is `[symbol-id node-id]`, see
;; `arthur.db/tracing`. Editor state, like solo: not an undo step, not sent to
;; a collaborator, and it cannot reach an export.
;;
;; SWITCHING ONE ON SWITCHES TRACING ON. A layer just asked for must not stay
;; invisible behind the global switch somebody forgot was off; switching one
;; off leaves the global switch alone. One event, so the inspector, a timeline
;; row and a face's section cannot disagree about it.
(fn [db [_ layer on?]]
(update-in db [:ui :tracing]
#(cond-> (update % :hidden (fnil (if on? disj conj) #{}) layer)
on? (assoc :on? true)))))
(rf/reg-event-db
::trace-faces
;; Every face the open symbol has, from the inspector's footage section:
;; switched on unless they all already are, which is the one gesture a person
;; wants when there is exactly one face and when there are five.
(fn [db [_ faces]]
(let [faces (set faces)
on (set (get-in db [:ui :trace :faces]))]
(assoc-in db [:ui :trace :faces]
(if (every? on faces) (reduce disj on faces) (into on faces))))))
::tracing-on
;; Every tracing layer at once, from the bar above the stage.
(fn [db [_ on?]] (assoc-in db [:ui :tracing :on?] (boolean on?))))
(rf/reg-event-db
::trace-opacity
(fn [db [_ opacity]] (assoc-in db [:ui :trace :opacity] opacity)))
::tracing-opacity
(fn [db [_ opacity]] (assoc-in db [:ui :tracing :opacity] opacity)))
(rf/reg-event-db
::smart-picking
@ -769,6 +767,8 @@
(nest/inside document st from path frame)]
(cond
(nil? destination) {:refused "what you are dropping into is not on screen at this frame"}
(clip/trace? (clip/symbol document destination))
{:refused "a tracing layer is a picture to draw over — nothing goes inside it"}
(not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
:else {:clip document :sid destination :at at :path path :matrix matrix})))
@ -888,6 +888,60 @@
{:extent :grow-symbol :point point
:remainder-id (random-uuid)}))))))
(defn- fitted
"Tracing placement `uuid` in symbol `sid` of `document`, sized so its picture
is as tall as `sid`'s stage, and — dropped on the timeline, with no point to
land on — middled on that stage rather than wherever the picture's own middle
happens to fall. A 1920px still is otherwise six stages tall.
A DEFAULT, set once, as the anchor is: nothing keeps it fitted afterwards."
[document sid uuid {:keys [height]} point?]
(let [[w h] (clip/stage document sid)
k (/ h height)]
(update-in document [:symbols sid :nodes uuid :channels]
(fn [chs]
(cond-> (assoc chs [:xform :scale] (ch/framed [k k]))
(not point?)
(assoc [:xform :pos]
(ch/framed (mapv - [(/ w 2) (/ h 2)]
(:value (get chs [:xform :anchor]))))))))))
(rf/reg-event-db
::drop-tracing
;; Footage or a still to draw over, as a tracing symbol — see `clip/trace?` —
;; placed by the same rule as any symbol dropped from the pool. One that shows
;; the same media already in the document is reused rather than copied: it is
;; the same picture, and a second symbol would only be a second name for it.
;;
;; A STILL ARRIVES WITH NO LENGTH, and is made as long as what is left of the
;; symbol it lands in, at that symbol's rate: it shows the same picture on every
;; frame, so its length is only how long it lasts, and trimming is how that
;; changes afterwards.
(fn [db [_ sym frame point target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
where (if point
(creation-destination db document st frame)
(drop-destination db document st frame target))]
(if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
(let [{host :sid at :at document :clip} where
same (some (fn [[id s]] (when (= (:media s) (:media sym)) id)) (:symbols document))
sid (or same (clip/free-id #(contains? (:symbols document) %) :tracing))
sym (if same
(clip/symbol document same)
(cond-> (assoc sym :id sid)
(nil? (:frames sym)) (assoc :frames (max 1 (- (clip/frames document host) at))
:fps (clip/fps document host))))
uuid (random-uuid)
result (span/place-symbol (assoc-in document [:symbols sid] sym) st host
uuid sid at
{:extent :grow-symbol
:point (destination-point where point)
:remainder-id (random-uuid)})]
(landed db where uuid
(cond-> result
(:clip result) (update :clip fitted host uuid sym (some? point)))))))))
(rf/reg-event-db
::drop-sound
;; A SOUND IS A CLIP TOO. It is placed and then adopted rather than written

8
frontend/src/arthur/flow/address.cljs
View file

@ -158,7 +158,13 @@
"head-pos" [:anchor-avg]
"head-rot" [:anchor-avg]
"head-scale" [:anchor-avg]
"eyes" [:anchor-avg :contour-avg :eye-verts :lash-weight]
;; The head's fit itself, registering the footage under it — see
;; `freeze/plate-part`. The image height it divides by is the footage's, which
;; the analysis already names.
"plate-pos" [:anchor-avg]
"plate-rot" [:anchor-avg]
"plate-scale" [:anchor-avg]
"eyes" [:anchor-avg :contour-avg :eye-verts :lash-weight]
"iris-pos" [:anchor-avg :contour-avg :gaze-gain :gaze-step]
"brows" [:anchor-avg :contour-avg :brow-verts :brow-gain :brow-step :brow-weight]
;; `brow-pos` and not `contour-avg`: the ring is smoothed and the RAISE is not.

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

@ -40,7 +40,6 @@
[arthur.domain.pick :as pick]
[arthur.domain.palette :as pal]
[arthur.domain.ring :as ring]
[arthur.domain.trace :as trace]
[arthur.flow.address :as address]))
;; ---------------------------------------------------------------------------
@ -250,37 +249,57 @@
:tx (* (- s') (+ (* c tx) (* sn ty)))
:ty (* (- s') (+ (* (- sn) tx) (* c ty)))}))
(defn head-mode
"Keep a subject's measured transform dense; optionally trace it.
(defn reads-for
"What a head with face `nodes` reads at, for trace keys `frames` and an
`origin` of `:continuous`, `:keys` or `:start` — see `domain/symbol`'s
`:reads`. At keys it holds where the face's footage holds, when it has footage
to follow; with none it holds at `frames` itself."
[nodes frames origin]
(case origin
:continuous nil
:start {:holds [0]}
:keys (if (contains? nodes :plate) {:holds-of :plate} {:holds (vec frames)})))
With no trace the head reads measured frame f at frame f (free movement).
`{:frames [12] :origin :keys}` holds the measured transform of source frame
12, `{:frames [12 42] :origin :keys}` jumps to 42's at 42, and `{:origin
:start}` holds frame 0's. See `domain/trace`. The trace selects position,
rotation and scale together, so the head and registered photo cannot drift
apart. No analysis block or authored face placement changes.
(defn head-mode
"Keep a subject's measured transform dense; optionally hold it at trace keys.
`{:frames [12 42] :origin :keys}`: the face's footage holds on frames 12 and
42 — its plate's `:time :holds` — and the head jumps to 12's measured
transform and then 42's, because it reads where the plate holds. `:start`
holds frame 0's forever, and `:continuous` reads every frame. The keys and the
origin are two facts with two owners: the plate's are which frames are drawn
over, and the head's is how it moves between them. No analysis block or
authored face placement changes.
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
frame 12 for the second face must leave the first one running, and it does,
because a trace lives on that subject's own head node and `domain/symbol`
reads it off whatever node carries it."
frame 12 for the second face must leave the first one running."
[{:keys [subject] t :trace} {:keys [clip]}]
(when (and subject (not (contains? (:subjects clip) subject)))
(throw (ex-info "head mode names a subject this clip did not track"
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
(let [t (some->> t (merge {:frames []}))]
(let [{:keys [frames origin] :as t} (merge {:frames []} (or t {:origin :continuous}))]
(reduce
(fn [c sid]
(let [frames (get-in c [:symbols sid :frames])]
(when-let [why (some-> t (trace/problems frames) first)]
(throw (ex-info (str "a head's trace is not one this take can hold: " why)
{:subject sid :trace t :frames frames})))
(update-in c [:symbols sid :nodes :head]
(fn [n]
(cond-> (assoc n :channels (:measured n))
t (assoc :trace t)
(nil? t) (dissoc :trace))))))
(let [nodes (get-in c [:symbols sid :nodes])
length (get-in c [:symbols sid :frames])
why (cond
(not (#{:continuous :keys :start} origin))
(str ":origin is " (pr-str origin) ", not :continuous, :keys or :start")
(not (and (vector? frames) (every? integer? frames)
(or (empty? frames) (apply < frames))
(every? #(< -1 % length) frames)))
(str "trace keys must be increasing frames of the face: " (pr-str frames)))
_ (when why
(throw (ex-info (str "a head's trace is not one this take can hold: " why)
{:subject sid :trace t :frames length})))
reads (reads-for nodes frames origin)]
(cond-> (update-in c [:symbols sid :nodes :head]
#(cond-> (assoc % :channels (:measured %))
reads (assoc :reads reads)
(nil? reads) (dissoc :reads)))
(contains? nodes :plate)
(assoc-in [:symbols sid :nodes :plate :time :holds] (vec frames)))))
clip (if subject [subject] (sort-by str (keys (:subjects clip)))))))
;; ---------------------------------------------------------------------------
@ -656,6 +675,53 @@
[:xform :scale] (dense scale 0 prov)}
:store (stored pos rot scale)}))
(defn plate-part
"Freeze one subject's footage registration: the anchor fit itself, which is the
inverse of the head's, with the image's pixels taken into image heights.
This is what puts a face's footage UNDER ITS HEAD and keeps it there. The plate
is a child of `:head`, so its world is `head · fit · 1/H`; on a frame where the
head and the plate read the same measured frame, `head · fit` is the identity
and the footage sits exactly where the face was filmed. On any other frame it
rides the head — held photo on a moving head, or live footage under a head
held at frame 0 — registered either way, because the fit and the photo are read
on the same held frame. Nothing in the evaluator knows it is a face.
`fit · S(1/H)` is still a similarity — the scale divides by H and nothing else
moves — so it lands on the same three decomposed channels as the head's."
[subject {:keys [analysis anchor-avg footage] :as params}
{:keys [transforms detected presence]}]
(let [h (:height footage)
absent? (when (or detected presence)
(fn [_ f] (and detected (not (nth detected f true)))))
xf (fn [role f]
(block {:role role :analysis (:id analysis) :params params
:tracks [role]}
{:type "float32" :features [subject] :absent? absent?}
{:detected detected}
[(mapv f transforms)]))
pos (xf "plate-pos" (fn [t] [(:tx t) (:ty t)]))
rot (xf "plate-rot" (fn [t] [(:theta t)]))
scale (xf "plate-scale" (fn [t] [(/ (:s t) h) (/ (:s t) h)]))
prov {:by :anchor/similarity :analysis (:id analysis)
:params {:anchor-avg anchor-avg}}]
{:measured {[:xform :pos] (dense pos 0 prov)
[:xform :rot] (dense rot 0 prov)
[:xform :scale] (dense scale 0 prov)}
:store (stored pos rot scale)}))
(defn footage-symbol
"The tracing symbol for `:footage` — `{:id :range :width :height}`, the
footage measured and which of its frames — or nil when the measurement came
from no footage: a synthetic take has nothing to show. See `clip/trace?`."
[{:keys [analysis fps footage]}]
(when-let [{:keys [id range width height]} footage]
{:id :footage :name (or (:source analysis) "footage")
:type :trace
:media {:footage id :range range}
:frames (- (second range) (first range)) :fps fps :width width :height height
:nodes {}}))
;; ---------------------------------------------------------------------------
;; the clip
@ -677,6 +743,9 @@
areas (cond-> [:mouth] (and eyes brows) (into [:eye :brow]) teeth (conj :teeth))
parts (mapv #(part subject % params inputs) areas)
head (head-part subject params inputs)
;; THE FACE'S FOOTAGE IS A PLACEMENT LIKE ANY OTHER, of the footage's
;; tracing symbol, under the head — see `plate-part`.
plate (when (:footage params) (plate-part subject params inputs))
features (cond-> {:mouth [:mouth [:mouth :mouth-in]]}
(and eyes brows)
(merge {:eye-r [:eye [:eye-r :eye-r-in :iris-r :pupil-r]]
@ -684,9 +753,14 @@
:brow-r [:brow [:brow-r]] :brow-l [:brow [:brow-l]]})
teeth (assoc :teeth [:teeth [:teeth]]))]
{:symbol {:id subject :frames (count outer)
:nodes (into {:head {:id :head :name "head" :kind :group :z "a1"
:measured (:measured head)}}
(mapcat :nodes) parts)}
:nodes (cond-> (into {:head {:id :head :name "head" :kind :group :z "a1"
:measured (:measured head)}}
(mapcat :nodes) parts)
plate (assoc :plate {:id :plate :name "footage" :kind :instance
:parent :head :z "a0"
:source {:symbol :footage}
:measured (:measured plate)
:channels (:measured plate)}))}
:features (into {} (map (fn [[role [area nodes]]]
[(own role) {:id (own role) :subject subject
:symbol subject :area area
@ -695,7 +769,7 @@
{(own :eyes) {:id (own :eyes) :kind :eye-pair :subject subject
:members [(own :eye-r) (own :eye-l)] :params {}}}
{})
:store (into (:store head) (mapcat :store) parts)}))
:store (into (merge (:store head) (:store plate)) (mapcat :store) parts)}))
(defn pivoted
"Every node a freeze makes that a hand can transform, pivoting about the
@ -751,8 +825,8 @@
[{:keys [name fps stage expose] :as params} subjects]
(when-not (and (map? subjects) (seq subjects)
(every? keyword? (keys subjects))
(not-any? #{:main :root :place} (keys subjects)))
(throw (ex-info "a freeze needs subjects with ids distinct from :main, :root and :place" {})))
(not-any? #{:main :root :place :footage} (keys subjects)))
(throw (ex-info "a freeze needs subjects with ids distinct from :main, :root, :place and :footage" {})))
(let [ordered (sort-by (comp str key) subjects)
parts (mapv (fn [[id inputs]] [id (subject-part params id inputs)]) ordered)
placement (face-placement params subjects)
@ -783,9 +857,12 @@
:z (str "a" i)
:source {:symbol id}}]))
ordered)}}
(map (fn [[id part]]
[id (assoc (place-in (:symbol part) placement) :fps fps)]))
parts)}]
(concat
(map (fn [[id part]]
[id (assoc (place-in (:symbol part) placement) :fps fps)])
parts)
(when-let [footage (footage-symbol params)]
[[:footage footage]])))}]
(doseq [[subject inputs] ordered
[id track] (:presence inputs)]
(when-not (and (= nf (count track))

35
frontend/src/arthur/flow/regenerate.cljs
View file

@ -2,7 +2,9 @@
"Recompute a changed feature from retained source tracks, then replace only
channels owned by that feature. Upload remains project/save's ordinary job."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.feature :as feature]
[arthur.domain.node :as node]
[arthur.domain.params :as params]
[arthur.flow.address :as address]
[arthur.flow.freeze :as freeze]
@ -125,17 +127,28 @@
still ARE the measurement, and are left alone once somebody has placed the head
by hand."
[entry params base subject]
(let [baked (freeze/head-part subject params @base)
at [:clip :symbols subject :nodes :head]
old (get-in entry at)
measured (:measured baked)]
(cond-> (-> entry
(assoc-in (conj at :measured) measured)
(update :store merge (:store baked)))
(= (bases (:channels old)) (bases (:measured old)))
(assoc-in (conj at :channels)
(into {} (map (fn [[p c]] [p (rebased (get-in old [:channels p]) c)]))
measured)))))
;; The face's footage is registered by the same fit, inverted, so it is
;; re-frozen with the head whenever the face has one — see `freeze/plate-part`.
(let [plate (get-in entry [:clip :symbols subject :nodes :plate])
footage (some->> plate node/source (clip/symbol (:clip entry)))
params (cond-> params
plate (assoc :footage {:height (:height footage)}))]
(reduce
(fn [entry [id bake]]
(let [baked (bake subject params @base)
at [:clip :symbols subject :nodes id]
old (get-in entry at)
measured (:measured baked)]
(cond-> (-> entry
(assoc-in (conj at :measured) measured)
(update :store merge (:store baked)))
(= (bases (:channels old)) (bases (:measured old)))
(assoc-in (conj at :channels)
(into {} (map (fn [[p c]] [p (rebased (get-in old [:channels p]) c)]))
measured)))))
entry
(cond-> [[:head freeze/head-part]]
plate (conj [:plate freeze/plate-part])))))
(defn change
"One scoped static edit. `source-inputs` holds dense landmarks and, when the

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

@ -134,5 +134,12 @@
;; `flow/address`: a model upgrade that silently reused
;; these landmarks is the failure this prevents.
:analysis (analysis-for (assoc manifest :width w :height h)
detector)})]
detector)
;; What the faces are traced over: these frames of this
;; footage, at the pixel size its stills are. See
;; `freeze/footage-symbol`.
:footage {:id (:id manifest)
:range (or (:range manifest) [0 (:frames manifest)])
:width (or (:width manifest) w)
:height (or (:height manifest) h)}})]
(build params subjects)))

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

@ -13,7 +13,6 @@
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.footage.store :as footage]
[arthur.subs.playback :as playback]
[re-frame.core :as rf]))
@ -25,7 +24,7 @@
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
(rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture])))
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
(rf/reg-sub ::tracing (fn [db _] (get-in db [:ui :trace])))
(rf/reg-sub ::tracing (fn [db _] (get-in db [:ui :tracing])))
;; The faces with smart frame picking on, as a PREVIEW switch. The setting
;; docs/frame-selection.md specifies is the document's and is not built; this is
;; the editor's own, so it moves what the stage shows and not what exports.
@ -170,7 +169,9 @@
:<- [::smart]
(fn [[document sid store palette smart] _]
(when (and document (clip/symbol document sid))
(clip/resolver document sid store palette {:snap smart}))))
;; The only resolver that asks for tracing layers: the stage shows them and
;; nothing else may. See `clip/trace-op`.
(clip/resolver document sid store palette {:snap smart :tracing? true}))))
(rf/reg-sub
::shown
@ -204,25 +205,3 @@
clip/IActivePalette
(active-palette [_] (clip/active-palette resolve)))))))
(rf/reg-sub
::underlay
:<- [::clip-id]
:<- [::clip]
:<- [::store]
:<- [::open]
:<- [::solo]
:<- [::tracing]
(fn [[id document store open solo {:keys [faces opacity]}] _]
;; What `ui/underlay` needs to paint the footage of 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
:opacity (or opacity trace/opacity-default)
:traces (cond->> (when document (trace/shown document open faces))
(seq solo) (filterv (fn [{:keys [path]}]
;; The open symbol's own face is at the
;; empty path: it is not under any row, so
;; soloing a row cannot hide it.
(or (empty? path)
(some #(= % (take (count %) path)) solo)))))})))

17
frontend/src/arthur/subs/ui.cljs
View file

@ -68,6 +68,18 @@
(let [{clip :clip st :store} (store/entry clip-id)]
(nest/inside clip st open (or path [id]) f)))))
(rf/reg-sub
::own-time
:<- [::render/clip-id]
:<- [::render/open]
:<- [::render/open-frame]
(fn [[clip-id open f] [_ path]]
;; Row `path`'s own clock from the open symbol — `nest/own-time` — and the
;; frame of it the playhead is over.
(let [{clip :clip st :store} (store/entry clip-id)]
(when-let [t (and clip (seq path) (nest/own-time clip st open (vec path) f))]
{:time t :frame (js/Math.floor (* (:rate t) (- f (:at t))))}))))
(rf/reg-sub
::creation-target
:<- [::selection]
@ -172,7 +184,10 @@
[_ n] (:nodes sym)
:let [f (get-in n [:source :footage])]
:when f]
f))]
f))
;; And what a tracing layer shows.
used (into used (keep #(get-in % [:media :footage]))
(vals (get-in entry [:clip :symbols])))]
(filterv #(contains? used (:id %)) available))))
(rf/reg-sub

4
frontend/src/arthur/ui/convert.cljs
View file

@ -85,6 +85,10 @@
[:div.convert-actions
[:button {:disabled loading?
:on-click #(rf/dispatch [::footage/convert-cancel])} "cancel"]
[:button {:disabled (or loading? (< n 1) (empty? name))
:title "draw over these frames · nothing is detected, and it is never exported"
:on-click #(rf/dispatch [::footage/convert-tracing])}
"tracing layer"]
[:button.on {:disabled (or loading? (< n 1) (empty? name))
:on-click #(rf/dispatch [::footage/convert])}
(if loading? "working…" "make symbol")]]]]))))

4
frontend/src/arthur/ui/drag.cljs
View file

@ -52,7 +52,7 @@
out of the pool, and not one that would make a cycle."
[]
(let [c @carrying]
(and c (#{:symbol :footage :import :sound} (:kind c)) (not (:refused? c)))))
(and c (#{:symbol :footage :import :sound :tracing} (:kind c)) (not (:refused? c)))))
(defn row!
"Start carrying the timeline row at `path` — a node of kind `node-kind`, to be
@ -118,5 +118,7 @@
:import (rf/dispatch [::project/import c frame point target])
;; Where it is dropped in time; a sound has no place in space.
:sound (rf/dispatch [::ui/drop-sound c frame target])
;; A still to trace over, made into a tracing symbol where it lands.
:tracing (rf/dispatch [::ui/drop-tracing (:symbol c) frame point target])
nil))
(done!)))

13
frontend/src/arthur/ui/palette.cljs
View file

@ -71,6 +71,19 @@
(when (> (count selections) 1)
[:span.dim (str (count selections) " selected")])
[:span {:style {:flex 1}}]
;; Every tracing layer at once: the reference on or off, and how strongly
;; it draws. A property of looking at the stage, like the zoom beside it.
(let [{:keys [on? opacity]} @(rf/subscribe [::render/tracing])]
[:<>
[:button {:class (when on? "on")
:title "show tracing layers over the picture · never exported"
:on-click #(rf/dispatch [::ui/tracing-on (not on?)])}
"tracing"]
[:input.trace-opacity
{:type "range" :min 0 :max 1 :step 0.05 :value opacity :disabled (not on?)
:title "how strongly tracing layers draw"
:style {:flex "0 0 64px"}
:on-change #(rf/dispatch [::ui/tracing-opacity (js/parseFloat (.. % -target -value))])}]])
(if (= :polygon tool)
[:<>
[:span.dim (str (quot (count draft) 2) " points")]

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

@ -15,7 +15,6 @@
[arthur.domain.params :as params]
[arthur.domain.pose :as pose]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.events.history :as history]
[arthur.events.paint :as paint-events]
[arthur.events.playback :as pb]
@ -468,91 +467,71 @@
(str/join " " (map name channel)) " · " why)]))])])))))
;; ---------------------------------------------------------------------------
;; the footage showing under the picture
;; tracing layers
;;
;; A tracing layer is a placement of a tracing symbol, and a face's footage is
;; one of them — its `:plate`, under its head — so one section serves both:
;; whether it is showing, and which of its frames it holds on. Showing is the
;; editor's (`arthur.db/tracing`); the holds are the document's, on the
;; placement's own `:time`. A face adds one fact of its own below them: whether
;; its head follows those holds.
(defn- footage-section
"The footage under the explicitly selected face or footage asset, on or off
and how strongly. `here` is exactly those faces.
(defn- layer-section
"Tracing layer `id` of symbol `sid`, at row `path` from the open symbol, under
`title`, with `more` appended."
[title sid id path & more]
(let [n (get-in @(rf/subscribe [::render/clip]) [:symbols sid :nodes id])
{:keys [on? hidden]} @(rf/subscribe [::render/tracing])
shown? (and on? (not (contains? hidden [sid id])))
{:keys [frame time]} @(rf/subscribe [::sub/own-time path])
holds (get-in n [:time :holds] [])
seek! #(rf/dispatch [::pb/seek (js/Math.round (+ (:at time) (/ % (:rate time))))])]
(into
[section title
[:div.row
[:label.dim {:title "show it over the picture · a reference, never exported"}
[:input {:type "checkbox" :checked (boolean shown?)
:on-change #(rf/dispatch [::ui/show-trace [sid id] (not shown?)])}]
" show"]]
[:div.row {:style {:margin "5px 0"}}
;; A DEAD BUTTON WITH NO REASON GIVEN is what reads as the feature not
;; working, so say why there is nothing to hold.
(if (nil? frame)
[:span.dim "move the playhead over this layer to hold a frame"]
[:button {:title "hold the picture on this frame until the next hold"
:on-click #(rf/dispatch [::project/toggle-hold sid id frame])}
(if (some #{frame} holds) (str "remove hold at " frame) (str "hold at " frame))])]
(when (seq holds)
[:div.row
[:span.dim "holds"]
(doall
(for [f holds]
^{:key f}
[:button {:class (when (= frame f) "on")
:disabled (nil? time)
:on-click #(seek! f)}
(str f)]))])]
more)))
ONE SWITCH FOR THE FACES THAT ARE HERE. A face's footage is the face's, not a
placement's, so there is nothing to inherit and nothing to set twice; with
several faces in a take the box says how many are showing and switches the rest
on, and one face alone is switched from its own timeline row.
(def ^:private origins
"How a face's head moves between its footage's holds, as the head's `:reads`."
[["continuous" nil "the head reads the frame it is on"]
["at holds" {:holds-of :plate} "the head jumps to each hold and stays there"]
["start" {:holds [0]} "the head holds frame 0 forever"]])
This is editor state, but the inspector still obeys selection scope: selecting
an unrelated shape must neither expose nor mutate a face's viewing aid."
[here]
(let [{:keys [faces opacity]} @(rf/subscribe [::render/tracing])
on (filterv (set faces) here)]
[section "footage"
[:div.row
[:label.dim {:title (str "show the footage these faces were traced from, over the "
"picture \u00b7 a reference, never exported")}
[:input {:type "checkbox" :checked (= (count on) (count here))
:on-change #(rf/dispatch [::ui/trace-faces here])}]
(str " show" (when (< 1 (count here)) (str " " (count on) "/" (count here))))]]
(defn- face-section
"Face `face`'s footage, at row `path` from the open symbol: its plate as a
tracing layer, and how its head follows the plate's holds."
[face path]
(let [reads (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head :reads])]
[layer-section (str "tracing · " (name face)) face :plate (conj path :plate)
[:div.row {:style {:margin-top "5px"}}
[:span.dim "opacity"]
[:input.trace-opacity
{:type "range" :min 0 :max 1 :step 0.05 :title "how strongly the footage draws"
:value (or opacity trace/opacity-default) :disabled (empty? on)
:on-change #(rf/dispatch [::ui/trace-opacity (js/parseFloat (.. % -target -value))])}]]]))
;; ---------------------------------------------------------------------------
;; tracing a face
;;
;; THE FACE'S OWN FACTS ONLY, and both of them are keyed to the face rather than
;; to an instance of it: which of its frames its drawings were made over, and
;; what its origin does between those frames. See `domain/trace`.
;;
;; `performance-section` below it is the face's too, for a third reason of the
;; same kind: the closure cuts the preserve-snap reads are stored on the face's
;; own nodes, so every placement of one face has the same marks, and a
;; per-placement switch would be a setting with nothing in it.
;;
;; Whether the footage is SHOWING is `footage-section` above, and not part of this
;; section. It is a viewing aid rather than a fact about a face, and it must not
;; come and go with the selection — so it is keyed to the OPEN symbol's faces,
;; which is a different question from the one this section answers.
(defn- trace-keys
"The face's trace keys and origin. `frame` is the frame of the FACE that the
playhead is over, and `seek!` goes to one of its frames — both of which depend
on whether the face is open in its own tab or placed in what is."
[face frame seek!]
(let [t (trace/of (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head]))
put #(rf/dispatch [::project/set-trace face %])
key? (boolean (some #{frame} (:frames t)))]
[:<>
[:div.row {:style {:margin "5px 0"}}
;; A DEAD BUTTON WITH NO REASON GIVEN is what reads as the feature not
;; working. There is no frame of this face under the playhead, so say that
;; rather than greying out the one control in the section.
(if (nil? frame)
[:span.dim "move the playhead over this face to key it"]
[:button {:on-click #(put (trace/toggle-frame t frame))}
(if key? (str "remove trace key at " frame) (str "trace key at " frame))])]
(when (seq (:frames t))
[:div.row
[:span.dim "keys"]
(doall
(for [f (:frames t)]
^{:key f}
[:button {:class (when (= frame f) "on")
:disabled (nil? seek!)
:on-click #(seek! f)}
(str f)]))])
[:div.row {:style {:margin-top "5px"}}
[:span.dim "origin"]
[:span.dim "head"]
(doall
(for [[o label] (map vector trace/origins ["continuous" "at keys" "start"])]
^{:key o}
[:button {:class (when (= o (:origin t)) "on")
:title (case o
:continuous "the head reads the frame it is on"
:keys "the head jumps to each trace key and holds it"
:start "the head holds frame 0 forever")
:on-click #(put (assoc t :origin o))}
(for [[label r title] origins]
^{:key label}
[:button {:class (when (= r reads) "on") :title title
:on-click #(rf/dispatch [::project/set-reads face r])}
label]))]]))
(defn- performance-section
@ -601,32 +580,6 @@
[:div.row
[:span.dim "the stage only \u00b7 an export is unaffected until this is a saved setting"]]]))
(defn- tracing-section
"`face` is the face these facts belong to, `faces` the faces placed inside it
to offer as somewhere to go next, and `path` the row path `faces` are under."
[face faces path]
(let [clip @(rf/subscribe [::render/clip])
own? (= face @(rf/subscribe [::render/open]))
;; The face's OWN frame, which is the playhead itself when the face is
;; the open symbol, and the selected placement's local frame when it is
;; placed in it. `time` maps the open symbol's frames to that
;; placement's, so seeking to one of the face's frames is a conversion.
{:keys [frame time]} (when-not own? @(rf/subscribe [::sub/selected-local]))
frame (if own? @(rf/subscribe [::playback/frame]) frame)
seek! (cond own? #(rf/dispatch [::pb/seek %])
time #(rf/dispatch [::pb/seek (js/Math.round
(+ (:at time) (/ % (:rate time))))]))]
[section (str "tracing · " (name face))
(when (trace/traceable? clip face) [trace-keys face frame seek!])
(when (seq faces)
[:div.row {:style {:margin-top "5px"}}
[:span.dim "faces"]
(doall
(for [{p :path in :in f :face} faces]
^{:key (str p)}
[:button {:on-click #(rf/dispatch [::ui/select [:node in (peek p) (into path p)]])}
(name f)]))])]))
;; ---------------------------------------------------------------------------
;; a symbol
@ -701,6 +654,11 @@
:group (get-in clip [:groups id :subject])
nil))
(defn- face?
"Is symbol `sid` a face: does it have a measured head?"
[clip sid]
(boolean (seq (get-in clip [:symbols sid :nodes :head :measured]))))
(defn- face-selection
"The one face explicitly named by a face symbol, its placement, or a tracking
owner. A shape merely living inside an open face is deliberately not one."
@ -711,7 +669,7 @@
(= :symbol kind) id
(#{:subject :feature :group} kind) (subject-of-owner clip selection)
(= :node kind) placed)]
(when (and candidate (trace/traceable? clip candidate)) candidate)))
(when (and candidate (face? clip candidate)) candidate)))
(defn- footage-faces [clip selection selected-node]
(if (= :footage (first selection))
@ -812,12 +770,11 @@
(get-in clip [:symbols (first node) :type])))
palette-symbol? (and (= :symbol (first selection))
(= :palette (get-in clip [:symbols (second selection) :type])))
face (or placed (when (trace/traceable? clip open) open))
faces (when face (trace/faces clip face))
;; Where that face sits, as a row path from the open symbol, so the faces
;; inside it can be selected by their own rows. A selection made on the
;; stage has no path and names a node directly in the open symbol; the
;; open symbol itself is at no path at all.
face (or placed (when (face? clip open) open))
layer? (and placed (clip-domain/trace? (clip-domain/symbol clip placed)))
;; Where that face or layer sits, as a row path from the open symbol. A
;; selection made on the stage has no path and names a node directly in
;; the open symbol; the open symbol itself is at no path at all.
path (if placed (or (nth selection 3 nil) [(second node)]) [])]
[:section.pane.params
[:div.pane-head "inspector"]
@ -829,11 +786,12 @@
(when (and placed (not palette-placement?)) [symbol-section placed "source symbol"])
(when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))}
[correction-section node])
(when (and (not palette-placement?) (seq footage-faces))
[footage-section footage-faces])
(when (and face (or (trace/traceable? clip face) (seq faces)))
[tracing-section face faces path])
(when face ^{:key (str "perf/" face)} [performance-section face])
(when layer?
[layer-section (str "tracing · " (clip-domain/symbol-name clip placed))
(first node) (second node) path])
(when (get-in clip [:symbols face :nodes :plate])
[face-section face path])
(when (and face (not layer?)) ^{:key (str "perf/" face)} [performance-section face])
(when palette-symbol? [palette-symbol-section (second selection)])
(when (and (= :symbol (first selection)) (not palette-symbol?))
[symbol-section (second selection)])

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

@ -27,7 +27,7 @@
[arthur.subs.playback :as sub]
[arthur.subs.render :as render]
[arthur.ui.canvas :as canvas]
[arthur.ui.underlay :as underlay]
[arthur.ui.tracing :as tracing]
[re-frame.core :as rf]
[reagent.ratom :as ratom]))
@ -103,9 +103,9 @@
(some-> @tracker ratom/dispose!)
(reset! tracker
(ratom/run!
(let [{was :resolver was-u :underlay} @snapshot
(let [{was :resolver was-t :tracing} @snapshot
now @(rf/subscribe [::render/shown])
u @(rf/subscribe [::render/underlay])]
t @(rf/subscribe [::render/tracing])]
(reset! snapshot
{:resolver now
:palette @(rf/subscribe [::render/palette])
@ -114,22 +114,17 @@
:frames @(rf/subscribe [::render/frames])
:width @(rf/subscribe [::sub/width])
:height @(rf/subscribe [::sub/height])
:underlay u
:tracing t
:frame @(rf/subscribe [::sub/frame])
:playing? @(rf/subscribe [::sub/playing?])})
;; A new resolver means a new scene or a new palette, and neither
;; moves the playhead — so nothing else would ask for a redraw.
;;
;; Switching a face's footage on wants the same redraw for the same
;; Switching tracing on or off wants the same redraw for the same
;; reason, and it needs asking for SEPARATELY: it is a viewing aid
;; in the editor's own state, so it changes what the canvases should
;; show without touching the frame number OR the resolver. The
;; document and the store are left out of the comparison because
;; they are what a new resolver already means.
;; Comparing the whole map is as cheap as picking fields out of it:
;; the document and the store it carries are the same OBJECTS unless
;; the resolver changed too, and that is tested first.
(when-not (and (identical? was now) (= was-u u))
;; show without touching the frame number OR the resolver.
(when-not (and (identical? was now) (= was-t t))
(repaint!))))))
(defn set-canvas! [el]
@ -163,7 +158,7 @@
rasterised before the next frame is asked for."
[f]
(let [{:keys [canvas]} @state
{:keys [resolver palette ramp width height underlay playing?]} @snapshot]
{:keys [resolver palette ramp width height tracing playing?]} @snapshot]
(when (and canvas resolver width height)
;; 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
@ -173,17 +168,20 @@
;; independent of the footage, so the size the frame is rasterised at comes
;; out of the document like everything else.
(let [ras (raster-for width height)
ops (resolver f)
{traces true picture false} (group-by #(= :trace (:kind %)) (resolver f))
;; A layer switched off, or all of them, is not on the stage at all:
;; not painted and not there to be clicked.
traces (when (:on? tracing)
(into [] (remove #(contains? (:hidden tracing) (:layer %))) traces))
active (clip/active-palette resolver)
bg (pal/background-index palette active)]
(swap! state assoc :ops ops)
(swap! state assoc :ops (into (vec picture) traces))
(-> ras
(raster/clear! bg)
(raster/draw-ops! ops))
(raster/draw-ops! picture))
(js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras (pal/effective-ramp palette active))
(underlay/paint! (assoc underlay :width width :playing? playing?)
resolver repaint!))
(tracing/paint! traces (assoc tracing :width width :playing? playing?) repaint!))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start")
;; User Timing entries otherwise accumulate forever in the browser's

89
frontend/src/arthur/ui/pool.cljs
View file

@ -56,6 +56,7 @@
[arthur.subs.ui :as sub]
[arthur.ui.canvas :as canvas]
[arthur.ui.drag :as drag]
[arthur.ui.tracing :as tracing]
[clojure.string :as str]
[re-frame.core :as rf]
[reagent.core :as r]))
@ -141,6 +142,13 @@
:style {:width 32 :height 20 :max-width 32 :max-height 20}}]
[:span.thumb]))
(defn- tracing-thumb
"The first source frame, using the stage's media URL cache."
[media]
(r/with-let [ready (r/atom 0)]
@ready
[picture (tracing/url-of media 0 #(swap! ready inc))]))
;; ---------------------------------------------------------------------------
;; the row
@ -254,8 +262,12 @@
:title (str label " · " (:frames sym) " frames · " nodes
(if (= 1 nodes) " node" " nodes")
(when (= sid open) " · open")
" — double-click to open, drag to place")
:thumb [picture (symbol-thumb document sid store palette ramp)]
(if (= :trace (:type sym))
" — drag to place"
" — double-click to open, drag to place"))
:thumb (if (= :trace (:type sym))
[tracing-thumb (:media sym)]
[picture (symbol-thumb document sid store palette ramp)])
:sub2 (str (:frames sym) "f · " nodes (if (= 1 nodes) " node" " nodes"))
:on? (= selection [:symbol sid])
:open? (= sid open)
@ -287,7 +299,7 @@
(rf/dispatch [::project/rename-symbol sid value])))
:on-click #(rf/dispatch [::ui/select [:symbol sid]])}]))
(defn- footage-row [{:keys [id label frames fps video] :as f} chosen rename]
(defn- footage-row [{:keys [id label frames fps video width height] :as f} chosen rename]
^{:key id}
[row (merge {:label label
:sub (str frames "f")
@ -304,7 +316,8 @@
:on-click #(rf/dispatch [::footage/choose id])}
(carrying (str "footage:" id)
#(drag/other! {:kind :footage :id id :label label
:frames frames :fps fps :video video})))])
:frames frames :fps fps :video video
:width width :height height})))])
(defn- sound-row
"An uploaded sound, or with `:footage?` a video's own — which is how a take's
@ -335,6 +348,30 @@
#(drag/other! {:kind :sound :source source :label label
:length length :rate rate :frames frames})))]))
(defn- image-row
"An uploaded still, to be traced over: dropped, it becomes a tracing layer —
see `events/ui ::drop-tracing`."
[{:keys [id label width height digest url]} rename]
^{:key id}
[row (merge {:label label
:sub (str width "×" height)
:title (str label " · " width "×" height
" — drag onto the stage or the timeline to trace over it")
:thumb [:img.thumb {:src url :alt ""
:style {:width 32 :height 20 :object-fit "cover"}}]
:rename (assoc rename
:key [:image id]
:value label
:commit! (fn [value]
((:begin! rename) nil)
(rf/dispatch [::footage/relabel :image id value])))}
(carrying (str "image:" id)
#(drag/other! {:kind :tracing :label label :frames 1
:center [(/ width 2) (/ height 2)]
:symbol {:name label :type :trace
:media {:image digest}
:width width :height height :nodes {}}})))])
(defn- import-row [{:keys [cid symbol name frames]} pid]
^{:key (str cid symbol)}
[row (merge {:label name
@ -400,7 +437,7 @@
Still not `:main` being special. The document says which symbol that is by its
structure; rename it, place it inside something else, and the pool follows."
[{:keys [document query searching? media sounds chosen rename main palette-choice selection] :as ctx}]
[{:keys [document query searching? media sounds images chosen rename main palette-choice selection] :as ctx}]
(let [named? #(hit? query (clip/symbol-name document %))
top (when (and main (named? main)) main)
symbol-ids (sort-by str (keys (:symbols document)))
@ -417,10 +454,10 @@
symbol-ids)
media (filterv #(hit? query (:label %)) media)
sounds (filterv #(hit? query (:label %)) sounds)
]
images (filterv #(hit? query (:label %)) images)]
[sections searching?
(+ (if top 1 0) (count rest) (count transitions)
(count media) (count sounds))
(count media) (count sounds) (count images))
[{:title "project" :searching? searching?
:blank "nothing to open yet"
:rows (when top [(symbol-row document top ctx)])}
@ -435,28 +472,35 @@
:rows (mapv #(footage-row % chosen rename) media)}
{:title "sounds" :searching? searching?
:blank "drop an mp3 or wav here"
:rows (mapv #(sound-row % (:fps document) rename) sounds)}]]))
:rows (mapv #(sound-row % (:fps document) rename) sounds)}
{:title "images" :searching? searching?
:blank "drop a png or jpeg here to trace over"
:rows (mapv #(image-row % rename) images)}]]))
(defn- all-assets
"Everything the server holds. Other projects' symbols stay grouped by project
and closed: a server holds many, and a wall of every symbol in every one buries
the one you want."
[{:keys [document query searching? rename chosen available all-sounds symbols palettes
project-id]}]
[{:keys [document query searching? rename chosen available all-sounds all-images symbols
palettes project-id]}]
(let [media (filterv #(hit? query (:label %)) available)
sounds (filterv #(hit? query (:label %)) all-sounds)
images (filterv #(hit? query (:label %)) all-images)
others (filterv #(and (not= project-id (:project %)) (hit? query (:name %)))
symbols)
grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others))
palettes (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) palettes)]
[sections searching?
(+ (count media) (count sounds) (count others) (count palettes))
(+ (count media) (count sounds) (count images) (count others) (count palettes))
[{:title "media" :searching? searching?
:blank "nothing uploaded yet"
:rows (mapv #(footage-row % chosen rename) media)}
{:title "sounds" :searching? searching?
:blank "no sounds uploaded yet"
:rows (mapv #(sound-row % (:fps document) rename) sounds)}
{:title "images" :searching? searching?
:blank "no images uploaded yet"
:rows (mapv #(image-row % rename) images)}
{:title "palettes" :searching? searching?
:blank "no palettes in other saved projects"
:rows (mapv import-palette-row palettes)}
@ -481,14 +525,17 @@
one cost of collapsing two folders into two tabs — that a hit could be behind
the tab you did not pick — is paid off by a number, counted over the same
labels the rows are filtered by."
[{:keys [document query media sounds available all-sounds symbols palettes project-id]}]
[{:keys [document query media sounds images available all-sounds all-images symbols
palettes project-id]}]
(let [n (fn [labels] (count (filter #(hit? query %) labels)))]
{:project (+ (n (map #(clip/symbol-name document %) (keys (:symbols document))))
(n (map :name (vals (pal/palettes document))))
(n (map :label media))
(n (map :label sounds)))
(n (map :label sounds))
(n (map :label images)))
:assets (+ (n (map :label available))
(n (map :label all-sounds))
(n (map :label all-images))
(n (map :name (remove #(= project-id (:project %)) palettes)))
(n (map :name (remove #(= project-id (:project %)) symbols))))}))
@ -504,7 +551,8 @@
;; than a flag per row: exactly one name is ever being edited, and
;; opening a second input has to close the first.
editing (r/atom nil)]
(let [{:keys [loading? status available sounds chosen]} @(rf/subscribe [::playback/footage])
(let [{:keys [loading? status available sounds images uploaded chosen]}
@(rf/subscribe [::playback/footage])
document @(rf/subscribe [::sub/settled-clip])
clip-id @(rf/subscribe [::render/clip-id])
store @(rf/subscribe [::render/store])
@ -522,12 +570,19 @@
:duration (/ frames fps)})
media)
@(rf/subscribe [::sub/project-sounds]))
;; The stills this document traces over, and those uploaded while it
;; was open — as `::sub/project-sounds` decides for sounds.
traced (into #{} (keep #(get-in % [:media :image])) (vals (:symbols document)))
own-images (filterv #(or (contains? traced (:digest %))
(contains? (set uploaded) (:id %)))
images)
needle (str/lower-case (str/trim @query))
searching? (boolean (seq needle))
ctx {:document document :clip-id clip-id :store store :palette palette
:ramp ramp :selection selection :open open
:media media :sounds own-sounds :chosen chosen
:media media :sounds own-sounds :images own-images :chosen chosen
:available (vec available) :all-sounds (vec sounds)
:all-images (vec images)
:symbols symbols :palettes palettes :project-id project-id
:palette-choice palette-choice
:query needle :searching? searching?
@ -553,11 +608,11 @@
[:div.pane-head
"media pool"
[:span.spacer]
[:button {:title "add a video or a sound"
[:button {:title "add a video, a sound or an image"
:disabled loading?
:on-click #(.click (js/document.getElementById "pool-file"))}
"+"]]
[:input {:id "pool-file" :type "file" :accept "video/*,audio/*"
[:input {:id "pool-file" :type "file" :accept "video/*,audio/*,image/*"
:style {:display "none"}
:on-change (fn [^js event]
(when-let [file (aget (.. event -target -files) 0)]

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

@ -25,7 +25,7 @@
[arthur.ui.drag :as drag]
[arthur.ui.layout :as layout]
[arthur.ui.player :as player]
[arthur.ui.underlay :as underlay]
[arthur.ui.tracing :as tracing]
[re-frame.core :as rf]
[reagent.core :as r]))
@ -501,8 +501,8 @@
:width w :height h
:style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}]
[:canvas.underlay {:ref #(underlay/set-canvas! %)
:width (* zoom w) :height (* zoom h)}]
[:canvas.tracing {:ref #(tracing/set-canvas! %)
:width (* zoom w) :height (* zoom h)}]
[overlay w h zoom]]
(when destination-name
[:div.stage-target "creating in " [:strong destination-name]])]))

45
frontend/src/arthur/ui/timeline.cljs
View file

@ -26,7 +26,6 @@
[arthur.domain.nest :as nest]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.events.playback :as pb]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
@ -720,17 +719,22 @@
{:title "rename lane"
:on-click (fn [^js e] (.stopPropagation e) (begin-rename!))}
"✎"])
;; A face's row is where its own footage is switched on, next to solo
;; because the two are the same kind of thing: what this row shows, here,
;; now, and nothing the picture keeps. The inspector's footage section does
;; all of them at once; this is how one face out of a take is singled out.
(when (contains? (:faces tracing) of)
[:button {:class (str "tl-trace" (when (contains? (:on tracing) of) " on"))
:title "show the footage this face was traced from"
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/trace-face of]))}
"T"])
;; A tracing layer's row switches it on and off, next to solo because the
;; two are the same kind of thing: what this row shows, here, now, and
;; nothing the picture keeps. A face's row switches its footage — its
;; plate — which is the same switch wherever the face is placed.
(when-let [layer (cond (contains? (:traces tracing) of) [(second select) (nth select 2)]
(contains? (:plated tracing) of) [of :plate])]
(let [{:keys [on? hidden]} (:state tracing)
shown? (and on? (not (contains? hidden layer)))]
[:button {:class (str "tl-trace" (when shown? " on"))
:title (if (contains? (:traces tracing) of)
"show this tracing layer · never exported"
"show the footage this face was traced from")
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/show-trace layer (not shown?)]))}
"T"]))
(when (= :instance node-kind)
[:button {:class (str "tl-solo" (when (contains? solo path) " on"))
:title "show only this on the stage (⇧ for more than one)"
@ -965,6 +969,7 @@
;; mapping to edit through, so the bar selects and does not slide.
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
(when (= :audio node-kind) " sound")
(when (= :trace (get-in clip [:symbols of :type])) " trace")
(when unmapped? " unmapped")
(when (and select (not unmapped?)) " movable")
(when (and select (contains? selected-set select)) " on")
@ -1015,6 +1020,9 @@
;; unexplained. It wears the pick colour rather than the accent every
;; span and drop already uses — see `--pick` in app.css.
:class (str (when ghost? "ghost")
;; A reference, not the picture: drawn so it cannot be
;; mistaken for a drawing that will be exported.
(when (= :trace (get-in clip [:symbols source :type])) " trace")
(when (and select (contains? selected-set select)) " on")
(when (and select (= select selection)) " primary")
(when (= (nth select 3 nil) target-path) " target")
@ -1135,11 +1143,14 @@
drop @(rf/subscribe [::sub/drop])
solo (set @(rf/subscribe [::render/solo]))
open @(rf/subscribe [::render/open])
;; Which rows offer a footage switch, and which of them are switched
;; on. A set rather than a lookup per row: the answer is the same for
;; every placement of a face, because the switch is the face's.
tracing {:faces (set (trace/traceable-faces clip open))
:on (set (:faces @(rf/subscribe [::render/tracing])))}
;; Which rows offer a tracing switch — placements of a tracing symbol,
;; and faces that have footage — and what is switched on. Sets rather
;; than a lookup per row.
tracing {:traces (into #{} (comp (filter #(= :trace (:type (val %)))) (map key))
(:symbols clip))
:plated (into #{} (comp (filter #(get-in (val %) [:nodes :plate])) (map key))
(:symbols clip))
:state @(rf/subscribe [::render/tracing])}
;; WHERE THE DROP WILL LAND IS WHERE THE PREVIEW GOES, and what is being
;; carried does not come into it. A row under the pointer takes the
;; preview as a block in that row -- the same row `ui/drop-destination`

154
frontend/src/arthur/ui/tracing.cljs Normal file
View file

@ -0,0 +1,154 @@
(ns arthur.ui.tracing
"Tracing layers — footage or a still to draw over — on their own canvas above
the stage.
A REFERENCE, NOT OUTPUT. A tracing symbol resolves to a `:trace` op, which the
raster refuses and only the stage's resolver asks for (see `clip/trace-op`), so
it cannot reach an export. It is drawn OVER the picture at one 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.
The op says where the image goes and which of its frames to show, and nothing
else: a face's footage is registered to the face because it is placed inside
it, under the head, so there is nothing about faces in here.
THREE THINGS KEEP IT STEADY, because a still is decoded asynchronously and the
frame it belongs to is already on screen by the time it arrives: the cache drops
the stills used longest ago rather than emptying itself, a layer keeps showing
the still it last showed until its next one has decoded, and the stills a little
way ahead of the playhead are asked for before they are needed. Each is a
separate cause of the same symptom — the tracing blinking out for a frame or two
— and none of them covers the others: the hold is what survives a seek, the
reading ahead is what keeps playback from being a frame behind for good."
(:require [arthur.flow.ingest :as ingest]))
(defonce ^:private state (atom {:canvas nil :urls {} :images {} :order [] :last {}}))
(defn set-canvas! [el] (swap! state assoc :canvas el))
(defn- footage-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)))
(defn url-of
"The URL of the still showing frame `frame` of `media`, or nil until it is
known. A footage symbol's frame 0 is the first frame of its range."
[{:keys [footage image range]} frame on-ready]
(cond
image (str "/blob/" image)
footage (some-> (footage-urls footage on-ready) (get (+ (first range) frame)))))
(def ^:private ^:const kept
"Decoded stills held at once. A 1280px still is about 5MB decoded, and
scrubbing footage with no holds asks for every frame of it."
48)
(def ^:private ^:const ahead
"Frames past the playhead whose stills are asked for while the current one is
drawn. A still cannot be decoded in the animation frame that wants it, so
playing footage would otherwise always be a frame or two behind itself."
8)
(defn- decoded
"`img` if the still has arrived and can be drawn."
[^js img]
(when (and (.-complete img) (pos? (.-naturalHeight img))) img))
(defn- touch!
"Hold `img` under `url` as the most recently used still, dropping the ones used
longest ago once there are more than `kept`.
LEAST RECENTLY USED, touched when it arrives and again on every frame it is
DRAWN, which is what makes it safe without a list of exceptions: the still on
screen is the newest thing in the cache and cannot be the one dropped — a still
held for a hundred frames included. Read-and-not-drawn does not touch, because
a still read only to be warmed was just inserted anyway."
[url img]
(swap! state
(fn [{:keys [images order] :as s}]
(let [images (assoc images url img)
order (conj (into [] (remove #{url}) order) url)
over (- (count order) kept)]
(if (pos? over)
(assoc s :images (apply dissoc images (subvec order 0 over))
:order (subvec order over))
(assoc s :images images :order order))))))
(defn- image
"The still at `url`, or nil until it has loaded. Asks for it the first time it
is wanted; `on-ready` paints again once it is there.
A still that fails is remembered as having failed, so a broken URL is one
console line and one request rather than one of each per animation frame."
[url on-ready]
(when url
(let [held (get-in @state [:images url])]
(cond
(= :failed held) nil
held (decoded held)
:else (let [img (js/Image.)]
(set! (.-onload img) on-ready)
(set! (.-onerror img)
(fn [_]
(swap! state assoc-in [:images url] :failed)
(js/console.error "arthur: a tracing still did not load" url)))
(set! (.-src img) url)
(touch! url img)
nil)))))
(defn- warm!
"Ask for the stills the next `ahead` frames of footage will want.
WHILE PLAYING ONLY, and only for a layer whose frame MOVED since it was last
painted. A scrub asks for a different `ahead` frames at every step, and a held
layer shows one still for as long as it is held, so reading ahead through
either would be requests for stills nobody is going to look at."
[{:keys [media frame]} on-ready]
(when (:footage media)
(doseq [p (range (inc frame) (+ frame 1 ahead))]
(image (url-of media p on-ready) on-ready))))
(defn paint!
"Draw trace ops `ops`, in draw order, at `opacity`, over a stage `width` wide.
`on-ready` is called when a still or a manifest that was missing arrives, to
paint again."
[ops {:keys [opacity width playing?]} on-ready]
(when-let [^js canvas (:canvas @state)]
(let [ctx (.getContext canvas "2d")
zoom (/ (.-width canvas) width)
was (:last @state)]
(.setTransform ctx 1 0 0 1 0 0)
(.clearRect ctx 0 0 (.-width canvas) (.-height canvas))
;; What each layer is showing, forgotten for the layers that are gone.
;; Before the draw, so switching them all off forgets all of them.
(swap! state update :last select-keys (map :node ops))
(set! (.-globalAlpha ctx) opacity)
(doseq [{:keys [node frame m] [w h] :size :as op} ops]
;; THE STILL IT HAS, not nothing. A frame whose still is still decoding
;; keeps the one before it rather than blinking off.
(let [want (url-of (:media op) frame on-ready)
[img url] (or (when-let [i (image want on-ready)] [i want])
(let [url (get-in was [node :url])]
(when-let [i (image url on-ready)] [i url])))]
(when img
(touch! url img)
(swap! state assoc-in [:last node] {:url url :frame frame})
(.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 w h))
(when (and playing? (not= frame (get-in was [node :frame])))
(warm! op on-ready)))))))

182
frontend/src/arthur/ui/underlay.cljs
View file

@ -1,182 +0,0 @@
(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 face'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`.
THREE THINGS KEEP IT STEADY, because a still is decoded asynchronously and the
frame it belongs to is already on screen by the time it arrives: the cache drops
the stills used longest ago rather than emptying itself, a face keeps showing
the still it last showed until its next one has decoded, and the stills a little
way ahead of the playhead are asked for before they are needed. Each is a
separate cause of the same symptom — the tracing blinking out for a frame or two
— and none of them covers the others: the hold is what survives a seek, the
reading ahead is what keeps playback from being a frame behind for good."
(:require [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.flow.ingest :as ingest]))
(defonce ^:private state (atom {:canvas nil :urls {} :images {} :order [] :last {}}))
(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)
(def ^:private ^:const ahead
"Frames past the playhead whose stills are asked for while the current one is
drawn. A still cannot be decoded in the animation frame that wants it, so
playing a continuously traced face would otherwise always be a frame or two
behind its own footage."
8)
(defn- decoded
"`img` if the still has arrived and can be drawn."
[^js img]
(when (and (.-complete img) (pos? (.-naturalHeight img))) img))
(defn- touch!
"Hold `img` under `url` as the most recently used still, dropping the ones used
longest ago once there are more than `kept`.
LEAST RECENTLY USED, touched when it arrives and again on every frame it is
DRAWN, which is what makes it safe without a list of exceptions: the still on
screen is the newest thing in the cache and cannot be the one dropped — a still
held at a trace key for a hundred frames included. Read-and-not-drawn does not
touch, because a still read only to be warmed was just inserted anyway, and
reordering the whole list ten times per face per frame in the draw loop is the
kind of allocation `ui/player` exists to avoid. What this replaces emptied the
cache on the frame it filled, so every still on screen had to be fetched and
decoded again: a blink every `kept` frames of a scrub, and with two faces and a
full cache a permanent one."
[url img]
(swap! state
(fn [{:keys [images order] :as s}]
(let [images (assoc images url img)
order (conj (into [] (remove #{url}) order) url)
over (- (count order) kept)]
(if (pos? over)
(assoc s :images (apply dissoc images (subvec order 0 over))
:order (subvec order over))
(assoc s :images images :order order))))))
(defn- image
"The still at `url`, or nil until it has loaded. Asks for it the first time it
is wanted; `on-ready` paints again once it is there.
A still that fails is remembered as having failed, so a broken URL is one
console line and one request rather than one of each per animation frame."
[url on-ready]
(when url
(let [held (get-in @state [:images url])]
(cond
(= :failed held) nil
held (decoded held)
:else (let [img (js/Image.)]
(set! (.-onload img) on-ready)
(set! (.-onerror img)
(fn [_]
(swap! state assoc-in [:images url] :failed)
(js/console.error "arthur: a tracing still did not load" url)))
(set! (.-src img) url)
(touch! url img)
nil)))))
(defn- still
"The URL of the still showing the face's own frame `p`. The manifest is the
whole footage's and `p` is an index into the analysed range, so the range's
start is where the face's frame 0 was filmed."
[us start p]
(get us (+ start p)))
(defn- warm!
"Ask for the stills the next `ahead` frames will want. Held trace frames
collapse to the one still, so a face traced at keys asks for almost nothing.
WHILE PLAYING ONLY, because that is the only time the next frame is the one
after this one. A scrub asks for a different `ahead` frames at every step, so
reading ahead through one would be `ahead` requests per step for stills the
pointer has already gone past — and a cache thrashed by its own guesses."
[us start t lf on-ready]
(doseq [p (distinct (map #(trace/photo-frame t %) (range (inc lf) (+ lf 1 ahead))))]
(image (still us start p) on-ready)))
(defn paint!
"Draw every switched-on face's footage 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 traces opacity width playing?]} 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))
;; What each face is showing, forgotten for the faces switched off. Before
;; the early exits, so switching them all off forgets all of them.
(swap! state update :last select-keys (map :path traces))
(when (seq traces)
(let [;; Read once: each face writes only its own entry below, and what it
;; was showing is what it falls back to.
was (:last @state)]
;; ONE OPACITY for all of them, set once: how strongly the reference
;; draws is a property of looking at the stage, not of a face.
(set! (.-globalAlpha ctx) opacity)
(doseq [{:keys [path face]} traces
:let [subject (get-in document [:subjects face])
analysis (get-in document [:analyses (:analysis subject)])
us (urls (:footage subject) on-ready)]
:when us]
(let [start (first (get analysis :range [0]))
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])
t (trace/of head)
lf (js/Math.floor frame)
want (trace/photo-frame t lf)
;; THE STILL IT HAS, not nothing. A frame whose still is
;; still decoding keeps the one before it — a reference a
;; frame stale, registered where that frame's face was,
;; rather than a face with its footage blinking off.
[img url p] (or (let [u (still us start want)]
(when-let [i (image u on-ready)] [i u want]))
(let [{:keys [url p]} (get was path)]
(when-let [i (image url on-ready)] [i url p])))
m (when img
(trace/photo-matrix world head store p (.-naturalHeight img)))]
(when m
;; Drawn, so it is the newest still in the cache and what
;; this face falls back to while its next one decodes.
(touch! url img)
(swap! state assoc-in [:last path] {:url url :p p})
(.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))
(when playing? (warm! us start t lf on-ready)))))))))))

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

@ -116,6 +116,20 @@
(is (= [0 0 0 3 3 3] (mapv #(node/expose % 3) (range 6))))
(is (= 4 (node/expose 5 2)) "frame 5 at exposure 2 reads frame 4, not 6"))
(deftest a-hold-floors-onto-authored-frames
;; Exposure on frames somebody chose rather than on a grid: the last hold at or
;; before the frame, and before the first one the first.
(is (= [0 1 2 3] (mapv #(node/hold % []) (range 4))) "no holds is no floor")
(is (= [12 12 12 12 30 30] (mapv #(node/hold % [12 30]) [0 11 12 29 30 99])))
(is (= [0 0 12 12 30] (mapv #(node/hold % [0 12 30]) [0 11 12 29 30])))
(testing "after exposure, before the lead"
(is (= 13 (node/local-frame {:time {:holds [4 12] :expose 2 :offset 1}} 13))
"13 exposes to 12, holds at 12, and the lead adds 1"))
(testing "refused unless increasing"
(is (seq (node/problems {:id :n :kind :group :z "a" :time {:holds [3 1]}})))
(is (seq (node/problems {:id :n :kind :group :z "a" :time {:holds '(1 3)}})))
(is (empty? (node/problems {:id :n :kind :group :z "a" :time {:holds [1 3]}})))))
(deftest exposure-comes-before-offset-and-the-order-is-visible
;; THE INVARIANT: flooring onto a grid and shifting against the clock do not
;; commute. Shift first and the floor discards it on most frames, so the lead

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

@ -167,6 +167,20 @@
x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest holds-are-inherited-like-exposure
(let [walk (ch/keyed (into {} (map (fn [f] [f [f 0]])) (range 12)) :hold)
s (assoc (sc {:id :g :kind :group :z "a1" :time {:holds [2 7]}
:channels {[:xform :pos] walk}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
:frames 12)
x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [2 2 2 2 2 2 2 7 7 7 7 7] (mapv x-at (range 12)))
"the group reads its held frame, before the first hold included")
(testing "and the playback path agrees"
(let [spec (ops/specified s nil) fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders 12) f fs]
(is (= (spec f) (fast f)) (str label " at frame " f)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
;; Lead applies to performance nodes and NOT to the plate. If it were a clip
;; property the mouth would drag the whole head forward with it.

139
frontend/test/arthur/domain/trace_test.cljs
View file

@ -1,139 +0,0 @@
(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.node :as node]
[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 nil)
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)))))
(defn- filmed
"Where a photo sitting exactly where it was filmed must land: the face's OWN
placement, over image height, and nothing else.
`:place` carries the source-to-stage mapping now, above `:head` — so a face
opened in its own tab draws at the size it is on the stage, and its photo has
to come with it. That is the whole reason the mapping belongs to the face: the
head still cancels out, which is what these assertions are about, but it
cancels against a placement rather than against nothing."
[c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil)]
(r f)
(vec (array-seq (node/mul! (node/mat) (symbol/world-of r :place)
(js/Float64Array. #js [0.001 0 0 0.001 0 0]))))))
(deftest the-photo-registers-to-the-face-it-was-filmed-with
(let [a (traced {:frames [] :origin :continuous})
b (traced {:frames [12] :origin :keys})
d (traced {:frames [12] :origin :continuous})]
(is (near? (filmed a 30) (photo-at a 30))
"a head showing the photo's own frame cancels out")
(is (near? (filmed b 30) (photo-at b 30))
"held at the trace frame, face and photo both stand still")
(is (not (near? (filmed d 30) (photo-at d 30)))
"a continuous head carries the held photo along with it")))
(defn- wrapped
"Face-1's take placed, moved, inside a symbol :wrap."
[]
(assoc-in @frozen [:symbols :wrap]
{:id :wrap :frames 200
:nodes {:m {:id :m :kind :instance :z "a0"
:source {:symbol :main}
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}}))
(deftest a-face-switched-on-shows-wherever-it-is-placed
(let [c (wrapped)]
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/shown c :wrap #{:face-1}))
"a face inside a take inside a symbol, at the row path it is at")
(is (= [] (trace/shown c :wrap #{})) "and nothing when it is switched off")
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/shown c :main #{:face-1}))
"the same switch, one symbol down")
(is (= [{:path [] :in :face-1 :face :face-1}] (trace/shown c :face-1 #{:face-1}))
"the face open in its own tab is at no path at all — it IS the stage")
(is (= [] (trace/shown c :wrap #{:main}))
"a symbol that is not a face has no footage of its own to show")))
(deftest the-faces-that-can-be-traced-are-listed-once-each
(is (= [:face-1] (trace/traceable-faces (wrapped) :wrap)))
(is (= [:face-1] (trace/traceable-faces @frozen :main)) "the take it was frozen into")
(is (= [:face-1] (trace/traceable-faces @frozen :face-1)) "itself, open to draw over"))
(deftest a-face-opened-to-be-drawn-over-starts-with-its-footage-showing
(let [c (wrapped)]
(is (= #{:face-1} (trace/showing-for c :face-1 #{})) "the face's own tab")
(is (= #{} (trace/showing-for c :main #{}))
"and not the take it is placed in, which is the picture itself")
(is (= #{:face-1} (trace/showing-for c :main #{:face-1}))
"one already switched on stays on wherever you go")))
(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 :wrap @store pal/index-of nil)
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")))

220
frontend/test/arthur/domain/tracing_test.cljs Normal file
View file

@ -0,0 +1,220 @@
(ns arthur.domain.tracing-test
"Tracing symbols: footage or a still to draw over, placed like any symbol and
never part of the picture — and a face's footage as one of them, under its head."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take]
[arthur.domain.clip :as clip]
[arthur.domain.creation :as creation]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.symbol :as symbol]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[arthur.flow.freeze :as freeze]
[re-frame.core :as rf]
[re-frame.db :as rf-db]))
(def ^:private image-h 1000)
(def ^:private frozen
"The synthetic take frozen as though it had come from footage 1000px tall."
(delay (freeze/clip (assoc take/params :footage {:id "f00" :range [0 take/frames]
:width 1500 :height image-h})
{:face-1 @take/measured})))
(defn- traced
"The take with face-1's trace keys and origin set."
[t]
(freeze/head-mode {:trace t} @frozen))
(defn- near? [a b]
(every? #(< (js/Math.abs %) 1e-3) (map - a b)))
(defn- resolver [c sid opts]
(clip/resolver c sid (:store @frozen) pal/index-of opts))
(defn- traces-at [r f]
(filterv #(= :trace (:kind %)) (r f)))
;; ---------------------------------------------------------------------------
;; the document
(deftest a-freeze-from-footage-makes-a-tracing-symbol-and-places-it-under-the-head
(let [c (traced nil)
plate (get-in c [:symbols :face-1 :nodes :plate])]
(is (clip/trace? (clip/symbol c :footage)))
(is (= {:footage "f00" :range [0 take/frames]} (:media (clip/symbol c :footage))))
(is (= :head (:parent plate)) "the footage rides the head")
(is (= :footage (node/source plate)))
(is (node/measured? plate) "and is registered by the measurement, not by hand")
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) "it saves and comes back")))
(deftest the-origin-writes-the-heads-reads-and-the-keys-the-plates-holds
(is (nil? (get-in (traced {:origin :continuous :frames [12]}) [:symbols :face-1 :nodes :head :reads])))
(is (= {:holds-of :plate} (get-in (traced {:origin :keys :frames [12]}) [:symbols :face-1 :nodes :head :reads])))
(is (= {:holds [0]} (get-in (traced {:origin :start}) [:symbols :face-1 :nodes :head :reads])))
(is (= [12 40] (get-in (traced {:origin :continuous :frames [12 40]})
[:symbols :face-1 :nodes :plate :time :holds]))
"the keys are the footage's whatever the head does"))
(deftest a-tracing-symbol-that-does-not-say-what-it-shows-will-not-load
(doseq [[why sym] [["nodes" {:nodes {:x {:id :x :kind :group :z "a"}}}]
["no media" {:media {}}]
["both" {:media {:footage "f" :image "i" :range [0 10]}}]
["short range" {:media {:footage "f" :range [0 9]}}]
["no size" {:width nil}]]]
(let [c (update-in (traced nil) [:symbols :footage] merge sym)]
(is (seq (clip/problems c)) why))))
(deftest reads-must-name-a-node-that-can-be-followed
(doseq [reads [{:holds-of :nowhere} {:holds-of :head} {:holds [3 1]}
{:holds [0] :holds-of :plate}]]
(is (seq (clip/problems (assoc-in (traced nil) [:symbols :face-1 :nodes :head :reads] reads)))
(pr-str reads))))
;; ---------------------------------------------------------------------------
;; registration
(defn- plate-at
"Face-1's footage op at frame `f`, its world matrix as a vector."
[c f]
(let [[op] (traces-at (resolver c :face-1 {:tracing? true}) f)]
(vec (array-seq (:m op)))))
(defn- filmed
"Where footage sitting exactly where it was filmed lands: the face's own
placement, over image height, and nothing else."
[c f]
(let [r (resolver c :face-1 nil)]
(r f)
(vec (array-seq (node/mul! (node/mat) (symbol/world-of r [:place])
(js/Float64Array. #js [(/ 1 image-h) 0 0 (/ 1 image-h) 0 0]))))))
(deftest the-footage-registers-to-the-face-it-was-filmed-with
(let [free (traced {:origin :continuous})
keyed (traced {:origin :keys :frames [12]})
ride (traced {:origin :continuous :frames [12]})
start (traced {:origin :start})]
(is (near? (filmed free 30) (plate-at free 30))
"a head reading the footage's own frame cancels out")
(is (near? (filmed keyed 30) (plate-at keyed 30))
"held at the key, face and footage both stand still where it was filmed")
(is (not (near? (filmed ride 30) (plate-at ride 30)))
"a continuous head carries the held footage along with it")
(is (= 12 (:frame (first (traces-at (resolver ride :face-1 {:tracing? true}) 30))))
"showing the held frame")
(is (not (near? (filmed start 60) (plate-at start 60)))
"footage under a head held at its start is stabilised, not where it was filmed")))
;; ---------------------------------------------------------------------------
;; never in the picture
(deftest only-the-stage-asks-for-tracing
(let [c (traced nil)]
(doseq [f [0 30 100]]
(is (empty? (traces-at (resolver c :main nil) f)) "an export, a centre, a thumbnail")
(is (= 1 (count (traces-at (resolver c :main {:tracing? true}) f))) "the stage"))))
(deftest a-trace-op-comes-up-through-every-instance-above-it
(let [c (assoc-in (traced nil) [:symbols :wrap]
{:id :wrap :frames 200
:nodes {:m {:id :m :kind :instance :z "a0" :source {:symbol :main}
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}})
inner (first (traces-at (resolver c :main {:tracing? true}) 20))
outer (first (traces-at (resolver c :wrap {:tracing? true}) 20))
moved (fn [m] (let [v (vec (array-seq m))] (-> v (update 4 + 30) (update 5 - 10))))]
(is (= [:m :face-1 :plate] (:node outer)) "named by its row path, as anything drawn is")
(is (= [:face-1 :plate] (:layer outer)) "and switched by where it is, not where it is placed")
(is (near? (moved (:m inner)) (vec (array-seq (:m outer)))))))
;; ---------------------------------------------------------------------------
;; a tracing layer placed by hand
(def ^:private still
{:id :still :name "ref" :type :trace :media {:image "abc"}
:frames 1 :fps 30 :width 400 :height 200 :nodes {}})
(defn- with-still []
(-> (clip/blank)
(assoc-in [:symbols :still] still)
(clip/place-symbol {} :main :still 0 :layer [160 100])
(update-in [:symbols :main :nodes :layer] assoc
:playback {:in 0 :speed 0 :end :hold} :span [0 120])))
(deftest a-still-is-placed-about-its-middle-and-shows-on-every-frame
(let [c (with-still)
r (clip/resolver c :main {} pal/index-of {:tracing? true})]
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))
(is (= [200 100] (clip/center c {} :still)) "a tracing symbol's middle is its pixels'")
(doseq [f [0 50 119]]
(let [[op] (traces-at r f)]
(is (= 0 (:frame op)))
(is (= [-40 0] (vec (take 2 (drop 4 (array-seq (:m op))))))
(str "its middle on the drop point, frame " f))))))
(deftest nothing-is-created-inside-a-tracing-layer
(let [c (with-still)]
(is (= :main (:sid (creation/target c {} :main [:node :main :layer [:layer]] 10)))
"selecting a tracing layer creates beside it, as selecting a shape does")
(is (= "a tracing layer is a picture to draw over — nothing goes inside it"
(:refused (ui/drop-destination-at c {} :main 10 [:node :main :layer [:layer]]))))))
(deftest a-click-picks-what-is-drawn-before-a-reference
(let [trace {:kind :trace :node :layer :size [100 100]
:m (js/Float64Array. #js [0 1 -1 0 50 0])}
shape {:kind :rect :node :dot :cx 10 :cy 10 :size 4}]
(is (= [:dot] (pick/hit [shape trace] [10 10])) "drawn wins, though the photo is on top")
(is (= [:layer] (pick/hit [shape trace] [20 50])) "a reference where nothing is drawn")
(is (nil? (pick/hit [shape trace] [60 50])) "outside the turned image is outside it")))
(deftest a-held-layer-is-keyed-on-its-own-unfloored-frames
(let [c (assoc-in (traced {:origin :keys :frames [12]}) [:symbols :face-1 :nodes :plate :time :holds] [12])
t (nest/own-time c (:store @frozen) :face-1 [:plate] 30)]
(is (= 30 (* (:rate t) (- 30 (:at t)))) "frame 30 is 30, though it shows 12")))
(deftest a-dropped-still-lasts-the-rest-of-the-symbol-fits-it-and-is-reused
(let [id (store/install! {:clip (clip/blank) :store {}} "drop-tracing")
sym {:name "sheet" :type :trace :media {:image "abc"}
:width 400 :height 800 :nodes {}}
drop! (fn []
(rf/dispatch-sync [::ui/drop-tracing sym 30 nil nil])
(let [doc (:clip (store/entry id))
[_ _ uuid] (get-in @rf-db/app-db [:ui :selection])]
[doc (get-in doc [:symbols :main :nodes uuid])]))]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 30}})
(let [[doc n] (drop!)
sid (node/source n)
[w h] (clip/stage doc :main)
k (/ h 800)]
(is (empty? (clip/problems doc)) (pr-str (clip/problems doc)))
(is (clip/trace? (clip/symbol doc sid)))
(is (= (- (clip/frames doc :main) 30) (clip/frames doc sid))
"as long as what is left of the symbol it landed in")
(is (= [30 (clip/frames doc :main)] (node/placed-span n)))
(is (= [k k] (get-in n [:channels [:xform :scale] :value])) "as tall as the stage")
(is (= [(/ w 2) (/ h 2)] (mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value])))
"dropped on the timeline, it is middled on the stage")
(let [[doc2 n2] (drop!)]
(is (= sid (node/source n2)) "the same picture is the same symbol")
(is (= 1 (count (filter clip/trace? (vals (:symbols doc2))))))))))
;; ---------------------------------------------------------------------------
;; on and off
(deftest switching-one-layer-on-switches-tracing-on
(reset! rf-db/app-db {:ui {:tracing {:on? false :opacity 0.5 :hidden #{[:face-1 :plate]}}}})
(rf/dispatch-sync [::ui/show-trace [:face-1 :plate] true])
(is (= {:on? true :opacity 0.5 :hidden #{}} (get-in @rf-db/app-db [:ui :tracing])))
(testing "and switching one off leaves the rest alone"
(rf/dispatch-sync [::ui/show-trace [:face-1 :plate] false])
(is (= {:on? true :opacity 0.5 :hidden #{[:face-1 :plate]}} (get-in @rf-db/app-db [:ui :tracing]))))
(testing "from nothing"
(reset! rf-db/app-db {:ui {:tracing {:on? true}}})
(rf/dispatch-sync [::ui/show-trace [:s :n] false])
(is (= #{[:s :n]} (get-in @rf-db/app-db [:ui :tracing :hidden])))))

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

@ -249,8 +249,9 @@
path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :dense (ch/describe (of c path))))
(is (= (of free path) (of c path)) "a trace does not copy measurements"))
(is (nil? (get-in (nodes free) [:head :trace])))
(is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace])))
(is (nil? (get-in (nodes free) [:head :reads])))
(is (= {:holds [12]} (get-in (nodes one) [:head :reads]))
"with no footage to follow, the head holds at the keys itself")
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
"the trace survives the document round trip")))

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

@ -77,7 +77,7 @@
(channel after :face-2 :iris-r [:xform :pos])))
(is (= (channel before :face-2 :iris-l [:xform :pos])
(channel after :face-2 :iris-l [:xform :pos])))
(is (= {:origin :keys :frames [12]} (get-in anchored [:symbols :face-2 :nodes :head :trace])))
(is (= {:holds [12]} (get-in anchored [:symbols :face-2 :nodes :head :reads])))
(is (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage