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

Rebuild annotation editor on the mark-group model

Browse source 
- scene: mark-group model (resolve/selection->marks/seg-local/marks->rows);
  drop legacy tl.marks/tl.md
- authoring: draft is a normal annotation group flagged :draft; generic
  put-group + with-let cancel; two-input click-to-fill editor in mark time
- timeline: dashed draft preview, numeric track ordering
- video frame readout (track+clip, mark time) clickable to fill an endpoint
- discontinuity jump popover; nested-annotation count badge
- localStorage persistence of the authored annotation layer

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-06-28 23:18:07 -04:00
parent 9d0302c367
commit c03756d3e1
13 changed files with 1003 additions and 1062 deletions
Download patch file Download diff file Expand all files Collapse all files

25
tl/data_model.org
View file

@ -2,18 +2,35 @@
a mark-group is the fundamental datastructure of this app. the whole scene graph is composed of them. we use this same structure to represent the main timeline, the clips within the timeline, and the annotations on the timeline. a mark-group is just an ordered list of marks with a little bit of extra data hanging off them depending on the type. it also has a parent: the mark-group context it belongs to. a mark-group is the fundamental datastructure of this app. the whole scene graph is composed of them. we use this same structure to represent the main timeline, the clips within the timeline, and the annotations on the timeline. a mark-group is just an ordered list of marks with a little bit of extra data hanging off them depending on the type. it also has a parent: the mark-group context it belongs to.
a mark can represent an instant or a range of time, and that instant or range can be defined in terms of frames (relative to the current timeline on the timeline stack) or frames w/r/t to other mark-groups and these can be mixed and matched. each mark can also optionally specify a target video track (video tracks and clips are initially sourced from an initial otio file). thus, the main timeline is a mark group with one mark: the start and end timestamp. a clip which belongs to that main timeline is a mark group with one mark: the start and end timestamps (within the main timeline) AND the video track to which it belongs. its parent is the main timeline (or should it have no parent? since these are the fundamental units maybe it's ok if they are seen everywhere. basically we have to make a choice: do we copy the clips into new contexts? like if we do it such that a clip has a parent, and the annotation on that clip has the same parent, they are siblings -- what does it mean to expand the annotation by putting it on the timeline stack w/r/t the underlying sibling clips, then? really in that case, the clip should become a child of the annotation, but it also needs to be the child of the main timeline as well, and any other sub annotation...seems better to have them parentless). an annotation is a mark group which conceptually represents a point or points of interest with optional commentary, though it looks not substantially different than a timeline or clip in the data structure, and really it's so flexible it could represent whole re-edits of clips. its marks can also be timestamps in the context of some timeline, or they can be the start and end frames of a given clip, defined relative to the clip, or defined relative to another annotation, or any combination thereof, in any amount, and with any combination of ranges and instants. (should an instant really just be a range of one frame? rather than its own separate thing?) a mark can represent an instant or a range of time, and that instant or range can be defined in terms of frames (relative to the current timeline on the timeline stack) or frames w/r/t to other mark-groups and these can be mixed and matched. each mark can also optionally specify a target video track (video tracks and clips are initially sourced from an initial otio file; the otio is only a seed -- it populates :tracks and the initial clip + timeline mark-groups once, then we never look at it again. :tracks is the only thing in the whole app that isn't a mark-group). thus, the main timeline is a mark group with one mark: the start and end timestamp. a clip which belongs to that main timeline is a mark group with one mark: the start and end timestamps (within the main timeline) AND a video track. but the track hangs off the mark, optionally, not the root of the clip. a clip is only different from an annotation in that one of its marks specifies a track (and, soon, :thumbnails), so an annotation could target a track too. clips are parentless: they're a flat pool, referenced by id, never owned. :parent is an annotation-only thing -- the authoring/visibility context, i.e. which timeline i was in when i made it. this dodges the whole knot: if clips had parents, expanding an annotation would have to make the clip a child of the annotation AND the main timeline AND every sub-annotation at once. containment is a reference, not ownership. an annotation is a mark group which conceptually represents a point or points of interest with optional commentary, though it looks not substantially different than a timeline or clip in the data structure, and really it's so flexible it could represent whole re-edits of clips. its marks can also be timestamps in the context of some timeline, or they can be the start and end frames of a given clip, defined relative to the clip, or defined relative to another annotation, or any combination thereof, in any amount, and with any combination of ranges and instants. an instant is just a range where start == end (length 0), no separate type. concatenation goes by length, so an instant adds no duration -- it's a marker at the current offset, drawn as a diamond instead of a bar.
because an annotation is just a mark-group, and a timeline is just a mark group, any annotation can be pushed onto the timeline-stack, replacing the main timeline. the clips within the marks in the mark group are laid end to end to form one continuous duration, a new timeline. the cool thing here is that you can now annotate within the context of this annotation. so if we are inside annotation A, annotation A is the :parent of our new Annotation B. if annotation B uses absolute timestamp marks, they are relative to the annotation A timeline, not the main timeline. and if annotation B uses clip based timestamps, they can only reference the frames of the underlying clip which are within range of the annotation (annotation A, the parent, may have start half way through the clip at the beginning, and end half way through the clip at the end). and then you can push annotation B onto the timeline stack, annotate within that, and on and on. because an annotation is just a mark-group, and a timeline is just a mark group, any annotation can be pushed onto the timeline-stack, replacing the main timeline. the clips within the marks in the mark group are laid end to end to form one continuous duration, a new timeline. the cool thing here is that you can now annotate within the context of this annotation. so if we are inside annotation A, annotation A is the :parent of our new Annotation B. if annotation B uses absolute timestamp marks, they are relative to the annotation A timeline, not the main timeline. and if annotation B uses clip based timestamps, they can only reference the frames of the underlying clip which are within range of the annotation (annotation A, the parent, may have start half way through the clip at the beginning, and end half way through the clip at the end). and then you can push annotation B onto the timeline stack, annotate within that, and on and on.
something about mark groups to note is that marks need not be defined in order. if the main timeline has clip A, B, and C laid end to end, an annotation X can have marks [[clipC[0], clipC[-1]], [clipA[0], clipA[-1]], [clipB[0], clipB[-1]]. -1 represents last available frame of the clip (note here that available frame may differ from absolute last frame of the underlying clip, because the annotation context we're in could cut off half the clip, for example). in this example, we have totally rearranged the clips into a timeline B C A, end to end. and you can also imagine we can cut clips in half, interleave them, repeat them and so on. something about mark groups to note is that marks need not be defined in order. if the main timeline has clip A, B, and C laid end to end, an annotation X can have marks [[clipC[0], clipC[-1]], [clipA[0], clipA[-1]], [clipB[0], clipB[-1]]. -1 represents last available frame of the clip (note here that available frame may differ from absolute last frame of the underlying clip, because the annotation context we're in could cut off half the clip, for example). note this clamping only bites for raw clip refs across a trim -- if you reference the subclip (the parent's mark) instead, the trim is baked into the mark's range, so subclip[-1] = the subclip's own end, no clamp (more below). in this example, we have totally rearranged the clips into a timeline B C A, end to end. and you can also imagine we can cut clips in half, interleave them, repeat them and so on.
hmm here's a struggle though. let's say i have interleaved half of A with half of B in an annotation which i pushed onto the timeline stack: hmm here's a struggle though. let's say i have interleaved half of A with half of B in an annotation which i pushed onto the timeline stack:
marks: [[clipB[20], clipB[40]], [clipA[0], clipA[20]], [clipB[0], clipB[20]] [clipA[20], clipA[40]]] marks: [[clipB[20], clipB[40]], [clipA[0], clipA[20]], [clipB[0], clipB[20]] [clipA[20], clipA[40]]]
we want to be able to mark these sub clips independently for a new annotation Y, right? but these are just 2 root clips that became 4. so how can we define annotation Y with respect to any of these 4 clips? we don't want to use absolute timeline time, but we also don't want to use absolute clip time because our marks can cross between the first sub clip (b 20 - 40) and the second (a 0 to a 20), so clip time means nothing here. we also need to remember that the parent timeline can clear out its marks at will. so we can definitely orphan annotations - that's ok, that's a UI concern we can display warnings for and just grey out basically (drop to bottom of annotation list, for example, with a warn emoji and let the user edit to specify its marks again, even warn on which marks are broken, and if at least one mark is still valid still display it there). so it rly seems like an annotation SHOULD create synthetic subclips which point at the raw clips so that we can use the synthetic subclips as our targets. but they need to be stable identities, serializable/deserializable. we want to be able to mark these sub clips independently for a new annotation Y, right? but these are just 2 root clips that became 4. so how can we define annotation Y with respect to any of these 4 clips? we don't want to use absolute timeline time, but we also don't want to use absolute clip time because our marks can cross between the first sub clip (b 20 - 40) and the second (a 0 to a 20), so clip time means nothing here. we also need to remember that the parent timeline can clear out its marks at will. so we can definitely orphan annotations - that's ok, that's a UI concern we can display warnings for and just grey out basically (drop to bottom of annotation list, for example, with a warn emoji and let the user edit to specify its marks again, even warn on which marks are broken, and if at least one mark is still valid still display it there). so it rly seems like an annotation SHOULD create synthetic subclips which point at the raw clips so that we can use the synthetic subclips as our targets. but they need to be stable identities, serializable/deserializable.
this brings us to playing. since right now there is only one source video file, we need to be able to seek to arbitrary frames. we should have a playhead stack, or each annotation can maintain its own playhead that gets used when its the top of the timeline stack. when we hit play, in the example above of annotation X, we find the clip under the playhead of the current timeline on the timeline stack, find where we are relative to the root clip, and use that root clip's frame to seek to that frame in the source video file. and start playing. when the playhead advances and the clip under it has changed, we look to see if there is a difference between that absolute frame in the source file (computed from playhead position and the clip) and where we would expect to be in the file. if it differs, we seek to that absolute frame and continue playing, checking every frame if we need to seek. does that make sense? this should be an extremely simple function. because we're rendering the timeline already, we should already know which frame we should be on without even recursing, i think? resolved: every mark gets a stable id (a uuid) at creation, and a clip/subclip-ref mark stays within ONE clip -- so the addressable subclip is just a single-clip mark, addressed by mark-id alone. a selection that crosses clip boundaries is stored as a RUN of per-clip marks (the lane sticks the contiguous run into one bar; the editor splits/merges at boundaries on edit). a mark is already a recursive structure pointing at a raw clip, the id just makes it addressable, so no separate entities, no recreation lifecycle. Y references A's subclips by mark-id: {:ref <mark-id> :at n}.
- edit a mark's range -> same id -> Y follows it
- reorder marks -> ids travel with them -> Y follows the content, not the slot
- delete a mark -> id gone -> Y dangles -> orphan (grey out, warn per broken mark, keep if at least one still resolves)
- add a mark -> new id
so "keep identity unless the whole thing is different" isn't an algorithm we run, it's a ui affordance: editing a row in place keeps the id, delete-row + add-row makes a new id. like keyed list editing / db rows with primary keys -- you carry stable keys, you never diff structure to guess identity.
and the subclip bakes the trim into its own definition, so it's a clean map to source: subclip[n] = src-start + n, subclip[-1] = src-end, no clamp, no context lookup. that makes resolving a ref context-free: (mark-id, scene) -> source range, no timeline-stack needed. the stack only decides which context's local timeline you're looking at, not how a ref resolves. only absolute (bare number) points are context-dependent -- they're local frames of the context the mark lives in.
so the whole mark grammar is two point kinds:
- ref point {:ref <mark-id> :at n} -> frame n of that mark's resolved range (context-free, n negative = from the end)
- absolute point <number> -> a local frame of the context the mark lives in (resolved through that context's spans)
mix them in a single range, instant = start==end, track optional on the mark. a raw clip is just a mark whose range is full source + a track. a clip/subclip-ref mark keeps both endpoints on the SAME target, so it resolves to exactly one source segment; only an absolute mark may span several.
decided: a clip/subclip-ref mark never crosses a clip boundary, so the "range whose endpoints are in different subclips" case just can't happen. a selection across clips is a run of single-clip marks instead, one per clip, laid end to end (genuinely contiguous -- the lane only draws them as one bar). this keeps resolve trivial (one source segment per ref mark), makes every piece addressable by mark-id alone, and makes a reorder follow each piece independently instead of swelling. the merge/unmerge is localized: dragging a boundary WITHIN a clip edits that end mark in place (id stable); dragging ACROSS a clip boundary adds/removes a whole clip from the selection (creates/destroys that end mark); the fully-contained middle clips never churn. the same rule applies at any depth -- "clip boundary" means a boundary in the fully-resolved footage, so it works the same whether you're at root crossing raw clips or nested crossing a parent mark's segments. the one multi-segment mark left is an absolute one (bare-number local range): it's arrangement-relative, you build it by dragging the timeline rather than by referencing, and it resolves via slice.
this brings us to playing. since right now there is only one source video file, we need to be able to seek to arbitrary frames. each context (mark-group) keeps its own local playhead, used when it's the top of the timeline stack. when we hit play, in the example above of annotation X, we find the clip under the playhead, compute the source frame, seek there, and start playing. one correction though: the local playhead has to be the master clock, not the video. you can't derive local position from currentTime -- once an annotation repeats or reorders clips, one source frame maps to several local frames, it's not invertible. so the local playhead advances on its own (wall-clock x fps while playing), and every frame we compute expected = group->media(local) and seek the video there only if round(currentTime*fps) != expected. within a clip, expected tracks the video's natural playback so no seek fires; at a mark boundary it jumps once and we seek. and right -- no recursion at play time: we resolve the current context once into flat ordered spans, and group->media is just the flat lookup the renderer already does.
# how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation. # how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation.
# automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit. # automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit.

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

@ -20,12 +20,24 @@ body { overflow: hidden; }
.top { display: flex; min-height: 140px; height: var(--top-h, 46vh); } .top { display: flex; min-height: 140px; height: var(--top-h, 46vh); }
.video-pane { .video-pane {
position: relative;
flex-shrink: 0; width: var(--video-w, 50%); min-width: 200px; flex-shrink: 0; width: var(--video-w, 50%); min-width: 200px;
display: flex; align-items: center; justify-content: center; display: flex; align-items: center; justify-content: center;
background: #000; overflow: hidden; background: #000; overflow: hidden;
} }
.video-pane video { max-width: 100%; max-height: 100%; display: block; background: #000; } .video-pane video { max-width: 100%; max-height: 100%; display: block; background: #000; }
.frame-readout {
position: absolute; bottom: 6px; right: 8px; z-index: 4;
display: flex; gap: 8px; align-items: center;
font-family: monospace; font-size: 11px; color: #cfe3f5;
background: rgba(0,0,0,0.6); padding: 2px 7px; border-radius: 4px;
pointer-events: none; /* don't block video controls… */
}
.frame-readout .fr-clip { pointer-events: auto; } /* …except the clip chip */
.fr-clip.clickable { cursor: copy; color: #9ed7b0; }
.fr-clip.clickable:hover { color: #c7efd4; }
.annot-pane { flex: 1; min-width: 200px; display: flex; } .annot-pane { flex: 1; min-width: 200px; display: flex; }
/* --- draggable dividers ------------------------------------------------- */ /* --- draggable dividers ------------------------------------------------- */
@ -56,11 +68,9 @@ body { overflow: hidden; }
border: 1px solid #3a6ea5; border-radius: 4px; border: 1px solid #3a6ea5; border-radius: 4px;
padding: 1px 7px; cursor: pointer; font-size: 10px; white-space: nowrap; padding: 1px 7px; cursor: pointer; font-size: 10px; white-space: nowrap;
} }
/* native popover in the top layer; top/right set by JS (place-popover!) in /* popover of jump targets for an annotation with discontinuous marks */
viewport coords so it tracks the commentary scroll. */ .jump-pop {
.jump-pop:popover-open { position: absolute; right: 0; top: 100%; z-index: 20; margin-top: 2px;
position: fixed;
margin: 0; inset: auto;
min-width: 150px; max-height: 180px; overflow-y: auto; min-width: 150px; max-height: 180px; overflow-y: auto;
background: #1b1b1b; border: 1px solid #3a6ea5; border-radius: 4px; background: #1b1b1b; border: 1px solid #3a6ea5; border-radius: 4px;
box-shadow: 0 4px 14px rgba(0,0,0,0.5); padding: 4px; box-shadow: 0 4px 14px rgba(0,0,0,0.5); padding: 4px;
@ -100,6 +110,10 @@ body { overflow: hidden; }
} }
.expand-btn:hover { color: #cfe3f5; border-color: #3a6ea5; } .expand-btn:hover { color: #cfe3f5; border-color: #3a6ea5; }
.expand-btn.has-children { color: #cfe3f5; border-color: #3a6ea5; background: #16263a; } .expand-btn.has-children { color: #cfe3f5; border-color: #3a6ea5; background: #16263a; }
.nest-badge {
margin-left: 3px; font-size: 9px; line-height: 1; vertical-align: top;
background: #3a6ea5; color: #fff; border-radius: 8px; padding: 1px 4px;
}
/* --- authoring form (fills the annotation pane) ------------------------- */ /* --- authoring form (fills the annotation pane) ------------------------- */
.form { .form {

8
tl/src/tl/core.cljs
View file

@ -19,15 +19,7 @@
(rdom/unmount-component-at-node root-el) (rdom/unmount-component-at-node root-el)
(rdom/render [views/main-panel] root-el))) (rdom/render [views/main-panel] root-el)))
;; one-time dev reset: wipe saved marks once so the nested-timeline seed data
;; shows, then flag it so persistence resumes normally. Safe to delete later.
(defn- reset-marks-once! []
(when-not (.getItem js/localStorage "tl/seed-reset-2")
(.removeItem js/localStorage "tl/marks")
(.setItem js/localStorage "tl/seed-reset-2" "1")))
(defn init [] (defn init []
(reset-marks-once!)
(re-frame/dispatch-sync [::events/initialize-db]) (re-frame/dispatch-sync [::events/initialize-db])
(re-frame/dispatch [::events/load-otio]) (re-frame/dispatch [::events/load-otio])
(dev-setup) (dev-setup)

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

@ -1,78 +1,18 @@
(ns tl.db) (ns tl.db)
(def default-db (def default-db
{;; load lifecycle for the OTIO fetch {:load {:status :idle} ; :idle | :loading | :ready | :error
:load {:status :idle ; :idle | :loading | :ready | :error :fps (/ 24000 1001)
:error nil}
;; the parsed, immutable-after-load document (tl.otio/parse output) ;; the whole scene graph (see tl.scene). Seeded from OTIO at load.
:timeline nil :scene {:tracks {}
:groups {:root {:type :timeline :parent nil
:marks [{:id :root-m :start 0 :end 0}]}}}
;; Mark-groups: the annotation layer (see tl.marks for the grammar). ;; view state
;; Clips come from :timeline; these are the user-authored groups + the :view {:stack [:root] ; timeline-stack; top = current context
;; root timeline descriptor. :playheads {} ; per-context local playhead
;; :playing? false
;; Nesting: every annotation has a :parent (the context it lives in; :root = :zoom 50 ; px per second
;; top level). "Expanding" an annotation pushes its id onto :timeline-stack; :row-h 28 ; track row height (px)
;; the top of the stack is the current context, and only annotations whose :pt nil}}) ; authoring: next clip-click target
;; :parent matches it are surfaced — so a nested annotation is invisible on
;; the main timeline. The context annotation's own spans crop the timeline
;; (time window + involved tracks) it's expanded into.
;;
;; The annotations below are seed data (shown on a fresh localStorage) so the
;; expand/nest flow is testable: "Opening rally" has two children.
;; The seed is laid out to exercise lane packing. Root level (by frame):
;; Act I 0–414 (section) created 1 -> lane 0 (earliest, top)
;; Opening rally 129–385 created 2 -> lane 1 (overlaps Act I)
;; Baseline 64–128 created 3 -> lane 1 (fits before rally)
;; Tashi glance 150–175 created 4 -> lane 2 (overlaps both)
;; Net-cam beat 542–609 created 5 -> lane 0 (collapses after Act I)
:marks
{:timeline-stack [:root]
:groups {:root {:type :timeline :name "Sequence"}
:ann-act1
{:type :annotation :parent :root :name "Act I — the warmup" :color "#8a8f3a"
:created 1 :content "The whole opening movement."
:marks [[0 414]]}
:ann-rally
{:type :annotation :parent :root :name "Opening rally" :color "#4e8fc2"
:created 2
:content "The first volley — CU coverage across the three principals."
:marks [:t2-c0 :t3-c0 :t4-c0]}
:ann-baseline
{:type :annotation :parent :root :name "Baseline establishing" :color "#c28f4e"
:created 3 :marks [:t1-c0]}
:ann-glance
{:type :annotation :parent :root :name "Tashi glance" :color "#c24e9a"
:created 4 :marks [[150 175]]}
:ann-net
{:type :annotation :parent :root :name "Net-cam beat" :color "#9a7ac2"
:created 5 :marks [:t6-c0]}
;; children of "Opening rally" (visible only when expanded into it):
;; Tashi's read 129–190 / Art reacts 192–266 -> share lane 0
;; the spin 140–205 -> lane 1 (overlaps both)
:ann-tashi-read
{:type :annotation :parent :ann-rally :name "Tashi's read" :color "#c2624e"
:created 6 :content "She clocks the spin early."
:marks [[[:at :t2-c0 0] [:at :t2-c0 -1]]]}
:ann-art-react
{:type :annotation :parent :ann-rally :name "Art reacts" :color "#5ab07a"
:created 7 :marks [:t3-c0]}
:ann-spin
{:type :annotation :parent :ann-rally :name "the spin" :color "#4ec2b0"
:created 8 :marks [[140 205]]}}}
;; 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 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 {}
:selected-clip nil
;; resizable layout (relative): top region height as vh, video pane
;; width as % of the top row. Pixel minimums enforced in CSS.
:top-h 46
:video-w 50}})

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

@ -3,21 +3,39 @@
[re-frame.core :as rf] [re-frame.core :as rf]
[tl.db :as db] [tl.db :as db]
[tl.otio :as otio] [tl.otio :as otio]
[tl.scene :as scene]
[tl.storage :as storage] [tl.storage :as storage]
[ajax.core :as ajax])) [ajax.core :as ajax]))
;; Persist the :marks map to localStorage as a side effect. (rf/reg-event-db ::initialize-db (fn [_ _] db/default-db))
(rf/reg-fx :tl/save (fn [marks] (storage/save-marks! marks)))
(rf/reg-event-db ;; after a group-mutating event, persist the authored annotation layer
::initialize-db (def persist (rf/after (fn [db] (storage/save! (:scene db)))))
(fn [_ _]
;; hydrate the annotation layer from localStorage if present
(if-let [saved (storage/load-marks)]
(assoc db/default-db :marks saved)
db/default-db)))
;; --- load + parse --------------------------------------------------------- ;; --- load + seed ----------------------------------------------------------
(defn- demo-annotations
"A couple of seed annotations referencing real clips, so there's something to
render/expand. 'opening' takes the 1st and 3rd clips (skips the 2nd) to show
rearrange + gap removal when expanded."
[scene]
(let [clip-ids (->> (:groups scene)
(filter (fn [[_ g]] (= :clip (:type g))))
(sort-by (fn [[_ g]] (-> g :marks first :start)))
(mapv first))
whole (fn [mid clip] {:id mid :start {:ref clip :at 0} :end {:ref clip :at -1}})
[a b c] (take 3 clip-ids)]
(cond-> scene
(and a b c)
(assoc-in [:groups :ann-opening]
{:type :annotation :parent :root :name "opening" :color "#4e8fc2"
:content "first and third shots, back to back — the middle is cut."
:marks [(whole :mo-a a) (whole :mo-c c)]})
b
(assoc-in [:groups :ann-beat]
{:type :annotation :parent :root :name "the beat" :color "#c2624e"
:content "the second shot on its own."
:marks [(whole :mb-b b)]}))))
(rf/reg-event-fx (rf/reg-event-fx
::load-otio ::load-otio
@ -32,135 +50,74 @@
(rf/reg-event-db (rf/reg-event-db
::otio-loaded ::otio-loaded
(fn [db [_ raw]] (fn [db [_ raw]]
(-> db (let [parsed (otio/parse raw)]
(assoc :timeline (otio/parse raw)) (-> db
(assoc-in [:load :status] :ready)))) (assoc :fps (:fps parsed))
(assoc :scene (let [scene (scene/from-otio parsed)
saved (storage/load)]
(if (nil? saved)
(demo-annotations scene) ; first run → seed demos
(update scene :groups merge saved)))) ; else restore authored layer
(assoc-in [:load :status] :ready)))))
(rf/reg-event-db (rf/reg-event-db
::otio-error ::otio-error
(fn [db [_ err]] (fn [db [_ err]] (-> db (assoc-in [:load :status] :error) (assoc-in [:load :error] err))))
(-> db
(assoc-in [:load :status] :error)
(assoc-in [:load :error] err))))
;; --- playhead cursor ----------------------------------------------------- ;; --- view -----------------------------------------------------------------
;; 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 [_ ctx lf]] (assoc-in db [:view :playheads ctx] lf)))
(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p)))
(rf/reg-event-db ::set-zoom (fn [db [_ z]] (assoc-in db [:view :zoom] z)))
(rf/reg-event-db ::set-row-h (fn [db [_ h]] (assoc-in db [:view :row-h] h)))
(rf/reg-event-db ::expand (fn [db [_ gid]] (update-in db [:view :stack] conj gid)))
(rf/reg-event-db ::collapse (fn [db _] (update-in db [:view :stack]
(fn [s] (if (> (count s) 1) (pop s) s)))))
(rf/reg-event-db ::pop-to
(fn [db [_ gid]]
(update-in db [:view :stack]
(fn [s] (let [i (first (keep-indexed #(when (= gid %2) %1) s))]
(if i (subvec s 0 (inc i)) s))))))
;; --- authoring ------------------------------------------------------------
;; The draft is just a normal annotation group, flagged :draft (:new while
;; unsaved, :edit while editing). The form holds the original (with-let) and
;; drives everything — field edits, frame nudges, save, cancel — through the
;; generic ::put-group. The only transient bit is [:view :pt]: the next clip
;; click's target — :new, or {:seg :f} once a start is pending.
(rf/reg-event-db ::open-draft
(fn [db _]
(-> db
(assoc-in [:scene :groups (keyword (gensym "ann-"))]
{:type :annotation :parent (peek (get-in db [:view :stack]))
:draft :new :name "" :color "#4e8fc2" :marks []})
(assoc-in [:view :pt] :new))))
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new))))
(rf/reg-event-db ::put-group persist (fn [db [_ gid g]] (assoc-in db [:scene :groups gid] g)))
(rf/reg-event-db ::drop-group persist (fn [db [_ gid]] (update-in db [:scene :groups] dissoc gid)))
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
(rf/reg-event-db ::delete-annotation persist (fn [db [_ gid]] (update-in db [:scene :groups] dissoc gid)))
;; click a clip while authoring: first click sets a pending start, the second
;; completes the span as a run of single-clip marks. `frame` (mark time) is
;; optional — clicking a clip uses whole-clip defaults (0 / clip end), clicking
;; the video frame-readout passes the exact frame under the playhead.
(rf/reg-event-db (rf/reg-event-db
::set-playhead ::draft-click-seg
(fn [db [_ frames]] (fn [db [_ seg-id frame]]
;; per-context slot, so expanding/collapsing doesn't clobber another (let [scene (:scene db)
;; timeline's remembered cursor position [gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
(assoc-in db [:view :playheads (ctx-id db)] frames))) segs (scene/content-segments scene (:parent g))
pt (get-in db [:view :pt])]
;; --- timeline zoom (x = px/second, y = track row height) ---------------- (if (map? pt)
(let [a (scene/seg-local segs (:seg pt) (:f pt))
(rf/reg-event-db b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))
::set-zoom run (scene/selection->marks scene (:parent g) (min a b) (max a b))]
(fn [db [_ px-per-sec]] (assoc-in db [:view :zoom] px-per-sec))) (-> db (update-in [:scene :groups gid :marks] into run)
(assoc-in [:view :pt] :new)))
(rf/reg-event-db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})))))
::set-row-h
(fn [db [_ h]] (assoc-in db [:view :row-h] h)))
;; --- resizable layout ----------------------------------------------------
(rf/reg-event-db
::set-top-h
(fn [db [_ h]] (assoc-in db [:view :top-h] h)))
(rf/reg-event-db
::set-video-w
(fn [db [_ w]] (assoc-in db [:view :video-w] w)))
;; --- authoring draft (lives in app-db: reactive fields + live preview) ---
(rf/reg-event-db ::open-draft (fn [db [_ d]] (assoc db :draft d)))
(rf/reg-event-db ::close-draft (fn [db _] (dissoc db :draft)))
(rf/reg-event-db ::draft-set (fn [db [_ path v]] (assoc-in db (into [:draft] path) v)))
(rf/reg-event-db ::draft-conj-row (fn [db [_ row]] (update-in db [:draft :rows] (fnil conj []) row)))
(rf/reg-event-db ::draft-remove-row (fn [db [_ i]]
(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
::expand-annotation
(fn [db [_ id]] (update-in db [:marks :timeline-stack] conj id)))
(rf/reg-event-db
::collapse ; the back button: pop one level
(fn [db _] (update-in db [:marks :timeline-stack]
(fn [s] (if (> (count s) 1) (pop s) s)))))
(rf/reg-event-db
::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))))))
;; --- authoring: create / delete annotations (persisted) -----------------
(rf/reg-event-fx
::add-annotation
(fn [{:keys [db]} [_ {:keys [name content color marks]}]]
;; new annotations are children of whatever context we're currently in
(let [id (keyword (str "ann-" (random-uuid)))
parent (last (get-in db [:marks :timeline-stack]))
group (cond-> {:type :annotation :parent parent :name name :color color
:marks marks :created (.now js/Date)} ; defines stacking order
(seq content) (assoc :content content))
db' (assoc-in db [:marks :groups id] group)]
{:db db' :tl/save (:marks db')})))
(rf/reg-event-fx
::update-annotation
(fn [{:keys [db]} [_ id {:keys [name content color marks]}]]
;; merge so :parent (and any other group keys) survive an edit; drop a
;; cleared :content explicitly rather than leaving the old text behind.
(let [group (cond-> {:name name :color color :marks marks :content nil}
(seq content) (assoc :content content))
db' (update-in db [:marks :groups id] merge group)]
{:db db' :tl/save (:marks db')})))
(rf/reg-event-fx
::delete-annotation
(fn [{:keys [db]} [_ id]]
;; remove the annotation and its whole nested subtree (so children aren't
;; orphaned), and pop the stack past anything we just deleted.
(let [groups (get-in db [:marks :groups])
doomed (loop [acc #{id}]
(let [more (into acc (keep (fn [[gid g]] (when (acc (:parent g)) gid)) groups))]
(if (= more acc) acc (recur more))))
db' (-> db
(update-in [:marks :groups] #(apply dissoc % doomed))
(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')})))

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

@ -1,157 +0,0 @@
(ns tl.marks
"Pure mark resolution: a *mark* resolves to one or more timeline *spans*.
No re-frame, no DOM — REPL/test friendly. Canonical unit is FRAMES (see tl.otio).
Mark grammar (data, not a textual DSL):
ref :t0-c0 ; whole clip (or another mark-group) span
instant 1234 ; absolute timeline frame
[:at ref i] ; frame i within a clip; 0-based, -1 = last
range [p1 p2] ; p = absolute frame OR [:at ref i]
marks [mark ...] ; a mark-group's ordered list (an EDL / union)
A *span* is {:start :end :track :clip :instant?} in DISPLAY frames — i.e.
media/source frames (position within the .mov), matching :media-in and the
<video> clock, which is what the timeline view and playhead use. Absolute
frames in marks are interpreted in this same coordinate.")
(defn clip-index
"Map of clip-id keyword -> clip, enriched with its track's setup :name + :kind.
(tl.otio/parse keeps the setup name on the track, not the clip.)"
[timeline]
(into {} (for [t (:tracks timeline)
c (:clips t)]
[(keyword (:id c)) (assoc c :track (:name t) :kind (:kind t))])))
(defn- ref? [m] (or (keyword? m) (string? m)))
(defn- point
"Resolve a point to {:frame :clip}. p is an absolute frame or [:at ref i]."
[idx p]
(cond
(number? p) {:frame p :clip nil}
(and (vector? p) (= :at (first p)))
(let [[_ ref i] p
c (idx (keyword ref))]
(when-not c (throw (ex-info "unknown clip ref" {:ref ref})))
(when-not (number? i) (throw (ex-info "indexed point needs a frame index" {:point p})))
(let [local (if (neg? i) (+ (:duration c) i) i)] ; -1 => last frame
{:frame (+ (:media-in c) local) :clip c}))
:else (throw (ex-info "bad point" {:point p}))))
(defn- clip-span [c]
{:start (:media-in c)
:end (+ (:media-in c) (:duration c))
:track (:track c) :clip c :instant? false})
(declare resolve-marks)
(defn- resolve-mark [idx groups seen m]
(cond
;; ref -> a clip span, or recurse into another mark-group
(ref? m)
(let [k (keyword m)]
(cond
(idx k) [(clip-span (idx k))]
(groups k) (do (when (seen k)
(throw (ex-info "cycle in mark-groups" {:at k :seen seen})))
(resolve-marks idx groups (conj seen k) (:marks (groups k))))
:else (throw (ex-info "unknown ref" {:ref m}))))
;; instant: [:at ref i]
(and (vector? m) (= :at (first m)))
(let [{:keys [frame clip]} (point idx m)]
[{:start frame :end frame :track (:track clip) :clip clip :instant? true}])
;; range: [p1 p2]
(and (vector? m) (= 2 (count m)))
(let [a (point idx (first m))
b (point idx (second m))]
[{:start (:frame a) :end (:frame b)
:track (:track (:clip a)) :clip (:clip a) :instant? false}])
:else (throw (ex-info "bad mark" {:mark m}))))
(defn resolve-marks
"Resolve a vector of marks to a flat, ordered vector of spans."
[idx groups seen marks]
(vec (mapcat #(resolve-mark idx groups seen %) marks)))
(defn resolve-group
"Resolve mark-group `gid` (key into `groups`) against clip index `idx`."
[idx groups gid]
(resolve-marks idx groups #{gid} (:marks (groups gid))))
(defn anchor
"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))

58
tl/src/tl/md.cljs
View file

@ -1,58 +0,0 @@
(ns tl.md
"Tiny Markdown -> Hiccup. Handles the subset commentary needs: ATX headings
(#..######), unordered lists (- / *), paragraphs, and inline **bold**,
*italic*, `code`. No dependencies, no dangerouslySetInnerHTML."
(:require [clojure.string :as str]))
(def ^:private inline-re #"(`[^`]+`|\*\*[^*]+\*\*|\*[^*]+\*)")
(defn- inline
"Parse inline markers in a line into a seq of strings / hiccup elements."
[s]
(loop [s s, acc []]
(if-let [m (re-find inline-re s)]
(let [tok (if (vector? m) (first m) m)
i (str/index-of s tok)
before (subs s 0 i)
after (subs s (+ i (count tok)))
el (cond
(str/starts-with? tok "`") [:code (subs tok 1 (dec (count tok)))]
(str/starts-with? tok "**") [:strong (subs tok 2 (- (count tok) 2))]
:else [:em (subs tok 1 (dec (count tok)))])]
(recur after (conj acc before el)))
(conj acc s))))
(defn- flush-para [out para]
(if (seq para)
(conj out (into [:p] (inline (str/join " " para))))
out))
(defn render
"Markdown string -> a Hiccup [:div.md ...] tree (styled via the .md CSS rules)."
[md]
(loop [ls (str/split-lines (or md "")), out [], para []]
(if (empty? ls)
(into [:div.md] (flush-para out para))
(let [t (str/trim (first ls))]
(cond
(str/blank? t)
(recur (rest ls) (flush-para out para) [])
(re-find #"^#{1,6}\s" t)
(let [n (count (re-find #"^#+" t))
txt (str/replace t #"^#+\s*" "")
tag (keyword (str "h" (min n 6)))]
(recur (rest ls)
(conj (flush-para out para) (into [tag] (inline txt)))
[]))
(re-find #"^[-*]\s" t)
(let [[items more] (split-with #(re-find #"^\s*[-*]\s" %) ls)
lis (for [it items]
(into [:li] (inline (str/replace (str/trim it) #"^[-*]\s*" ""))))]
(recur more
(conj (flush-para out para) (into [:ul] lis))
[]))
:else
(recur (rest ls) out (conj para t)))))))

248
tl/src/tl/scene.cljs Normal file
View file

@ -0,0 +1,248 @@
(ns tl.scene
"The scene graph: a flat pool of mark-groups (the only non-mark-group thing is
:tracks). Everything here is pure — see data_model.org.
Conventions
- ranges are HALF-OPEN [start end); length = end - start.
- a point is either
<number> absolute: a frame in the mark's OWNING context
{:ref id :at n} relative: frame n of id's resolved range
(n>=0 from the start; n<0 from the end, -1 = the
exclusive end, -2 = last actual frame)
- a ref mark's :start and :end target the SAME id ⇒ exactly one segment;
an absolute mark may resolve to several (slice over its parent).
- resolve ⇒ ordered segments {:mark id :track t :src [a b] :local [c d]}."
(:refer-clojure :exclude [resolve]))
(defn- grp [scene gid] (get-in scene [:groups gid]))
(defn- find-mark
"[owning-gid mark] for a mark id anywhere in the scene, or nil."
[scene mid]
(some (fn [[gid g]]
(some (fn [m] (when (= mid (:id m)) [gid m])) (:marks g)))
(:groups scene)))
;; --- flat helpers over resolved segments ---------------------------------
(defn length [segs]
(if (seq segs) (-> segs last :local second) 0))
(defn local->source
"The source frame shown at local frame `lf` (clamped to the end)."
[segs lf]
(or (some (fn [{:keys [src local]}]
(let [[c d] local [a _] src]
(when (and (<= c lf) (< lf d)) (+ a (- lf c)))))
segs)
(when (seq segs) (-> segs last :src second))))
(defn source->local
"Local frame for source frame `sf` (first segment containing it), or nil."
[segs sf]
(some (fn [{:keys [src local]}]
(let [[a b] src [c _] local]
(when (and (<= a sf) (< sf b)) (+ c (- sf a)))))
segs))
(defn pieces
"Where source range [sa sb) lands in local coords: a list of [lo hi)."
[segs sa sb]
(vec (keep (fn [{:keys [src local]}]
(let [[a b] src [c _] local
lo (max sa a) hi (min sb b)]
(when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))])))
segs)))
(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)))
(defn tracks [segs] (into #{} (keep :track segs)))
;; --- resolution ----------------------------------------------------------
(declare resolve resolve-mark)
(defn- target-range
"Source [xs xe) + :track of a referenceable id (a clip/timeline group, or a
single-clip mark). Single-segment by the ref invariant; nil if unknown."
[scene id]
(let [segs (cond
(grp scene id) (resolve scene id)
(find-mark scene id) (let [[gid m] (find-mark scene id)]
(resolve-mark scene gid m))
:else nil)]
(when (seq segs)
{:xs (-> segs first :src first)
:xe (-> segs last :src second)
:track (-> segs first :track)})))
(defn- point-frame
"Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref
dangles."
[scene gid point]
(cond
(number? point)
(let [parent (:parent (grp scene gid))]
{:frame (if parent (local->source (resolve scene parent) point) point)
:track nil})
(map? point)
(when-let [{:keys [xs xe track]} (target-range scene (:ref point))]
(let [n (:at point)]
{:frame (if (neg? n) (+ xe n 1) (+ xs n)) :track track}))))
(defn resolve-mark
"One mark → its segment(s) (1 for a ref mark, 1+ for an absolute mark), with
:local 0-based within the mark. nil when a ref dangles."
[scene gid {:keys [id start end track]}]
(if (map? start) ; ref mark (same target both ends)
(let [a (point-frame scene gid start)
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)]}])))
(let [parent (:parent (grp scene gid))]
(if parent ; absolute, relative to parent
(let [sub (slice (resolve scene parent) start end)
base (or (some-> sub first :local first) 0)]
(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)]}]))))
(defn resolve
"A mark-group → its local timeline: ordered segments laid end to end. Broken
marks (dangling refs) are skipped."
[scene gid]
(loop [[m & more] (:marks (grp scene gid)), off 0, out []]
(if (nil? m)
out
(if-let [segs (seq (resolve-mark scene gid m))]
(let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs))
shifted (mapv (fn [s] (let [[c d] (:local s)]
(assoc s :local [(+ off c) (+ off d)])))
segs)]
(recur more (+ off len) (into out shifted)))
(recur more off out)))))
(defn broken-marks
"Mark ids in `gid` whose refs no longer resolve."
[scene gid]
(->> (:marks (grp scene gid))
(filterv (fn [m] (empty? (resolve-mark scene gid m))))
(mapv :id)))
;; --- what the current timeline is made of --------------------------------
(defn content-segments
"The clip-segments that make up context `ctx` — what you draw and select
against. An annotation's marks reference clips, so that's just `resolve`. The
root timeline doesn't enumerate its clips (they're a parentless pool), so
there it's the pool laid in root's identity coordinate (local = source)."
[scene ctx]
(if (= :timeline (:type (grp scene ctx)))
(->> (:groups scene)
(keep (fn [[gid g]]
(when (= :clip (:type g))
(let [seg (first (resolve scene gid))]
(assoc seg :mark gid :local (:src seg)))))) ; ref clip by group id
(sort-by (comp first :src))
vec)
(resolve scene ctx)))
;; --- editing: split a local selection into a run of single-clip marks -----
(defn selection->marks
"Split local range [la lb) of context `ctx` into a run of single-clip ref
marks, one per content segment it crosses (the 'no cross-clip marks' rule).
Each references the segment's source id with the right offsets."
[scene ctx la lb]
(mapv (fn [{:keys [mark src]}]
(let [{:keys [xs]} (target-range scene mark)
[a b] src]
{:id (random-uuid)
:start {:ref mark :at (- a xs)}
:end {:ref mark :at (- b xs)}}))
(slice (content-segments scene ctx) la lb)))
(defn reconcile-run
"Re-derive the run for selection [la lb), REUSING the id of any `old-run` mark
that targets the same segment — so resizing a selection keeps ids stable
(middle pieces untouched, boundary pieces edited in place), drops pieces that
fall out, and gives fresh ids to new ones. This is the merge/unmerge the
annotation editor needs; it never touches the model, just chooses ids."
[scene ctx old-run la lb]
(let [by-ref (into {} (map (juxt #(get-in % [:start :ref]) :id)) old-run)]
(mapv (fn [m] (if-let [id (by-ref (get-in m [:start :ref]))]
(assoc m :id id)
m))
(selection->marks scene ctx la lb))))
;; --- mark-time helpers for the two-input annotation editor ----------------
;; The editor works in MARK TIME — a 0-based frame within a VISIBLE content
;; segment — so it already accounts for the segment being trimmed by the parent
;; timeline (we ref the segment's own :mark, whose resolved length is the
;; segment's length). A clip selection start≠end expands, via selection->marks,
;; into a run of single-clip marks.
(defn seg-length
"Length (mark-time frames) of the content segment with :mark = `mid`, or nil."
[segs mid]
(some (fn [{m :mark [c d] :local}] (when (= m mid) (- d c))) segs))
(defn seg-local
"Local (context) frame for mark-time frame `f` within content segment `mid`."
[segs mid f]
(some (fn [{m :mark [c _] :local}] (when (= m mid) (+ c (or f 0)))) segs))
(defn- at->frame
"Normalise a ref's :at to a non-negative mark-time frame (resolves :at -1 etc.)."
[scene ref at]
(if (neg? at)
(let [{:keys [xs xe]} (target-range scene ref)] (+ (- xe xs) at 1))
at))
(defn marks->rows
"Render single-clip `marks` as editor rows (one {:s … :e …} per mark, frames
normalised to mark time). 1:1 with `marks`, so row i pairs with mark i."
[scene marks]
(mapv (fn [{:keys [start end]}]
{:s {:seg (:ref start) :f (at->frame scene (:ref start) (:at start))}
:e {:seg (:ref end) :f (at->frame scene (:ref end) (:at end))}})
marks))
;; --- tiny view-state helpers (per-context playhead) ----------------------
(defn playhead [view ctx] (get-in view [:playheads ctx] 0))
(defn set-playhead [view ctx lf] (assoc-in view [:playheads ctx] lf))
;; --- seeding from OTIO ----------------------------------------------------
(defn from-otio
"Seed a scene from tl.otio/parse output: a video :track per source track, one
clip mark-group per clip (source range + track), and the root timeline. The
otio is only a seed — nothing here reads it again."
[{:keys [duration tracks]}]
(let [vtracks (filter #(= :video (:kind %)) tracks)
track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks)
clips (into {} (for [t vtracks c (:clips t)]
[(keyword (:id c))
{:type :clip :parent nil :name (:name c)
:marks [{:id (keyword (str (:id c) "-m"))
:start (:media-in c)
:end (+ (:media-in c) (:duration c))
:track (keyword (str "t" (:index t)))}]}]))]
{:tracks track-map
:groups (assoc clips :root {:type :timeline :parent nil
:marks [{:id :root-m :start 0 :end duration}]})}))
(defn clip-name [scene gid] (:name (grp scene gid)))

23
tl/src/tl/storage.cljs
View file

@ -1,16 +1,21 @@
(ns tl.storage (ns tl.storage
"Persist the user's mark-groups to localStorage as EDN. The OTIO-derived clips "Persist the authored annotation layer to localStorage as EDN. The OTIO-derived
are NOT stored — only the authored annotation layer (:marks)." tracks/clips/root are NOT stored — only annotation mark-groups (never drafts)."
(:require [cljs.reader :as reader])) (:require [cljs.reader :as reader]))
(def ^:private k "tl/marks") (def ^:private k "tl/annotations")
(defn load-marks (defn annotations
"Read the saved :marks map, or nil if absent/corrupt." "The non-draft annotation groups of a scene, as a {gid group} map."
[scene]
(into {} (filter (fn [[_ g]] (and (= :annotation (:type g)) (not (:draft g))))
(:groups scene))))
(defn load
"The saved {gid group} map, or nil if absent/corrupt."
[] []
(when-let [s (.getItem js/localStorage k)] (when-let [s (.getItem js/localStorage k)]
(try (reader/read-string s) (try (reader/read-string s) (catch :default _ nil))))
(catch :default _ nil))))
(defn save-marks! [marks] (defn save! [scene]
(.setItem js/localStorage k (pr-str marks))) (.setItem js/localStorage k (pr-str (annotations scene))))

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

@ -1,138 +1,82 @@
(ns tl.subs (ns tl.subs
(:require (:require [re-frame.core :as rf]
[re-frame.core :as rf] [tl.scene :as scene]))
[tl.marks :as marks]))
(rf/reg-sub ::load-status (fn [db] (get-in db [:load :status]))) (rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
(rf/reg-sub ::playing? (fn [db] (get-in db [:view :playing?])))
(rf/reg-sub ::pt (fn [db] (get-in db [:view :pt])))
(rf/reg-sub ::fps (fn [db] (:fps db)))
(rf/reg-sub ::scene (fn [db] (:scene db)))
(rf/reg-sub ::zoom (fn [db] (get-in db [:view :zoom])))
(rf/reg-sub ::row-h (fn [db] (get-in db [:view :row-h])))
(rf/reg-sub ::stack (fn [db] (get-in db [:view :stack])))
(rf/reg-sub ::timeline (fn [db] (:timeline db))) (rf/reg-sub ::context :<- [::stack] (fn [stack _] (peek stack)))
(rf/reg-sub ::fps :<- [::timeline] (fn [t] (:fps t)))
(rf/reg-sub ::duration :<- [::timeline] (fn [t] (:duration t)))
(rf/reg-sub ::tracks :<- [::timeline] (fn [t] (:tracks t)))
;; --- authoring draft ----------------------------------------------------- ;; the annotation group currently being authored/edited (the one flagged :draft),
(rf/reg-sub ::draft (fn [db] (:draft db))) ;; with its group id merged in as :gid
(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])))
(rf/reg-sub ::timeline-stack (fn [db] (get-in db [:marks :timeline-stack])))
(rf/reg-sub ::clip-index :<- [::timeline] (fn [t] (when t (marks/clip-index t))))
;; Flat catalog of clips for the authoring autocomplete: one entry per clip,
;; with its setup name + 0-based occurrence within that setup, ordered by time.
(rf/reg-sub (rf/reg-sub
::clip-catalog ::draft-group
:<- [::clip-index] :<- [::scene]
(fn [idx _] (fn [scene _] (some (fn [[gid g]] (when (:draft g) (assoc g :gid gid))) (:groups scene))))
(when idx
(->> (vals idx) ;; the current timeline laid out: ordered clip-segments {:mark :track :src :local}
(group-by :track) (rf/reg-sub
(mapcat (fn [[setup clips]] ::segments
(map-indexed (fn [occ c] :<- [::scene] :<- [::context]
{:clip-id (keyword (:id c)) :setup setup (fn [[scene ctx] _] (when ctx (scene/content-segments scene ctx))))
:occ occ :start (:media-in c)})
(sort-by :media-in clips)))) (rf/reg-sub ::length :<- [::segments] (fn [segs _] (scene/length segs)))
;; tracks present in the current view, in track order, with names
(rf/reg-sub
::tracks
:<- [::scene] :<- [::segments]
(fn [[scene segs] _]
(let [present (scene/tracks segs)]
(->> (:tracks scene)
(filter (fn [[tid _]] (contains? present tid)))
(sort-by (fn [[tid _]] (js/parseInt (subs (name tid) 1) 10))) ; t2 before t10
(mapv (fn [[tid t]] {:id tid :name (:name t)}))))))
;; playhead (local frame) for the current context
(rf/reg-sub
::playhead
(fn [db _] (scene/playhead (:view db) (peek (get-in db [:view :stack])))))
;; breadcrumb trail of the stack
(rf/reg-sub
::breadcrumbs
:<- [::scene] :<- [::stack]
(fn [[scene stack] _]
(mapv (fn [gid] {:id gid :name (or (get-in scene [:groups gid :name]) (name gid))}) stack)))
;; child annotations of the current context, with their bars in local coords
(rf/reg-sub
::annotations
:<- [::scene] :<- [::context] :<- [::segments]
(fn [[scene ctx segs] _]
(let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g)))
(:groups scene)))]
(->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (= ctx (:parent g)))
(let [src-segs (scene/resolve scene gid)
bars (vec (mapcat (fn [{[a b] :src}] (scene/pieces segs a b)) src-segs))]
{:id gid :name (:name g) :color (or (:color g) "#4e8fc2")
:content (:content g) :children (count (:marks g))
:nested (get nested gid 0)
:draft (boolean (:draft g))
:start (or (ffirst bars) 0) :bars bars}))))
(sort-by :start) (sort-by :start)
vec)))) vec))))
;; The current context = top of the timeline-stack. :root is the main timeline; ;; the annotation the playhead is currently inside (or the latest one passed) —
;; otherwise it's the annotation whose nested timeline we're expanded into. ;; drives the rolling highlight/scroll in the commentary
(rf/reg-sub
::context-id
:<- [::timeline-stack]
(fn [stack _] (or (last stack) :root)))
;; Annotations surfaced right now: those whose :parent is the current context.
;; (A missing :parent means top-level, i.e. :root — keeps old saved data valid.)
;; Each is enriched with how many children it has, so the UI can flag/expand it.
(rf/reg-sub
::annotations
:<- [::groups] :<- [::clip-index] :<- [::context-id]
(fn [[groups idx ctx] _]
(when idx
(let [anns (filter (fn [[_ g]] (= :annotation (:type g))) groups)
child-count (frequencies (keep (fn [[_ g]] (:parent g :root)) anns))]
(->> anns
(filter (fn [[_ g]] (= ctx (:parent g :root))))
(map (fn [[gid g]]
(let [spans (marks/resolve-group idx groups gid)]
{:id gid :name (:name g) :content (:content g) :color (:color g)
:marks (:marks g) :children (get child-count gid 0)
:created (:created g 0) ; definition order
:spans spans :anchor (marks/anchor spans)
:end (when (seq spans) (reduce max (map :end spans)))
:instant? (every? :instant? spans)})))
;; pane order: by start, then longest first (sections lead a tie)
(sort-by (juxt #(or (:anchor %) 0) #(- (or (:end %) 0))))
vec)))))
;; Breadcrumb trail for the stack: root + each expanded annotation's name.
(rf/reg-sub
::breadcrumbs
:<- [::groups] :<- [::timeline-stack]
(fn [[groups stack] _]
(mapv (fn [gid] {:id gid :name (:name (groups gid) (name gid))}) stack)))
;; 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
::context-spans
:<- [::groups] :<- [::clip-index] :<- [::context-id]
(fn [[groups idx ctx] _]
(when (and idx (not= :root ctx) (groups ctx))
(not-empty (marks/resolve-group idx groups ctx)))))
;; 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-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.
(rf/reg-sub (rf/reg-sub
::active-annotation ::active-annotation
:<- [::annotations] :<- [::playhead] :<- [::annotations] :<- [::playhead]
(fn [[anns ph] _] (fn [[anns ph] _]
(:id (or (last (filter #(<= (:anchor %) ph) anns)) (:id (or (some (fn [a] (when (some (fn [[lo hi]] (<= lo ph hi)) (:bars a)) a)) anns)
(last (filter #(<= (:start %) ph) anns))
(first anns))))) (first anns)))))
;; --- 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
;; 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 ::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

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

@ -4,441 +4,336 @@
[reagent.core :as r] [reagent.core :as r]
[re-frame.core :as rf] [re-frame.core :as rf]
[tl.subs :as subs] [tl.subs :as subs]
[tl.marks :as marks] [tl.scene :as scene]
[tl.md :as md]
[tl.events :as events])) [tl.events :as events]))
;; Served by dev/media_server.py (range-capable) rather than shadow's :dev-http,
;; which doesn't do byte-range serving — Safari/iOS won't play <video> without it.
;; Host-relative so it works over localhost and Tailscale alike.
(def media-src (def media-src
(str (.. js/window -location -protocol) "//" (str (.. js/window -location -protocol) "//"
(.. js/window -location -hostname) ":8281/challengers_480p.mp4")) (.. js/window -location -hostname) ":8281/challengers_480p.mp4"))
(defonce video-el (atom nil))
(defonce raf (atom nil))
(defonce scroll-el (atom nil)) (defonce scroll-el (atom nil))
(defonce play (atom nil)) ; {:ctx :segs :fps :idx} while playing, else nil
(defn- secs [frames fps] (/ frames fps)) (defn- px [local fps zoom] (* (/ local fps) zoom))
(defn- tc ;; --- playback: the VIDEO is the clock ------------------------------------
"frames -> m:ss timecode string." ;; Play it; a rAF reads currentTime and maps it into the current context's local
[frames fps] ;; timeline (::tick). Moving the playhead (jump/scrub) just seeks the video.
(let [s (/ frames fps)
m (js/Math.floor (/ s 60))
sec (js/Math.floor (mod s 60))]
(str m ":" (when (< sec 10) "0") sec)))
(defn- local-x (defn- seek-video! [fps source-frame]
"Pixel x for a media frame in the current mark-group's local timeline." (when (and @video-el source-frame)
[spans fps zoom mf] (set! (.-currentTime @video-el) (/ source-frame fps))))
(* (secs (or (marks/media->group spans mf) 0) fps) zoom))
(defn- center-on-playhead! (defn- seg-at
"Scroll the timeline so `playhead` (a media frame) sits at the horizontal "Index of the segment whose local range contains `local` (0 if none)."
centre, in the current mark-group's local coordinates." [segs local]
[fps zoom spans playhead] (or (first (keep-indexed (fn [i {[c d] :local}] (when (<= c local d) i)) segs)) 0))
(when-let [el @scroll-el]
(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))))
(defn- jump-and-scroll! (defn- stop-play! []
"Move the playhead cursor to media frame `frame` and scroll it into view." (when @raf (js/cancelAnimationFrame @raf) (reset! raf nil))
[_fps frame] (reset! play nil)
(rf/dispatch [::events/set-playhead frame]) (when-let [v @video-el] (.pause v))
(center-on-playhead! (or @(rf/subscribe [::subs/fps]) (/ 24000 1001)) (rf/dispatch [::events/set-playing false]))
(or @(rf/subscribe [::subs/zoom]) 50)
@(rf/subscribe [::subs/view-spans]) frame))
;; --- authoring draft (in app-db at :draft; nil = closed) ----------------- (defn- play-tick []
;; A point is {:text "..."} (a typed frame) or {:clip <id> :setup <s> :occ <n> (when-let [{:keys [ctx segs fps idx]} @play]
;; :frame <n>} (a chosen clip). A row is {:a <point> :b <point>}; b empty => an (let [v @video-el
;; instant, b filled => a range. sf (* (.-currentTime v) fps)
{[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]))
(stop-play!))
(rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))])))
(when @play (reset! raf (js/requestAnimationFrame play-tick)))))
(defn- blank-row [] {:a {:text ""} :b {:text ""}}) (defn- start-play! []
(defn- blank-draft [] (let [ctx @(rf/subscribe [::subs/context])
{:name "" :content "" :color "#4e8fc2" :rows [(blank-row)] :active [:rows 0 :a]}) segs @(rf/subscribe [::subs/segments])
fps @(rf/subscribe [::subs/fps])
ph @(rf/subscribe [::subs/playhead])]
(when (and @video-el (seq segs))
(let [idx (seg-at segs ph)
{[ss _] :src [ls _] :local} (nth segs idx)]
(reset! play {:ctx ctx :segs segs :fps fps :idx idx})
(seek-video! fps (+ ss (- ph ls))) ; start from the playhead's source
(.play @video-el)
(rf/dispatch [::events/set-playing true])
(reset! raf (js/requestAnimationFrame play-tick))))))
(defn- insert-clip! (defn- toggle-play! [] (if @play (stop-play!) (start-play!)))
"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]
(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- goto! [local]
(defn- clip-point [cat clip frame] "Move the playhead to local frame `local` and seek the video to match."
(let [{:keys [setup occ]} (some #(when (= clip (:clip-id %)) %) cat)] (let [ctx @(rf/subscribe [::subs/context])
{:clip clip :setup setup :occ occ :frame frame})) segs @(rf/subscribe [::subs/segments])
fps @(rf/subscribe [::subs/fps])]
(rf/dispatch [::events/set-playhead ctx local])
(seek-video! fps (scene/local->source segs local))
(when @play (swap! play assoc :idx (seg-at segs local))))) ; keep playback in sync
(defn- mp->point [cat mp] (defn video-monitor []
(cond [:video {:src media-src :controls true :preload "auto"
(number? mp) {:text (str mp)} :plays-inline true :webkit-playsinline "true"
(and (vector? mp) (= :at (first mp))) (clip-point cat (second mp) (nth mp 2)) :ref (fn [n] (when n (reset! video-el n)))}])
:else {:text ""}))
(defn- mark->row [cat m] (defn- clip-label
(cond "“<video track> <clip name>” for the content segment whose :mark is `mid`."
(number? m) {:a {:text (str m)} :b {:text ""}} [scene segs mid]
(keyword? m) {:a (clip-point cat m 0) :b (clip-point cat m -1)} ; whole-clip ref (let [tname (some (fn [{m :mark t :track}] (when (= m mid) (get-in scene [:tracks t :name]))) segs)
(and (vector? m) (= :at (first m))) {:a (mp->point cat m) :b {:text ""}} ; instant cname (or (scene/clip-name scene mid) "clip")]
(and (vector? m) (= 2 (count m))) {:a (mp->point cat (first m)) ; range (if tname (str tname " " cname) cname)))
:b (mp->point cat (second m))}
:else {:a {:text ""} :b {:text ""}}))
(defn- edit-draft [cat id {:keys [name content color marks]}] (defn frame-readout
{:id id :name name :content (or content "") :color (or color "#4e8fc2") "Bottom-right of the video: the timeline (context-absolute) frame, and the
:rows (mapv #(mark->row cat %) marks) :active [:rows 0 :a]}) track + clip + mark-time frame under the playhead. While authoring, the clip
readout is clickable to fill an endpoint at that exact frame."
;; forward: editor row -> a mark (for save + the live timeline preview)
(defn- point->mp
"Point editor -> a mark point: a frame number, or [:at clip frame], or nil."
[{:keys [clip frame text]}]
(cond
clip [:at clip (or frame 0)]
(and text (re-matches #"\s*-?\d+\s*" text)) (js/parseInt (str/trim text))
:else nil))
(defn- row->mark [{:keys [a b]}]
(let [pa (point->mp a) pb (point->mp b)]
(cond (and pa pb) [pa pb] ; range
pa pa ; instant
:else nil)))
(defn video-monitor
"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 ---------------------------------------------------
(defn- jump-targets
"One jump option per span: {:frame :label}, label = setup name · timecode."
[fps nm spans]
(for [s spans]
{:frame (:start s)
:label (str (or (:track (:clip s)) nm) " · " (tc (:start s) fps))}))
(defn- place-popover!
"Anchor a native popover under its trigger button, in viewport coords (so it
tracks the commentary's scroll). anchor() CSS misbehaves inside a scroll box."
[pop]
(when-let [btn (.querySelector js/document (str "[popovertarget='" (.-id pop) "']"))]
(let [r (.getBoundingClientRect btn)]
(set! (.. pop -style -top) (str (+ (.-bottom r) 4) "px"))
(set! (.. pop -style -right) (str (- (.-innerWidth js/window) (.-right r)) "px"))
(set! (.. pop -style -left) "auto"))))
(defn- position-popover-ref
"Ref for a .jump-pop: position it just before it opens (beforetoggle fires
pre-paint, so there's no flash from the default position)."
[node]
(when node
(.addEventListener node "beforetoggle"
(fn [e] (when (= "open" (.-newState e)) (place-popover! node))))))
(defn commentary
"Markdown commentary. Each annotation is a block anchored to its start frame;
the active one is highlighted and scrolled into view. A jump button seeks to
the annotation's start — or opens a popover of starts if it has several."
[] []
(let [el (atom nil)] ; scroll container (no reactivity needed) (let [ph @(rf/subscribe [::subs/playhead])
segs @(rf/subscribe [::subs/segments])
scene @(rf/subscribe [::subs/scene])
auth? (some? @(rf/subscribe [::subs/draft-group]))
seg (some (fn [{[c d] :local :as s}] (when (<= c ph d) s)) segs)
cf (when seg (js/Math.round (- ph (first (:local seg)))))]
[:div.frame-readout
[:span.fr-abs (str (js/Math.round ph) "f")]
(when seg
[:span.fr-clip {:class (when auth? "clickable")
:title (when auth? "Click to set endpoint at this frame")
:on-click (when auth?
#(rf/dispatch [::events/draft-click-seg (:mark seg) cf]))}
(str (clip-label scene segs (:mark seg)) " " cf "f")])]))
;; --- timeline -------------------------------------------------------------
(defn- scrub! [content fps zoom ev]
(.preventDefault ev)
(let [to (fn [clientX]
(let [x (- clientX (.-left (.getBoundingClientRect content)))]
(goto! (max 0 (* (/ x zoom) fps)))))
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- follow! [fps zoom playhead]
(when-let [el @scroll-el]
(let [x (px playhead fps zoom)]
(set! (.-scrollLeft el) (max 0 (- x (/ (.-clientWidth el) 2)))))))
(defn timeline []
(let [content (atom nil)]
(fn []
(let [scene @(rf/subscribe [::subs/scene])
fps @(rf/subscribe [::subs/fps])
zoom @(rf/subscribe [::subs/zoom])
row-h @(rf/subscribe [::subs/row-h])
segs @(rf/subscribe [::subs/segments])
tracks @(rf/subscribe [::subs/tracks])
anns @(rf/subscribe [::subs/annotations])
playhead @(rf/subscribe [::subs/playhead])
playing? @(rf/subscribe [::subs/playing?])
authoring? (some? @(rf/subscribe [::subs/draft-group]))
len @(rf/subscribe [::subs/length])
width (px len fps zoom)
lane-h (* 18 (count anns))
track-y (into {} (map-indexed (fn [i t] [(:id t) i]) tracks))]
(when playing? (r/after-render #(follow! fps zoom playhead)))
[:div.timeline
[:div.gutter
[:div {:style {:height lane-h}}]
(for [t tracks]
^{:key (:id t)}
[:div.gutter-label {:style {:height row-h :line-height (str (dec row-h) "px")}}
(:name t)])]
[:div.hscroll {:ref (fn [n] (reset! scroll-el n))}
[:div.content {:ref (fn [n] (reset! content n))
:on-mouse-down #(scrub! @content fps zoom %)
:style {:width width :height (+ lane-h (* row-h (count tracks)))}}
[:div.playhead {:style {:left (px playhead fps zoom)}} [:div.playhead-handle]]
;; annotation bars — solid for saved, dashed for the in-progress draft
(for [[i a] (map-indexed vector anns)
[j [lo hi]] (map-indexed vector (:bars a))]
^{:key (str (:id a) "-" j)}
[:div.ann-bar {:title (:name a)
:on-mouse-down (when-not (:draft a)
(fn [e] (.stopPropagation e)
(rf/dispatch [::events/expand (:id a)])))
:style {:position "absolute" :top (+ 2 (* i 18)) :height 14
:left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom))
:background (str (:color a) (if (:draft a) "44" "cc"))
:cursor (if (:draft a) "default" "pointer")
:border-radius 2
:border (str (if (:draft a) "1px dashed " "1px solid ") (:color a))}}])
(for [[i a] (map-indexed vector anns) :let [[lo _] (first (:bars a))] :when lo]
^{:key (str "lbl-" (:id a))}
[:div.ann-bar-label {:style {:position "absolute" :top (* i 18)
:left (+ 4 (px lo fps zoom))}} (:name a)])
;; clips (while authoring, click to fill the focused endpoint)
(for [{:keys [mark track src local] :as seg} segs]
(let [[c d] local]
^{:key (str mark "-" (first src))}
[:div.clip {:class (when authoring? "clickable")
:on-mouse-down (when authoring?
(fn [e] (.stopPropagation e) (.preventDefault e)
(rf/dispatch [::events/draft-click-seg (:mark seg)])))
:style {:left (px c fps zoom) :width (max 1 (px (- d c) fps zoom))
:top (+ lane-h (* (get track-y track 0) row-h)) :height (- row-h 2)
:line-height (str (- row-h 2) "px") :position "absolute"}}
(scene/clip-name scene mark)]))]]]))))
;; --- annotation list (commentary) + authoring ----------------------------
(defn- jump-control
"One jump button, or — when the annotation's marks have discontinuities (more
than one bar) — a button that opens a popover of one target per piece."
[open a]
(let [bars (:bars a)]
(if (< (count bars) 2)
[:button.jump-btn {:on-click #(goto! (:start a))} "↪ jump"]
[:span {:style {:position "relative"}}
[:button.jump-btn {:on-click #(swap! open (fn [x] (when (not= x (:id a)) (:id a))))}
(str "↪ jump (" (count bars) ") ▾")]
(when (= @open (:id a))
[:div.jump-pop
(for [[i [lo _]] (map-indexed vector bars)]
^{:key i}
[:button {:on-click #(do (goto! lo) (reset! open nil))}
(str "▸ part " (inc i) " · " (js/Math.round lo) "f")])])])))
(defn commentary []
(let [el (atom nil) open (r/atom nil)]
(fn [] (fn []
(let [anns @(rf/subscribe [::subs/annotations]) (let [anns @(rf/subscribe [::subs/annotations])
active @(rf/subscribe [::subs/active-annotation]) scene @(rf/subscribe [::subs/scene])
fps @(rf/subscribe [::subs/fps])] active @(rf/subscribe [::subs/active-annotation])]
(r/after-render (r/after-render
(fn [] (fn [] (when-let [c @el]
(when-let [c @el] (when-let [node (and active (.querySelector c (str "#ann-" (name active))))]
(when-let [node (and active (.querySelector c (str "#ann-" (name active))))] (set! (.-scrollTop c) (max 0 (- (.-offsetTop node) (/ (.-clientHeight c) 3))))))))
(set! (.-scrollTop c) (max 0 (- (.-offsetTop node) (/ (.-clientHeight c) 3))))))))
[:div.commentary {:ref (fn [n] (reset! el n))} [:div.commentary {:ref (fn [n] (reset! el n))}
[:div.commentary-head [:div.commentary-head
[:button.add-btn {:on-click #(rf/dispatch [::events/open-draft (blank-draft)])} [:button.add-btn {:on-click #(rf/dispatch [::events/open-draft])}
"＋ Add annotation"]] "＋ Add annotation"]]
(if (seq anns) (if (seq anns)
(doall (doall
(for [{:keys [id content spans children] nm :name :as ann} anns] (for [a anns]
(let [targets (vec (jump-targets fps nm spans)) ^{:key (:id a)}
one? (= 1 (count targets))] [:div.ann {:id (str "ann-" (name (:id a))) :class (when (= (:id a) active) "active")}
^{:key id} [:div.ann-head
[:div.ann {:id (str "ann-" (name id)) [:div.ann-title (:name a)]
:class (when (= id active) "active")} [:div.ann-actions
[:div.ann-head [jump-control open a]
[:div.ann-title nm] [:button.expand-btn {:title "Expand" :on-click #(rf/dispatch [::events/expand (:id a)])}
[:div.ann-actions "⤢" (when (pos? (:nested a)) [:span.nest-badge (:nested a)])]
(if one? [:button.edit-btn {:title "Edit"
[:button.jump-btn :on-click #(rf/dispatch [::events/edit-draft (:id a)])}
{:on-click #(jump-and-scroll! fps (:frame (first targets)))} "↪ jump"] "✎"]
;; native popover: the button toggles it; the browser [:button.del-btn {:title "Delete"
;; handles light-dismiss + Escape + top-layer. Positioning is :on-click #(when (js/confirm (str "Delete \"" (:name a) "\"?"))
;; the one bit of JS (anchor() misbehaves in a scroll box). (rf/dispatch [::events/delete-annotation (:id a)]))}
[:button.jump-btn {:popovertarget (str "jp-" (name id))} "✕"]]]
(str "↪ jump (" (count targets) ")")]) (when (not-empty (:content a)) [:div.md (:content a)])]))
[:button.expand-btn [:div.ann-empty "No annotations here."])]))))
{:title (if (pos? children)
(str "Expand — " children " nested")
"Expand into a nested timeline")
:class (when (pos? children) "has-children")
:on-click #(rf/dispatch [::events/expand-annotation id])}
(if (pos? children) (str "⤢ " children) "⤢")]
[:button.edit-btn
{:title "Edit annotation"
:on-click #(rf/dispatch [::events/open-draft
(edit-draft @(rf/subscribe [::subs/clip-catalog]) id ann)])}
"✎"]
[:button.del-btn {:title "Delete annotation"
:on-click #(when (js/confirm (str "Delete \"" nm "\"?"))
(rf/dispatch [::events/delete-annotation id]))}
"✕"]]]
(when-not one?
[:div.jump-pop {:popover "auto" :id (str "jp-" (name id))
:ref position-popover-ref}
(for [[k t] (map-indexed vector targets)]
^{:key k}
[:button {:popovertarget (str "jp-" (name id))
:popovertargetaction "hide"
:on-click #(jump-and-scroll! fps (:frame t))}
(:label t)])])
[md/render content]])))
[:div.ann-empty "No annotations."])]))))
;; --- timeline ------------------------------------------------------------- (defn- to-frame [v len]
;; The timeline's rendering controller — data subscriptions, coordinate (let [n (js/parseInt v 10)] (-> (if (js/isNaN n) 0 n) (max 0) (min len))))
;; 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 timeline (defn- frame-chip
"Static element shell: the structural markup (gutter / hscroll / content / "A filled endpoint: clip name + a mark-time frame input (edits `put` the group)."
playhead / annotation lane / track rows / clips) with placeholder content and [scene segs put d i k {:keys [seg f]}]
no controller logic. Rebuild the data->geometry + interaction on top of this." (let [len (scene/seg-length segs seg)]
[] [:div.pt-chip
[:div.timeline [:span.pt-chip-name (clip-label scene segs seg)]
[:div.gutter [:input.pt-frame {:type "number" :min 0 :max len :value f
[:div {:style {:height 18}}] ; lane spacer :on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}]
[:div.gutter-label {:style {:height 28 :line-height "27px"}} "Track"] [:span.pt-dur (str "/" len)]]))
[: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 -------------------------------------------------- (defn annotation-form []
(r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid)]
(let [d @(rf/subscribe [::subs/draft-group])
scene @(rf/subscribe [::subs/scene])
segs @(rf/subscribe [::subs/segments])
pt @(rf/subscribe [::subs/pt])
gid (:gid d)
new? (= :new (:draft d))
put (fn [g] (rf/dispatch [::events/put-group gid (dissoc g :gid)]))
rows (scene/marks->rows scene (:marks d))]
[:div.form
[:div.form-head (if new? "New annotation" "Edit annotation")]
[:div.form-row
[:input.form-name {:placeholder "Name" :value (:name d)
:on-change #(put (assoc d :name (.. % -target -value)))}]
[:input.form-color {:type "color" :value (:color d)
:on-change #(put (assoc d :color (.. % -target -value)))}]]
[:textarea.form-content {:placeholder "Content (optional)" :value (:content d)
:on-change #(put (assoc d :content (.. % -target -value)))}]
[:div.form-marks-label "Marks"]
(doall
(for [[i row] (map-indexed vector rows)]
^{:key i}
[:div.mark-row
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
[frame-chip scene segs put d i :end (:e row)]
[:button.row-x {:title "Remove"
:on-click #(put (update d :marks (fn [ms] (vec (concat (subvec ms 0 i) (subvec ms (inc i)))))))} "✕"]]))
(when (map? pt)
[:div.mark-row
[:div.pt-chip [:span.pt-chip-name (clip-label scene segs (:seg pt))]]
[:span.mark-arrow "→"] [:div.pt-input.active [:div.pt-text "click end clip…"]]])
(when (= pt :new)
[:div.mark-row [:div.pt-input.active [:div.pt-text "click a clip…"]]])
[:div.form-hint "Click a clip in the timeline to set a start, then a clip for the end."]
[:div.form-actions
[:button.save {:disabled (or (str/blank? (:name d)) (empty? (:marks d)))
:on-click #(put (dissoc d :draft))} "Save"]
[:button.cancel {:on-click #(if new? (rf/dispatch [::events/drop-group gid]) (put orig))} "Cancel"]]])))
(defn- slider [label v lo hi on] ;; --- chrome ---------------------------------------------------------------
[:label.slider label
[:input {:type "range" :min lo :max hi :value v
:on-change #(on (js/parseFloat (.. % -target -value)))}]])
(defn- zoom-x! [z1] (rf/dispatch [::events/set-zoom z1])) (defn breadcrumbs []
(defn breadcrumbs
"Trail of the expanded-timeline stack. Only shown when nested. The back button
pops one level; clicking a crumb jumps straight back to it. Either way the
main timeline is fully restored."
[]
(let [crumbs @(rf/subscribe [::subs/breadcrumbs])] (let [crumbs @(rf/subscribe [::subs/breadcrumbs])]
(when (> (count crumbs) 1) (when (> (count crumbs) 1)
[:div.crumbs [:div.crumbs
[:button.back-btn {:title "Back one level" :on-click #(rf/dispatch [::events/collapse])} [:button.back-btn {:on-click #(rf/dispatch [::events/collapse])} "← back"]
"← back"] (for [[i {:keys [id name]}] (map-indexed vector crumbs)]
(doall (let [last? (= i (dec (count crumbs)))]
(for [[i {:keys [id name]}] (map-indexed vector crumbs)] ^{:key id}
(let [last? (= i (dec (count crumbs)))] [:span.crumb-item
^{:key id} (when (pos? i) [:span.crumb-sep "›"])
[:span.crumb-item [:button.crumb {:class (when last? "current") :disabled last?
(when (pos? i) [:span.crumb-sep "›"]) :on-click #(rf/dispatch [::events/pop-to id])} name]]))])))
[:button.crumb {:class (when last? "current") :disabled last?
:on-click #(rf/dispatch [::events/pop-to id])}
name]])))])))
(defn zoom-controls [] (defn toolbar []
(let [zoom @(rf/subscribe [::subs/zoom]) (let [zoom @(rf/subscribe [::subs/zoom]) row-h @(rf/subscribe [::subs/row-h])
row-h @(rf/subscribe [::subs/row-h])] playing? @(rf/subscribe [::subs/playing?])]
[:div.toolbar [:div.toolbar
;; transport buttons kept as UI; handlers belong to the playback layer (rebuild) [:button.play-btn {:on-click toggle-play! :title "Play / pause"} (if playing? "⏸" "▶")]
[:div.transport [:label.slider "Zoom X"
[:button.step-btn {:title "Previous frame"} "|◀"] [:input {:type "range" :min 2 :max 400 :value zoom
[:button.play-btn {:title "Play / pause"} "▶"] :on-change #(rf/dispatch [::events/set-zoom (js/parseFloat (.. % -target -value))])}]]
[:button.step-btn {:title "Next frame"} "▶|"]] [:label.slider "Zoom Y"
[slider "Zoom X" zoom 2 400 zoom-x!] [:input {:type "range" :min 8 :max 120 :value row-h
[slider "Zoom Y" row-h 8 120 #(rf/dispatch [::events/set-row-h %])]])) :on-change #(rf/dispatch [::events/set-row-h (js/parseFloat (.. % -target -value))])}]]]))
(defn- begin-resize!
"Drag a divider: dispatches `evt` with the new size as a relative percent,
clamped to [lo hi]. :x = % of the row width; :y = vh from the top."
[axis evt lo hi ev]
(.preventDefault ev)
(let [container (.. ev -currentTarget -parentNode) ; the .top row (for :x)
move (fn [e]
(let [pct (if (= axis :x)
(let [r (.getBoundingClientRect container)]
(* 100 (/ (- (.-clientX e) (.-left r)) (.-width r))))
(* 100 (/ (.-clientY e) (.-innerHeight js/window))))
n (-> pct (max lo) (min hi))]
(rf/dispatch-sync [evt n])))
up (fn up [_]
(.removeEventListener js/document "pointermove" move)
(.removeEventListener js/document "pointerup" up))]
;; pointer events so it works for touch (mouse events don't fire on touch)
(.addEventListener js/document "pointermove" move)
(.addEventListener js/document "pointerup" up)))
;; --- authoring form -------------------------------------------------------
(defn- suggestions [catalog text fps]
(let [t (str/trim (or text ""))]
(cond
(re-matches #"-?\d+" t)
[{:type :frame :frame (js/parseInt t) :label (str "Frame " t " · " (tc (js/parseInt t) fps))}]
(seq t)
(->> catalog
(filter #(str/includes? (str/lower-case (:setup %)) (str/lower-case t)))
(map #(assoc % :type :clip
:label (str (:setup %) " [" (:occ %) "] · " (tc (:start %) fps))))
(take 40) vec)
:else [])))
(defn point-input
"A point editor: text input with autocomplete (frame or clip), or — once a
clip is chosen — a chip + a frame field. `path` is the path into :draft for
this point; the value lives in re-frame (the highlighted-row index is the only
local, ephemeral bit)."
[path _placeholder]
(let [hi (r/atom 0)] ; ephemeral: autocomplete highlight
(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 {: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)])
[:button.pt-x {:title "clear" :on-click #(set-point! {:text ""})} "×"]])
(let [text (:text p "")
sugg (suggestions @(rf/subscribe [::subs/clip-catalog]) text fps)
preview! (fn [] (let [s (nth sugg @hi nil)]
(when (= :clip (:type s)) (jump-and-scroll! fps (:start s)))))
pick (fn [i] (when-let [s (nth sugg i nil)]
(set-point! (case (:type s)
:frame {:text (str (:frame s))}
:clip {:clip (:clip-id s) :setup (:setup s)
:occ (:occ s) :frame 0}))))]
[: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)
"ArrowDown" (do (.preventDefault e)
(swap! hi #(min (max 0 (dec (count sugg))) (inc %)))
(preview!))
"ArrowUp" (do (.preventDefault e)
(swap! hi #(max 0 (dec %)))
(preview!))
"Enter" (do (.preventDefault e) (pick @hi))
nil))
:on-blur #(when (seq sugg) (pick @hi))}]
(when (seq sugg)
[:ul.pt-dropdown
(doall
(map-indexed
(fn [i s] ^{:key i}
[:li {:class (when (= i @hi) "hi")
:on-mouse-enter #(reset! hi i)
:on-mouse-down (fn [e] (.preventDefault e) (pick i))}
(:label s)])
sugg))])]))))))
(defn mark-row [i]
[:div.mark-row
[point-input [:rows i :a] "frame or clip…"]
[:span.mark-arrow "→"]
[point-input [:rows i :b] "end (optional)"]
[:button.row-x {:title "remove mark"
:on-click #(rf/dispatch [::events/draft-remove-row i])}
"✕"]])
(defn- save-draft! [d]
(let [nm (str/trim (:name d))
marks (vec (keep row->mark (:rows d)))]
(cond
(str/blank? nm) (js/alert "Name is required.")
(empty? marks) (js/alert "Add at least one valid mark.")
:else (let [payload {:name nm :content (:content d) :color (:color d) :marks marks}]
(if-let [id (:id d)]
(rf/dispatch [::events/update-annotation id payload])
(rf/dispatch [::events/add-annotation payload]))
(rf/dispatch [::events/close-draft])))))
(defn annotation-form []
(when-let [d @(rf/subscribe [::subs/draft])]
[:div.form
[:div.form-head (if (:id d) "Edit annotation" "New annotation")]
[:div.form-row
[:input.form-name {:placeholder "Name (required)" :value (:name d) :auto-focus true
:on-change #(rf/dispatch [::events/draft-set [:name] (.. % -target -value)])}]
[:input.form-color {:type "color" :value (:color d)
:on-change #(rf/dispatch [::events/draft-set [:color] (.. % -target -value)])}]]
[:textarea.form-content {:placeholder "Content (optional, markdown)" :value (:content d)
:on-change #(rf/dispatch [::events/draft-set [:content] (.. % -target -value)])}]
[: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: 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"]]]))
(defn main-panel [] (defn main-panel []
(let [status @(rf/subscribe [::subs/load-status]) (let [status @(rf/subscribe [::subs/status])
fps (or @(rf/subscribe [::subs/fps]) (/ 24000 1001)) draft? (some? @(rf/subscribe [::subs/draft-group]))]
top-h @(rf/subscribe [::subs/top-h]) [:div.app
video-w @(rf/subscribe [::subs/video-w])]
[:div.app {:style {"--top-h" (str top-h "vh") "--video-w" (str video-w "%")}}
;; top region: video | annotation (the annotation pane becomes the
;; authoring form while a draft is open, leaving the timeline accessible)
[:div.top [:div.top
[:div.video-pane [:div.video-pane [video-monitor] [frame-readout]]
[video-monitor fps]] [:div.annot-pane (if draft? [annotation-form] [commentary])]]
[:div.divider-v
{:on-pointer-down #(begin-resize! :x ::events/set-video-w 12 88 %)}]
[:div.annot-pane (if @(rf/subscribe [::subs/draft]) [annotation-form] [commentary])]]
;; horizontal divider
[:div.divider-h
{:on-pointer-down #(begin-resize! :y ::events/set-top-h 12 88 %)}]
;; timeline region
[:div.timeline-pane [:div.timeline-pane
[breadcrumbs] [breadcrumbs]
[zoom-controls] [toolbar]
[:div.timeline-scroll [:div.timeline-scroll
(case status (case status
:ready [timeline] :ready [timeline]

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

@ -1,96 +0,0 @@
(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))))))

240
tl/test/tl/scene_test.cljs Normal file
View file

@ -0,0 +1,240 @@
(ns tl.scene-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.scene :as s]))
;; --- shared fixture -------------------------------------------------------
;; three contiguous clips on three tracks (half-open source ranges).
;; A [0,100)@t0 B [100,200)@t1 C [200,300)@t2 root [0,300)
(def base
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 300}]}
:clip-a {:type :clip :parent nil :marks [{:id :m/a :start 0 :end 100 :track :t0}]}
:clip-b {:type :clip :parent nil :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
:clip-c {:type :clip :parent nil :marks [{:id :m/c :start 200 :end 300 :track :t2}]}}})
(defn with-group [scene gid g] (assoc-in scene [:groups gid] g))
(defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}})
;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips.
(def inter-x
(with-group base :ann-x
{:type :annotation :parent :root
:marks [{:id :m/s0 :start {:ref :clip-b :at 50} :end {:ref :clip-b :at -1}} ; src [150,200)
{:id :m/s1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at 50}} ; src [0,50)
{:id :m/s2 :start {:ref :clip-b :at 0} :end {:ref :clip-b :at 50}} ; src [100,150)
{:id :m/s3 :start {:ref :clip-a :at 50} :end {:ref :clip-a :at -1}}]})) ; src [50,100)
;; Y inside X, referencing two of X's subclips (parent = :ann-x)
(def x+y
(with-group inter-x :ann-y
{:type :annotation :parent :ann-x
:marks [{:id :m/y0 :start {:ref :m/s0 :at 10} :end {:ref :m/s0 :at 20}} ; s0 10..20 -> src [160,170)
{:id :m/y1 :start {:ref :m/s1 :at 0} :end {:ref :m/s1 :at 5}}]})) ; s1 0..5 -> src [0,5)
;; =========================================================================
;; Suite 1 — resolve / layout
;; =========================================================================
(deftest root-is-identity
(testing "the root timeline maps local 1:1 to source"
(let [segs (s/resolve base :root)]
(is (= 300 (s/length segs)))
(is (= 250 (s/local->source segs 250)))
(is (= [0 300] (:src (first segs)))))))
(deftest rearrange-and-gap-removal
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track"
(let [scene (with-group base :ann
{:type :annotation :parent :root
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})
segs (s/resolve scene :ann)]
(is (= 200 (s/length segs)))
(is (= 200 (s/local->source segs 0))) ; local 0 -> C's source start
(is (= 0 (s/local->source segs 100))) ; local 100 -> A's source start
(is (= #{:t2 :t0} (s/tracks segs)))
(is (not (contains? (s/tracks segs) :t1))))))
(deftest inter-x-lays-four-subclips
(testing "four 50-frame subclips, in mark order, end to end"
(let [segs (s/resolve inter-x :ann-x)]
(is (= 4 (count segs)))
(is (= 200 (s/length segs)))
(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 (= #{:t1 :t0} (s/tracks segs))))))
(deftest trim-no-clamp
(testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame"
;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100
(let [scene (-> base
(with-group :ann {:type :annotation :parent :root
:marks [{:id :m/s :start {:ref :clip-a :at 20}
:end {:ref :clip-a :at 80}}]})
(with-group :ann-y {:type :annotation :parent :ann
:marks [{:id :m/y :start {:ref :m/s :at 0}
:end {:ref :m/s :at -1}}]}))
seg (first (s/resolve scene :ann-y))]
(is (= [20 80] (:src seg))) ; ends at the subclip's 80, not 100
(is (= 60 (s/length (s/resolve scene :ann-y)))))))
(deftest tracks-by-membership
(testing "zoom includes exactly the tracks the marks touch"
(let [scene (with-group base :ann
{:type :annotation :parent :root
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})]
(is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann)))))))
(deftest repeat-yields-two-pieces
(testing "a clip referenced twice renders at two local positions"
(let [scene (with-group base :ann
{:type :annotation :parent :root
:marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100)
(refm :m/r1 :clip-b 0 -1) ; B local [100,200)
(refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300)
segs (s/resolve scene :ann)]
(is (= [[0 100] [200 300]] (s/pieces segs 0 100)))))) ; clip-a's two pieces
;; =========================================================================
;; Suite 2 — authoring lifecycle (annotate A, push A, annotate B, mess with A)
;; =========================================================================
(deftest y-follows-x-reorder
(testing "Y's refs track the subclips' CONTENT through a reorder of X"
(let [reordered (update-in x+y [:groups :ann-x :marks] reverse)]
(is (= (s/resolve x+y :ann-y) (s/resolve reordered :ann-y))))))
(deftest y-follows-x-inplace-edit
(testing "editing s0's in-point in place (same id) is reflected through Y's ref"
(let [edited (assoc-in x+y [:groups :ann-x :marks 0 :start :at] 40)] ; s0 now B[40,100) src[140,200)
(is (= [150 160] (:src (first (s/resolve edited :ann-y)))))))) ; s0[10..20] -> [150,160)
(deftest y-orphans-partially-on-delete
(testing "deleting s0 dangles Y's first mark; the second still resolves"
(let [del (update-in x+y [:groups :ann-x :marks] #(vec (rest %)))] ; drop s0
(is (= [:m/y0] (s/broken-marks del :ann-y)))
(is (= 1 (count (s/resolve del :ann-y))))
(is (= [0 5] (:src (first (s/resolve del :ann-y)))))))) ; the surviving y1
(deftest selection-splits-into-a-run
(testing "a selection crossing subclip boundaries becomes one mark per segment"
(let [run (s/selection->marks inter-x :ann-x 40 110)] ; crosses s0, s1, s2
(is (= 3 (count run)))
(is (= [:m/s0 :m/s1 :m/s2] (map #(get-in % [:start :ref]) run)))
;; the s0 piece is its tail (local 40..50 -> offset 40..50 into s0)
(is (= 40 (get-in (first run) [:start :at])))
(is (= 50 (get-in (first run) [:end :at]))))))
(deftest root-selection-splits-by-clip
(testing "selecting across A/B/C at the ROOT splits into one ref per clip"
(let [run (s/selection->marks base :root 40 210)] ; A-tail + B + C-head
(is (= 3 (count run)))
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) run)))
(is (= 40 (get-in (first run) [:start :at]))) ; A from frame 40
(is (= 0 (get-in (last run) [:start :at])))))) ; C from frame 0
(deftest reconcile-keeps-ids-across-resize
(testing "resizing a selection keeps the surviving pieces' ids; adds/drops at the ends"
(let [run1 (s/selection->marks base :root 40 110) ; A-tail, B-head
a-id (:id (first run1))
run2 (s/reconcile-run base :root run1 40 210) ; grow → A, B, C
run3 (s/reconcile-run base :root run2 40 90)] ; shrink → A only
(is (= 2 (count run1)))
(is (= 3 (count run2)))
(is (= a-id (:id (first run2)))) ; A's id survived the grow
(is (= 1 (count run3)))
(is (= a-id (:id (first run3))))))) ; …and the shrink
;; =========================================================================
;; Suite 3 — playhead & playback
;; =========================================================================
(deftest per-context-playhead
(testing "each context keeps its own playhead, independent of the stack"
(let [v (-> {} (s/set-playhead :root 30) (s/set-playhead :ann-x 80))]
(is (= 30 (s/playhead v :root)))
(is (= 80 (s/playhead v :ann-x)))
(is (= 0 (s/playhead v :ann-y)))))) ; unvisited -> 0
(deftest source-to-local
(testing "source->local inverts local->source within a segment (video-clock playback)"
(let [segs (s/resolve inter-x :ann-x)] ; s0 = src[150,200) at local[0,50)
(is (= 10 (s/source->local segs 160))) ; src 160 -> local 10
(is (= 50 (s/source->local segs 0))) ; src 0 (start of s1) -> local 50
(is (nil? (s/source->local segs 999)))))) ; source not in view -> nil
(deftest recursive-following
(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
(deftest seek-only-at-boundaries
(testing "source advances 1:1 within a subclip and jumps only at a boundary"
(let [segs (s/resolve inter-x :ann-x)]
(is (= 1 (- (s/local->source segs 25) (s/local->source segs 24)))) ; within s0
(is (not= 1 (- (s/local->source segs 50) (s/local->source segs 49))))))) ; s0 -> s1
(deftest seed-from-otio
(testing "from-otio seeds tracks + clip mark-groups + root; content-segments at root tiles the clips"
(let [parsed {:fps 24 :duration 200
:tracks [{:index 0 :kind :video :name "Wide" :clips [{:id "t0-c0" :name "a" :media-in 0 :duration 100}]}
{:index 1 :kind :video :name "CU" :clips [{:id "t1-c0" :name "b" :media-in 100 :duration 100}]}
{:index 2 :kind :audio :name "Aud" :clips [{:id "t2-c0" :name "x" :media-in 0 :duration 50}]}]}
scene (s/from-otio parsed)]
(is (= 2 (count (:tracks scene)))) ; audio track dropped
(is (contains? (:groups scene) :t0-c0))
(is (contains? (:groups scene) :root))
(let [segs (s/content-segments scene :root)]
(is (= 2 (count segs)))
(is (= #{:t0 :t1} (s/tracks segs)))
(is (= 200 (s/length segs)))))))
;; =========================================================================
;; Suite 4 — draft rows <-> marks (the two-input editor)
;; =========================================================================
(deftest seg-length-is-mark-time
(testing "a content segment's length is its visible length, in mark time"
(is (= 100 (s/seg-length (s/content-segments base :root) :clip-a)))))
(deftest seg-local-maps-mark-time-to-context
(testing "seg-local + selection->marks: a clip selection start A@0 → end C@100"
(let [segs (s/content-segments base :root)]
(is (= 0 (s/seg-local segs :clip-a 0)))
(is (= 150 (s/seg-local segs :clip-b 50)))
(let [la (s/seg-local segs :clip-a 0) lb (s/seg-local segs :clip-c 100)
marks (s/selection->marks base :root la lb)]
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) marks)))))))
(deftest frames-are-mark-time-under-parent-trim
(testing "frames are 0-based within the TRIMMED segment, not raw clip time"
(let [scene (with-group base :p
{:type :annotation :parent :root
:marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]})
segs (s/content-segments scene :p)]
(is (= 60 (s/seg-length segs :m/s))) ; trimmed length, not 100
(let [la (s/seg-local segs :m/s 0) lb (s/seg-local segs :m/s 30)
marks (s/selection->marks scene :p la lb)]
(is (= 1 (count marks)))
(is (= :m/s (get-in (first marks) [:start :ref])))
(is (= 0 (get-in (first marks) [:start :at])))
(is (= 30 (get-in (first marks) [:end :at])))))))
(deftest marks-to-rows-normalises-frames
(testing "marks->rows is 1:1 with marks and normalises :at -1 to the length"
(let [rows (s/marks->rows base [{:id :m :start {:ref :clip-a :at 0}
:end {:ref :clip-a :at -1}}])]
(is (= 1 (count rows)))
(is (= {:seg :clip-a :f 0} (:s (first rows))))
(is (= {:seg :clip-a :f 100} (:e (first rows)))))))
(deftest repeats-are-unambiguous
(testing "two instances of A share a source frame but distinct locals (local is master)"
(let [scene (with-group base :ann
{:type :annotation :parent :root
:marks [(refm :m/r0 :clip-a 0 -1) (refm :m/r1 :clip-b 0 -1) (refm :m/r2 :clip-a 0 -1)]})
segs (s/resolve scene :ann)]
(is (= 5 (s/local->source segs 5))) ; first A
(is (= 5 (s/local->source segs 205))) ; second A — same source frame
(is (= 100 (s/local->source segs 100)))))) ; crossing into B