From baa46cb73498b8516bce6d29fc1093a8593250c8 Mon Sep 17 00:00:00 2001 From: Your Name Date: Tue, 30 Jun 2026 10:33:21 -0400 Subject: [PATCH] feat: jumps always scroll to clip; scroll-to flag = clip-follow on playback Reframe the per-annotation :scroll-to flag. Jumps/links now ALWAYS scroll the target clip into view (unconditional, no flag). The flag instead drives normal playback: while the playhead plays through an annotation that opts in, each of its clips is scrolled into view as the playhead crosses onto that clip's track (deduped to fire only on track change; reset when playback stops). Form label updated to "Follow clips during playback". Co-Authored-By: Claude Opus 4.8 --- tl/src/tl/views.cljs | 64 ++++++++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 29 deletions(-) diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index b425c18..9704c44 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -14,6 +14,7 @@ (defonce scroll-el (atom nil)) (defonce body-scroll-el (atom nil)) ; the vertical (tracks) scroll container (defonce playhead-el (atom nil)) ; the single full-height playhead overlay +(defonce played-track (atom nil)) ; last track auto-scrolled into view during playback (defonce play (atom nil)) ; {:ctx :segs :fps :idx} while playing, else nil (defonce active-insert! (atom nil)) ; the live content-editor's (insert! link) fn (declare commit-link!) @@ -179,6 +180,10 @@ (rf/reg-fx :player/pause (fn [_] (when-let [v @video-el] (.pause v)))) (rf/reg-fx :player/seek (fn [secs] (when (and @video-el secs) (set! (.-currentTime @video-el) secs)))) +(defn- ann-scroll-to? + "Does annotation group `a` opt into vertical clip-following during playback?" + [a] (boolean (get-in a [:meta :scroll-to]))) + (defn- scroll-to-seg-track! "Vertically scroll the tracks so the clip under local frame `local` is centred. We scroll the clip's *gutter label* into view rather than the clip itself: the @@ -194,12 +199,11 @@ (.scrollIntoView row #js {:block "center" :behavior "smooth"}))))) (defn- goto! - "Move the playhead to local frame `local` and seek the video to match. - `follow?` recentres horizontally; `scroll-to?` also scrolls the tracks - vertically to the clip under the landing frame (opt-in per annotation)." - ([local] (goto! local false false)) - ([local follow?] (goto! local follow? false)) - ([local follow? scroll-to?] + "Move the playhead to local frame `local` and seek the video to match. When + `follow?` (a jump/link, not a scrub), recentre horizontally AND scroll the + clip under the landing frame into view vertically — jumps always do both." + ([local] (goto! local false)) + ([local follow?] (let [ctx @(rf/subscribe [::subs/context]) segs @(rf/subscribe [::subs/segments]) fps @(rf/subscribe [::subs/fps]) @@ -209,7 +213,7 @@ (when @play (swap! play assoc :idx (seg-at segs local))) ; keep playback in sync (when follow? (r/after-render #(do (follow! fps zoom local true) ; smooth on jump/link - (when scroll-to? (scroll-to-seg-track! segs local)))))))) + (scroll-to-seg-track! segs local))))))) (defn video-monitor [] [:video {:src @(rf/subscribe [::subs/clip-url]) :controls true :preload "auto" @@ -304,6 +308,7 @@ thumbs @(rf/subscribe [::subs/thumbnails]) playhead @(rf/subscribe [::subs/playhead]) playing? @(rf/subscribe [::subs/playing?]) + active @(rf/subscribe [::subs/active-annotation]) authoring? (some? @(rf/subscribe [::subs/draft-group])) linking @(rf/subscribe [::subs/linking]) len @(rf/subscribe [::subs/length]) @@ -311,7 +316,19 @@ lane-h (max 18 (* 18 (count anns))) tracks-h (* row-h (count tracks)) track-y (into {} (map-indexed (fn [i t] [(:id t) i]) tracks))] - (when playing? (r/after-render #(follow! fps zoom playhead))) + (if playing? + (r/after-render + (fn [] + (follow! fps zoom playhead) + ;; clip-following: while playing through an annotation that opts in + ;; (:meta :scroll-to), scroll each clip into view as the playhead + ;; crosses onto its track. Deduped so it only moves on track change. + (when (ann-scroll-to? (get-in scene [:groups active])) + (let [track (:track (nth segs (seg-at segs playhead) nil))] + (when (not= track @played-track) + (reset! played-track track) + (scroll-to-seg-track! segs playhead)))))) + (reset! played-track nil)) (r/after-render #(position-playhead! fps zoom playhead)) [:div.timeline {:class (when-not @tracks-open? "tracks-collapsed")} [:div.playhead.timeline-playhead {:ref (fn [n] (reset! playhead-el n))} @@ -391,16 +408,8 @@ (scene/link-local @(rf/subscribe [::subs/scene]) @(rf/subscribe [::subs/context]) {:ref (keyword ref) :at (js/parseInt at 10)})) -(defn- ann-scroll-to? - "Does group `a` opt into vertical scroll-to-clip when navigated to?" - [a] (boolean (get-in a [:meta :scroll-to]))) - -(defn- ref-scroll-to? [scene ref] - (ann-scroll-to? (get-in scene [:groups (keyword ref)]))) - -(defn- goto-link! - ([local] (goto-link! local false)) - ([local scroll-to?] (when local (goto! local true scroll-to?)))) +(defn- goto-link! [local] + (when local (goto! local true))) (defn content-display "Read-only render of annotation `content`: markdown blocks (headings, lists, @@ -417,7 +426,7 @@ (let [lf (scene/link-local scene ctx {:ref ref :at at})] [:span.link-chip {:class (when-not lf "broken") :title (when-not lf "linked clip no longer in this timeline") - :on-click #(goto-link! lf (ref-scroll-to? scene ref))} + :on-click #(goto-link! lf)} (when-not lf "△ ") label (when lf [:span.link-f (str " " (js/Math.round lf) "f")])]))))) @@ -490,8 +499,7 @@ :on-input emit :on-key-up save! :on-mouse-up save! :on-blur save! :on-click (fn [e] (when-let [chip (.closest (.-target e) ".link-chip")] (when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))] - (goto-link! lf (ref-scroll-to? @(rf/subscribe [::subs/scene]) - (.. chip -dataset -ref))))))}])) + (goto-link! lf))))}])) (defn- point-candidates [scene ctx q timelines?] (let [needle (str/lower-case q) @@ -657,10 +665,9 @@ than one bar) — a button that opens a popover of one target per piece, each labelled with the clip + frame it lands on (as the annotation editor shows it)." [open a scene segs] - (let [bars (:bars a) - scroll? (ref-scroll-to? scene (:id a))] + (let [bars (:bars a)] (if (< (count bars) 2) - [:button.jump-btn {:on-click #(goto! (:start a) true scroll?)} "↪ jump"] + [:button.jump-btn {:on-click #(goto! (:start a) true)} "↪ jump"] [:span {:style {:position "relative"}} [:button.jump-btn {:on-click #(swap! open (fn [x] (when (not= x (:id a)) (:id a))))} (str "↪ jump (" (count bars) ") ▾")] @@ -668,7 +675,7 @@ [:div.jump-pop (for [[i [lo _]] (map-indexed vector bars)] ^{:key i} - [:button {:on-click #(do (goto! lo true scroll?) (reset! open nil))} + [:button {:on-click #(do (goto! lo true) (reset! open nil))} (str "▸ " (clip-at scene segs lo))])])]))) (defn commentary [] @@ -761,10 +768,10 @@ :on-change #(put (assoc d :name (.. % -target -value)))}] [:input.form-color {:type "color" :value (:color d) :on-change #(put (assoc d :color (.. % -target -value)))}]] - [:label.form-check {:title "When you jump to this annotation, scroll the tracks to its clips"} + [:label.form-check {:title "During playback, scroll each of this annotation's clips into view as the playhead reaches it"} [:input {:type "checkbox" :checked (boolean (get-in d [:meta :scroll-to])) :on-change #(put (assoc-in d [:meta :scroll-to] (.. % -target -checked)))}] - [:span "Scroll to clips on jump"]]]) + [:span "Follow clips during playback"]]]) [:div.form-marks-label "Content"] ^{:key gid} [content-editor gid (:content orig)] (if (and linking (= gid (:gid linking))) @@ -919,8 +926,7 @@ (let [[x0 y0 x1 y1] rect] [:div.script-hl {:title (:name a) :data-ann (name (:id a)) :on-mouse-down #(.stopPropagation %) - :on-click #(goto! (:start a) true ; jump the timeline to this annotation - (ref-scroll-to? @(rf/subscribe [::subs/scene]) (:id a))) + :on-click #(goto! (:start a) true) ; jump the timeline to this annotation :style {:left (* x0 w) :top (* y0 h) :width (* (- x1 x0) w) :height (* (- y1 y0) h) :background (str (:color a) "44") :border (str "1.5px solid " (:color a))}}]))