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

42
clips/migrations/0016_an_anchor_is_a_peg.py Normal file
View file

@ -0,0 +1,42 @@
"""Schema 7: an anchor is a peg.
`[:xform :anchor]` is gone from the transform. `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.
A pivot nobody chose is now derived from what the node draws, per drag, and stored
nowhere; a pivot to keep is a peg, an ordinary `:group` parent.
Nothing is converted, as in schema 6. Every project is marked 7, and one that
still carries an anchor is refused when it is opened, by name and with what to do
about it — `node/problems` in the frontend.
Not converted rather than not worth converting. Dropping an anchor is in fact
pixel-exact wherever rotation and scale are the identity, since the anchor
cancels out of the composition there — and that is everywhere a freeze, a drop or
a new drawing wrote one. It is NOT exact on anything a hand has since turned or
scaled, where the composed translation is `a + p - M·a`, and it cannot be made
exact at all where `pos` is dense, because tier 2 is content-addressed and not
rewritable here. A conversion would therefore be silent and right for most nodes
and silent and wrong for exactly the ones somebody had hand-placed, which is the
worse failure: a refusal names the document and says what to do.
"""
from django.db import migrations, models
def forwards(apps, schema_editor):
apps.get_model("clips", "Project").objects.update(schema_version=7)
class Migration(migrations.Migration):
dependencies = [("clips", "0015_tracing_images")]
operations = [
migrations.AlterField(
model_name="project",
name="schema_version",
field=models.PositiveIntegerField(default=7),
),
migrations.RunPython(forwards, migrations.RunPython.noop),
]

2
clips/models.py
View file

@ -250,7 +250,7 @@ class Project(models.Model):
settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects", settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects",
) )
name = models.CharField(max_length=200, default="untitled") name = models.CharField(max_length=200, default="untitled")
schema_version = models.PositiveIntegerField(default=6) schema_version = models.PositiveIntegerField(default=7)
seq = models.PositiveBigIntegerField(default=0) seq = models.PositiveBigIntegerField(default=0)
palette = models.CharField(max_length=64, default="arthur/default") palette = models.CharField(max_length=64, default="arthur/default")
created = models.DateTimeField(auto_now_add=True) created = models.DateTimeField(auto_now_add=True)

2
clips/tests/test_api.py
View file

@ -446,7 +446,7 @@ class DocumentTests(TestCase):
self.assertEqual(5, len(response.json()["written"])) self.assertEqual(5, len(response.json()["written"]))
loaded = self.client.get(f"/api/projects/{self.project.id}").json() loaded = self.client.get(f"/api/projects/{self.project.id}").json()
self.assertEqual(6, loaded["schema_version"]) self.assertEqual(7, loaded["schema_version"])
self.assertEqual(1, len(loaded["clips"])) self.assertEqual(1, len(loaded["clips"]))
clip = loaded["clips"][0] clip = loaded["clips"][0]
self.assertEqual("c1", clip["cid"]) self.assertEqual("c1", clip["cid"])

74
docs/animation-model.md
View file

@ -172,7 +172,6 @@ Every animatable property is a channel, and channels are addressed **by path**:
[:xform :rot] {:animated? false :value 0.0} [:xform :rot] {:animated? false :value 0.0}
[:xform :scale] {:animated? false :value [1.0 1.0]} [:xform :scale] {:animated? false :value [1.0 1.0]}
[:xform :skew] {:animated? false :value [0.0 0.0]} [:xform :skew] {:animated? false :value [0.0 0.0]}
[:xform :anchor]{:animated? false :value [0.0 0.0]}
[:geom :pts] {:animated? true :interp :hold :dense {...} :generated {...}} [:geom :pts] {:animated? true :interp :hold :dense {...} :generated {...}}
[:style :color] {:animated? false :value :skin-dark} [:style :color] {:animated? false :value :skin-dark}
[:vis] {:animated? true :interp :hold :keys {0 true, 37 false}}} [:vis] {:animated? true :interp :hold :keys {0 true, 37 false}}}
@ -324,7 +323,7 @@ to change to allow it.
## Transform: decomposed, never a matrix ## Transform: decomposed, never a matrix
```clojure ```clojure
{:pos [x y] :rot θ :scale [sx sy] :skew [kx ky] :anchor [ax ay]} {:pos [x y] :rot θ :scale [sx sy] :skew [kx ky]}
``` ```
Stored decomposed for two reasons. Each component has to be independently Stored decomposed for two reasons. Each component has to be independently
@ -334,18 +333,79 @@ entries is meaningless — a rotation tweened through its matrix shears on the w
Composition, per node: Composition, per node:
``` ```
local = T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor) local = T(pos) · R(rot) · K(skew) · S(scale)
world = world(parent) · pinv · local world = world(parent) · pinv · local
``` ```
`:anchor` is Flash's registration point and Blender's origin: rotation and scale
happen about it, and getting it wrong is why hand-placed parts swing rather than
turn.
`:pinv` is Blender's `parent_inverse`, captured at the moment of parenting so the `:pinv` is Blender's `parent_inverse`, captured at the moment of parenting so the
child does not jump when it acquires a parent. Small, and its absence is the kind child does not jump when it acquires a parent. Small, and its absence is the kind
of thing that makes a parenting feature feel broken. of thing that makes a parenting feature feel broken.
### There is no `:anchor`, because an anchor is a peg
Rotation and scale happen about the node's **own origin**. There is no
registration point in the decomposition, and that is a deletion rather than a
gap, because
```
T(pos) · T(a) · R·K·S · T(-a) ≡ peg at pos+a carrying R·K·S, child at -a
```
to the last bit of the mantissa — `node-test` asserts it. `T(a)·M·T(-a)` is `M`
conjugated by a translation, which is "do `M` in a frame shifted by `a`", and a
**parent already is a shifted frame**. So an anchor was a peg that could not be
selected, could not be keyed, could not be shared between nodes, and could not be
put above a measured channel. Same expressive content, strictly less reach.
What it did, two mechanisms now do, split along who owns the pivot:
**A pivot nobody chose is derived per drag and never stored.** `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` then solves for the position that holds that point
still:
```
q = M⁻¹(c − p) the material point under c
p' = c − M'·q = c − M'·M⁻¹(c − p)
```
so a turn writes `pos` **and** `rot`. Nothing is cached, so nothing can go stale:
the stored anchor was the centre of what the node drew, 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 visibly disagreed and the pivot was wrong.
A symbol with more than one node diverged on the first edit.
**A pivot somebody chose is a peg** — an ordinary `:group` parent, `nest/peg`,
with `:pinv` captured so nothing moves when it appears. Toon Boom's peg, Fusion's
separate Transform node, Harmony's peg-over-the-drawing. It is the answer to the
three things a derived pivot cannot do:
| want | why a derived pivot cannot | what the peg does |
| --- | --- | --- |
| a pivot that persists — an arm turning about its shoulder | a gesture's pivot is the middle of the drawing and lives for one drag | the peg's `pos`, static, nowhere near the middle |
| a pivot that travels — a foot roll | an anchor could only be keyed against `pos`, interpolated in the same breath, the two obliged to agree frame for frame | the peg's `pos` is an ordinary channel, so key it |
| a hand transform over a **measured** one | impossible: `local`'s translation is `pos − M·a`, and under a measured `M` writing `a` moves the thing it was meant to leave alone | the peg's channels are its own, so the hand transform composes outside the measurement, which stays regenerable |
That last row is why the rotoscoped parts were worst. `flow/freeze` used to run a
`pivoted` pass writing a default anchor onto everything it had made, and it
**skipped every `node/measured?` node** — correctly, for the reason in the table.
So the traced mouth, lids and brows got no pivot at all and turned about the
origin of head-local space, which is the top-left corner of the *footage*: on a
320×200 stage the mouth pivoted about (−234, −395), off the stage by more than a
stage. The pass is gone; there is no node a derived pivot can be missing from.
A peg is also how `demo/stage` places its seven faces, and that is the case that
makes the pair necessary rather than tidy: `:scale` is **keyed** — the faces pulse
— and the source's middle has to stay on its authored centre throughout. A static
`pos` cannot do it alone, since `T(pos)·S(k(f))` moves that point whenever `k`
changes. `T(center)·S(k(f))·T(-origin)` does, for every `k`, with nothing keyed
that was not keyed before.
`gesture/refusal` still turns a hand edit on a measured channel away, because the
next regenerate would discard it — but it can now name a way through, and the way
is a peg.
**The similarity fit already produces a decomposition.** `fitSimilarity` returns **The similarity fit already produces a decomposition.** `fitSimilarity` returns
`{s θ tx ty}`, which drops straight into `[:xform :scale]`, `[:xform :rot]` and `{s θ tx ty}`, which drops straight into `[:xform :scale]`, `[:xform :rot]` and
`[:xform :pos]` with no conversion. The analysis output and the animation model `[:xform :pos]` with no conversion. The analysis output and the animation model

20
docs/port-plan.md
View file

@ -146,7 +146,6 @@ Full specification in `docs/animation-model.md`. The subset to build:
[:xform :rot] {:animated? false :value 0.0} [:xform :rot] {:animated? false :value 0.0}
[:xform :scale] {:animated? false :value [1.0 1.0]} [:xform :scale] {:animated? false :value [1.0 1.0]}
[:xform :skew] {:animated? false :value [0.0 0.0]} [:xform :skew] {:animated? false :value [0.0 0.0]}
[:xform :anchor] {:animated? false :value [0.0 0.0]}
[:geom :pts] {:animated? true :interp :hold [:geom :pts] {:animated? true :interp :hold
:dense {:store "sha256:…" :offset 0 :stride 40 :frames 600} :dense {:store "sha256:…" :offset 0 :stride 40 :frames 600}
:generated {:by :roto/lips-outer :analysis "sha256:…" :generated {:by :roto/lips-outer :analysis "sha256:…"
@ -170,15 +169,24 @@ uses to offer a parameter panel instead of raw keys. It lives on the *channel*,
not the node, because a node wants a rotoscoped `[:geom :pts]` and a not the node, because a node wants a rotoscoped `[:geom :pts]` and a
hand-animated `[:xform :pos]` at the same time. hand-animated `[:xform :pos]` at the same time.
`:skew`, `:span`, `:anchor` and `:over` stay in the shape even though nothing `:skew`, `:span` and `:over` stay in the shape even though nothing drives them
drives them yet: each is a component of a decomposition or of a composition yet: each is a component of a decomposition or of a composition order, and adding
order, and adding one later migrates every stored transform. one later migrates every stored transform.
`:anchor` was in this list and has since been **deleted**, which is the one place
the reasoning above came out wrong. It is not a component of the decomposition:
`T(a)·M·T(-a)` is `M` conjugated by a translation, and a parent already is a
translated frame, so an anchor is a peg written inline — one that cannot be
selected, keyed, shared, or put above a measured channel. Rotation and scale
happen about the node's own origin; a pivot nobody chose is derived per drag by
`domain/gesture` and a pivot somebody chose is a peg. See
docs/animation-model.md, "There is no `:anchor`, because an anchor is a peg".
Transform composition, per node: Transform composition, per node:
``` ```
local = T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor) local = T(pos) · R(rot) · K(skew) · S(scale)
world = world(parent) · local world = world(parent) · pinv · local
``` ```
## What the prototype knows that you would otherwise rediscover ## What the prototype knows that you would otherwise rediscover

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

@ -6,8 +6,12 @@
(def layout (reader/read-string (rc/inline "arthur/demo/stage_8625.edn"))) (def layout (reader/read-string (rc/inline "arthur/demo/stage_8625.edn")))
(defn- position-track [center anchor drift phase frames] (defn- position-track
(let [base (mapv - center anchor) "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 [dx dy] drift
wave (fn [f period] (js/Math.sin (* 2 js/Math.PI (/ (+ f phase) period)))) wave (fn [f period] (js/Math.sin (* 2 js/Math.PI (/ (+ f phase) period))))
x0 (wave 0 96) x0 (wave 0 96)
@ -22,6 +26,10 @@
(defn compose (defn compose
"The authored layout plus a source clip -> the composed stage document. "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 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 (`: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. `:linked-to` written there; it does not appear in the document this returns.
@ -35,7 +43,9 @@
question from which drawing that is." question from which drawing that is."
[source] [source]
(let [{:keys [name width height frames symbol instances audio scale]} layout (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)]) [(/ (:width source) 2) (/ (:height source) 2)])
original (get-in source [:symbols :main]) original (get-in source [:symbols :main])
;; Authored id -> uuid, so the `:linked-to` in the EDN resolves to the ;; Authored id -> uuid, so the `:linked-to` in the EDN resolves to the
@ -47,19 +57,53 @@
(throw (ex-info "the stage layout names an instance that is not there" (throw (ex-info "the stage layout names an instance that is not there"
{:in what :id id {:in what :id id
:known (vec (sort-by str (keys by-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 nodes (into
{:root {:id :root :name "stage" :kind :group :z "a1"}} {:root {:id :root :name "stage" :kind :group :z "a1"}}
(map (fn [{:keys [uuid name z span at center anchor drift phase]}] (mapcat (fn [{:keys [uuid peg name z span at center origin drift phase]}]
(let [anchor (or anchor default-anchor)] (let [origin (or origin default-origin)]
[uuid {:id uuid :name name :kind :instance [[peg {:id peg :name name :kind :group
:parent :root :z z :span span :parent :root :z z :span span
:time {:mode :map :at at :rate 1} :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} :source {:symbol symbol}
:channels {[:xform :pos] (if drift :channels {[:xform :pos]
(position-track center anchor drift phase frames) (ch/framed (mapv - origin))}}]]))
(ch/framed (mapv - center anchor)))
[:xform :anchor] {:animated? false :value anchor}
[:xform :scale] scale}}]))
instances)) instances))
nodes (into nodes nodes (into nodes
(map (fn [{:keys [uuid linked-to z source span at gain pan]}] (map (fn [{:keys [uuid linked-to z source span at gain pan]}]

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

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

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

146
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 is in the placement's matrices, so a shape five symbols down moves under the
pointer like one on top. 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 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 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`, changed. Auto-key deliberately replaces that rule with `set-keyed-channel`,
@ -27,7 +42,7 @@
[n f store] [n f store]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) 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)])] 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] (defn- measured-channel? [n path]
(let [c (get-in n [:channels path])] (let [c (get-in n [:channels path])]
@ -38,48 +53,137 @@
accept authored correction layers; measured scale cannot yet be decomposed accept authored correction layers; measured scale cannot yet be decomposed
safely. The one-argument form asks whether any stage gesture is possible." safely. The one-argument form asks whether any stage gesture is possible."
([n] (when (node/measured? n) ([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] ([n kind]
(when (and (= :scale kind) (measured-channel? n [:xform :scale])) (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]] (defn- through [m [x y]]
(let [out (js/Float64Array. 2)] (let [out (js/Float64Array. 2)]
(node/apply-pt! out 0 m x y) (node/apply-pt! out 0 m x y)
[(aget out 0) (aget out 1)])) [(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 (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] [{:keys [parent]} {:keys [pos]} p0 p1]
(when-let [inv (node/invert parent)] (when-let [inv (node/invert parent)]
{[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))})) {[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))}))
(defn angle (defn angle
"The angle of stage point `p` about the node's pivot, in the space its "The angle of stage point `p` about parent-space pivot `c`, in the space the
rotation is in." node's rotation is in."
[{:keys [parent]} {:keys [pos anchor]} p] [{:keys [parent]} c p]
(when-let [inv (node/invert parent)] (when-let [inv (node/invert parent)]
(let [[x y] (mapv - (through inv p) (mapv + pos anchor))] (let [[x y] (mapv - (through inv p) c)]
(js/Math.atan2 y x)))) (js/Math.atan2 y x))))
(defn turn (defn turn
"The node's rotation, turned by `da` radians." "The node turned by `da` radians about parent-space point `c`: the rotation,
[{:keys [rot]} da] and the position that holds `c` still.
{[:xform :rot] (+ rot da)})
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 (defn scale
"The node's scale with the point under stage `p0` taken to `p1`, about its "The node's scale with the point under stage `p0` taken to `p1`, about
pivot, along its own axes — or by the same factor on both when `uniform?`." parent-space pivot `c`, along the node's own axes — or by the same factor on
[{:keys [world]} {:keys [anchor] s :scale} p0 p1 uniform?] both when `uniform?` — and the position that holds `c` still.
(when-let [inv (node/invert world)]
(let [a (mapv - (through inv p0) anchor) The factors are measured in the node's OWN coordinates, which is what makes a
b (mapv - (through inv p1) anchor) 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))) k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a)))
r (if uniform? r (when uniform?
(let [aa (reduce + (map * a a))] (let [aa (reduce + (map * a a))]
(if (< aa 1e-9) 1 (/ (reduce + (map * a b)) aa))) (if (< aa 1e-9) 1 (/ (reduce + (map * a b)) aa))))
nil)] s (:scale v)
{[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))}))) 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) (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 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` matrix becomes a `:pinv`, Blender's parent-inverse, and the time a new `:at`
and `:rate`. Its channels, keys and span are untouched." 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.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.span :as span] [arthur.domain.span :as span]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
@ -601,8 +604,9 @@
The new symbol starts where the earliest of them starts and ends where the 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. 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 Its instance sits at the identity, so nothing moves. It stores no pivot: an
middle of what it now holds." 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] [clip store open froms sid uuid f]
(let [host-path (pop (first froms)) (let [host-path (pop (first froms))
{host :sid frame :frame} (inside clip store open host-path f) {host :sid frame :frame} (inside clip store open host-path f)
@ -633,7 +637,81 @@
(node/mat) back)] (node/mat) back)]
(if (:refused r) (reduced r) r))) (if (:refused r) (reduced r) r)))
{:clip made} froms)] {:clip made} froms)]
(cond-> moved moved))))
(:clip moved) (update :clip assoc-in
[:symbols host :nodes uuid :channels [:xform :anchor] :value] ;; ---------------------------------------------------------------------------
(clip/center (:clip moved) store sid))))))) ;; 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 (def xform-paths
"In composition order, which is also the order they have to be sampled in. "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 :skew is in here although nothing drives it yet. A decomposition is not
decomposition is not extensible after the fact: adding a component later means extensible after the fact: adding a component later means migrating every
migrating every stored transform, so both are in the shape and in the stored transform, so it is in the shape and in the composition order from the
composition order from the start." start.
[[:xform :pos] [:xform :rot] [:xform :scale] [:xform :skew] [:xform :anchor]])
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 (def valid-paths
"The set of valid channel paths follows from the node's :kind, and that is a "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 :rot] (ch/framed 0.0)
[:xform :scale] (ch/framed [1.0 1.0]) [:xform :scale] (ch/framed [1.0 1.0])
[:xform :skew] (ch/framed [0.0 0.0]) [:xform :skew] (ch/framed [0.0 0.0])
[:xform :anchor] (ch/framed [0.0 0.0])
[:vis] (ch/framed true)}) [:vis] (ch/framed true)})
(def audio-defaults (def audio-defaults
@ -87,13 +97,14 @@
(defn measured? (defn measured?
"Is this node's transform regenerated from the footage rather than authored? "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 What it guards is that a hand edit to a measured transform is thrown away by
edit to a measured transform is thrown away by the next regenerate, which is the next regenerate, which is what `gesture/refusal` refuses. The way to
what `gesture/refusal` refuses — and a DEFAULT written under one is worse than transform one of these by hand is a PEG above it: the hand transform is then on
useless, which is what `flow/freeze`'s pivot pass declines to do. A node a hand a node of its own and the measured channels underneath are left to be
cannot transform has no use for a pivot, and at a measured scale an anchor does regenerated. Nothing has to be written onto the measured node at all, which is
not cancel out of `local!` the way it does at the identity, so writing one what the old pivot default could never manage — an anchor under a measured
would move the very thing it was meant to leave alone." scale does not cancel out of `local!`, so writing one moved the very thing it
was meant to leave alone."
[n] [n]
(boolean (some #(let [c (get-in n [:channels [:xform %]])] (boolean (some #(let [c (get-in n [:channels [:xform %]])]
(or (:dense c) (:generated c))) (or (:dense c) (:generated c)))
@ -352,10 +363,10 @@
dest)) dest))
(defn local! (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 Written out closed-form rather than as four matrix products, because this runs
per node per frame and the five products would each allocate. The derivation, per node per frame and the four products would each allocate. The derivation,
so the constants are checkable rather than trusted: so the constants are checkable rather than trusted:
R·K·S = | c -s | · | 1 kx | · | sx 0 | R·K·S = | c -s | · | 1 kx | · | sx 0 |
@ -367,32 +378,28 @@
R·K·S = | sx(c - s·ky) sy(c·kx - s) | R·K·S = | sx(c - s·ky) sy(c·kx - s) |
| sx(s + c·ky) sy(s·kx + c) | | sx(s + c·ky) sy(s·kx + c) |
and the translation is anchor + pos - M·anchor, which is what makes rotation and the translation is pos itself, because rotation and scale happen about the
and scale happen ABOUT the anchor. :anchor is Flash's registration point and node's OWN ORIGIN and nothing else. Turning about any other point is
Blender's origin, and getting it wrong is why hand-placed parts swing rather `gesture/about`, which solves for the `pos` that holds the chosen point still
than turn. 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 :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." 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) (let [c (js/Math.cos rot)
s (js/Math.sin rot) s (js/Math.sin rot)
sx (ch/component scale 0) sx (ch/component scale 0)
sy (ch/component scale 1) sy (ch/component scale 1)
kx (ch/component skew 0) kx (ch/component skew 0)
ky (ch/component skew 1) ky (ch/component skew 1)]
ax (ch/component anchor 0) (aset dest 0 (* sx (- c (* s ky))))
ay (ch/component anchor 1) (aset dest 1 (* sx (+ s (* c ky))))
a (* sx (- c (* s ky))) (aset dest 2 (* sy (- (* c kx) s)))
b (* sx (+ s (* c ky))) (aset dest 3 (* sy (+ (* s kx) c)))
cc (* sy (- (* c kx) s)) (aset dest 4 (ch/component pos 0))
d (* sy (+ (* s kx) c))] (aset dest 5 (ch/component pos 1))
(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)))))
dest)) dest))
(defn pinv (defn pinv
@ -479,6 +486,10 @@
(not (and (finite-number? (get-in n [:time :rate])) (not (and (finite-number? (get-in n [:time :rate]))
(pos? (get-in n [:time :rate]))))) (pos? (get-in n [:time :rate])))))
(conj ":time :rate must be positive") (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") (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))) (and (:span n) (not (and (vector? (:span n)) (= 2 (count (:span n)))
(every? finite-number? (:span n)) (every? finite-number? (:span n))
@ -491,9 +502,15 @@
(or (empty? hs) (apply < hs)))))) (or (empty? hs) (apply < hs))))))
(conj ":time :holds must be a vector of increasing frames")) (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 (into (when valid
(for [[path _] (:channels n) (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")))) (str "channel " (pr-str path) " is not valid on a " k " node"))))
(into (for [[path c] (:channels n) (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)))) {:id id :name (str "shape " (inc (count (shapes clip sid))))
:kind :poly :paint? true :parent nil :z z :kind :poly :paint? true :parent nil :z z
:span [frame end] :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) :channels {geometry (channel/keyed {frame points} :hold)
[:style :color] (channel/framed color) [: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))]))}})
clip))) clip)))
(defn add-key [clip sid id frame] (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))) (subvec hit 0 (inc (count selected)))
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 (defn bounds-of
"A closure from a frame to `[x0 y0 x1 y1]` around what node `n` draws on it, in "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. 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 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 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 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 is a resolver per frame.
instances rather than the one walk it is."
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] [document store sid n]
(let [grow (fn [[x0 y0 x1 y1 :as b] x y] (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])) (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])] (let [s (at f [:geom :size])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h])))) (when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h]))))
(constantly nil)))) (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] (:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire])) [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 (defn block-keys
"Every tier-2 key a leaf map names, in a stable order." "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)) (quot (if (vector? pts) (count pts) (.-length pts)) 2))
(defn- xform-at (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." them has no value on it."
[rd] [rd]
(let [pos (rd [:xform :pos]) (let [pos (rd [:xform :pos])
rot (rd [:xform :rot]) rot (rd [:xform :rot])
scl (rd [:xform :scale]) scl (rd [:xform :scale])
skw (rd [:xform :skew]) skw (rd [:xform :skew])]
anc (rd [:xform :anchor])]
(when-not (or (ch/nothing? pos) (ch/nothing? rot) (ch/nothing? scl) (when-not (or (ch/nothing? pos) (ch/nothing? rot) (ch/nothing? scl)
(ch/nothing? skw) (ch/nothing? anc)) (ch/nothing? skw))
[pos rot scl skw anc]))) [pos rot scl skw])))
(defn- visible? (defn- visible?
"Is the node switched on this frame? "Is the node switched on this frame?
@ -423,10 +422,10 @@
plf (node/local-frame n ppf) plf (node/local-frame n ppf)
rd (fn [path] (read id path (get chs path) lf plf))] rd (fn [path] (read id path (get chs path) lf plf))]
(when (visible? id (rd [:vis])) (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 ;; dest aliases `local` here, which mul! allows: it reads both
;; operands fully before writing either. ;; 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) {:m (node/world! m (:m parent) (pinv-for id) m scratch)
:f lf :f lf
:pre plf :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 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. 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?] [document sid uuid {:keys [width height]} point?]
(let [[w h] (clip/stage document sid) (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] (update-in document [:symbols sid :nodes uuid :channels]
(fn [chs] (fn [chs]
(cond-> (assoc chs [:xform :scale] (ch/framed [k k])) (let [where (if point?
(not point?) (mapv + (:value (get chs [:xform :pos])) mid)
(assoc [:xform :pos] [(/ w 2) (/ h 2)])]
(ch/framed (mapv - [(/ w 2) (/ h 2)] (assoc chs
(:value (get chs [:xform :anchor])))))))))) [:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed (mapv - where (mapv * [k k] mid)))))))))
(rf/reg-event-db (rf/reg-event-db
::drop-symbol ::drop-symbol
@ -1346,6 +1363,24 @@
uuid (conj host uuid)]) uuid (conj host uuid)])
(update-in [:ui :expanded] conj (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 (rf/reg-event-db
::edit-keyframes ::edit-keyframes
(fn [db [_ items delta]] (fn [db [_ items delta]]

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

@ -37,7 +37,6 @@
[arthur.domain.feature :as feature] [arthur.domain.feature :as feature]
[arthur.domain.geom :as geom] [arthur.domain.geom :as geom]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.pick :as pick]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.flow.address :as address])) [arthur.flow.address :as address]))
@ -401,9 +400,10 @@
cy (/ (+ y0 y1) 2) cy (/ (+ y0 y1) 2)
k (min (/ (* 0.8 w) (max 1e-9 (- x1 x0))) k (min (/ (* 0.8 w) (max 1e-9 (- x1 x0)))
(/ (* 0.8 h) (max 1e-9 (- y1 y0))))] (/ (* 0.8 h) (max 1e-9 (- y1 y0))))]
{[:xform :anchor] (ch/framed [cx cy]) ;; `pos` alone, because `T(a)·S(k)·T(-a)` translates by `a − k·a`: folding
[:xform :scale] (ch/framed [k k]) ;; that into the position is the same pixels with no stored pivot.
[:xform :pos] (ch/framed [(- (/ w 2) cx) (- (/ h 2) cy)])})) {[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) (* k cx)) (- (/ h 2) (* k cy))])}))
(defn face-placement (defn face-placement
"The face's transform on the stage, as FRAMED channels. "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 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. composited onto a 320x200 stage is not a problem to solve.
ANCHOR is the reference centroid, and this is where `:anchor` earns its place. POSITION puts the reference centroid a QUARTER of the way down the stage,
MediaPipe's normalised space has its origin at the image's TOP-LEFT CORNER, so because the rigid landmarks are eyes and nose — the upper middle of a face — so
head-local geometry is not centred on anything; the registration point of the a quarter down leaves the jaw and the mouth on the stage. Whatever hangs off is
face is the head's own centre, and rotation and scale have to happen about that clipped, which is not a feature to add: every fill in `domain/raster` clamps
rather than about a corner of the footage. Getting that wrong is why hand-placed already.
parts swing rather than turn.
POSITION puts the anchor a QUARTER of the way down the stage, because the rigid THE CENTROID IS IN THE POSITION, NOT IN A PIVOT. MediaPipe's normalised space
landmarks are eyes and nose — the upper middle of a face — so a quarter down has its origin at the image's TOP-LEFT CORNER, so head-local geometry is not
leaves the jaw and the mouth on the stage. Whatever hangs off is clipped, which centred on anything and the placement has to carry the offset to the head's own
is not a feature to add: every fill in `domain/raster` clamps already. 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 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 measured across all of them together — which is what keeps two faces filmed
@ -462,10 +464,9 @@
c (geom/centroid ref) c (geom/centroid ref)
span (- (reduce max (map :x ref)) (reduce min (map :x ref))) span (- (reduce max (map :x ref)) (reduce min (map :x ref)))
k (/ (* 0.4 w) span)] k (/ (* 0.4 w) span)]
{[:xform :anchor] (ch/framed [(:x c) (:y c)]) {[:xform :scale] (ch/framed [k k])
[:xform :scale] (ch/framed [k k]) [:xform :pos] (ch/framed [(- (/ w 2) (* k (:x c)))
[:xform :pos] (ch/framed [(- (/ w 2) (:x c)) (- (* 0.25 h) (* k (:y c)))])}))))
(- (* 0.25 h) (:y c))])}))))
(defn- mouth-part [subject absent? obs (defn- mouth-part [subject absent? obs
{:keys [analysis verts anchor-avg contour-avg aperture-cut] :as params} {: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)})) :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 (defn clip
"Subject-id -> conditioned measurements becomes one symbol per face, and a "Subject-id -> conditioned measurements becomes one symbol per face, and a
symbol called :main that places them. symbol called :main that places them.
@ -872,8 +833,7 @@
{:subject subject :feature id :frames nf :actual (count track)})))) {:subject subject :feature id :frames nf :actual (count track)}))))
(let [store (merged :store)] (let [store (merged :store)]
{:store store {:store store
:clip (-> (reduce (fn [c [subject inputs]] :clip (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :trace (get inputs :trace (:trace params))} (head-mode {:subject subject :trace (get inputs :trace (:trace params))}
{:clip c})) {:clip c}))
built ordered) built ordered)})))
(pivoted store))})))

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

@ -149,14 +149,20 @@
(rf/dispatch [::ui/select nil])))) (rf/dispatch [::ui/select nil]))))
(defn- begin! (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] [{:keys [open f] :as ctx} kind path p]
(let [{document :clip st :store} (loaded ctx)] (let [{document :clip st :store} (loaded ctx)]
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)] (when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
(let [n (get-in document [:symbols sid :nodes id]) (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 (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]}] (defn- stage-bounds [{:keys [world bounds]}]
(when (and world bounds) (when (and world bounds)
@ -184,23 +190,26 @@
(and (seq members) box) (and (seq members) box)
(reset! gesture {:kind kind :members members :p0 p :box 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 (case kind
:move (gesture/move pl v0 p0 p) :move (gesture/move pl v0 p0 p)
:scale :scale
(let [d0 (max 1e-6 (js/Math.hypot (- (first p0) cx) (- (second p0) cy))) (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) k (/ (js/Math.hypot (- (first p) cx) (- (second p) cy)) d0)]
[px py] (through (:world pl) (:anchor v0)) (when-let [inv (node/invert (:parent pl))]
target [(+ cx (* k (- px cx))) (+ cy (* k (- py cy)))] (gesture/scale-by v0 (through inv [cx cy]) k)))
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))})))
nil)) nil))
(defn- drag! [p ^js event] (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) shift? (.-shiftKey event)
moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))] moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))]
(when moved? (when moved?
@ -217,14 +226,14 @@
(do (reset! gesture nil) (rf/dispatch [::ui/refuse why])) (do (reset! gesture nil) (rf/dispatch [::ui/refuse why]))
(let [vs (case kind (let [vs (case kind
:move (gesture/move pl v0 p0 p) :move (gesture/move pl v0 p0 p)
:scale (gesture/scale pl v0 p0 p shift?) :scale (gesture/scale pl v0 c p0 p shift?)
:turn (let [b (gesture/angle pl v0 p) :turn (let [b (gesture/angle pl c p)
d (- b a) d (- b a)
t (+ turned (- d (* 2 js/Math.PI (js/Math.round (/ d (* 2 js/Math.PI)))))) t (+ turned (- d (* 2 js/Math.PI (js/Math.round (/ d (* 2 js/Math.PI))))))
q (/ js/Math.PI 12)] q (/ js/Math.PI 12)]
(swap! gesture assoc :a b :turned t) (swap! gesture assoc :a b :turned t)
;; ⇧ turns in 15° steps, as everywhere. ;; ⇧ turns in 15° steps, as everywhere.
(gesture/turn v0 (if shift? (gesture/turn v0 c (if shift?
(- (* q (js/Math.round (/ (+ (:rot v0) t) q))) (:rot v0)) (- (* q (js/Math.round (/ (+ (:rot v0) t) q))) (:rot v0))
t))))] t))))]
(when vs (when vs
@ -247,12 +256,28 @@
"The selected node's box, drawn through its own transform so it turns with "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 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 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] [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]) [_ _ _ path] @(rf/subscribe [::sub/selection])
[ax ay] (when world (:anchor (gesture/values node frame (:store (loaded ctx))))) [px py] (when world
[px py] (when world (through world [ax ay])) (let [[x0 y0 x1 y1] bounds]
(through world (if bounds
[(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]
[0 0]))))
grab (fn [kind] grab (fn [kind]
(fn [^js event] (fn [^js event]
(.stopPropagation event) (.stopPropagation event)

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

@ -58,6 +58,11 @@
selections @(rf/subscribe [::sub/selections]) selections @(rf/subscribe [::sub/selections])
clipboard @(rf/subscribe [::sub/clipboard]) clipboard @(rf/subscribe [::sub/clipboard])
selected? (boolean (seq selections)) 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") title (or project-name "untitled")
commit! (fn [] commit! (fn []
(rf/dispatch [::project/rename @draft]) (rf/dispatch [::project/rename @draft])
@ -85,7 +90,14 @@
{:label "duplicate unique" {:label "duplicate unique"
:sub "Duplicate with a private nested symbol graph · ⇧⌘/Ctrl D" :sub "Duplicate with a private nested symbol graph · ⇧⌘/Ctrl D"
:disabled? (not selected?) :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] [snapshots/view]
(if @renaming? (if @renaming?
[:input.project-name {:auto-focus true :value @draft [: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) (clip/place-symbol nil :mid :box 2 v nil)
(turn :main u [40 20] (/ js/Math.PI 2) [2 2]) (turn :main u [40 20] (/ js/Math.PI 2) [2 2])
(turn :mid v [5 -3] 0.3 [1.5 0.5]) (turn :mid v [5 -3] 0.3 [1.5 0.5])
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow) (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])))))
(defn- drawn [c path] (defn- drawn [c path]
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %)) (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- 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] (defn- dragged [c path f vs-fn]
(let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16) (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)] 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 (deftest a-shape-two-symbols-down-moves-under-the-pointer
(doseq [path [[u] [u v] [u v :shape]]] (doseq [path [[u] [u v] [u v :shape]]]
(let [c (two-down) (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])) (is (near? (map (fn [[x y]] [(+ x 7) (- y 4)]) (drawn c [u v :shape]))
(drawn moved [u v :shape])) (drawn moved [u v :shape]))
(str "moving " path " by (7, -4) on the stage moves the shape by (7, -4)"))))) (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]))))) (get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :interp])))))
(deftest turning-keeps-the-pivot-where-it-is (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) (let [c (two-down)
path [u v :shape] path [u v :shape]
{:keys [world]} (nest/placement c nil :main path 16) {:keys [world]} (nest/placement c nil :main path 16)
pivot #(let [out (js/Float64Array. 2)] pivot #(let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 (:world (nest/placement % nil :main path 16)) 5 3)))) (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 0.7))] turned (dragged c path 16 #(gesture/turn %2 %3 0.7))]
(is (some? world)) (is (some? world))
(is (near? (pivot c) (pivot turned)) "the anchor stays put") (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 (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 (deftest scaling-takes-the-grabbed-point-to-the-pointer
(let [c (two-down) (let [c (two-down)
@ -83,37 +94,43 @@
at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3))) at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3)))
p0 (at world 10 0) p0 (at world 10 0)
p1 [(+ (first p0) 3) (- (second p0) 5)] 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))] w2 (:world (nest/placement grown nil :main path 16))]
(is (near? p1 (at w2 10 0)) (is (near? p1 (at w2 10 0))
"the corner grabbed is under the pointer, through a turned, unevenly scaled parent") "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 ;; which way a corner drag goes
;; ;;
;; `scale` takes the point under the pointer to the pointer, about the node's ;; `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 ;; 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 ;; decided entirely by where the pivot is. In the middle of what the node draws,
;; draws, where `clip/place-symbol`, `paint/new-shape` and now `flow/freeze` all ;; which is where `gesture/pivot` derives it, pulling a corner away from the
;; put it, pulling a corner away from the middle makes the node bigger. With it ;; middle makes the node bigger. At the node's coordinate ORIGIN — which is what
;; at the node's coordinate ORIGIN, which is what a node with no anchor gets, ;; a node whose stored anchor had never been written got, and for head-local
;; every corner drag is a drag away from some point off in the corner of the ;; geometry is the top-left corner of the FOOTAGE — every corner drag is a drag
;; footage: the shape shrinks and slides while the corner dutifully follows the ;; away from a point off in the corner: the shape shrinks and slides while the
;; pointer, which is what the bug looked like from the outside. ;; 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)] (defn- at [m p] (let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 m (first p) (second p)))))) (vec (array-seq (node/apply-pt! out 0 m (first p) (second p))))))
(defn- handles (defn- handles
"Where the stage would draw this node's box and pivot: its own bounds and "Where the stage would draw this node's box and pivot: its own bounds through
anchor through its `:world`, which is what `ui/stage`'s `handles` does." 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] [c st open path f]
(let [{:keys [sid id world frame]} (nest/placement 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]) n (get-in c [:symbols sid :nodes id])
[x0 y0 x1 y1] ((pick/bounds-of c st sid n) frame)] [x0 y0 x1 y1] ((pick/bounds-of c st sid n) frame)]
{:corners (mapv #(at world %) [[x0 y0] [x1 y0] [x1 y1] [x0 y1]]) {: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 (defn- span
"How big the box is, as the length of its diagonals — which does not care that "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] [c st open path f i d]
(let [{:keys [sid id frame] :as pl} (nest/placement c st open path f) (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) 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) p0 (nth (:corners (handles c st open path f)) i)
p1 (mapv + p0 d)] 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})) :p0 p0 :p1 p1}))
(defn- away (defn- away
@ -141,22 +159,13 @@
len (max 1e-9 (js/Math.hypot dx dy))] len (max 1e-9 (js/Math.hypot dx dy))]
[(* k (/ dx len)) (* k (/ dy len))])) [(* 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 (deftest dragging-a-corner-away-from-the-middle-makes-it-bigger
(doseq [[what c path f] (doseq [[what c path f]
[["a shape on its own" [["a shape on its own"
(paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow) (paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow)
[:shape] 4] [:shape] 4]
["a shape two symbols down, through a turned and unevenly scaled parent" ["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)] i (range 4)]
(let [before (handles c nil :main path f) (let [before (handles c nil :main path f)
out (corner-drag c nil :main path f i (away before i 6)) 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 (deftest a-face-part-scales-about-its-own-middle
;; The whole measured rig, from `demo/take`: source-space geometry under a ;; The whole measured rig, from `demo/take`: source-space geometry under a
;; dense head similarity, under the authored source placement, inside an ;; dense head similarity, under the authored source placement, inside an
;; instance. Before `freeze/pivoted` the mouth's pivot sat at (-234, -395) on a ;; instance. The mouth's pivot used to sit at (-234, -395) on a 320x200 stage —
;; 320x200 stage — the top-left corner of the FOOTAGE, carried onto the stage — ;; the top-left corner of the FOOTAGE, carried onto the stage — because its
;; and every corner drag was a drag away from it. ;; 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 (let [{c :clip st :store} @take/frozen
f 10] f 10]
(doseq [path [[:face-1] [:face-1 :mouth] [:face-1 :eye-r]]] (doseq [path [[:face-1] [:face-1 :mouth] [:face-1 :eye-r]]]
@ -225,7 +237,7 @@
(let [v (gesture/values n 10 st)] (let [v (gesture/values n 10 st)]
(is (map? v) (str sid "/" id " could not be read at all")) (is (map? v) (str sid "/" id " could not be read at all"))
(is (every? #(or (number? %) (ch/nothing? %)) (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)))) (str sid "/" id " did not read as numbers: " (pr-str v))))
(when (node/measured? n) (when (node/measured? n)
(is (thrown? js/Error (gesture/values n 10 nil)) (is (thrown? js/Error (gesture/values n 10 nil))
@ -243,8 +255,8 @@
;; jumps on the first pointermove. Two drags have to compose. ;; jumps on the first pointermove. Two drags have to compose.
(let [c (two-down) (let [c (two-down)
path [u v :shape] path [u v :shape]
once (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26])) once (dragged c path 16 (fn [pl v0 _] (gesture/move pl v0 [30 30] [37 26])))
twice (dragged once path 16 #(gesture/move %1 %2 [30 30] [33 31])) 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. ;; 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) 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)] 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 (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]] (let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]]
(constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear))) (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]]) 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)))) (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") "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} (is (= {:animated? false :value 0.4}

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

@ -3,6 +3,7 @@
[arthur.demo.stage :as stage] [arthur.demo.stage :as stage]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
@ -150,6 +151,14 @@
[document id] [document id]
(get-in document [:symbols :main :nodes (uuid-of 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 (deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)] (let [document (stage/compose source)]
(is (empty? (clip/problems document))) (is (empty? (clip/problems document)))
@ -171,25 +180,41 @@
(is (= 7 (count (distinct (map #(:name (val %)) symbols)))))))) (is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :instance (:kind %)) (is (= 7 (count (filter #(= :instance (:kind %))
(vals (get-in document [:symbols :main :nodes])))))) (vals (get-in document [:symbols :main :nodes]))))))
(is (= [0 232] (:span (placement document :right))) "its own frames, from its own 0") (is (= [0 232] (:span (peg 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") (is (= [48 280] (node/placed-span (peg document :right))) "and where that sits on the stage")
(let [left (placement document :left) (is (= (uuid-of :right) (:id (placement document :right))))
scale (get-in left [:channels [:xform :scale]]) (is (= (:id (peg document :right)) (:parent (placement document :right)))
anchor (get-in left [:channels [:xform :anchor] :value]) "the face hangs off its peg")
pos (get-in left [:channels [:xform :pos]]) (testing "a keyed scale happens about the pinned point, and that is the peg"
start-pos (ch/value-at pos 0 nil)] ;; THE CASE THAT MAKES A PEG NECESSARY. `:scale` is keyed — the faces pulse
(is (= [160 100] anchor) "the source center becomes a stored pivot") ;; — and the source's middle has to stay on the authored `:center` through
(is (= [-120 -60] start-pos)) ;; all of it. A stored anchor used to buy that with a static position; with
(is (not= start-pos (ch/value-at pos 40 nil)) "the face drifts during playback") ;; `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.4 0.4] (ch/value-at scale 0 nil)))
(is (= [0.56 0.56] (ch/value-at scale 12 nil))) (is (= [0.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48 nil))) (is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]] (doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f nil) [0 0] anchor) (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)] out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100) (node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)]) (is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales")))) (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" (testing "the editorial link resolves to the placement's uuid"
;; The EDN names `:right`; the document must carry the identity, or the link ;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it ;; dangles the moment anything is renamed. `clip/problems` above checks it
@ -333,18 +358,34 @@
[:symbols :main :nodes u :channels]))] [:symbols :main :nodes u :channels]))]
(is (= [25 35] (clip/center c nil :box)) "the middle of the square") (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") (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" (testing "a placement stores a position and no pivot at all"
(is (= [25 35] (get-in (placed c :box nil) [[:xform :anchor] :value]))) (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])) (is (= [0 0] (get-in (placed c :box nil) [[:xform :pos] :value]))
"dropped on the timeline: where it was drawn")) "dropped on the timeline: where it was drawn"))
(testing "dropped on a stage pixel, its middle goes there" (testing "dropped on a stage pixel, its middle goes there"
(is (= [75 65] (get-in (placed c :box [100 100]) [[:xform :pos] :value])))) (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" (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) (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"))] 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") ;; what `gesture/pivot` derives for the instance, before and after
(is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value])) pivot-of (fn [doc]
"the instance's did not"))))) (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 (deftest palette-context-is-inherited-keyed-and-overridable
(let [palette (fn [id name a b] (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]] (:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.demo.take :as take]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.palette :as pal])) [arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]))
(defn- nested (defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing." "Three symbols: :outer places :inner, and :loose is placed by nothing."
@ -383,3 +386,108 @@
(is (nil? (get-in slid [:symbols :lane :nodes :a])) (is (nil? (get-in slid [:symbols :lane :nodes :a]))
"a fully covered neighbor is removed") "a fully covered neighbor is removed")
(is (empty? (clip/problems slid))))) (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? [a b] (< (js/Math.abs (- a b)) 1e-12))
(defn- close-pt? [[ax ay] [bx by]] (and (close? ax bx) (close? ay by))) (defn- close-pt? [[ax ay] [bx by]] (and (close? ax bx) (close? ay by)))
(defn- local [& {:keys [pos rot scale skew anchor] (defn- local [& {:keys [pos rot scale skew]
:or {pos [0 0] rot 0 scale [1 1] skew [0 0] anchor [0 0]}}] :or {pos [0 0] rot 0 scale [1 1] skew [0 0]}}]
(node/local! (node/mat) pos rot scale skew anchor)) (node/local! (node/mat) pos rot scale skew))
;; ---- the transform, component by component ---- ;; ---- the transform, component by component ----
@ -28,16 +28,19 @@
(is (close-pt? [0 10] (pt (local :rot (/ js/Math.PI 2)) 10 0))) (is (close-pt? [0 10] (pt (local :rot (/ js/Math.PI 2)) 10 0)))
(is (= [20 21] (pt (local :scale [2 3]) 10 7)))) (is (= [20 21] (pt (local :scale [2 3]) 10 7))))
(deftest rotation-and-scale-happen-about-the-anchor (deftest rotation-and-scale-happen-about-the-nodes-own-origin
;; :anchor is Flash's registration point and Blender's origin. Getting it wrong ;; THERE IS NO :anchor, and this is the half of that which lives here: a local
;; is why hand-placed parts SWING rather than turn, and a swing looks like a ;; transform turns and scales about [0 0] of the node's own space and nothing
;; parenting bug rather than like a wrong pivot. ;; else. Turning about any other point is `gesture/about`, which solves for the
(let [m (local :rot (/ js/Math.PI 2) :anchor [10 0])] ;; `pos` that holds that point still — see `gesture-test`. The two together are
(is (close-pt? [10 0] (pt m 10 0)) "the anchor itself is a fixed point") ;; what the anchor used to be, with no stored pivot to fall out of step with the
(is (close-pt? [10 10] (pt m 20 0)) "and the rest turns about it")) ;; drawing.
(let [m (local :scale [2 2] :anchor [10 10])] (let [m (local :rot (/ js/Math.PI 2))]
(is (close-pt? [10 10] (pt m 10 10))) (is (close-pt? [0 0] (pt m 0 0)) "the origin is the fixed point")
(is (close-pt? [30 30] (pt m 20 20))))) (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 (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 ;; 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")) (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 (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 ;; 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, ;; produces a transform that is right at the origin and wrong everywhere else,
;; which is exactly the kind of wrong that survives inspection. ;; 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])) 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) R (fn [t] (js/Float64Array. #js [(js/Math.cos t) (js/Math.sin t)
(- (js/Math.sin t)) (js/Math.cos t) 0 0])) (- (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])) S (fn [[sx sy]] (js/Float64Array. #js [sx 0 0 sy 0 0]))
step (fn [acc m] (node/mul! (node/mat) acc m)) step (fn [acc m] (node/mul! (node/mat) acc m))
want (reduce step (T (nth pos 0) (nth pos 1)) want (reduce step (T (nth pos 0) (nth pos 1))
[(T (nth anchor 0) (nth anchor 1)) [(R rot) (K skew) (S scale)])
(R rot) (K skew) (S scale) got (local :pos pos :rot rot :scale scale :skew skew)]
(T (- (nth anchor 0)) (- (nth anchor 1)))])
got (local :pos pos :rot rot :scale scale :skew skew :anchor anchor)]
(is (every? (fn [i] (close? (aget want i) (aget got i))) (range 6)) (is (every? (fn [i] (close? (aget want i) (aget got i))) (range 6))
(str (vec (array-seq want)) " vs " (vec (array-seq got)))))) (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 (deftest mul-may-write-into-either-operand
;; Evaluation composes world := parent · local with dest aliasing local, so ;; Evaluation composes world := parent · local with dest aliasing local, so
;; that a node's world transform needs no scratch. If mul! wrote before reading, ;; 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 (= [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)))))) (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 ;; A decomposition is not extensible after the fact: adding a component later
;; means migrating every stored transform. So both are present from the start, ;; means migrating every stored transform. So it is present from the start, on
;; on every kind that is in the picture. ;; every kind that is in the picture.
(doseq [k (disj node/implemented-kinds :audio)] (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 :skew]) (str k))))
(is (contains? (get node/valid-paths k) [:xform :anchor]) (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 (deftest valid-paths-follow-from-the-kind
(is (contains? (:poly node/valid-paths) [:geom :pts])) (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)] 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"))) (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 (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") (let [id (store/install! {:clip (clip/blank) :store {}} "drop-tracing")
sym {:name "sheet" :type :trace :media {:image "abc"} sym {:name "sheet" :type :trace :media {:image "abc"}
@ -197,8 +211,7 @@
"as long as what is left of the symbol it landed in") "as long as what is left of the symbol it landed in")
(is (= [30 (clip/frames doc :main)] (node/placed-span n))) (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 (= [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]) (is (= [(/ w 2) (/ h 2)] (middle-on-stage doc n))
(get-in n [:channels [:xform :anchor] :value])))
"dropped on the timeline, it is middled on the stage") "dropped on the timeline, it is middled on the stage")
(let [[doc2 n2] (drop!)] (let [[doc2 n2] (drop!)]
(is (= sid (node/source n2)) "the same picture is the same symbol") (is (= sid (node/source n2)) "the same picture is the same symbol")
@ -221,9 +234,8 @@
[w h] (clip/stage doc host) [w h] (clip/stage doc host)
k (min (/ w 3000) (/ h image-h))] k (min (/ w 3000) (/ h image-h))]
(is (= [k k] (get-in n [:channels [:xform :scale] :value]))) (is (= [k k] (get-in n [:channels [:xform :scale] :value])))
(is (= (or point [(/ w 2) (/ h 2)]) (is (= (or point [(/ w 2) (/ h 2)]) (middle-on-stage doc n))
(mapv + (get-in n [:channels [:xform :pos] :value]) "the picture's middle lands where the drop asked for it, at the fitted scale")
(get-in n [:channels [:xform :anchor] :value]))))
(is (= plate (get-in doc [:symbols :face-1 :nodes :plate])) (is (= plate (get-in doc [:symbols :face-1 :nodes :plate]))
"the face's registered tracing placement is unchanged") "the face's registered tracing placement is unchanged")
(is (= (clip/symbol c sid) (clip/symbol doc sid)) (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) (let [c (freeze/head-mode {} @frozen)
res (clip/resolver c :main @store pal/index-of nil) res (clip/resolver c :main @store pal/index-of nil)
k (first (:value (chan :place [:xform :scale]))) k (first (:value (chan :place [:xform :scale])))
anc (:value (chan :place [:xform :anchor]))
pos (:value (chan :place [:xform :pos])) pos (:value (chan :place [:xform :pos]))
tfs (:transforms @take/measured)] tfs (:transforms @take/measured)]
(doseq [f (range 0 take/frames 13)] (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 ;; the fit removed the head's motion, so putting it back is the fit's
;; inverse. Node :head carries exactly this. ;; inverse. Node :head carries exactly this.
im (geom/apply-sim (freeze/invert (nth tfs ef)) g) im (geom/apply-sim (freeze/invert (nth tfs ef)) g)
;; And where :place puts it: scaled about the anchor, then translated, ;; And where :place puts it: scaled about its own origin, then
;; which is p ↦ k(p - anchor) + anchor + pos. ;; translated, which is p ↦ k·p + pos. The recentring that used to be
wx (+ (* k (- (:x im) (nth anc 0))) (nth anc 0) (nth pos 0)) ;; an `:anchor` is folded into `pos`, so this is the whole of it.
wy (+ (* k (- (:y im) (nth anc 1))) (nth anc 1) (nth pos 1))] wx (+ (* k (:x im)) (nth pos 0))
wy (+ (* k (:y im)) (nth pos 1))]
(is (some? op) (str "frame " f " emitted no mouth op")) (is (some? op) (str "frame " f " emitted no mouth op"))
;; Tolerance is the Float32 transform block's, scaled to stage pixels, and ;; Tolerance is the Float32 transform block's, scaled to stage pixels, and
;; it is three orders below a pixel. ;; it is three orders below a pixel.
@ -310,100 +310,81 @@
;; The difference from `makeXform` in one assertion: the placement is a FRAMED ;; 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 ;; transform on a node, which a hand can revise, and it claims no generator that
;; would offer to overwrite it. ;; 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)] (let [c (get (node/channels (node :place)) path)]
(is (= :framed (ch/describe c)) (str path " is not framed")) (is (= :framed (ch/describe c)) (str path " is not framed"))
(is (nil? (:generated c)) (str path " claims provenance"))))) (is (nil? (:generated c)) (str path " claims provenance")))))
(deftest a-part-has-a-pivot-exactly-when-a-hand-can-use-one (deftest a-freeze-stores-no-pivot-at-all
;; The face's anchor was always the head's centre — the test below — and the ;; THE PASS THAT USED TO BE HERE IS GONE, and so is the biconditional it
;; parts underneath it had none at all, so each one turned and scaled about ITS ;; needed. `freeze/pivoted` walked every node it had made and wrote the middle
;; OWN origin, which is the top-left corner of the FOOTAGE. On a 320x200 stage ;; of what that node drew into `[:xform :anchor]` — skipping anything
;; the mouth's pivot sat at (-234, -395): off the stage by more than a stage, ;; `node/measured?`, because an anchor under a measured scale does not cancel
;; so a corner drag slid the mouth about instead of resizing it. ;; 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 ;; A derived pivot has no such exception, because there is nothing to write.
;; 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.
(let [c @clip*] (let [c @clip*]
(doseq [sid [:main :face-1] (doseq [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes])) [id n] (get-in c [:symbols sid :nodes])]
;; `:place` authors its own in `face-placement`, upstream of this. (is (nil? (get-in n [:channels [:xform :anchor]]))
:when (not= [:face-1 :place] [sid id])] (str sid "/" id " stores a pivot")))))
(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])))))))))
(deftest the-head-keeps-no-pivot-of-its-own (deftest every-part-pivots-inside-what-it-draws-measured-or-not
;; The case that makes `measured?` the right predicate rather than "draws ;; The mouth's pivot used to sit at (-234, -395) on a 320x200 stage — the
;; nothing": `:head` carries the measured similarity, so its scale is nowhere ;; top-left corner of the FOOTAGE, carried onto the stage — so a corner drag
;; near 1 and an anchor on it would NOT cancel out of `node/local!` — it would ;; slid the mouth about instead of resizing it. This is that, fixed, and
;; move the whole face. It is skipped for that reason, and would still be ;; asserted over EVERY node the freeze makes rather than the ones that happened
;; skipped if it were ever given geometry. ;; 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 (node/measured? (node :head)))
(is (nil? (get-in (node :head) [:channels [:xform :anchor]])))) (is (string? (gesture/refusal (node :head))))
(is (re-find #"peg" (gesture/refusal (node :head)))))
(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")))))
(deftest the-place-puts-the-head-s-centre-where-it-says-it-does (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 ;; k·centroid + pos is where the head's centre lands in the parent, and that is
;; `:anchor` the registration point: scale and rotation happen about the head's ;; the recentring MediaPipe's space makes necessary: its origin is the image's
;; centre rather than about the corner of the footage, where MediaPipe's ;; top-left corner, so head-local geometry is not centred on anything. It used
;; normalised space has its origin. ;; to be an `:anchor`, which made the offset double as a pivot; folded into
(let [anc (:value (chan :place [:xform :anchor])) ;; `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])) pos (:value (chan :place [:xform :pos]))
c (geom/centroid (:ref @take/measured))] c (geom/centroid (:ref @take/measured))]
(is (< (abs (- (nth anc 0) (:x c))) 1e-12)) (is (< (abs (- (+ (* k (:x c)) (nth pos 0)) (/ W 2))) 1e-9))
(is (< (abs (- (nth anc 1) (:y c))) 1e-12)) (is (< (abs (- (+ (* k (:y c)) (nth pos 1)) (* 0.25 H))) 1e-9))))
(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))))
(deftest the-stage-is-the-clip-s-and-not-the-footage-s (deftest the-stage-is-the-clip-s-and-not-the-footage-s
;; Project dimensions are independent of the footage, which is precisely what ;; Project dimensions are independent of the footage, which is precisely what