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

clearing everything starting again basically

Browse source
This commit is contained in:
Your Name 2026-06-28 14:02:11 -04:00
parent 60d1a641ee
commit ea181911cb
4 changed files with 61 additions and 355 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -71,7 +71,6 @@
;; 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
;; width as % of the top row. Pixel minimums enforced in CSS.

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

@ -3,7 +3,6 @@
[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]))
@ -44,24 +43,19 @@
(assoc-in [:load :status] :error)
(assoc-in [:load :error] err))))
;; --- playback ------------------------------------------------------------
;; The <video> element is the clock (direct 1:1): it pushes its currentTime
;; (as frames) into :playhead. See tl.views/video-monitor.
;; --- playhead cursor -----------------------------------------------------
;; The playhead is a per-context timeline cursor (a media frame), moved by
;; scrub/jump. (Playback was removed and is to be rebuilt.)
(defn- ctx-id [db] (or (last (get-in db [:marks :timeline-stack])) :root))
(rf/reg-event-db
::set-playhead
(fn [db [_ frames]]
;; the video clock writes into the current context's slot, so expanding /
;; collapsing doesn't clobber another timeline's remembered position
;; per-context slot, so expanding/collapsing doesn't clobber another
;; timeline's remembered cursor position
(assoc-in db [:view :playheads (ctx-id db)] frames)))
(rf/reg-event-db
::set-playing
(fn [db [_ playing?]]
(assoc-in db [:view :playing?] playing?)))
;; --- timeline zoom (x = px/second, y = track row height) ----------------
(rf/reg-event-db
@ -115,42 +109,21 @@
;; The timeline-stack is the breadcrumb trail. Expanding pushes an annotation
;; id; the top of the stack is the current context (see ::context-id).
(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
(rf/reg-event-db
::expand-annotation
(fn [{:keys [db]} [_ id]]
(let [db (update-in db [:marks :timeline-stack] conj id)]
{:db db :tl/seek (seek-fx db)})))
(fn [db [_ id]] (update-in db [:marks :timeline-stack] conj id)))
(rf/reg-event-fx
(rf/reg-event-db
::collapse ; the back button: pop one level
(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)})))
(fn [db _] (update-in db [:marks :timeline-stack]
(fn [s] (if (> (count s) 1) (pop s) s)))))
(rf/reg-event-fx
(rf/reg-event-db
::pop-to ; a breadcrumb: truncate to that id
(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)})))
(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))))))
;; --- authoring: create / delete annotations (persisted) -----------------
@ -190,5 +163,4 @@
(update-in [:marks :timeline-stack]
(fn [s] (let [s' (vec (take-while #(not (doomed %)) s))]
(if (seq s') s' [:root])))))]
;; deleting may have popped the stack — restore the surviving context
{:db db' :tl/save (:marks db') :tl/seek (seek-fx db')})))
{:db db' :tl/save (:marks db')})))

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

@ -134,6 +134,5 @@
::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

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

@ -15,13 +15,7 @@
(str (.. js/window -location -protocol) "//"
(.. js/window -location -hostname) ":8281/challengers_480p.mp4"))
(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))
@ -48,28 +42,12 @@
target (-> (- px (/ (.-clientWidth el) 2)) (max 0) (min max-sl))]
(set! (.-scrollLeft el) target))))
;; Moving the playhead = seeking the video. The video is the single clock
;; (video-monitor's rAF reads currentTime back into :playhead), so we never
;; 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 (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)
"Move the playhead cursor to media frame `frame` and scroll it into view."
[_fps frame]
(rf/dispatch [::events/set-playhead frame])
(center-on-playhead! (or @(rf/subscribe [::subs/fps]) (/ 24000 1001))
(or @(rf/subscribe [::subs/zoom]) 50)
@(rf/subscribe [::subs/view-spans]) frame))
;; --- authoring draft (in app-db at :draft; nil = closed) -----------------
@ -132,97 +110,16 @@
pa pa ; instant
:else nil)))
(defn- toggle-play! []
(when-let [v @video-el]
(if (.-paused v) (.play v) (.pause v)))) ; play/pause events drive :playing? + rAF
(defn- step-frame!
"Pause and nudge the playhead one frame in `dir` (-1 / +1). Seeking is the
only move — the rAF clock reports the new position back into :playhead."
[fps dir]
(when-let [v @video-el]
(when-not (.-paused v) (.pause v))
(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."
[el]
(let [tag (some-> el .-tagName)]
(or (= "TEXTAREA" tag)
(and (= "INPUT" tag)
(not (#{"range" "checkbox" "radio" "button"} (.-type el))))
(boolean (and el (.-isContentEditable el))))))
(defn- on-keydown [e]
;; Space = play/pause globally. preventDefault stops it from scrolling the
;; page or activating a focused button (and from the <video>'s own native
;; toggle, so we never double-fire). (Jump popovers are native — they
;; light-dismiss and Escape-close themselves.)
(when (and (= "Space" (.-code e))
(not (editable-target? (.-target e))))
(.preventDefault e)
(toggle-play!)))
;; Re-bind on every (re)load so the live handler is the one attached —
;; defonce alone would keep a stale listener across hot reloads.
(defonce ^:private kbd (atom nil))
(when-let [h @kbd] (.removeEventListener js/document "keydown" h))
(reset! kbd on-keydown)
(.addEventListener js/document "keydown" on-keydown)
(defn video-monitor
"Native-controls <video>, which is the single playback clock AND the single
seek target. One always-on requestAnimationFrame copies its currentTime (as
frames) into :playhead whenever it changes — covering playback, native-control
scrubbing, jumps and timeline scrubs alike, with no per-event bookkeeping.
The element is captured into `video-el` (shared with seek-to-frame!) by a
stable ref that ignores nil — an *inline* ref closure is re-created every
render and React can call it with nil, which is what left video-el nil and
made both the clock read and the seek write silently no-op."
[fps]
(let [raf (atom nil)
seen (atom nil) ; last currentTime we pushed
capture! (fn [n] (when n (reset! video-el n))) ; stable id; ignore React's nils
tick (fn tick []
(when-let [v @video-el]
;; 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)))]
(r/create-class
{:display-name "video-monitor"
:component-did-mount (fn [_] (tick))
:component-will-unmount (fn [_] (some-> @raf js/cancelAnimationFrame) (reset! video-el nil))
:reagent-render
(fn [_fps]
[:video {:src media-src
:controls true
:preload "auto"
:ref capture!
;; Keep playback inline on iOS instead of jumping to fullscreen.
:plays-inline true
:webkit-playsinline "true"
:on-play (fn [_] (reset! following? true)
(rf/dispatch [::events/set-playing true]))
:on-pause (fn [_] (rf/dispatch [::events/set-playing false]))}])})))
"Plain native-controls <video>. It is decoupled from the timeline playhead —
the playback layer was removed and is to be rebuilt."
[_fps]
[:video {:src media-src
:controls true
:preload "auto"
;; Keep playback inline on iOS instead of jumping to fullscreen.
:plays-inline true
:webkit-playsinline "true"}])
;; --- commentary sidebar ---------------------------------------------------
@ -318,177 +215,31 @@
[:div.ann-empty "No annotations."])]))))
;; --- timeline -------------------------------------------------------------
;; The timeline's rendering controller — data subscriptions, coordinate
;; translation (media<->group / pieces), lane packing, scrubbing and the
;; playhead — was removed and is to be rebuilt. Only the element scaffolding +
;; CSS remain below, as a static shell.
(defn- ann-extent
"[earliest-start, latest-end] across an annotation's spans (its footprint)."
[spans] [(reduce min (map :start spans)) (reduce max (map :end spans))])
(defn- assign-lanes
"Pack annotations into as few rows as possible. Processed in definition order
(earliest :created first), each takes the topmost lane it doesn't time-overlap
— so non-overlapping annotations collapse onto one row, and when they do
overlap the earlier-defined one sits above. Returns each with a :lane index."
[anns]
(let [ordered (sort-by (juxt #(:created % 0) #(first (ann-extent (:spans %)))) anns)]
(loop [[a & more] ordered, lanes [], out []]
(if (nil? a)
out
(let [[s e] (ann-extent (:spans a))
fits? (fn [ivs] (every? (fn [[s2 e2]] (or (<= e s2) (>= s e2))) ivs))
li (or (first (keep-indexed (fn [i ivs] (when (fits? ivs) i)) lanes))
(count lanes))
lanes (update (if (< li (count lanes)) lanes (conj lanes [])) li conj [s e])]
(recur more lanes (conj out (assoc a :lane li))))))))
(defn- lane-count [placed]
(if (seq placed) (inc (reduce max (map :lane placed))) 0))
(defn annotation-lane
"The annotation rows above the tracks. Annotations are packed into shared rows
(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)))]
^{:key li}
[:div.ann-lane-row
(doall
(for [{:keys [id name spans preview?] c :color} items]
(let [color (or c "#4e8fc2")
on? (= id active)
rects (mapcat #(marks/pieces vspans (:start %) (:end %)) spans)]
^{:key id}
[:<>
(doall
(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
"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 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)}}
(for [c (:clips track)]
^{:key (:id c)} [clip-block fps zoom vspans row-h authoring? c])]))
(defn- ev->frames
"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 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 vspans)))
move (fn [e] (to (.-clientX e)))
up (fn up [_]
(.removeEventListener js/document "mousemove" move)
(.removeEventListener js/document "mouseup" up))]
(to (.-clientX ev))
(.addEventListener js/document "mousemove" move)
(.addEventListener js/document "mouseup" up)))
(defn timeline []
(let [content (atom nil)]
(fn []
(let [fps @(rf/subscribe [::subs/fps])
zoom @(rf/subscribe [::subs/zoom])
row-h @(rf/subscribe [::subs/row-h])
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])
active @(rf/subscribe [::subs/active-annotation])
;; all video tracks, each flagged :visible? by the crop (hidden ones
;; collapse rather than disappear, so they animate out)
vtracks @(rf/subscribe [::subs/visible-tracks])
;; live, un-saved preview of the annotation currently being authored
d @(rf/subscribe [::subs/draft])
preview (when d
(let [cidx @(rf/subscribe [::subs/clip-index])
groups @(rf/subscribe [::subs/groups])
marks (vec (keep row->mark (:rows d)))
spans (when (and cidx (seq marks))
(try (marks/resolve-marks cidx groups #{} marks)
(catch :default _ nil)))]
(when (seq spans)
;; newest :created so the in-progress draft sinks below
;; existing annotations when they overlap
{:id ::draft :preview? true :color (:color d) :created js/Infinity
:name (or (not-empty (str/trim (str (:name d)))) "(new)")
:spans spans})))
lane-anns (let [base (if (:id d) (remove #(= (:id %) (:id d)) anns) anns)]
(->> (cond-> (vec base) preview (conj preview))
(filterv (comp seq :spans)))) ; need a footprint to pack
placed (assign-lanes lane-anns)
lane-h (* 18 (lane-count placed))
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 vspans playhead)))
[:div.timeline
;; fixed left gutter: setup (track) names, in lockstep with the rows
;; (collapsed tracks shrink here too so labels stay aligned)
[:div.gutter
[:div {:style {:height lane-h}}] ; spacer aligning labels with rows
(for [t vtracks]
^{:key (:id t)}
[:div.gutter-label {:class (when-not (:visible? t) "collapsed")
:style {:height (if (:visible? t) row-h 0)
:line-height (str (dec row-h) "px")}}
(:name t)])]
;; horizontally-scrolling timeline
[: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 vspans e))
:style {:width width}}
(let [x (local-x vspans fps zoom playhead)]
[:div.playhead {:style {:left x}}
[:div.playhead-handle]])
[annotation-lane fps zoom vspans placed active]
(for [t vtracks]
^{:key (:id t)} [track-row fps zoom vspans row-h (some? d) t])]]]))))
(defn timeline
"Static element shell: the structural markup (gutter / hscroll / content /
playhead / annotation lane / track rows / clips) with placeholder content and
no controller logic. Rebuild the data->geometry + interaction on top of this."
[]
[:div.timeline
[:div.gutter
[:div {:style {:height 18}}] ; lane spacer
[:div.gutter-label {:style {:height 28 :line-height "27px"}} "Track"]
[:div.gutter-label {:style {:height 28 :line-height "27px"}} "Track"]]
[:div.hscroll {:ref (fn [n] (reset! scroll-el n))}
[:div.content {:style {:width 480}}
[:div.playhead {:style {:left 0}} [:div.playhead-handle]]
[:div.ann-lane-row
[:div.ann-bar {:style {:left 0 :width 160 :background "#4e8fc280" :border "1px solid #4e8fc2"}}]
[:div.ann-bar-label {:style {:left 4}} "annotation"]]
[:div.track-row {:style {:height 28}}
[:div.clip {:style {:left 0 :width 160 :height 26 :line-height "26px"}} "clip"]]
[:div.track-row {:style {:height 28}}
[:div.clip {:style {:left 180 :width 120 :height 26 :line-height "26px"}} "clip"]]]]])
;; --- zoom + layout shell --------------------------------------------------
@ -497,20 +248,7 @@
[:input {:type "range" :min lo :max hi :value v
:on-change #(on (js/parseFloat (.. % -target -value)))}]])
(defn- zoom-x!
"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])
spans @(rf/subscribe [::subs/view-spans])
z0 @(rf/subscribe [::subs/zoom])]
(rf/dispatch [::events/set-zoom z1])
(when el
(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- zoom-x! [z1] (rf/dispatch [::events/set-zoom z1]))
(defn breadcrumbs
"Trail of the expanded-timeline stack. Only shown when nested. The back button
@ -533,16 +271,14 @@
name]])))])))
(defn zoom-controls []
(let [zoom @(rf/subscribe [::subs/zoom])
row-h @(rf/subscribe [::subs/row-h])
fps (or @(rf/subscribe [::subs/fps]) (/ 24000 1001))
playing? @(rf/subscribe [::subs/playing?])]
(let [zoom @(rf/subscribe [::subs/zoom])
row-h @(rf/subscribe [::subs/row-h])]
[:div.toolbar
;; transport buttons kept as UI; handlers belong to the playback layer (rebuild)
[:div.transport
[:button.step-btn {:on-click #(step-frame! fps -1) :title "Previous frame"} "|◀"]
[:button.play-btn {:on-click toggle-play! :title "Play / pause (Space)"}
(if playing? "⏸" "▶")]
[:button.step-btn {:on-click #(step-frame! fps 1) :title "Next frame"} "▶|"]]
[:button.step-btn {:title "Previous frame"} "|◀"]
[:button.play-btn {:title "Play / pause"} "▶"]
[:button.step-btn {:title "Next frame"} "▶|"]]
[slider "Zoom X" zoom 2 400 zoom-x!]
[slider "Zoom Y" row-h 8 120 #(rf/dispatch [::events/set-row-h %])]]))