arthur/frontend/src/arthur/domain/nest.cljs
Your Name ddef5c6bfd A node has a pivot
Rotation and scale are composed about `[:xform :pivot]`, a point in the
node's own coordinates:

    local = T(pos) · T(piv) · R · K · S · T(-piv)

Schema 7 deleted this field, on the argument that an anchor is a peg. The
algebra was right and the conclusion was not. The identity holds between a
pivot and a peg THAT ALREADY EXISTS; it says nothing about what a node
turns about when nobody has made one, and that default is what a person
meets. With no pivot in the composition, a turn about anything but the
node's own origin has to be paid for by solving `pos` per frame —
`gesture/about` — and that solution is an arc in the angle while `pos`
tweens along the chord. Right on the frame it is written, wrong on every
frame between two keys.

A drawing escaped it: `paint/centred` puts a shape's origin on the middle
of what it draws. A symbol instance cannot — its origin is its symbol's,
and a symbol is drawn on the stage, so its origin is the top-left corner
of the stage. Off the document this was reported on: a symbol's content
centred 161 px from its own origin, and one instance of it keyed rot 0→60
put the drawing where it was put on both keys and at (-88, 121) halfway
between, a stage and a half away. The advice on offer was "make a peg
first", for wanting to spin a drawing.

So a turn now writes `rot` and nothing else, always, and the pivot is held
exactly between two keys because the matrix is built about it on every
frame. The default, and the way back to it, are the parts the old anchor
was missing:

  - a node nobody has pivoted turns about the middle of what it draws,
    `pick/bounds-of` — the same bounds the selection box comes from
  - the first turn or scale writes that middle down, in the same edit,
    with the `pos` that holds the picture still (`gesture/with-pivot`)
  - `clip/place-symbol` stores the middle of what a symbol draws as the
    instance's pivot, so a drop spins in place from the start
  - ⌃/⌘-drag the cross on the stage to put the pivot anywhere, moving
    nothing — on any node now, not pegs alone
  - ⌖ beside the pivot row in the inspector puts it back on the middle of
    what the node draws NOW (`gesture/centred`)

A pivot is a CHOICE and does not follow the drawing: once it is the node's
own, adding a shape inside a symbol cannot re-aim a keyed spin of any
instance of it. `instance-test` has asserted both answers to that now, and
the stored one is right.

A peg stays a peg, for the three things a node's own pivot is not: a pivot
SHARED between nodes, a SECOND transform on one node, and a hand transform
over a measured one. `nest/repivot` is gone — a pivot inside the node's own
transform has nothing to correct in anybody else's `:pinv`, so the gesture
works on every node and is no longer refused on an animated one. A measured
node's pivot is authored like any other, so a traced mouth can be told
where to turn without a peg.

Schema 8, and the first version that converts rather than refusing: an
absent pivot reads as [0 0] and T(pos)·T(0)·M·T(-0) is T(pos)·M to the
bit, so every stored document composes to exactly the matrices it did and
the migration only restamps the version.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-10-06 14:33:35 -04:00

718 lines
38 KiB
Clojure

(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.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn- resolved
"Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then
answers `symbol/world-of` and `symbol/frame-of` for it on that frame.
Only its lineage is resolved, because where a node is depends on its parents
and nothing else in the symbol — and the whole symbol costs more than a frame
of the stage, which the editor asks for on every frame."
[clip store sid frame id]
(let [sym (clip/symbol clip sid)
sym (update sym :nodes select-keys (symbol/lineage (:nodes sym) id))
r (symbol/resolver sym store pal/index-of nil)]
(r frame)
r))
(defn inside
"Walk row path `path` down from symbol `sid`, whose OWN frame `f` is showing,
into the node it ends at. Returns `{:sid :frame :matrix :time}`: the symbol that
node places (nil for one that places none), the frame of its own it is
showing, the matrix from its coordinates to `sid`'s, and the time map from
`sid`'s frames to its own — or nil when a node on the way is not on screen at
that frame, where there is no inside to be in.
`f` IS ONE OF `sid`'S OWN FRAMES, which is the coordinate everything authored
and every editing gesture is in — see `docs/one-grid-plan.md`. It used to be an
OUTPUT frame, multiplied into `sid`'s space here, which made the units of the
argument something each caller had to know without being told and put a
2.5-frame step between what the ruler offered and what the document could hold.
A caller holding the playhead converts with `clip/shown-frame`.
THE SAME STEP FOR EVERY NODE. Inside an instance is the symbol it places;
inside a shape is where its points and keys are. Either way it is the node's
own coordinates and frames, so a shape any depth down is edited through the
maps it is drawn with.
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 node, 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 id)
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)
inst? (= :instance (:kind (get nodes id)))
;; WHICH symbol, and which frame of it, are both read off the
;; cel: inside a held cel is its drawing on the frame
;; the hold pins, not on `local`, and inside a playing insert
;; is its animation at its own in-point and speed.
shown (when (number? local)
(clip/placed-frame clip sid (get nodes id) local))
inner (:symbol shown)
lf (if shown (:frame shown) local)]
(if (and m (number? local)
;; A clip over a gap has no inside to be in.
(or (not inst?) shown)
(or (nil? inner) (< -1 lf (clip/frames clip inner))))
{:sid inner :frame (js/Math.floor lf)
:matrix (node/mul! (node/mat) matrix m)
;; Forward sampling above works for holds too. :time is the
;; invertible edit map; source in-points and speeds belong in it.
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain)
(or (not inst?) (clip/source-time clip sid (get nodes id))))
(cond-> (reduce node/then-time time (map node/time-of chain))
inst? (node/then-time (clip/source-time clip sid (get nodes id)))))}
(reduced nil))))
{:sid sid :frame (js/Math.floor f)
: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
lives in, its own frame, the matrix from the space its `[:xform :pos]` is in to
`sid`'s, and the one from its own coordinates. Nil when it is not on screen.
`:parent` is everything above the node's own transform, `world = parent ·
local`: its symbol's way to the stage, its parents there, and its `:pinv`."
[clip store sid path f]
(when-let [{:keys [sid frame matrix]} (inside clip store sid (pop path) f)]
(let [id (peek path)
n (get-in clip [:symbols sid :nodes id])
r (when n (resolved clip store sid frame id))
w (when r (symbol/world-of r id))]
(when w
{:sid sid :id id
:frame (js/Math.floor (symbol/frame-of r id))
:parent (reduce #(node/mul! (node/mat) %1 %2) matrix
(keep identity [(some->> (:parent n) (symbol/world-of r))
(node/pinv n)]))
:world (node/mul! (node/mat) matrix w)}))))
(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 (node/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
"Flatten audible source intervals through cel and parent clocks.
A held visual source is silent. Every returned track carries a source offset,
an output interval, and automation mapped into the open symbol's time.
Automatically associated face audio can be reached more than once in a
multi-face take. Equal `:media-link`s at the same source and output interval
are one recording, not a louder mix; at different placements they remain
separate scheduled clips."
[clip sid]
(letfn [(to-local [m f] (* (:rate m) (- f (:at m))))
(to-outer [m f] (+ (:at m) (/ f (:rate m))))
(window [m span bounds]
(if span
[(max (first bounds) (to-outer m (first span)))
(min (second bounds) (to-outer m (second span)))]
bounds))
(channels [chs m]
(into {}
(map (fn [[p c]]
[p (cond-> c
(:keys c) (update :keys #(into {} (map (fn [[f v]] [(to-outer m f) v])) %))
(:segments c) (update :segments #(into {} (map (fn [[f v]] [(to-outer m f) v])) %))
(:dense c) (assoc :sample-time m))]))
chs))
(walk [sid outer bounds path seen]
(when (contains? seen sid)
(throw (ex-info "symbol cycle in audio" {:symbol sid})))
(let [sym (clip/symbol clip sid)
nodes (:nodes sym)
bounds (window outer [0 (:frames sym)] bounds)
positions (reduce
(fn [acc id]
(let [n (get nodes id)
parent (if-let [pid (:parent n)] (get acc pid)
{:time outer :bounds bounds})
m (node/then-time (:time parent) (node/time-of n))
m (if (= :audio (:kind n))
(update m :rate * (/ (or (get-in n [:source :fps]) (clip/fps clip sid))
(clip/fps clip sid))) m)]
(assoc acc id {:time m :bounds (window m (:span n) (:bounds parent))})))
{} (symbol/order nodes))]
(mapcat
(fn [[id n]]
(let [{m :time [lo hi] :bounds} (get positions id)]
(when (< lo hi)
(case (:kind n)
:audio [(-> n
(assoc :parent nil :path (conj path id) :owner sid
:fps (or (get-in n [:source :fps]) (clip/fps clip sid))
:span [(to-local m lo) (to-local m hi)]
:time (merge (:time n) {:mode :map :at (:at m) :rate (:rate m) :offset 0})
:channels (channels (:channels n) m)))]
:instance
(let [{:keys [in speed end]} (node/playback-of n)
child (node/source n)
length (clip/frames clip child)]
;; A visual freeze does not emit a sustained audio sample.
(when (and child length (pos? speed))
(let [source (node/then-time m (clip/source-time clip sid
(-> n
(assoc-in [:playback :end] :stop)
(update :time dissoc :loop?))))
loop? (or (= end :loop) (get-in n [:time :loop?]))
periods (if loop?
(range (js/Math.floor (/ (to-local source lo) length))
(js/Math.ceil (/ (to-local source hi) length)))
[0])]
(mapcat (fn [period]
(let [cycle (update source :at + (/ (* period length) (:rate source)))]
(walk child cycle [lo hi] (conj path id) (conj seen sid))))
periods))))
nil))))
(sort-by (comp str key) nodes))))]
(let [tracks (walk sid (clip/grid-time clip sid)
[0 (clip/output-frames clip sid)] [] #{})]
(second
(reduce (fn [[seen out] track]
(let [link (:media-link track)
k (when link [link (:source track) (:span track)
(select-keys (:time track) [:at :rate :offset])])]
(if (and k (contains? seen k))
[seen out]
[(cond-> seen k (conj k)) (conj out track)])))
[#{} []] tracks)))))
(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 delete-node
"Take node `id` out of symbol `sid`, with everything hanging off it."
[clip sid id]
(clip/update-symbol clip sid update :nodes #(apply dissoc % (subtree % id))))
(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) p)
js/Float64Array.from))]
(cond
(= host target) {:refused "it is already there"}
(and (= :instance (:kind n))
(some #(clip/contains-symbol? clip % target) (node/sources n)))
{: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-refusal
"Why `move-node` would refuse to move `from` into `to` at frame `f`, or nil.
SAID BEFORE THE DROP, not after it. A drag that reparents has to tell the
person what it would do while they can still change their mind, and the only
honest source for that is the check the command itself makes. Hence one
function, asked by the gesture on the way past and by `move-node` on the way
in.
The one that surprises: BOTH have to be on screen at this frame, because the
move keeps the picture and there is no common frame to keep it at otherwise.
Two clips of one lane never overlap, so nesting one into another there can
never be done — it is a thing to do between symbols, with the playhead
somewhere both of them are showing.
The deeper refusals — generated parts, a stencil parted from what it clips —
belong to the transplant and are only known when it runs."
[clip store open from to f]
(let [here (inside clip store open (pop from) f)
there (inside clip store open to f)
n (get-in clip [:symbols (:sid here) :nodes (peek from)])]
(cond
(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)))
"a held or looping clip has no clock to move through"
(nil? (some-> there :matrix node/invert)) "the target is scaled to nothing"
(= (:sid here) (:sid there)) "it is already there"
(and (= :instance (:kind n))
(some #(clip/contains-symbol? clip % (:sid there)) (node/sources n)))
"a symbol cannot go inside itself")))
(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 node/invert)]
(if-let [why (move-refusal clip store open from to f)]
{:refused why}
(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- down
"Walk row path `path` down from symbol `sid` by structure alone: `{:sid
:time}`, the symbol it leads to and the time map from `sid`'s frames to that
symbol's own, nil through a loop.
`inside` without the frame. Which symbol a row is in and how fast it runs
there are the same on every frame, so asking needs nothing to be on screen;
only a move that keeps the PICTURE needs a frame, for the matrix."
[clip sid path]
(let [;; Structurally, a row leads into a symbol only where it names one:
;; a clip does, and a group holding one does not, so the walk stops at
;; the group rather than picking the drawing showing now — which
;; would make where a row lives depend on the playhead.
only (fn [sid id]
(when sid (node/source (get-in clip [:symbols sid :nodes id]))))
sids (reductions only sid path)
;; Every node on the way, outermost first: each instance, after its
;; parents in the symbol it is in.
maps (mapcat (fn [sid id]
(let [nodes (:nodes (clip/symbol clip sid))
chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))]
(mapcat (fn [n]
(if (get-in n [:time :loop?]) [nil]
(cond-> [(node/time-of n)]
(= :instance (:kind n)) (conj (clip/source-time clip sid n)))))
chain)))
sids path)]
{:sid (last sids)
:time (when (every? some? maps)
(reduce node/then-time node/same-time maps))}))
(defn- dragged
"Frame `from` of node `id`'s own space, dragged `df` frames of the open
symbol: ONE WHOLE FRAME of that space.
THE ONE PLACE A RULER GESTURE BECOMES A FRAME NUMBER, and the whole of it.
`df` counts the open symbol's own frames, which is what the ruler is drawn in,
so for a row of the open symbol itself this is `from + df` and nothing happens
here at all. It earns its keep for a row reached THROUGH a retimed instance,
where one frame of the ruler is a fraction of the node's own: a frame number is
the one thing in a document that cannot fall between two frames —
`span/resize-out`, `resize-in` and `roll` refuse a fractional edge outright,
and `slide` would have let it into `:time :at` and refused every later edge
edit on that clip for ever.
Rounding, not flooring: a drag is a gesture at a position, and the frame it
means is the nearer one in both directions. Nothing else belongs here."
[here nodes id from df]
(let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
rate (:rate (reduce node/then-time (:time here) (map node/time-of chain)))]
(js/Math.round (+ from (* df rate)))))
(defn slide
"Move the node at row path `path` along its symbol's time by `df` frames of
`open`. `{:clip}` or `{:refused why}`.
ONE WRITE TO `:at`, for every node alike: its span, keys and children are in
its own frames and come with it. `df` is carried down into the frames `:at` is
in — the symbol's, through each instance on the way, and its parents' there."
[clip open path df]
(let [here (down clip open (pop path))
id (peek path)
nodes (:nodes (clip/symbol clip (:sid here)))]
(cond
(nil? (get nodes id)) {:refused "nothing to move"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(let [n (get nodes id)
;; Measured from where the node STARTS, so what lands on a whole
;; frame is the thing you can see moving. A node with no span is
;; on screen throughout and only its `:at` moves.
from (or (first (node/placed-span n)) (get-in n [:time :at] 0))
d (- (dragged here nodes id from df) from)
;; MOVE THE MAP THAT IS THERE; write a fresh one only where there is
;; none. The test for "there is one" is `:time` itself, and whether
;; it is the affine kind is `node/mapped-time?` — which an absent
;; `:mode` satisfies, because `node/time-of` has always read it as
;; `:map`. Asking for the key instead said no to every clip
;; `span/held` makes, whose `:time` is `{:at f :rate 1}` and nothing
;; more, and the else branch then REPLACED that map with one built
;; from `d` alone: the first drag of a freshly drawn clip threw away
;; its `:at` and jumped it to the head of the lane.
shift (fn [n]
(if (and (:time n) (node/mapped-time? n))
(update-in n [:time :at] (fnil + 0) d)
(assoc n :time {:mode :map :at d :rate 1})))
moved (assoc nodes id (shift (get nodes id)))
;; An editorial audio link follows a moved picture. Moving or
;; trimming the audio itself remains independent.
moved (if (= :audio (:kind (get nodes id)))
moved
(reduce (fn [ns [audio-id n]]
(if (and (= :audio (:kind n)) (= id (:linked-to n)))
(assoc ns audio-id (shift n))
ns))
moved nodes))]
;; COMMITTED LIKE EVERY OTHER SPAN EDIT. This validated with
;; `symbol/problems` and wrote the nodes in itself, which made it a
;; SECOND commit path — and the one `span/finish`'s docstring says is
;; the only one: "no command can commit an overlap in lane mode, and
;; `symbol/overlaps` turning up anything is a bug in a command rather
;; than a state to design around". It was that bug. A body drag could
;; leave two clips of a lane on screen over the same frames, and from
;; there the lane stops behaving: `symbol/children` has two clips
;; claiming one frame, so which drawing a polygon lands in and whether
;; a boundary can be rolled depend on which of them `some` reaches
;; first. `finish` does the same `problems` check and the overlap one
;; too, so this is less code and one fewer invariant to remember.
(span/claim clip (:sid here) moved id :grow-symbol (random-uuid))))))
(defn slide-many
"Move a selection simultaneously. Lane collisions refuse the entire edit."
[document open paths df]
(let [paths (vec (distinct (filter seq paths)))
entries (mapv (fn [path]
(let [here (down document open (pop path))
id (peek path)
nodes (get-in document [:symbols (:sid here) :nodes])]
{:path path :here here :sid (:sid here) :id id
:nodes nodes :node (get nodes id)})) paths)
roots (remove
(fn [{:keys [path sid id nodes]}]
(some (fn [other]
(or (and (< (count (:path other)) (count path))
(= (:path other) (subvec path 0 (count (:path other)))))
(and (= sid (:sid other)) (not= id (:id other))
(some #{(:id other)} (rest (symbol/lineage nodes id))))))
entries)) entries)]
(if (some #(or (nil? (:node %)) (nil? (get-in % [:here :time]))) roots)
{:refused "selection includes a node without an editable clock"}
(let [changes
(reduce (fn [changes {:keys [here sid id nodes node]}]
(let [from (or (first (node/placed-span node)) (get-in node [:time :at] 0))
d (- (dragged here nodes id from df) from)
shift (fn [n] (update-in n [:time :at] (fnil + 0) d))
ids (cons id (when (not= :audio (:kind node))
(for [[aid n] nodes :when (= id (:linked-to n))] aid)))]
(reduce (fn [out nid] (assoc-in out [sid nid] (shift (get nodes nid)))) changes ids)))
{} roots)]
(reduce (fn [result [sid changed]]
(if (:refused result) (reduced result)
(span/finish (:clip result) sid
(merge (get-in (:clip result) [:symbols sid :nodes]) changed)
nil :grow-symbol)))
{:clip document} changes)))))
(defn resize-out
"Move the right edge of the node at `path` by `df` frames of `open`.
One command either way: in a symbol drawn as a lane `span/resize-out` claims
the time it grows into, and in a composition it is one write to one span. The
mode says which, and nothing here has to ask."
[clip open path df ripple?]
(let [here (down clip open (pop path))
sid (:sid here)
id (peek path)
nodes (:nodes (clip/symbol clip sid))
n (get nodes id)]
(cond
(nil? n) {:refused "nothing to resize"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(span/resize-out clip sid id (dragged here nodes id (second (node/placed-span n)) df)
{:ripple? ripple? :extent :grow-symbol}))))
(defn resize-in
"Move the left edge of the node at `path` by `df` frames of `open`."
[clip open path df]
(let [here (down clip open (pop path))
sid (:sid here)
id (peek path)
nodes (:nodes (clip/symbol clip sid))
n (get nodes id)]
(cond
(nil? n) {:refused "nothing to resize"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(span/resize-in clip sid id (dragged here nodes id (first (node/placed-span n)) df)))))
(defn roll
"Move the shared boundary at `right-path` and the adjacent `left-path`."
[clip open left-path right-path df]
(let [here (down clip open (pop right-path))
sid (:sid here)
left-id (peek left-path)
right-id (peek right-path)
nodes (:nodes (clip/symbol clip sid))
right (get nodes right-id)]
(cond
(or (not= (pop left-path) (pop right-path)) (nil? right))
{:refused "a rolling edit needs adjacent clips in one sequence"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(span/roll clip sid left-id right-id
(dragged here nodes right-id (first (node/placed-span right)) df)))))
(defn restack
"Put the node at row path `from` just in front of the one at `to` when
`front?`, or just behind it — side by side in one symbol, as the timeline lists
them. `{:clip :sid :id}` or `{:refused why}`.
ONE WRITE TO `:z`, between the two it lands between, so nothing else is
renumbered. Among the nodes that share its parent, because that is what `:z`
orders; a roto part's parent is the rig, and it restacks within that."
[clip open from to front?]
(let [{sid :sid} (down clip open (pop to))
nodes (:nodes (clip/symbol clip sid))
n (get nodes (peek from))
t (get nodes (peek to))
z #(or (:z %) "")
zs (->> nodes
(keep (fn [[k m]] (when (and (= (:parent m) (:parent t)) (not= k (peek from)))
(z m))))
sort)]
(cond
(not= (pop from) (pop to)) {:refused "only things side by side can be restacked"}
(or (nil? n) (nil? t)) {:refused "nothing to restack"}
(not= (:parent n) (:parent t)) {:refused "they hang off different parents"}
:else
{:sid sid
:id (peek from)
:clip (clip/update-symbol
clip sid assoc-in [:nodes (peek from) :z]
(if front?
(symbol/z-between (z t) (first (filter #(pos? (compare % (z t))) zs)))
(symbol/z-between (last (filter #(neg? (compare % (z t))) zs)) (z t))))})))
(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. It stores no pivot: an
instance turns about the middle of what it draws at the moment it is dragged,
so this cannot leave one behind when the group's contents are edited later."
[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 (or (clip/frames clip (node/source n)) 0)])))
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) :fps (clip/fps clip host)
: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)]
moved))))
;; ---------------------------------------------------------------------------
;; pegs
(defn peg
"Put a PEG over the node at row path `path`: a free `:group` between it and
whatever it hangs off now, sitting on the pivot the node has at frame `f`.
`{:clip :sid :id}` or `{:refused why}`.
WHAT A PEG IS FOR, NOW THAT A NODE HAS ITS OWN PIVOT. `[:xform :pivot]` is how
ONE node turns about a point of its own — that is `node/local!`, it needs no
parent, and it is right between two keys. A peg is for the three things that
are about MORE THAN ONE NODE, or about a node whose channels are not yours to
write:
A PIVOT SHARED BETWEEN NODES. An arm and a forearm turning about one shoulder
is one transform driving two drawings, and two pivots that have to agree
frame for frame are not that. The peg is the shoulder, and they hang off it.
A SECOND TRANSFORM ON ONE NODE. A drawing turning about its own middle while
the whole limb swings about the shoulder is two rotations, and a node has one
`rot`. Toon Boom stacks pegs for exactly this.
A HAND TRANSFORM OVER A MEASURED ONE. `gesture/refusal` turns a drag on a
measured node away because the next regenerate would discard it. A peg's
channels are its own, so the hand transform composes OUTSIDE the measured one
and the measurement stays regenerable. Resolve publishes a track and parents a
transform to it; Harmony puts a peg over the drawing. Same shape.
The node's own pivot is NOT one of them, and that is the correction: a peg used
to be the only pivot there was, so making one was the answer to \"this turns
about the wrong point\" — which is a thing to drag a cross for, not a node to
create. See `xform-paths`.
NOTHING MOVES, and that is `:pinv`'s whole job — Blender's parent-inverse, the
same field `transplant` writes for the same reason. The peg takes the node's
place in the hierarchy, inheriting its `:parent` and its `:pinv`; the node hangs
off the peg with `T(-c)` as its own, so
... · pinv · T(c) · T(-c) · local = ... · pinv · local
to the bit. The node's channels are untouched, which is what lets this work on a
measured node at all — and what lets the node keep its own pivot, which is in
its own coordinates and therefore says nothing about who its parent is.
THE PEG TAKES THE NODE'S `:z`, so draw order is unchanged: a parent's z path is
a prefix of its child's, so the node now sorts at `[… z z]` where it sorted at
`[… z]`, and against any sibling the comparison is decided at the same place it
was before. It takes no `:time` and no `:span`: an identity time map leaves the
node's own frames exactly as they were, and a peg with no span is simply always
there, so what is on screen when does not change either."
[clip store open path f uuid]
(let [{:keys [sid id frame]} (placement clip store open path f)
n (when sid (get-in clip [:symbols sid :nodes id]))]
(cond
(nil? n) {:refused "it is not on screen at this frame"}
(= :audio (:kind n)) {:refused "a sound has no transform to pivot"}
(contains? (:nodes (clip/symbol clip sid)) uuid) {:refused "that id is taken"}
:else
(let [c (gesture/pivot (gesture/values n frame store)
((pick/bounds-of clip store sid n) frame))]
{:sid sid
:id uuid
:clip (clip/update-symbol
clip sid update :nodes
(fn [nodes]
(-> nodes
(assoc uuid (cond-> {:id uuid :kind :group
:name (str (clip/node-label clip id n) " peg")
:parent (:parent n)
:z (:z n)
:channels {[:xform :pos] (ch/framed c)}}
(:pinv n) (assoc :pinv (:pinv n))))
(update id assoc
:parent uuid
:pinv (vec (array-seq
(node/local! (node/mat) (mapv - c) [0 0] 0 [1 1] [0 0])))))))}))))