Drag symbols onto the stage or the timeline, with previews

A symbol dragged out of the pool shows where it would land: on the stage, a
dashed outline of its first frame centred on the pointer, and on the timeline
a preview row of its own length. A stage drop places it at the playhead under
the pointer; a timeline drop places it at the frame under the pointer, in its
own coordinates. A drop that would make a cycle is refused while hovering.
Pool thumbnails are capped at 40x30.

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

frontend/src/arthur/events/ui.cljs

@@ -70,16 +70,7 @@
    (assoc-in db [:ui :knobs [scope id knob]] value)))
 
 ;; ---------------------------------------------------------------------------
-;; the pool, onto the stage
+;; a new symbol
-
-(rf/reg-event-db
- ::place-symbol
- (fn [db [_ sid [x y]]]
-   (let [uuid (random-uuid)
-         host (get-in db [:ui :open])]
-     (-> db
-         (edit/edit #(clip/place-symbol % host sid (get-in db [:playback :frame]) uuid [x y]))
-         (assoc-in [:ui :selection] [:node host uuid])))))
 
 (defn- where-new-goes
   "The row path, from the open symbol down, of the symbol a new thing goes into:
@@ -112,3 +103,32 @@
          ;; Open every row down to it, or the new row is inside a closed one and
          ;; the button looks like it did nothing.
          (update-in [:ui :expanded] into (rest (reductions conj [] down)))))))
+
+;; ---------------------------------------------------------------------------
+;; a drop in flight
+;;
+;; `[:ui :drop]` is where a drag out of the pool would land: `:where` is :stage or
+;; :timeline, `:frame` the frame of the open symbol it would start on, and
+;; `:point` the stage pixel under the pointer when that is the stage. `:label`
+;; and `:frames` ride along so the timeline can draw the preview row without
+;; reaching into the drag. Only written when it CHANGES — dragover fires every few
+;; milliseconds whether the pointer moved or not.
+
+(rf/reg-event-db
+ ::drop-hover
+ (fn [db [_ hover]]
+   (if (= hover (get-in db [:ui :drop])) db (assoc-in db [:ui :drop] hover))))
+
+(rf/reg-event-db
+ ::drop-clear
+ (fn [db _] (update db :ui dissoc :drop)))
+
+(rf/reg-event-db
+ ::drop-symbol
+ (fn [db [_ sid frame pos]]
+   (let [uuid (random-uuid)
+         host (get-in db [:ui :open])]
+     (-> db
+         (update :ui dissoc :drop)
+         (edit/edit #(clip/place-symbol % host sid frame uuid pos))
+         (assoc-in [:ui :selection] [:node host uuid [uuid]])))))

frontend/src/arthur/subs/ui.cljs

@@ -13,6 +13,7 @@
 (rf/reg-sub ::tone      (fn [db _] (get-in db [:ui :tone])))
 (rf/reg-sub ::tool      (fn [db _] (get-in db [:ui :tool])))
 (rf/reg-sub ::draft     (fn [db _] (get-in db [:ui :draft])))
+(rf/reg-sub ::drop      (fn [db _] (get-in db [:ui :drop])))
 (rf/reg-sub ::tabs      (fn [db _] (get-in db [:ui :tabs])))
 (rf/reg-sub ::expanded  (fn [db _] (get-in db [:ui :expanded])))
 (rf/reg-sub ::knobs     (fn [db _] (get-in db [:ui :knobs])))

frontend/src/arthur/ui/drag.cljs

@@ -0,0 +1,98 @@
+(ns arthur.ui.drag
+  "What a drag out of the pool is carrying while it is in flight, and what it
+  would look like where it lands.
+
+  A PAGE-LOCAL ATOM, not `dataTransfer`. A browser lets a drop target read the
+  payload on `drop` and hides it on every `dragover` before that, which is exactly
+  when a preview needs it — so the pool writes the payload here on `dragstart`,
+  and the `text/plain` it also sets is only what makes the drag a drag. A plain
+  atom rather than app-db because it lives for one gesture and nothing renders
+  from it; what the preview DOES render from — the frame and point under the
+  pointer — is `[:ui :drop]`, set by `::ui/drop-hover`."
+  (:require [arthur.domain.clip :as clip]
+            [arthur.domain.palette :as pal]
+            [arthur.events.ui :as ui]
+            [arthur.footage.store :as store]
+            [re-frame.core :as rf]))
+
+(defonce carrying (atom nil))
+
+(defn- outline
+  "Frame 0 of symbol `sid` as plain shapes in its own space, and the centre of
+  their bounds. Frame 0 because an instance dropped at the playhead starts there."
+  [document st sid]
+  (let [shapes (keep (fn [op]
+                       (case (:kind op)
+                         :poly {:kind :poly
+                                :pts (vec (take (* 2 (:n op)) (array-seq (:pts op))))}
+                         :disc (select-keys op [:kind :cx :cy :r])
+                         :rect (select-keys op [:kind :cx :cy :size])
+                         nil))
+                     ((clip/resolver document st pal/index-of sid) 0))
+        xys (mapcat (fn [{:keys [kind pts cx cy]}]
+                      (if (= :poly kind) (partition 2 pts) [[cx cy]]))
+                    shapes)]
+    (if (empty? xys)
+      {:shapes []}
+      (let [xs (map first xys) ys (map second xys)
+            [x0 x1 y0 y1] [(apply min xs) (apply max xs) (apply min ys) (apply max ys)]]
+        {;; Under a few pixels there is nothing to see — a face symbol is drawn in
+         ;; units of one image height and scaled up by what places it — so the
+         ;; preview is the crosshair instead.
+         :shapes (if (< (max (- x1 x0) (- y1 y0)) 3) [] (vec shapes))
+         :center [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]}))))
+
+(defn symbol!
+  "Start carrying symbol `sid` of the loaded document into the open symbol."
+  [clip-id sid open]
+  (let [{document :clip st :store} (store/entry clip-id)]
+    (reset! carrying (merge {:kind :symbol :sid sid
+                             :label (clip/symbol-name document sid)
+                             :frames (clip/frames document sid)
+                             ;; A symbol cannot go inside itself or inside
+                             ;; anything it places. Refused by not ACCEPTING the
+                             ;; drop, so the pointer says so while it hovers.
+                             :refused? (clip/contains-symbol? document sid open)}
+                            (outline document st sid)))))
+
+(defn accepts?
+  "Whether a drop target should accept what is being carried."
+  []
+  (let [c @carrying] (and c (not (:refused? c)))))
+
+(defn other!
+  "Start carrying something that is not yet in the document: `:kind` says what,
+  and the rest is what a preview can show of it before it is fetched."
+  [payload]
+  (reset! carrying payload))
+
+(defn done!
+  "The gesture is over, dropped or abandoned."
+  []
+  (reset! carrying nil)
+  (rf/dispatch [::ui/drop-clear]))
+
+(defn hover!
+  "Say where the drag would land, for the previews. `point` is nil over the
+  timeline."
+  [where frame point]
+  (when-let [{:keys [label frames]} @carrying]
+    (rf/dispatch [::ui/drop-hover {:where where :frame frame :point point
+                                   :label label :frames frames}])))
+
+(defn pos-for
+  "Where an instance goes so the middle of its first frame is under `point`. A
+  symbol with nothing drawn has no middle, and its origin goes there instead."
+  [point]
+  (let [[cx cy] (:center @carrying)]
+    (if cx (mapv - point [cx cy]) point)))
+
+(defn land!
+  "Drop what is being carried at `frame` of the open symbol, with its instance
+  at `pos`."
+  [frame pos]
+  (when-let [{:keys [kind sid]} (when (accepts?) @carrying)]
+    (case kind
+      :symbol (rf/dispatch [::ui/drop-symbol sid frame pos])
+      nil))
+  (done!))

frontend/src/arthur/ui/pool.cljs

@@ -27,6 +27,7 @@
             [arthur.subs.playback :as playback]
             [arthur.subs.render :as render]
             [arthur.subs.ui :as sub]
+            [arthur.ui.drag :as drag]
             [clojure.string :as str]
             [re-frame.core :as rf]
             [reagent.core :as r]))
@@ -43,11 +44,16 @@
    [:span.text label (when sub [:span.sub sub])]])
 
 (defn- carrying
-  "Drag-start handler for a row whose payload is `payload`."
+  "The drag handlers for a row. `text` is what makes it a drag at all and what
-  [payload]
+  another application would receive; `start!` puts the real payload where the
-  (fn [^js event]
+  stage and the timeline can read it while hovering — see `ui/drag`."
-    (.setData (.-dataTransfer event) "text/plain" payload)
+  [text start!]
-    (set! (.. event -dataTransfer -effectAllowed) "copy")))
+  {:draggable true
+   :on-drag-start (fn [^js event]
+                    (.setData (.-dataTransfer event) "text/plain" text)
+                    (set! (.. event -dataTransfer -effectAllowed) "copy")
+                    (start!))
+   :on-drag-end (fn [_] (drag/done!))})
 
 (defn- thumbnail
   "One frame of a video, from its proxy. `#t=` seeks a paused, muted element to a
@@ -55,18 +61,22 @@
   played and nothing is decoded past it."
   [{:keys [video]}]
   (if video
+    ;; Sized here as well as in the stylesheet: a video element with no size
+    ;; is as big as its footage, and a portrait phone clip is 1440×1920.
     [:video.thumb {:src (str video "#t=0.2") :muted true :preload "metadata"
-                   :plays-inline true :tab-index -1}]
+                   :plays-inline true :tab-index -1
+                   :style {:width 40 :height 30 :max-width 40 :max-height 30}}]
     [:span.thumb]))
 
 (defn- footage-row [{:keys [id label frames fps] :as f} chosen]
-  [item {:label label
+  [item (merge {:label label
-         :sub (str frames "f @ " fps)
+                :sub (str frames "f @ " fps)
-         :thumb [thumbnail f]
+                :thumb [thumbnail f]
-         :on? (= id chosen)
+                :on? (= id chosen)
-         :draggable true
+                :on-click #(rf/dispatch [::footage/choose id])}
-         :on-drag-start (carrying (str "footage:" id))
+               (carrying (str "footage:" id)
-         :on-click #(rf/dispatch [::footage/choose id])}])
+                         #(drag/other! {:kind :footage :id id :label label
+                                        :frames frames :fps fps})))])
 
 (defn- folder [title & children]
   (into [:details.pool-folder {:open true} [:summary title]] children))
@@ -76,6 +86,7 @@
 
 (defn- this-project []
   (let [document  @(rf/subscribe [::render/clip])
+        clip-id   @(rf/subscribe [::render/clip-id])
         selection @(rf/subscribe [::sub/selection])
         open      @(rf/subscribe [::render/open])
         media     @(rf/subscribe [::sub/project-footage])
@@ -86,14 +97,14 @@
                     (for [sid (sort-by str (keys (:symbols document)))
                           :let [sym (clip/symbol document sid)]]
                       ^{:key (str sid)}
-                      [item {:label (clip/symbol-name document sid)
+                      [item (merge {:label (clip/symbol-name document sid)
-                             :sub (str (:frames sym) "f · " (count (:nodes sym)) " nodes"
+                                    :sub (str (:frames sym) "f · " (count (:nodes sym)) " nodes"
-                                       (when (= sid open) " · open"))
+                                              (when (= sid open) " · open"))
-                             :on? (= selection [:symbol sid])
+                                    :on? (= selection [:symbol sid])
-                             :draggable true
+                                    :on-click #(rf/dispatch [::ui/select [:symbol sid]])
-                             :on-drag-start (carrying (str "symbol:" (subs (str sid) 1)))
+                                    :on-double-click #(rf/dispatch [::pb/open-symbol sid])}
-                             :on-click #(rf/dispatch [::ui/select [:symbol sid]])
+                                   (carrying (str "symbol:" (subs (str sid) 1))
-                             :on-double-click #(rf/dispatch [::pb/open-symbol sid])}]))
+                                             #(drag/symbol! clip-id sid open)))]))
                    [:div.dim "double-click to open · drag to place"])
             (group "media"
                    (if (empty? media)
@@ -124,10 +135,12 @@
                            (doall
                             (for [{:keys [cid symbol name frames]} rows]
                               ^{:key (str cid symbol)}
-                              [item {:label name
+                              [item (merge {:label name :sub (str frames "f")}
-                                     :sub (str frames "f")
+                                           (carrying (str "import:" (str/join "|" [pid cid symbol]))
-                                     :draggable true
+                                                     #(drag/other! {:kind :import :label name
-                                     :on-drag-start (carrying (str "import:" (str/join "|" [pid cid symbol])))}]))]))))))))
+                                                                    :frames frames
+                                                                    :project pid :cid cid
+                                                                    :symbol symbol})))]))]))))))))
 
 (defn view []
   (r/with-let [;; Counted, not a boolean. `dragenter`/`dragleave` fire for every

frontend/src/arthur/ui/stage.cljs

@@ -16,6 +16,7 @@
             [arthur.subs.playback :as playback]
             [arthur.subs.render :as render]
             [arthur.subs.ui :as sub]
+            [arthur.ui.drag :as drag]
             [arthur.ui.player :as player]
             [re-frame.core :as rf]))
 
@@ -65,6 +66,34 @@
               (or (not= :linear (channel/segment-interp geom active))
                   (contains? (:keys geom) frame)))]))))
 
+(defn- ghost
+  "Where a drag out of the pool would land: the outline of its first frame,
+  dashed, with its middle under the pointer. Drawn from the drag's own outline
+  rather than by resolving anything, so hovering costs one re-render and no
+  evaluation."
+  []
+  (let [{:keys [where point]} @(rf/subscribe [::sub/drop])
+        {:keys [shapes]} @drag/carrying]
+    (when (and (= :stage where) point)
+      (let [[x y] (drag/pos-for point)]
+        [:g.ghost {:transform (str "translate(" x "," y ")")}
+         (if (seq shapes)
+           (doall
+            (map-indexed
+             (fn [i {:keys [kind pts cx cy r size]}]
+               (case kind
+                 :poly ^{:key i} [:polygon {:points (points-text pts)}]
+                 :disc ^{:key i} [:circle {:cx cx :cy cy :r r}]
+                 :rect ^{:key i} [:rect {:x (- cx (/ size 2)) :y (- cy (/ size 2))
+                                         :width size :height size}]
+                 nil))
+             shapes))
+           ;; Nothing drawn, or nothing big enough to see: a mark where its
+           ;; middle will land.
+           (let [[cx cy] (or (:center @drag/carrying) [0 0])]
+             [:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5)
+                             " M " cx " " (- cy 5) " V " (+ cy 5))}]))]))))
+
 (defn- overlay [w h]
   (let [clip  @(rf/subscribe [::render/clip])
         frame @(rf/subscribe [::playback/frame])
@@ -87,6 +116,7 @@
                                               (stage-point event w h)])))
            :on-pointer-up     (fn [_] (reset! dragging nil))
            :on-pointer-cancel (fn [_] (reset! dragging nil))}
+     [ghost]
      (when (seq draft)
        [:polyline {:points (points-text draft) :fill "none"
                    :stroke "#d0ba86" :stroke-width 1}])
@@ -108,32 +138,31 @@
                                              (.-pointerId event))
                          (reset! dragging [sid id active i]))}])))])]))
 
-(defn- dropped-symbol
-  "The symbol a drag out of the media pool is carrying, or nil.
-
-  `text/plain` with a prefix rather than a custom MIME type: the payload is one
-  short string, every browser agrees about this type, and a drag that arrives
-  from somewhere else simply fails the prefix test."
-  [^js event]
-  (let [data (.getData (.-dataTransfer event) "text/plain")]
-    (when (and data (.startsWith data "symbol:"))
-      (keyword (subs data (count "symbol:"))))))
-
 (defn view []
   ;; Reactive on the clip's dimensions, so selecting a clip of another size
   ;; resizes the canvas. `ui/canvas` guards the width assignment — which
   ;; reallocates the backing store — so this re-rendering costs nothing per frame.
   (let [w @(rf/subscribe [::playback/width])
-        h @(rf/subscribe [::playback/height])]
+        h @(rf/subscribe [::playback/height])
+        frame @(rf/subscribe [::playback/frame])]
     [:div.stage-area
      [:div.stage-wrap
-      {:on-drag-over (fn [^js event]
+      ;; A drop on the stage lands at the PLAYHEAD, where the pointer is in space;
-                       (when (.-types (.-dataTransfer event))
+      ;; a drop on the timeline lands where the pointer is in time.
-                         (.preventDefault event)))
+      ;; `dragenter` is cancelled as well as `dragover`: a drop target has to
+      ;; accept on BOTH, and the element under the pointer changes whenever the
+      ;; preview re-renders beneath it, which fires a fresh `dragenter`.
+      {:on-drag-enter (fn [^js event] (when (drag/accepts?) (.preventDefault event)))
+       :on-drag-over (fn [^js event]
+                       (when (drag/accepts?)
+                         (.preventDefault event)
+                         (drag/hover! :stage frame (stage-point event w h))))
+       :on-drag-leave (fn [^js event]
+                        (when-not (.contains (.-currentTarget event) (.-relatedTarget event))
+                          (rf/dispatch [::ui/drop-clear])))
        :on-drop (fn [^js event]
                   (.preventDefault event)
-                  (when-let [sid (dropped-symbol event)]
+                  (drag/land! frame (drag/pos-for (stage-point event w h))))}
-                    (rf/dispatch [::ui/place-symbol sid (stage-point event w h)])))}
       [:canvas.stage {:ref #(player/set-canvas! %)
                       :width w :height h
                       :style {:width (str (* zoom w) "px")

frontend/src/arthur/ui/timeline.cljs

@@ -28,6 +28,7 @@
             [arthur.subs.playback :as playback]
             [arthur.subs.render :as render]
             [arthur.subs.ui :as sub]
+            [arthur.ui.drag :as drag]
             [arthur.ui.player :as player]
             [re-frame.core :as rf]
             [reagent.core :as r]))
@@ -197,7 +198,8 @@
 
 (defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of]}
                    selection]
-  [:div {:class (str "tl-label" (when (and select (= select selection)) " on"))
+  [:div {:class (str "tl-label" (when (and select (= select selection)) " on")
+                     (when (= :ghost kind) " ghost"))
          :style {:padding-left (str (+ 4 (* 11 depth)) "px")}
          :title label
          :on-click #(when select (rf/dispatch [::ui/select select]))
@@ -212,13 +214,13 @@
    [:span.name label]
    (when (= :node kind) [:span.kind (str "·" (name node-kind))])])
 
-(defn- track-cell [{:keys [span keys dense?]} frames]
+(defn- track-cell [{:keys [span keys dense? kind]} frames]
   [:div.tl-track
    ;; 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"))
+       [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost"))
               :style {:left (edge% in frames)
                       :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}}]))
    ;; A dense channel has a value on every frame, so ticking each one is a solid
@@ -235,7 +237,15 @@
           frame     @(rf/subscribe [::playback/frame])
           selection @(rf/subscribe [::sub/selection])
           expanded  @(rf/subscribe [::sub/expanded])
-          visible   (rows clip @(rf/subscribe [::render/open]) expanded)
+          drop      @(rf/subscribe [::sub/drop])
+          ;; Where a drag out of the pool would land, as a row of its own at the
+          ;; top: its own length, starting on the frame it would start on. The
+          ;; stage's drop shows it too, at the playhead.
+          visible   (cond->> (rows clip @(rf/subscribe [::render/open]) expanded)
+                      drop (cons {:path [::drop] :depth 0 :kind :ghost
+                                  :label (str "+ " (:label drop))
+                                  :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]
+                                  :keys []}))
           ;; Roughly ten labels, on a round number of frames.
           step      (* 10 (js/Math.ceil (/ frames 100)))]
       [:section.pane.time
@@ -248,10 +258,23 @@
          (doall (for [row visible]
                   ^{:key (str (:path row))} [label-cell row selection]))]
         [:div.tl-tracks
-         ;; Five frames as a percentage of the whole span, handed to the
+         {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
-         ;; stylesheet so the frame grid can be a repeating background instead of
+          :on-drag-over (fn [^js e]
-         ;; a div per frame. A 900-frame take is 900 elements nobody needs.
+                          (when (drag/accepts?)
-         {:style {"--tick" (str (* 100 (/ 5 frames)) "%")}}
+                            (.preventDefault e)
+                            (drag/hover! :timeline (frame-at e frames) nil)))
+          :on-drag-leave (fn [^js e]
+                           (when-not (.contains (.-currentTarget e) (.-relatedTarget e))
+                             (rf/dispatch [::ui/drop-clear])))
+          ;; In its own coordinates: dropped in time, nowhere in particular in
+          ;; space, so what was drawn at a place stays at that place.
+          :on-drop (fn [^js e]
+                     (.preventDefault e)
+                     (drag/land! (frame-at e frames) [0 0]))
+          ;; Five frames as a percentage of the whole span, handed to the
+          ;; stylesheet so the frame grid can be a repeating background instead
+          ;; of a div per frame. A 900-frame take is 900 elements nobody needs.
+          :style {"--tick" (str (* 100 (/ 5 frames)) "%")}}
          [:div.tl-ruler
           {:on-pointer-down (fn [^js e]
                               (rf/dispatch [::pb/seek (frame-at e frames)])

static/arthur/app.css

@@ -308,6 +308,8 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
   flex: 0 0 40px;
   width: 40px;
   height: 30px;
+  max-width: 40px;
+  max-height: 30px;
   object-fit: cover;
   background: var(--stage);
   border-radius: 2px;
@@ -430,6 +432,19 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
 .paint-overlay.drawing { cursor: crosshair; }
 .paint-overlay circle { cursor: grab; }
 
+/* Where a drag out of the pool would land. Dashed and unfilled, so it reads as
+   "not there yet" over whatever is already drawn. */
+/* Never a hit target: it is drawn under the pointer, and anything under the
+   pointer that changes mid-drag gets a dragenter of its own. */
+.paint-overlay .ghost { pointer-events: none; }
+.paint-overlay .ghost > * {
+  fill: none;
+  stroke: #fff1be;
+  stroke-width: 1;
+  stroke-dasharray: 3 2;
+  vector-effect: non-scaling-stroke;
+}
+
 /* --------------------------------------------------------------------------
    params */
 
@@ -582,6 +597,14 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
     -45deg, var(--span) 0 3px, #c3d4ea 3px 6px);
 }
 
+/* The preview row of a drop in flight: its own length, where it would start. */
+.tl-span.ghost, .tl-label.ghost { pointer-events: none; }
+.tl-span.ghost {
+  background: transparent;
+  border: 1px dashed var(--sel);
+}
+.tl-label.ghost { color: var(--sel); font-style: italic; }
+
 /* Flash's keyframe: a filled dot. */
 .tl-key {
   position: absolute;