From 7f3d903452b86ff68eeea3a3324415a866e2b9f3 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 2 Jul 2026 10:05:36 -0400 Subject: [PATCH] feat: allow drag reordering marks, allow reparenting, allow removing endpoints of mark --- tl/resources/public/css/app.css | 58 ++++++++++++-- tl/src/tl/events.cljs | 77 ++++++++++++++++-- tl/src/tl/subs.cljs | 1 + tl/src/tl/views.cljs | 136 ++++++++++++++++++++++++++------ 4 files changed, 238 insertions(+), 34 deletions(-) diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index 561be78..4c55d67 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -13,6 +13,7 @@ :root { --paper:#fff; --ink:#000; --gray:#808080; --mute:#555; --shade:#eee; --hover:#ddd; /* subtle fills (code/err bg, button hover) */ + --pick-a:#00d5ff; --pick-b:#ff2e9a; /* picker-mode + drop-target glow (cyan↔magenta) */ --chicago:"Chicago","ChicagoFLF","Charcoal","Geneva",system-ui,sans-serif; --geneva:"Geneva","Verdana","Tahoma","Segoe UI",sans-serif; --mono:"Monaco","Courier New",monospace; @@ -658,26 +659,69 @@ html.dark .timeline-head { .toolbar .dark-toggle { margin-left: auto; } .home-head-right { display: flex; align-items: center; gap: 8px; } -/* picker mode: pulse a black ring around everything pickable so it's obvious - what to click — a 1-bit "glow" (no blur, stays HyperCard). Clips + the frame - readout pulse whenever a draft is open; annotations pulse while linking. */ +/* picker mode: pulse a bright colored glow around everything pickable so it's + obvious what to click. Keeps a crisp ink ring for structure, but the glow + swells and shifts hue (cyan↔magenta) for life. Clips + the frame readout glow + whenever a draft is open; annotation bars glow while linking. */ @keyframes hc-pulse { - 0%, 100% { box-shadow: 0 0 0 1px var(--ink); } - 50% { box-shadow: 0 0 0 4px var(--ink); } + 0%,100% { box-shadow: 0 0 0 1px var(--ink), 0 0 6px 1px var(--pick-a); } + 50% { box-shadow: 0 0 0 3px var(--ink), 0 0 18px 5px var(--pick-b); } } .picking .clip.clickable, .picking .fr-clip.clickable, .linking .ann-bar { position: relative; z-index: 6; - animation: hc-pulse 0.9s ease-in-out infinite; + animation: hc-pulse 1.1s ease-in-out infinite; } .linking .ann-bar { cursor: pointer; } @media (prefers-reduced-motion: reduce) { .picking .clip.clickable, .picking .fr-clip.clickable, .linking .ann-bar { - animation: none; box-shadow: 0 0 0 3px var(--ink); + animation: none; box-shadow: 0 0 0 2px var(--ink), 0 0 10px 2px var(--pick-a); } } +/* --- drag an annotation to reparent it ---------------------------------- */ +/* Every valid drop target glows while a card is being dragged; the one under + the cursor fills. The dragged card itself dims. */ +@keyframes hc-drop { + 0%,100% { box-shadow: 0 0 0 1px var(--pick-a); } + 50% { box-shadow: 0 0 0 2px var(--pick-a), 0 0 12px 2px var(--pick-a); } +} +.ann[draggable="true"] { cursor: grab; } +.ann[draggable="true"]:active { cursor: grabbing; } +.ann.drop-ready { animation: hc-drop 1s ease-in-out infinite; } +.ann.drop-over { + animation: none; + background: color-mix(in srgb, var(--pick-a) 20%, var(--paper)); + box-shadow: 0 0 0 2px var(--pick-b), 0 0 16px 3px var(--pick-b); +} +.crumb.drop-ready { animation: hc-drop 1s ease-in-out infinite; } +.crumb.drop-over { + background: color-mix(in srgb, var(--pick-a) 28%, var(--paper)); + box-shadow: 0 0 0 2px var(--pick-b), 0 0 12px 2px var(--pick-b); +} +@media (prefers-reduced-motion: reduce) { + .ann.drop-ready, .crumb.drop-ready { animation: none; box-shadow: 0 0 0 2px var(--pick-a); } +} + +/* --- re-pick one mark endpoint / drag-reorder marks --------------------- */ +.pt-chip-x { + border: none; background: none; color: var(--mute); cursor: pointer; + font-size: 10px; padding: 0 2px; line-height: 1; flex: none; +} +.pt-chip-x:hover { color: var(--ink); } +.mark-grip { + cursor: grab; user-select: none; color: var(--mute); + padding: 0 2px; font-size: 13px; line-height: 1; flex: none; align-self: center; +} +.mark-grip:active { cursor: grabbing; } +.mark-block.dragging { opacity: 0.4; } +.mark-block.drop-before { position: relative; } +.mark-block.drop-before::before { + content: ""; position: absolute; left: 0; right: 0; top: -3px; height: 2px; + background: var(--pick-b); box-shadow: 0 0 6px 1px var(--pick-b); +} + /* iOS Safari zooms the page when focusing a control with font-size < 16px. On touch devices bump every form control to 16px so tapping never zooms. */ @media (pointer: coarse) { diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index ed45901..b52e238 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -606,6 +606,41 @@ id (assoc :http-xhrio (api/put-scene id {:deleted [gid]} {:on-success [::scene-saved] :on-failure [::save-error]})))))) +;; --- move an annotation into another context (drag-drop reparent) --------- +;; Changing :parent re-homes an annotation under a new context. Marks that no +;; longer resolve there just skip (scene/resolve drops them) and reappear if the +;; annotation is moved back — no data loss. Guard against cycles: never drop a +;; group into itself or one of its own descendants (that would make the :parent +;; chain loop forever, hanging path-to / resolve). +(defn- descendant? + "Is `gid` equal to `anc` or somewhere below it in the :parent tree?" + [scene anc gid] + (loop [g gid] + (cond (nil? g) false + (= g anc) true + :else (recur (get-in scene [:groups g :parent]))))) + +(rf/reg-event-db ::ann-drag-start (fn [db [_ gid]] (assoc-in db [:view :dragging-ann] gid))) +(rf/reg-event-db ::ann-drag-end (fn [db _] (assoc-in db [:view :dragging-ann] nil))) + +(rf/reg-event-fx + ::reparent + (fn [{:keys [db]} [_ gid new-parent]] + (let [scene (:scene db) + g (get-in scene [:groups gid])] + (if (or (not= :annotation (:type g)) ; only annotations move + (:draft g) ; not while being drafted/edited + (= (:parent g) new-parent) ; no-op: already there + (descendant? scene gid new-parent)) ; target inside gid → cycle + {:db (assoc-in db [:view :dragging-ann] nil)} + (let [id (get-in db [:project :id])] + (cond-> {:db (-> db (assoc-in [:scene :groups gid :parent] new-parent) + (assoc-in [:view :dragging-ann] nil) + (assoc :save-error nil))} + id (assoc :http-xhrio (api/put-scene id {:changed {gid {:parent new-parent}}} + {:on-success [::scene-saved] + :on-failure [::save-error]})))))))) + (rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil))) (rf/reg-event-db ::save-error (fn [db [_ failure]] @@ -615,6 +650,22 @@ ;; completes the span as a run of single-clip marks. `frame` (mark time) is ;; optional — clicking a clip uses whole-clip defaults (0 / clip end), clicking ;; the video frame-readout passes the exact frame under the playhead. +;; Unset one endpoint of an existing mark to re-pick it: seed the pending-point +;; state with the endpoint we're keeping, so the existing "one end set, click the +;; other" UI takes over. We stash the original mark (:mark) + its slot (:i) so the +;; rebuilt mark keeps its id — and thus its note/drawing bindings (see the repick +;; branch of ::draft-click-seg). selection->marks re-sorts by min/max, so it +;; doesn't matter that the kept end was the start or the end. +(rf/reg-event-db + ::unset-endpoint + (fn [db [_ gid i which]] + (let [marks (get-in db [:scene :groups gid :marks]) + mark (get marks i) + keep (if (= which :start) (:end mark) (:start mark))] + (-> db (assoc-in [:scene :groups gid :marks] + (into (subvec marks 0 i) (subvec marks (inc i)))) + (assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i i}))))) + (rf/reg-event-db ::draft-click-seg (fn [db [_ seg-id frame]] @@ -623,9 +674,25 @@ segs (scene/content-segments scene (:parent g)) pt (get-in db [:view :pt])] (if (map? pt) - (let [a (scene/seg-local segs (:seg pt) (:f pt)) - b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))) - run (scene/selection->marks scene (:parent g) (min a b) (max a b))] - (-> db (update-in [:scene :groups gid :marks] into run) - (assoc-in [:view :pt] :new))) + (let [a (scene/seg-local segs (:seg pt) (:f pt)) + b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))) + lo (min a b) hi (max a b) + old (:mark pt)] + (if old + ;; re-picking an endpoint: reconcile-run keeps the mark id for the + ;; piece on the kept clip; re-attach that mark's bindings, and splice + ;; the run back into its original slot so order is preserved. + (let [run (->> (scene/reconcile-run scene (:parent g) [old] lo hi) + (mapv (fn [m] (if (= (:id m) (:id old)) + (cond-> m + (:notes old) (assoc :notes (:notes old)) + (:drawings old) (assoc :drawings (:drawings old))) + m)))) + i (:i pt)] + (-> db (update-in [:scene :groups gid :marks] + #(into (into (subvec % 0 i) run) (subvec % i))) + (assoc-in [:view :pt] :new))) + (let [run (scene/selection->marks scene (:parent g) lo hi)] + (-> db (update-in [:scene :groups gid :marks] into run) + (assoc-in [:view :pt] :new))))) (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)}))))) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 708dd93..e3afa64 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -20,6 +20,7 @@ (rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{}))) (rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus]))) (rf/reg-sub ::linking (fn [db] (get-in db [:view :linking]))) +(rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann]))) (rf/reg-sub ::thumbnails (fn [db] (get-in db [:project :thumbnails]))) (rf/reg-sub ::thumbnail-status (fn [db] (get-in db [:project :thumbnail_status]))) (rf/reg-sub ::create-error (fn [db] (:create-error db))) diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index f2d1e7a..3dd23dd 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -912,27 +912,61 @@ ;; playhead crossing bars re-renders only the card(s) whose active state flipped — ;; not the entire commentary list (the old code derefed the active SET in the ;; parent, forcing a full-list reconcile on every crossing). +;; Is `t` among the drag's data types? `dataTransfer.types` is a plain JS array in +;; modern browsers (a DOMStringList in older ones) — Array.from normalises both so +;; the .includes never throws (a throw here would swallow the preventDefault the +;; drop depends on). +(defn- has-type? [e t] + (.includes (js/Array.from (.. e -dataTransfer -types)) t)) + +;; Drag-drop wiring shared by both card variants: an annotation is a drag source +;; (carries its gid) AND a drop target (drop another annotation onto it to make it +;; a child). `over?` is a local atom driving the drop-target highlight. +(defn- ann-drag-props [a authed? over?] + (when authed? + {:draggable true + :on-drag-start (fn [e] + (.. e -dataTransfer (setData "text/ann" (name (:id a)))) + (set! (.. e -dataTransfer -effectAllowed) "move") + (rf/dispatch [::events/ann-drag-start (:id a)])) + :on-drag-end (fn [_] (reset! over? false) (rf/dispatch [::events/ann-drag-end])) + :on-drag-over (fn [e] + (when (has-type? e "text/ann") + (.preventDefault e) (reset! over? true))) + :on-drag-leave (fn [_] (reset! over? false)) + :on-drop (fn [e] + (let [src (.. e -dataTransfer (getData "text/ann"))] + (when (seq src) + (.preventDefault e) (reset! over? false) + (rf/dispatch [::events/reparent (keyword src) (:id a)]))))})) + (defn- annotation-card [a scene ctx segs nmap authed? open] - (let [active? @(rf/subscribe [::subs/annotation-active? (:id a)])] + (r/with-let [over? (r/atom false) hov? (r/atom false)] + (let [active? @(rf/subscribe [::subs/annotation-active? (:id a)]) + dragging @(rf/subscribe [::subs/dragging-ann]) + drop-ok? (and dragging (not= dragging (:id a))) + drag-props (merge (ann-drag-props a authed? over?) + {:class (str (when active? "active ") + (when (and drop-ok? @over?) "drop-over ") + (when drop-ok? "drop-ready"))})] (if (:hidden a) - (r/with-let [hov? (r/atom false)] - [:div.ann {:id (str "ann-" (name (:id a))) - :class (when active? "active") + [:div.ann (merge drag-props + {:id (str "ann-" (name (:id a))) :style (merge {"--ann-color" (:color a)} {:opacity 0.4 :background "var(--desktop)" :background-size "2px 2px" :min-height "24px" :display "flex" :align-items "center" :justify-content "space-between" :padding "2px 6px"}) :on-mouse-enter #(reset! hov? true) - :on-mouse-leave #(reset! hov? false)} + :on-mouse-leave #(reset! hov? false)}) [:span.ann-title {:style {:font-size 10}} [:span.ann-swatch {:style {:background (:color a)}}] (:name a)] [:div {:style {:display "flex" :gap "2px" :visibility (if @hov? "visible" "hidden")}} [:button.expand-btn {:title "Expand" :on-click #(rf/dispatch [::events/expand (:id a)])} "⤢"] - [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-draft (:id a)])} "✎"]]]) - [:div.ann {:id (str "ann-" (name (:id a))) - :class (when active? "active") - :style {"--ann-color" (:color a)}} + [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-draft (:id a)])} "✎"]]] + [:div.ann (merge drag-props + {:id (str "ann-" (name (:id a))) + :style {"--ann-color" (:color a)}}) [:div.ann-head [:div.ann-title [:span.ann-swatch {:style {:background (:color a)}}] @@ -951,7 +985,7 @@ (when (seq (:notes a)) [:div.ann-notes (for [ng (:notes a) :let [n (nmap ng)] :when n] - ^{:key (name ng)} [note-live-chip ng n])])]))) + ^{:key (name ng)} [note-live-chip ng n])])])))) ;; Renders nothing: owns the active-annotation subscription and scrolls the active ;; card into view, so `commentary` itself no longer re-renders on every crossing. @@ -993,14 +1027,17 @@ (let [n (js/parseInt v 10)] (-> (if (js/isNaN n) 0 n) (max 0) (min len)))) (defn- frame-chip - "A filled endpoint: clip name + a mark-time frame input (edits `put` the group)." + "A filled endpoint: clip name + a mark-time frame input (edits `put` the group). + The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)." [scene segs put d i k {:keys [seg f]}] (let [len (scene/seg-length segs seg)] [:div.pt-chip [:span.pt-chip-name (clip-label scene segs seg)] [:input.pt-frame {:type "number" :min 0 :max len :value f :on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}] - [:span.pt-dur (str "/" len)]])) + [:span.pt-dur (str "/" len)] + [:button.pt-chip-x {:type "button" :title "Re-pick this end" + :on-click #(rf/dispatch [::events/unset-endpoint (:gid d) i k])} "✕"]])) ;; --- script-note bindings (annotation form) ------------------------------ ;; A note is bound by dragging its chip from the source list onto a drop target @@ -1036,6 +1073,31 @@ [:button.row-x {:type "button" :title "Unbind" :on-click #(on-unbind ng)} "✕"]]) [:span.note-drop-hint "drop a note"])]) +;; drag-to-reorder marks: one live drag at a time, so a single module atom holds +;; {:src i :over j}. Deref'd in the form so the drop line follows the cursor. +(defonce ^:private mark-drag (r/atom nil)) + +(defn- vec-move [v si di] + (if (= si di) v + (let [x (nth v si) + without (vec (concat (subvec v 0 si) (subvec v (inc si)))) + di* (if (< si di) (dec di) di)] + (vec (concat (subvec without 0 di*) [x] (subvec without di*)))))) + +;; DnD props for mark row `i`: a drag source (the ⠿ handle sets draggable) and a +;; drop target that moves the dragged mark to before this row on drop. +(defn- mark-drag-props [put d i] + {:on-drag-over (fn [e] + (when (:src @mark-drag) + (.preventDefault e) + (when (not= (:over @mark-drag) i) (swap! mark-drag assoc :over i)))) + :on-drop (fn [e] + (.preventDefault e) + (when-let [si (:src @mark-drag)] + (put (update d :marks vec-move si i))) + (reset! mark-drag nil)) + :on-drag-end (fn [_] (reset! mark-drag nil))}) + (defn annotation-form [] (r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid)] (let [d @(rf/subscribe [::subs/draft-group]) @@ -1093,10 +1155,19 @@ (doall (for [[i row] (map-indexed vector rows) :let [mark (get (:marks d) i) - mark-id (:id mark)]] + mark-id (:id mark) + drag @mark-drag]] ^{:key i} - [:div.mark-block + [:div.mark-block (merge (mark-drag-props put d i) + {:class (str (when (= i (:src drag)) "dragging ") + (when (and (:src drag) (= i (:over drag)) + (not= i (:src drag))) "drop-before"))}) [:div.mark-row + [:span.mark-grip {:draggable true :title "Drag to reorder" + :on-drag-start (fn [e] + (.. e -dataTransfer (setData "text/mark-idx" (str i))) + (set! (.. e -dataTransfer -effectAllowed) "move") + (reset! mark-drag {:src i}))} "⠿"] [frame-chip scene segs put d i :start (:s row)] [:span.mark-arrow "→"] [frame-chip scene segs put d i :end (:e row)] @@ -1153,18 +1224,39 @@ ;; --- chrome --------------------------------------------------------------- +;; A breadcrumb is a drop target too: drop an annotation onto an ancestor context +;; (root or any timeline on the path) to move it up out of the current level. +(defn- crumb-drop-props [id over?] + {:on-drag-over (fn [e] + (when (has-type? e "text/ann") + (.preventDefault e) (reset! over? true))) + :on-drag-leave (fn [_] (reset! over? false)) + :on-drop (fn [e] + (let [src (.. e -dataTransfer (getData "text/ann"))] + (when (seq src) + (.preventDefault e) (reset! over? false) + (rf/dispatch [::events/reparent (keyword src) id]))))}) + +(defn- crumb [i {:keys [id name]} last?] + (r/with-let [over? (r/atom false)] + (let [dragging @(rf/subscribe [::subs/dragging-ann])] + [:span.crumb-item + (when (pos? i) [:span.crumb-sep "›"]) + [:button.crumb (merge (crumb-drop-props id over?) + {:class (str (when last? "current ") + (when dragging "drop-ready ") + (when (and dragging @over?) "drop-over")) + :disabled (and last? (not dragging)) + :on-click #(rf/dispatch [::events/pop-to id])}) + name]]))) + (defn breadcrumbs [] (let [crumbs @(rf/subscribe [::subs/breadcrumbs])] (when (> (count crumbs) 1) [:div.crumbs [:button.back-btn {:on-click #(rf/dispatch [::events/collapse])} "← back"] - (for [[i {:keys [id name]}] (map-indexed vector crumbs)] - (let [last? (= i (dec (count crumbs)))] - ^{:key id} - [:span.crumb-item - (when (pos? i) [:span.crumb-sep "›"]) - [:button.crumb {:class (when last? "current") :disabled last? - :on-click #(rf/dispatch [::events/pop-to id])} name]]))]))) + (for [[i c] (map-indexed vector crumbs)] + ^{:key (:id c)} [crumb i c (= i (dec (count crumbs)))])]))) (defn toolbar [] ;; NB: subscribe the coarse ::at-start?/::at-end? edges, not the raw playhead — @@ -1669,7 +1761,7 @@ [login-form]])])) (defn create-page [] - (let [pname (r/atom "") otio (atom nil) clip (atom nil)] + (let [pname (r/atom "") otio (r/atom nil) clip (r/atom nil)] (fn [] (let [err @(rf/subscribe [::subs/create-error]) prog @(rf/subscribe [::subs/create-progress])