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

Split domain/clip along the data: clip, nest, bring

Browse source 
domain/clip is the document and what only needs the document: its symbol
table, placing, the resolver, problems. domain/nest is how nested symbols
relate — one walk down a row path gives the frame, the matrix and the time
map, which merges inside and time-down — and moving and grouping between
them, and nested sound. domain/bring is copying symbols in from another
clip, a take from footage, and one placed that merges the store and places
the instance, which conversion and import both now call instead of each
doing it in their own words. Tests follow the same split.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-29 14:11:41 -04:00
parent 7bb80d315d
commit c17ee138f2
10 changed files with 639 additions and 589 deletions
Download patch file Download diff file Expand all files Collapse all files

5
frontend/src/arthur/audio/mix.cljs
View file

@ -12,6 +12,7 @@
than the render being spelled once per consumer." than the render being spelled once per consumer."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node])) [arthur.domain.node :as node]))
(defn wav-bytes (defn wav-bytes
@ -92,9 +93,9 @@
(defn tracks-of (defn tracks-of
"The sounds symbol `sid` plays, including those inside what it places — see "The sounds symbol `sid` plays, including those inside what it places — see
`clip/audio-tracks`. Playback mixes the open symbol's." `nest/audio-tracks`. Playback mixes the open symbol's."
[document sid] [document sid]
(clip/audio-tracks document sid)) (nest/audio-tracks document sid))
(defn- render! [document sid sources store] (defn- render! [document sid sources store]
(let [fps (:fps document) (let [fps (:fps document)

98
frontend/src/arthur/domain/bring.cljs Normal file
View file

@ -0,0 +1,98 @@
(ns arthur.domain.bring
"Bringing symbols into a clip from another: out of a saved project, or out of
a freeze of new footage.
Copied, never linked. What comes in gets ids of its own where they are taken,
and editing it here does not touch where it came from. Tracking identities and
the analysis they were measured by come along only when the receiving clip can
hold them; otherwise what comes in is drawing, which plays but does not re-tune.
Plain data in and out — documents, and in `placed` a document with its store —
so the events that fetch them are only fetching."
(:refer-clojure :exclude [take])
(:require [arthur.domain.clip :as clip]
[clojure.string :as string]))
(defn symbols
"Copy symbols `roots` of clip `other`, and every symbol they place, into
`clip`. Returns `{:clip :ids}`, where `:ids` maps each copied symbol's id in
`other` to its id here.
AN ID THAT IS TAKEN IS RENAMED, never merged: two symbols that happen to share
an id are two drawings, and an instance's `:of` inside the copy is rewritten to
follow. `wanted` maps a root's id in `other` to the id it should preferably get,
which is how a symbol made from footage is called what the person typed rather
than `:main`.
Only symbols travel. What else `other` holds — tracking identities, an analysis
— is the caller's decision, because whether it can come too depends on what
`clip` already has."
[clip other roots wanted]
(let [;; A tree walk is safe because placing cannot make a cycle.
reach (into #{} (mapcat #(tree-seq any? (partial clip/places other) %)) roots)
ids (reduce (fn [ids sid]
(let [taken? #(or (contains? (:symbols clip) %)
(some #{%} (vals ids)))]
(assoc ids sid (clip/free-id taken? (get wanted sid sid)))))
{} (sort-by str reach))
copy (fn [sid]
(-> (clip/symbol other sid)
(assoc :id (ids sid))
(update :nodes #(into {} (map (fn [[id n]]
[id (cond-> n (:of n) (update :of ids))]))
%))))]
{:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach)
:ids ids}))
(defn symbol-id
"An id for a symbol a person has named: the name, lower-cased and hyphenated,
or `:symbol` when nothing of it survives."
[label]
(let [slug (-> (str label) string/lower-case
(string/replace #"[^a-z0-9]+" "-")
(string/replace #"^-+|-+$" ""))]
(keyword (if (seq slug) slug "symbol"))))
(defn take
"Put `frozen`, a take, into `clip` as ONE symbol called `label`. Returns
`{:clip :sid :tracked?}`.
`frozen` is what `flow/freeze/clip` makes: a `:main` that places one symbol per
tracked face. `:main` becomes the named symbol — it is what holds the faces in
stage pixels, so it is the thing worth placing — and it gets the take's SOUND
as an audio node of its own, source frames `range` of footage `footage-id`, so
wherever the symbol is placed it is heard.
The tracking identities, and the analysis they were measured by, come along
only when `clip` has no analysis of its own and no face had to be renamed. A
document holds one analysis, and regeneration finds a face's symbol by its
subject id, so either condition failing means the take comes in as drawings
that play but cannot be re-tuned — `:tracked? false` says so."
[clip frozen label footage-id range]
(let [{c :clip ids :ids} (symbols clip frozen [:main] {:main (symbol-id label)})
sid (ids :main)
tracked? (and (nil? (:analysis clip))
(every? #(= % (ids %)) (keys (:subjects frozen))))]
{:sid sid
:tracked? tracked?
:clip (cond-> (-> c
(assoc-in [:symbols sid :name] (str label))
(assoc-in [:symbols sid :nodes :sound]
{:id :sound :name "sound" :kind :audio :parent nil
:z "z-sound" :source {:footage footage-id}
;; Source frame `start` plays on the symbol's 0.
:span range :time {:mode :map :at (- (first range)) :rate 1}}))
tracked? (-> (assoc :analysis (:analysis frozen))
(update :subjects merge (:subjects frozen))
(update :features merge (:features frozen))
(update :groups merge (:groups frozen))))}))
(defn placed
"`entry` — a document and its store — once `brought` holds the symbols brought
in and `store` their blocks: the stores merged and an instance of `sid` placed
in `host` at `frame`, its middle on stage pixel `point` or where it was drawn
when there is none. See `clip/place-symbol`."
[entry brought store sid host frame uuid point]
(let [st (merge (:store entry) store)]
(assoc entry :store st :clip (clip/place-symbol brought st host sid frame uuid point))))

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

@ -20,6 +20,11 @@
a MAP of them. A `:kind :instance` node places one symbol inside another, and a MAP of them. A `:kind :instance` node places one symbol inside another, and
the clip resolver gives each instance its own reading heads. the clip resolver gives each instance its own reading heads.
WHAT IS NOT HERE: how nested symbols' frames and coordinates relate, and
moving nodes between them, are `arthur.domain.nest`; bringing symbols in from
another clip is `arthur.domain.bring`. This namespace is the document and the
operations that only need the document.
NO SYMBOL IS SPECIAL. There is no reserved root and no pointer to one: which NO SYMBOL IS SPECIAL. There is no reserved root and no pointer to one: which
symbol is on screen is the editor's state, not the document's, and every symbol is on screen is the editor's state, not the document's, and every
function here that needs a symbol is told which. A new document has one symbol function here that needs a symbol is told which. A new document has one symbol
@ -37,8 +42,7 @@
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]))
[clojure.string :as string]))
(def clip-keys (def clip-keys
"Every top-level field of a clip, and the reason `arthur.domain.leaf` refuses "Every top-level field of a clip, and the reason `arthur.domain.leaf` refuses
@ -122,7 +126,74 @@
:subjects {} :features {} :groups {} :subjects {} :features {} :groups {}
:symbols {:main {:id :main :frames blank-frames :nodes {}}}}) :symbols {:main {:id :main :frames blank-frames :nodes {}}}})
(declare resolver) (defn- transform-op
"Put a symbol's already resolved mark into its instance's parent space."
[op m path]
(let [at (fn [x y] [(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4))
(+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))])
scale (node/mean-scale m)
op (assoc op :node (conj path (:node op)))]
(case (:kind op)
:poly (let [out (js/Float64Array. (.-length (:pts op)))]
(dotimes [i (:n op)]
(let [[x y] (at (aget (:pts op) (* 2 i))
(aget (:pts op) (inc (* 2 i))))]
(aset out (* 2 i) x)
(aset out (inc (* 2 i)) y)))
(assoc op :pts out))
:disc (let [[x y] (at (:cx op) (:cy op))]
(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))))
op)))
(defn resolver
"Resolve symbol `sid` of a clip, including every symbol its instances place.
Each instance owns its own symbol resolver, so two offsets never share a
channel cursor or point buffer. The returned ops must be drawn before the next
frame, as with symbol/resolver.
Any symbol can be resolved and none is the default: the frame space is the
resolved symbol's own `:frames`, and nested instances inside it still resolve,
because this is the function that knows how to do that."
([clip store palette sid] (resolver clip store palette sid nil))
([clip store palette sid {:keys [picture-fps] :as opts}]
(letfn [(build [sid chain pose-tracks]
(when (some #{sid} chain)
(throw (ex-info "symbol cycle" {:chain (conj chain sid)})))
(let [sym (or (symbol clip sid)
(throw (ex-info "an instance names a missing symbol" {:symbol sid})))
nodes (:nodes sym)
rank (symbol/draw-rank nodes (symbol/order nodes))
ids (sort-by rank (keys nodes))
own (symbol/resolver sym store palette pose-tracks
(assoc opts :source-fps (:fps clip)))
children (into {}
(for [[id n] nodes :when (= :instance (:kind n))]
[id (build (:of n) (conj chain sid)
(get-in n [:playback :tracks]))]))]
(fn [f]
(let [by-id (into {} (map (juxt :node identity)) (own f))]
(into []
(mapcat
(fn [id]
(let [n (get nodes id)]
(if (= :instance (:kind n))
(let [m (symbol/world-of own id)
local (symbol/frame-of own id)
target (symbol clip (:of n))
length (:frames target)
frame (when (and m (number? local))
(if (get-in n [:time :loop?])
(mod local length)
local))]
(if (and frame (<= 0 frame) (< frame length))
(map #(transform-op % m [id]) ((get children id) frame))
[]))
(when-let [op (get by-id id)] [op]))))
ids))))))]
(build sid [] nil))))
(defn center (defn center
"The middle of everything symbol `sid` draws, over all its frames, in its own "The middle of everything symbol `sid` draws, over all its frames, in its own
@ -217,7 +288,7 @@
(assoc-in [:symbols sid] {:id sid :name (name sid) :frames (- end frame) :nodes {}}) (assoc-in [:symbols sid] {:id sid :name (name sid) :frames (- end frame) :nodes {}})
(place-symbol nil host sid frame uuid nil))))) (place-symbol nil host sid frame uuid nil)))))
(defn- free-id (defn free-id
"`wanted`, or the first `wanted-2`, `wanted-3`… `taken?` does not claim. "`wanted`, or the first `wanted-2`, `wanted-3`… `taken?` does not claim.
Keeps the namespace, so `:sym/face` becomes `:sym/face-2`." Keeps the namespace, so `:sym/face` becomes `:sym/face-2`."
[taken? wanted] [taken? wanted]
@ -226,409 +297,6 @@
(map #(keyword (namespace wanted) (str (name wanted) "-" %)) (map #(keyword (namespace wanted) (str (name wanted) "-" %))
(iterate inc 2)))))) (iterate inc 2))))))
(defn adopt
"Copy symbols `roots` of clip `other`, and every symbol they place, into
`clip`. Returns `{:clip :ids}`, where `:ids` maps each copied symbol's id in
`other` to its id here.
AN ID THAT IS TAKEN IS RENAMED, never merged: two symbols that happen to share
an id are two drawings, and an instance's `:of` inside the copy is rewritten to
follow. `wanted` maps a root's id in `other` to the id it should preferably get,
which is how a symbol made from footage is called what the person typed rather
than `:main`.
Only symbols travel. What else `other` holds — tracking identities, an analysis
— is the caller's decision, because whether it can come too depends on what
`clip` already has."
[clip other roots wanted]
(let [;; A tree walk is safe because placing cannot make a cycle.
reach (into #{} (mapcat #(tree-seq any? (partial places other) %)) roots)
ids (reduce (fn [ids sid]
(let [taken? #(or (contains? (:symbols clip) %)
(some #{%} (vals ids)))]
(assoc ids sid (free-id taken? (get wanted sid sid)))))
{} (sort-by str reach))
copy (fn [sid]
(-> (symbol other sid)
(assoc :id (ids sid))
(update :nodes #(into {} (map (fn [[id n]]
[id (cond-> n (:of n) (update :of ids))]))
%))))]
{:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach)
:ids ids}))
(defn symbol-id
"An id for a symbol a person has named: the name, lower-cased and hyphenated,
or `:symbol` when nothing of it survives."
[label]
(let [slug (-> (str label) string/lower-case
(string/replace #"[^a-z0-9]+" "-")
(string/replace #"^-+|-+$" ""))]
(keyword (if (seq slug) slug "symbol"))))
(defn add-take
"Put a frozen take into `clip` as ONE symbol called `label`. Returns
`{:clip :sid :tracked?}`.
`take` is what `flow/freeze/clip` makes: a `:main` that places one symbol per
tracked face. `:main` becomes the named symbol — it is what holds the faces in
stage pixels, so it is the thing worth placing — and it gets the take's SOUND
as an audio node of its own, source frames `range` of footage `footage-id`, so
wherever the symbol is placed it is heard.
The tracking identities, and the analysis they were measured by, come along
only when `clip` has no analysis of its own and no face had to be renamed. A
document holds one analysis, and regeneration finds a face's symbol by its
subject id, so either condition failing means the take comes in as drawings
that play but cannot be re-tuned — `:tracked? false` says so."
[clip take label footage-id range]
(let [{c :clip ids :ids} (adopt clip take [:main] {:main (symbol-id label)})
sid (ids :main)
tracked? (and (nil? (:analysis clip))
(every? #(= % (ids %)) (keys (:subjects take))))]
{:sid sid
:tracked? tracked?
:clip (cond-> (-> c
(assoc-in [:symbols sid :name] (str label))
(assoc-in [:symbols sid :nodes :sound]
{:id :sound :name "sound" :kind :audio :parent nil
:z "z-sound" :source {:footage footage-id}
;; Source frame `start` plays on the symbol's 0.
:span range :time {:mode :map :at (- (first range)) :rate 1}}))
tracked? (-> (assoc :analysis (:analysis take))
(update :subjects merge (:subjects take))
(update :features merge (:features take))
(update :groups merge (:groups take))))}))
(defn audio-tracks
"Every sound symbol `sid` plays, as audio nodes in `sid`'s own frames: its own
and, recursively, those inside the instances it places.
A sound inside a placed symbol is heard where the instance puts it, so each one
is carried OUT through the instance's time map — the same map a timeline row
draws with — and cut to the instance's own span, until it is in the frames of
the symbol being played. Keyed automation moves with it. What comes back is
what a mixer that only knows flat tracks can play as it is."
[clip sid]
(let [sym (symbol clip sid)]
(into (vec (filter #(= :audio (:kind %)) (vals (:nodes sym))))
(mapcat
(fn [inst]
(let [outer (node/time-of inst)
->outer (fn [x] (+ (:at outer) (/ x (:rate outer))))
[in out] (or (:span inst) [0 (frames clip (:of inst))])]
(keep (fn [a]
(let [[p0 p1] (or (node/placed-span a) [in out])
x0 (max p0 in)
x1 (min p1 out)
own (node/time-of a)
->own (fn [x] (* (:rate own) (- x (:at own))))
world (node/then-time outer own)]
(when (< x0 x1)
(-> a
(assoc :span [(->own x0) (->own x1)]
:time {:mode :map :at (:at world) :rate (:rate world)})
(update :channels
(fn [chs]
(into {} (map (fn [[p ch]]
[p (cond-> ch (:keys ch)
(update :keys #(into {} (map (fn [[f v]] [(->outer f) v])) %)))]))
chs)))))))
(audio-tracks clip (:of inst)))))
(filter #(= :instance (:kind %)) (vals (:nodes sym)))))))
(defn inside
"Carry frame `f` of symbol `sid` down through the instances named by `path`,
one per level, the way a timeline row's path names them. Returns
`{:sid :frame :matrix}`: the symbol the last one places, the frame it is showing
there, and the matrix from its coordinates to `sid`'s — or nil when one of the
instances is not on screen at that frame, where there is no inside to be in.
Walked by RESOLVING each level, so the frame and the matrix are the ones the
stage draws with, time maps, parents and exposure included, rather than a
second account of them that could disagree."
[clip store sid path f]
(reduce (fn [{:keys [sid frame matrix]} id]
(let [r (symbol/resolver (symbol clip sid) store pal/index-of nil
{:source-fps (:fps clip)})
_ (r frame)
m (symbol/world-of r id)
local (symbol/frame-of r id)
inner (get-in clip [:symbols sid :nodes id :of])]
(if (and m (number? local) inner (< -1 local (frames clip inner)))
{:sid inner :frame (js/Math.floor local)
:matrix (node/mul! (node/mat) matrix m)}
(reduced nil))))
{:sid sid :frame f :matrix (node/mat)}
path))
(defn- invert
"The inverse of a 2x3 affine, or nil when it has none — an instance scaled to
nothing has no inside to draw into."
[^js m]
(let [[a b c d e f] (array-seq m)
det (- (* a d) (* b c))]
(when-not (zero? det)
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
(defn drawn-inside
"Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the
symbol `path` leads to, so a shape added there lands exactly where it was drawn.
`{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside."
[clip store sid path f pts]
(when-let [{:keys [matrix] :as at} (inside clip store sid path f)]
(when-let [inv (invert matrix)]
(let [out (js/Float64Array. 2)]
(assoc (select-keys at [:sid :frame])
:pts (into [] (mapcat (fn [[x y]]
(node/apply-pt! out 0 inv x y)
[(aget out 0) (aget out 1)]))
(partition 2 pts)))))))
;; ---------------------------------------------------------------------------
;; reparenting
;;
;; ONE NESTING, AS FAR AS A PERSON IS CONCERNED. Putting a node inside another
;; symbol is how things are grouped: the symbol is a shared timeline, and its
;; instance is the handle that moves, retimes and transforms everything in it
;; together. Parent pointers inside a symbol stay — the roto rig is built on them
;; — but they are not something the timeline hands out.
;;
;; A MOVE CHANGES NEITHER THE PICTURE NOR THE TIMING. Space: the node keeps its
;; own channels and gains a `:pinv`, the matrix from where it was to where it
;; goes, which is Blender's parent-inverse and what `node/world!` has always
;; applied. Time: its frames shift by the difference between the two symbols'
;; time maps — its keys and span if it is a shape, only its `:at` if it is an
;; instance, whose span is in its own frames and does not move at all.
(defn- time-down
"The time map from symbol `sid` down through the instances `path` names: the
frame of the last one's symbol for each frame of `sid`. Each step is the
instance's own map after its parents' in that symbol, so the map is the one
the stage reads with, floors aside. Nil through a looping instance, whose
frames come round again and do not map one to one."
[clip sid path]
(:down
(reduce (fn [{:keys [sid down]} id]
(let [nodes (:nodes (symbol clip sid))
chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))]
(if (some #(get-in % [:time :loop?]) chain)
(reduced {:down nil})
{:sid (:of (get nodes id))
:down (reduce node/then-time down (map node/time-of chain))})))
{:sid sid :down {:at 0 :rate 1}}
path)))
(defn- retime
"Node `n` with its own time map replaced by `m`, and nothing else touched: its
span and keys are in its own frames, which a move does not change."
[n {:keys [at rate]}]
(assoc n :time (merge (:time n) {:mode :map :at at :rate rate :offset 0})))
(defn- subtree
"`id` and every node whose parent chain reaches it."
[nodes id]
(into #{} (filter #(some #{id} (symbol/lineage nodes %))) (keys nodes)))
(defn- transplant
"Move node `id` from symbol `host`, where frame `frame` is showing, into symbol
`target`, keeping where it is on screen and when. `carry` is the matrix from
`host`'s coordinates to `target`'s, and `back` the time map from `target`'s
frames to `host`'s.
THE ONE RULE, for space and time alike: the node's new map is its old one
under what it leaves — its parents here, and the way from here to there — so
the picture and the timing through it do not change. For space that is a
`:pinv`, Blender's parent-inverse; for time it is a new `:at` and `:rate`. Its
channels, keys and span are untouched, and its children keep their parent
pointers and come with it. `{:clip}` or `{:refused why}`."
[clip store host frame id target carry back]
(let [nodes (:nodes (symbol clip host))
n (get nodes id)
moving (subtree nodes id)
;; Its parents in this symbol, outermost first.
chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
parent (when-let [p (:parent n)]
(let [r (symbol/resolver (symbol clip host) store pal/index-of nil
{:source-fps (:fps clip)})]
(r frame)
(some-> (symbol/world-of r p) js/Float64Array.from)))]
(cond
(= host target) {:refused "it is already there"}
(and (= :instance (:kind n)) (contains-symbol? clip (:of n) target))
{:refused "a symbol cannot go inside itself"}
(some (fn [m] (or (:measured (get nodes m))
(some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m))))))
moving)
{:refused "generated parts stay with their take — move the instance that places it"}
(some (fn [[k m]] (and (:stencil m)
(not= (contains? moving k) (contains? moving (:stencil m)))))
nodes)
{:refused "a stencil and what it clips have to move together"}
(and (:parent n) (nil? parent))
{:refused "its parent is not on screen at this frame"}
(some #(get-in % [:time :loop?]) chain)
{:refused "a looping parent is in the way"}
:else
(let [taken (:nodes (symbol clip target))
ids (into {} (map (fn [m] [m (free-id #(contains? taken %) m)])) moving)
pinv (reduce #(node/mul! (node/mat) %1 %2) carry (keep identity [parent (node/pinv n)]))
;; back · parents · own: target frames to the node's own.
time (reduce node/then-time back (concat (map node/time-of chain)
[(node/time-of n)]))
moved (for [m moving
:let [x (get nodes m)]]
(cond-> (-> x
(assoc :id (ids m))
(update :parent #(get ids %)))
(:stencil x) (update :stencil ids)
(= m id) (-> (retime time)
(assoc :pinv (vec (array-seq pinv))
:z (str "z" (js/Date.now) "-" (ids m))))))]
{:id (ids id)
:sid target
:clip (-> clip
(update-symbol host update :nodes #(apply dissoc % moving))
(update-symbol target update :nodes (fnil into {})
(map (juxt :id identity)) moved))}))))
(defn move-node
"Move the node at row path `from` — its last id is the node, the rest the
instances down to where it lives — into the symbol placed by the instance at
row path `to`, or to the top of `open` when `to` is empty. Row paths start at
`open`, and `f` is its current frame, at which both have to be on screen.
`{:clip :sid :id}` — the symbol it landed in and its id there, renamed only if
that one was taken — or `{:refused why}`."
[clip store open from to f]
(let [here (inside clip store open (pop from) f)
there (inside clip store open to f)
a (time-down clip open (pop from))
b (time-down clip open to)
inv (some-> there :matrix invert)]
(cond
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)]))
{:refused "nothing to move"}
(or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"}
(not (and a b)) {:refused "a looping instance is in the way"}
(nil? inv) {:refused "the target is scaled to nothing"}
:else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there)
(node/mul! (node/mat) inv (:matrix here))
(node/then-time (node/invert-time b) a)))))
(defn group
"Put the nodes at row paths `froms`, all side by side in one symbol, into a
NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or
`{:refused why}`.
The new symbol starts where the earliest of them starts and ends where the
last one ends, so its instance's bar on the timeline covers exactly theirs.
Its instance sits at the identity, so nothing moves, and pivots about the
middle of what it now holds."
[clip store open froms sid uuid f]
(let [host-path (pop (first froms))
{host :sid frame :frame} (inside clip store open host-path f)
nodes (:nodes (symbol clip host))
whole [0 (frames clip host)]
spans (for [from froms
:let [n (get nodes (peek from))]]
(or (node/placed-span n)
(when (= :instance (:kind n))
(node/placed-span (assoc n :span [0 (frames clip (:of n))])))
whole))
start (max 0 (apply min (map first spans)))
end (min (second whole) (apply max (map second spans)))]
(cond
(nil? host) {:refused "they have to be on screen at this frame"}
(not-every? #(= host-path (pop %)) froms) {:refused "only things side by side can be grouped"}
(some #(nil? (get nodes (peek %))) froms) {:refused "nothing to group"}
:else
(let [made (-> clip
(assoc-in [:symbols sid] {:id sid :name (name sid)
:frames (max 1 (js/Math.ceil (- end start)))
:nodes {}})
(place-symbol store host sid (js/Math.floor start) uuid nil))
moved (reduce (fn [acc from]
(let [r (transplant (:clip acc) store host frame (peek from) sid
(node/mat)
(node/invert-time
(node/time-of (get-in (:clip acc) [:symbols host :nodes uuid]))))]
(if (:refused r) (reduced r) r)))
{:clip made} froms)]
(cond-> moved
(:clip moved) (update :clip assoc-in
[:symbols host :nodes uuid :channels [:xform :anchor] :value]
(center (:clip moved) store sid)))))))
(defn- transform-op
"Put a symbol's already resolved mark into its instance's parent space."
[op m path]
(let [at (fn [x y] [(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4))
(+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))])
scale (node/mean-scale m)
op (assoc op :node (conj path (:node op)))]
(case (:kind op)
:poly (let [out (js/Float64Array. (.-length (:pts op)))]
(dotimes [i (:n op)]
(let [[x y] (at (aget (:pts op) (* 2 i))
(aget (:pts op) (inc (* 2 i))))]
(aset out (* 2 i) x)
(aset out (inc (* 2 i)) y)))
(assoc op :pts out))
:disc (let [[x y] (at (:cx op) (:cy op))]
(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))))
op)))
(defn resolver
"Resolve symbol `sid` of a clip, including every symbol its instances place.
Each instance owns its own symbol resolver, so two offsets never share a
channel cursor or point buffer. The returned ops must be drawn before the next
frame, as with symbol/resolver.
Any symbol can be resolved and none is the default: the frame space is the
resolved symbol's own `:frames`, and nested instances inside it still resolve,
because this is the function that knows how to do that."
([clip store palette sid] (resolver clip store palette sid nil))
([clip store palette sid {:keys [picture-fps] :as opts}]
(letfn [(build [sid chain pose-tracks]
(when (some #{sid} chain)
(throw (ex-info "symbol cycle" {:chain (conj chain sid)})))
(let [sym (or (symbol clip sid)
(throw (ex-info "an instance names a missing symbol" {:symbol sid})))
nodes (:nodes sym)
rank (symbol/draw-rank nodes (symbol/order nodes))
ids (sort-by rank (keys nodes))
own (symbol/resolver sym store palette pose-tracks
(assoc opts :source-fps (:fps clip)))
children (into {}
(for [[id n] nodes :when (= :instance (:kind n))]
[id (build (:of n) (conj chain sid)
(get-in n [:playback :tracks]))]))]
(fn [f]
(let [by-id (into {} (map (juxt :node identity)) (own f))]
(into []
(mapcat
(fn [id]
(let [n (get nodes id)]
(if (= :instance (:kind n))
(let [m (symbol/world-of own id)
local (symbol/frame-of own id)
target (symbol clip (:of n))
length (:frames target)
frame (when (and m (number? local))
(if (get-in n [:time :loop?])
(mod local length)
local))]
(if (and frame (<= 0 frame) (< frame length))
(map #(transform-op % m [id]) ((get children id) frame))
[]))
(when-let [op (get by-id id)] [op]))))
ids))))))]
(build sid [] nil))))
(defn problems (defn problems
"Human-readable reasons this clip will not evaluate or save." "Human-readable reasons this clip will not evaluate or save."
[clip] [clip]

259
frontend/src/arthur/domain/nest.cljs Normal file
View file

@ -0,0 +1,259 @@
(ns arthur.domain.nest
"How nested symbols relate, and moving things between them.
A row path — the ids from the open symbol down through instances, as the
timeline names a row — says where something is. Walking one answers three
questions at once, which is why there is one walk: what frame is showing down
there, what matrix takes its coordinates up to the open symbol's, and what
time map takes the open symbol's frames down to its own.
ONE NESTING, AS FAR AS A PERSON IS CONCERNED. Putting a node inside another
symbol is how things are grouped: the symbol is a shared timeline, and its
instance is the handle that moves, retimes and transforms everything in it
together. Parent pointers inside a symbol stay — the roto rig is built on them
— but they are not something the timeline hands out.
A MOVE CHANGES NEITHER THE PICTURE NOR THE TIMING. Every node has the same two
maps into its parent — the matrix of its transform, and `node/time-of` — and a
move keeps a node's world maps and re-expresses them under the new parent: the
matrix becomes a `:pinv`, Blender's parent-inverse, and the time a new `:at`
and `:rate`. Its channels, keys and span are untouched."
(:require [arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]))
(defn- invert
"The inverse of a 2x3 affine, or nil when it has none — an instance scaled to
nothing has no inside to draw into."
[^js m]
(let [[a b c d e f] (array-seq m)
det (- (* a d) (* b c))]
(when-not (zero? det)
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
(defn- resolved
"Symbol `sid` of `clip`, resolved at `frame`: the resolver, which then answers
`symbol/world-of` and `symbol/frame-of` for that frame."
[clip store sid frame]
(let [r (symbol/resolver (clip/symbol clip sid) store pal/index-of nil
{:source-fps (:fps clip)})]
(r frame)
r))
(defn inside
"Walk row path `path` down from symbol `sid`, whose frame `f` is showing.
Returns `{:sid :frame :matrix :time}`: the symbol the last instance places,
the frame it is showing there, the matrix from its coordinates to `sid`'s, and
the time map from `sid`'s frames to its own — or nil when an instance on the
way is not on screen at that frame, where there is no inside to be in.
The frame and the matrix come from RESOLVING each level, so they are the ones
the stage draws with, floors included. The time map is the affine part, floors
aside, and is nil through a looping instance, whose frames come round again
and do not map one to one."
[clip store sid path f]
(reduce (fn [{:keys [sid frame matrix time]} id]
(let [r (resolved clip store sid frame)
nodes (:nodes (clip/symbol clip sid))
chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))
m (symbol/world-of r id)
local (symbol/frame-of r id)
inner (get-in nodes [id :of])]
(if (and m (number? local) inner (< -1 local (clip/frames clip inner)))
{:sid inner :frame (js/Math.floor local)
:matrix (node/mul! (node/mat) matrix m)
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain))
(reduce node/then-time time (map node/time-of chain)))}
(reduced nil))))
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
path))
(defn drawn-inside
"Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the
symbol `path` leads to, so a shape added there lands exactly where it was drawn.
`{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside."
[clip store sid path f pts]
(when-let [{:keys [matrix] :as at} (inside clip store sid path f)]
(when-let [inv (invert matrix)]
(let [out (js/Float64Array. 2)]
(assoc (select-keys at [:sid :frame])
:pts (into [] (mapcat (fn [[x y]]
(node/apply-pt! out 0 inv x y)
[(aget out 0) (aget out 1)]))
(partition 2 pts)))))))
(defn audio-tracks
"Every sound symbol `sid` plays, as audio nodes in `sid`'s own frames: its own
and, recursively, those inside the instances it places.
A sound inside a placed symbol is heard where the instance puts it, so each one
is carried OUT through the instance's time map — the same map a timeline row
draws with — and cut to the instance's own span, until it is in the frames of
the symbol being played. Keyed automation moves with it. What comes back is
what a mixer that only knows flat tracks can play as it is."
[clip sid]
(let [sym (clip/symbol clip sid)]
(into (vec (filter #(= :audio (:kind %)) (vals (:nodes sym))))
(mapcat
(fn [inst]
(let [outer (node/time-of inst)
->outer (fn [x] (+ (:at outer) (/ x (:rate outer))))
[in out] (or (:span inst) [0 (clip/frames clip (:of inst))])]
(keep (fn [a]
(let [[p0 p1] (or (node/placed-span a) [in out])
x0 (max p0 in)
x1 (min p1 out)
own (node/time-of a)
->own (fn [x] (* (:rate own) (- x (:at own))))
world (node/then-time outer own)]
(when (< x0 x1)
(-> a
(assoc :span [(->own x0) (->own x1)]
:time {:mode :map :at (:at world) :rate (:rate world)})
(update :channels
(fn [chs]
(into {} (map (fn [[p ch]]
[p (cond-> ch (:keys ch)
(update :keys #(into {} (map (fn [[f v]] [(->outer f) v])) %)))]))
chs)))))))
(audio-tracks clip (:of inst)))))
(filter #(= :instance (:kind %)) (vals (:nodes sym)))))))
(defn- retime
"Node `n` with its own time map replaced by `m`, and nothing else touched: its
span and keys are in its own frames, which a move does not change."
[n {:keys [at rate]}]
(assoc n :time (merge (:time n) {:mode :map :at at :rate rate :offset 0})))
(defn- subtree
"`id` and every node whose parent chain reaches it."
[nodes id]
(into #{} (filter #(some #{id} (symbol/lineage nodes %))) (keys nodes)))
(defn- transplant
"Move node `id` from symbol `host`, where frame `frame` is showing, into symbol
`target`, keeping where it is on screen and when. `carry` is the matrix from
`host`'s coordinates to `target`'s, and `back` the time map from `target`'s
frames to `host`'s.
THE ONE RULE, for space and time alike: the node's new map is its old one
under what it leaves — its parents here, and the way from here to there — so
the picture and the timing through it do not change. For space that is a
`:pinv`, Blender's parent-inverse; for time it is a new `:at` and `:rate`. Its
channels, keys and span are untouched, and its children keep their parent
pointers and come with it. `{:clip}` or `{:refused why}`."
[clip store host frame id target carry back]
(let [nodes (:nodes (clip/symbol clip host))
n (get nodes id)
moving (subtree nodes id)
;; Its parents in this symbol, outermost first.
chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
parent (when-let [p (:parent n)]
(some-> (symbol/world-of (resolved clip store host frame) p)
js/Float64Array.from))]
(cond
(= host target) {:refused "it is already there"}
(and (= :instance (:kind n)) (clip/contains-symbol? clip (:of n) target))
{:refused "a symbol cannot go inside itself"}
(some (fn [m] (or (:measured (get nodes m))
(some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m))))))
moving)
{:refused "generated parts stay with their take — move the instance that places it"}
(some (fn [[k m]] (and (:stencil m)
(not= (contains? moving k) (contains? moving (:stencil m)))))
nodes)
{:refused "a stencil and what it clips have to move together"}
(and (:parent n) (nil? parent))
{:refused "its parent is not on screen at this frame"}
(some #(get-in % [:time :loop?]) chain)
{:refused "a looping parent is in the way"}
:else
(let [taken (:nodes (clip/symbol clip target))
ids (into {} (map (fn [m] [m (clip/free-id #(contains? taken %) m)])) moving)
pinv (reduce #(node/mul! (node/mat) %1 %2) carry (keep identity [parent (node/pinv n)]))
;; back · parents · own: target frames to the node's own.
time (reduce node/then-time back (concat (map node/time-of chain)
[(node/time-of n)]))
moved (for [m moving
:let [x (get nodes m)]]
(cond-> (-> x
(assoc :id (ids m))
(update :parent #(get ids %)))
(:stencil x) (update :stencil ids)
(= m id) (-> (retime time)
(assoc :pinv (vec (array-seq pinv))
:z (str "z" (js/Date.now) "-" (ids m))))))]
{:id (ids id)
:sid target
:clip (-> clip
(clip/update-symbol host update :nodes #(apply dissoc % moving))
(clip/update-symbol target update :nodes (fnil into {})
(map (juxt :id identity)) moved))}))))
(defn move-node
"Move the node at row path `from` — its last id is the node, the rest the
instances down to where it lives — into the symbol placed by the instance at
row path `to`, or to the top of `open` when `to` is empty. Row paths start at
`open`, and `f` is its current frame, at which both have to be on screen.
`{:clip :sid :id}` — the symbol it landed in and its id there, renamed only if
that one was taken — or `{:refused why}`."
[clip store open from to f]
(let [here (inside clip store open (pop from) f)
there (inside clip store open to f)
a (:time here)
b (:time there)
inv (some-> there :matrix invert)]
(cond
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)]))
{:refused "nothing to move"}
(or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"}
(not (and a b)) {:refused "a looping instance is in the way"}
(nil? inv) {:refused "the target is scaled to nothing"}
:else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there)
(node/mul! (node/mat) inv (:matrix here))
(node/then-time (node/invert-time b) a)))))
(defn group
"Put the nodes at row paths `froms`, all side by side in one symbol, into a
NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or
`{:refused why}`.
The new symbol starts where the earliest of them starts and ends where the
last one ends, so its instance's bar on the timeline covers exactly theirs.
Its instance sits at the identity, so nothing moves, and pivots about the
middle of what it now holds."
[clip store open froms sid uuid f]
(let [host-path (pop (first froms))
{host :sid frame :frame} (inside clip store open host-path f)
nodes (:nodes (clip/symbol clip host))]
(cond
(nil? host) {:refused "they have to be on screen at this frame"}
(not-every? #(= host-path (pop %)) froms) {:refused "only things side by side can be grouped"}
(some #(nil? (get nodes (peek %))) froms) {:refused "nothing to group"}
:else
(let [whole [0 (clip/frames clip host)]
spans (for [from froms
:let [n (get nodes (peek from))]]
(or (node/placed-span n)
(when (= :instance (:kind n))
(node/placed-span (assoc n :span [0 (clip/frames clip (:of n))])))
whole))
start (js/Math.floor (max 0 (apply min (map first spans))))
end (min (second whole) (apply max (map second spans)))
made (-> clip
(assoc-in [:symbols sid] {:id sid :name (name sid)
:frames (max 1 (js/Math.ceil (- end start)))
:nodes {}})
(clip/place-symbol store host sid start uuid nil))
back (node/invert-time (node/time-of (get-in made [:symbols host :nodes uuid])))
moved (reduce (fn [acc from]
(let [r (transplant (:clip acc) store host frame (peek from) sid
(node/mat) back)]
(if (:refused r) (reduced r) r)))
{:clip made} froms)]
(cond-> moved
(:clip moved) (update :clip assoc-in
[:symbols host :nodes uuid :channels [:xform :anchor] :value]
(clip/center (:clip moved) store sid)))))))

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

@ -4,7 +4,7 @@
The frames come from the server by URL since step 9 — see `flow/ingest` — and the The frames come from the server by URL since step 9 — see `flow/ingest` — and the
detector's identity comes from the server too, because it goes into the content detector's identity comes from the server too, because it goes into the content
address of every block this produces." address of every block this produces."
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.bring :as bring]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.flow.detect :as detect] [arthur.flow.detect :as detect]
@ -430,16 +430,13 @@
(let [uuid (random-uuid) (let [uuid (random-uuid)
fps (get-in db [:clip :fps]) fps (get-in db [:clip :fps])
{:keys [clip sid tracked?]} {:keys [clip sid tracked?]}
(clip/add-take (:clip (store/entry (:clip/current db))) (:clip built) (bring/take (:clip (store/entry (:clip/current db))) (:clip built)
name footage-id range) name footage-id range)
db (edit/edit-entry db (edit/edit-entry
db db
#(let [st (merge (:store %) (:store built))] #(cond-> (bring/placed % clip (:store built) sid host frame uuid point)
(cond-> (assoc %
:store st
:clip (clip/place-symbol clip st host sid frame uuid point))
tracked? (merge (select-keys built [:footage-id :source-blocks tracked? (merge (select-keys built [:footage-id :source-blocks
:source-inputs])))))] :source-inputs]))))]
{:db (-> db {:db (-> db
(update :ui dissoc :convert) (update :ui dissoc :convert)
(assoc-in [:ui :selection] [:node host uuid [uuid]]) (assoc-in [:ui :selection] [:node host uuid [uuid]])

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

@ -22,6 +22,7 @@
Nothing here touches app-db except through events. The promise chain lives in an Nothing here touches app-db except through events. The promise chain lives in an
fx, which is the only thing in this namespace that is not pure." fx, which is the only thing in this namespace that is not pure."
(:require [arthur.db :as db] (:require [arthur.db :as db]
[arthur.domain.bring :as bring]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
@ -153,20 +154,15 @@
(rf/reg-event-fx (rf/reg-event-fx
::imported ::imported
;; Copied, not linked: the symbol and everything it places come in under ids of ;; As drawing: its tracking stays with the analysis that measured it. See
;; their own, with the blocks they name, and editing them here does not touch ;; `arthur.domain.bring`.
;; the project they came from. They come in as DRAWINGS — their tracking stays
;; with the analysis that measured them — so they play but do not re-tune.
(fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]] (fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]]
(let [sid (leaf/unsegment symbol) (let [sid (leaf/unsegment symbol)
uuid (random-uuid) uuid (random-uuid)
{:keys [clip ids]} (clip/adopt (:clip (store/entry (:clip/current db))) {:keys [clip ids]} (bring/symbols (:clip (store/entry (:clip/current db)))
(:clip other) [sid] {}) (:clip other) [sid] {})
db (edit/edit-entry db (edit/edit-entry db #(bring/placed % clip (:store other) (ids sid)
db host frame uuid point))]
#(let [st (merge (:store %) (:store other))]
(assoc % :store st
:clip (clip/place-symbol clip st host (ids sid) frame uuid point))))]
{:db (-> db {:db (-> db
(assoc-in [:ui :selection] [:node host uuid [uuid]]) (assoc-in [:ui :selection] [:node host uuid [uuid]])
(update :project merge {:status (str "brought in " label)})) (update :project merge {:status (str "brought in " label)}))

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

@ -6,6 +6,7 @@
there should not be one: an editor's own state is the cheapest thing in the there should not be one: an editor's own state is the cheapest thing in the
app to change and the most expensive to have two copies of." app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
[arthur.events.paint :as paint] [arthur.events.paint :as paint]
[arthur.footage.store :as store] [arthur.footage.store :as store]
@ -75,7 +76,7 @@
;; Drawn on the stage, stored where it goes: inside the selected ;; Drawn on the stage, stored where it goes: inside the selected
;; instance, re-expressed in that symbol's coordinates and frame so it ;; instance, re-expressed in that symbol's coordinates and frame so it
;; lands exactly where it was drawn. ;; lands exactly where it was drawn.
{:keys [sid frame pts]} (clip/drawn-inside clip st open down {:keys [sid frame pts]} (nest/drawn-inside clip st open down
(get-in db [:playback :frame]) draft)] (get-in db [:playback :frame]) draft)]
(cond (cond
(< (count draft) 6) {} (< (count draft) 6) {}
@ -107,7 +108,7 @@
(fn [db _] (fn [db _]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [{clip :clip st :store} (store/entry (:clip/current db))
down (where-new-goes clip db) down (where-new-goes clip db)
{host :sid frame :frame} (clip/inside clip st (get-in db [:ui :open]) down {host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down
(get-in db [:playback :frame])) (get-in db [:playback :frame]))
sid (clip/fresh-id clip) sid (clip/fresh-id clip)
uuid (random-uuid)] uuid (random-uuid)]
@ -155,7 +156,7 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; moving rows between symbols ;; moving rows between symbols
;; ;;
;; Both are `clip/move-node` and `clip/group`, which keep the picture and the ;; Both are `nest/move-node` and `nest/group`, which keep the picture and the
;; timing as they are; what these add is where the selection goes and the reason ;; timing as they are; what these add is where the selection goes and the reason
;; when a move is refused, which is the only feedback a refused drop has. ;; when a move is refused, which is the only feedback a refused drop has.
@ -166,7 +167,7 @@
::move-node ::move-node
(fn [db [_ from to]] (fn [db [_ from to]]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [{clip :clip st :store} (store/entry (:clip/current db))
r (clip/move-node clip st (get-in db [:ui :open]) from to r (nest/move-node clip st (get-in db [:ui :open]) from to
(get-in db [:playback :frame]))] (get-in db [:playback :frame]))]
(if-let [why (:refused r)] (if-let [why (:refused r)]
(refused db why) (refused db why)
@ -183,11 +184,11 @@
f (get-in db [:playback :frame]) f (get-in db [:playback :frame])
host (pop (first froms)) host (pop (first froms))
uuid (random-uuid) uuid (random-uuid)
r (clip/group clip st open froms (clip/fresh-id clip) uuid f)] r (nest/group clip st open froms (clip/fresh-id clip) uuid f)]
(if-let [why (:refused r)] (if-let [why (:refused r)]
(refused db why) (refused db why)
(-> db (-> db
(edit/edit (constantly (:clip r))) (edit/edit (constantly (:clip r)))
(assoc-in [:ui :selection] [:node (:sid (clip/inside clip st open host f)) (assoc-in [:ui :selection] [:node (:sid (nest/inside clip st open host f))
uuid (conj host uuid)]) uuid (conj host uuid)])
(update-in [:ui :expanded] conj (conj host uuid))))))) (update-in [:ui :expanded] conj (conj host uuid)))))))

26
frontend/test/arthur/domain/bring_test.cljs Normal file
View file

@ -0,0 +1,26 @@
(ns arthur.domain.bring-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
[]
(-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
(deftest adopting-symbols-renames-what-collides
(let [here (nested)
there (-> (clip/blank)
(assoc-in [:symbols :inner] {:id :inner :frames 4 :nodes {}})
(clip/place-symbol nil :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" nil))
{:keys [clip ids]} (bring/symbols here there [:main] {:main :take})]
(is (= {:main :take :inner :inner-2} ids)
"the root gets the name asked for; a taken id gets the next free one")
(is (= 10 (clip/frames clip :inner)) "what was already here is untouched")
(is (= :inner-2 (:of (first (vals (get-in clip [:symbols :take :nodes])))))
"and the copy's instance follows its renamed symbol")
(is (empty? (clip/problems clip)))))

154
frontend/test/arthur/domain/instance_test.cljs
View file

@ -265,68 +265,6 @@
(is (seq (node/problems (assoc-in n [:time :in] 3))) (is (seq (node/problems (assoc-in n [:time :in] 3)))
"a stale :in is reported rather than silently ignored"))) "a stale :in is reported rather than silently ignored")))
(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names
(let [c (nested)
[id] (keys (get-in c [:symbols :outer :nodes]))
at #(select-keys (clip/inside c nil :outer %1 %2) [:sid :frame])]
(is (= {:sid :outer :frame 12} (at [] 12)))
(is (= {:sid :inner :frame 7} (at [id] 12))
"the instance starts at 5, so frame 12 outside is frame 7 inside")
(is (nil? (clip/inside c nil :outer [id] 2))
"and before it starts there is no inside to be in")))
(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn
(let [u #uuid "00000000-0000-4000-8000-0000000000dd"
c (-> (clip/blank)
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
(clip/place-symbol nil :main :box 10 u nil)
;; moved, turned and doubled, so nothing lines up by accident
(update-in [:symbols :main :nodes u :channels] merge
{[:xform :pos] (ch/framed [40 20])
[:xform :rot] (ch/framed (/ js/Math.PI 2))
[:xform :scale] (ch/framed [2 2])}))
drawn [100 50 140 50 120 90]
{:keys [sid frame pts]} (clip/drawn-inside c nil :main [u] 16 drawn)
c (paint/new-shape c sid :shape frame pts :brow)
[op] (filter #(= [u :shape] (:node %))
((clip/resolver c nil pal/index-of :main) 16))]
(is (= :box sid))
(is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10")
(is (every? #(< (js/Math.abs %) 1e-9)
(map - drawn (take 6 (array-seq (:pts op)))))
"resolved back out through the instance, it is exactly what was drawn")))
(deftest adopting-symbols-renames-what-collides
(let [here (nested)
there (-> (clip/blank)
(assoc-in [:symbols :inner] {:id :inner :frames 4 :nodes {}})
(clip/place-symbol nil :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" nil))
{:keys [clip ids]} (clip/adopt here there [:main] {:main :take})]
(is (= {:main :take :inner :inner-2} ids)
"the root gets the name asked for; a taken id gets the next free one")
(is (= 10 (clip/frames clip :inner)) "what was already here is untouched")
(is (= :inner-2 (:of (first (vals (get-in clip [:symbols :take :nodes])))))
"and the copy's instance follows its renamed symbol")
(is (empty? (clip/problems clip)))))
(deftest a-placed-symbols-sound-is-heard-where-it-is-placed
(let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1"
:span [10 40] :time {:mode :map :at -10 :rate 1}
:channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}}
c (-> (clip/blank)
(assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}})
(clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil))
[t] (clip/audio-tracks c :main)]
(is (= [10 40] (:span t)) "the same frames of the source")
(is (= [50 80] (node/placed-span t)) "starting where the instance starts")
(is (= #{50 55} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
"with its automation moved along")
(testing "and cut off where the instance's own span ends"
(let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12])
[t] (clip/audio-tracks c :main)]
(is (= [10 22] (:span t)))
(is (= [50 62] (node/placed-span t)))))))
(deftest an-instance-pivots-about-the-middle-of-what-it-draws (deftest an-instance-pivots-about-the-middle-of-what-it-draws
(let [square (fn [x y] {:kind :poly :z "a1" :id :sq (let [square (fn [x y] {:kind :poly :z "a1" :id :sq
:channels {[:geom :pts] (ch/framed [x y (+ x 10) y (+ x 10) (+ y 10) x (+ y 10)]) :channels {[:geom :pts] (ch/framed [x y (+ x 10) y (+ x 10) (+ y 10) x (+ y 10)])
@ -351,95 +289,3 @@
(is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved") (is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved")
(is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value])) (is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value]))
"the instance's did not"))))) "the instance's did not")))))
(defn- picture
"What `sid` draws at each of `fs`, without the node paths a move changes:
per frame, the sorted marks with their points rounded to a thousandth."
[c sid fs]
(let [resolve (clip/resolver c nil pal/index-of sid)
round #(/ (js/Math.round (* 1000 %)) 1000)]
(mapv (fn [f]
(sort-by str (map (fn [op]
[(:color op) (mapv round (take (* 2 (:n op)) (array-seq (:pts op))))])
(resolve f))))
fs)))
(def ^:private a-uuid #uuid "00000000-0000-4000-8000-0000000000e1")
(def ^:private b-uuid #uuid "00000000-0000-4000-8000-0000000000e2")
(defn- studio
"`main` holds a keyed shape and a moved, turned, doubled instance of `box`,
placed at frame 10; `box` holds a shape of its own."
[]
(let [tri (fn [id x keyed]
{:id id :kind :poly :z "a1" :paint? true :span [4 60]
:channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed))
[:style :color] (ch/framed :brow)}})]
(-> (clip/blank)
(assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40}))
(assoc-in [:symbols :box] {:id :box :frames 50 :nodes {:inner (tri :inner 5 {0 10})}})
(clip/place-symbol nil :main :box 10 a-uuid nil)
(update-in [:symbols :main :nodes a-uuid :channels] merge
{[:xform :pos] (ch/framed [30 20])
[:xform :rot] (ch/framed 0.5)
[:xform :scale] (ch/framed [2 2])}))))
(deftest moving-a-node-into-a-symbol-changes-nothing-on-screen
;; From frame 10, where the instance starts: inside a symbol a node exists only
;; while that symbol is on screen, so moving the shape in cuts off 4–9.
(let [c (studio)
fs [10 16 29 30 45 59 60 70]
{moved :clip :as r} (clip/move-node c nil :main [:tri] [a-uuid] 16)]
(is (nil? (:refused r)) (:refused r))
(is (contains? (get-in moved [:symbols :box :nodes]) :tri) "it is in the symbol now")
(is (not (contains? (get-in moved [:symbols :main :nodes]) :tri)) "and not beside it")
(is (= [4 60] (get-in moved [:symbols :box :nodes :tri :span]))
"its span and keys are its own and do not change")
(is (= -10 (get-in moved [:symbols :box :nodes :tri :time :at]))
"its time map takes up the ten frames the instance starts late")
(is (= (picture c :main fs) (picture moved :main fs)) "and the picture is the same, frame for frame")
(testing "moving it back out is also invisible"
(let [{back :clip} (clip/move-node moved nil :main [a-uuid :tri] [] 16)]
(is (= (picture c :main fs) (picture back :main fs)))))))
(deftest moving-an-instance-moves-only-its-at
(let [c (-> (studio)
(assoc-in [:symbols :holder] {:id :holder :frames 100 :nodes {}})
(clip/place-symbol nil :main :holder 3 b-uuid nil))
fs [0 10 16 40 59]
{moved :clip :as r} (clip/move-node c nil :main [a-uuid] [b-uuid] 16)
n (get-in moved [:symbols :holder :nodes a-uuid])]
(is (nil? (:refused r)) (:refused r))
(is (= 7 (get-in n [:time :at])) "placed at 10 in main is at 7 inside something placed at 3")
(is (= [0 50] (:span n)) "its own frames do not move")
(is (= (picture c :main fs) (picture moved :main fs)))))
(deftest grouping-makes-a-symbol-around-them-and-changes-nothing-on-screen
(let [c (studio)
fs [0 4 10 16 30 59 60]
{grouped :clip :as r} (clip/group c nil :main [[:tri] [a-uuid]] :group-1 b-uuid 16)
inst (get-in grouped [:symbols :main :nodes b-uuid])]
(is (nil? (:refused r)) (:refused r))
(is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes])))))
(is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were")
(is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts")
(is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends")
(is (= (picture c :main fs) (picture grouped :main fs)))
(is (empty? (clip/problems grouped)))))
(deftest what-cannot-move-says-why
(let [c (studio)]
(is (:refused (clip/move-node c nil :main [a-uuid] [a-uuid] 16)) "not into itself")
(is (:refused (clip/move-node c nil :main [:tri] [a-uuid] 2)) "not while the target is off screen")
(let [roto (assoc-in c [:symbols :main :nodes :tri :channels [:geom :pts] :generated] {:by :roto})]
(is (re-find #"generated" (:refused (clip/move-node roto nil :main [:tri] [a-uuid] 16)))))))
(deftest moving-into-a-retimed-instance-keeps-the-timing
(let [c (assoc-in (studio) [:symbols :main :nodes a-uuid :time :rate] 2)
fs [10 12 17 20 29 34]
{moved :clip :as r} (clip/move-node c nil :main [:tri] [a-uuid] 16)]
(is (nil? (:refused r)) (:refused r))
(is (= {:at -20 :rate 0.5}
(select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate]))
"half speed inside something at double speed, so it runs as it did")
(is (= (picture c :main fs) (picture moved :main fs)))))

158
frontend/test/arthur/domain/nest_test.cljs Normal file
View file

@ -0,0 +1,158 @@
(ns arthur.domain.nest-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
[]
(-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names
(let [c (nested)
[id] (keys (get-in c [:symbols :outer :nodes]))
at #(select-keys (nest/inside c nil :outer %1 %2) [:sid :frame])]
(is (= {:sid :outer :frame 12} (at [] 12)))
(is (= {:sid :inner :frame 7} (at [id] 12))
"the instance starts at 5, so frame 12 outside is frame 7 inside")
(is (nil? (nest/inside c nil :outer [id] 2))
"and before it starts there is no inside to be in")))
(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn
(let [u #uuid "00000000-0000-4000-8000-0000000000dd"
c (-> (clip/blank)
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
(clip/place-symbol nil :main :box 10 u nil)
;; moved, turned and doubled, so nothing lines up by accident
(update-in [:symbols :main :nodes u :channels] merge
{[:xform :pos] (ch/framed [40 20])
[:xform :rot] (ch/framed (/ js/Math.PI 2))
[:xform :scale] (ch/framed [2 2])}))
drawn [100 50 140 50 120 90]
{:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn)
c (paint/new-shape c sid :shape frame pts :brow)
[op] (filter #(= [u :shape] (:node %))
((clip/resolver c nil pal/index-of :main) 16))]
(is (= :box sid))
(is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10")
(is (every? #(< (js/Math.abs %) 1e-9)
(map - drawn (take 6 (array-seq (:pts op)))))
"resolved back out through the instance, it is exactly what was drawn")))
(deftest a-placed-symbols-sound-is-heard-where-it-is-placed
(let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1"
:span [10 40] :time {:mode :map :at -10 :rate 1}
:channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}}
c (-> (clip/blank)
(assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}})
(clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil))
[t] (nest/audio-tracks c :main)]
(is (= [10 40] (:span t)) "the same frames of the source")
(is (= [50 80] (node/placed-span t)) "starting where the instance starts")
(is (= #{50 55} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
"with its automation moved along")
(testing "and cut off where the instance's own span ends"
(let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12])
[t] (nest/audio-tracks c :main)]
(is (= [10 22] (:span t)))
(is (= [50 62] (node/placed-span t)))))))
(defn- picture
"What `sid` draws at each of `fs`, without the node paths a move changes:
per frame, the sorted marks with their points rounded to a thousandth."
[c sid fs]
(let [resolve (clip/resolver c nil pal/index-of sid)
round #(/ (js/Math.round (* 1000 %)) 1000)]
(mapv (fn [f]
(sort-by str (map (fn [op]
[(:color op) (mapv round (take (* 2 (:n op)) (array-seq (:pts op))))])
(resolve f))))
fs)))
(def ^:private a-uuid #uuid "00000000-0000-4000-8000-0000000000e1")
(def ^:private b-uuid #uuid "00000000-0000-4000-8000-0000000000e2")
(defn- studio
"`main` holds a keyed shape and a moved, turned, doubled instance of `box`,
placed at frame 10; `box` holds a shape of its own."
[]
(let [tri (fn [id x keyed]
{:id id :kind :poly :z "a1" :paint? true :span [4 60]
:channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed))
[:style :color] (ch/framed :brow)}})]
(-> (clip/blank)
(assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40}))
(assoc-in [:symbols :box] {:id :box :frames 50 :nodes {:inner (tri :inner 5 {0 10})}})
(clip/place-symbol nil :main :box 10 a-uuid nil)
(update-in [:symbols :main :nodes a-uuid :channels] merge
{[:xform :pos] (ch/framed [30 20])
[:xform :rot] (ch/framed 0.5)
[:xform :scale] (ch/framed [2 2])}))))
(deftest moving-a-node-into-a-symbol-changes-nothing-on-screen
;; From frame 10, where the instance starts: inside a symbol a node exists only
;; while that symbol is on screen, so moving the shape in cuts off 4–9.
(let [c (studio)
fs [10 16 29 30 45 59 60 70]
{moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)]
(is (nil? (:refused r)) (:refused r))
(is (contains? (get-in moved [:symbols :box :nodes]) :tri) "it is in the symbol now")
(is (not (contains? (get-in moved [:symbols :main :nodes]) :tri)) "and not beside it")
(is (= [4 60] (get-in moved [:symbols :box :nodes :tri :span]))
"its span and keys are its own and do not change")
(is (= -10 (get-in moved [:symbols :box :nodes :tri :time :at]))
"its time map takes up the ten frames the instance starts late")
(is (= (picture c :main fs) (picture moved :main fs)) "and the picture is the same, frame for frame")
(testing "moving it back out is also invisible"
(let [{back :clip} (nest/move-node moved nil :main [a-uuid :tri] [] 16)]
(is (= (picture c :main fs) (picture back :main fs)))))))
(deftest moving-an-instance-moves-only-its-at
(let [c (-> (studio)
(assoc-in [:symbols :holder] {:id :holder :frames 100 :nodes {}})
(clip/place-symbol nil :main :holder 3 b-uuid nil))
fs [0 10 16 40 59]
{moved :clip :as r} (nest/move-node c nil :main [a-uuid] [b-uuid] 16)
n (get-in moved [:symbols :holder :nodes a-uuid])]
(is (nil? (:refused r)) (:refused r))
(is (= 7 (get-in n [:time :at])) "placed at 10 in main is at 7 inside something placed at 3")
(is (= [0 50] (:span n)) "its own frames do not move")
(is (= (picture c :main fs) (picture moved :main fs)))))
(deftest grouping-makes-a-symbol-around-them-and-changes-nothing-on-screen
(let [c (studio)
fs [0 4 10 16 30 59 60]
{grouped :clip :as r} (nest/group c nil :main [[:tri] [a-uuid]] :group-1 b-uuid 16)
inst (get-in grouped [:symbols :main :nodes b-uuid])]
(is (nil? (:refused r)) (:refused r))
(is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes])))))
(is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were")
(is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts")
(is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends")
(is (= (picture c :main fs) (picture grouped :main fs)))
(is (empty? (clip/problems grouped)))))
(deftest what-cannot-move-says-why
(let [c (studio)]
(is (:refused (nest/move-node c nil :main [a-uuid] [a-uuid] 16)) "not into itself")
(is (:refused (nest/move-node c nil :main [:tri] [a-uuid] 2)) "not while the target is off screen")
(let [roto (assoc-in c [:symbols :main :nodes :tri :channels [:geom :pts] :generated] {:by :roto})]
(is (re-find #"generated" (:refused (nest/move-node roto nil :main [:tri] [a-uuid] 16)))))))
(deftest moving-into-a-retimed-instance-keeps-the-timing
(let [c (assoc-in (studio) [:symbols :main :nodes a-uuid :time :rate] 2)
fs [10 12 17 20 29 34]
{moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)]
(is (nil? (:refused r)) (:refused r))
(is (= {:at -20 :rate 0.5}
(select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate]))
"half speed inside something at double speed, so it runs as it did")
(is (= (picture c :main fs) (picture moved :main fs)))))