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

An anchor is a peg

Browse source 
`[:xform :anchor]` is deleted. `T(a)·M·T(-a)` is a transform conjugated by a
translation — "do M in a frame shifted by a" — and a parent already IS a shifted
frame, so an anchor was a peg written inline: one that could not be selected,
keyed, shared between nodes, or placed above a measured channel. Same expressive
content, strictly less reach. `node-test` asserts the two produce the same matrix.

Its two jobs split, and neither is a field on a node any more.

A pivot nobody chose is DERIVED PER DRAG and stored nowhere. `gesture/pivot` is
the middle of what the node draws — `pick/bounds-of`, the same call the stage
draws the selection box from, on the same frame — or the node's own origin when it
draws nothing. `gesture/about` solves for the position that holds that point
still, so a turn now writes `pos` as well as `rot`. Nothing is cached, so nothing
goes stale: the stored anchor was that same middle captured once at creation while
the box beside it was recomputed every render, so on anything edited since it was
made the cross and the box disagreed and the pivot was wrong. A symbol with more
than one node diverged on its first edit.

A pivot somebody chose is a PEG — `nest/peg`, an ordinary `:group` parent sitting
on the derived pivot with `:pinv` captured so nothing moves. It is the answer to
the three things a derived pivot cannot do: a pivot that persists (an arm about
its shoulder), a pivot that travels (a keyed `pos`), and a hand transform over a
measured one. The last was impossible before — `local`'s translation is
`pos − M·a`, so under a measured `M` writing an anchor moves the thing it was
meant to leave alone. `flow/freeze`'s `pivoted` pass knew this and skipped every
`node/measured?` node, which is exactly why the traced mouth pivoted about
(-234, -395) on a 320x200 stage: the top-left corner of the footage. That pass is
gone; there is no node a derived pivot can be missing from.

`demo/stage` is the one place the anchor did work a static `pos` cannot: `:scale`
is keyed, and the source's middle has to stay on its authored centre throughout.
It is now seven pegs, identical to the pixel.

Also: `events/ui`'s `fitted` rescales a dropped tracing right after placement, and
the anchor had been silently keeping the picture centred through that; it solves
for the middle explicitly now.

Schema 7. Nothing is converted, as in 6: every project is marked 7 and one still
carrying an anchor is refused by name, with what to do about it. Dropping an
anchor is pixel-exact wherever rotation and scale are the identity — everywhere a
freeze or a drop wrote one — but not on anything since turned by hand, and not at
all where `pos` is dense, so a conversion would be silent and wrong for exactly
the nodes somebody had placed themselves.

601 CLJS tests, 68 Django tests, and the onion and take browser suites pass.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01HkinzDz1VtahZVsujAGRBD
This commit is contained in:
Your Name 2026-10-05 19:12:16 -04:00
parent a6b6c116c6
commit 925c12fc77
25 changed files with 1009 additions and 429 deletions
Download patch file Download diff file Expand all files Collapse all files

74
frontend/src/arthur/demo/stage.cljs
View file

@ -6,8 +6,12 @@
(def layout (reader/read-string (rc/inline "arthur/demo/stage_8625.edn")))
(defn- position-track [center anchor drift phase frames]
(let [base (mapv - center anchor)
(defn- position-track
"Where the peg sits over time: its `center` plus a slow two-axis drift. The
peg's own position, so the stage point the face is pinned to is what moves —
not an offset that has to be kept in step with a changing scale."
[center drift phase frames]
(let [base center
[dx dy] drift
wave (fn [f period] (js/Math.sin (* 2 js/Math.PI (/ (+ f phase) period))))
x0 (wave 0 96)
@ -22,6 +26,10 @@
(defn compose
"The authored layout plus a source clip -> the composed stage document.
A PEG'S IDENTITY IS AUTHORED TOO, beside its instance's, for the reason the
instance's is: `compose` is a pure function of the layout, so a generated one
would make the same stage a different document on every call.
AN INSTANCE IS KEYED BY ITS :uuid, not by the authored id. The authored id
(`:left`, `:voice-right`) is a handle for reading the EDN and for the
`:linked-to` written there; it does not appear in the document this returns.
@ -35,7 +43,9 @@
question from which drawing that is."
[source]
(let [{:keys [name width height frames symbol instances audio scale]} layout
default-anchor (or (:anchor layout)
;; Which point of the SOURCE is pinned to the stage `:center`. Its
;; middle, unless the layout says otherwise for an off-centre drawing.
default-origin (or (:origin layout)
[(/ (:width source) 2) (/ (:height source) 2)])
original (get-in source [:symbols :main])
;; Authored id -> uuid, so the `:linked-to` in the EDN resolves to the
@ -47,20 +57,54 @@
(throw (ex-info "the stage layout names an instance that is not there"
{:in what :id id
:known (vec (sort-by str (keys by-id)))}))))
;; EVERY PLACEMENT IS A PEG AND AN INSTANCE, and this layout is what
;; makes the pair necessary rather than tidy. `:scale` is KEYED — the
;; faces pulse — and it has to happen about the point the face is pinned
;; to. A stored `[:xform :anchor]` used to buy that: a static position
;; and a moving scale, turning about a fixed point. No static position
;; can do it alone, because `T(pos)·S(k(f))` moves the source's middle
;; whenever `k` changes, so holding it still would mean keying `pos` in
;; lockstep with `scale` — two channels that have to agree frame for
;; frame, which is the thing channels exist to avoid.
;;
;; A peg does it with neither:
;;
;; peg pos = center (+ drift), scale = k(f)
;; └ face pos = -origin
;;
;; world = T(center)·S(k(f))·T(-origin)
;;
;; which takes `origin` to `center` for EVERY k, with nothing keyed that
;; was not keyed before. That is the same matrix the anchor produced —
;; `node-test` asserts the identity — and it is reachable, keyable and
;; selectable, which the anchor was not.
;;
;; THE PEG IS THE PLACEMENT: it carries WHERE (pos, scale) and WHEN
;; (`:at`, `:span`), and the face under it carries only which drawing and
;; the offset to its origin. The time map has to be the peg's, because
;; `:scale` is read in the placement's own frames — that is what staggers
;; the entrances' growth — and `:span` goes with it so that
;; `node/placed-span` still answers where the placement sits on the stage.
;; The face then reads its peg's frames as its own and shows whenever the
;; peg does.
nodes (into
{:root {:id :root :name "stage" :kind :group :z "a1"}}
(map (fn [{:keys [uuid name z span at center anchor drift phase]}]
(let [anchor (or anchor default-anchor)]
[uuid {:id uuid :name name :kind :instance
:parent :root :z z :span span
:time {:mode :map :at at :rate 1}
:source {:symbol symbol}
:channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor)))
[:xform :anchor] {:animated? false :value anchor}
[:xform :scale] scale}}]))
instances))
(mapcat (fn [{:keys [uuid peg name z span at center origin drift phase]}]
(let [origin (or origin default-origin)]
[[peg {:id peg :name name :kind :group
:parent :root :z z :span span
:time {:mode :map :at at :rate 1}
:channels {[:xform :pos]
(if drift
(position-track center drift phase frames)
(ch/framed center))
[:xform :scale] scale}}]
[uuid {:id uuid :name (str name " face") :kind :instance
:parent peg :z "a1"
:source {:symbol symbol}
:channels {[:xform :pos]
(ch/framed (mapv - origin))}}]]))
instances))
nodes (into nodes
(map (fn [{:keys [uuid linked-to z source span at gain pan]}]
[uuid {:id uuid :kind :audio :parent :root :z z

14
frontend/src/arthur/demo/stage_8625.edn
View file

@ -6,8 +6,11 @@
:symbol :sym/face-8625
:name "8625 stage study"
:width 320 :height 200 :frames 280
;; Each :center below places the source clip's center on the stage. A symbol
;; can author :anchor to override that default for an off-center drawing.
;; Each :center below places the source clip's center on the stage; :origin
;; overrides which point of the source that is, for an off-centre drawing.
;; :peg is the identity of the transform node the placement hangs off — it
;; carries :center and :scale, the face below it carries -:origin, and that pair
;; is what makes a KEYED scale happen about the pinned point. See demo/stage.
;; Each placement reads this pulse in its own local time, so the staggered
;; entrances start their growth at different moments on the master timeline.
:scale {:animated? true :interp :linear
@ -50,30 +53,37 @@
;; uuid. Nothing downstream of `compose` sees the authored id.
:instances
[{:id :left :uuid #uuid "ee7321c8-faf1-46d7-8029-37771898accb"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f01"
:name "8625 left" :z "a1"
:at 0 :span [0 280]
:center [40 40] :drift [3 2] :phase 0}
{:id :right :uuid #uuid "1aa0da78-b4ed-4bb6-8d70-b09a3ec5e2c3"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f02"
:name "8625 right" :z "a2"
:at 48 :span [0 232]
:center [120 40] :drift [-3 2] :phase 17}
{:id :top-third :uuid #uuid "23bb697d-eba7-4af6-a86c-606c50107088"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f03"
:name "8625 top third" :z "a5"
:at 24 :span [0 256]
:center [200 40] :drift [2 -3] :phase 31}
{:id :top-fourth :uuid #uuid "f4f0241d-026e-4e50-9bea-a4ccde896d8a"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f04"
:name "8625 top fourth" :z "a6"
:at 72 :span [0 208]
:center [280 40] :drift [-2 -2] :phase 49}
{:id :bottom-left :uuid #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f05"
:name "8625 bottom left" :z "a7"
:at 96 :span [0 184]
:center [70 135] :drift [3 -2] :phase 63}
{:id :bottom-middle :uuid #uuid "63f3fb32-9e94-4d68-a1c2-12e6de2d04b5"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f06"
:name "8625 bottom middle" :z "a8"
:at 120 :span [0 160]
:center [160 135] :drift [-2 3] :phase 81}
{:id :bottom-right :uuid #uuid "fa338701-cb21-4d45-89f1-a5e706f045ec"
:peg #uuid "b1e0a7c4-5f3d-4a8e-9c21-70e4d1a90f07"
:name "8625 bottom right" :z "a9"
:at 144 :span [0 136]
:center [250 135] :drift [2 2] :phase 107}]}

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

@ -589,10 +589,13 @@
that draws nothing gets the STAGE's middle, which is where a drawing made into
it will be, because drawings are made on the stage.
What this feeds is a DEFAULT: `place-symbol` copies it into a new instance's
anchor and nothing ever updates it, as Flash's transformation point and After
Effects' anchor point are set once and left. A symbol that grows later keeps
its instances' pivots where they were, so nothing on screen moves."
WHERE A DROP LANDS, and nothing else any more. It used to be copied into each
new instance's anchor as a pivot default, which made it a cache of a derived
value that nothing invalidated — so a symbol edited afterwards kept its
instances pivoting about where its drawing had been. Pivots are derived per
drag now and there is nothing to keep in step; see `domain/gesture`. What is
left is positional: `place-symbol` puts this point under the pointer, and
`ui/drag`'s ghost draws the cross there so a drop lands where it was aimed."
[clip store sid]
(let [resolve (resolver clip sid store pal/index-of {:grid-fps (fps clip sid)})
bounds (fn [[x0 y0 x1 y1 :as b] x y]
@ -615,12 +618,12 @@
(defn place-symbol
"An instance of symbol `sid`, inside symbol `host`, at `frame` of `host`.
THE ANCHOR IS THE MIDDLE. Every instance pivots about the centre of what it
draws — see `center` — so rotating or scaling one turns it in place rather than
swinging it about a corner. At the identity transform the anchor moves nothing,
so where the drawing lands is `pos` alone: with `point`, a stage pixel, the
middle goes there; without one — a drop on the timeline — the drawing stays
where it was drawn.
THE MIDDLE GOES UNDER THE POINTER. `center` says where the symbol's drawing
sits in its own coordinates, and `pos` is set so that point lands on `point`, a
stage pixel; without one — a drop on the timeline — the drawing stays where it
was drawn. No pivot is stored: an instance turns about the middle of what it
draws at the moment it is dragged, so editing the symbol afterwards cannot
leave a pivot behind. See `domain/gesture`.
THE UUID IS AN ARGUMENT. An instance's identity is the key it has in the node
map — it is what `:linked-to`, an export target and a saved leaf all name — so
@ -653,9 +656,8 @@
:time {:mode :map :at frame :rate 1}
:source {:symbol sid}
:playback {:in 0 :speed 1 :end :stop}
:channels {[:xform :pos] {:animated? false
:value (if point (mapv - point middle) [0 0])}
[:xform :anchor] {:animated? false :value middle}}})))))
:channels {[:xform :pos] {:animated? false
:value (if point (mapv - point middle) [0 0])}}})))))
(defn place-sound
"Place a sound at host frame `frame`. Its span uses `source`'s fps when

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

@ -7,6 +7,21 @@
is in the placement's matrices, so a shape five symbols down moves under the
pointer like one on top.
A PIVOT IS A FACT ABOUT A DRAG, NOT A FIELD ON A NODE, and that is the whole
reason `[:xform :anchor]` is gone. Turning about a point other than the node's
origin needs no stored anchor: it is one equation, `about` below, for the `pos`
that holds the chosen point still — and a turn therefore writes `pos` AND
`rot`, where it used to write `rot` alone and lean on a stored anchor to place
the result. Nothing is cached, so nothing goes stale when the drawing is
edited, which is exactly what the stored anchor could not manage: it was the
centre of what the node drew, captured once at creation, and the stage drew the
selection box from the live centre right beside it.
WHERE THE PIVOT COMES FROM is the caller's, and `ui/stage` has one rule: the
middle of what the node draws, or its own origin when it draws nothing. A peg
draws nothing, so a peg turns about where it was put — which is what makes a
peg the way to keep a pivot, key one, or have one over a measured transform.
The normal keying rule is `node/set-channel`, the inspector's: a channel with
keys gets one on the node's own frame, and one without has its one value
changed. Auto-key deliberately replaces that rule with `set-keyed-channel`,
@ -27,7 +42,7 @@
[n f store]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f store)
xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
{:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
{:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :skew (xy :skew)}))
(defn- measured-channel? [n path]
(let [c (get-in n [:channels path])]
@ -38,48 +53,137 @@
accept authored correction layers; measured scale cannot yet be decomposed
safely. The one-argument form asks whether any stage gesture is possible."
([n] (when (node/measured? n)
"its transform is measured — use a correction or place the instance it is in"))
"its transform is measured — use a correction, or put a peg over it"))
([n kind]
(when (and (= :scale kind) (measured-channel? n [:xform :scale]))
"its scale is measured — place the instance it is in")))
"its scale is measured — put a peg over it and scale that")))
(defn- through [m [x y]]
(let [out (js/Float64Array. 2)]
(node/apply-pt! out 0 m x y)
[(aget out 0) (aget out 1)]))
(defn linear
"The node's own linear part, `R(rot)·K(skew)·S(scale)`, as a 2x3 whose
translation is zero — so putting a point through it applies the rotation, skew
and scale and nothing else. `node/local!` with a zero `pos` rather than a
second closed form, so there is one place the decomposition is written out."
[{:keys [rot scale skew]}]
(node/local! (node/mat) [0 0] rot scale skew))
(defn local-of
"The node's whole local transform, `T(pos)·R·K·S` — what takes a point in the
node's own coordinates to its parent's."
[{:keys [pos rot scale skew]}]
(node/local! (node/mat) pos rot scale skew))
(defn about
"The `pos` that keeps parent-space point `c` still while the node's linear part
changes from `v`'s to `v'`'s. Nil when `v`'s is singular — a node scaled to
nothing has no point under `c` to hold.
THE ONE EQUATION a pivot needs, and it replaces the stored anchor outright.
Local is `T(p)·M`. The material point sitting under `c` is `q = M⁻¹(c − p)`,
and holding it there under the new `M'` is
p' = c − M'·q = c − M'·M⁻¹·(c − p)
Checkable at both ends it has to be right at: with `c` the node's own origin,
`c = p`, so `q = 0` and `p' = p` — turning about yourself never moves you. And
for a pure turn, `M' = R(da)·M`, so `M'·M⁻¹ = R(da)` and `p' = c + R(da)(p − c)`,
which is the familiar rotation of `p` about `c`.
This is also why an anchor was never needed: `T(p)·T(a)·M·T(-a)` is this same
identity with `a` as the pivot, solved once at creation and then stored. Solving
it per drag costs one matrix inverse and keeps no state to be invalidated."
[v v' c]
(let [m (linear v)]
(when-let [inv (node/invert m)]
(let [q (through inv (mapv - c (:pos v)))]
(mapv - c (through (linear v') q))))))
(defn pivot
"The parent-space point a drag on this node turns and scales about: the middle
of `bounds` — what it draws, in its own coordinates — through its own
transform, or its own origin when it draws nothing.
ONE RULE FOR SHAPES AND PEGS ALIKE, which is what makes a peg the answer for a
pivot rather than a second mechanism beside one. A `:group` draws nothing, so
`bounds` is nil, so this is its `pos`: a peg turns about where it was put. That
is Toon Boom's rule, and it is the whole of why a peg can hold a pivot that an
anchor could not — the peg's `pos` is an ordinary channel, so it can be keyed,
dragged, and sit above a measured transform.
A shape turns about the middle of the box the stage draws round it, and that is
the same `pick/bounds-of` on the same frame rather than a value that agrees with
it by hand: the box and the cross cannot drift apart, because they are one
computation."
[v bounds]
(let [[x0 y0 x1 y1] bounds]
(through (local-of v)
(if bounds [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)] [0 0]))))
(defn move
"The node's position with its pivot carried from stage point `p0` to `p1`."
"The node's position with the drag carried from stage point `p0` to `p1`."
[{:keys [parent]} {:keys [pos]} p0 p1]
(when-let [inv (node/invert parent)]
{[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))}))
(defn angle
"The angle of stage point `p` about the node's pivot, in the space its
rotation is in."
[{:keys [parent]} {:keys [pos anchor]} p]
"The angle of stage point `p` about parent-space pivot `c`, in the space the
node's rotation is in."
[{:keys [parent]} c p]
(when-let [inv (node/invert parent)]
(let [[x y] (mapv - (through inv p) (mapv + pos anchor))]
(let [[x y] (mapv - (through inv p) c)]
(js/Math.atan2 y x))))
(defn turn
"The node's rotation, turned by `da` radians."
[{:keys [rot]} da]
{[:xform :rot] (+ rot da)})
"The node turned by `da` radians about parent-space point `c`: the rotation,
and the position that holds `c` still.
TWO CHANNELS, where this used to write one. The second is not a correction
applied afterwards — it is what makes the turn happen about `c` at all, and
with no stored anchor there is nothing else for it to come out of."
[v c da]
(let [v' (update v :rot + da)]
(cond-> {[:xform :rot] (:rot v')}
c (into (when-let [p (about v v' c)] {[:xform :pos] p})))))
(defn scale
"The node's scale with the point under stage `p0` taken to `p1`, about its
pivot, along its own axes — or by the same factor on both when `uniform?`."
[{:keys [world]} {:keys [anchor] s :scale} p0 p1 uniform?]
(when-let [inv (node/invert world)]
(let [a (mapv - (through inv p0) anchor)
b (mapv - (through inv p1) anchor)
k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a)))
r (if uniform?
(let [aa (reduce + (map * a a))]
(if (< aa 1e-9) 1 (/ (reduce + (map * a b)) aa)))
nil)]
{[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))})))
"The node's scale with the point under stage `p0` taken to `p1`, about
parent-space pivot `c`, along the node's own axes — or by the same factor on
both when `uniform?` — and the position that holds `c` still.
The factors are measured in the node's OWN coordinates, which is what makes a
corner drag track the pointer on a node that has been turned."
[{:keys [world]} v c p0 p1 uniform?]
(when-let [winv (node/invert world)]
(when-let [minv (node/invert (linear v))]
(let [q (through minv (mapv - c (:pos v)))
a (mapv - (through winv p0) q)
b (mapv - (through winv p1) q)
k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a)))
r (when uniform?
(let [aa (reduce + (map * a a))]
(if (< aa 1e-9) 1 (/ (reduce + (map * a b)) aa))))
s (:scale v)
s' (if r (mapv #(* r %) s) (mapv * s (map k a b)))
v' (assoc v :scale s')]
(cond-> {[:xform :scale] s'}
c (into (when-let [p (about v v' c)] {[:xform :pos] p})))))))
(defn scale-by
"The node scaled by factor `k` on both axes about parent-space point `c`, and
the position that holds `c` still.
What a MULTI-SELECTION scales by: one factor for everything about the shared
box, so a group of shapes keeps its arrangement instead of each member solving
for its own factors. `scale` is the single-node form, where the factors come
out of the pointer in the node's own axes."
[v c k]
(let [v' (update v :scale #(mapv (partial * k) %))]
(cond-> {[:xform :scale] (:scale v')}
c (into (when-let [p (about v v' c)] {[:xform :pos] p})))))
(def ^:private manual-layer ::manual-transform)

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

@ -18,9 +18,12 @@
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]
(: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]))
@ -601,8 +604,9 @@
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."
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)
@ -633,7 +637,81 @@
(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)))))))
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}`.
A PEG IS WHAT AN ANCHOR WAS, REACHABLE. `T(a)·M·T(-a)` — a transform conjugated
by a translation — is \"do M in a frame shifted by `a`\", and a parent already IS
a shifted frame; `node-test` asserts the two produce the same matrix. So the
stored anchor was a peg that could not be selected, keyed, shared, or placed
over a measured channel, and this is the same capability with none of those
restrictions. It is the answer to all three things a derived pivot cannot do:
A PIVOT THAT PERSISTS. A gesture's pivot is the middle of what the node draws
and lives for one drag. An arm that turns about its shoulder wants a pivot
that outlasts the drag and is nowhere near the middle, and it wants it on
every frame, not re-derived per drag.
A PIVOT THAT IS KEYED. The peg's `pos` is an ordinary channel, so a pivot
that travels — a foot roll — is a keyed position. An anchor could only have
been keyed against `pos`, which is interpolated in the same breath, and the
two would have had to agree frame for frame.
A HAND TRANSFORM OVER A MEASURED ONE. This is the one that was impossible.
`gesture/refusal` turns a drag on a measured node away because the next
regenerate would discard it, and an anchor written onto one would move the
thing it was meant to leave alone — `node/local!`'s translation is
`pos − M·a`, and under a measured `M` that is not the identity. 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.
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.
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 [1 1] [0 0])))))))}))))

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

@ -28,11 +28,22 @@
(def xform-paths
"In composition order, which is also the order they have to be sampled in.
:skew and :anchor are in here although nothing drives either yet. A
decomposition is not extensible after the fact: adding a component later means
migrating every stored transform, so both are in the shape and in the
composition order from the start."
[[:xform :pos] [:xform :rot] [:xform :scale] [:xform :skew] [:xform :anchor]])
:skew is in here although nothing drives it yet. A decomposition is not
extensible after the fact: adding a component later means migrating every
stored transform, so it is in the shape and in the composition order from the
start.
THERE IS NO :anchor, and that is a deletion rather than an omission. An anchor
is `T(a)·M·T(-a)` — the conjugation of a transform by a translation, which is
to say \"do M in a frame shifted by a\" — and a PARENT ALREADY IS A SHIFTED
FRAME. So an anchor is a peg that cannot be addressed, cannot be keyed, cannot
be shared between nodes, and cannot be put above a measured channel, which is
exactly where a pivot is most needed. Same expressive content, strictly less
reach. What it used to do, two mechanisms now do properly: `domain/gesture`
turns and scales about a point computed at the moment of the drag and stores
nothing, and a peg — an ordinary `:group` parent — carries a pivot that has to
persist, be keyed, or sit over a measured transform. See docs/animation-model.md."
[[:xform :pos] [:xform :rot] [:xform :scale] [:xform :skew]])
(def valid-paths
"The set of valid channel paths follows from the node's :kind, and that is a
@ -67,7 +78,6 @@
[:xform :rot] (ch/framed 0.0)
[:xform :scale] (ch/framed [1.0 1.0])
[:xform :skew] (ch/framed [0.0 0.0])
[:xform :anchor] (ch/framed [0.0 0.0])
[:vis] (ch/framed true)})
(def audio-defaults
@ -87,13 +97,14 @@
(defn measured?
"Is this node's transform regenerated from the footage rather than authored?
ONE PREDICATE, TWO CALLERS, and they are the same question asked twice: a hand
edit to a measured transform is thrown away by the next regenerate, which is
what `gesture/refusal` refuses — and a DEFAULT written under one is worse than
useless, which is what `flow/freeze`'s pivot pass declines to do. A node a hand
cannot transform has no use for a pivot, and at a measured scale an anchor does
not cancel out of `local!` the way it does at the identity, so writing one
would move the very thing it was meant to leave alone."
What it guards is that a hand edit to a measured transform is thrown away by
the next regenerate, which is what `gesture/refusal` refuses. The way to
transform one of these by hand is a PEG above it: the hand transform is then on
a node of its own and the measured channels underneath are left to be
regenerated. Nothing has to be written onto the measured node at all, which is
what the old pivot default could never manage — an anchor under a measured
scale does not cancel out of `local!`, so writing one moved the very thing it
was meant to leave alone."
[n]
(boolean (some #(let [c (get-in n [:channels [:xform %]])]
(or (:dense c) (:generated c)))
@ -352,10 +363,10 @@
dest))
(defn local!
"dest := T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor)
"dest := T(pos) · R(rot) · K(skew) · S(scale)
Written out closed-form rather than as five matrix products, because this runs
per node per frame and the five products would each allocate. The derivation,
Written out closed-form rather than as four matrix products, because this runs
per node per frame and the four products would each allocate. The derivation,
so the constants are checkable rather than trusted:
R·K·S = | c -s | · | 1 kx | · | sx 0 |
@ -367,32 +378,28 @@
R·K·S = | sx(c - s·ky) sy(c·kx - s) |
| sx(s + c·ky) sy(s·kx + c) |
and the translation is anchor + pos - M·anchor, which is what makes rotation
and scale happen ABOUT the anchor. :anchor is Flash's registration point and
Blender's origin, and getting it wrong is why hand-placed parts swing rather
than turn.
and the translation is pos itself, because rotation and scale happen about the
node's OWN ORIGIN and nothing else. Turning about any other point is
`gesture/about`, which solves for the `pos` that holds the chosen point still
and writes it alongside the rotation — so a pivot is a fact about a drag rather
than a field on a node, and there is no stored pivot to go stale. A pivot that
has to outlive a drag is a peg: see `xform-paths`.
:skew is stored as shear FACTORS, not angles — kx is x gained per unit y — so
that the identity is 0 and a decomposition round-trips without a tangent."
[^js dest pos rot scale skew anchor]
[^js dest pos rot scale skew]
(let [c (js/Math.cos rot)
s (js/Math.sin rot)
sx (ch/component scale 0)
sy (ch/component scale 1)
kx (ch/component skew 0)
ky (ch/component skew 1)
ax (ch/component anchor 0)
ay (ch/component anchor 1)
a (* sx (- c (* s ky)))
b (* sx (+ s (* c ky)))
cc (* sy (- (* c kx) s))
d (* sy (+ (* s kx) c))]
(aset dest 0 a)
(aset dest 1 b)
(aset dest 2 cc)
(aset dest 3 d)
(aset dest 4 (+ ax (ch/component pos 0) (- (+ (* a ax) (* cc ay)))))
(aset dest 5 (+ ay (ch/component pos 1) (- (+ (* b ax) (* d ay)))))
ky (ch/component skew 1)]
(aset dest 0 (* sx (- c (* s ky))))
(aset dest 1 (* sx (+ s (* c ky))))
(aset dest 2 (* sy (- (* c kx) s)))
(aset dest 3 (* sy (+ (* s kx) c)))
(aset dest 4 (ch/component pos 0))
(aset dest 5 (ch/component pos 1))
dest))
(defn pinv
@ -479,6 +486,10 @@
(not (and (finite-number? (get-in n [:time :rate]))
(pos? (get-in n [:time :rate])))))
(conj ":time :rate must be positive")
(contains? (:channels n) [:xform :anchor])
(conj (str ":anchor is gone — a pivot nobody chose is derived from what "
"the node draws, and a pivot to keep is a peg over it; "
"edit > add peg, then turn and key that"))
(nil? (:z n)) (conj "no :z — draw order is authored per scene, not implied by the tree")
(and (:span n) (not (and (vector? (:span n)) (= 2 (count (:span n)))
(every? finite-number? (:span n))
@ -491,9 +502,15 @@
(or (empty? hs) (apply < hs))))))
(conj ":time :holds must be a vector of increasing frames"))
;; `[:xform :anchor]` is excluded because it has a NAMED refusal above.
;; It is the one invalid path a stored document is likely to carry — every
;; schema-6 drawing and placement had one — so "not valid on a :poly node"
;; would be the first thing a person saw, and it says nothing about what to
;; do. The precedent is `symbol/problems`' refusal of `:trace`.
(into (when valid
(for [[path _] (:channels n)
:when (not (contains? valid path))]
:when (and (not (contains? valid path))
(not= path [:xform :anchor]))]
(str "channel " (pr-str path) " is not valid on a " k " node"))))
(into (for [[path c] (:channels n)

12
frontend/src/arthur/domain/paint.cljs
View file

@ -25,13 +25,13 @@
{:id id :name (str "shape " (inc (count (shapes clip sid))))
:kind :poly :paint? true :parent nil :z z
:span [frame end]
;; No pivot is written, and none is needed: a drawing turns
;; and scales about the middle of what it draws NOW, which
;; `ui/stage` derives per drag. The anchor this used to store
;; was the middle of the FIRST key's points, so a drawing that
;; travelled or was redrawn pivoted about where it had once been.
:channels {geometry (channel/keyed {frame points} :hold)
[:style :color] (channel/framed color)
;; Turned and scaled about its middle, as a placed
;; symbol is: set once here and never followed.
[:xform :anchor]
(channel/framed (mapv (fn [vs] (/ (+ (apply min vs) (apply max vs)) 2))
[(take-nth 2 points) (take-nth 2 (rest points))]))}})
[:style :color] (channel/framed color)}})
clip)))
(defn add-key [clip sid id frame]

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

@ -134,14 +134,6 @@
(subvec hit 0 (inc (count selected)))
selected))
(defn- union
"The smaller box around both, either of which may be nil."
[a b]
(cond (nil? a) b
(nil? b) a
:else (let [[ax0 ay0 ax1 ay1] a [bx0 by0 bx1 by1] b]
[(min ax0 bx0) (min ay0 by0) (max ax1 bx1) (max ay1 by1)])))
(defn bounds-of
"A closure from a frame to `[x0 y0 x1 y1]` around what node `n` draws on it, in
its own coordinates — nil on a frame it draws nothing on.
@ -149,8 +141,13 @@
A CLOSURE, as `clip/resolver` is, and for the same reason it is: inside an
instance is its whole symbol resolved at that frame, and a resolver costs the
symbol to BUILD and a lookup to RUN. Asking frame by frame through a fresh one
is a resolver per frame, which is what made `pivot` want a separate path for
instances rather than the one walk it is."
is a resolver per frame.
WHAT A SELECTION BOX IS DRAWN FROM, and now also what a gesture pivots about —
the two were the same quantity all along, computed in two places at two times.
The box came from here on every render and the pivot from a value stored at
creation, so they drifted apart the moment anything was edited, which is what
made a pivot on anything beyond one unchanging shape wrong. See `domain/gesture`."
[document store sid n]
(let [grow (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
@ -201,22 +198,3 @@
(let [s (at f [:geom :size])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h]))))
(constantly nil))))
(defn pivot
"The middle of everything node `n` draws over its own frames `fs`, in its own
coordinates — where it should turn and scale about. Nil for a node that draws
nothing on any of them.
`clip/center`'s rule, for a NODE rather than a symbol, and the same rule
`clip/place-symbol` and `paint/new-shape` already set theirs by. A node left
without one pivots about its own coordinate ORIGIN, and an origin is not a
middle: traced geometry is in the footage's normalised space, whose origin is
the top-left corner of the IMAGE, so the pivot lands hundreds of stage pixels
off the stage and a corner drag slides the shape about instead of resizing it.
ALL its frames, not the first, for the reason `clip/center` says: a mouth that
opens and travels still has its middle where the mouth is."
[document store sid n fs]
(let [bounds (bounds-of document store sid n)]
(when-let [[x0 y0 x1 y1] (reduce #(union %1 (bounds %2)) nil fs)]
[(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])))

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

@ -29,7 +29,20 @@
(:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire]))
(def schema-version 6)
(def schema-version
"The stored document format. A client refuses a project stored under a
different one — see `events/project` — so this is bumped by any change to what
a leaf may contain.
7 deleted `[:xform :anchor]`. Nothing is converted, as in 6: every project is
marked 7, and one still carrying an anchor is refused when it is opened, by
name and with what to do about it — `node/problems`. Dropping one would in fact
be exact wherever rotation and scale are the identity, which is everywhere a
freeze or a drop wrote one, since the anchor cancels out of `node/local!`
there; it is NOT exact on anything since turned or scaled by hand, and that is
the case a silent conversion would quietly move. So it is refused rather than
guessed at."
7)
(defn block-keys
"Every tier-2 key a leaf map names, in a stable order."

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

@ -359,17 +359,16 @@
(quot (if (vector? pts) (count pts) (.-length pts)) 2))
(defn- xform-at
"The five transform components at the node's local frame, or nil when any of
"The four transform components at the node's local frame, or nil when any of
them has no value on it."
[rd]
(let [pos (rd [:xform :pos])
rot (rd [:xform :rot])
scl (rd [:xform :scale])
skw (rd [:xform :skew])
anc (rd [:xform :anchor])]
skw (rd [:xform :skew])]
(when-not (or (ch/nothing? pos) (ch/nothing? rot) (ch/nothing? scl)
(ch/nothing? skw) (ch/nothing? anc))
[pos rot scl skw anc])))
(ch/nothing? skw))
[pos rot scl skw])))
(defn- visible?
"Is the node switched on this frame?
@ -423,10 +422,10 @@
plf (node/local-frame n ppf)
rd (fn [path] (read id path (get chs path) lf plf))]
(when (visible? id (rd [:vis]))
(when-let [[pos rot scl skw anc] (xform-at rd)]
(when-let [[pos rot scl skw] (xform-at rd)]
;; dest aliases `local` here, which mul! allows: it reads both
;; operands fully before writing either.
(let [m (node/local! (mat-for id) pos rot scl skw anc)]
(let [m (node/local! (mat-for id) pos rot scl skw)]
{:m (node/world! m (:m parent) (pinv-for id) m scratch)
:f lf
:pre plf

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

@ -1048,17 +1048,34 @@
land on — middled on that stage rather than wherever the picture's own middle
happens to fall. A 1920px still is otherwise six stages tall.
A DEFAULT, set once, as the anchor is: nothing keeps it fitted afterwards."
A DEFAULT, set once: nothing keeps it fitted afterwards.
THIS RESCALES, SO IT HAS TO RE-PLACE, and that is work the stored anchor used
to do silently. `clip/place-symbol` has just put the picture's middle where it
belongs — under the pointer, or wherever it was — at the IDENTITY scale, and
then this changes the scale. With an anchor on the middle, `T(a)·S(k)·T(-a)`
left that point alone for any `k` and there was nothing to fix. Without one,
`T(pos)·S(k)` moves it by `(1-k)·middle`, so the middle has to be solved for
again — the same equation `gesture/about` solves per drag, with `middle` as the
point to hold.
A trace's own coordinates are its pixels, `[0 0 width height]`, so its middle
is half its size and `pos = where − k·middle` for both branches: `where` is
where `place-symbol` left the middle when a pointer chose it, and the stage's
own middle when nothing did — a 1920px still is otherwise six stages tall and
dropped off-centre as well."
[document sid uuid {:keys [width height]} point?]
(let [[w h] (clip/stage document sid)
k (min (/ w width) (/ h height))]
k (min (/ w width) (/ h height))
mid [(/ width 2) (/ height 2)]]
(update-in document [:symbols sid :nodes uuid :channels]
(fn [chs]
(cond-> (assoc chs [:xform :scale] (ch/framed [k k]))
(not point?)
(assoc [:xform :pos]
(ch/framed (mapv - [(/ w 2) (/ h 2)]
(:value (get chs [:xform :anchor]))))))))))
(let [where (if point?
(mapv + (:value (get chs [:xform :pos])) mid)
[(/ w 2) (/ h 2)])]
(assoc chs
[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed (mapv - where (mapv * [k k] mid)))))))))
(rf/reg-event-db
::drop-symbol
@ -1346,6 +1363,24 @@
uuid (conj host uuid)])
(update-in [:ui :expanded] conj (conj host uuid)))))))
(rf/reg-event-db
::peg
;; A peg over the selected node, selected afterwards — because the point of
;; making one is to transform it, and the thing you just made is the thing you
;; meant to grab. The peg takes the node's place in the hierarchy, so the row
;; path it is selected by is the one the node had.
(fn [db [_ path]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
f (editing-frame db clip)
uuid (random-uuid)
r (nest/peg clip st open path f uuid)]
(if-let [why (:refused r)]
(refused db why)
(-> db
(edit/edit (constantly (:clip r)))
(assoc-in [:ui :selection] [:node (:sid r) uuid (conj (pop (vec path)) uuid)]))))))
(rf/reg-event-db
::edit-keyframes
(fn [db [_ items delta]]

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

@ -37,7 +37,6 @@
[arthur.domain.feature :as feature]
[arthur.domain.geom :as geom]
[arthur.domain.node :as node]
[arthur.domain.pick :as pick]
[arthur.domain.palette :as pal]
[arthur.domain.ring :as ring]
[arthur.flow.address :as address]))
@ -401,9 +400,10 @@
cy (/ (+ y0 y1) 2)
k (min (/ (* 0.8 w) (max 1e-9 (- x1 x0)))
(/ (* 0.8 h) (max 1e-9 (- y1 y0))))]
{[:xform :anchor] (ch/framed [cx cy])
[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) cx) (- (/ h 2) cy)])}))
;; `pos` alone, because `T(a)·S(k)·T(-a)` translates by `a − k·a`: folding
;; that into the position is the same pixels with no stored pivot.
{[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) (* k cx)) (- (/ h 2) (* k cy))])}))
(defn face-placement
"The face's transform on the stage, as FRAMED channels.
@ -429,17 +429,19 @@
bounding box — and it is a fraction of the STAGE, so a 1440x1920 portrait clip
composited onto a 320x200 stage is not a problem to solve.
ANCHOR is the reference centroid, and this is where `:anchor` earns its place.
MediaPipe's normalised space has its origin at the image's TOP-LEFT CORNER, so
head-local geometry is not centred on anything; the registration point of the
face is the head's own centre, and rotation and scale have to happen about that
rather than about a corner of the footage. Getting that wrong is why hand-placed
parts swing rather than turn.
POSITION puts the reference centroid a QUARTER of the way down the stage,
because the rigid landmarks are eyes and nose — the upper middle of a face — so
a quarter down leaves the jaw and the mouth on the stage. Whatever hangs off is
clipped, which is not a feature to add: every fill in `domain/raster` clamps
already.
POSITION puts the anchor a QUARTER of the way down the stage, because the rigid
landmarks are eyes and nose — the upper middle of a face — so a quarter down
leaves the jaw and the mouth on the stage. Whatever hangs off is clipped, which
is not a feature to add: every fill in `domain/raster` clamps already.
THE CENTROID IS IN THE POSITION, NOT IN A PIVOT. MediaPipe's normalised space
has its origin at the image's TOP-LEFT CORNER, so head-local geometry is not
centred on anything and the placement has to carry the offset to the head's own
centre. This used to be an `:anchor`, which made the offset do double duty as a
pivot; `pos = stage − k·centroid` is the same translation with nothing stored,
and the face then turns about the middle of what it actually draws rather than
about a centroid measured once. See `domain/gesture`.
ONE MAPPING, COMPUTED OVER EVERY SUBJECT AND WRITTEN INTO EACH FACE. It is
measured across all of them together — which is what keeps two faces filmed
@ -462,10 +464,9 @@
c (geom/centroid ref)
span (- (reduce max (map :x ref)) (reduce min (map :x ref)))
k (/ (* 0.4 w) span)]
{[:xform :anchor] (ch/framed [(:x c) (:y c)])
[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) (:x c))
(- (* 0.25 h) (:y c))])}))))
{[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) (* k (:x c)))
(- (* 0.25 h) (* k (:y c)))])}))))
(defn- mouth-part [subject absent? obs
{:keys [analysis verts anchor-avg contour-avg aperture-cut] :as params}
@ -771,46 +772,6 @@
{})
:store (into (merge (:store head) (:store plate)) (mapcat :store) parts)}))
(defn pivoted
"Every node a freeze makes that a hand can transform, pivoting about the
middle of what it draws.
THE SAME RULE AS EVERYWHERE ELSE, and this is the one place that used to skip
it: `clip/place-symbol` writes an instance's anchor, `paint/new-shape` a
drawing's, `nest/group` a new symbol's, and `face-placement` the source
placement's — and the traced parts underneath it got none, so each of them
turned and scaled about ITS OWN ORIGIN, which for head-local geometry is the
top-left corner of the footage. `freeze_test` already said why that is wrong
for the face; it is no less wrong for the mouth.
WHAT IT SKIPS IS `node/measured?`, the predicate `gesture/refusal` refuses a
hand edit by — so a node gets a pivot exactly when a hand can use one, which
is the invariant worth having rather than a list of exceptions. It is also
what keeps this off `:head`: the head carries the measured similarity, its
scale is nowhere near 1, and an anchor under a scale does NOT cancel out of
`node/local!` the way it does at the identity, so writing one there would move
the whole face. Skipping it because it draws nothing would be true today and
true by accident.
A DEFAULT, written once, never followed: an anchor already on a node is left
alone, and nothing updates one when the geometry moves later. On everything it
does write to, rotation and scale are the identity, where the anchor cancels
out — so this changes where a part pivots and not one pixel of what it draws."
[clip store]
(reduce
(fn [c [sid id]]
(let [n (get-in c [:symbols sid :nodes id])
at [:symbols sid :nodes id :channels [:xform :anchor]]]
(if (or (get-in c at) (node/measured? n))
c
(if-let [p (pick/pivot c store sid n (range (get-in c [:symbols sid :frames])))]
(assoc-in c at (ch/framed p))
c))))
clip
(for [sid (sort-by str (keys (:symbols clip)))
id (sort-by str (keys (get-in clip [:symbols sid :nodes])))]
[sid id])))
(defn clip
"Subject-id -> conditioned measurements becomes one symbol per face, and a
symbol called :main that places them.
@ -872,8 +833,7 @@
{:subject subject :feature id :frames nf :actual (count track)}))))
(let [store (merged :store)]
{:store store
:clip (-> (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :trace (get inputs :trace (:trace params))}
{:clip c}))
built ordered)
(pivoted store))})))
:clip (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :trace (get inputs :trace (:trace params))}
{:clip c}))
built ordered)})))

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

@ -149,14 +149,20 @@
(rf/dispatch [::ui/select nil]))))
(defn- begin!
"Start dragging `kind` of the node at `path` from stage point `p`."
"Start dragging `kind` of the node at `path` from stage point `p`.
THE PIVOT IS DERIVED HERE, once, and held for the drag. Once per pointerdown is
what makes deriving it affordable where a stored one was tempting — and holding
it for the drag is what keeps a turn steady: re-deriving per pointermove would
chase the box the turn is itself moving."
[{:keys [open f] :as ctx} kind path p]
(let [{document :clip st :store} (loaded ctx)]
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
(let [n (get-in document [:symbols sid :nodes id])
v0 (gesture/values n frame st)]
v0 (gesture/values n frame st)
c (gesture/pivot v0 ((pick/bounds-of document st sid n) frame))]
(reset! gesture {:kind kind :pl pl :path path :open open :v0 v0 :p0 p :n n
:a (gesture/angle pl v0 p) :turned 0})))))
:c c :a (gesture/angle pl c p) :turned 0})))))
(defn- stage-bounds [{:keys [world bounds]}]
(when (and world bounds)
@ -184,23 +190,26 @@
(and (seq members) box)
(reset! gesture {:kind kind :members members :p0 p :box box}))))
(defn- multi-values [kind {:keys [pl v0]} [cx cy] p0 p]
(defn- multi-values
"What one member of a multi-selection makes of the drag. `[cx cy]` is the
middle of the shared box, in stage pixels — every member scales about THAT, so
the selection keeps its arrangement.
The whole of what this used to open-code — take the member's anchor to stage,
scale it about the box, and write the position difference — is `scale-by`,
because that was this same pivot equation with the stored anchor as the pivot."
[kind {:keys [pl v0]} [cx cy] p0 p]
(case kind
:move (gesture/move pl v0 p0 p)
:scale
(let [d0 (max 1e-6 (js/Math.hypot (- (first p0) cx) (- (second p0) cy)))
k (/ (js/Math.hypot (- (first p) cx) (- (second p) cy)) d0)
[px py] (through (:world pl) (:anchor v0))
target [(+ cx (* k (- px cx))) (+ cy (* k (- py cy)))]
inv (node/invert (:parent pl))]
(when inv
(let [[a b] (through inv [px py]) [c d] (through inv target)]
{[:xform :pos] (mapv + (:pos v0) [(- c a) (- d b)])
[:xform :scale] (mapv #(* k %) (:scale v0))})))
k (/ (js/Math.hypot (- (first p) cx) (- (second p) cy)) d0)]
(when-let [inv (node/invert (:parent pl))]
(gesture/scale-by v0 (through inv [cx cy]) k)))
nil))
(defn- drag! [p ^js event]
(let [{:keys [kind pl path open v0 p0 n a turned values]} @gesture
(let [{:keys [kind pl path open v0 p0 n a c turned values]} @gesture
shift? (.-shiftKey event)
moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))]
(when moved?
@ -217,16 +226,16 @@
(do (reset! gesture nil) (rf/dispatch [::ui/refuse why]))
(let [vs (case kind
:move (gesture/move pl v0 p0 p)
:scale (gesture/scale pl v0 p0 p shift?)
:turn (let [b (gesture/angle pl v0 p)
:scale (gesture/scale pl v0 c p0 p shift?)
:turn (let [b (gesture/angle pl c p)
d (- b a)
t (+ turned (- d (* 2 js/Math.PI (js/Math.round (/ d (* 2 js/Math.PI))))))
q (/ js/Math.PI 12)]
(swap! gesture assoc :a b :turned t)
;; ⇧ turns in 15° steps, as everywhere.
(gesture/turn v0 (if shift?
(- (* q (js/Math.round (/ (+ (:rot v0) t) q))) (:rot v0))
t))))]
(gesture/turn v0 c (if shift?
(- (* q (js/Math.round (/ (+ (:rot v0) t) q))) (:rot v0))
t))))]
(when vs
(swap! gesture assoc :values vs)
(rf/dispatch [::ui/gesture
@ -247,12 +256,28 @@
"The selected node's box, drawn through its own transform so it turns with
it: a square on each corner to scale by, a knob above to turn by, and a cross
on the pivot. Dragging inside it moves it — that is the stage's own
pointerdown, which keeps a selection it lands inside."
pointerdown, which keeps a selection it lands inside.
THE CROSS IS THE MIDDLE OF THE BOX, and that is an identity rather than a
coincidence to keep up: both come from the same `bounds` on the same frame, so
the cross cannot drift off the box. It used to be drawn from the stored
`[:xform :anchor]` while the box was recomputed every render, which is what
made the pivot visibly wrong on anything that had been edited since it was
made. On a node that draws nothing — a peg — there is no box and the cross
marks its own origin, which is what it turns about.
AN INDICATOR AND NOT A HANDLE. There is nothing to drag it to: no pivot is
stored, so moving it could only mean something for the next drag and would be
gone by the one after. A pivot that has to persist is a peg, which is a node,
and is moved and keyed as any other node is."
[ctx]
(let [{:keys [world bounds node frame]} @(rf/subscribe [::sub/selected-placement])
(let [{:keys [world bounds]} @(rf/subscribe [::sub/selected-placement])
[_ _ _ path] @(rf/subscribe [::sub/selection])
[ax ay] (when world (:anchor (gesture/values node frame (:store (loaded ctx)))))
[px py] (when world (through world [ax ay]))
[px py] (when world
(let [[x0 y0 x1 y1] bounds]
(through world (if bounds
[(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]
[0 0]))))
grab (fn [kind]
(fn [^js event]
(.stopPropagation event)

14
frontend/src/arthur/ui/topbar.cljs
View file

@ -58,6 +58,11 @@
selections @(rf/subscribe [::sub/selections])
clipboard @(rf/subscribe [::sub/clipboard])
selected? (boolean (seq selections))
;; A peg goes over ONE node: it takes that node's place in the
;; hierarchy, and there is no one place a pair of them would go.
one-node (when (= 1 (count selections))
(let [[kind _ _ path] (first selections)]
(when (and (= :node kind) (seq path)) path)))
title (or project-name "untitled")
commit! (fn []
(rf/dispatch [::project/rename @draft])
@ -85,7 +90,14 @@
{:label "duplicate unique"
:sub "Duplicate with a private nested symbol graph · ⇧⌘/Ctrl D"
:disabled? (not selected?)
:on-click #(rf/dispatch [::ui/duplicate-unique])}]}]
:on-click #(rf/dispatch [::ui/duplicate-unique])}
;; The only way to keep a pivot, and the only way to transform a
;; measured part by hand — which is what `gesture/refusal` tells
;; you to do, so it has to be reachable from somewhere.
{:label "add peg"
:sub "A transform node over the selection, to pivot, turn and key from"
:disabled? (nil? one-node)
:on-click #(rf/dispatch [::ui/peg one-node])}]}]
[snapshots/view]
(if @renaming?
[:input.project-name {:auto-focus true :value @draft

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

@ -29,8 +29,7 @@
(clip/place-symbol nil :mid :box 2 v nil)
(turn :main u [40 20] (/ js/Math.PI 2) [2 2])
(turn :mid v [5 -3] 0.3 [1.5 0.5])
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow)
(assoc-in [:symbols :box :nodes :shape :channels [:xform :anchor]] (ch/framed [5 3])))))
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow))))
(defn- drawn [c path]
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %))
@ -38,15 +37,22 @@
(defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b))))
(defn- pivot-of
"The parent-space pivot the stage would derive for this node at this frame —
`begin!`'s one line, so a test drags about the same point the stage does."
[c st sid id frame v0]
(gesture/pivot v0 ((pick/bounds-of c st sid (get-in c [:symbols sid :nodes id])) frame)))
(defn- dragged [c path f vs-fn]
(let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame nil)]
(gesture/apply-values c sid id frame (vs-fn pl v0))))
(gesture/apply-values c sid id frame
(vs-fn pl v0 (pivot-of c nil sid id frame v0)))))
(deftest a-shape-two-symbols-down-moves-under-the-pointer
(doseq [path [[u] [u v] [u v :shape]]]
(let [c (two-down)
moved (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26]))]
moved (dragged c path 16 (fn [pl v0 _] (gesture/move pl v0 [30 30] [37 26])))]
(is (near? (map (fn [[x y]] [(+ x 7) (- y 4)]) (drawn c [u v :shape]))
(drawn moved [u v :shape]))
(str "moving " path " by (7, -4) on the stage moves the shape by (7, -4)")))))
@ -65,15 +71,20 @@
(get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :interp])))))
(deftest turning-keeps-the-pivot-where-it-is
;; The shape's geometry is [0 0 10 0 5 10], so the middle of what it draws is
;; (5, 5) in its own coordinates. NOTHING STORES THAT: the turn solves for the
;; `pos` that holds it still, which is the whole of why the rest goes round it.
(let [c (two-down)
path [u v :shape]
{:keys [world]} (nest/placement c nil :main path 16)
pivot #(let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 (:world (nest/placement % nil :main path 16)) 5 3))))
turned (dragged c path 16 #(gesture/turn %2 0.7))]
(vec (array-seq (node/apply-pt! out 0 (:world (nest/placement % nil :main path 16)) 5 5))))
turned (dragged c path 16 #(gesture/turn %2 %3 0.7))]
(is (some? world))
(is (near? (pivot c) (pivot turned)) "the anchor stays put")
(is (not (near? (drawn c path) (drawn turned path))) "and the rest goes round it")))
(is (near? (pivot c) (pivot turned)) "the middle of the drawing stays put")
(is (not (near? (drawn c path) (drawn turned path))) "and the rest goes round it")
(is (contains? (get-in turned [:symbols :box :nodes :shape :channels]) [:xform :pos])
"a turn writes pos as well as rot — that is what makes it happen about a point")))
(deftest scaling-takes-the-grabbed-point-to-the-pointer
(let [c (two-down)
@ -83,37 +94,43 @@
at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3)))
p0 (at world 10 0)
p1 [(+ (first p0) 3) (- (second p0) 5)]
grown (dragged c path 16 #(gesture/scale %1 %2 p0 p1 false))
grown (dragged c path 16 #(gesture/scale %1 %2 %3 p0 p1 false))
w2 (:world (nest/placement grown nil :main path 16))]
(is (near? p1 (at w2 10 0))
"the corner grabbed is under the pointer, through a turned, unevenly scaled parent")
(is (near? (at world 5 3) (at w2 5 3)) "about the pivot")))
(is (near? (at world 5 5) (at w2 5 5)) "about the middle of the drawing")))
;; ---------------------------------------------------------------------------
;; which way a corner drag goes
;;
;; `scale` takes the point under the pointer to the pointer, about the node's
;; PIVOT, and that is the whole of it — so which way a corner drag goes is
;; decided entirely by where the pivot is. With it in the middle of what the node
;; draws, where `clip/place-symbol`, `paint/new-shape` and now `flow/freeze` all
;; put it, pulling a corner away from the middle makes the node bigger. With it
;; at the node's coordinate ORIGIN, which is what a node with no anchor gets,
;; every corner drag is a drag away from some point off in the corner of the
;; footage: the shape shrinks and slides while the corner dutifully follows the
;; pointer, which is what the bug looked like from the outside.
;; decided entirely by where the pivot is. In the middle of what the node draws,
;; which is where `gesture/pivot` derives it, pulling a corner away from the
;; middle makes the node bigger. At the node's coordinate ORIGIN — which is what
;; a node whose stored anchor had never been written got, and for head-local
;; geometry is the top-left corner of the FOOTAGE — every corner drag is a drag
;; away from a point off in the corner: the shape shrinks and slides while the
;; corner dutifully follows the pointer, which is what the bug looked like from
;; the outside.
;;
;; None of it is stored any more, so none of it can be absent or stale. These
;; tests used to need a freeze pass to have written the pivots they check.
(defn- at [m p] (let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 m (first p) (second p))))))
(defn- handles
"Where the stage would draw this node's box and pivot: its own bounds and
anchor through its `:world`, which is what `ui/stage`'s `handles` does."
"Where the stage would draw this node's box and pivot: its own bounds through
its `:world`, and the MIDDLE OF THOSE BOUNDS, which is what `ui/stage`'s
`handles` does. One `bounds-of` feeding both is the point — the cross cannot
drift off the box, because it is the box's own middle."
[c st open path f]
(let [{:keys [sid id world frame]} (nest/placement c st open path f)
n (get-in c [:symbols sid :nodes id])
[x0 y0 x1 y1] ((pick/bounds-of c st sid n) frame)]
{:corners (mapv #(at world %) [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])
:pivot (at world (:anchor (gesture/values n frame st)))}))
:pivot (at world [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])}))
(defn- span
"How big the box is, as the length of its diagonals — which does not care that
@ -129,9 +146,10 @@
[c st open path f i d]
(let [{:keys [sid id frame] :as pl} (nest/placement c st open path f)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame st)
c* (pivot-of c st sid id frame v0)
p0 (nth (:corners (handles c st open path f)) i)
p1 (mapv + p0 d)]
{:clip (gesture/apply-values c sid id frame (gesture/scale pl v0 p0 p1 false))
{:clip (gesture/apply-values c sid id frame (gesture/scale pl v0 c* p0 p1 false) false st)
:p0 p0 :p1 p1}))
(defn- away
@ -141,22 +159,13 @@
len (max 1e-9 (js/Math.hypot dx dy))]
[(* k (/ dx len)) (* k (/ dy len))]))
(defn- middled
"`two-down` with the shape pivoting about the middle of what it draws — which
is what `paint/new-shape` writes and what `two-down` deliberately moves off, so
that the rest of this file is not accidentally testing the easy case."
[]
(let [c (two-down)]
(assoc-in c [:symbols :box :nodes :shape :channels [:xform :anchor]]
(ch/framed (pick/pivot c nil :box (get-in c [:symbols :box :nodes :shape]) [4])))))
(deftest dragging-a-corner-away-from-the-middle-makes-it-bigger
(doseq [[what c path f]
[["a shape on its own"
(paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow)
[:shape] 4]
["a shape two symbols down, through a turned and unevenly scaled parent"
(middled) [u v :shape] 16]]
(two-down) [u v :shape] 16]]
i (range 4)]
(let [before (handles c nil :main path f)
out (corner-drag c nil :main path f i (away before i 6))
@ -190,9 +199,12 @@
(deftest a-face-part-scales-about-its-own-middle
;; The whole measured rig, from `demo/take`: source-space geometry under a
;; dense head similarity, under the authored source placement, inside an
;; instance. Before `freeze/pivoted` the mouth's pivot sat at (-234, -395) on a
;; 320x200 stage — the top-left corner of the FOOTAGE, carried onto the stage —
;; and every corner drag was a drag away from it.
;; instance. The mouth's pivot used to sit at (-234, -395) on a 320x200 stage —
;; the top-left corner of the FOOTAGE, carried onto the stage — because its
;; stored anchor was never written: `freeze` refused to write one onto anything
;; measured, and rightly, since an anchor under a measured scale does not cancel
;; out. Deriving it removes the refusal along with the field. There is nothing
;; to write, so there is no node a pivot can be missing from.
(let [{c :clip st :store} @take/frozen
f 10]
(doseq [path [[:face-1] [:face-1 :mouth] [:face-1 :eye-r]]]
@ -225,7 +237,7 @@
(let [v (gesture/values n 10 st)]
(is (map? v) (str sid "/" id " could not be read at all"))
(is (every? #(or (number? %) (ch/nothing? %))
(concat (:pos v) (:scale v) (:anchor v) [(:rot v)]))
(concat (:pos v) (:scale v) (:skew v) [(:rot v)]))
(str sid "/" id " did not read as numbers: " (pr-str v))))
(when (node/measured? n)
(is (thrown? js/Error (gesture/values n 10 nil))
@ -243,8 +255,8 @@
;; jumps on the first pointermove. Two drags have to compose.
(let [c (two-down)
path [u v :shape]
once (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26]))
twice (dragged once path 16 #(gesture/move %1 %2 [30 30] [33 31]))
once (dragged c path 16 (fn [pl v0 _] (gesture/move pl v0 [30 30] [37 26])))
twice (dragged once path 16 (fn [pl v0 _] (gesture/move pl v0 [30 30] [33 31])))
;; The same second drag, begun from the clip as it was BEFORE the first.
stale (let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame nil)]
@ -260,9 +272,9 @@
(deftest a-drag-keys-a-keyed-channel-and-sets-a-framed-one
(let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]]
(constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear)))
moved (dragged c [u v] 16 #(gesture/move %1 %2 [0 0] [4 0]))
moved (dragged c [u v] 16 (fn [pl v0 _] (gesture/move pl v0 [0 0] [4 0])))
pos (get-in moved [:symbols :mid :nodes v :channels [:xform :pos]])
rot (dragged c [u v] 16 #(gesture/turn %2 0.1))]
rot (dragged c [u v] 16 #(gesture/turn %2 %3 0.1))]
(is (= #{0 4 20} (set (keys (:keys pos))))
"a key on the instance's own frame — 16 of main is 6 of mid, 4 of its own — and the others kept")
(is (= {:animated? false :value 0.4}

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

@ -3,6 +3,7 @@
[arthur.demo.stage :as stage]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
@ -150,6 +151,14 @@
[document id]
(get-in document [:symbols :main :nodes (uuid-of id)]))
(defn- peg
"The PEG of the placement the layout calls `id`: the transform node the face
hangs off, which carries where and when it sits on the stage."
[document id]
(get-in document [:symbols :main :nodes
(->> (:instances stage/layout)
(some (fn [p] (when (= id (:id p)) (:peg p)))))]))
(deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)]
(is (empty? (clip/problems document)))
@ -171,25 +180,41 @@
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :instance (:kind %))
(vals (get-in document [:symbols :main :nodes]))))))
(is (= [0 232] (:span (placement document :right))) "its own frames, from its own 0")
(is (= [48 280] (node/placed-span (placement document :right))) "and where that sits on the stage")
(let [left (placement document :left)
scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0 nil)]
(is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40 nil)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0 nil)))
(is (= [0.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f nil) [0 0] anchor)
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales"))))
(is (= [0 232] (:span (peg document :right))) "its own frames, from its own 0")
(is (= [48 280] (node/placed-span (peg document :right))) "and where that sits on the stage")
(is (= (uuid-of :right) (:id (placement document :right))))
(is (= (:id (peg document :right)) (:parent (placement document :right)))
"the face hangs off its peg")
(testing "a keyed scale happens about the pinned point, and that is the peg"
;; THE CASE THAT MAKES A PEG NECESSARY. `:scale` is keyed — the faces pulse
;; — and the source's middle has to stay on the authored `:center` through
;; all of it. A stored anchor used to buy that with a static position; with
;; `T(pos)·S(k(f))` alone it would take a `pos` keyed in lockstep with
;; `scale`, two channels obliged to agree frame for frame. The peg needs
;; neither: it holds `center` and the keyed scale, the face holds `-origin`,
;; and `T(center)·S(k)·T(-origin)` takes origin to center for EVERY k.
(let [pg (peg document :left)
face (placement document :left)
scale (get-in pg [:channels [:xform :scale]])
pos (get-in pg [:channels [:xform :pos]])
off (get-in face [:channels [:xform :pos] :value])]
(is (= [-160 -100] off) "the face is offset to its own origin, and that is all")
(is (nil? (get-in face [:channels [:xform :scale]])) "the scale is the peg's")
(is (= [40 40] (ch/value-at pos 0 nil)) "the peg sits on the authored center")
(is (not= (ch/value-at pos 0 nil) (ch/value-at pos 40 nil)) "and drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0 nil)))
(is (= [0.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]]
(let [k (ch/value-at scale f nil)
;; peg · face, composed as the evaluator does
m (node/mul! (node/mat)
(node/local! (node/mat) (ch/value-at pos 0 nil) 0 k [0 0])
(node/local! (node/mat) off 0 [1 1] [0 0]))
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
(str "f" f ": the face center stays put while it scales, at k=" (pr-str k)))))))
(testing "the editorial link resolves to the placement's uuid"
;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
@ -333,18 +358,34 @@
[:symbols :main :nodes u :channels]))]
(is (= [25 35] (clip/center c nil :box)) "the middle of the square")
(is (= [160 100] (clip/center c nil :empty)) "nothing drawn: the stage's middle")
(testing "the anchor is the middle, and it moves nothing at the identity"
(is (= [25 35] (get-in (placed c :box nil) [[:xform :anchor] :value])))
(testing "a placement stores a position and no pivot at all"
(is (= [[:xform :pos]] (keys (placed c :box nil))) "one channel, and it is where it sits")
(is (= [0 0] (get-in (placed c :box nil) [[:xform :pos] :value]))
"dropped on the timeline: where it was drawn"))
(testing "dropped on a stage pixel, its middle goes there"
(is (= [75 65] (get-in (placed c :box [100 100]) [[:xform :pos] :value]))))
(testing "and growing the symbol later does not move an instance's pivot"
(let [c (clip/place-symbol c nil :main :box 0 u nil)
grown (assoc-in c [:symbols :box :nodes :sq2] (assoc (square 80 30) :id :sq2 :z "a2"))]
(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]))
"the instance's did not")))))
(testing "growing the symbol later moves where its instances pivot, and moves nothing on screen"
;; THE BUG, INVERTED. This used to assert the opposite — that the instance
;; kept pivoting about where the symbol's drawing had been — because the
;; middle was copied into a stored anchor at drop time and nothing ever
;; invalidated it. A pivot derived per drag follows the drawing instead, and
;; it cannot move anything on screen by doing so: there is no stored value
;; for the composition to read, so adding `sq2` changes the pivot and not
;; one pixel of the picture.
(let [c (clip/place-symbol c nil :main :box 0 u nil)
grown (assoc-in c [:symbols :box :nodes :sq2] (assoc (square 80 30) :id :sq2 :z "a2"))
;; what `gesture/pivot` derives for the instance, before and after
pivot-of (fn [doc]
(let [n (get-in doc [:symbols :main :nodes u])]
(gesture/pivot (gesture/values n 0 nil)
((pick/bounds-of doc nil :main n) 0))))]
(is (= [25 35] (clip/center c nil :box)) "the symbol's middle")
(is (= [55 35] (clip/center grown nil :box)) "and it moved when the symbol grew")
(is (= [25 35] (pivot-of c)))
(is (= [55 35] (pivot-of grown)) "the instance's pivot followed the drawing")
(is (= (get-in c [:symbols :main :nodes u :channels])
(get-in grown [:symbols :main :nodes u :channels]))
"and not one channel of the instance changed, so nothing on screen moved")))))
(deftest palette-context-is-inherited-keyed-and-overridable
(let [palette (fn [id name a b]

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

@ -2,10 +2,13 @@
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.demo.take :as take]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]))
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
@ -383,3 +386,108 @@
(is (nil? (get-in slid [:symbols :lane :nodes :a]))
"a fully covered neighbor is removed")
(is (empty? (clip/problems slid)))))
;; ---------------------------------------------------------------------------
;; pegs
;;
;; What `[:xform :anchor]` used to be, as a node. These assert the three things
;; it is for, and the one invariant that has to hold whatever it is for: NOTHING
;; MOVES when a peg appears.
(def ^:private pg #uuid "00000000-0000-4000-8000-0000000000f1")
(defn- shaped
"A shape at a known place, turned and scaled, so that `:pinv` has real work to
do rather than cancelling against an identity."
[]
(-> (clip/blank)
(paint/new-shape :main :shape 0 [0 0 10 0 5 10] :brow)
(update-in [:symbols :main :nodes :shape :channels] merge
{[:xform :pos] (ch/framed [40 25])
[:xform :rot] (ch/framed 0.4)
[:xform :scale] (ch/framed [1.5 0.75])})))
(defn- drawn-at
"Every drawn point on frame `f`, flat. `st` because a measured take's geometry
is dense and a dense channel read without its tier-2 store throws."
([c f] (drawn-at c nil f))
([c st f]
(->> ((clip/resolver c :main st pal/index-of nil) f)
(filter #(= :poly (:kind %)))
(mapcat #(array-seq (:pts %)))
vec)))
(defn- near? [a b] (and (= (count a) (count b))
(every? #(< (js/Math.abs %) 1e-9) (map - a b))))
(deftest a-peg-appears-over-a-node-and-moves-nothing
(let [c (shaped)
r (nest/peg c nil :main [:shape] 0 pg)
out (:clip r)]
(is (nil? (:refused r)) (:refused r))
(is (= :group (get-in out [:symbols :main :nodes pg :kind])) "a peg is an ordinary group")
(is (= pg (get-in out [:symbols :main :nodes :shape :parent])) "and the node hangs off it")
(is (= (get-in c [:symbols :main :nodes :shape :channels])
(get-in out [:symbols :main :nodes :shape :channels]))
"the node's channels are untouched — which is what lets this work on a measured one")
(is (near? (drawn-at c 0) (drawn-at out 0))
"and nothing moved: that is `:pinv`'s whole job")
(is (empty? (clip/problems out)))))
(deftest a-peg-sits-on-the-pivot-so-it-turns-about-the-same-point
;; The peg lands where the cross was, so grabbing it turns about exactly the
;; point a drag on the node would have. That is what makes it a REPLACEMENT for
;; the pivot rather than a second, differently-placed one.
(let [c (shaped)
n (get-in c [:symbols :main :nodes :shape])
was (gesture/pivot (gesture/values n 0 nil)
((pick/bounds-of c nil :main n) 0))
out (:clip (nest/peg c nil :main [:shape] 0 pg))
peg (get-in out [:symbols :main :nodes pg])]
(is (near? was (:value (get-in peg [:channels [:xform :pos]])))
"the peg's position IS the pivot")
;; And a peg draws nothing, so its own derived pivot is its own origin —
;; which is that same point. Toon Boom's rule, falling out of one sentence.
(is (near? was (gesture/pivot (gesture/values peg 0 nil)
((pick/bounds-of out nil :main peg) 0)))
"so the peg turns about where it was put")))
(deftest turning-a-peg-turns-its-child-about-that-point
(let [c (:clip (nest/peg (shaped) nil :main [:shape] 0 pg))
pl (nest/placement c nil :main [pg] 0)
v0 (gesture/values (get-in c [:symbols :main :nodes pg]) 0 nil)
piv (gesture/pivot v0 nil)
out (gesture/apply-values c :main pg 0 (gesture/turn v0 piv 0.6))
;; every drawn point's distance from the pivot, before and after
radii (fn [doc]
(let [[px py] (:value (get-in c [:symbols :main :nodes pg
:channels [:xform :pos]]))]
(map (fn [[x y]] (js/Math.hypot (- x px) (- y py)))
(partition 2 (drawn-at doc 0)))))]
(is (some? pl))
(is (not (near? (drawn-at c 0) (drawn-at out 0))) "the child moved")
(is (near? (vec (radii c)) (vec (radii out)))
"and every point kept its distance from the peg — so it TURNED about it")))
(deftest a-peg-goes-over-a-measured-node-which-is-the-one-thing-an-anchor-could-not-do
;; `gesture/refusal` turns a drag on a measured node away and tells you to put
;; a peg over it, so this is that advice being true. An anchor could never have
;; been written here: `node/local!`'s translation is `pos − M·a`, and under the
;; head's measured similarity `M` is nowhere near the identity, so writing one
;; would have moved the whole face. A peg's channels are its own.
(let [{c :clip st :store} @take/frozen
head (get-in c [:symbols :face-1 :nodes :head])]
(is (node/measured? head))
(is (string? (gesture/refusal head)) "a drag on it is still refused")
(let [r (nest/peg c st :main [:face-1 :head] 0 pg)
out (:clip r)]
(is (nil? (:refused r)) (:refused r))
(is (= pg (get-in out [:symbols :face-1 :nodes :head :parent])))
(is (= (:channels head) (get-in out [:symbols :face-1 :nodes :head :channels]))
"the measured channels are untouched, so the next regenerate still owns them")
(is (nil? (gesture/refusal (get-in out [:symbols :face-1 :nodes pg])))
"and the peg over it CAN be dragged, which is the whole point")
(is (empty? (clip/problems out)))
(doseq [f [0 7 20]]
(is (near? (drawn-at c st f) (drawn-at out st f))
(str "frame " f " moved when the peg appeared"))))))

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

@ -14,9 +14,9 @@
(defn- close? [a b] (< (js/Math.abs (- a b)) 1e-12))
(defn- close-pt? [[ax ay] [bx by]] (and (close? ax bx) (close? ay by)))
(defn- local [& {:keys [pos rot scale skew anchor]
:or {pos [0 0] rot 0 scale [1 1] skew [0 0] anchor [0 0]}}]
(node/local! (node/mat) pos rot scale skew anchor))
(defn- local [& {:keys [pos rot scale skew]
:or {pos [0 0] rot 0 scale [1 1] skew [0 0]}}]
(node/local! (node/mat) pos rot scale skew))
;; ---- the transform, component by component ----
@ -28,16 +28,19 @@
(is (close-pt? [0 10] (pt (local :rot (/ js/Math.PI 2)) 10 0)))
(is (= [20 21] (pt (local :scale [2 3]) 10 7))))
(deftest rotation-and-scale-happen-about-the-anchor
;; :anchor is Flash's registration point and Blender's origin. Getting it wrong
;; is why hand-placed parts SWING rather than turn, and a swing looks like a
;; parenting bug rather than like a wrong pivot.
(let [m (local :rot (/ js/Math.PI 2) :anchor [10 0])]
(is (close-pt? [10 0] (pt m 10 0)) "the anchor itself is a fixed point")
(is (close-pt? [10 10] (pt m 20 0)) "and the rest turns about it"))
(let [m (local :scale [2 2] :anchor [10 10])]
(is (close-pt? [10 10] (pt m 10 10)))
(is (close-pt? [30 30] (pt m 20 20)))))
(deftest rotation-and-scale-happen-about-the-nodes-own-origin
;; THERE IS NO :anchor, and this is the half of that which lives here: a local
;; transform turns and scales about [0 0] of the node's own space and nothing
;; else. Turning about any other point is `gesture/about`, which solves for the
;; `pos` that holds that point still — see `gesture-test`. The two together are
;; what the anchor used to be, with no stored pivot to fall out of step with the
;; drawing.
(let [m (local :rot (/ js/Math.PI 2))]
(is (close-pt? [0 0] (pt m 0 0)) "the origin is the fixed point")
(is (close-pt? [0 10] (pt m 10 0)) "and the rest turns about it"))
(let [m (local :scale [2 2])]
(is (close-pt? [0 0] (pt m 0 0)))
(is (close-pt? [20 20] (pt m 10 10)))))
(deftest skew-is-shear-factors-so-the-identity-is-zero
;; Stored as factors rather than angles: kx is x gained per unit y, so a
@ -48,13 +51,13 @@
(is (= [5 12] (pt (local :skew [0 1]) 5 7)) "ky adds x into y"))
(deftest the-composition-order-is-the-one-the-model-specifies
;; local = T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor)
;; local = T(pos) · R(rot) · K(skew) · S(scale)
;;
;; Asserted against the product of the five matrices built separately, so the
;; Asserted against the product of the four matrices built separately, so the
;; closed form in node/local! is checked rather than trusted. Every other order
;; produces a transform that is right at the origin and wrong everywhere else,
;; which is exactly the kind of wrong that survives inspection.
(let [pos [3 -4] rot 0.7 scale [1.5 0.5] skew [0.25 -0.1] anchor [11 -6]
(let [pos [3 -4] rot 0.7 scale [1.5 0.5] skew [0.25 -0.1]
T (fn [x y] (js/Float64Array. #js [1 0 0 1 x y]))
R (fn [t] (js/Float64Array. #js [(js/Math.cos t) (js/Math.sin t)
(- (js/Math.sin t)) (js/Math.cos t) 0 0]))
@ -62,13 +65,31 @@
S (fn [[sx sy]] (js/Float64Array. #js [sx 0 0 sy 0 0]))
step (fn [acc m] (node/mul! (node/mat) acc m))
want (reduce step (T (nth pos 0) (nth pos 1))
[(T (nth anchor 0) (nth anchor 1))
(R rot) (K skew) (S scale)
(T (- (nth anchor 0)) (- (nth anchor 1)))])
got (local :pos pos :rot rot :scale scale :skew skew :anchor anchor)]
[(R rot) (K skew) (S scale)])
got (local :pos pos :rot rot :scale scale :skew skew)]
(is (every? (fn [i] (close? (aget want i) (aget got i))) (range 6))
(str (vec (array-seq want)) " vs " (vec (array-seq got))))))
(deftest an-anchor-is-a-peg-written-inline
;; The identity that makes the deletion safe rather than a trade: a node with
;; anchor `a` is exactly a peg at `pos + a` carrying the rotation and scale,
;; parenting a child offset by `-a`. Same matrix, to the last bit of the
;; mantissa — so everything the anchor could express, a parent already could,
;; and the parent can also be keyed, shared, and put over a measured channel.
(let [pos [7 -3] rot 0.9 scale [1.4 0.6] a [11 -6]
;; what T(pos)·T(a)·R·K·S·T(-a) used to produce, built from the parts
anchored (reduce (fn [acc m] (node/mul! (node/mat) acc m))
(js/Float64Array. #js [1 0 0 1 (nth pos 0) (nth pos 1)])
[(js/Float64Array. #js [1 0 0 1 (nth a 0) (nth a 1)])
(local :rot rot :scale scale)
(js/Float64Array. #js [1 0 0 1 (- (nth a 0)) (- (nth a 1))])])
;; the same thing as a peg and a child
peg (local :pos (mapv + pos a) :rot rot :scale scale)
child (local :pos (mapv - a))
world (node/world! (node/mat) peg nil child (node/mat))]
(is (every? (fn [i] (close? (aget anchored i) (aget world i))) (range 6))
(str (vec (array-seq anchored)) " vs " (vec (array-seq world))))))
(deftest mul-may-write-into-either-operand
;; Evaluation composes world := parent · local with dest aliasing local, so
;; that a node's world transform needs no scratch. If mul! wrote before reading,
@ -168,13 +189,31 @@
(is (= [5 5] (ch/value-at (get chs [:xform :pos]) 0 nil)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0 nil))))))
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
(deftest skew-is-in-the-shape-although-nothing-drives-it
;; A decomposition is not extensible after the fact: adding a component later
;; means migrating every stored transform. So both are present from the start,
;; on every kind that is in the picture.
;; means migrating every stored transform. So it is present from the start, on
;; every kind that is in the picture.
(doseq [k (disj node/implemented-kinds :audio)]
(is (contains? (get node/valid-paths k) [:xform :skew]) (str k))
(is (contains? (get node/valid-paths k) [:xform :anchor]) (str k))))
(is (contains? (get node/valid-paths k) [:xform :skew]) (str k))))
(deftest there-is-no-anchor-anywhere-in-the-shape
;; The deletion, asserted rather than assumed. A document carrying one is not
;; migrated, it is invalid — `problems` rejects the channel on every kind — so
;; there is no shape in which a stale stored pivot can come back.
(doseq [k node/implemented-kinds]
(is (not (contains? (get node/valid-paths k) [:xform :anchor])) (str k)))
(is (not (contains? (set node/xform-paths) [:xform :anchor])))
(is (not (contains? node/defaults [:xform :anchor])))
(let [ps (node/problems {:id :x :kind :poly :z "a1"
:channels {[:xform :anchor] (ch/framed [1 2])}})]
(is (seq ps) "a node carrying one does not validate")
;; NAMED, with what to do about it, the way `symbol/problems` refuses
;; `:trace` — every schema-6 drawing and placement carried an anchor, so this
;; is the first thing a person opening an old project sees, and "not valid on
;; a :poly node" would tell them nothing.
(is (some #(re-find #"peg" %) ps) (str "no named refusal: " (pr-str ps)))
(is (not-any? #(re-find #"is not valid on a" %) ps)
(str "the generic path complaint should not also fire: " (pr-str ps)))))
(deftest valid-paths-follow-from-the-kind
(is (contains? (:poly node/valid-paths) [:geom :pts]))

22
frontend/test/arthur/domain/tracing_test.cljs
View file

@ -176,6 +176,20 @@
t (nest/own-time c (:store @frozen) :face-1 [:plate] 30)]
(is (= 30 (* (:rate t) (- 30 (:at t)))) "frame 30 is 30, though it shows 12")))
(defn- middle-on-stage
"Where the picture's own middle lands, for a tracing placement `n`.
`pos + scale · middle`, because a trace's own coordinates are its pixels and
the scaled middle moves with the scale. This used to be `pos + anchor`: with
the anchor ON the middle, `T(a)·S(k)·T(-a)` left that point alone whatever `k`
was, so the sum read correctly without the scale appearing in it at all. That
is the work `events/ui`'s `fitted` now does explicitly."
[doc n]
(let [{:keys [width height]} (clip/symbol doc (node/source n))]
(mapv + (get-in n [:channels [:xform :pos] :value])
(mapv * (get-in n [:channels [:xform :scale] :value])
[(/ width 2) (/ height 2)]))))
(deftest a-dropped-still-lasts-the-rest-of-the-symbol-fits-it-and-is-reused
(let [id (store/install! {:clip (clip/blank) :store {}} "drop-tracing")
sym {:name "sheet" :type :trace :media {:image "abc"}
@ -197,8 +211,7 @@
"as long as what is left of the symbol it landed in")
(is (= [30 (clip/frames doc :main)] (node/placed-span n)))
(is (= [k k] (get-in n [:channels [:xform :scale] :value])) "as tall as the stage")
(is (= [(/ w 2) (/ h 2)] (mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value])))
(is (= [(/ w 2) (/ h 2)] (middle-on-stage doc n))
"dropped on the timeline, it is middled on the stage")
(let [[doc2 n2] (drop!)]
(is (= sid (node/source n2)) "the same picture is the same symbol")
@ -221,9 +234,8 @@
[w h] (clip/stage doc host)
k (min (/ w 3000) (/ h image-h))]
(is (= [k k] (get-in n [:channels [:xform :scale] :value])))
(is (= (or point [(/ w 2) (/ h 2)])
(mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value]))))
(is (= (or point [(/ w 2) (/ h 2)]) (middle-on-stage doc n))
"the picture's middle lands where the drop asked for it, at the fitted scale")
(is (= plate (get-in doc [:symbols :face-1 :nodes :plate]))
"the face's registered tracing placement is unchanged")
(is (= (clip/symbol c sid) (clip/symbol doc sid))

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

@ -203,7 +203,6 @@
(let [c (freeze/head-mode {} @frozen)
res (clip/resolver c :main @store pal/index-of nil)
k (first (:value (chan :place [:xform :scale])))
anc (:value (chan :place [:xform :anchor]))
pos (:value (chan :place [:xform :pos]))
tfs (:transforms @take/measured)]
(doseq [f (range 0 take/frames 13)]
@ -223,10 +222,11 @@
;; the fit removed the head's motion, so putting it back is the fit's
;; inverse. Node :head carries exactly this.
im (geom/apply-sim (freeze/invert (nth tfs ef)) g)
;; And where :place puts it: scaled about the anchor, then translated,
;; which is p ↦ k(p - anchor) + anchor + pos.
wx (+ (* k (- (:x im) (nth anc 0))) (nth anc 0) (nth pos 0))
wy (+ (* k (- (:y im) (nth anc 1))) (nth anc 1) (nth pos 1))]
;; And where :place puts it: scaled about its own origin, then
;; translated, which is p ↦ k·p + pos. The recentring that used to be
;; an `:anchor` is folded into `pos`, so this is the whole of it.
wx (+ (* k (:x im)) (nth pos 0))
wy (+ (* k (:y im)) (nth pos 1))]
(is (some? op) (str "frame " f " emitted no mouth op"))
;; Tolerance is the Float32 transform block's, scaled to stage pixels, and
;; it is three orders below a pixel.
@ -310,100 +310,81 @@
;; The difference from `makeXform` in one assertion: the placement is a FRAMED
;; transform on a node, which a hand can revise, and it claims no generator that
;; would offer to overwrite it.
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale] [:xform :anchor]]]
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(let [c (get (node/channels (node :place)) path)]
(is (= :framed (ch/describe c)) (str path " is not framed"))
(is (nil? (:generated c)) (str path " claims provenance")))))
(deftest a-part-has-a-pivot-exactly-when-a-hand-can-use-one
;; The face's anchor was always the head's centre — the test below — and the
;; parts underneath it had none at all, so each one turned and scaled about ITS
;; OWN origin, which is the top-left corner of the FOOTAGE. On a 320x200 stage
;; the mouth's pivot sat at (-234, -395): off the stage by more than a stage,
;; so a corner drag slid the mouth about instead of resizing it.
(deftest a-freeze-stores-no-pivot-at-all
;; THE PASS THAT USED TO BE HERE IS GONE, and so is the biconditional it
;; needed. `freeze/pivoted` walked every node it had made and wrote the middle
;; of what that node drew into `[:xform :anchor]` — skipping anything
;; `node/measured?`, because an anchor under a measured scale does not cancel
;; out of `node/local!` and writing one would have moved the whole face. So the
;; traced parts a hand most wants to adjust were exactly the ones that could
;; never be given a pivot.
;;
;; BY BICONDITIONAL, over every node the freeze makes, rather than against a
;; list of the ones that happen to have geometry today. The rule `pivoted` goes
;; by is `node/measured?` — the one `gesture/refusal` refuses a hand edit by —
;; so the two have to agree exactly: a pivot is written where a hand could use
;; it and nowhere else. A brow has a dense `[:xform :pos]` and so gets none,
;; which is not an exception to the rule, it is the rule.
;; A derived pivot has no such exception, because there is nothing to write.
(let [c @clip*]
(doseq [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes]))
;; `:place` authors its own in `face-placement`, upstream of this.
:when (not= [:face-1 :place] [sid id])]
(let [n (get-in c [:symbols sid :nodes id])
frames (range (get-in c [:symbols sid :frames]))
anchor (:value (get-in n [:channels [:xform :anchor]]))
usable (and (not (node/measured? n))
(some? (pick/pivot c @store sid n frames)))]
(is (= usable (some? anchor))
(str sid "/" id " has a pivot: " (some? anchor)
", but a hand can use one: " usable))
(is (= (nil? (gesture/refusal n)) (not (node/measured? n)))
(str sid "/" id ": `refusal` and `measured?` disagree"))
(when anchor
(let [bounds (pick/bounds-of c @store sid n)
[x0 y0 x1 y1] (reduce #(let [k (bounds %2)]
(cond (nil? %1) k (nil? k) %1
:else (mapv (fn [op i] (op (nth %1 i) (nth k i)))
[min min max max] (range 4))))
nil frames)]
(is (and (<= x0 (nth anchor 0) x1) (<= y0 (nth anchor 1) y1))
(str sid "/" id "'s pivot " (pr-str anchor) " is outside what it draws, "
(pr-str [x0 y0 x1 y1])))))))))
[id n] (get-in c [:symbols sid :nodes])]
(is (nil? (get-in n [:channels [:xform :anchor]]))
(str sid "/" id " stores a pivot")))))
(deftest the-head-keeps-no-pivot-of-its-own
;; The case that makes `measured?` the right predicate rather than "draws
;; nothing": `:head` carries the measured similarity, so its scale is nowhere
;; near 1 and an anchor on it would NOT cancel out of `node/local!` — it would
;; move the whole face. It is skipped for that reason, and would still be
;; skipped if it were ever given geometry.
(deftest every-part-pivots-inside-what-it-draws-measured-or-not
;; The mouth's pivot used to sit at (-234, -395) on a 320x200 stage — the
;; top-left corner of the FOOTAGE, carried onto the stage — so a corner drag
;; slid the mouth about instead of resizing it. This is that, fixed, and
;; asserted over EVERY node the freeze makes rather than the ones that happened
;; to get an anchor: where a node draws something, the pivot derived for it is
;; inside what it draws, `node/measured?` or not.
(let [c @clip*]
(doseq [sid [:main :face-1]
[id n] (get-in c [:symbols sid :nodes])]
(let [bounds ((pick/bounds-of c @store sid n) 0)
v (gesture/values n 0 @store)
[px py] (gesture/pivot v bounds)]
(is (every? #(js/Number.isFinite %) [px py])
(str sid "/" id "'s pivot is not a point: " (pr-str [px py])))
(if bounds
;; Inside its own bounds, through its own transform — so inside what it
;; draws wherever that transform puts it.
(let [[x0 y0 x1 y1] bounds
[cx cy] (gesture/pivot v bounds)
[ox oy] (gesture/pivot (assoc v :pos [0 0] :rot 0 :scale [1 1]) bounds)]
(is (and (<= x0 ox x1) (<= y0 oy y1))
(str sid "/" id "'s pivot " (pr-str [ox oy])
" is outside what it draws, " (pr-str bounds)))
(is (every? #(js/Number.isFinite %) [cx cy])))
;; A node that draws nothing pivots about its own origin, which in its
;; parent's coordinates is exactly its position. That is the peg rule,
;; and `:head` is where it earns its keep: it carries the measured
;; similarity, so it could never have held an anchor.
(is (= (:pos v) [px py])
(str sid "/" id " draws nothing, so its pivot is its own origin")))))))
(deftest the-head-can-still-not-be-dragged-but-a-peg-over-it-can
;; `measured?` is still the predicate a hand edit is refused by — that has not
;; changed and should not: an edit to a measured channel is thrown away by the
;; next regenerate. What changed is the advice, and that it is now true: the
;; head draws nothing, so it pivots about its own origin, and a peg above it
;; carries a hand transform on channels of its own.
(is (node/measured? (node :head)))
(is (nil? (get-in (node :head) [:channels [:xform :anchor]]))))
(deftest giving-every-part-its-pivot-moves-nothing-on-screen
;; The claim `pivoted`'s docstring makes, asserted in pixels rather than
;; trusted: rotation and scale are the identity on a node a freeze has just
;; made, and at the identity the anchor cancels out of `node/local!`. So the
;; pass decides where a part PIVOTS and nothing else — if it ever renders
;; differently, it has been applied to a node whose transform is not the
;; identity, which is the one way it could go wrong.
(let [c @clip*
;; Every node the freeze makes EXCEPT `:place`, whose anchor
;; `face-placement` authors — which is the set `pivoted` writes.
every (for [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes]))
:when (and (not= [:face-1 :place] [sid id])
(seq (get-in c [:symbols sid :nodes id :channels])))]
[sid id])
anchors #(into {} (for [[sid id] every]
[[sid id] (get-in % [:symbols sid :nodes id
:channels [:xform :anchor]])]))
bare (reduce (fn [c [sid id]]
(update-in c [:symbols sid :nodes id :channels]
dissoc [:xform :anchor]))
c every)
again (freeze/pivoted bare @store)]
(is (every? nil? (vals (anchors bare))) "stripped")
(is (= (anchors c) (anchors again)) "the pass puts back exactly what the freeze wrote")
(doseq [f (range 0 take/frames 17)]
(is (= (render bare f) (render again f))
(str "frame " f " draws differently once every part has a pivot")))))
(is (string? (gesture/refusal (node :head))))
(is (re-find #"peg" (gesture/refusal (node :head)))))
(deftest the-place-puts-the-head-s-centre-where-it-says-it-does
;; anchor + pos is where the anchor lands in the parent, which is what makes
;; `:anchor` the registration point: scale and rotation happen about the head's
;; centre rather than about the corner of the footage, where MediaPipe's
;; normalised space has its origin.
(let [anc (:value (chan :place [:xform :anchor]))
;; k·centroid + pos is where the head's centre lands in the parent, and that is
;; the recentring MediaPipe's space makes necessary: its origin is the image's
;; top-left corner, so head-local geometry is not centred on anything. It used
;; to be an `:anchor`, which made the offset double as a pivot; folded into
;; `pos` it is the same translation — `a + p − k·a` with `p = stage − k·a` — and
;; the face then pivots about the middle of what it actually draws.
(let [k (first (:value (chan :place [:xform :scale])))
pos (:value (chan :place [:xform :pos]))
c (geom/centroid (:ref @take/measured))]
(is (< (abs (- (nth anc 0) (:x c))) 1e-12))
(is (< (abs (- (nth anc 1) (:y c))) 1e-12))
(is (< (abs (- (+ (nth anc 0) (nth pos 0)) (/ W 2))) 1e-9))
(is (< (abs (- (+ (nth anc 1) (nth pos 1)) (* 0.25 H))) 1e-9))))
(is (< (abs (- (+ (* k (:x c)) (nth pos 0)) (/ W 2))) 1e-9))
(is (< (abs (- (+ (* k (:y c)) (nth pos 1)) (* 0.25 H))) 1e-9))))
(deftest the-stage-is-the-clip-s-and-not-the-footage-s
;; Project dimensions are independent of the footage, which is precisely what