Add multi-object stage selection and transforms

frontend/src/arthur/domain/gesture.cljs

@@ -29,14 +29,19 @@
         xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
     {:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
 
+(defn- measured-channel? [n path]
+  (let [c (get-in n [:channels path])]
+    (boolean (or (:dense c) (:generated c)))))
+
 (defn refusal
-  "Why node `n`'s transform cannot be set by hand, or nil when it can. A
+  "Why `kind` cannot transform node `n`, or nil. Measured position and rotation
-  measured transform is regenerated from the footage, and writing a value over
+  accept authored correction layers; measured scale cannot yet be decomposed
-  it would throw the measurement away."
+  safely. The one-argument form asks whether any stage gesture is possible."
-  [n]
+  ([n] (when (node/measured? n)
-  (cond
+         "its transform is measured — use a correction or place the instance it is in"))
-    (node/measured? n)
+  ([n kind]
-    "its transform is measured — place the instance it is in"))
+   (when (and (= :scale kind) (measured-channel? n [:xform :scale]))
+     "its scale is measured — place the instance it is in")))
 
 (defn- through [m [x y]]
   (let [out (js/Float64Array. 2)]
@@ -76,24 +81,57 @@
               nil)]
       {[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))})))
 
+(def ^:private manual-layer ::manual-transform)
+
+(defn- plus [a b]
+  (if (number? a) (+ a b) (mapv + (vec a) (vec b))))
+
+(defn- minus [a b]
+  (if (number? a) (- a b) (mapv - (vec a) (vec b))))
+
+(defn- corrected-channel
+  "Set the effective value of a measured channel without replacing its base."
+  [channel f target store extent auto-key?]
+  (let [current (ch/value-at channel f store)
+        layers  (vec (:over channel))
+        i       (first (keep-indexed #(when (= manual-layer (:id %2)) %1) layers))
+        old     (when i (ch/value-at (get-in layers [i :values]) f store))
+        zero    (if (number? target) 0 (vec (repeat (count target) 0)))
+        value   (plus (or old zero) (minus target current))
+        values  (or (when i (get-in layers [i :values])) (ch/framed zero))
+        values  ((if auto-key? node/set-keyed-channel node/set-channel)
+                 {:kind :group :channels {[:xform :pos] values}}
+                 [:xform :pos] f value)
+        values  (get-in values [:channels [:xform :pos]])
+        layer   (ch/layer manual-layer [0 extent] :offset values)]
+    (assoc channel :over (if i (assoc layers i layer) (conj layers layer)))))
+
 (defn apply-values
   "Clip with channel values `vs`, `{path value}`, written into node `id` of
   symbol `sid` on the node's own frame `f`, by the keying rule above. The sixth
   argument arms auto-key; the five-argument form retains the normal rule."
-  ([clip sid id f vs] (apply-values clip sid id f vs false))
+  ([clip sid id f vs] (apply-values clip sid id f vs false nil))
-  ([clip sid id f vs auto-key?]
+  ([clip sid id f vs auto-key?] (apply-values clip sid id f vs auto-key? nil))
+  ([clip sid id f vs auto-key? store]
    (let [put (if auto-key? node/set-keyed-channel node/set-channel)]
      (update-in clip [:symbols sid :nodes id]
-                #(reduce-kv (fn [n path v] (put n path f v)) % vs)))))
+                #(reduce-kv
+                  (fn [n path v]
+                    (if (measured-channel? n path)
+                      (update-in n [:channels path] corrected-channel f v store
+                                 (get-in clip [:symbols sid :frames]) auto-key?)
+                      (put n path f v)))
+                  % vs)))))
 
 (defn apply-take
   "Apply a buffered performance take. `take` is keyed by `[symbol node]`, then
   local frame, then channel path. It becomes ordinary authored keys in one
   document edit rather than making the edit pipeline run for every sample."
-  [clip take]
+  ([clip take] (apply-take clip take nil))
-  (reduce-kv
+  ([clip take store]
-   (fn [c [sid id] frames]
+   (reduce-kv
-     (reduce-kv (fn [c f values]
+    (fn [c [sid id] frames]
-                  (apply-values c sid id f values true))
+      (reduce-kv (fn [c f values]
-                c frames))
+                   (apply-values c sid id f values true store))
-   clip take))
+                 c frames))
+    clip take)))

frontend/src/arthur/domain/pick.cljs

@@ -55,6 +55,31 @@
   [ops [x y]]
   (some #(when (on? % x y) (path-of %)) (rseq (vec ops))))
 
+(defn- op-bounds [{:keys [kind pts n cx cy r size]}]
+  (case kind
+    :poly (reduce (fn [b i]
+                    (let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))]
+                      (if b (let [[x0 y0 x1 y1] b]
+                              [(min x0 x) (min y0 y) (max x1 x) (max y1 y)])
+                          [x y x y]))) nil (range n))
+    :disc [(- cx r) (- cy r) (+ cx r) (+ cy r)]
+    :rect (let [h (/ size 2)] [(- cx h) (- cy h) (+ cx h) (+ cy h)])
+    nil))
+
+(defn in-rect
+  "Distinct row paths whose drawn bounds intersect `[x0 y0 x1 y1]`. `depth`
+  chooses objects at one hierarchy level, just as an ordinary stage click does."
+  [ops [ax ay bx by] depth]
+  (let [[rx0 rx1] [(min ax bx) (max ax bx)]
+        [ry0 ry1] [(min ay by) (max ay by)]]
+    (->> ops
+         (keep (fn [op]
+                 (when-let [[x0 y0 x1 y1] (op-bounds op)]
+                   (when (and (<= x0 rx1) (<= rx0 x1) (<= y0 ry1) (<= ry0 y1))
+                     (let [path (path-of op)]
+                       (subvec path 0 (min (count path) (max 1 depth))))))))
+         distinct vec)))
+
 (defn- prefix? [a b]
   (and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
 

frontend/src/arthur/events/project.cljs

@@ -755,6 +755,16 @@
    (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)]
      (edit/edit db #(update-in % [:symbols sid :nodes id] put path frame value)))))
 
+(rf/reg-event-db
+ ::set-channels
+ ;; One property assignment over a stage selection is one document edit.
+ (fn [db [_ edits]]
+   (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)]
+     (edit/edit db
+                #(reduce (fn [c {:keys [sid id path frame value]}]
+                           (update-in c [:symbols sid :nodes id] put path frame value))
+                         % edits)))))
+
 (rf/reg-event-db
  ::toggle-key
  (fn [db [_ sid id path frame]]

frontend/src/arthur/events/ui.cljs

@@ -78,6 +78,7 @@
                                  [:clip :symbols sid :nodes id :kind]))]
     (cond-> (-> db
                 (assoc-in [:ui :selection] selection)
+                (assoc-in [:ui :selections] (if selection [selection] []))
                 (update :ui dissoc :points :retry))
       (and (= :node kind) (seq path) (not sound?))
       (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path)))))))
@@ -103,6 +104,29 @@
 
 (rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection)))
 
+(rf/reg-event-db
+ ::select-many
+ ;; `:selection` remains the primary address used by the inspector and timeline;
+ ;; `:selections` is the ordered set used by the stage and batch commands.
+ (fn [db [_ selections]]
+   (let [xs (vec (distinct (keep identity selections)))]
+     (if-let [primary (peek xs)]
+       (-> (selected db primary) (assoc-in [:ui :selections] xs))
+       (selected db nil)))))
+
+(rf/reg-event-db
+ ::toggle-selection
+ (fn [db [_ selection]]
+   (let [primary (get-in db [:ui :selection])
+         many (vec (get-in db [:ui :selections]))
+         old (if (some #{primary} many) many (if primary [primary] []))
+         xs  (if (some #{selection} old)
+               (vec (remove #{selection} old))
+               (conj old selection))]
+     (if-let [primary (peek xs)]
+       (-> (selected db primary) (assoc-in [:ui :selections] xs))
+       (selected db nil)))))
+
 (rf/reg-event-db
  ::aim
  ;; The gestures that name a PLACE in the document rather than a thing on
@@ -915,26 +939,44 @@
  ::transform
  ;; The drag let go: one edit, so one undo step and one write to collaborators.
  (fn [db [_ g]]
-   (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))]
+   (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))
+         st (:store (store/entry (:clip/current db)))]
      (if auto?
        (let [db   (-> db
                       (update-in [:ui :gesture] merge g)
                       (record-auto-frame (get-in db [:playback :frame])))
              take (get-in db [:ui :gesture :take])]
          (cond-> (update db :ui dissoc :gesture)
-           (seq take) (edit/edit #(gesture/apply-take % take))))
+           (seq take) (edit/edit #(gesture/apply-take % take st))))
        (let [{:keys [sid id frame values]} g]
          (cond-> (update db :ui dissoc :gesture)
-           (seq values) (edit/edit #(gesture/apply-values % sid id frame values false))))))))
+           (seq values) (edit/edit #(gesture/apply-values % sid id frame values false st))))))))
+
+(rf/reg-event-db
+ ::transform-many
+ ;; Every visible member of a stage selection is one edit and therefore one
+ ;; undo step. Members absent at this playhead are intentionally not in `edits`.
+ (fn [db [_ edits]]
+   (let [st (:store (store/entry (:clip/current db)))]
+     (cond-> (update db :ui dissoc :gesture)
+       (seq edits)
+       (edit/edit #(reduce (fn [c {:keys [sid id frame values]}]
+                             (gesture/apply-values c sid id frame values
+                                                   (boolean (get-in db [:ui :auto-key?])) st))
+                           % edits))))))
 
 (rf/reg-event-db
  ::delete-selected
  (fn [db _]
-   (let [[kind sid id] (get-in db [:ui :selection])]
+   (let [primary (get-in db [:ui :selection])
-     (if (= :node kind)
+         many (vec (get-in db [:ui :selections]))
+         selections (if (some #{primary} many) many (if primary [primary] []))
+         nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))]
+     (if (seq nodes)
        (-> db
-           (edit/edit #(nest/delete-node % sid id))
+           (edit/edit #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes))
-           (assoc-in [:ui :selection] nil))
+           (assoc-in [:ui :selection] nil)
+           (assoc-in [:ui :selections] []))
        db))))
 
 (rf/reg-event-db

frontend/src/arthur/subs/render.cljs

@@ -43,20 +43,24 @@
    ;; With a timeline bar being slid, the document as it will be when the drag
    ;; lets go, so the stage and the rows follow the pointer. Nothing is written
    ;; until then: one drag is one undo step and one write to collaborators.
-   (let [c (:clip (footage/entry id))]
+   (let [{c :clip st :store} (footage/entry id)]
      (or (when-let [{:keys [path df kind ripple? other]} sliding]
            (:clip (case kind
                     :out (nest/resize-out c open path df ripple?)
                     :in (nest/resize-in c open path df)
                     :roll (nest/roll c open other path df)
                     (nest/slide c open path df))))
-         (when-let [{:keys [sid id frame values]} gesture]
+         (when-let [{:keys [sid id frame values edits]} gesture]
            ;; A held stage control owns the touched parameters completely. Make
            ;; them temporary static channels for the preview, so their existing
            ;; automation cannot pull against the pointer while the performance
            ;; recorder samples the live value in the background. Pointer-up
            ;; removes this preview and commits the buffered take as real keys.
-           (when c (gesture/apply-values c sid id frame values false)))
+           (when c
+             (if (seq edits)
+               (reduce (fn [out {:keys [sid id frame values]}]
+                         (gesture/apply-values out sid id frame values false st)) c edits)
+               (gesture/apply-values c sid id frame values false st))))
          c))))
 
 (rf/reg-sub

frontend/src/arthur/ui/player.cljs

@@ -152,6 +152,9 @@
   [point]
   (pick/hit (:ops @state) point))
 
+(defn in-rect [rect depth]
+  (pick/in-rect (:ops @state) rect depth))
+
 (defn paint!
   "Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
   the resolver reuses its point buffers between frames, so they have to be

frontend/src/arthur/ui/stage.cljs

@@ -25,7 +25,8 @@
             [arthur.ui.layout :as layout]
             [arthur.ui.player :as player]
             [arthur.ui.underlay :as underlay]
-            [re-frame.core :as rf]))
+            [re-frame.core :as rf]
+            [reagent.core :as r]))
 
 ;; THE ZOOM IS NOT A CONSTANT ANY MORE — it is `ui/layout`'s, an integer in
 ;; [1 8], 2 to begin with. It scales the canvas with CSS and never its backing
@@ -118,6 +119,7 @@
 ;; placement and transform it started from, and where. What it makes of the
 ;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`.
 (defonce ^:private gesture (atom nil))
+(defonce ^:private marquee (r/atom nil))
 
 (defn- loaded
   "The document and its tier-2 store, read WHEN THE POINTER GOES DOWN.
@@ -157,12 +159,62 @@
         (reset! gesture {:kind kind :pl pl :path path :open open :v0 v0 :p0 p :n n
                          :a (gesture/angle pl v0 p) :turned 0})))))
 
+(defn- stage-bounds [{:keys [world bounds]}]
+  (when (and world bounds)
+    (let [[x0 y0 x1 y1] bounds
+          ps (pairs (through world [x0 y0 x1 y0 x1 y1 x0 y1]))]
+      [(apply min (map first ps)) (apply min (map second ps))
+       (apply max (map first ps)) (apply max (map second ps))])))
+
+(defn- begin-many! [ctx kind placements p]
+  (let [{document :clip st :store} (loaded ctx)
+        members (into [] (keep (fn [{:keys [path]}]
+                                 (when-let [{:keys [sid id frame] :as pl}
+                                            (nest/placement document st (:open ctx) path (:f ctx))]
+                                   (let [n (get-in document [:symbols sid :nodes id])]
+                                     {:pl pl :path path :node n
+                                      :v0 (gesture/values n frame st)}))))
+                      placements)
+        why (some #(gesture/refusal (:node %) kind) members)
+        boxes (keep stage-bounds placements)
+        box   (when (seq boxes)
+                (reduce (fn [[ax ay bx by] [cx cy dx dy]]
+                          [(min ax cx) (min ay cy) (max bx dx) (max by dy)]) boxes))]
+    (cond
+      why (rf/dispatch [::ui/refuse (str "the selection cannot move together: " why)])
+      (and (seq members) box)
+      (reset! gesture {:kind kind :members members :p0 p :box box}))))
+
+(defn- multi-values [kind {:keys [pl v0]} [cx cy] p0 p]
+  (case kind
+    :move (gesture/move pl v0 p0 p)
+    :scale
+    (let [d0 (max 1e-6 (js/Math.hypot (- (first p0) cx) (- (second p0) cy)))
+          k  (/ (js/Math.hypot (- (first p) cx) (- (second p) cy)) d0)
+          [px py] (through (:world pl) (:anchor v0))
+          target [(+ cx (* k (- px cx))) (+ cy (* k (- py cy)))]
+          inv (node/invert (:parent pl))]
+      (when inv
+        (let [[a b] (through inv [px py]) [c d] (through inv target)]
+          {[:xform :pos] (mapv + (:pos v0) [(- c a) (- d b)])
+           [:xform :scale] (mapv #(* k %) (:scale v0))})))
+    nil))
+
 (defn- drag! [p ^js event]
   (let [{:keys [kind pl path open v0 p0 n a turned values]} @gesture
         shift? (.-shiftKey event)
         moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))]
     (when moved?
-      (if-let [why (gesture/refusal n)]
+      (if-let [members (:members @gesture)]
+        (let [[x0 y0 x1 y1] (:box @gesture)
+              center [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]
+              edits (into [] (keep (fn [{:keys [pl path] :as member}]
+                             (when-let [vs (multi-values kind member center p0 p)]
+                               (assoc (select-keys pl [:sid :id :frame])
+                                      :path path :values vs)))) members)]
+          (swap! gesture assoc :values edits)
+          (rf/dispatch [::ui/gesture {:edits edits}]))
+        (if-let [why (gesture/refusal n kind)]
         (do (reset! gesture nil) (rf/dispatch [::ui/refuse why]))
         (let [vs (case kind
                    :move  (gesture/move pl v0 p0 p)
@@ -180,16 +232,17 @@
             (swap! gesture assoc :values vs)
             (rf/dispatch [::ui/gesture
                           (assoc (select-keys pl [:sid :id :frame])
-                                 :path path :open open :values vs)])))))))
+                                 :path path :open open :values vs)]))))))))
 
 (defn- let-go! [commit?]
-  (when-let [{:keys [pl path open values]} @gesture]
+  (when-let [{:keys [pl path open values members]} @gesture]
     (reset! gesture nil)
     (when values
-      (rf/dispatch (if commit?
+      (rf/dispatch (cond
-                     [::ui/transform (assoc (select-keys pl [:sid :id :frame])
+                     (not commit?) [::ui/gesture nil]
-                                            :path path :open open :values values)]
+                     members [::ui/transform-many values]
-                     [::ui/gesture nil])))))
+                     :else [::ui/transform (assoc (select-keys pl [:sid :id :frame])
+                                                  :path path :open open :values values)])))))
 
 (defn- handles
   "The selected node's box, drawn through its own transform so it turns with
@@ -227,6 +280,30 @@
        [:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3)
                              " M " px " " (- py 3) " V " (+ py 3))}]])))
 
+(defn- group-handles [ctx placements]
+  (let [boxes (keep stage-bounds placements)]
+    (when (seq boxes)
+      (let [[x0 y0 x1 y1] (reduce (fn [[ax ay bx by] [cx cy dx dy]]
+                                     [(min ax cx) (min ay cy) (max bx dx) (max by dy)]) boxes)
+            grab (fn [kind]
+                   (fn [^js event]
+                     (.stopPropagation event)
+                     (.preventDefault event)
+                     (let [svg (.-ownerSVGElement (.-currentTarget event))]
+                       (.setPointerCapture svg (.-pointerId event))
+                       (begin-many! ctx kind placements (xy svg event (:w ctx) (:h ctx))))))]
+        [:g.handles.multi
+         [:rect.box {:x x0 :y y0 :width (- x1 x0) :height (- y1 y0)}]
+         (doall (for [[i [x y]] (map-indexed vector [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])]
+                  ^{:key i} [:rect.corner {:x (- x 1.8) :y (- y 1.8)
+                                           :width 3.6 :height 3.6
+                                           :on-pointer-down (grab :scale)}]))]))))
+
+(defn- address-for [{:keys [open f] :as ctx} path]
+  (let [{document :clip st :store} (loaded ctx)]
+    (when-let [{:keys [sid id]} (and (seq path) (nest/placement document st open path f))]
+      [:node sid id path])))
+
 (defn- aim-box
   "The TARGET's outline: where a new polygon or symbol would be parented, drawn
   around the thing that would be its parent.
@@ -271,6 +348,9 @@
         draft @(rf/subscribe [::sub/draft])
         drawing? (= :polygon tool)
         [_ _ _ selected] @(rf/subscribe [::sub/selection])
+        selections @(rf/subscribe [::sub/selections])
+        placements @(rf/subscribe [::sub/selected-placements])
+        selected-paths (set (keep #(nth % 3 nil) selections))
         clip-id @(rf/subscribe [::render/clip-id])
         ctx {:clip-id clip-id
              ;; The open symbol's OWN frame, which is what `nest/placement`
@@ -281,7 +361,8 @@
         points? @(rf/subscribe [::sub/points])
         [sid id geom active editable? frame matrix] (when points? (editing))
         pts (when geom (through matrix (channel/value-at geom frame
-                                                          (:store (store/entry clip-id)))))]
+                                                          (:store (store/entry clip-id)))))
+        mark @marquee]
     [:svg {:class (str "paint-overlay" (when drawing? " drawing"))
            :width (* zoom w) :height (* zoom h)
            :view-box (str "0 0 " w " " h)
@@ -295,10 +376,22 @@
                                       path (pick/choose selected (player/at p)
                                                         (or (.-metaKey event) (.-ctrlKey event)))]
                                   (.focus svg)
-                                  (when (not= path selected) (select! ctx path))
+                                  (cond
-                                  (when path
+                                    (and (.-shiftKey event) path)
+                                    (when-let [address (address-for ctx path)]
+                                      (rf/dispatch [::ui/toggle-selection address]))
+
+                                    path
+                                    (when-not (contains? selected-paths path) (select! ctx path))
+
+                                    :else
+                                    (do (.setPointerCapture svg (.-pointerId event))
+                                        (reset! marquee {:p0 p :p p :more? (.-shiftKey event)})))
+                                  (when (and path (not (.-shiftKey event)))
                                     (.setPointerCapture svg (.-pointerId event))
-                                    (begin! ctx :move path p)))))
+                                    (if (and (> (count placements) 1) (contains? selected-paths path))
+                                      (begin-many! ctx :move placements p)
+                                      (begin! ctx :move path p))))))
            :on-double-click (fn [^js event]
                               (when-not drawing?
                                 (let [p (xy (.-currentTarget event) event w h)
@@ -321,19 +414,38 @@
                                 (rf/dispatch [::paint-events/set-vertex
                                               sid node key-frame vertex
                                               (through inv (stage-point event w h))])
-                                (when @gesture
+                                (let [p (xy (.-currentTarget event) event w h)]
-                                  (drag! (xy (.-currentTarget event) event w h) event))))
+                                  (if @marquee
-           :on-pointer-up     (fn [_] (reset! dragging nil) (let-go! true))
+                                    (swap! marquee assoc :p p)
-           :on-pointer-cancel (fn [_] (reset! dragging nil) (let-go! false))}
+                                    (when @gesture (drag! p event))))))
+           :on-pointer-up     (fn [_]
+                                (reset! dragging nil)
+                                (if-let [{:keys [p0 p more?]} @marquee]
+                                  (let [depth (or (some-> selected count) 1)
+                                        paths (player/in-rect [(first p0) (second p0)
+                                                               (first p) (second p)] depth)
+                                        addresses (into [] (keep #(address-for ctx %)) paths)
+                                        old (if more? selections [])]
+                                    (reset! marquee nil)
+                                    (rf/dispatch [::ui/select-many (into old addresses)]))
+                                  (let-go! true)))
+           :on-pointer-cancel (fn [_]
+                                (reset! dragging nil) (reset! marquee nil) (let-go! false))}
      [ghost]
      (when (seq draft)
        [:polyline {:points (points-text draft) :fill "none"
                    :stroke "#d0ba86" :stroke-width 1}])
+     (when mark
+       (let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]]
+         [:rect.marquee {:x (min x0 x1) :y (min y0 y1)
+                         :width (js/Math.abs (- x1 x0))
+                         :height (js/Math.abs (- y1 y0))}]))
      ;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land"
      ;; is the question the outline exists to answer, and the moment it is being
      ;; asked is mid-draft.
      (when-not points? [aim-box])
-     (when-not (or drawing? points?) [handles ctx])
+     (when-not (or drawing? points?)
+       (if (> (count placements) 1) [group-handles ctx placements] [handles ctx]))
      (when (and id pts (not drawing?) (not (channel/nothing? pts)))
        [:g
         [:polygon {:points (points-text pts) :fill "none"

frontend/test/arthur/domain/gesture_test.cljs

@@ -274,6 +274,22 @@
   (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"
@@ -297,6 +313,18 @@
     (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)]

frontend/test/arthur/events/lane_test.cljs

@@ -182,6 +182,14 @@
     (is (empty? (get-in after [:ui :expanded]))
         "and there are no rows above the top to open")))
 
+(deftest a-primary-selection-also-starts-the-stage-selection-set
+  (let [doc (fixture/document)
+        id (store/install! {:clip doc :store {}} "primary-stage-selection")
+        address [:node :main :insert [:insert]]
+        after (ui/selected {:clip/current id :ui {}} address)]
+    (is (= address (get-in after [:ui :selection])))
+    (is (= [address] (get-in after [:ui :selections])))))
+
 (deftest finishing-a-polygon-opens-no-rows
   ;; Expansion is the twist triangle's business. Finishing a shape used to open
   ;; every row down to it, which inside a lane meant tearing its one row into a

static/arthur/app.css

@@ -1380,6 +1380,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 .paint-overlay .handles .knob { fill: #161820; stroke: #fff1be; stroke-width: 0.6; cursor: grab; }
 .paint-overlay .handles .corner { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: nwse-resize; }
 .paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; }
+.paint-overlay .marquee { fill: rgba(230, 202, 139, 0.12); stroke: #e6ca8b; stroke-width: 0.6; stroke-dasharray: 2 1; pointer-events: none; }
 
 /* The aim outline and its name tag. Solid, no handles, and a tag pinned just
    outside the bottom-right corner — see `ui/stage/aim-box` for why the box