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 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-06-30 10:33:21 -04:00
parent a99485ff48
commit baa46cb734

View file

@ -14,6 +14,7 @@
(defonce scroll-el (atom nil)) (defonce scroll-el (atom nil))
(defonce body-scroll-el (atom nil)) ; the vertical (tracks) scroll container (defonce body-scroll-el (atom nil)) ; the vertical (tracks) scroll container
(defonce playhead-el (atom nil)) ; the single full-height playhead overlay (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 play (atom nil)) ; {:ctx :segs :fps :idx} while playing, else nil
(defonce active-insert! (atom nil)) ; the live content-editor's (insert! link) fn (defonce active-insert! (atom nil)) ; the live content-editor's (insert! link) fn
(declare commit-link!) (declare commit-link!)
@ -179,6 +180,10 @@
(rf/reg-fx :player/pause (fn [_] (when-let [v @video-el] (.pause v)))) (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)))) (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! (defn- scroll-to-seg-track!
"Vertically scroll the tracks so the clip under local frame `local` is centred. "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 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"}))))) (.scrollIntoView row #js {:block "center" :behavior "smooth"})))))
(defn- goto! (defn- goto!
"Move the playhead to local frame `local` and seek the video to match. "Move the playhead to local frame `local` and seek the video to match. When
`follow?` recentres horizontally; `scroll-to?` also scrolls the tracks `follow?` (a jump/link, not a scrub), recentre horizontally AND scroll the
vertically to the clip under the landing frame (opt-in per annotation)." clip under the landing frame into view vertically — jumps always do both."
([local] (goto! local false false)) ([local] (goto! local false))
([local follow?] (goto! local follow? false)) ([local follow?]
([local follow? scroll-to?]
(let [ctx @(rf/subscribe [::subs/context]) (let [ctx @(rf/subscribe [::subs/context])
segs @(rf/subscribe [::subs/segments]) segs @(rf/subscribe [::subs/segments])
fps @(rf/subscribe [::subs/fps]) fps @(rf/subscribe [::subs/fps])
@ -209,7 +213,7 @@
(when @play (swap! play assoc :idx (seg-at segs local))) ; keep playback in sync (when @play (swap! play assoc :idx (seg-at segs local))) ; keep playback in sync
(when follow? (when follow?
(r/after-render #(do (follow! fps zoom local true) ; smooth on jump/link (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 [] (defn video-monitor []
[:video {:src @(rf/subscribe [::subs/clip-url]) :controls true :preload "auto" [:video {:src @(rf/subscribe [::subs/clip-url]) :controls true :preload "auto"
@ -304,6 +308,7 @@
thumbs @(rf/subscribe [::subs/thumbnails]) thumbs @(rf/subscribe [::subs/thumbnails])
playhead @(rf/subscribe [::subs/playhead]) playhead @(rf/subscribe [::subs/playhead])
playing? @(rf/subscribe [::subs/playing?]) playing? @(rf/subscribe [::subs/playing?])
active @(rf/subscribe [::subs/active-annotation])
authoring? (some? @(rf/subscribe [::subs/draft-group])) authoring? (some? @(rf/subscribe [::subs/draft-group]))
linking @(rf/subscribe [::subs/linking]) linking @(rf/subscribe [::subs/linking])
len @(rf/subscribe [::subs/length]) len @(rf/subscribe [::subs/length])
@ -311,7 +316,19 @@
lane-h (max 18 (* 18 (count anns))) lane-h (max 18 (* 18 (count anns)))
tracks-h (* row-h (count tracks)) tracks-h (* row-h (count tracks))
track-y (into {} (map-indexed (fn [i t] [(:id t) i]) 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)) (r/after-render #(position-playhead! fps zoom playhead))
[:div.timeline {:class (when-not @tracks-open? "tracks-collapsed")} [:div.timeline {:class (when-not @tracks-open? "tracks-collapsed")}
[:div.playhead.timeline-playhead {:ref (fn [n] (reset! playhead-el n))} [: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]) (scene/link-local @(rf/subscribe [::subs/scene]) @(rf/subscribe [::subs/context])
{:ref (keyword ref) :at (js/parseInt at 10)})) {:ref (keyword ref) :at (js/parseInt at 10)}))
(defn- ann-scroll-to? (defn- goto-link! [local]
"Does group `a` opt into vertical scroll-to-clip when navigated to?" (when local (goto! local true)))
[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 content-display (defn content-display
"Read-only render of annotation `content`: markdown blocks (headings, lists, "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})] (let [lf (scene/link-local scene ctx {:ref ref :at at})]
[:span.link-chip {:class (when-not lf "broken") [:span.link-chip {:class (when-not lf "broken")
:title (when-not lf "linked clip no longer in this timeline") :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-not lf "△ ") label
(when lf [:span.link-f (str " " (js/Math.round lf) "f")])]))))) (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-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")] :on-click (fn [e] (when-let [chip (.closest (.-target e) ".link-chip")]
(when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))] (when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))]
(goto-link! lf (ref-scroll-to? @(rf/subscribe [::subs/scene]) (goto-link! lf))))}]))
(.. chip -dataset -ref))))))}]))
(defn- point-candidates [scene ctx q timelines?] (defn- point-candidates [scene ctx q timelines?]
(let [needle (str/lower-case q) (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 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)." labelled with the clip + frame it lands on (as the annotation editor shows it)."
[open a scene segs] [open a scene segs]
(let [bars (:bars a) (let [bars (:bars a)]
scroll? (ref-scroll-to? scene (:id a))]
(if (< (count bars) 2) (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"}} [:span {:style {:position "relative"}}
[:button.jump-btn {:on-click #(swap! open (fn [x] (when (not= x (:id a)) (:id a))))} [:button.jump-btn {:on-click #(swap! open (fn [x] (when (not= x (:id a)) (:id a))))}
(str "↪ jump (" (count bars) ") ▾")] (str "↪ jump (" (count bars) ") ▾")]
@ -668,7 +675,7 @@
[:div.jump-pop [:div.jump-pop
(for [[i [lo _]] (map-indexed vector bars)] (for [[i [lo _]] (map-indexed vector bars)]
^{:key i} ^{: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))])])]))) (str "▸ " (clip-at scene segs lo))])])])))
(defn commentary [] (defn commentary []
@ -761,10 +768,10 @@
:on-change #(put (assoc d :name (.. % -target -value)))}] :on-change #(put (assoc d :name (.. % -target -value)))}]
[:input.form-color {:type "color" :value (:color d) [:input.form-color {:type "color" :value (:color d)
:on-change #(put (assoc d :color (.. % -target -value)))}]] :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])) [:input {:type "checkbox" :checked (boolean (get-in d [:meta :scroll-to]))
:on-change #(put (assoc-in d [:meta :scroll-to] (.. % -target -checked)))}] :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"] [:div.form-marks-label "Content"]
^{:key gid} [content-editor gid (:content orig)] ^{:key gid} [content-editor gid (:content orig)]
(if (and linking (= gid (:gid linking))) (if (and linking (= gid (:gid linking)))
@ -919,8 +926,7 @@
(let [[x0 y0 x1 y1] rect] (let [[x0 y0 x1 y1] rect]
[:div.script-hl {:title (:name a) :data-ann (name (:id a)) [:div.script-hl {:title (:name a) :data-ann (name (:id a))
:on-mouse-down #(.stopPropagation %) :on-mouse-down #(.stopPropagation %)
:on-click #(goto! (:start a) true ; jump the timeline to this annotation :on-click #(goto! (:start a) true) ; jump the timeline to this annotation
(ref-scroll-to? @(rf/subscribe [::subs/scene]) (:id a)))
:style {:left (* x0 w) :top (* y0 h) :style {:left (* x0 w) :top (* y0 h)
:width (* (- x1 x0) w) :height (* (- y1 y0) h) :width (* (- x1 x0) w) :height (* (- y1 y0) h)
:background (str (:color a) "44") :border (str "1.5px solid " (:color a))}}])) :background (str (:color a) "44") :border (str "1.5px solid " (:color a))}}]))