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

Move a peg's pivot without moving what hangs off it

Browse source 
Two bugs in the handles, and the second one meant a peg still had no movable
pivot — which is the complaint pegs exist to answer.

`.peg-grab` was drawn LAST, on top of the four scale corners, and at r=7 against
corners spanning 5.2 to 8.8 from the middle it swallowed the inner half of each
one. It is drawn first now, at r=5, so it stops short of them.

And dragging a peg's cross is a TRANSLATE, not a new pivot. It writes the peg's
`pos`, and a peg is a parent, so everything under it comes along — `peg.mjs` said
so all along: "dragging the peg cross moved its child — dx=18.000". That is the
right behaviour for the drag and no way to say "put the pivot here", so a peg
could be made with its pivot wherever `nest/peg` happened to put it and never
moved again.

⌥-drag now relocates it, which is After Effects' pan-behind split. `nest/repivot`
moves the peg and solves

    pinv(child)' = local'⁻¹ · local · pinv(child)

for each child, because only `local(peg) · pinv(child)` reaches a child, so
preserving that product holds the picture exactly still — verified as a drift of
0, both in `nest-test` and through real ⌥-pointer events in `peg.mjs`. The
child's own channels are never touched, so this works over a measured child,
which is the case the peg exists for.

Refused on a peg whose position is animated, rather than quietly wrong: the
compensation depends on the peg's own transform, so a keyed position wants a
different `pinv` on every frame and one stored matrix is not it. The message says
to put a peg over it instead.

One edit at the end of the drag, not per pointermove: a repivot moves nothing on
screen by construction, so only the cross needs to follow the pointer.

603 CLJS tests, and peg.mjs and onion.mjs 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:25:04 -04:00
parent 00b8ed34ee
commit 357ff1f3b9
6 changed files with 227 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -715,3 +715,72 @@
:parent uuid
:pinv (vec (array-seq
(node/local! (node/mat) (mapv - c) 0 [1 1] [0 0])))))))}))))
(defn- animated?
[n path]
(let [c (get-in n [:channels path])]
(boolean (or (:keys c) (:dense c) (:generated c)))))
(defn repivot
"Move the peg at row path `path` so its origin sits on parent-space point `c`,
WITHOUT MOVING ANYTHING UNDER IT. `{:clip :sid :id}` or `{:refused why}`.
THE GESTURE A PEG WAS MISSING, and the one the stage's ordinary drag is not.
Dragging a peg writes its `pos`, and a peg is a PARENT, so that translates
everything below it — which is the right behaviour for the drag and the wrong
one for \"put the pivot here\". They are different operations and only look like
one because both move the same cross. After Effects splits them the same way:
dragging a layer moves it, the pan-behind tool moves its anchor and compensates.
What makes it hold still is that only the COMPOSITION of the peg's own
transform and each child's parent-inverse reaches the child:
world(child) = … · local(peg) · pinv(child) · local(child)
so moving the peg from `local` to `local'` and solving
pinv(child)' = local'⁻¹ · local · pinv(child)
leaves that product exactly as it was. The child's own channels are never
touched, which is what lets this work over a MEASURED child — the case the
whole peg exists for.
REFUSED ON AN ANIMATED PEG, rather than quietly wrong. `pinv` is one stored
matrix and the compensation above depends on `local(peg)`, so if the peg's
position is keyed there is a different correction to make on every frame and no
single `pinv` is it. A peg being animated is the normal case once it is doing
its job, so the honest move is to say so and let another peg above it carry the
new pivot."
[clip store open path f c]
(let [{:keys [sid id]} (placement clip store open path f)
n (when sid (get-in clip [:symbols sid :nodes id]))
nodes (when sid (:nodes (clip/symbol clip sid)))
kids (when n (keep (fn [[k m]] (when (= id (:parent m)) k)) nodes))]
(cond
(nil? n) {:refused "it is not on screen at this frame"}
(empty? kids) {:refused "nothing hangs off it, so it has no pivot to move"}
(animated? n [:xform :pos])
{:refused (str "its position is animated, so one stored parent-inverse "
"cannot hold its children still on every frame — put a peg "
"over it and move that one's pivot instead")}
:else
(let [v (gesture/values n f store)
old (gesture/local-of v)
new (node/local! (node/mat) c (:rot v) (:scale v) (:skew v))]
(if-let [back (node/invert new)]
{:sid sid :id id
:clip (clip/update-symbol
clip sid update :nodes
(fn [ns]
(reduce
(fn [ns k]
(let [fix (node/mul! (node/mat) back old)
;; `local'⁻¹ · local · pinv`, with an absent pinv the
;; identity it stands for.
pv (if-let [p (node/pinv (get ns k))]
(node/mul! (node/mat) fix p)
fix)]
(assoc-in ns [k :pinv] (vec (array-seq pv)))))
(update ns id node/set-channel [:xform :pos] f (vec c))
kids)))}
{:refused "it is scaled to nothing, so it has no pivot to move"})))))

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

@ -1381,6 +1381,27 @@
(edit/edit (constantly (:clip r)))
(assoc-in [:ui :selection] [:node (:sid r) uuid (conj (pop (vec path)) uuid)]))))))
(rf/reg-event-db
::repivot
;; Put the pivot of the peg at `path` on stage point `point`, moving nothing.
;; One edit at the end of the drag rather than per pointermove: a repivot moves
;; nothing on screen by construction, so there is no intermediate state worth
;; drawing — `ui/stage` follows the pointer with the cross alone.
(fn [db [_ path point]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
f (editing-frame db clip)
pl (nest/placement clip st open (vec path) f)
c (when pl (let [out (js/Float64Array. 2)]
(when-let [inv (node/invert (:parent pl))]
(node/apply-pt! out 0 inv (first point) (second point))
[(aget out 0) (aget out 1)])))
r (when c (nest/repivot clip st open (vec path) f c))]
(cond
(nil? r) db
(:refused r) (refused db (:refused r))
:else (edit/edit db (constantly (:clip r)))))))
(rf/reg-event-db
::edit-keyframes
(fn [db [_ items delta]]

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

@ -122,6 +122,13 @@
(defonce ^:private gesture (atom nil))
(defonce ^:private marquee (r/atom nil))
;; An ⌥-drag of a peg's cross: where the pivot is being put, in stage pixels.
;; A REAGENT atom and not the plain `gesture` one, because the only thing that
;; moves during it is the cross — a repivot holds everything else still by
;; construction — so this drives a re-render and the document is left alone until
;; the pointer goes up.
(defonce ^:private repivot (r/atom nil))
(defn- loaded
"The document and its tier-2 store, read WHEN THE POINTER GOES DOWN.
@ -313,6 +320,24 @@
;; A peg. Same three gestures, hung on nothing.
(let [r 7]
[:<>
;; BEFORE the corners, and smaller than the ring they sit on, or it
;; swallows the inner half of every one of them: a corner spans 5.2
;; to 8.8 from the middle, so the disc has to stop short of 5.2.
[:circle.peg-grab
{:cx px :cy py :r 5
;; ⌥ moves the PIVOT instead of the peg, which is the pan-behind
;; split: a plain drag writes `pos` and carries the children with
;; it, and that is a translate, not a new pivot.
:on-pointer-down
(fn [^js event]
(.stopPropagation event)
(.preventDefault event)
(let [svg (.-ownerSVGElement (.-currentTarget event))
p (xy svg event (:w ctx) (:h ctx))]
(.setPointerCapture svg (.-pointerId event))
(if (.-altKey event)
(reset! repivot {:path path :p p})
(begin! ctx :move path p))))}]
[:line.knob-arm {:x1 px :y1 (- py r) :x2 px :y2 (- py r 8)}]
[:circle.knob {:cx px :cy (- py r 8) :r 2.2 :on-pointer-down (grab :turn)}]
(doall
@ -320,14 +345,12 @@
[(+ px r) (+ py r)] [(- px r) (+ py r)]])]
^{:key i}
[:rect.corner {:x (- x 1.8) :y (- y 1.8) :width 3.6 :height 3.6
:on-pointer-down (grab :scale)}]))
;; What moves a peg. A transparent disc rather than the cross itself,
;; because `.pivot` is `pointer-events: none` — it is a mark on the
;; picture in every other case and must not eat a click meant for the
;; shape under it.
[:circle.peg-grab {:cx px :cy py :r r :on-pointer-down (grab :move)}]]))
[:path.pivot {:d (str "M " (- px 4) " " py " H " (+ px 4)
" M " px " " (- py 4) " V " (+ py 4))}]])))
:on-pointer-down (grab :scale)}]))]))
;; Where the pivot is going, while it is being put there.
(let [[cx cy] (or (:p @repivot) [px py])]
[:path.pivot {:class (when @repivot "moving")
:d (str "M " (- cx 4) " " cy " H " (+ cx 4)
" M " cx " " (- cy 4) " V " (+ cy 4))}])])))
(defn- group-handles [ctx placements]
(let [boxes (keep stage-bounds placements)]
@ -663,11 +686,16 @@
@painting (stroke-move! p)
(and pen? (seq draft)) (let [q (snapped draft (stage-point event w h) event)]
(when (not= q hover) (rf/dispatch [::ui/hover q])))
@repivot (swap! repivot assoc :p p)
@marquee (swap! marquee assoc :p p)
@gesture (drag! p event))))
:on-pointer-up (fn [_]
(reset! dragging nil)
(stroke-end!)
;; One edit, at the end: see `::ui/repivot`.
(when-let [{:keys [path p]} @repivot]
(reset! repivot nil)
(rf/dispatch [::ui/repivot path p]))
(if-let [{:keys [p0 p more?]} @marquee]
(let [depth (or (some-> selected count) 1)
paths (player/in-rect [(first p0) (second p0)

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

@ -491,3 +491,44 @@
(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"))))))
(deftest moving-a-pegs-pivot-moves-nothing-under-it
;; THE OPERATION A PLAIN DRAG IS NOT. Dragging a peg writes its `pos`, and a
;; peg is a parent, so that carries its children with it — a translate. Putting
;; the pivot somewhere else has to leave the picture alone, and does, because
;; only `local(peg) · pinv(child)` reaches the child and `repivot` preserves
;; that product.
(let [c (:clip (nest/peg (shaped) nil :main [:shape] 0 pg))
was (drawn-at c 0)
r (nest/repivot c nil :main [pg] 0 [10 90])
out (:clip r)]
(is (nil? (:refused r)) (:refused r))
(is (= [10 90] (:value (get-in out [:symbols :main :nodes pg :channels [:xform :pos]])))
"the peg's origin is where it was put")
(is (near? was (drawn-at out 0)) "and not one point of the child moved")
(is (empty? (clip/problems out)))
;; And it is a REAL pivot afterwards: a turn about it keeps it fixed.
(let [v0 (gesture/values (get-in out [:symbols :main :nodes pg]) 0 nil)
piv (gesture/pivot v0 nil)
spun (gesture/apply-values out :main pg 0 (gesture/turn v0 piv 0.5))
radii (fn [doc] (map (fn [[x y]] (js/Math.hypot (- x 10) (- y 90)))
(partition 2 (drawn-at doc 0))))]
(is (near? [10 90] piv) "the derived pivot followed it")
(is (not (near? (drawn-at out 0) (drawn-at spun 0))) "the child turned")
(is (near? (vec (radii out)) (vec (radii spun)))
"about the pivot's new home, keeping every distance from it"))))
(deftest a-pegs-pivot-cannot-be-moved-once-its-position-is-animated
;; Refused rather than quietly wrong: the compensation depends on the peg's own
;; transform, so a keyed position needs a different `pinv` per frame and one
;; stored matrix is not it.
(let [c (:clip (nest/peg (shaped) nil :main [:shape] 0 pg))
keyed (assoc-in c [:symbols :main :nodes pg :channels [:xform :pos]]
(ch/keyed {0 [10 10] 5 [40 10]} :linear))
r (nest/repivot keyed nil :main [pg] 0 [10 90])]
(is (string? (:refused r)))
(is (re-find #"animated" (:refused r)) (:refused r))
(is (re-find #"peg over it" (:refused r)) (:refused r)))
(testing "and a node with nothing under it has no pivot to move"
(let [r (nest/repivot (shaped) nil :main [:shape] 0 [10 90])]
(is (re-find #"nothing hangs off it" (:refused r)) (:refused r)))))

59
frontend/test/browser/peg.mjs
View file

@ -183,7 +183,64 @@ try {
ok(dx > 2, 'dragging the peg cross moved its child', `dx=${dx.toFixed(3)}`);
ok(Math.abs(dy) < 1.5, 'and only horizontally, as dragged', `dy=${dy.toFixed(3)}`);
}
console.log(failures ? `\n${failures} FAILED` : '\nPASS: a peg can be made, selected, and dragged on the stage');
// ⌥-drag the cross: the PIVOT moves and the child must not.
const dom2 = await evalJS(`
const q = document.querySelector('.paint-overlay .handles .peg-grab');
const r = q && q.getBoundingClientRect();
const corner = document.querySelector('.paint-overlay .handles .corner');
const cr = corner && corner.getBoundingClientRect();
return {
grab: r ? {x: r.x + r.width/2, y: r.y + r.height/2, w: r.width} : null,
// The corner's own middle must hit the CORNER, not the move disc over it.
cornerHit: cr ? (document.elementFromPoint(cr.x + cr.width/2, cr.y + cr.height/2) || {}).className
?.baseVal ?? null : null,
};
`);
console.log('dom2:', JSON.stringify(dom2));
ok(dom2.cornerHit === 'corner', 'a scale corner is on top of the move disc, not under it',
String(dom2.cornerHit));
if (dom2.grab) {
const before2 = await evalJS(`
const c = cljs.core, k = c.keyword, v = c.vector;
const db = c.deref(re_frame.db.app_db);
const e = arthur.footage.store.entry(c.get(db, k('clip/current')));
const doc = c.get(e, k('clip'));
const res = arthur.domain.clip.resolver(doc, k('main'), c.get(e,k('store')),
arthur.domain.palette.index_of, null);
return Array.from(c.get(c.first(res.call(null, 0)), k('pts')));
`);
const { x, y } = dom2.grab;
const steps = [['mousePressed', 0, 0], ['mouseMoved', -40, 25], ['mouseMoved', -80, 50],
['mouseReleased', -80, 50]];
for (const [type, dx, dy] of steps) {
await send('Input.dispatchMouseEvent', {
type, x: x + dx, y: y + dy, button: 'left', buttons: 1, clickCount: 1,
pointerType: 'mouse', modifiers: 1, // alt
});
await sleep(90);
}
await sleep(500);
const after2 = await evalJS(`
const c = cljs.core, k = c.keyword, v = c.vector;
const db = c.deref(re_frame.db.app_db);
const e = arthur.footage.store.entry(c.get(db, k('clip/current')));
const doc = c.get(e, k('clip'));
const nodes = c.get_in(doc, v(k('symbols'), k('main'), k('nodes')));
const pegId = c.get(c.get(nodes, k('shape')), k('parent'));
const res = arthur.domain.clip.resolver(doc, k('main'), c.get(e,k('store')),
arthur.domain.palette.index_of, null);
return {pos: c.clj__GT_js(c.get_in(nodes, v(pegId, k('channels'), v(k('xform'),k('pos')), k('value')))),
pts: Array.from(c.get(c.first(res.call(null, 0)), k('pts'))),
refusal: c.clj__GT_js(c.get_in(db, v(k('ui'), k('refusal'))))};
`);
const drift = Math.max(...before2.map((b, i) => Math.abs(b - after2.pts[i])));
console.log('after alt-drag: peg pos', JSON.stringify(after2.pos), 'child drift', drift);
ok(drift < 1e-6, 'alt-dragging the cross moved NOTHING under the peg', `drift ${drift}`);
ok(Math.abs(after2.pos[0] - made.pegPos[0]) > 2, 'but the pivot did move',
`${JSON.stringify(made.pegPos)} -> ${JSON.stringify(after2.pos)}`);
}
console.log(failures ? `\n${failures} FAILED` : '\nPASS: a peg can be made, moved, and have its pivot placed');
} finally {
if (ws) ws.close();
chrome.kill();