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

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

View file

@ -15,9 +15,17 @@
[arthur.domain.node :as node]))
(defn values
"Node `n`'s transform on its own frame `f`, as vectors."
[n f]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f)
"Node `n`'s transform on its own frame `f`, as vectors.
`store` IS NOT OPTIONAL, though `ch/value-at` would let it be. A measured
transform is a dense channel, and a dense channel read without the tier-2
store it names throws — so leaving it off read correctly for every hand-placed
node and crashed the stage the moment a selection landed on an iris, a brow or
a head. Those are not hard to land on: `pick/choose` keeps a selection at the
depth it already has, so once anything inside a face is selected, an ordinary
click beside it selects its neighbour — which near the eyes is an iris."
[n f store]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f store)
xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
{:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
@ -27,8 +35,7 @@
it would throw the measurement away."
[n]
(cond
(some #(let [c (get-in n [:channels [:xform %]])] (or (:dense c) (:generated c)))
[:pos :rot :scale])
(node/measured? n)
"its transform is measured — place the instance it is in"))
(defn- through [m [x y]]

View file

@ -81,6 +81,21 @@
[n]
(merge (defaults-of n) (:channels n)))
(defn measured?
"Is this node's transform regenerated from the footage rather than authored?
ONE PREDICATE, TWO CALLERS, and they are the same question asked twice: a hand
edit to a measured transform is thrown away by the next regenerate, which is
what `gesture/refusal` refuses — and a DEFAULT written under one is worse than
useless, which is what `flow/freeze`'s pivot pass declines to do. A node a hand
cannot transform has no use for a pivot, and at a measured scale an anchor does
not cancel out of `local!` the way it does at the identity, so writing one
would move the very thing it was meant to leave alone."
[n]
(boolean (some #(let [c (get-in n [:channels [:xform %]])]
(or (:dense c) (:generated c)))
[:pos :rot :scale])))
(defn set-channel
"Write `v` into channel `path`: a key on the node's own frame `f` when the
channel is keyed, its one value when it is not."

View file

@ -75,35 +75,80 @@
(subvec hit 0 (inc (count selected)))
selected))
(defn local-bounds
"`[x0 y0 x1 y1]` around what node `n` draws on its own frame `f`, in its own
coordinates, or nil when it draws nothing there. Inside an instance is its
symbol, resolved at that frame."
[document store n f]
(defn- union
"The smaller box around both, either of which may be nil."
[a b]
(cond (nil? a) b
(nil? b) a
:else (let [[ax0 ay0 ax1 ay1] a [bx0 by0 bx1 by1] b]
[(min ax0 bx0) (min ay0 by0) (max ax1 bx1) (max ay1 by1)])))
(defn bounds-of
"A closure from a frame to `[x0 y0 x1 y1]` around what node `n` draws on it, in
its own coordinates — nil on a frame it draws nothing on.
A CLOSURE, as `clip/resolver` is, and for the same reason it is: inside an
instance is its whole symbol resolved at that frame, and a resolver costs the
symbol to BUILD and a lookup to RUN. Asking frame by frame through a fresh one
is a resolver per frame, which is what made `pivot` want a separate path for
instances rather than the one walk it is."
[document store n]
(let [grow (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
at #(ch/value-at (get (node/channels n) %) f store)]
at (fn [f p] (ch/value-at (get (node/channels n) p) f store))]
(case (:kind n)
:instance
(let [sid (:of n)
frames (clip/frames document sid)
f (if (get-in n [:time :loop?]) (mod f frames) f)]
(when (< -1 f frames)
(reduce (fn [b {:keys [kind pts n cx cy r size]}]
(case kind
:poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2))))
b (range n))
:disc (-> b (grow (- cx r) (- cy r)) (grow (+ cx r) (+ cy r)))
:rect (let [h (/ size 2)]
(-> b (grow (- cx h) (- cy h)) (grow (+ cx h) (+ cy h))))
b))
nil
((clip/resolver document store pal/index-of sid) f))))
:poly (let [pts (at [:geom :pts])]
(when-not (ch/nothing? pts)
(reduce (fn [b i] (grow b (ch/component pts (* 2 i)) (ch/component pts (inc (* 2 i)))))
nil (range (quot (if (vector? pts) (count pts) (.-length pts)) 2)))))
:disc (let [r (at [:geom :radius])] (when-not (ch/nothing? r) [(- r) (- r) r r]))
:rect (let [s (at [:geom :size])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h])))
nil)))
(let [sid (:of n)
frames (clip/frames document sid)
loop? (get-in n [:time :loop?])
resolve (clip/resolver document store pal/index-of sid)]
(fn [f]
(let [f (if loop? (mod f frames) f)]
(when (< -1 f frames)
(reduce (fn [b {:keys [kind pts n cx cy r size]}]
(case kind
:poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2))))
b (range n))
:disc (-> b (grow (- cx r) (- cy r)) (grow (+ cx r) (+ cy r)))
:rect (let [h (/ size 2)]
(-> b (grow (- cx h) (- cy h)) (grow (+ cx h) (+ cy h))))
b))
nil
(resolve f))))))
:poly (fn [f]
(let [pts (at f [:geom :pts])]
(when-not (ch/nothing? pts)
(reduce (fn [b i] (grow b (ch/component pts (* 2 i)) (ch/component pts (inc (* 2 i)))))
nil (range (quot (if (vector? pts) (count pts) (.-length pts)) 2))))))
:disc (fn [f]
(let [r (at f [:geom :radius])]
(when-not (ch/nothing? r) [(- r) (- r) r r])))
:rect (fn [f]
(let [s (at f [:geom :size])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h]))))
(constantly nil))))
(defn local-bounds
"`[x0 y0 x1 y1]` around what node `n` draws on its own frame `f`, in its own
coordinates, or nil when it draws nothing there."
[document store n f]
((bounds-of document store n) f))
(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 n fs]
(let [bounds (bounds-of document store n)]
(when-let [[x0 y0 x1 y1] (reduce #(union %1 (bounds %2)) nil fs)]
[(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])))

View file

@ -35,6 +35,8 @@
(:require [arthur.domain.channel :as ch]
[arthur.domain.feature :as feature]
[arthur.domain.geom :as geom]
[arthur.domain.node :as node]
[arthur.domain.pick :as pick]
[arthur.domain.ring :as ring]
[arthur.domain.trace :as trace]
[arthur.flow.address :as address]))
@ -671,6 +673,46 @@
{})
:store (into (:store head) (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 n (range (get-in c [:symbols sid :frames])))]
(assoc-in c at (ch/framed p))
c))))
clip
(for [sid (sort-by str (keys (:symbols clip)))
id (sort-by str (keys (get-in clip [:symbols sid :nodes])))]
[sid id])))
(defn clip
"Subject-id -> conditioned measurements becomes one symbol per face, and a
symbol called :main that places them.
@ -719,8 +761,10 @@
(= subject (get-in built [:features (feature/owned subject id) :subject])))
(throw (ex-info "presence must name this subject's feature and span the take"
{:subject subject :feature id :frames nf :actual (count track)}))))
{:store (merged :store)
:clip (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :trace (get inputs :trace (:trace params))}
{:clip c}))
built ordered)}))
(let [store (merged :store)]
{:store store
:clip (-> (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :trace (get inputs :trace (:trace params))}
{:clip c}))
built ordered)
(pivoted store))})))

View file

@ -118,23 +118,40 @@
;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`.
(defonce ^:private gesture (atom nil))
(defn- loaded
"The document and its tier-2 store, read WHEN THE POINTER GOES DOWN.
NOT AT RENDER TIME, which is the bug it does not look like. `footage/store` is
a mutable handle behind an id, and — see `events/edit` — the id does not change
when the document does; `:paint/revision` is what says it did, and nothing this
component subscribes to reads it. So a clip dereferenced while rendering is the
clip as it was BEFORE the last edit, and a drag begun from one starts by
putting the node back where it was two edits ago: the node sits still under the
press and then jumps on the first pointermove, which is the whole of the drag
that follows being right and its first frame being wrong. Every id here is
reactive except the document, and the document is the one read late."
[{:keys [clip-id]}]
(store/entry clip-id))
(defn- select!
"Select the node at row path `path` of the open symbol — the selection a
timeline row makes, so the row, the inspector and the stage all show it — or
nothing."
[{:keys [document st open f]} path]
(rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path)
(nest/placement document st open path f))]
[:node sid id path])]))
[{:keys [open f] :as ctx} path]
(let [{document :clip st :store} (loaded ctx)]
(rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path)
(nest/placement document st open path f))]
[:node sid id path])])))
(defn- begin!
"Start dragging `kind` of the node at `path` from stage point `p`."
[{:keys [document st open f]} kind path p]
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
(let [n (get-in document [:symbols sid :nodes id])
v0 (gesture/values n frame)]
(reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n
:a (gesture/angle pl v0 p) :turned 0}))))
[{:keys [open f] :as ctx} kind path p]
(let [{document :clip st :store} (loaded ctx)]
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
(let [n (get-in document [:symbols sid :nodes id])
v0 (gesture/values n frame st)]
(reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n
:a (gesture/angle pl v0 p) :turned 0})))))
(defn- drag! [p ^js event]
(let [{:keys [kind pl v0 p0 n a turned values]} @gesture
@ -175,7 +192,7 @@
[ctx]
(let [{:keys [world bounds node frame]} @(rf/subscribe [::sub/selected-placement])
[_ _ _ path] @(rf/subscribe [::sub/selection])
[ax ay] (when world (:anchor (gesture/values node frame)))
[ax ay] (when world (:anchor (gesture/values node frame (:store (loaded ctx)))))
[px py] (when world (through world [ax ay]))
grab (fn [kind]
(fn [^js event]
@ -209,7 +226,7 @@
drawing? (= :polygon tool)
[_ _ _ selected] @(rf/subscribe [::sub/selection])
clip-id @(rf/subscribe [::render/clip-id])
ctx {:document (:clip (store/entry clip-id)) :st (:store (store/entry clip-id))
ctx {:clip-id clip-id
:open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::playback/frame])
:w w :h h}
points? @(rf/subscribe [::sub/points])

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

View file

@ -13,9 +13,11 @@
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.geom :as geom]
[arthur.domain.gesture :as gesture]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.raster :as raster]
[arthur.domain.ring :as ring]
[arthur.domain.symbol :as symbol]
@ -309,6 +311,82 @@
(is (= :framed (ch/describe c)) (str path " is not framed"))
(is (nil? (:generated c)) (str path " claims provenance")))))
(deftest a-part-has-a-pivot-exactly-when-a-hand-can-use-one
;; The face's anchor was always the head's centre — the test below — and the
;; parts underneath it had none at all, so each one turned and scaled about ITS
;; OWN origin, which is the top-left corner of the FOOTAGE. On a 320x200 stage
;; the mouth's pivot sat at (-234, -395): off the stage by more than a stage,
;; so a corner drag slid the mouth about instead of resizing it.
;;
;; BY BICONDITIONAL, over every node the freeze makes, rather than against a
;; list of the ones that happen to have geometry today. The rule `pivoted` goes
;; by is `node/measured?` — the one `gesture/refusal` refuses a hand edit by —
;; so the two have to agree exactly: a pivot is written where a hand could use
;; it and nowhere else. A brow has a dense `[:xform :pos]` and so gets none,
;; which is not an exception to the rule, it is the rule.
(let [c @clip*]
(doseq [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes]))
;; `:face` authors its own in `face-placement`, upstream of this.
:when (not= [:main :face] [sid id])]
(let [n (get-in c [:symbols sid :nodes id])
frames (range (get-in c [:symbols sid :frames]))
anchor (:value (get-in n [:channels [:xform :anchor]]))
usable (and (not (node/measured? n))
(some? (pick/pivot c @store 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 [[x0 y0 x1 y1] (reduce #(let [k (pick/local-bounds c @store n %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
;; The case that makes `measured?` the right predicate rather than "draws
;; nothing": `:head` carries the measured similarity, so its scale is nowhere
;; near 1 and an anchor on it would NOT cancel out of `node/local!` — it would
;; move the whole face. It is skipped for that reason, and would still be
;; skipped if it were ever given geometry.
(is (node/measured? (node :head)))
(is (nil? (get-in (node :head) [:channels [:xform :anchor]]))))
(deftest giving-every-part-its-pivot-moves-nothing-on-screen
;; The claim `pivoted`'s docstring makes, asserted in pixels rather than
;; trusted: rotation and scale are the identity on a node a freeze has just
;; made, and at the identity the anchor cancels out of `node/local!`. So the
;; pass decides where a part PIVOTS and nothing else — if it ever renders
;; differently, it has been applied to a node whose transform is not the
;; identity, which is the one way it could go wrong.
(let [c @clip*
;; Every node the freeze makes EXCEPT `:face`, 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= [:main :face] [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-face-puts-the-head-s-centre-where-it-says-it-does
;; anchor + pos is where the anchor lands in the parent, which is what makes
;; `:anchor` the registration point: scale and rotation happen about the head's