diff --git a/frontend/src/arthur/domain/gesture.cljs b/frontend/src/arthur/domain/gesture.cljs index db31b31..ec27248 100644 --- a/frontend/src/arthur/domain/gesture.cljs +++ b/frontend/src/arthur/domain/gesture.cljs @@ -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]] diff --git a/frontend/src/arthur/domain/node.cljs b/frontend/src/arthur/domain/node.cljs index 5ee917a..b4e72a8 100644 --- a/frontend/src/arthur/domain/node.cljs +++ b/frontend/src/arthur/domain/node.cljs @@ -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." diff --git a/frontend/src/arthur/domain/pick.cljs b/frontend/src/arthur/domain/pick.cljs index 5fedcfd..d1826c9 100644 --- a/frontend/src/arthur/domain/pick.cljs +++ b/frontend/src/arthur/domain/pick.cljs @@ -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)]))) diff --git a/frontend/src/arthur/flow/freeze.cljs b/frontend/src/arthur/flow/freeze.cljs index 90b87c3..c409f5e 100644 --- a/frontend/src/arthur/flow/freeze.cljs +++ b/frontend/src/arthur/flow/freeze.cljs @@ -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))}))) diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index dde9f5a..351a124 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -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]) diff --git a/frontend/test/arthur/domain/gesture_test.cljs b/frontend/test/arthur/domain/gesture_test.cljs index 96ee6e4..8bf7e01 100644 --- a/frontend/test/arthur/domain/gesture_test.cljs +++ b/frontend/test/arthur/domain/gesture_test.cljs @@ -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))) diff --git a/frontend/test/arthur/flow/freeze_test.cljs b/frontend/test/arthur/flow/freeze_test.cljs index c60c1ec..324ede5 100644 --- a/frontend/test/arthur/flow/freeze_test.cljs +++ b/frontend/test/arthur/flow/freeze_test.cljs @@ -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