noe/tl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Show thumbnails in expanded timelines

Browse source
This commit is contained in:
Your Name 2026-06-29 03:36:07 -04:00
parent caa2aa6b9b
commit 1b0dd21fb1
4 changed files with 85 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

15
tl/resources/public/css/app.css
View file

@ -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;

25
tl/src/tl/scene.cljs
View file

@ -72,12 +72,14 @@
(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}]
(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))]))))
(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

45
tl/src/tl/views.cljs
View file

@ -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))))]
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 tiles i))]
url (:url (nth visible-tiles i))]
:when (pos? width)]
^{:key i}
[:div.clip-thumb
{:style {:left left
:width width
:background-image (str "url(" url ")")}}])))))
: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
(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))])))
(rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))])))))
(when @play (reset! raf (js/requestAnimationFrame play-tick)))))
(defn- engage-play!

6
tl/test/tl/scene_test.cljs
View file

@ -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"