diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index 351ba36..ef15297 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -250,8 +250,19 @@ body { overflow: hidden; } .gutter-label.collapsed { opacity: 0; border-bottom: none; padding: 0; } .clip { position: absolute; top: 1px; box-sizing: border-box; overflow: hidden; - background: #3a6ea5; border: 1px solid #16324f; border-radius: 2px; - font-size: 10px; color: #cfe3f5; white-space: nowrap; padding-left: 3px; + background: #244966; border: 1px solid #16324f; border-radius: 2px; + font-size: 10px; color: #cfe3f5; white-space: nowrap; +} +.clip-thumb { + position: absolute; top: 0; bottom: 0; + background-size: cover; background-position: center; + opacity: .82; +} +.clip-name { + position: relative; z-index: 1; height: 100%; box-sizing: border-box; + padding: 0 4px; overflow: hidden; text-overflow: ellipsis; + text-shadow: 0 1px 2px #000, 0 0 4px #000; + background: linear-gradient(90deg, rgba(0,0,0,.55), rgba(0,0,0,.12)); } .playhead { position: absolute; top: 0; bottom: 0; width: 2px; background: #e33; diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 0a7842a..ce5cb37 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -72,13 +72,15 @@ (defn slice "Sub-segments of `segs` covering local range [la lb), src + local re-cut." [segs la lb] - (vec (keep (fn [{:keys [src local] :as seg}] - (let [[a _] src [c d] local - lo (max la c) hi (min lb d)] - (when (< lo hi) - (assoc seg :local [lo hi] - :src [(+ a (- lo c)) (+ a (- hi c))])))) - segs))) + (vec + (keep (fn [{:keys [src local] :as seg}] + (let [[a _] src [c d] local + lo (max la c) hi (min lb d)] + (when (< lo hi) + (cond-> (assoc seg :local [lo hi] + :src [(+ a (- lo c)) (+ a (- hi c))]) + (:thumb-start seg) (update :thumb-start + (- lo c)))))) + segs))) (defn tracks [segs] (into #{} (keep :track segs))) @@ -98,7 +100,9 @@ (when (seq segs) {:xs (-> segs first :src first) :xe (-> segs last :src second) - :track (-> segs first :track)}))) + :track (-> segs first :track) + :thumb (-> segs first :thumb) + :thumb-start (-> segs first :thumb-start)}))) (defn- point-frame "Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref @@ -111,10 +115,12 @@ :track nil}) (map? point) - (when-let [{:keys [xs xe track]} (target-range scene (:ref point))] + (when-let [{:keys [xs xe track thumb thumb-start]} (target-range scene (:ref point))] (let [n (:at point) f (if (neg? n) (+ xe n 1) (+ xs n))] - (when (<= xs f xe) {:frame f :track track}))))) ; nil if trimmed out of range + (when (<= xs f xe) + (cond-> {:frame f :track track} + thumb (assoc :thumb thumb :thumb-at (+ (or thumb-start 0) (- f xs))))))))) ; nil if trimmed out of range (defn resolve-mark "One mark → its segment(s) (1 for a ref mark, 1+ for an absolute mark), with @@ -125,7 +131,8 @@ b (point-frame scene gid end)] (when (and a b) (let [s (:frame a) e (:frame b)] - [{:mark id :track (:track a) :src [s e] :local [0 (- e s)]}]))) + [{:mark id :track (:track a) :src [s e] :local [0 (- e s)] + :thumb (:thumb a) :thumb-start (:thumb-at a)}]))) (let [parent (:parent (grp scene gid))] (if parent ; absolute, relative to parent (let [sub (slice (resolve scene parent) start end) @@ -133,7 +140,9 @@ (mapv (fn [s] (let [[c d] (:local s)] (assoc s :mark id :local [(- c base) (- d base)]))) sub)) - [{:mark id :track track :src [start end] :local [0 (- end start)]}])))) + [{:mark id :track track :src [start end] :local [0 (- end start)] + :thumb (when (= :clip (:type (grp scene gid))) gid) + :thumb-start 0}])))) (defn resolve "A mark-group → its local timeline: ordered segments laid end to end. Broken diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index f6b50e2..de46fa0 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -12,24 +12,35 @@ (defonce scroll-el (atom nil)) (defonce play (atom nil)) ; {:ctx :segs :fps :idx} while playing, else nil +(def ^:private seek-guard-frames 0.75) +(def ^:private seek-settle-frames 2) + (defn- px [local fps zoom] (* (/ local fps) zoom)) -(defn- clip-thumbnail-layer [thumbs fps zoom row-h {:keys [mark]}] - (when-let [tiles (seq (get-in thumbs [:clips mark]))] - (let [clip-w (px (-> tiles last :end) fps zoom) +(defn- clip-thumbnail-layer [thumbs fps zoom row-h {:keys [mark thumb thumb-start local]}] + (when-let [tiles (seq (get-in thumbs [:clips (or thumb mark)]))] + (let [[c d] local + offset (or thumb-start 0) + visible-end (+ offset (- d c)) + visible-tiles (seq (filter (fn [{:keys [start end]}] + (and (< start visible-end) (> end offset))) + tiles)) + clip-w (px (- d c) fps zoom) tile-w (max 1 (* (- row-h 2) (/ 16 9))) - n (min (count tiles) (max 1 (js/Math.ceil (/ clip-w tile-w))))] - (into [:<>] - (for [i (range n) - :let [left (* i tile-w) - width (min tile-w (- clip-w left)) - url (:url (nth tiles i))] - :when (pos? width)] - ^{:key i} - [:div.clip-thumb - {:style {:left left - :width width - :background-image (str "url(" url ")")}}]))))) + n (when visible-tiles + (min (count visible-tiles) (max 1 (js/Math.ceil (/ clip-w tile-w)))))] + (when n + (into [:<>] + (for [i (range n) + :let [left (* i tile-w) + width (min tile-w (- clip-w left)) + url (:url (nth visible-tiles i))] + :when (pos? width)] + ^{:key i} + [:div.clip-thumb + {:style {:left left + :width width + :background-image (str "url(" url ")")}}])))))) ;; --- playback: the VIDEO is the clock ------------------------------------ ;; Play it; a rAF reads currentTime and maps it into the current context's local @@ -68,15 +79,27 @@ (when-let [{:keys [ctx segs fps idx]} @play] (let [v @video-el sf (* (.-currentTime v) fps) + {:keys [pending-ns]} @play {[ss se] :src [ls _] :local} (nth segs idx)] - (if (>= sf se) - (if-let [{[ns _] :src [nl _] :local} (get segs (inc idx))] - (do (swap! play assoc :idx (inc idx)) - (when (> (js/Math.abs (- sf ns)) 1.5) ; only seek at a real discontinuity - (seek-video! fps ns)) - (rf/dispatch [::events/set-playhead ctx nl])) - (.pause v)) ; end → pause event disengages - (rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))]))) + (cond + pending-ns + (when (< (js/Math.abs (- sf pending-ns)) seek-settle-frames) + (swap! play dissoc :pending-ns)) + + :else + (let [{[ns _] :src [nl _] :local :as next-seg} (get segs (inc idx)) + discontinuity? (and next-seg (> (js/Math.abs (- se ns)) 1.5)) + boundary (if discontinuity? (- se seek-guard-frames) se)] + (if (>= sf boundary) + (if next-seg + (do (swap! play (fn [p] + (cond-> (assoc p :idx (inc idx)) + discontinuity? (assoc :pending-ns ns)))) + (when discontinuity? + (seek-video! fps ns)) + (rf/dispatch [::events/set-playhead ctx nl])) + (.pause v)) ; end → pause event disengages + (rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))]))))) (when @play (reset! raf (js/requestAnimationFrame play-tick))))) (defn- engage-play! diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index 2b70d0b..f44cb99 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -63,6 +63,8 @@ (is (= [150 200] (:src (nth segs 0)))) (is (= 150 (s/local->source segs 0))) ; B's second half (is (= 0 (s/local->source segs 50))) ; boundary into A's first half + (is (= [:clip-b :clip-a :clip-b :clip-a] (map :thumb segs))) + (is (= [50 0 0 50] (map :thumb-start segs))) (is (= #{:t1 :t0} (s/tracks segs)))))) (deftest trim-no-clamp @@ -168,7 +170,9 @@ (testing "a local frame in Y (nested 2 deep) resolves down Y->X->clip to source" (let [segs (s/resolve x+y :ann-y)] (is (= 165 (s/local->source segs 5))) ; inside y0 -> B src 165 - (is (= 2 (s/local->source segs 12)))))) ; across the boundary -> A src 2 + (is (= 2 (s/local->source segs 12))) ; across the boundary -> A src 2 + (is (= [:clip-b :clip-a] (map :thumb segs))) + (is (= [60 0] (map :thumb-start segs)))))) (deftest seek-only-at-boundaries (testing "source advances 1:1 within a subclip and jumps only at a boundary"