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

Scale a part about the middle of what it draws, from the document as it is

Browse source 
Three faults, one gesture. None of them was in `gesture/scale`, whose
`s' = s·b/a` about the pivot was right all along.

THE PIVOT. `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 `flow/freeze` wrote none for the parts underneath, so a
traced mouth turned and scaled about its own coordinate ORIGIN, which for
head-local geometry is the top-left corner of the footage. On a 320x200 stage
that put the mouth's pivot at (-234, -395), so dragging a corner outward slid
the shape about and shrank it. `pick/pivot` is `clip/center`'s rule for a node
rather than a symbol; `freeze/pivoted` applies it to every node the freeze
makes, skipping `node/measured?` — the predicate `gesture/refusal` already
refuses a hand edit by, so a pivot is written exactly where a hand can use
one. That also keeps it off `:head`, whose scale is not 1 and where an anchor
would NOT cancel out of `local!`; skipping it for drawing nothing would have
been true only by accident. Asserted in pixels: the pass moves nothing.

THE JUMP. `ui/stage`'s overlay dereferenced the document while RENDERING and
used it when the pointer went down. The store is a mutable handle behind an id
that does not change when the document does — `:paint/revision` says that, and
the overlay subscribes to neither it nor `::render/clip` — so after any edit
the next drag began from the transform the node had before the last one: still
under the press, jumping on the first pointermove. `ctx` now carries the id and
`loaded` reads at pointer-down.

THE CRASH. `gesture/values` read its channels without the tier-2 store, which
is fine until a selection lands on a dense transform — an iris follows the
gaze, a brow the raise, a head the similarity — and then `dense-at` throws and
takes the stage down, in `begin!` and again in `handles`. It takes the store
now. Kept in this commit because it is the same two functions.

`pick/bounds-of` yields a closure, as `clip/resolver` does, so an instance's
resolver is built once for a walk instead of once per frame — which is what
let `pivot` be the one walk it is rather than a separate path for instances.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-09-30 11:53:50 -04:00
parent ed88c5e674
commit 11093079de
7 changed files with 426 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,5 +1,6 @@
(ns arthur.domain.gesture-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
@ -39,7 +40,7 @@
(defn- dragged [c path f vs-fn]
(let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame)]
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame nil)]
(gesture/apply-values c sid id frame (vs-fn pl v0))))
(deftest a-shape-two-symbols-down-moves-under-the-pointer
@ -75,6 +76,174 @@
"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")))
;; ---------------------------------------------------------------------------
;; which way a corner drag goes
;;
;; `scale` takes the point under the pointer to the pointer, about the node's
;; PIVOT, and that is the whole of it — so which way a corner drag goes is
;; decided entirely by where the pivot is. With it in the middle of what the node
;; draws, where `clip/place-symbol`, `paint/new-shape` and now `flow/freeze` all
;; put it, pulling a corner away from the middle makes the node bigger. With it
;; at the node's coordinate ORIGIN, which is what a node with no anchor gets,
;; every corner drag is a drag away from some point off in the corner of the
;; footage: the shape shrinks and slides while the corner dutifully follows the
;; pointer, which is what the bug looked like from the outside.
(defn- at [m p] (let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 m (first p) (second p))))))
(defn- handles
"Where the stage would draw this node's box and pivot: its own bounds and
anchor through its `:world`, which is what `ui/stage`'s `handles` does."
[c st open path f]
(let [{:keys [sid id world frame]} (nest/placement c st open path f)
n (get-in c [:symbols sid :nodes id])
[x0 y0 x1 y1] (pick/local-bounds c st n frame)]
{:corners (mapv #(at world %) [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])
:pivot (at world (:anchor (gesture/values n frame st)))}))
(defn- span
"How big the box is, as the length of its diagonals — which does not care that
a turned parent leaves it off the screen's axes."
[{[a b c* d] :corners}]
(+ (js/Math.hypot (- (first c*) (first a)) (- (second c*) (second a)))
(js/Math.hypot (- (first d) (first b)) (- (second d) (second b)))))
(defn- corner-drag
"Drag corner `i` of the node's box by `d`, exactly as the stage does: read the
placement and the transform off the document AS IT IS NOW, scale from where
the pointer went down to where it is."
[c st open path f i d]
(let [{:keys [sid id frame] :as pl} (nest/placement c st open path f)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame st)
p0 (nth (:corners (handles c st open path f)) i)
p1 (mapv + p0 d)]
{:clip (gesture/apply-values c sid id frame (gesture/scale pl v0 p0 p1 false))
:p0 p0 :p1 p1}))
(defn- away
"A pull of `k` stage pixels straight away from the pivot, from corner `i`."
[{:keys [corners pivot]} i k]
(let [[dx dy] (mapv - (nth corners i) pivot)
len (max 1e-9 (js/Math.hypot dx dy))]
[(* k (/ dx len)) (* k (/ dy len))]))
(defn- middled
"`two-down` with the shape pivoting about the middle of what it draws — which
is what `paint/new-shape` writes and what `two-down` deliberately moves off, so
that the rest of this file is not accidentally testing the easy case."
[]
(let [c (two-down)]
(assoc-in c [:symbols :box :nodes :shape :channels [:xform :anchor]]
(ch/framed (pick/pivot c nil (get-in c [:symbols :box :nodes :shape]) [4])))))
(deftest dragging-a-corner-away-from-the-middle-makes-it-bigger
(doseq [[what c path f]
[["a shape on its own"
(paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow)
[:shape] 4]
["a shape two symbols down, through a turned and unevenly scaled parent"
(middled) [u v :shape] 16]]
i (range 4)]
(let [before (handles c nil :main path f)
out (corner-drag c nil :main path f i (away before i 6))
in (corner-drag c nil :main path f i (away before i -6))
grown (handles (:clip out) nil :main path f)
shrunk (handles (:clip in) nil :main path f)]
(is (< (span before) (span grown))
(str what ", corner " i ": pulled away from the middle it got smaller"))
(is (> (span before) (span shrunk))
(str what ", corner " i ": pushed towards the middle it got bigger"))
(is (near? (:p1 out) (nth (:corners grown) i))
(str what ", corner " i ": the corner grabbed is not under the pointer"))
(is (near? (:pivot before) (:pivot grown))
(str what ", corner " i ": the pivot moved")))))
(deftest a-corner-pulled-up-and-left-grows-up-and-left
;; The report, literally: no turned parent in the way, so the box's corners are
;; the screen's, and the top-left one dragged further top-left has to make the
;; box bigger rather than smaller.
(let [c (paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow)
before (handles c nil :main [:shape] 4)
after (handles (:clip (corner-drag c nil :main [:shape] 4 0 [-10 -10]))
nil :main [:shape] 4)
[tl _ br _] (:corners after)]
(is (= [100 80] (first (:corners before))) "corner 0 is the top left")
(is (near? [90 70] tl) "the corner grabbed is under the pointer")
(is (and (> (first br) 140) (> (second br) 110))
"and the far corner went the other way, about the middle")
(is (< (span before) (span after)) "so the shape is bigger")))
(deftest a-face-part-scales-about-its-own-middle
;; The whole measured rig, from `demo/take`: source-space geometry under a
;; dense head similarity, under the authored source placement, inside an
;; instance. Before `freeze/pivoted` the mouth's pivot sat at (-234, -395) on a
;; 320x200 stage — the top-left corner of the FOOTAGE, carried onto the stage —
;; and every corner drag was a drag away from it.
(let [{c :clip st :store} @take/frozen
f 10]
(doseq [path [[:face-1] [:face-1 :mouth] [:face-1 :eye-r]]]
(let [before (handles c st :main path f)
[px py] (:pivot before)]
(is (and (< 0 px (:width c)) (< 0 py (:height c)))
(str path "'s pivot " (pr-str (:pivot before)) " is off the stage"))
(doseq [i (range 4)]
(let [out (corner-drag c st :main path f i (away before i 8))
grown (handles (:clip out) st :main path f)]
(is (< (span before) (span grown))
(str path ", corner " i " pulled away from the middle got smaller"))
(is (near? (:p1 out) (nth (:corners grown) i))
(str path ", corner " i " is not under the pointer"))
(is (near? (:pivot before) (:pivot grown))
(str path ", corner " i ": the pivot moved"))))))))
(deftest every-node-in-a-face-can-have-its-transform-read
;; What a click near the eyes hit, and it took the stage down with it — in
;; `begin!` selecting the node, and again in `handles` drawing its pivot
;; cross. `values` asked its channels for a value WITHOUT the tier-2 store,
;; which is fine for every hand-placed node and throws the moment one of them
;; is dense: an iris follows the gaze, a brow follows the raise, a head
;; follows the measured similarity, and all three are ordinary things to
;; select. Over every node of a real take, so a new dense channel on any of
;; them is covered the day it is added.
(let [{c :clip st :store} @take/frozen]
(doseq [sid [:main :face-1]
[id n] (get-in c [:symbols sid :nodes])]
(let [v (gesture/values n 10 st)]
(is (map? v) (str sid "/" id " could not be read at all"))
(is (every? #(or (number? %) (ch/nothing? %))
(concat (:pos v) (:scale v) (:anchor v) [(:rot v)]))
(str sid "/" id " did not read as numbers: " (pr-str v))))
(when (node/measured? n)
(is (thrown? js/Error (gesture/values n 10 nil))
(str sid "/" id " has a dense transform, so reading it storeless"
" has to throw — otherwise this test proves nothing"))
(is (string? (gesture/refusal n))
(str sid "/" id " is measured but a drag on it is not refused"))))))
(deftest a-drag-starts-from-the-document-as-it-is-now
;; What `ui/stage`'s `loaded` is for. A drag reads the placement and the
;; transform when the pointer goes DOWN; reading them when the overlay last
;; rendered is the same code with a clip in it that predates the last edit, and
;; this is what that costs — the node is put back where it was before the
;; previous drag and only then moved, so it sits still under the press and
;; jumps on the first pointermove. Two drags have to compose.
(let [c (two-down)
path [u v :shape]
once (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26]))
twice (dragged once path 16 #(gesture/move %1 %2 [30 30] [33 31]))
;; The same second drag, begun from the clip as it was BEFORE the first.
stale (let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame nil)]
(gesture/apply-values once sid id frame
(gesture/move pl v0 [30 30] [33 31])))]
(is (near? (map (fn [[x y]] [(+ x 10) (- y 3)]) (drawn c path)) (drawn twice path))
"(7, -4) then (3, 1) leaves the shape moved by (10, -3)")
(is (near? (map (fn [[x y]] [(+ x 3) (+ y 1)]) (drawn c path)) (drawn stale path))
"begun from the stale clip it lands where the FIRST drag never happened")
(is (not (near? (drawn twice path) (drawn stale path)))
"which is the jump, and it is the whole of the difference")))
(deftest a-drag-keys-a-keyed-channel-and-sets-a-framed-one
(let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]]
(constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear)))