arthur/frontend/test/arthur/domain/gesture_test.cljs
Your Name ddef5c6bfd A node has a pivot
Rotation and scale are composed about `[:xform :pivot]`, a point in the
node's own coordinates:

    local = T(pos) · T(piv) · R · K · S · T(-piv)

Schema 7 deleted this field, on the argument that an anchor is a peg. The
algebra was right and the conclusion was not. The identity holds between a
pivot and a peg THAT ALREADY EXISTS; it says nothing about what a node
turns about when nobody has made one, and that default is what a person
meets. With no pivot in the composition, a turn about anything but the
node's own origin has to be paid for by solving `pos` per frame —
`gesture/about` — and that solution is an arc in the angle while `pos`
tweens along the chord. Right on the frame it is written, wrong on every
frame between two keys.

A drawing escaped it: `paint/centred` puts a shape's origin on the middle
of what it draws. A symbol instance cannot — its origin is its symbol's,
and a symbol is drawn on the stage, so its origin is the top-left corner
of the stage. Off the document this was reported on: a symbol's content
centred 161 px from its own origin, and one instance of it keyed rot 0→60
put the drawing where it was put on both keys and at (-88, 121) halfway
between, a stage and a half away. The advice on offer was "make a peg
first", for wanting to spin a drawing.

So a turn now writes `rot` and nothing else, always, and the pivot is held
exactly between two keys because the matrix is built about it on every
frame. The default, and the way back to it, are the parts the old anchor
was missing:

  - a node nobody has pivoted turns about the middle of what it draws,
    `pick/bounds-of` — the same bounds the selection box comes from
  - the first turn or scale writes that middle down, in the same edit,
    with the `pos` that holds the picture still (`gesture/with-pivot`)
  - `clip/place-symbol` stores the middle of what a symbol draws as the
    instance's pivot, so a drop spins in place from the start
  - ⌃/⌘-drag the cross on the stage to put the pivot anywhere, moving
    nothing — on any node now, not pegs alone
  - ⌖ beside the pivot row in the inspector puts it back on the middle of
    what the node draws NOW (`gesture/centred`)

A pivot is a CHOICE and does not follow the drawing: once it is the node's
own, adding a shape inside a symbol cannot re-aim a keyed spin of any
instance of it. `instance-test` has asserted both answers to that now, and
the stored one is right.

A peg stays a peg, for the three things a node's own pivot is not: a pivot
SHARED between nodes, a SECOND transform on one node, and a hand transform
over a measured one. `nest/repivot` is gone — a pivot inside the node's own
transform has nothing to correct in anybody else's `:pinv`, so the gesture
works on every node and is no longer refused on an animated one. A measured
node's pivot is authored like any other, so a traced mouth can be told
where to turn without a peg.

Schema 8, and the first version that converts rather than refusing: an
absent pivot reads as [0 0] and T(pos)·T(0)·M·T(-0) is T(pos)·M to the
bit, so every stored document composes to exactly the matrices it did and
the migration only restamps the version.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-10-06 14:33:35 -04:00

432 lines
24 KiB
Clojure

(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]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]))
(def ^:private u #uuid "00000000-0000-4000-8000-0000000000e1")
(def ^:private v #uuid "00000000-0000-4000-8000-0000000000e2")
(defn- two-down
"A shape inside :box, placed turned and scaled unevenly in :mid, placed turned
and doubled in :main — so nothing lines up by accident."
[]
(let [turn (fn [c host id pos rot k]
(update-in c [:symbols host :nodes id :channels] merge
{[:xform :pos] (ch/framed pos)
[:xform :rot] (ch/framed rot)
[:xform :scale] (ch/framed k)}))]
(-> (clip/blank)
(assoc-in [:symbols :mid] {:id :mid :frames 40 :nodes {}})
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
(clip/place-symbol nil :main :mid 10 u nil)
(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))))
(defn- drawn [c path]
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %))
((clip/resolver c :main nil pal/index-of nil) 16))))))))
(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- at [m p] (let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 m (first p) (second p))))))
(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 (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 (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)")))))
(deftest a-buffered-performance-take-becomes-one-set-of-authored-keys
(let [c (paint/new-shape (clip/blank) :main :shape 0 [0 0 10 0 5 10] :brow)
out (gesture/apply-take
c {[:main :shape]
{3 {[:xform :pos] [10 20] [:xform :rot] 0.25}
4 {[:xform :pos] [12 22] [:xform :rot] 0.5}}})]
(is (= {3 [10 20], 4 [12 22]}
(get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :keys])))
(is (= {3 0.25, 4 0.5}
(get-in out [:symbols :main :nodes :shape :channels [:xform :rot] :keys])))
(is (= :linear
(get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :interp])))))
(deftest turning-keeps-the-pivot-where-it-is
;; The shape was drawn at [0 0 10 0 5 10], so the middle of what it draws is
;; (5, 5) of the space it was drawn in — and `paint/centred` made that the
;; node's OWN ORIGIN, which is (0, 0) in its own coordinates. So the pivot is
;; the origin, and the turn is one channel: there is no `pos` to solve for,
;; because `node/local!` already turns about exactly this point.
(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)) 0 0))))
turned (dragged c path 16 #(gesture/turn %2 %3 0.7))]
(is (some? world))
(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 (= #{[:xform :rot]} (set (keys (gesture/turn (gesture/values
(get-in c [:symbols :box :nodes :shape]) 4 nil)
(pivot-of c nil :box :shape 4
(gesture/values
(get-in c [:symbols :box :nodes :shape]) 4 nil))
0.7))))
"a turn about the node's own origin writes rot ALONE — a pos written
beside it would be solved for this frame and interpolated along the
chord of an arc between keys, which is a keyed spin leaving the stage")))
(deftest a-keyed-turn-holds-its-pivot-between-its-keys
;; THE BUG, as it was reported: a shape keyed from the bottom left to the top
;; centre with a 360° turn on the way flew right off the stage in the middle of
;; the spin and came back. 0° and 360° are the two frames where a wrong pivot
;; cannot be seen, so the keys looked right and every frame between them did
;; not. Here the whole tween is checked, which is the only way this is caught.
(let [drawn-at [100 80 140 80 140 110 100 110]
c (-> (clip/blank)
(paint/new-shape :main :shape 0 drawn-at :brow)
;; Keyed by hand, as the inspector keys: bottom left to top
;; centre, one full turn on the way.
(assoc-in [:symbols :main :nodes :shape :channels [:xform :pos]]
(ch/keyed {0 [60 150] 30 [160 40]} :linear))
(assoc-in [:symbols :main :nodes :shape :channels [:xform :rot]]
(ch/keyed {0 0 30 (* 2 js/Math.PI)} :linear)))
middle (fn [f]
(let [{:keys [world]} (nest/placement c nil :main [:shape] f)
[x0 y0 x1 y1] ((pick/bounds-of c nil :main
(get-in c [:symbols :main :nodes :shape])) f)]
(at world [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])))]
(doseq [f (range 0 31)]
(let [[x y] (middle f)
t (/ f 30)]
(is (near? [x y] [(+ 60 (* t 100)) (- 150 (* t 110))])
(str "frame " f ": the middle of the drawing is at " (pr-str [x y])
", not on the straight line from (60, 150) to (160, 40)"))))))
(deftest a-keyed-turn-of-a-symbol-instance-holds-its-pivot-too
;; THE BUG AS IT WAS REPORTED THE SECOND TIME, and the case the drawing test
;; above could never have caught. A symbol is drawn ON THE STAGE, so its origin
;; is the stage's top-left corner and the middle of what it draws is a long way
;; from it — 161 px, on the document this came off, on a 320x200 stage. An
;; instance that turned about its origin therefore swung its drawing round the
;; corner of the stage on an orbit the size of the stage: the two keys looked
;; right, every frame between them was somewhere else entirely, and at frame 30
;; of 60 the drawing was off the left edge.
;;
;; Keyed here exactly as the stage keys it — `turn` through `apply-values` with
;; auto-key armed, twice, at two frames — and then checked ON EVERY FRAME, which
;; is the only way this is caught: a full turn is right at 0° and at 360°.
(let [;; a shape at the far side of the symbol from its origin, as a drawing
;; made on the stage is
c (-> (clip/blank)
(assoc-in [:symbols :box] {:id :box :frames 60 :nodes {}})
(paint/new-shape :box :shape 0 [100 80 140 80 140 110 100 110] :brow)
(clip/place-symbol nil :main :box 0 u nil))
node #(get-in % [:symbols :main :nodes u])
box #(let [n (node %)] ((pick/bounds-of % nil :main n) 0))
;; where the drawing's middle is, on the stage, at frame f
middle (fn [doc f]
(let [{:keys [world]} (nest/placement doc nil :main [u] f)
[x0 y0 x1 y1] (box doc)]
(at world [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])))
;; turn it at frame 0, and again at frame 30, auto-keying both
spin (fn [doc f da]
(let [v (gesture/values (node doc) f nil)]
(gesture/apply-values doc :main u f
(gesture/turn v (gesture/pivot v (box doc)) da)
true)))
turned (-> c (spin 0 0.0) (spin 30 (* 2 js/Math.PI)))
was (middle c 0)]
(is (= [120 95] (:value (get-in c [:symbols :main :nodes u :channels [:xform :pivot]])))
"the placement pivots about the middle of what the symbol draws, which is
120 px and 95 px from the symbol's own origin — the orbit the drawing
used to be swung round")
(is (= #{0 30} (set (keys (get-in turned [:symbols :main :nodes u :channels [:xform :rot] :keys]))))
"one rotation channel, keyed twice")
(is (nil? (:keys (get-in turned [:symbols :main :nodes u :channels [:xform :pos]])))
"and NO position keys: a turn writes the rotation and nothing else")
(doseq [f (range 0 31)]
(is (near? was (middle turned f))
(str "frame " f ": the drawing's middle is at " (pr-str (middle turned f))
" rather than staying on " (pr-str was) " — it is orbiting, not turning")))))
(deftest scaling-takes-the-grabbed-point-to-the-pointer
(let [c (two-down)
path [u v :shape]
{:keys [world]} (nest/placement c nil :main path 16)
out (js/Float64Array. 2)
at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3)))
;; (5, -5) of the shape's own coordinates is the point drawn at (10, 0):
;; the ring is centred, so what was drawn is offset by its own middle.
p0 (at world 5 -5)
p1 [(+ (first p0) 3) (- (second p0) 5)]
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 5 -5))
"the corner grabbed is under the pointer, through a turned, unevenly scaled parent")
(is (near? (at world 0 0) (at w2 0 0)) "about the middle of the drawing, which is its origin")))
;; ---------------------------------------------------------------------------
;; 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. 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- handles
"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. On a drawing it is also
the node's own origin, because that is where `paint/centred` put it."
[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 [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])}))
(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)
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 c* p0 p1 false) false st)
: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))]))
(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"
(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))
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. 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]]]
(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) (: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))
(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 (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)]
(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)))
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 %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}
(update (get-in rot [:symbols :mid :nodes v :channels [:xform :rot]]) :value
#(/ (js/Math.round (* 10 %)) 10)))
"a channel with no keys has its one value changed")))
(deftest a-measured-transform-is-not-set-by-hand
(is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
(is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]} :hold)}}))))
(deftest moving-a-measured-part-adds-an-authored-offset
(let [key "measured-position"
st {key {:data (js/Float32Array. #js [1 2 2 3])}}
measured {:animated? true :dense {:store key :offset 0 :stride 2 :frames 2}}
c (-> (clip/blank)
(paint/new-shape :main :brow 0 [0 0 10 0 5 3] :brow)
(assoc-in [:symbols :main :nodes :brow :channels [:xform :pos]] measured))
once (gesture/apply-values c :main :brow 0 {[:xform :pos] [4 6]} false st)
twice (gesture/apply-values once :main :brow 0 {[:xform :pos] [5 8]} false st)
pos #(get-in % [:symbols :main :nodes :brow :channels [:xform :pos]])]
(is (= (:dense measured) (:dense (pos twice))) "the measured base survives")
(is (= [5 8] (ch/value-at (pos twice) 0 st)) "the brow lands under the pointer")
(is (= [6 9] (ch/value-at (pos twice) 1 st))
"its measured motion continues underneath the authored offset")
(is (= 1 (count (:over (pos twice)))) "repeated drags update one correction layer")))
(deftest a-click-selects-the-level-figma-would
(let [hit [:a :b :c :shape]]
(testing "choose"
(is (= [:a] (pick/choose nil hit false)) "the thing in the open symbol")
(is (= hit (pick/choose nil hit true)) "⌘ goes to the shape")
(is (= [:a :b] (pick/choose [:a :b] hit false)) "inside what is selected keeps it")
(is (= [:a :x] (pick/choose [:a :b] [:a :x :y] false)) "beside it, at the same depth")
(is (= [:z] (pick/choose [:a :b] [:z :y] false)) "elsewhere, from the top")
(is (nil? (pick/choose [:a] nil false)) "nothing, on nothing"))
(testing "deeper"
(is (= [:a :b] (pick/deeper [:a] hit)))
(is (= hit (pick/deeper hit hit)) "not past the shape")
(is (= [:z] (pick/deeper [:z] hit)) "and not into something else"))))
(deftest the-topmost-op-under-the-point-is-hit
(let [sq (fn [node x0] {:kind :poly :node node :n 4
:pts (js/Float64Array. #js [x0 0 (+ x0 10) 0 (+ x0 10) 10 x0 10])})
ops [(sq :under 0) (sq [u :over] 5) {:kind :disc :node :dot :cx 50 :cy 50 :r 1}]]
(is (= [u :over] (pick/hit ops [7 5])) "the later op is drawn on top")
(is (= [:under] (pick/hit ops [2 5])))
(is (= [:dot] (pick/hit ops [52.5 50])) "a few-pixel shape can be missed by a little")
(is (nil? (pick/hit ops [30 30])))))
(deftest a-marquee-selects-visible-objects-at-one-depth
(let [sq (fn [path x0] {:kind :poly :node path :n 4
:pts (js/Float64Array.
#js [x0 0 (+ x0 10) 0 (+ x0 10) 10 x0 10])})
ops [(sq [:left :inside] 0) (sq [:right :inside] 20) (sq [:away] 80)]]
(is (= [[:left] [:right]] (pick/in-rect ops [-2 -2 35 12] 1))
"a fresh marquee chooses objects in the open symbol")
(is (= [[:left :inside] [:right :inside]] (pick/in-rect ops [-2 -2 35 12] 2))
"an existing deep selection keeps the marquee at that depth")
(is (= [[:left]] (pick/in-rect ops [5 5 6 6] 1))
"intersection, rather than full containment, makes small objects selectable")))
(deftest an-instances-box-is-what-its-symbol-draws
(let [c (two-down)
{:keys [frame]} (nest/placement c nil :main [u v] 16)]
(is (= [0 0 10 10] ((pick/bounds-of c nil :mid (get-in c [:symbols :mid :nodes v])) frame))
"an instance's box is what its symbol draws, in the symbol's space")
(is (= [-5 -5 5 5] ((pick/bounds-of c nil :box (get-in c [:symbols :box :nodes :shape])) 4))
"and the shape's own box is about its own origin, which is its middle")))