An anchor is a peg

`[: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

View file

@ -29,8 +29,7 @@
(clip/place-symbol nil :mid :box 2 v nil)
(turn :main u [40 20] (/ js/Math.PI 2) [2 2])
(turn :mid v [5 -3] 0.3 [1.5 0.5])
(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])))))
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow))))
(defn- drawn [c path]
(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- 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]
(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 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
(doseq [path [[u] [u v] [u v :shape]]]
(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]))
(drawn moved [u v :shape]))
(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])))))
(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)
path [u v :shape]
{:keys [world]} (nest/placement c nil :main path 16)
pivot #(let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 (:world (nest/placement % nil :main path 16)) 5 3))))
turned (dragged c path 16 #(gesture/turn %2 0.7))]
(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 %3 0.7))]
(is (some? world))
(is (near? (pivot c) (pivot turned)) "the anchor stays put")
(is (not (near? (drawn c path) (drawn turned path))) "and the rest goes round it")))
(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 (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
(let [c (two-down)
@ -83,37 +94,43 @@
at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3)))
p0 (at world 10 0)
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))]
(is (near? p1 (at w2 10 0))
"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
;;
;; `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.
;; decided entirely by where the pivot is. In the middle of what the node draws,
;; which is where `gesture/pivot` derives it, pulling a corner away from the
;; middle makes the node bigger. At the node's coordinate ORIGIN — which is what
;; a node whose stored anchor had never been written got, and for head-local
;; geometry is the top-left corner of the FOOTAGE — every corner drag is a drag
;; away from a point off in the corner: the shape shrinks and slides while the
;; 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)]
(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."
"Where the stage would draw this node's box and pivot: its own bounds through
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]
(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/bounds-of c st sid n) frame)]
{: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
"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]
(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)
c* (pivot-of c st sid id frame v0)
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))
{:clip (gesture/apply-values c sid id frame (gesture/scale pl v0 c* p0 p1 false) false st)
:p0 p0 :p1 p1}))
(defn- away
@ -141,22 +159,13 @@
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 :box (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]]
(two-down) [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))
@ -190,9 +199,12 @@
(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.
;; instance. The mouth's pivot used to sit at (-234, -395) on a 320x200 stage —
;; the top-left corner of the FOOTAGE, carried onto the stage — because its
;; 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
f 10]
(doseq [path [[:face-1] [:face-1 :mouth] [:face-1 :eye-r]]]
@ -225,7 +237,7 @@
(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)]))
(concat (:pos v) (:scale v) (:skew 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))
@ -243,8 +255,8 @@
;; 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]))
once (dragged c path 16 (fn [pl v0 _] (gesture/move pl v0 [30 30] [37 26])))
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.
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)]
@ -260,9 +272,9 @@
(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)))
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]])
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))))
"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}

View file

@ -3,6 +3,7 @@
[arthur.demo.stage :as stage]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
@ -150,6 +151,14 @@
[document 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
(let [document (stage/compose source)]
(is (empty? (clip/problems document)))
@ -171,25 +180,41 @@
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :instance (:kind %))
(vals (get-in document [:symbols :main :nodes]))))))
(is (= [0 232] (:span (placement 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")
(let [left (placement document :left)
scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0 nil)]
(is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40 nil)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0 nil)))
(is (= [0.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f nil) [0 0] anchor)
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales"))))
(is (= [0 232] (:span (peg document :right))) "its own frames, from its own 0")
(is (= [48 280] (node/placed-span (peg document :right))) "and where that sits on the stage")
(is (= (uuid-of :right) (:id (placement document :right))))
(is (= (:id (peg document :right)) (:parent (placement document :right)))
"the face hangs off its peg")
(testing "a keyed scale happens about the pinned point, and that is the peg"
;; THE CASE THAT MAKES A PEG NECESSARY. `:scale` is keyed — the faces pulse
;; — and the source's middle has to stay on the authored `:center` through
;; all of it. A stored anchor used to buy that with a static position; with
;; `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.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]]
(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)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
(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"
;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
@ -333,18 +358,34 @@
[:symbols :main :nodes u :channels]))]
(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")
(testing "the anchor is the middle, and it moves nothing at the identity"
(is (= [25 35] (get-in (placed c :box nil) [[:xform :anchor] :value])))
(testing "a placement stores a position and no pivot at all"
(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]))
"dropped on the timeline: where it was drawn"))
(testing "dropped on a stage pixel, its middle goes there"
(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"
(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"))]
(is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved")
(is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value]))
"the instance's did not")))))
(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)
grown (assoc-in c [:symbols :box :nodes :sq2] (assoc (square 80 30) :id :sq2 :z "a2"))
;; what `gesture/pivot` derives for the instance, before and after
pivot-of (fn [doc]
(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
(let [palette (fn [id name a b]

View file

@ -2,10 +2,13 @@
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.demo.take :as take]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]))
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
@ -383,3 +386,108 @@
(is (nil? (get-in slid [:symbols :lane :nodes :a]))
"a fully covered neighbor is removed")
(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"))))))

View file

@ -14,9 +14,9 @@
(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- local [& {:keys [pos rot scale skew anchor]
:or {pos [0 0] rot 0 scale [1 1] skew [0 0] anchor [0 0]}}]
(node/local! (node/mat) pos rot scale skew anchor))
(defn- local [& {:keys [pos rot scale skew]
:or {pos [0 0] rot 0 scale [1 1] skew [0 0]}}]
(node/local! (node/mat) pos rot scale skew))
;; ---- the transform, component by component ----
@ -28,16 +28,19 @@
(is (close-pt? [0 10] (pt (local :rot (/ js/Math.PI 2)) 10 0)))
(is (= [20 21] (pt (local :scale [2 3]) 10 7))))
(deftest rotation-and-scale-happen-about-the-anchor
;; :anchor is Flash's registration point and Blender's origin. Getting it wrong
;; is why hand-placed parts SWING rather than turn, and a swing looks like a
;; parenting bug rather than like a wrong pivot.
(let [m (local :rot (/ js/Math.PI 2) :anchor [10 0])]
(is (close-pt? [10 0] (pt m 10 0)) "the anchor itself is a fixed point")
(is (close-pt? [10 10] (pt m 20 0)) "and the rest turns about it"))
(let [m (local :scale [2 2] :anchor [10 10])]
(is (close-pt? [10 10] (pt m 10 10)))
(is (close-pt? [30 30] (pt m 20 20)))))
(deftest rotation-and-scale-happen-about-the-nodes-own-origin
;; THERE IS NO :anchor, and this is the half of that which lives here: a local
;; transform turns and scales about [0 0] of the node's own space and nothing
;; else. Turning about any other point is `gesture/about`, which solves for the
;; `pos` that holds that point still — see `gesture-test`. The two together are
;; what the anchor used to be, with no stored pivot to fall out of step with the
;; drawing.
(let [m (local :rot (/ js/Math.PI 2))]
(is (close-pt? [0 0] (pt m 0 0)) "the origin is the fixed point")
(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
;; 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"))
(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
;; produces a transform that is right at the origin and wrong everywhere else,
;; 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]))
R (fn [t] (js/Float64Array. #js [(js/Math.cos t) (js/Math.sin t)
(- (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]))
step (fn [acc m] (node/mul! (node/mat) acc m))
want (reduce step (T (nth pos 0) (nth pos 1))
[(T (nth anchor 0) (nth anchor 1))
(R rot) (K skew) (S scale)
(T (- (nth anchor 0)) (- (nth anchor 1)))])
got (local :pos pos :rot rot :scale scale :skew skew :anchor anchor)]
[(R rot) (K skew) (S scale)])
got (local :pos pos :rot rot :scale scale :skew skew)]
(is (every? (fn [i] (close? (aget want i) (aget got i))) (range 6))
(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
;; Evaluation composes world := parent · local with dest aliasing local, so
;; 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 (= [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
;; means migrating every stored transform. So both are present from the start,
;; on every kind that is in the picture.
;; means migrating every stored transform. So it is present from the start, on
;; every kind that is in the picture.
(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 :anchor]) (str k))))
(is (contains? (get node/valid-paths k) [:xform :skew]) (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
(is (contains? (:poly node/valid-paths) [:geom :pts]))

View file

@ -176,6 +176,20 @@
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")))
(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
(let [id (store/install! {:clip (clip/blank) :store {}} "drop-tracing")
sym {:name "sheet" :type :trace :media {:image "abc"}
@ -197,8 +211,7 @@
"as long as what is left of the symbol it landed in")
(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 (= [(/ w 2) (/ h 2)] (mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value])))
(is (= [(/ w 2) (/ h 2)] (middle-on-stage doc n))
"dropped on the timeline, it is middled on the stage")
(let [[doc2 n2] (drop!)]
(is (= sid (node/source n2)) "the same picture is the same symbol")
@ -221,9 +234,8 @@
[w h] (clip/stage doc host)
k (min (/ w 3000) (/ h image-h))]
(is (= [k k] (get-in n [:channels [:xform :scale] :value])))
(is (= (or point [(/ w 2) (/ h 2)])
(mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value]))))
(is (= (or point [(/ w 2) (/ h 2)]) (middle-on-stage doc n))
"the picture's middle lands where the drop asked for it, at the fitted scale")
(is (= plate (get-in doc [:symbols :face-1 :nodes :plate]))
"the face's registered tracing placement is unchanged")
(is (= (clip/symbol c sid) (clip/symbol doc sid))

View file

@ -203,7 +203,6 @@
(let [c (freeze/head-mode {} @frozen)
res (clip/resolver c :main @store pal/index-of nil)
k (first (:value (chan :place [:xform :scale])))
anc (:value (chan :place [:xform :anchor]))
pos (:value (chan :place [:xform :pos]))
tfs (:transforms @take/measured)]
(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
;; inverse. Node :head carries exactly this.
im (geom/apply-sim (freeze/invert (nth tfs ef)) g)
;; And where :place puts it: scaled about the anchor, then translated,
;; which is p ↦ k(p - anchor) + anchor + pos.
wx (+ (* k (- (:x im) (nth anc 0))) (nth anc 0) (nth pos 0))
wy (+ (* k (- (:y im) (nth anc 1))) (nth anc 1) (nth pos 1))]
;; And where :place puts it: scaled about its own origin, then
;; translated, which is p ↦ k·p + pos. The recentring that used to be
;; an `:anchor` is folded into `pos`, so this is the whole of it.
wx (+ (* k (:x im)) (nth pos 0))
wy (+ (* k (:y im)) (nth pos 1))]
(is (some? op) (str "frame " f " emitted no mouth op"))
;; Tolerance is the Float32 transform block's, scaled to stage pixels, and
;; it is three orders below a pixel.
@ -310,100 +310,81 @@
;; 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
;; 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)]
(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.
(deftest a-freeze-stores-no-pivot-at-all
;; THE PASS THAT USED TO BE HERE IS GONE, and so is the biconditional it
;; needed. `freeze/pivoted` walked every node it had made and wrote the middle
;; of what that node drew into `[:xform :anchor]` — skipping anything
;; `node/measured?`, because an anchor under a measured scale does not cancel
;; 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
;; 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.
;; A derived pivot has no such exception, because there is nothing to write.
(let [c @clip*]
(doseq [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes]))
;; `:place` authors its own in `face-placement`, upstream of this.
:when (not= [:face-1 :place] [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 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])))))))))
[id n] (get-in c [:symbols sid :nodes])]
(is (nil? (get-in n [:channels [:xform :anchor]]))
(str sid "/" id " stores a pivot")))))
(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.
(deftest every-part-pivots-inside-what-it-draws-measured-or-not
;; The mouth's pivot used to sit at (-234, -395) on a 320x200 stage — the
;; top-left corner of the FOOTAGE, carried onto the stage — so a corner drag
;; slid the mouth about instead of resizing it. This is that, fixed, and
;; asserted over EVERY node the freeze makes rather than the ones that happened
;; 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 (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 `: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")))))
(is (string? (gesture/refusal (node :head))))
(is (re-find #"peg" (gesture/refusal (node :head)))))
(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
;; `:anchor` the registration point: scale and rotation happen about the head's
;; centre rather than about the corner of the footage, where MediaPipe's
;; normalised space has its origin.
(let [anc (:value (chan :place [:xform :anchor]))
;; k·centroid + pos is where the head's centre lands in the parent, and that is
;; the recentring MediaPipe's space makes necessary: its origin is the image's
;; top-left corner, so head-local geometry is not centred on anything. It used
;; to be an `:anchor`, which made the offset double as a pivot; folded into
;; `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]))
c (geom/centroid (:ref @take/measured))]
(is (< (abs (- (nth anc 0) (:x c))) 1e-12))
(is (< (abs (- (nth anc 1) (:y c))) 1e-12))
(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))))
(is (< (abs (- (+ (* k (:x c)) (nth pos 0)) (/ W 2))) 1e-9))
(is (< (abs (- (+ (* k (:y c)) (nth pos 1)) (* 0.25 H))) 1e-9))))
(deftest the-stage-is-the-clip-s-and-not-the-footage-s
;; Project dimensions are independent of the footage, which is precisely what