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

feat: broken fixes lol

Browse source
This commit is contained in:
Your Name 2026-06-28 09:12:28 -04:00
parent ec236e93cb
commit 60d1a641ee
9 changed files with 412 additions and 121 deletions
Download patch file Download diff file Expand all files Collapse all files

9
tl/dev/media_server.py
View file

@ -20,15 +20,23 @@ import time
PORT = int(os.environ.get("MEDIA_PORT", "8281"))
ROOT = os.path.join(os.path.dirname(__file__), "..", "resources", "public")
MEDIA_CACHE_CONTROL = os.environ.get("MEDIA_CACHE_CONTROL", "public, max-age=604800")
MEDIA_EXTENSIONS = {".mp4", ".mov", ".m4v", ".webm"}
class RangeHandler(http.server.SimpleHTTPRequestHandler):
def __init__(self, *args, **kwargs):
super().__init__(*args, directory=os.path.abspath(ROOT), **kwargs)
def is_cacheable_media(self, path=None):
path = path or self.translate_path(self.path)
return os.path.splitext(path)[1].lower() in MEDIA_EXTENSIONS
def end_headers(self):
self.send_header("Access-Control-Allow-Origin", "*")
self.send_header("Accept-Ranges", "bytes")
if self.is_cacheable_media():
self.send_header("Cache-Control", MEDIA_CACHE_CONTROL)
super().end_headers()
def send_head(self):
@ -59,6 +67,7 @@ class RangeHandler(http.server.SimpleHTTPRequestHandler):
self.send_header("Content-Type", self.guess_type(path))
self.send_header("Content-Range", f"bytes {start}-{end}/{size}")
self.send_header("Content-Length", str(end - start + 1))
self.send_header("Last-Modified", self.date_time_string(os.fstat(f.fileno()).st_mtime))
self.end_headers()
f.seek(start)
self._range = (f, start, end) # consumed by copyfile override

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

@ -131,6 +131,11 @@ body { overflow: hidden; }
.row-x:hover { color: #e66; border-color: #a44; }
.add-mark { align-self: flex-start; color: #cfe3f5; border-color: #3a6ea5; }
/* the point a clip-click will fill — make it obvious where focus is */
.pt-input.active .pt-text, .pt-chip.active {
outline: 2px solid #5ab07a; outline-offset: 0;
}
/* point editor + autocomplete */
.pt-input { position: relative; flex: 1 1 130px; display: inline-block; }
.pt-text {

7
tl/shadow-cljs.edn
View file

@ -15,7 +15,12 @@
8290 "target/browser-test"}
:builds
{:app
{:test
{:target :node-test
:output-to "target/node-tests.js"
:ns-regexp "-test$"}
:app
{:target :browser
:output-dir "resources/public/js/compiled"
:asset-path "/js/compiled"

5
tl/src/tl/db.cljs
View file

@ -67,7 +67,10 @@
;; transient view state (mutates while scrubbing/zooming)
:view {:zoom 50 ; X zoom: pixels per SECOND (px/frame = zoom/fps)
:row-h 28 ; Y zoom: track row height in px
:playhead 0.0 ; frames (media/display coordinate)
;; playhead per timeline context (frames): keyed by the timeline-stack
;; top, so each (sub)timeline remembers where its playhead was. :root
;; is the main timeline.
:playheads {}
:playing? false
:selected-clip nil
;; resizable layout (relative): top region height as vh, video pane

70
tl/src/tl/events.cljs
View file

@ -3,6 +3,7 @@
[re-frame.core :as rf]
[tl.db :as db]
[tl.otio :as otio]
[tl.marks :as marks]
[tl.storage :as storage]
[ajax.core :as ajax]))
@ -47,10 +48,14 @@
;; The <video> element is the clock (direct 1:1): it pushes its currentTime
;; (as frames) into :playhead. See tl.views/video-monitor.
(defn- ctx-id [db] (or (last (get-in db [:marks :timeline-stack])) :root))
(rf/reg-event-db
::set-playhead
(fn [db [_ frames]]
(assoc-in db [:view :playhead] frames)))
;; the video clock writes into the current context's slot, so expanding /
;; collapsing doesn't clobber another timeline's remembered position
(assoc-in db [:view :playheads (ctx-id db)] frames)))
(rf/reg-event-db
::set-playing
@ -87,25 +92,65 @@
(update-in db [:draft :rows]
#(into (subvec % 0 i) (subvec % (inc i))))))
;; Which point a clicked clip fills. Set when a point input gains focus, kept
;; (not cleared on blur) so a subsequent clip click in the timeline lands here.
(rf/reg-event-db ::set-draft-active (fn [db [_ path]] (assoc-in db [:draft :active] path)))
;; Drop a clicked clip into the active point, then advance: start -> end of the
;; same row; end -> start of the next row (appended if needed). Lets you build a
;; range, or a run of ranges, by clicking clips left to right.
(rf/reg-event-db
::draft-fill-point
(fn [db [_ [_ i slot :as path] point]]
(let [db (assoc-in db (into [:draft] path) point)]
(if (= :a slot)
(assoc-in db [:draft :active] [:rows i :b])
(-> db
(update-in [:draft :rows]
(fn [rows] (cond-> rows
(not (get rows (inc i))) (conj {:a {:text ""} :b {:text ""}}))))
(assoc-in [:draft :active] [:rows (inc i) :a]))))))
;; --- nested timelines: expand an annotation / navigate back -------------
;; The timeline-stack is the breadcrumb trail. Expanding pushes an annotation
;; id; the top of the stack is the current context (see ::context-id).
(rf/reg-event-db
(defn- context-spans
"The current context's mark-group spans, or nil at the root / no timeline."
[db ctx]
(when (and (not= :root ctx) (get-in db [:marks :groups ctx]) (:timeline db))
(not-empty (marks/resolve-group (marks/clip-index (:timeline db))
(get-in db [:marks :groups]) ctx))))
(defn- seek-fx
"A :tl/seek effect for the db's current context: restore its remembered
playhead (defaulting to the first span's start) and hand the view its spans."
[db]
(let [ctx (ctx-id db)
spans (context-spans db ctx)
frame (get-in db [:view :playheads ctx] (or (:start (first spans)) 0))]
{:fps (get-in db [:timeline :fps]) :frame frame :spans spans}))
(rf/reg-event-fx
::expand-annotation
(fn [db [_ id]] (update-in db [:marks :timeline-stack] conj id)))
(fn [{:keys [db]} [_ id]]
(let [db (update-in db [:marks :timeline-stack] conj id)]
{:db db :tl/seek (seek-fx db)})))
(rf/reg-event-db
(rf/reg-event-fx
::collapse ; the back button: pop one level
(fn [db _] (update-in db [:marks :timeline-stack]
(fn [s] (if (> (count s) 1) (pop s) s)))))
(fn [{:keys [db]} _]
(let [db (update-in db [:marks :timeline-stack]
(fn [s] (if (> (count s) 1) (pop s) s)))]
{:db db :tl/seek (seek-fx db)})))
(rf/reg-event-db
(rf/reg-event-fx
::pop-to ; a breadcrumb: truncate to that id
(fn [db [_ id]]
(update-in db [:marks :timeline-stack]
(fn [s] (let [i (first (keep-indexed #(when (= id %2) %1) s))]
(if i (subvec s 0 (inc i)) s))))))
(fn [{:keys [db]} [_ id]]
(let [db (update-in db [:marks :timeline-stack]
(fn [s] (let [i (first (keep-indexed #(when (= id %2) %1) s))]
(if i (subvec s 0 (inc i)) s))))]
{:db db :tl/seek (seek-fx db)})))
;; --- authoring: create / delete annotations (persisted) -----------------
@ -145,4 +190,5 @@
(update-in [:marks :timeline-stack]
(fn [s] (let [s' (vec (take-while #(not (doomed %)) s))]
(if (seq s') s' [:root])))))]
{:db db' :tl/save (:marks db')})))
;; deleting may have popped the stack — restore the surviving context
{:db db' :tl/save (:marks db') :tl/seek (seek-fx db')})))

68
tl/src/tl/marks.cljs
View file

@ -87,3 +87,71 @@
"Earliest display frame across spans — the scroll/sort anchor. nil if empty."
[spans]
(when (seq spans) (reduce min (map :start spans))))
(defn- overlaps?
"Do inclusive frame ranges [a0 a1] and [b0 b1] touch or overlap?"
[a0 a1 b0 b1]
(and (<= a0 b1) (>= a1 b0)))
;; --- mark-group time <-> clip time ----------------------------------------
;; A timeline IS a mark-group: the root is the trivial one ([0 duration]); an
;; annotation is one nested inside it. Resolving a mark-group gives its spans, in
;; order — its local timeline is those spans laid end to end (gaps between them
;; do not exist locally). These pure fns are the whole translation between a
;; mark-group's local time and the underlying clip/media time, at any depth.
(defn group-length
"Total frames of a mark-group's local timeline."
[spans]
(reduce + 0 (map #(- (:end %) (:start %)) spans)))
(defn media->group
"Local frame for media frame `mf`, or nil when mf lies in a gap between spans."
[spans mf]
(loop [acc 0 [s & more] (seq spans)]
(when s
(if (<= (:start s) mf (:end s))
(+ acc (- mf (:start s)))
(recur (+ acc (- (:end s) (:start s))) more)))))
(defn group->media
"Media frame for local frame `lf` (clamped to the group's length)."
[spans lf]
(loop [acc 0 [s & more] (seq spans)]
(if s
(let [len (- (:end s) (:start s))]
(if (<= (max 0 lf) (+ acc len))
(+ (:start s) (- (max 0 lf) acc))
(recur (+ acc len) more)))
(:end (last spans)))))
(defn pieces
"Local [lo hi] sub-intervals of the media interval [a b], clipped to each span
— so an underlying clip is drawn only where the group covers it, and a span
that stops short of the clip yields a trimmed end."
[spans a b]
(loop [acc 0 [s & more] (seq spans) out []]
(if (nil? s)
out
(let [lo (max a (:start s)) hi (min b (:end s))]
(recur (+ acc (- (:end s) (:start s))) more
(cond-> out (< lo hi) (conj [(+ acc (- lo (:start s)))
(+ acc (- hi (:start s)))])))))))
(defn tracks-overlapping
"Set of track names of the video clips in clip-index `idx` whose media range
intersects ANY of `spans` — the union of the spans, not their bounding box.
A clip lying only in a gap between two separate spans is excluded (so two
marks A and C don't pull in a clip B sitting between them), while a single
range that genuinely covers A→C does include everything along the way."
[idx spans]
(->> (vals idx)
(filter (fn [{:keys [kind media-in duration]}]
;; a clip's last frame is media-in + duration - 1 (the next clip
;; starts at media-in + duration); using the exclusive end here
;; falsely picks up the clip that begins where a span ends.
(and (= :video kind)
(let [last-frame (+ media-in duration -1)]
(some #(overlaps? media-in last-frame (:start %) (:end %)) spans)))))
(map :track)
set))

70
tl/src/tl/subs.cljs
View file

@ -11,8 +11,9 @@
(rf/reg-sub ::tracks :<- [::timeline] (fn [t] (:tracks t)))
;; --- authoring draft -----------------------------------------------------
(rf/reg-sub ::draft (fn [db] (:draft db)))
(rf/reg-sub ::draft-at (fn [db [_ path]] (get-in db (into [:draft] path))))
(rf/reg-sub ::draft (fn [db] (:draft db)))
(rf/reg-sub ::draft-at (fn [db [_ path]] (get-in db (into [:draft] path))))
(rf/reg-sub ::draft-active (fn [db] (get-in db [:draft :active]))) ; point a clip click fills
;; --- mark-groups / annotations ------------------------------------------
(rf/reg-sub ::groups (fn [db] (get-in db [:marks :groups])))
@ -74,38 +75,43 @@
(fn [[groups stack] _]
(mapv (fn [gid] {:id gid :name (:name (groups gid) (name gid))}) stack)))
;; Crop: when expanded into an annotation, its own spans define the visible
;; window (time range) and the set of involved tracks. nil at the root.
;; The current context's spans (its local timeline, in order) — nil at the root.
;; This IS the mark-group being shown; the timeline lays these end to end.
(rf/reg-sub
::crop
::context-spans
:<- [::groups] :<- [::clip-index] :<- [::context-id]
(fn [[groups idx ctx] _]
(when (and idx (not= :root ctx) (groups ctx))
(let [spans (marks/resolve-group idx groups ctx)]
(when (seq spans)
{:window [(reduce min (map :start spans)) (reduce max (map :end spans))]
:tracks (set (keep :track spans))})))))
(not-empty (marks/resolve-group idx groups ctx)))))
;; Video tracks to render, filtered to the crop's involved tracks when expanded.
;; (Audio is never shown.) Returns {:track ... :visible? bool} so the timeline
;; can collapse — rather than drop — hidden rows and animate them out.
;; The spans the timeline renders against. The root is the trivial mark-group
;; [0 duration] (so media frames map to themselves); a nested annotation uses
;; its own spans, laid end to end (gaps between them simply don't exist locally).
(rf/reg-sub
::view-spans
:<- [::context-spans] :<- [::duration]
(fn [[spans dur] _] (or spans [{:start 0 :end (or dur 0)}])))
(rf/reg-sub ::view-frames :<- [::view-spans]
(fn [spans _] (marks/group-length spans))) ; local timeline length
;; Tracks whose clips actually fall inside the current mark-group (union of its
;; spans) — at the root, all of them. nil track-set => show everything.
(rf/reg-sub
::crop-tracks
:<- [::clip-index] :<- [::context-spans]
(fn [[idx spans] _]
(when (seq spans) (marks/tracks-overlapping idx spans))))
;; Video tracks to render, each flagged :visible? so the timeline can collapse —
;; rather than drop — the rows that aren't part of the current mark-group.
(rf/reg-sub
::visible-tracks
:<- [::tracks] :<- [::crop]
(fn [[tracks crop] _]
(let [tset (when (seq (:tracks crop)) (:tracks crop))]
(->> tracks
(filter #(= :video (:kind %)))
(mapv (fn [t] (assoc t :visible? (or (nil? tset) (contains? tset (:name t))))))))))
;; View transform applied to the timeline: a frame offset (so the crop window's
;; start sits at the left edge) and the visible span length in frames.
(rf/reg-sub
::view-offset :<- [::crop]
(fn [crop _] (if crop (first (:window crop)) 0)))
(rf/reg-sub
::view-frames :<- [::crop] :<- [::duration]
(fn [[crop dur] _] (if crop (- (second (:window crop)) (first (:window crop))) dur)))
:<- [::tracks] :<- [::crop-tracks]
(fn [[tracks tset] _]
(->> tracks
(filter #(= :video (:kind %)))
(mapv (fn [t] (assoc t :visible? (or (nil? tset) (contains? tset (:name t)))))))))
;; The annotation the playhead is currently "in" — the latest one whose anchor
;; we've reached. Drives the commentary scroll + highlight.
@ -119,7 +125,15 @@
;; --- view state (frames in; views multiply by zoom for pixels) ---
(rf/reg-sub ::zoom (fn [db] (get-in db [:view :zoom]))) ; X: px per second
(rf/reg-sub ::row-h (fn [db] (get-in db [:view :row-h]))) ; Y: track row height px
(rf/reg-sub ::playhead (fn [db] (get-in db [:view :playhead]))) ; frames
;; Playhead — a MEDIA frame (the video clock) for the current context. A context
;; with no remembered position defaults to the start of its first span, so a
;; freshly-expanded mark-group begins at its own beginning.
(rf/reg-sub ::playheads (fn [db] (get-in db [:view :playheads])))
(rf/reg-sub
::playhead
:<- [::playheads] :<- [::context-id] :<- [::view-spans]
(fn [[phs ctx spans] _] (get phs ctx (or (:start (first spans)) 0))))
(rf/reg-sub ::playing? (fn [db] (get-in db [:view :playing?])))
(rf/reg-sub ::top-h (fn [db] (get-in db [:view :top-h]))) ; layout: top region height
(rf/reg-sub ::video-w (fn [db] (get-in db [:view :video-w]))) ; layout: video pane width

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

@ -18,6 +18,10 @@
(defonce video-el (atom nil))
(defonce scroll-el (atom nil))
(defonce following? (atom true))
;; The current mark-group's spans (its local timeline), or nil at the root. Read
;; by the clock + frame-step from those non-reactive call sites without
;; subscribing; kept current by the timeline render and the :tl/seek fx.
(defonce play-spans (atom nil))
(defn- secs [frames fps] (/ frames fps))
@ -29,12 +33,17 @@
sec (js/Math.floor (mod s 60))]
(str m ":" (when (< sec 10) "0") sec)))
(defn- local-x
"Pixel x for a media frame in the current mark-group's local timeline."
[spans fps zoom mf]
(* (secs (or (marks/media->group spans mf) 0) fps) zoom))
(defn- center-on-playhead!
"Scroll the timeline so `playhead` sits at the horizontal centre. `off` is the
crop offset in frames (0 at the root; the window start when expanded)."
[fps zoom off playhead]
"Scroll the timeline so `playhead` (a media frame) sits at the horizontal
centre, in the current mark-group's local coordinates."
[fps zoom spans playhead]
(when-let [el @scroll-el]
(let [px (* (secs (- playhead off) fps) zoom)
(let [px (local-x spans fps zoom playhead)
max-sl (max 0 (- (.-scrollWidth el) (.-clientWidth el)))
target (-> (- px (/ (.-clientWidth el) 2)) (max 0) (min max-sl))]
(set! (.-scrollLeft el) target))))
@ -44,16 +53,24 @@
;; write :playhead directly — we just move the video and let it report back.
(defn- seek-to-frame! [fps frames]
(when-let [v @video-el]
(set! (.-currentTime v) (secs frames fps))))
(set! (.-currentTime v) (secs (max 0 frames) fps))))
(defn- jump! [fps frame] (seek-to-frame! fps frame))
;; A navigation event (expand/collapse/pop/delete) computes — from its new db —
;; the destination context's remembered playhead and crop window, and hands them
;; here to restore that (sub)timeline's position and confine playback to it.
(rf/reg-fx :tl/seek
(fn [{:keys [fps frame spans]}]
(reset! play-spans spans) ; nil at the root
(when fps (seek-to-frame! fps frame))))
(defn- jump-and-scroll!
"Jump (seek video + move playhead) AND scroll the timeline to center the frame."
[fps frame]
(jump! fps frame)
(center-on-playhead! fps (or @(rf/subscribe [::subs/zoom]) 50)
(or @(rf/subscribe [::subs/view-offset]) 0) frame))
@(rf/subscribe [::subs/view-spans]) frame))
;; --- authoring draft (in app-db at :draft; nil = closed) -----------------
;; A point is {:text "..."} (a typed frame) or {:clip <id> :setup <s> :occ <n>
@ -61,17 +78,20 @@
;; instant, b filled => a range.
(defn- blank-row [] {:a {:text ""} :b {:text ""}})
(defn- blank-draft [] {:name "" :content "" :color "#4e8fc2" :rows [(blank-row)]})
(defn- blank-draft []
{:name "" :content "" :color "#4e8fc2" :rows [(blank-row)] :active [:rows 0 :a]})
(defn- insert-clip!
"Clicking a clip while authoring appends a whole-clip range row (clip[0]→clip[-1])."
"Clicking a clip while authoring drops it into the active point: a start point
takes the clip's first frame (0), an end point its last frame (-1). The active
point then advances (see ::draft-fill-point)."
[clip-id]
(let [{:keys [setup occ]} (some #(when (= clip-id (:clip-id %)) %)
@(rf/subscribe [::subs/clip-catalog]))]
(when setup
(rf/dispatch [::events/draft-conj-row
{:a {:clip clip-id :setup setup :occ occ :frame 0}
:b {:clip clip-id :setup setup :occ occ :frame -1}}]))))
(when-let [{:keys [setup occ]} (some #(when (= clip-id (:clip-id %)) %)
@(rf/subscribe [::subs/clip-catalog]))]
(let [path (or @(rf/subscribe [::subs/draft-active]) [:rows 0 :a])
end? (= :b (last path))]
(rf/dispatch [::events/draft-fill-point path
{:clip clip-id :setup setup :occ occ :frame (if end? -1 0)}]))))
;; reverse of the form's row->mark: turn stored marks back into editor rows
(defn- clip-point [cat clip frame]
@ -95,7 +115,7 @@
(defn- edit-draft [cat id {:keys [name content color marks]}]
{:id id :name name :content (or content "") :color (or color "#4e8fc2")
:rows (mapv #(mark->row cat %) marks)})
:rows (mapv #(mark->row cat %) marks) :active [:rows 0 :a]})
;; forward: editor row -> a mark (for save + the live timeline preview)
(defn- point->mp
@ -122,8 +142,10 @@
[fps dir]
(when-let [v @video-el]
(when-not (.-paused v) (.pause v))
(let [frame (js/Math.round (* (.-currentTime v) fps))]
(set! (.-currentTime v) (secs (max 0 (+ frame dir)) fps)))))
(let [spans (or (seq @play-spans) [{:start 0 :end js/Infinity}])
local (or (marks/media->group spans (* (.-currentTime v) fps)) 0)]
;; step in local time, then translate back to the underlying media frame
(set! (.-currentTime v) (secs (marks/group->media spans (+ (js/Math.round local) dir)) fps)))))
(defn- editable-target?
"True for fields where Space should type a space, not toggle play."
@ -167,8 +189,21 @@
capture! (fn [n] (when n (reset! video-el n))) ; stable id; ignore React's nils
tick (fn tick []
(when-let [v @video-el]
(let [t (.-currentTime v)]
(when (not= t @seen) ; skip churn while paused/idle
;; The video is the frame source for the local timeline. With
;; one <video> and non-contiguous media, playing off the end
;; of a span means we must jump to the next span's media (or
;; stop at the end) — translation is pure (media->group); this
;; only acts at a span boundary, so within a span the video
;; just plays.
(when-let [spans (seq @play-spans)]
(let [mf (* (.-currentTime v) fps)]
(when-not (marks/media->group spans mf)
(if-let [nxt (seq (filter #(> % mf) (map :start spans)))]
(set! (.-currentTime v) (secs (reduce min nxt) fps))
(do (when-not (.-paused v) (.pause v))
(set! (.-currentTime v) (secs (reduce max (map :end spans)) fps)))))))
(let [t (.-currentTime v)] ; re-read (advanced/clamped above)
(when (not= t @seen) ; skip churn while paused/idle
(reset! seen t)
(rf/dispatch [::events/set-playhead (* t fps)]))))
(reset! raf (js/requestAnimationFrame tick)))]
@ -310,9 +345,10 @@
(defn annotation-lane
"The annotation rows above the tracks. Annotations are packed into shared rows
(see assign-lanes); each row holds every annotation assigned to that lane.
Bars are positioned in display frames relative to the crop offset `off`."
[fps zoom off placed active]
(see assign-lanes); each row holds every annotation in that lane. Bars are laid
out in the current mark-group's local coordinates (`vspans`) via marks/pieces,
so they line up with the clips below."
[fps zoom vspans placed active]
[:div
(doall
(for [[li items] (->> placed (group-by :lane) (into (sorted-map)))]
@ -321,65 +357,68 @@
(doall
(for [{:keys [id name spans preview?] c :color} items]
(let [color (or c "#4e8fc2")
on? (= id active)]
on? (= id active)
rects (mapcat #(marks/pieces vspans (:start %) (:end %)) spans)]
^{:key id}
[:<>
(doall
(for [[j s] (map-indexed vector spans)]
(let [left (* (secs (- (:start s) off) fps) zoom)
w (* (secs (- (:end s) (:start s)) fps) zoom)]
^{:key j}
[:div.ann-bar
{:title name
:style {:left left :width (max 3 w)
:background (cond preview? (str color "44") on? color :else (str color "80"))
:border (str (if preview? "1px dashed " "1px solid ") color)}}])))
(when-let [a (some-> spans first :start)]
[:div.ann-bar-label {:style {:left (+ 4 (* (secs (- a off) fps) zoom))}} name])])))]))])
(for [[j [lo hi]] (map-indexed vector rects)]
^{:key j}
[:div.ann-bar
{:title name
:style {:left (* (secs lo fps) zoom) :width (max 3 (* (secs (- hi lo) fps) zoom))
:background (cond preview? (str color "44") on? color :else (str color "80"))
:border (str (if preview? "1px dashed " "1px solid ") color)}}]))
(when-let [[lo _] (first rects)]
[:div.ann-bar-label {:style {:left (+ 4 (* (secs lo fps) zoom))}} name])])))]))])
(defn clip-block [fps zoom off row-h authoring? {:keys [id name media-in duration] :as _clip}]
(let [left (* (secs (- media-in off) fps) zoom)
width (max 1 (* (secs duration fps) zoom))]
[:div.clip {:style {:left left :width width :height (- row-h 2)
:line-height (str (- row-h 2) "px")}
;; while authoring, click a clip to drop it into the marks list
:class (when authoring? "clickable")
:on-mouse-down (when authoring?
(fn [e]
(.stopPropagation e) ; don't start a scrub
(insert-clip! (keyword id))))}
name]))
(defn clip-block
"An underlying clip drawn in local coordinates: one block per piece where the
current mark-group covers it (none if it falls entirely in a removed gap; a
trimmed width where a span stops short of the clip)."
[fps zoom vspans row-h authoring? {:keys [id name media-in duration]}]
(into [:<>]
(for [[i [lo hi]] (map-indexed vector (marks/pieces vspans media-in (+ media-in duration)))]
^{:key i}
[:div.clip {:style {:left (* (secs lo fps) zoom)
:width (max 1 (* (secs (- hi lo) fps) zoom))
:height (- row-h 2) :line-height (str (- row-h 2) "px")}
:class (when authoring? "clickable")
:on-mouse-down (when authoring?
(fn [e]
(.stopPropagation e) ; don't start a scrub
(.preventDefault e) ; keep the focused point input from blurring
(insert-clip! (keyword id))))}
name])))
(defn track-row
"A track lane. When cropped out of the current view it collapses to height 0
(CSS transitions the height) rather than vanishing, so tracks animate away."
[fps zoom off row-h authoring? track]
"A track lane. When it isn't part of the current mark-group it collapses to
height 0 (CSS transitions the height) rather than vanishing."
[fps zoom vspans row-h authoring? track]
(let [vis? (:visible? track true)]
[:div.track-row {:class (when-not vis? "collapsed")
:style {:height (if vis? row-h 0)}}
;; clips render even while collapsing (overflow:hidden clips them) so the
;; row's contents shrink away with it instead of blanking instantly
(for [c (:clips track)]
^{:key (:id c)} [clip-block fps zoom off row-h authoring? c])]))
^{:key (:id c)} [clip-block fps zoom vspans row-h authoring? c])]))
(defn- ev->frames
"Pointer clientX -> clamped timeline frame, relative to the content div
(whose bounding rect already accounts for horizontal scroll). `off`/`end`
are the visible window bounds in frames."
[content clientX zoom fps off end]
(let [px (- clientX (.-left (.getBoundingClientRect content)))
frames (+ off (* (/ px zoom) fps))]
(-> frames (max off) (min end))))
"Pointer clientX -> a media frame: read the local frame under the cursor (the
content rect already accounts for scroll) and translate back through the
current mark-group."
[content clientX zoom fps vspans]
(let [px (- clientX (.-left (.getBoundingClientRect content)))
local (max 0 (* (/ px zoom) fps))]
(marks/group->media vspans local)))
(defn- begin-scrub!
"mousedown on the timeline: seek to the click, then follow the mouse (even
outside the element) until mouseup."
[content zoom fps off end ev]
[content zoom fps vspans ev]
(.preventDefault ev)
(let [to (fn [clientX]
;; just seek; the video clock reports back into :playhead (rAF),
;; so the red line and the picture can never disagree
(seek-to-frame! fps (ev->frames content clientX zoom fps off end)))
(seek-to-frame! fps (ev->frames content clientX zoom fps vspans)))
move (fn [e] (to (.-clientX e)))
up (fn up [_]
(.removeEventListener js/document "mousemove" move)
@ -394,8 +433,7 @@
(let [fps @(rf/subscribe [::subs/fps])
zoom @(rf/subscribe [::subs/zoom])
row-h @(rf/subscribe [::subs/row-h])
off @(rf/subscribe [::subs/view-offset])
vframes @(rf/subscribe [::subs/view-frames])
vspans @(rf/subscribe [::subs/view-spans]) ; current mark-group's local timeline
playhead @(rf/subscribe [::subs/playhead])
playing? @(rf/subscribe [::subs/playing?])
anns @(rf/subscribe [::subs/annotations])
@ -423,10 +461,11 @@
(filterv (comp seq :spans)))) ; need a footprint to pack
placed (assign-lanes lane-anns)
lane-h (* 18 (lane-count placed))
end (+ off vframes)
width (* (secs vframes fps) zoom)]
width (* (secs (marks/group-length vspans) fps) zoom)]
;; keep the clock's playback clamp in sync with the visible mark-group
(reset! play-spans @(rf/subscribe [::subs/context-spans]))
(when (and playing? @following?)
(r/after-render #(center-on-playhead! fps zoom off playhead)))
(r/after-render #(center-on-playhead! fps zoom vspans playhead)))
[:div.timeline
;; fixed left gutter: setup (track) names, in lockstep with the rows
;; (collapsed tracks shrink here too so labels stay aligned)
@ -442,14 +481,14 @@
[:div.hscroll {:ref (fn [n] (reset! scroll-el n))
:on-wheel (fn [_] (reset! following? false))}
[:div.content {:ref (fn [n] (reset! content n))
:on-mouse-down (fn [e] (begin-scrub! @content zoom fps off end e))
:on-mouse-down (fn [e] (begin-scrub! @content zoom fps vspans e))
:style {:width width}}
(let [x (* (secs (- playhead off) fps) zoom)]
(let [x (local-x vspans fps zoom playhead)]
[:div.playhead {:style {:left x}}
[:div.playhead-handle]])
[annotation-lane fps zoom off placed active]
[annotation-lane fps zoom vspans placed active]
(for [t vtracks]
^{:key (:id t)} [track-row fps zoom off row-h (some? d) t])]]]))))
^{:key (:id t)} [track-row fps zoom vspans row-h (some? d) t])]]]))))
;; --- zoom + layout shell --------------------------------------------------
@ -462,14 +501,15 @@
"Set X zoom while keeping the playhead pinned to its on-screen position
(Resolve-style: zoom around the playhead, not the left edge)."
[z1]
(let [el @scroll-el
fps @(rf/subscribe [::subs/fps])
ph @(rf/subscribe [::subs/playhead])
off (or @(rf/subscribe [::subs/view-offset]) 0)
z0 @(rf/subscribe [::subs/zoom])]
(let [el @scroll-el
fps @(rf/subscribe [::subs/fps])
ph @(rf/subscribe [::subs/playhead])
spans @(rf/subscribe [::subs/view-spans])
z0 @(rf/subscribe [::subs/zoom])]
(rf/dispatch [::events/set-zoom z1])
(when el
(let [target (max 0 (+ (.-scrollLeft el) (* (secs (- ph off) fps) (- z1 z0))))]
(let [lf (or (marks/media->group spans ph) 0)
target (max 0 (+ (.-scrollLeft el) (* (secs lf fps) (- z1 z0))))]
(r/after-render #(set! (.-scrollLeft el) target))))))
(defn breadcrumbs
@ -551,13 +591,16 @@
(fn [path placeholder]
(let [p (or @(rf/subscribe [::subs/draft-at path]) {})
fps (or @(rf/subscribe [::subs/fps]) (/ 24000 1001))
active? (= path @(rf/subscribe [::subs/draft-active]))
activate! #(rf/dispatch [::events/set-draft-active path])
set-point! (fn [v] (rf/dispatch [::events/draft-set path v]))]
(if (:clip p)
(let [dur (some-> @(rf/subscribe [::subs/clip-index]) (get (:clip p)) :duration)]
[:span.pt-chip
[:span.pt-chip {:class (when active? "active")}
[:span.pt-chip-name (str (:setup p) " [" (:occ p) "]")]
[:input.pt-frame {:type "number" :value (:frame p)
:title "frame within clip (-1 = last)"
:on-focus activate!
:on-change #(rf/dispatch [::events/draft-set (conj path :frame)
(js/parseInt (.. % -target -value))])}]
(when dur [:span.pt-dur (str "/" dur)])
@ -571,9 +614,10 @@
:frame {:text (str (:frame s))}
:clip {:clip (:clip-id s) :setup (:setup s)
:occ (:occ s) :frame 0}))))]
[:span.pt-input
[:span.pt-input {:class (when active? "active")}
[:input.pt-text
{:value text :placeholder placeholder
:on-focus activate!
:on-change #(do (set-point! {:text (.. % -target -value)}) (reset! hi 0))
:on-key-down (fn [e]
(case (.-key e)
@ -632,7 +676,8 @@
[:div.form-marks-label "Marks"]
(doall (for [i (range (count (:rows d)))] ^{:key i} [mark-row i]))
[:button.add-mark {:on-click #(rf/dispatch [::events/draft-conj-row (blank-row)])} "＋ add mark"]
[:div.form-hint "Tip: click a clip in the timeline to drop it in as a whole-clip range."]
[:div.form-hint "Tip: focus the start or end field, then click clips in the timeline — "
"start takes the clip's first frame, end its last. It auto-advances start→end."]
[:div.form-actions
[:button.save {:on-click #(save-draft! d)} "Save"]
[:button.cancel {:on-click #(rf/dispatch [::events/close-draft])} "Cancel"]]]))

96
tl/test/tl/marks_test.cljs Normal file
View file

@ -0,0 +1,96 @@
(ns tl.marks-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.marks :as marks]))
;; A tiny clip catalog laid out on the media axis (the shared timeline):
;; A 100–149 (track "A") B 150–199 (track "B") C 200–249 (track "C")
;; A and C are separated by B. Each entry mirrors tl.otio/parse output
;; (clip-index values carry :track + :kind alongside :media-in/:duration).
(def idx
{:a {:media-in 100 :duration 50 :track "A" :kind :video}
:b {:media-in 150 :duration 50 :track "B" :kind :video}
:c {:media-in 200 :duration 50 :track "C" :kind :video}
:sfx {:media-in 100 :duration 150 :track "SFX" :kind :audio}})
(defn span [s e] {:start s :end e})
(deftest tracks-overlapping-single-range
(testing "a single A→C range covers everything in between, incl. B"
(is (= #{"A" "B" "C"}
(marks/tracks-overlapping idx [(span 100 249)])))))
(deftest tracks-overlapping-separate-marks
(testing "two separate marks (A and C) skip a clip B sitting only in the gap"
(is (= #{"A" "C"}
(marks/tracks-overlapping idx [(span 100 149) (span 200 249)]))))
(testing "the gap clip B is genuinely excluded (regression: bounding-box bug)"
(is (not (contains? (marks/tracks-overlapping idx [(span 100 149) (span 200 249)])
"B")))))
(deftest tracks-overlapping-single-clip
(testing "one whole-clip span yields just that track"
(is (= #{"B"} (marks/tracks-overlapping idx [(span 150 199)])))))
(deftest tracks-overlapping-touching-boundary
(testing "a span touching a clip's edge frame counts as overlapping"
(is (= #{"A" "B"} (marks/tracks-overlapping idx [(span 100 150)])))))
(deftest tracks-overlapping-excludes-audio
(testing "audio tracks are never returned"
(is (not (contains? (marks/tracks-overlapping idx [(span 100 249)]) "SFX")))))
;; --- resolve-marks: the span coordinates the crop is built from -----------
(deftest range-mark-spans-the-two-points
(testing "a [A-start A-end] range resolves to one span over A's frames"
(let [spans (marks/resolve-marks idx {} #{} [[[:at :a 0] [:at :a -1]]])]
(is (= 1 (count spans)))
(is (= 100 (:start (first spans))))
(is (= 149 (:end (first spans))))))) ; media-in + (duration-1)
(deftest two-separate-marks-resolve-to-two-spans
(testing "marks A and C resolve to two disjoint spans (no B coverage)"
(let [spans (marks/resolve-marks idx {} #{}
[[[:at :a 0] [:at :a -1]]
[[:at :c 0] [:at :c -1]]])]
(is (= [[100 149] [200 249]]
(map (juxt :start :end) spans)))
;; and the union of those spans must not pull in B's track
(is (= #{"A" "C"} (marks/tracks-overlapping idx spans))))))
;; --- mark-group <-> clip time: the gapless local timeline -----------------
;; A mark-group of [clip-A] then [clip-C], A=100–150 and C=200–250, with the
;; B gap (150–200) removed: a 100-frame local timeline laid end to end.
(def grp [{:start 100 :end 150} {:start 200 :end 250}])
(deftest group-length-sums-spans
(is (= 100 (marks/group-length grp))))
(deftest media->group-translates-and-drops-gaps
(testing "media frames map onto the gapless local axis"
(is (= 0 (marks/media->group grp 100)))
(is (= 50 (marks/media->group grp 150)))
(is (= 50 (marks/media->group grp 200))) ; C's start sits right after A
(is (= 75 (marks/media->group grp 225))))
(testing "a media frame in the removed gap has no local position"
(is (nil? (marks/media->group grp 175)))))
(deftest group->media-is-the-inverse
(is (= 100 (marks/group->media grp 0)))
(is (= 225 (marks/group->media grp 75)))
(testing "the seam never resolves into the removed gap (B's media, 150–200)"
(is (= 150 (marks/group->media grp 50))) ; A's end
(is (= 201 (marks/group->media grp 51)))) ; one frame into C, not B
(testing "past the end clamps to the last span's end"
(is (= 250 (marks/group->media grp 999)))))
(deftest pieces-lay-clips-end-to-end-and-trim
(testing "clips A and C render adjacent in local space; B (the gap) doesn't"
(is (= [[0 50]] (marks/pieces grp 100 150))) ; clip A
(is (= [] (marks/pieces grp 150 200))) ; clip B — in the gap
(is (= [[50 100]] (marks/pieces grp 200 250)))) ; clip C, right after A
(testing "a span trimming a clip short yields a trimmed end, not the full clip"
(let [trimmed [{:start 100 :end 130}]] ; only 30 frames of clip A
(is (= [[0 30]] (marks/pieces trimmed 100 150)))
(is (= 130 (marks/group->media trimmed 30))))))