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

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

frontend/src/arthur/domain/nest.cljs

@@ -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"})))))

frontend/src/arthur/events/ui.cljs

@@ -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]]

frontend/src/arthur/ui/stage.cljs

@@ -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)}]))
+                              :on-pointer-down (grab :scale)}]))]))
-            ;; What moves a peg. A transparent disc rather than the cross itself,
+       ;; Where the pivot is going, while it is being put there.
-            ;; because `.pivot` is `pointer-events: none` — it is a mark on the
+       (let [[cx cy] (or (:p @repivot) [px py])]
-            ;; picture in every other case and must not eat a click meant for the
+         [:path.pivot {:class (when @repivot "moving")
-            ;; shape under it.
+                       :d (str "M " (- cx 4) " " cy " H " (+ cx 4)
-            [:circle.peg-grab {:cx px :cy py :r r :on-pointer-down (grab :move)}]]))
+                               " M " cx " " (- cy 4) " V " (+ cy 4))}])])))
-       [:path.pivot {:d (str "M " (- px 4) " " py " H " (+ px 4)
-                             " M " px " " (- py 4) " V " (+ py 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)

frontend/test/arthur/domain/nest_test.cljs

@@ -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)))))

frontend/test/browser/peg.mjs

@@ -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();

static/arthur/app.css

@@ -1427,6 +1427,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 .paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; }
 /* A peg draws nothing, so the cross is the only thing to grab it by. */
 .paint-overlay .handles .peg-grab { fill: transparent; stroke: none; cursor: move; }
+/* While an alt-drag is placing it. */
+.paint-overlay .handles .pivot.moving { stroke: #7ad7a0; stroke-width: 0.9; }
 .paint-overlay .marquee { fill: rgba(230, 202, 139, 0.12); stroke: #e6ca8b; stroke-width: 0.6; stroke-dasharray: 2 1; pointer-events: none; }
 
 /* The creation-target outline and its name tag. Solid, no handles, and a tag pinned just