Slide rows along time and restack them, at any depth

A node's bar drags along the timeline: one write to its :at, for every node
alike, carried down through the instances above it. The stage and rows show
the slide live through ::render/clip, and it lands as one edit on release.

A row dropped on another's top or bottom edge goes in front of it or behind:
one write to :z, between its new neighbours (symbol/z-between). Onto the edge
of a row in another symbol, it moves there first. Neither needs anything on
screen — nest/down walks a row path by structure, without a frame.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

frontend/src/arthur/domain/nest.cljs

@@ -228,6 +228,81 @@
                         (node/mul! (node/mat) inv (:matrix here))
                         (node/then-time (node/invert-time b) a)))))
 
+(defn- down
+  "Walk row path `path` down from symbol `sid` by structure alone: `{:sid
+  :time}`, the symbol it leads to and the time map from `sid`'s frames to that
+  symbol's own, nil through a loop.
+
+  `inside` without the frame. Which symbol a row is in and how fast it runs
+  there are the same on every frame, so asking needs nothing to be on screen;
+  only a move that keeps the PICTURE needs a frame, for the matrix."
+  [clip sid path]
+  (let [sids  (reductions #(get-in clip [:symbols %1 :nodes %2 :of]) sid path)
+        ;; Every node on the way, outermost first: each instance, after its
+        ;; parents in the symbol it is in.
+        chain (mapcat (fn [sid id]
+                        (let [nodes (:nodes (clip/symbol clip sid))]
+                          (map #(get nodes %) (rseq (symbol/lineage nodes id)))))
+                      sids path)]
+    {:sid  (last sids)
+     :time (when (not-any? #(get-in % [:time :loop?]) chain)
+             (reduce node/then-time {:at 0 :rate 1} (map node/time-of chain)))}))
+
+(defn slide
+  "Move the node at row path `path` along its symbol's time by `df` frames of
+  `open`. `{:clip}` or `{:refused why}`.
+
+  ONE WRITE TO `:at`, for every node alike: its span, keys and children are in
+  its own frames and come with it. `df` is carried down into the frames `:at` is
+  in — the symbol's, through each instance on the way, and its parents' there."
+  [clip open path df]
+  (let [here  (down clip open (pop path))
+        id    (peek path)
+        nodes (:nodes (clip/symbol clip (:sid here)))]
+    (cond
+      (nil? (get nodes id)) {:refused "nothing to move"}
+      (nil? (:time here)) {:refused "a looping instance is in the way"}
+      :else
+      (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
+            d     (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))]
+        {:clip (clip/update-symbol
+                clip (:sid here) update-in [:nodes id]
+                (fn [n]
+                  (if (= :map (get-in n [:time :mode]))
+                    (update-in n [:time :at] (fnil + 0) d)
+                    (assoc n :time {:mode :map :at d :rate 1}))))}))))
+
+(defn restack
+  "Put the node at row path `from` just in front of the one at `to` when
+  `front?`, or just behind it — side by side in one symbol, as the timeline lists
+  them. `{:clip :sid :id}` or `{:refused why}`.
+
+  ONE WRITE TO `:z`, between the two it lands between, so nothing else is
+  renumbered. Among the nodes that share its parent, because that is what `:z`
+  orders; a roto part's parent is the rig, and it restacks within that."
+  [clip open from to front?]
+  (let [{sid :sid} (down clip open (pop to))
+        nodes (:nodes (clip/symbol clip sid))
+        n     (get nodes (peek from))
+        t     (get nodes (peek to))
+        z     #(or (:z %) "")
+        zs    (->> nodes
+                   (keep (fn [[k m]] (when (and (= (:parent m) (:parent t)) (not= k (peek from)))
+                                       (z m))))
+                   sort)]
+    (cond
+      (not= (pop from) (pop to)) {:refused "only things side by side can be restacked"}
+      (or (nil? n) (nil? t)) {:refused "nothing to restack"}
+      (not= (:parent n) (:parent t)) {:refused "they hang off different parents"}
+      :else
+      {:sid sid
+       :id (peek from)
+       :clip (clip/update-symbol
+              clip sid assoc-in [:nodes (peek from) :z]
+              (if front?
+                (symbol/z-between (z t) (first (filter #(pos? (compare % (z t))) zs)))
+                (symbol/z-between (last (filter #(neg? (compare % (z t))) zs)) (z t))))})))
+
 (defn group
   "Put the nodes at row paths `froms`, all side by side in one symbol, into a
   NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or

frontend/src/arthur/domain/symbol.cljs

@@ -110,6 +110,30 @@
   [nodes id]
   (mapv #(:z (get nodes %)) (rseq (lineage nodes id))))
 
+(defn z-between
+  "A `:z` that sorts strictly between `a` and `b`, which must be in order; nil
+  for either is no bound on that side. What makes restacking one write.
+
+  The midpoint of the first character they differ in, when there is room. When
+  there is not, anything that starts with `a` and is longer sorts after it, and
+  before `b` too unless `a` is a prefix of `b` — and then the room is found one
+  character further into `b`. \"0\" is the floor, and nothing this makes ends
+  in it, so there is always a further character to go to; only an authored key
+  ending in \"0\" leaves none, and then one character less than it does."
+  [a b]
+  (let [a (or a "")]
+    (if (nil? b)
+      (str a "m")
+      (let [i   (count (take-while true? (map = a b)))
+            hi  (.charCodeAt b i)
+            lo  (if (< i (count a)) (.charCodeAt a i) 48)
+            mid (quot (+ lo hi) 2)]
+        (cond
+          (> mid lo)      (str (subs b 0 i) (char mid))
+          (< i (count a)) (str a "m")
+          (< (inc i) (count b)) (str (subs b 0 (inc i)) (z-between nil (subs b (inc i))))
+          :else           (str (subs b 0 i) (char (dec hi)) "m"))))))
+
 (defn- z-lex
   "Lexicographic compare of two z paths, a prefix sorting first.
 

frontend/src/arthur/events/ui.cljs

@@ -176,6 +176,47 @@
            (assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj to (:id r))])
            (update-in [:ui :expanded] into (rest (reductions conj [] to))))))))
 
+(rf/reg-event-db
+ ::sliding
+ ;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the
+ ;; drag is abandoned.
+ (fn [db [_ path df]]
+   (if path
+     (assoc-in db [:ui :sliding] {:path path :df df})
+     (update db :ui dissoc :sliding))))
+
+(rf/reg-event-db
+ ::slide
+ (fn [db [_ path df]]
+   (let [db (update db :ui dissoc :sliding)
+         r  (nest/slide (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]) path df)]
+     (cond
+       (zero? df) db
+       (:refused r) (refused db (:refused r))
+       :else (edit/edit db (constantly (:clip r)))))))
+
+(rf/reg-event-db
+ ::restack
+ ;; Onto the edge of a row in another symbol, it goes into that symbol first:
+ ;; one gesture, as in a layers panel, for where it lives and where in the stack.
+ (fn [db [_ from to front?]]
+   (let [{clip :clip st :store} (store/entry (:clip/current db))
+         open  (get-in db [:ui :open])
+         f     (get-in db [:playback :frame])
+         host  (pop to)
+         moved (if (= host (pop from))
+                 {:clip clip :id (peek from)}
+                 (nest/move-node clip st open from host f))
+         r     (if (:refused moved)
+                 moved
+                 (nest/restack (:clip moved) open (conj host (:id moved)) to front?))]
+     (if-let [why (:refused r)]
+       (refused db why)
+       (-> db
+           (edit/edit (constantly (:clip r)))
+           (assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj host (:id r))])
+           (update-in [:ui :expanded] into (rest (reductions conj [] host))))))))
+
 (rf/reg-event-db
  ::group
  (fn [db [_ froms]]

frontend/src/arthur/subs/render.cljs

@@ -8,6 +8,7 @@
   recomputation here and a frame costs a lookup and a blit — and, crucially, the
   playhead is not an input, so moving it cannot invalidate this."
   (:require [arthur.domain.clip :as clip]
+            [arthur.domain.nest :as nest]
             [arthur.domain.palette :as pal]
             [arthur.footage.store :as footage]
             [arthur.subs.playback :as playback]
@@ -16,13 +17,23 @@
 (rf/reg-sub ::clip-id (fn [db _] (:clip/current db)))
 (rf/reg-sub ::paint-revision (fn [db _] (:paint/revision db)))
 
+(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
+(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
+
 (rf/reg-sub
  ::clip
  :<- [::clip-id]
  :<- [::paint-revision]
- (fn [[id _] _] (:clip (footage/entry id))))
+ :<- [::sliding]
-
+ :<- [::open]
-(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
+ (fn [[id _ sliding open] _]
+   ;; 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))]
+     (or (when-let [{:keys [path df]} sliding]
+           (:clip (nest/slide c open path df)))
+         c))))
 
 (rf/reg-sub
  ::symbol

frontend/src/arthur/ui/timeline.cljs

@@ -195,13 +195,25 @@
   (when-let [from (drag/row)]
     (not= from (subvec target 0 (min (count from) (count target))))))
 
+(defn- zone
+  "Which part of a row the pointer is over: its top edge, to go in front of it;
+  its bottom edge, to go behind; its middle, to go into it or be grouped with it."
+  [^js e]
+  (let [box (.getBoundingClientRect (.-currentTarget e))
+        y   (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))]
+    (cond (< y 0.3) :front (> y 0.7) :back :else :into)))
+
 (defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of]}
                    selection over]
-  (let [node? (= :node kind)]
+  (let [node? (= :node kind)
+        [over-path where] @over]
     [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
                                (when (= :ghost kind) " ghost")
-                               (when (= path @over)
+                               (when (= path over-path)
-                                 (if (= :instance node-kind) " drop-into" " drop-group")))
+                                 (case where
+                                   :front " drop-front"
+                                   :back  " drop-back"
+                                   (if (= :instance node-kind) " drop-into" " drop-group"))))
                    :style {:padding-left (str (+ 4 (* 11 depth)) "px")}
                    :title label
                    :on-click #(when select (rf/dispatch [::ui/select select]))
@@ -209,7 +221,9 @@
                    :on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))}
             ;; A node's row can be dragged onto another: onto an instance's, to
             ;; go inside the symbol it places; onto any other node's, to be
-            ;; grouped with it into a new one. Both keep the picture as it is.
+            ;; grouped with it into a new one; onto an edge of either, to be
+            ;; restacked in front of it or behind it, in whichever symbol it is
+            ;; in. All of them keep the picture as it is, but for the stacking.
             node? (merge {:draggable true
                           :on-drag-start (fn [^js e]
                                            (.stopPropagation e)
@@ -223,18 +237,21 @@
                                             (.preventDefault e)
                                             (.stopPropagation e)
                                             (set! (.. e -dataTransfer -dropEffect) "move")
-                                            (when (not= path @over) (reset! over path))))
+                                            (let [o [path (zone e)]]
+                                              (when (not= o @over) (reset! over o)))))
                           :on-drop (fn [^js e]
                                      (.preventDefault e)
                                      (.stopPropagation e)
-                                     (let [from (when (takes? path) (drag/row))]
+                                     (let [from  (when (takes? path) (drag/row))
+                                           where (zone e)]
                                        (reset! over nil)
                                        (drag/done!)
                                        (when from
                                          (rf/dispatch
-                                          (if (= :instance node-kind)
+                                          (cond
-                                            [::ui/move-node from path]
+                                            (not= :into where) [::ui/restack from path (= :front where)]
-                                            [::ui/group [from path]])))))}))
+                                            (= :instance node-kind) [::ui/move-node from path]
+                                            :else [::ui/group [from path]])))))}))
      [:button.tl-twist
       {:disabled (not expandable?)
        :on-click (fn [^js e]
@@ -244,26 +261,62 @@
      [:span.name label]
      (when node? [:span.kind (str "·" (name node-kind))])]))
 
-(defn- track-cell [{:keys [span keys dense? kind]} frames]
+(defn- track-cell
-  [:div.tl-track
+  "`sliding` is the pointer's side of a bar being dragged, `{:path :x :width
-   ;; Clipped to the ruler: an instance longer than the room left in its
+  :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every
-   ;; symbol still plays its own frames from 0, it is just cut off at the end.
+  row and the stage are drawn from already has in it."
-   (when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])]
+  [{:keys [path span keys dense? kind select]} frames sliding]
-     (when (< in out)
+  (let [{from :path x0 :x width :width} @sliding
-       [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost"))
+        slide   (fn [^js e]
-              :style {:left (edge% in frames)
+                  (when (= path from)
-                      :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}}]))
+                    (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))]
-   ;; A dense channel has a value on every frame, so ticking each one is a solid
+                      (when (not= df (:df @sliding))
-   ;; block that says less than the bar behind it already does.
+                        (swap! sliding assoc :df df)
-   (when-not dense?
+                        (rf/dispatch [::ui/sliding path df])))))
-     (doall
+        done    (fn [commit?]
-      (for [f keys :when (and (<= 0 f) (< f frames))]
+                  (when (= path from)
-        ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])
+                    (let [df (:df @sliding)]
+                      (reset! sliding nil)
+                      (rf/dispatch (if commit? [::ui/slide path df] [::ui/sliding nil])))))]
+    [:div.tl-track
+     ;; The track, not the bar, holds the pointer while a bar slides, so the drag
+     ;; goes on when the bar has slid off the ruler and is no longer drawn.
+     {:on-pointer-move   slide
+      :on-pointer-up     (fn [e] (slide e) (done true))
+      :on-pointer-cancel (fn [_] (done false))}
+     ;; Clipped to the ruler: an instance longer than the room left in its
+     ;; symbol still plays its own frames from 0, it is just cut off at the end.
+     (when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])]
+       (when (< in out)
+         [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
+                            (when select " movable") (when (= path from) " sliding"))
+                :style {:left (edge% in frames)
+                        :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
+                :on-pointer-down
+                (when select
+                  (fn [^js e]
+                    (let [track (.. e -currentTarget -parentElement)]
+                      (.stopPropagation e)
+                      (rf/dispatch [::ui/select select])
+                      (reset! sliding {:path path :x (.-clientX e) :df 0
+                                       :width (.-width (.getBoundingClientRect track))})
+                      ;; As on the ruler: an enhancement that throws on a pointer
+                      ;; the browser has no record of.
+                      (try (.setPointerCapture track (.-pointerId e))
+                           (catch :default _ nil)))))}]))
+     ;; A dense channel has a value on every frame, so ticking each one is a solid
+     ;; block that says less than the bar behind it already does.
+     (when-not dense?
+       (doall
+        (for [f keys :when (and (<= 0 f) (< f frames))]
+          ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))]))
 
 (defn view []
   (r/with-let [scrubbing (r/atom false)
-               ;; The row a carried row is over, for the highlight.
+               ;; The row a carried row is over and which part of it, for the
-               over (r/atom nil)]
+               ;; highlight.
+               over (r/atom nil)
+               sliding (r/atom nil)]
     (let [clip      @(rf/subscribe [::render/clip])
           frames    (max 1 (or @(rf/subscribe [::render/frames]) 1))
           frame     @(rf/subscribe [::playback/frame])
@@ -345,6 +398,6 @@
              ^{:key f} [:div.tick {:style {:left (edge% f frames)}} f]))]
          (if (seq visible)
            (doall (for [row visible]
-                    ^{:key (str (:path row))} [track-cell row frames]))
+                    ^{:key (str (:path row))} [track-cell row frames sliding]))
            [:div.tl-empty "nothing in this symbol"])
          [:div.tl-playhead {:style {:left (at% frame frames)}}]]]])))

frontend/test/arthur/domain/nest_test.cljs

@@ -192,3 +192,49 @@
            (select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate]))
         "half speed inside something at double speed, so it runs as it did")
     (is (= (picture c :main fs) (picture moved :main fs)))))
+
+(deftest sliding-a-shape-inside-a-retimed-instance-moves-it-by-frames-of-the-open-symbol
+  ;; `box` runs at double speed from 10, so six frames of main are twelve of box.
+  (let [c   (-> (studio)
+                (update-in [:symbols :main :nodes] dissoc :tri)
+                (assoc-in [:symbols :main :nodes a-uuid :time :rate] 2)
+                (assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]]
+                          (ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]})))
+        {slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6)
+        fs  [13 15 18 20]]
+    (is (nil? (:refused r)) (:refused r))
+    (is (= {:mode :map :at 12 :rate 1} (get-in slid [:symbols :box :nodes :inner :time])))
+    (is (= [4 60] (get-in slid [:symbols :box :nodes :inner :span])) "its span and keys are its own")
+    (is (= (picture c :main fs) (picture slid :main (map #(+ 6 %) fs)))
+        "what it did at a frame of main it now does six frames later")
+    (is (seq (first (picture c :main [14]))))
+    (is (empty? (first (picture slid :main [14]))) "and it is not there yet where it was")
+    (testing "sliding it again adds to where it is"
+      (is (= 2 (get-in (:clip (nest/slide slid :main [a-uuid :inner] -5))
+                       [:symbols :box :nodes :inner :time :at]))))))
+
+(deftest sliding-needs-nothing-on-screen-and-refuses-only-a-loop
+  (let [c (studio)]
+    (is (= 3 (get-in (:clip (nest/slide c :main [a-uuid :inner] 3))
+                     [:symbols :box :nodes :inner :time :at]))
+        "the instance starts at 10, and where the playhead is has nothing to do with it")
+    (is (:refused (nest/slide (assoc-in c [:symbols :main :nodes a-uuid :time :loop?] true)
+                              :main [a-uuid :inner] 3))
+        "but through a loop one frame outside is many inside")))
+
+(deftest restacking-is-one-write-to-z
+  (let [shape (fn [z] {:kind :poly :z z :channels {}})
+        c     (-> (clip/blank)
+                  (assoc-in [:symbols :main :nodes] {:a (shape "a1") :b (shape "a2") :c (shape "a3")}))
+        order (fn [c] (map key (sort-by (comp :z val) (get-in c [:symbols :main :nodes]))))
+        front (:clip (nest/restack c :main [:a] [:c] true))
+        back  (:clip (nest/restack c :main [:c] [:a] false))
+        mid   (:clip (nest/restack c :main [:a] [:b] true))]
+    (is (= [:b :c :a] (order front)) "in front of the front one")
+    (is (= [:c :a :b] (order back)) "behind the back one")
+    (is (= [:b :a :c] (order mid)) "between two")
+    (is (= (dissoc (get-in c [:symbols :main :nodes]) :a)
+           (dissoc (get-in mid [:symbols :main :nodes]) :a))
+        "and nothing else is renumbered")
+    (is (:refused (nest/restack c :main [:a] [a-uuid :inner] true))
+        "only among the things it is beside")))

frontend/test/arthur/domain/symbol_test.cljs

@@ -107,6 +107,21 @@
     (is (= [:a :b :c] (ids-at with 0)))
     (is (= (get-in base [:nodes :a]) (get-in with [:nodes :a])) "and :a is untouched")))
 
+(deftest z-between-always-finds-room
+  (let [between? (fn [a b z] (and (or (nil? a) (neg? (compare a z)))
+                                  (or (nil? b) (neg? (compare z b)))))]
+    (testing "on the keys scenes already have"
+      (doseq [[a b] [[nil "a1"] ["a1" nil] ["a1" "a2"] ["a1" "a3"] ["a" "a1"]
+                     ["a1" "z1727000000000-shape"] [nil "0"] [nil "-"] ["c0000" "c0001"]]]
+        (is (between? a b (symbol/z-between a b)) (pr-str [a b (symbol/z-between a b)]))))
+    (testing "and again and again: to the back, to the front, and into one gap from either side"
+      (doseq [[label start step past?] [["back"     "a1" #(symbol/z-between nil %)  #(between? nil %1 %2)]
+                                        ["front"    "a1" #(symbol/z-between % nil)  #(between? %1 nil %2)]
+                                        ["under a2" "a1" #(symbol/z-between % "a2") #(between? %1 "a2" %2)]
+                                        ["over a1"  "a2" #(symbol/z-between "a1" %) #(between? "a1" %1 %2)]]]
+        (is (every? (fn [[x y]] (past? x y)) (partition 2 1 (take 300 (iterate step start))))
+            label)))))
+
 ;; ---- transform composition through the tree ----
 
 (deftest geometry-lands-in-the-parents-space

static/arthur/app.css

@@ -660,9 +660,16 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 /* The preview row of a drop in flight: its own length, where it would start. */
 .tl-span.ghost, .tl-label.ghost { pointer-events: none; }
 
-/* A row being dragged over another: into an instance, or grouped with a node. */
+/* A row being dragged over another: into an instance, or grouped with a node,
+   by its middle; in front of it or behind it, by its top or bottom edge. */
 .tl-label.drop-into { box-shadow: inset 0 0 0 2px var(--sel); background: var(--sel-bg); }
-.tl-label.drop-group { box-shadow: inset 0 -2px 0 var(--sel); }
+.tl-label.drop-group { outline: 2px dashed var(--sel); outline-offset: -2px; }
+.tl-label.drop-front { box-shadow: inset 0 2px 0 var(--sel); }
+.tl-label.drop-back { box-shadow: inset 0 -2px 0 var(--sel); }
+
+/* A node's bar slides it along its symbol's time. */
+.tl-span.movable { cursor: ew-resize; touch-action: none; }
+.tl-span.movable.sliding { border-color: var(--sel); }
 .tl-span.ghost {
   background: transparent;
   border: 1px dashed var(--sel);
@@ -678,6 +685,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
   margin: -3.5px 0 0 -3.5px;
   background: var(--key);
   border-radius: 50%;
+  /* So grabbing a dot grabs the bar under it. */
+  pointer-events: none;
 }
 
 .tl-playhead {