Drag timeline rows into symbols, into groups, and back out

A node's row can be dragged onto an instance's row, to go inside the symbol
it places; onto any other node's row, to be grouped with it into a new
symbol; or onto empty label space, to come back to the top of the open
symbol. All three keep the picture and the timing as they are, and a refused
move says why in the status line. Pool drop targets now only take things out
of the pool, and row drags set a move effect so the browser delivers the drop.

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

frontend/src/arthur/domain/clip.cljs

@@ -486,7 +486,9 @@
                       (= m id) (-> (retime time)
                                    (assoc :pinv (vec (array-seq pinv))
                                           :z (str "z" (js/Date.now) "-" (ids m))))))]
-        {:clip (-> clip
+        {:id (ids id)
+         :sid target
+         :clip (-> clip
                    (update-symbol host update :nodes #(apply dissoc % moving))
                    (update-symbol target update :nodes (fnil into {})
                                   (map (juxt :id identity)) moved))}))))
@@ -496,7 +498,8 @@
   instances down to where it lives — into the symbol placed by the instance at
   row path `to`, or to the top of `open` when `to` is empty. Row paths start at
   `open`, and `f` is its current frame, at which both have to be on screen.
-  `{:clip}`, or `{:refused why}`."
+  `{:clip :sid :id}` — the symbol it landed in and its id there, renamed only if
+  that one was taken — or `{:refused why}`."
   [clip store open from to f]
   (let [here  (inside clip store open (pop from) f)
         there (inside clip store open to f)

frontend/src/arthur/events/ui.cljs

@@ -151,3 +151,43 @@
          (edit/edit-entry #(update % :clip clip/place-symbol (:store %)
                                    host sid frame uuid point))
          (assoc-in [:ui :selection] [:node host uuid [uuid]])))))
+
+;; ---------------------------------------------------------------------------
+;; moving rows between symbols
+;;
+;; Both are `clip/move-node` and `clip/group`, which keep the picture and the
+;; timing as they are; what these add is where the selection goes and the reason
+;; when a move is refused, which is the only feedback a refused drop has.
+
+(defn- refused [db why]
+  (update db :project merge {:status (str "can't: " why)}))
+
+(rf/reg-event-db
+ ::move-node
+ (fn [db [_ from to]]
+   (let [{clip :clip st :store} (store/entry (:clip/current db))
+         r (clip/move-node clip st (get-in db [:ui :open]) from to
+                           (get-in db [:playback :frame]))]
+     (if-let [why (:refused r)]
+       (refused db why)
+       (-> db
+           (edit/edit (constantly (:clip r)))
+           (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
+ ::group
+ (fn [db [_ froms]]
+   (let [{clip :clip st :store} (store/entry (:clip/current db))
+         open (get-in db [:ui :open])
+         f    (get-in db [:playback :frame])
+         host (pop (first froms))
+         uuid (random-uuid)
+         r    (clip/group clip st open froms (clip/fresh-id clip) uuid f)]
+     (if-let [why (:refused r)]
+       (refused db why)
+       (-> db
+           (edit/edit (constantly (:clip r)))
+           (assoc-in [:ui :selection] [:node (:sid (clip/inside clip st open host f))
+                                       uuid (conj host uuid)])
+           (update-in [:ui :expanded] conj (conj host uuid)))))))

frontend/src/arthur/ui/drag.cljs

@@ -47,9 +47,22 @@
                              :shapes (outline document st sid)}))))
 
 (defn accepts?
-  "Whether a drop target should accept what is being carried."
+  "Whether the stage or the tracks should accept what is being carried: things
+  out of the pool, and not one that would make a cycle."
   []
-  (let [c @carrying] (and c (not (:refused? c)))))
+  (let [c @carrying]
+    (and c (#{:symbol :footage :import} (:kind c)) (not (:refused? c)))))
+
+(defn row!
+  "Start carrying the timeline row at `path` — a node, to be moved into another
+  symbol or grouped with another node."
+  [path]
+  (reset! carrying {:kind :row :path path}))
+
+(defn row
+  "The path of the row being carried, or nil when it is not a row."
+  []
+  (let [c @carrying] (when (= :row (:kind c)) (:path c))))
 
 (defn other!
   "Start carrying something that is not yet in the document: `:kind` says what,

frontend/src/arthur/ui/timeline.cljs

@@ -188,15 +188,53 @@
       (str (.toFixed (or fps 0) 1) " paint/s"
            (when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]]))
 
+(defn- takes?
+  "Whether the row at `target` can take the row being carried: not itself, and
+  not anything inside it."
+  [target]
+  (when-let [from (drag/row)]
+    (not= from (subvec target 0 (min (count from) (count target))))))
+
 (defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of]}
-                   selection]
+                   selection over]
-  [:div {:class (str "tl-label" (when (and select (= select selection)) " on")
+  (let [node? (= :node kind)]
-                     (when (= :ghost kind) " ghost"))
+    [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
+                               (when (= :ghost kind) " ghost")
+                               (when (= path @over)
+                                 (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]))
                    ;; An instance's row opens the symbol it places, as a tab.
                    :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.
+            node? (merge {:draggable true
+                          :on-drag-start (fn [^js e]
+                                           (.stopPropagation e)
+                                           (.setData (.-dataTransfer e) "text/plain" "row")
+                                           (set! (.. e -dataTransfer -effectAllowed) "move")
+                                           (drag/row! path))
+                          :on-drag-end (fn [_] (reset! over nil) (drag/done!))
+                          :on-drag-enter (fn [^js e] (when (takes? path) (.preventDefault e)))
+                          :on-drag-over (fn [^js e]
+                                          (when (takes? path)
+                                            (.preventDefault e)
+                                            (.stopPropagation e)
+                                            (set! (.. e -dataTransfer -dropEffect) "move")
+                                            (when (not= path @over) (reset! over path))))
+                          :on-drop (fn [^js e]
+                                     (.preventDefault e)
+                                     (.stopPropagation e)
+                                     (let [from (when (takes? path) (drag/row))]
+                                       (reset! over nil)
+                                       (drag/done!)
+                                       (when from
+                                         (rf/dispatch
+                                          (if (= :instance node-kind)
+                                            [::ui/move-node from path]
+                                            [::ui/group [from path]])))))}))
      [:button.tl-twist
       {:disabled (not expandable?)
        :on-click (fn [^js e]
@@ -204,7 +242,7 @@
                    (rf/dispatch [::ui/toggle-row path]))}
       (when expandable? (if expanded? "▾" "▸"))]
      [:span.name label]
-   (when (= :node kind) [:span.kind (str "·" (name node-kind))])])
+     (when node? [:span.kind (str "·" (name node-kind))])]))
 
 (defn- track-cell [{:keys [span keys dense? kind]} frames]
   [:div.tl-track
@@ -223,7 +261,9 @@
         ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])
 
 (defn view []
-  (r/with-let [scrubbing (r/atom false)]
+  (r/with-let [scrubbing (r/atom false)
+               ;; The row a carried row is over, for the highlight.
+               over (r/atom nil)]
     (let [clip      @(rf/subscribe [::render/clip])
           frames    (max 1 (or @(rf/subscribe [::render/frames]) 1))
           frame     @(rf/subscribe [::playback/frame])
@@ -244,11 +284,23 @@
        [transport]
        [:div.tl-body
         [:div.tl-labels
+         ;; Empty label space takes a row back out to the top of the open symbol.
+         {:on-drag-over (fn [^js e]
+                          (when (drag/row)
+                            (.preventDefault e)
+                            (set! (.. e -dataTransfer -dropEffect) "move")))
+          :on-drop (fn [^js e]
+                     (.preventDefault e)
+                     (when-let [from (drag/row)]
+                       (drag/done!)
+                       (reset! over nil)
+                       (when (< 1 (count from))
+                         (rf/dispatch [::ui/move-node from []]))))}
          [:div {:style {:height "var(--ruler)"
                         :border-bottom "1px solid var(--line)"
                         :background "var(--chrome)"}}]
          (doall (for [row visible]
-                  ^{:key (str (:path row))} [label-cell row selection]))]
+                  ^{:key (str (:path row))} [label-cell row selection over]))]
         [:div.tl-tracks
          {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
           :on-drag-over (fn [^js e]

static/arthur/app.css

@@ -615,6 +615,10 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
 
 /* 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. */
+.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-span.ghost {
   background: transparent;
   border: 1px dashed var(--sel);