Compare commits

...

2 commits

12 changed files with 633 additions and 2010 deletions

View file

@ -9,7 +9,7 @@ User = get_user_model()
def ann(name, content="", **extra):
return {"type": "annotation", "parent": "root", "name": name,
return {"type": "annotation", "in": ["root"], "name": name,
"content": content, "marks": [], **extra}

View file

@ -20,7 +20,7 @@ Use idiomatic ClojureScript formatting with two-space indentation and aligned ma
## Testing Guidelines
`shadow-cljs.edn` includes `test` in `:source-paths`, but this repository currently has no committed test suite or npm test script. Add tests under `test/tl/` using matching namespace names such as `tl.otio-test`. When adding test support, include a runnable npm script and document the command here. Until then, verify changes with `npm run watch` for interactive behavior and `npm run release` before merging.
Run `npm test` for pure model and re-frame integration tests under `test/tl/`. Verify compilation with `npm run release`. Model tests should cover ordered clip slices, repeated footage, contextual contiguity, and visibility edges; see `data_model.org`.
## Commit & Pull Request Guidelines

View file

@ -1,98 +0,0 @@
# Annotation Flow Rework — Plan
Marks-first authoring, proxy synthetic-clips, transclusion, active-mark, draft/edit lane+pane.
## Decisions (locked)
- **Flow inversion:** the "+" button enters a *draft-marks* mode. You author marks first (click clip / frame button / drag range), then Create-new or Associate-existing. No annotation is created up front.
- **Transclusion = Associate-existing.** Appends draft marks to another annotation and enters edit mode on it. Does not break "a mark appears in only one annotation" — ownership is unique, only the resolved footage underneath is shared (containment is a reference, not ownership).
- **Proxy = synthetic clip.** A cross-clip (or single-clip) selection is a mark-group `{:type :proxy}` living in the **same flat pool** as clips. Its internal marks are the per-clip run (A start→end, B, C, D…). The annotation holds ONE mark `[{:ref P :at 0} {:ref P :at -1}]` = full span of P.
- **Always-proxy, no promotion.** Every annotation-mark is born as a proxy (even single-clip, even instant). 1:1 proxy↔annotation-mark, never shared. Endpoint edits mutate P's internal marks **in place** (add/remove/trim boundary mark); middle ids stable. No bare↔proxy conversion ever.
- **Active mark = through-line pointer.** Session state `{:editing <draft|annotation-id> :active-mark <mark-id>}`. Set on create/click/drag/finish-draw. Read by drawing-mode (bind stroke), lane (highlight), pane (highlight). Shared by draft-new and edit-existing.
- **No new clip-id layer.** Raw clips already have stable ids; root ranges already reference them. Stability = edit-in-place; new id = delete+recreate. Arrangement-created subclips stay fragile → orphan + warn.
- **Pane collapses a proxy to one row** (start clip/frame → end clip/frame). Lane draws a proxy as one bar.
## Open questions (revisit if they bite)
- (none currently — promotion and pool questions resolved)
---
## Chunk 1 — Proxy as synthetic clip (pure logic, no UI) ✅
- [x] Proxy shape: mark-group `{:type :proxy :parent nil :marks [...]}` in the flat pool, referenced by id (`scene/make-proxy`, marks via existing `selection->marks`).
- [x] `roll-proxy` : re-derive the run for a new selection, reusing interior ids, adding/dropping boundary marks (wraps existing `reconcile-run` — one fn covers grow/shrink both ends). `proxy-ref` builds the annotation's single `{:ref P :at 0 → :at -1}` mark.
- [x] **Core enabler:** rewrote `resolve-mark`'s ref branch to *slice the target's resolved timeline in local frames* (`target-segs` + `slice` + `rebase`), so a scattered-source proxy resolves piece-by-piece. Clips and proxies now use the identical `{:ref g :at n}` grammar. Instants handled via `instant-seg`.
- [x] Tests: proxy resolves as one collapsed mark (multi-clip + single-clip), roll keeps interior ids stable. Full suite green (only pre-existing `annotations-survive-json-roundtrip` fails on HEAD too). App compiles clean.
**Note:** honored the exact `{:ref P :at 0 → :at -1}` shape (no `:proxy` special mark) — the slice rewrite made it uniform with clip refs. Deferred: nested annotation Y referencing frames *inside* a proxy-mark still routes through `point-frame`/`target-range` (single-segment assumption) — fine until sub-annotation authoring against a proxy-containing parent lands.
## Chunk 2 — Selections become proxies + collapsed row + active-mark ✅
**Scope note:** the always-proxy lock forced this to also pull in the *display half of Chunk 6* (a proxy mark can't render in the per-clip `frame-chip` row) and *proxy persistence* (a new pool entity, or `{:ref proxy}` dangles on reload). So this landed as one coherent vertical slice. The existing draft **is** still a hidden annotation group — the true flow inversion (button → no annotation; create-vs-associate) is Chunk 3; here we kept `::open-draft` and just changed what a selection produces.
- [x] `::draft-click-seg` (fresh-selection branch): wraps the run in a proxy group (`scene/make-proxy`) in the pool + gives the annotation one `scene/proxy-ref` mark, instead of appending a bare run.
- [x] **Active-mark pointer** introduced: `[:view :active-mark]` set on selection, cleared on `::open-draft`; `::subs/active-mark`; form highlights it (`.active-mark` class). Consumed by drawing (Chunk 4) next.
- [x] Collapsed row: `scene/mark-row` collapses a proxy to first-clip start → last-clip end, tagged `:proxy`; form renders it read-only (endpoint editing = lane handles, Chunk 5). Plain clip marks unchanged.
- [x] Persistence: `restore-annotations` `:proxy` branch; `::save-group` includes referenced proxies in `:changed`; `::remove-mark` drops the mark + its orphan proxy. (localStorage `tl.storage` is dead code — persistence is backend `put-scene` only.)
- [x] Tests: proxy collapses to one row, plain mark still a pair, proxy survives restore + resolves. App compiles clean.
**Deferred to later chunks:** numeric/lane endpoint editing + repick on proxy rows (5); the real button→create-or-associate inversion (3); auto-draw on the active mark (4). Instant/frame-button and drag-range as distinct inputs still route through the existing click-click path.
## Chunk 3 — Create-or-Associate ✅ (associate path)
- [x] Associate-existing: once a draft has marks, the form shows an **"Or add these marks to an existing annotation"** autocomplete (shared `autocomplete` component, per request). Targets = `::associate-targets` sub (all reachable non-draft annotations, labelled `name · in <ctx>` via `scene/timelines`).
- [x] `::associate-marks draft-gid target-gid`: appends the draft's proxy-ref marks to the target, **persists the attachment now** (patch + referenced proxies via `put-scene`), discards the draft shell, sets active-mark, opens the target in edit mode (`:draft :edit`). The form is now keyed by draft-gid so it remounts with a fresh `orig` on the swap.
- [x] One-annotation invariant holds: marks *move* off the draft (which is discarded) onto exactly one target.
- [x] Create-new = the existing default (fill name + Save). App compiles clean.
**Design choice:** associate persists immediately + reopens the target for edit (rather than staging an un-persisted attach), to sidestep the form's `with-let orig` snapshot lifecycle — the swap-in target's `orig` = its post-attach state, so later tweaks diff correctly and the association can't be silently lost.
### Simplified draft UI (per feedback) ✅
The fresh-draft form now has a **two-stage** shape driven by `[:view :draft-stage]` (`::subs/draft-stage`):
- **:choosing** (default on `::open-draft`) — you see ONLY the mark-range rows + one **Title** autocomplete (`allow-new?`). Picking an existing annotation → `::associate-marks` (edit it); typing a new title → `::create-named` (name it + advance). No name field, color, content, tags, script-notes, or Save yet; per-mark note-drop hidden too.
- **:creating** — the full new-annotation form (name/color/content/tags/notes/Save) appears.
So "the title is the autocomplete": one control forks create-vs-associate.
**Deferred:** the "+" still makes a hidden draft group up front (invisible). Cancelling a choosing-stage draft drops it (orphan proxies left in pool — minor cruft; clean up later).
## Chunk 4 — Auto drawing mode after range select ✅
- [x] `::draft-click-seg` is now an event-fx; completing a **new** selection seeks the video to the mark's start (`:player/seek`) and dispatches `::start-drawing` on the just-made proxy mark — you land in draw mode automatically. (Endpoint re-pick does NOT auto-draw — it's an edit, not a fresh selection.)
- [x] Drawing binds to the active mark: `::draft-click-seg` already sets `:active-mark` to the new mark, and `::start-drawing` binds `[:view :draw]` to that same `mark-id`.
- [x] Touch = active: `::start-drawing` and `::save-drawing` both set `:active-mark` to the drawn mark, so "last drawn/last touched" stays the active one.
- [x] Compiles clean, tests green.
**Note:** auto-draw fires on every new selection (per the spec). To add another mark you cancel/finish the drawing (a clean no-op if empty) then select again. If that proves heavy for rapid multi-mark authoring we can gate it behind a toggle.
## Chunk 5 — Lane draft/edit interactions
- [x] **(done early — correctness)** Lane bars computed PER MARK (`scene/lane-bars`): two abutting-but-distinct marks stay separate bars instead of fusing; a cross-clip proxy still coalesces to one bar. Was a latent bug (global `merge-bars` over all marks' source ranges), now unambiguous with per-mark proxies. Tested.
- [x] Each lane bar is now `[lo hi mark-id]` (`lane-bars`); consumers that want only the range still destructure `[lo hi]`. Test updated.
- [x] Click a draft/edit mark's bar → drawing mode for that mark (via `mark-drag!` — a no-move gesture is a click → `::start-drawing`, which also sets active).
- [x] Drag whole mark left/right → `::reroll-proxy` with both endpoints shifted (`mark-drag!` `:move`).
- [x] Edge handles resize (`.bar-handle` at each edge → `mark-drag!` `:start`/`:end`) → `::reroll-proxy` → `roll-proxy`: within-clip edits the boundary mark in place (id stable), across-boundary adds/drops a clip. Endpoints clamped to `[0,len]`, min width 1.
- [x] Active-mark highlight in the lane (box-shadow ring + z-index on the bar whose mark = `::active-mark`).
- [x] Shared look: draft & saved bars use the same `.ann-bar` (draft dashed/translucent, saved solid); pane proxy rows carry the same `.active-mark` highlight as the lane.
- [x] **Drag-to-select on the timeline** (`region-select!`): while authoring, drag across clips or empty track space → a live preview band → one selection (proxy + auto-draw). Click a clip still does the two-click flow (no-move → `on-click` fallback). This is the "drag a range" input deferred from Chunk 2.
- [x] **Visible edge handles**: each draft bar edge shows a small paper/ink pill grip (was invisible ew-resize zone).
- [x] **Draw mode tears down on form save/cancel** (`::finish-edit` clears `:draw`/`:active-mark`/`:pt`/`:draft-stage`) — no more stuck overlay.
**Rough edges (polish later):** very narrow bars (<~18px) are mostly handle. Numeric endpoint editing in the pane rows is still read-only (the lane is the editing surface).
## Chunk 6 — Pane collapsed display + active indicator
- [ ] Marks editor renders a proxy as ONE row (start clip/frame → end clip/frame), not N rows.
- [ ] Active mark highlighted in the pane, matching the lane.
## Chunk 7 — Orphan / stability polish ✅
- [x] Broken annotations sort to the bottom (existing sub) and are **greyed out** (opacity on the card) while staying visible so surviving marks stay usable; `△`/`⚠` warnings on the card (existing).
- [x] **Per-mark broken indicator** in the editor: broken mark rows show `△` + strike-through + dimmed (`scene/broken-marks` set); an annotation keeps rendering as long as ≥1 mark resolves.
## Fundamental fix — per-mark lane interaction (not per-bar)
Handles/drag were attached to each visual bar, so a mark rendered as N pieces got N handle pairs (handles at every clip boundary). Two root fixes:
- [x] **Interaction decoupled from visual pieces**: colored bars are per-piece (pointer-events none for draft); a separate per-MARK layer spans the mark's whole extent = one draggable unit + exactly two end-handles + active ring. Robust no matter how many pieces a mark has.
- [x] **`merge-bars` absorbs ≤1-frame gaps**: independent frame-rounding of clip `:start` could leave a 1-frame gap between adjacent clips and spuriously split a mark's bar; a 1-frame gap is a rounding artifact, not real discontinuity, so it now coalesces (still per-mark, never fuses distinct marks).

View file

@ -1,42 +1,47 @@
#+title: Data Model
#+title: Data model
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 scene contains tracks and a flat map of groups. OTIO supplies immutable raw clips.
Each clip has a track, source-frame offset, duration, and position in the root timeline.
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.
An annotation owns an ordered vector of marks. Each mark has a stable id and an
ordered vector of parts:
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.
#+begin_src clojure
{:type :annotation
:in [:root :chapter]
:marks [{:id :moment
:parts [{:clip :clip-a :start 10 :end 20}
{:clip :clip-c :start 30 :end 50}
{:clip :clip-a :start 10 :end 20}]}]}
#+end_src
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.
A part is a half-open integer frame range within a raw clip. Repeats, trims, and
order are explicit. Marks can bind notes and drawings. Those bindings belong to
the mark, not to any one rendered occurrence.
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:
Opening an annotation concatenates its parts, in mark order. Selecting footage
in any timeline stores raw-clip parts immediately. Editing or deleting the context
does not change the selected footage.
marks: [[clipB[20], clipB[40]], [clipA[0], clipA[20]], [clipB[0], clipB[20]] [clipA[20], clipA[40]]]
=:in= is a set of visibility edges serialized as a vector; order has no meaning.
Moving replaces the source edge with the destination edge. Linking adds an edge.
Associating new marks with an annotation also enables its edge in the context
where the marks were selected. Other edges remain untouched. An annotation with
no surviving contexts is listed at root so it can be filed again.
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.
Compilation and projection are different operations. =resolve= produces ordered
source segments; =project-bars= finds every matching raw-clip occurrence in the
render context, intersects ranges, and merges adjacent/overlapping display pieces.
The same projection drives lane bars, selected bars, editor summaries, and bindings.
Different marks never merge into one editable mark. Repetition in the context can
make one stored part appear several times.
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.
Projection cannot be inverted: a bounding range loses gaps, order, and repetition.
The editor displays each contiguous projected range separately. Expanding a mark's
summary exposes its actual ordered parts for endpoint edits. Endpoint edits clamp
within that clip and cannot cross the opposite endpoint. The projected display
never reconstructs or replaces the stored parts. Annotation drag-and-drop changes
visibility only; dragging on the timeline creates a new selection.
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.
# 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.
* update!
- ok so the idea is this. you hit the new annotation button. it does not auto-select a mark for you. you can either click the clip, click the frame button, or drag a range. after you select a range, you are automatically in drawing mode. your drawings are connected to the mark, not the annotation. a mark should only ever appear in one annotation. instead of creating a new annotation mark group by default, this mode also allows you to either create new or associate with an existing annotation. associate with existing gives you our dropdown with only other annotations available. when you pick one, you effectively go into "edit" mode on that annotation with the new marks suddenly added. so this is basically our "transclusion": we can have annotations with marks embedded in other timelines. this is great for if we have subdivided our analysis into "chapters" but want to annotate shared concepts across them while keeping the main annotation pane clear. it's organized. so the big thing is that you don't create the annotation, you create the mark(s) first, then either create or assoc the annotation.
- another crucial thing: if we click and drag and it spans multiple clips, the range we have in our create/add annotation UI in the annotation pane should only show the start and end points relative to the clips at start and end. so the way this will work is we will create a mark group that's not an annotation as our "proxy" marks so that they don't appear in the ui that spans the full range and contains the full sequential clips, and then the mark group on the annotation that contains that mark group will just use that mark group as start and end as if it had been clicked. so, for example: there's clips A, B, C and D contiguous. user drags region from clip A to clip D. in the UI, we should see that our mark starts at clip A frame 0 and ends at clip D last frame, so we need to "pass through" the synthetic unnamed non-annotation mark group to the underlying clips, the synthetic unnamed non-annotation mark group is a proxy.. so that proxy mark group has marks that go from clip A start-clip A end, clip B start - clip B end, clip C start to clip C end, and clip D start to clip D end. makes sense? so what do we do if the user wants to drag adjust endpoint in UI? let's say there's another clip before clip A called clip 0. we move start point BACK to clip 0 frame 50. well, our main mark group just shows the range as we would expect: clip 0 frame 50 TO clip D last frame. but the proxy mark group? it has a new mark range with new mark id at the beginning, but the other mark ids are stable. and the same is true of rolling the end point forward: new mark id, new range, rest are stsable. what if we roll the endpoints inward? same principle but we kill off mark ranges instead of adding new ones. should be clean. so this means we needs we need to change how draft/edit marks look/act in the lane. when in draft/edit mode, clicking on the mark brings up drawing mode for that mark (there can still be a button next to the mark in the edit pane). you can drag the whole mark left to right. and you can also grab handles on the edges of the annotation left to right. and since we consider whatever last created or last touched mark to be the "active" one for associating drawings to, we need to have that visually represented in the timeline, and in the pane where the draft marks or edit annotation is. and these need to share the same look for the mark range,s its only the stuff above it that iwll change. make sense?
- note: when we talk about rolling the whole clip around, we know that the mark ids are going to change if we highlight one clip, unhighlight, then return back. this means that if we annotated a range defined w/r/t that annotation, the underlying gids are broken forever, even if they're rolled back. so that they exist still, right? since the underlying clips will never change, i wonder if we could just give each clip a stable identifier and define our root-most ranges in terms of those stable identifiers? or is that worse? idk
View state holds navigation history, per-context playheads, and the active editing
context. None of these is a parent or an input to the meaning of stored marks.

View file

@ -17,8 +17,7 @@
;; the whole scene graph (see tl.scene). Seeded from OTIO at load.
:scene {:tracks {}
:groups {:root {:type :timeline :parent nil
:marks [{:id :root-m :start 0 :end 0}]}}}
:groups {:root {:type :timeline :name "root"}}}
;; view state
:view {:stack [:root] ; timeline-stack; top = current context

View file

@ -201,6 +201,7 @@
(-> (apply dissoc groups (map keyword deleted))
(into (remove (fn [[gid _]] (contains? drafts gid)) restored))))))))
(rf/reg-event-fx
::refresh-project-detail
(fn [{:keys [db]} _]
@ -463,7 +464,7 @@
(defn- draft-in-ctx [db ctx]
(some (fn [[gid g]]
(when (and (:draft g) (= ctx (scene/home (:scene db) gid))) [gid g]))
(when (and (:draft g) (= ctx (get-in db [:view :edit-context]))) [gid g]))
(get-in db [:scene :groups])))
(defn- draft-mark-at [db ctx lf]
@ -489,7 +490,7 @@
(defn- mark-start-local [db ann mark-id]
(let [scene (:scene db)
ctx (scene/home scene ann)
ctx (get-in db [:view :edit-context])
segs (scene/content-segments scene ctx)]
(ffirst (scene/mark-bars scene ann mark-id segs))))
@ -499,7 +500,7 @@
(let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack])))
(some (fn [[gid g]] (when (:draft g) [gid g]))
(get-in db [:scene :groups])))
ctx (scene/home (:scene db) ann)
ctx (get-in db [:view :edit-context])
local (when ann (mark-start-local db ann mark-id))
db (cond-> db
ann (start-drawing-db ann mark-id)
@ -659,10 +660,10 @@
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
(let [ctx (peek (get-in db [:view :stack]))]
{:type :annotation :in [ctx] ; filed under the context it's born in
:draft :new :name "" :color "#4e8fc2" :marks []
:v scene/schema-version}))
:draft :new :name "" :color "#4e8fc2" :marks []}))
(assoc-in [:view :pt] :new)
(assoc-in [:view :active-mark] nil)
(assoc-in [:view :edit-context] (peek (get-in db [:view :stack])))
(assoc-in [:view :draft-stage] :choosing))))
;; commit a fresh draft to "create new": name it and reveal the full form (color,
@ -672,24 +673,15 @@
(-> db (assoc-in [:scene :groups gid :name] title)
(assoc-in [:view :draft-stage] :creating))))
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
(rf/reg-event-db ::edit-draft
(fn [db [_ gid]]
(-> db
(assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :edit-context] (peek (get-in db [:view :stack])))
(assoc-in [:view :pt] :new))))
;; Edit an annotation from a card. If its primary home isn't the context being
;; viewed, enter that home first so mark rows/handles edit in their authored
;; coordinate system. finish-edit pops this temporary context.
(rf/reg-event-fx
::edit-annotation
(fn [{:keys [db]} [_ gid]]
(let [home (scene/home (:scene db) gid)
ctx (peek (get-in db [:view :stack]))
push-home? (and home (not= home ctx))
fx (if push-home? (enter-ctx db #(conj % home)) {:db db})]
(update fx :db #(cond-> (-> %
(assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
(assoc-in [:view :edit-pop-parent] nil))
push-home? (assoc-in [:view :edit-pop-parent] home))))))
(rf/reg-event-fx ::edit-annotation
(fn [_ [_ gid]] {:dispatch [::edit-draft gid]}))
;; Edit the annotation you're currently inside: drop into its parent timeline so
;; its marks are editable there, remembering to pop back when done. Root has no
@ -700,22 +692,21 @@
fx (if root? {:db db} (enter-ctx db pop))]
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
(assoc-in [:view :edit-context] (peek (get-in % [:view :stack])))
(assoc-in [:view :edit-return] (when-not root? gid)))))))
(rf/reg-event-fx ::finish-edit
(fn [{:keys [db]} _]
;; leaving the form (save OR cancel): tear down all authoring
;; transients so draw mode / pending points don't linger.
(let [return-g (get-in db [:view :edit-return])
pop? (some? (get-in db [:view :edit-pop-parent]))
db (-> db (assoc-in [:view :draw] nil)
(assoc-in [:view :active-mark] nil)
(assoc-in [:view :pt] nil)
(assoc-in [:view :draft-stage] nil)
(assoc-in [:view :edit-return] nil)
(assoc-in [:view :edit-pop-parent] nil))]
(assoc-in [:view :edit-context] nil))]
(cond
return-g (enter-ctx db #(conj % return-g))
pop? (enter-ctx db #(if (> (count %) 1) (pop %) %))
:else {:db db}))))
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
;; cancelling a draft is local only; saving a real annotation / deleting one
@ -728,21 +719,13 @@
(rf/reg-event-fx
::save-group
(fn [{:keys [db]} [_ gid g orig]]
(let [g (cond-> (editable-group g)
(= :annotation (:type g)) (assoc :v scene/schema-version))
(let [g (editable-group g)
patch (group-patch orig g)
root? (= :timeline (:type g)) ; the root timeline persists whole
id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks)
;; proxies this annotation references are synthetic clips in the pool —
;; persist them alongside it or the {:ref proxy} marks dangle on reload.
proxies (into {} (keep (fn [m]
(let [pid (get-in m [:start :ref])
pg (get-in db [:scene :groups pid])]
(when (= :proxy (:type pg)) [pid pg])))
(:marks g)))]
id (get-in db [:project :id])]
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))}
(and id (or (seq patch) (seq proxies)))
(assoc :http-xhrio (api/put-scene id {:changed (merge {gid (if root? g patch)} proxies)}
(and id (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed {gid (if root? g patch)}}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))
(rf/reg-event-fx ::delete-annotation
@ -753,24 +736,7 @@
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))
;; --- membership edges (:in): file an annotation under mark-groups ----------
;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups
;; the annotation is filed under; the FIRST is the primary home (scene/home) — where
;; it's edited and its links resolve. Marks never move or re-cut — they resolve to
;; raw clips globally, and that only decides whether BARS draw in a context. Three
;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag /
;; file-into picker), remove (× on a chip).
(defn- files-under?
"Does `desc` reach `anc` by following :in edges (would nesting create a cycle)?"
[scene desc anc seen]
(boolean
(when-not (contains? seen desc)
(let [ins (scene/membership scene desc)]
(or (contains? ins anc)
(some #(and (= :annotation (get-in scene [:groups % :type]))
(files-under? scene % anc (conj seen desc)))
ins))))))
;; --- visibility edges ----------------------------------------------------
(rf/reg-event-db
::ann-drag-start
@ -798,29 +764,17 @@
{:on-success [::scene-saved]
:on-failure [::save-error]})))))
;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps
;; existing edges (link); otherwise the edge you grabbed is moved off its source.
;; Marks are untouched either way.
(defn- file-edge [db gid new-parent add? source]
(let [scene (:scene db)
g (get-in scene [:groups gid])
in (vec (:in g))
clear #(-> % (assoc-in [:view :dragging-ann] nil)
(assoc-in [:view :dragging-ann-source] nil))]
(if (or (not= :annotation (:type g)) ; only annotations file
(:draft g) ; not mid-draft
(= gid new-parent) ; not under itself
(contains? (set in) new-parent) ; already filed there
(files-under? scene new-parent gid #{})) ; would make a cycle
{:db (clear db)}
(let [in' (if add?
(conj in new-parent) ; link: append, primary unchanged
(let [rest* (vec (remove #{source} in))]
(if (= source (first in))
(into [new-parent] rest*) ; moved the primary → new home
(conj rest* new-parent))))
g* (assoc g :in in')]
(update (persist-group db gid g g*) :db clear)))))
(defn- file-edge [db gid target add? source]
(let [g (get-in db [:scene :groups gid])
edges (scene/membership (:scene db) gid)
edges (if add? edges (disj edges source))
next-edges (vec (distinct (cond-> (vec edges) target (conj target))))
db (update db :view dissoc :dragging-ann :dragging-ann-source)]
(if (and (= :annotation (:type g)) (not (:draft g)) (not= gid target)
(or (nil? target)
(contains? #{:annotation :timeline} (get-in db [:scene :groups target :type]))))
(persist-group db gid g (assoc g :in next-edges))
{:db db})))
(rf/reg-event-fx
::reparent
@ -833,69 +787,25 @@
(fn [{:keys [db]} [_ gid target]]
(file-edge db gid target true nil)))
;; remove one membership edge (× on a chip). Never the primary home, never the last.
(rf/reg-event-fx
::unfile
(rf/reg-event-fx ::unfile
(fn [{:keys [db]} [_ gid target]]
(let [g (get-in db [:scene :groups gid])
in (vec (:in g))]
(if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1))
{:db db}
(persist-group db gid g (assoc g :in (vec (remove #{target} in))))))))
(file-edge db gid nil false target)))
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
(rf/reg-event-db ::save-error
(fn [db [_ failure]]
(assoc db :save-error (api/error-message failure "Couldn't save your changes — they're unsaved."))))
;; 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.
;; Unset one endpoint of an existing mark to re-pick it: seed the pending-point
;; state with the endpoint we're keeping, so the existing "one end set, click the
;; other" UI takes over. We stash the original mark (:mark) + its slot (:i) so the
;; rebuilt mark keeps its id — and thus its note/drawing bindings (see the repick
;; branch of ::draft-click-seg). selection->marks re-sorts by min/max, so it
;; doesn't matter that the kept end was the start or the end.
(rf/reg-event-db
::unset-endpoint
(fn [db [_ gid i which]]
(let [marks (get-in db [:scene :groups gid :marks])
mark (get marks i)
keep (if (= which :start) (:end mark) (:start mark))]
(-> db (assoc-in [:scene :groups gid :marks]
(into (subvec marks 0 i) (subvec marks (inc i))))
(assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i i})))))
;; clear ONE endpoint of a proxy mark to re-pick it: remember the OPPOSITE
;; endpoint's ctx-local position (kept fixed) so the next clip-click only rerolls
;; the cleared side — the kept end never turns into the start (the old swap bug).
(rf/reg-event-db
::unset-proxy-endpoint
(fn [db [_ gid mark-id pid which]]
(let [scene (:scene db)
ctx (scene/home scene gid)
segs (scene/content-segments scene ctx)
[lo hi] (scene/mark-extent scene gid mark-id segs)]
(assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)}))))
;; complete a selection on the active draft: wrap the run [lo hi) in a proxy (a
;; synthetic clip), give the annotation one mark referencing it, make it active,
;; seek to its start, and drop into drawing mode ("select a range → you're drawing").
(defn- select-range-fx [db gid g lo hi]
(let [scene (:scene db)
p (scene/make-proxy scene (scene/home scene gid) lo hi)
pgid (keyword (str "prox-" (random-uuid)))
mid (str (random-uuid))
sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)]
{:db (-> db (assoc-in [:scene :groups pgid] p)
(update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid))
(assoc-in [:view :active-mark] mid)
(assoc-in [:view :playheads (scene/home scene gid)] lo)
(let [ctx (get-in db [:view :edit-context])
mark (scene/make-mark (:scene db) ctx lo hi)
sf (scene/local->source (scene/content-segments (:scene db) ctx) lo)]
{:db (-> db (update-in [:scene :groups gid :marks] conj mark)
(assoc-in [:view :active-mark] (:id mark))
(assoc-in [:view :playheads ctx] lo)
(assoc-in [:view :pt] :new))
:player/seek (when sf (/ sf (:fps db)))
:fx [[:dispatch [::start-drawing gid mid]]]}))
:fx [[:dispatch [::start-drawing gid (:id mark)]]]}))
;; drag a region directly on the timeline (context-local frames) → one selection.
(rf/reg-event-fx
@ -911,115 +821,34 @@
(fn [{:keys [db]} [_ seg-id frame]]
(let [scene (:scene db)
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
segs (scene/content-segments scene (scene/home scene gid))
segs (scene/content-segments scene (get-in db [:view :edit-context]))
pt (get-in db [:view :pt])]
(cond
;; re-picking one endpoint of a proxy: roll only that side, keep the other
(:proxy pt)
(let [proxy (get-in scene [:groups (:proxy pt)])
new-local (if (= (:which pt) :start)
(scene/seg-local segs seg-id (or frame 0))
(scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))))
keep (:keep pt)
lo (scene/assert-frame "proxy range start" (min new-local keep))
hi (scene/assert-frame "proxy range end" (max new-local keep))]
{:db (-> db (assoc-in [:scene :groups (:proxy pt)]
(scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi)))
(assoc-in [:view :pt] :new))})
(map? pt)
(if (map? pt)
(let [a (scene/seg-local segs (:seg pt) (:f pt))
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))
lo (min a b) hi (max a b)
old (:mark pt)]
(if old
;; re-picking an endpoint: reconcile-run keeps the mark id for the
;; piece on the kept clip; re-attach that mark's bindings, and splice
;; the run back into its original slot so order is preserved.
(let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi)
(mapv (fn [m] (if (= (:id m) (:id old))
(cond-> m
(:notes old) (assoc :notes (:notes old))
(:drawings old) (assoc :drawings (:drawings old)))
m))))
i (:i pt)]
{:db (-> db (update-in [:scene :groups gid :marks]
#(into (into (subvec % 0 i) run) (subvec % i)))
(assoc-in [:view :pt] :new))})
;; new selection (two-click): same completion as a timeline drag.
(select-range-fx db gid g lo hi)))
:else
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))]
(select-range-fx db gid g (min a b) (max a b)))
{:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})}))))
;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned
;; proxy group too (a draft's proxies are local until save, so a db-only dissoc
;; is enough — a saved-annotation edit will diff it away on Save).
(rf/reg-event-db
::remove-mark
(rf/reg-event-db ::remove-mark
(fn [db [_ gid i]]
(let [marks (get-in db [:scene :groups gid :marks])
pid (get-in marks [i :start :ref])
prox? (= :proxy (get-in db [:scene :groups pid :type]))]
(cond-> (update-in db [:scene :groups gid :marks]
#(into (subvec % 0 i) (subvec % (inc i))))
prox? (update-in [:scene :groups] dissoc pid)))))
(update-in db [:scene :groups gid :marks]
#(into (subvec % 0 i) (subvec % (inc i))))))
;; live lane edit of a proxy mark: re-derive its run for a new context-local
;; range [la lb) (whole-mark move, or one edge dragged). roll-proxy reuses the
;; ids of interior pieces (stable), adds/drops boundary marks as edges cross clip
;; boundaries. The annotation's {:ref proxy} mark and its drawing bindings never
;; move; only the proxy's internals change. Persists on the annotation's Save.
(rf/reg-event-db
::reroll-proxy
(fn [db [_ ann mark-id la lb]]
(let [scene (:scene db)
pid (->> (get-in scene [:groups ann :marks])
(some #(when (= mark-id (:id %)) (get-in % [:start :ref]))))
proxy (get-in scene [:groups pid])
;; roll against the VIEWED timeline (top of the stack), NOT the annotation's
;; :parent — the drag's frames are local to what you're looking at, and a
;; transcluded mark is being edited from a context other than its parent.
;; For a normal (non-transcluded) mark the two are the same.
ctx (peek (get-in db [:view :stack]))
len (scene/length (scene/content-segments scene ctx))
la (scene/assert-frame "proxy roll start" la)
lb (scene/assert-frame "proxy roll end" lb)
la* (max 0 (min la (dec len)))
lb* (max (inc la*) (min lb len))]
(if (= :proxy (:type proxy))
(assoc-in db [:scene :groups pid] (scene/roll-proxy scene ctx proxy la* lb*))
db))))
::set-part-frame
(fn [db [_ gid mid index which frame]]
(update-mark db gid mid #(scene/set-part-frame (:scene db) % index which frame))))
;; numeric endpoint edit from the pane: set a proxy's boundary internal mark's
;; :at directly (the collapsed row's start = first mark's start, end = last mark's
;; end). In-place within one clip — no boundary crossing (that's the lane handles).
(rf/reg-event-db
::set-proxy-frame
(fn [db [_ pid which frame]]
(let [frame (scene/assert-frame "proxy endpoint frame" frame)
marks (get-in db [:scene :groups pid :marks])
idx (if (= which :start) 0 (dec (count marks)))]
(assoc-in db [:scene :groups pid :marks idx which :at] frame))))
;; transclusion: instead of creating a new annotation, append the draft's marks
;; to an EXISTING one and open it in edit mode ("the new marks suddenly added").
;; We persist the attachment now (the marks + their proxies) and discard the draft
;; shell (never saved); further tweaks in the reopened form diff against this state.
;; Adding footage and making it visible in the authoring context is one edit.
(rf/reg-event-fx
::associate-marks
(fn [{:keys [db]} [_ draft-gid target-gid]]
(let [marks (get-in db [:scene :groups draft-gid :marks])
orig-t (get-in db [:scene :groups target-gid])
;; adding marks does NOT change placement — membership is asserted, never
;; derived from where marks were authored. To also list C in this context,
;; file it in explicitly (the + picker / drag).
target (update orig-t :marks (fnil into []) marks)
target (-> orig-t
(update :marks (fnil into []) marks)
(update :in #(vec (distinct (conj (vec %) (get-in db [:view :edit-context]))))))
patch (group-patch orig-t target) ; just the :marks change
proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref])
pg (get-in db [:scene :groups pid])]
(when (= :proxy (:type pg)) [pid pg])))
marks))
id (get-in db [:project :id])
db (-> db
(assoc-in [:scene :groups target-gid] (assoc target :draft :edit))
@ -1029,6 +858,6 @@
(assoc :save-error nil))]
(cond-> {:db db}
(and id (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed (merge {target-gid patch} proxies)}
(assoc :http-xhrio (api/put-scene id {:changed {target-gid patch}}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))

View file

@ -1,21 +1,8 @@
(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]}."
"Annotations own ordered marks; marks own ordered root-clip slices.
:in contains visibility edges only. All frame ranges are integer [start,end)."
(:refer-clojure :exclude [resolve]))
(defn- grp [scene gid] (get-in scene [:groups gid]))
(defn frame?
"True when `n` is a concrete integer frame coordinate."
[n]
@ -38,17 +25,10 @@
(throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi])))))
[lo hi])
(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))
(reduce max 0 (map (comp second :local) segs)))
(defn local->source
"The source frame shown at local frame `lf` (clamped to the end)."
@ -62,17 +42,6 @@
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]
(assert-frame "source frame" sf)
(some (fn [{:keys [src local]}]
(assert-range "segment source" src)
(assert-range "segment local" 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]
@ -82,7 +51,8 @@
(assert-range "segment local" local)
(let [[a b] src [c _] local
lo (max sa a) hi (min sb b)]
(when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))])))
(when (or (< lo hi) (and (= sa sb) (<= a sa) (< sa b)))
[(+ c (- lo a)) (+ c (- hi a))])))
segs)))
(defn merge-bars
@ -110,7 +80,7 @@
(assert-range "segment local" local)
(let [[a _] src [c d] local
lo (max la c) hi (min lb d)]
(when (< lo hi)
(when (or (< lo hi) (and (= la lb) (<= c la) (< la d)))
(cond-> (assoc seg :local [lo hi]
:src [(+ a (- lo c)) (+ a (- hi c))])
(:thumb-start seg) (update :thumb-start + (- lo c))))))
@ -118,640 +88,185 @@
(defn tracks [segs] (into #{} (keep :track segs)))
;; --- resolution ----------------------------------------------------------
(declare resolve resolve-mark home child-of?)
(defn- clip-segment [scene {:keys [clip start end]}]
(let [{:keys [type source duration track]} (get-in scene [:groups clip])]
(assert-range "clip slice" [start end])
(when (and (= type :clip) (<= 0 start end duration))
{:thumb clip :thumb-start start :track track
:src [(+ source start) (+ source end)] :local [0 (- end start)]})))
(defn- target-segs
"Resolved segments (local 0-based) of a referenceable id: a group (clip,
timeline, proxy, annotation) or a single mark. One segment for a clip/subclip
by the ref invariant; several for a proxy or an arrangement group."
[scene id]
(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))
(defn- concatenate [segments]
(reduce (fn [out {:keys [local] :as segment}]
(let [offset (or (some-> out peek :local second) 0)]
(conj out (assoc segment :local [offset (+ offset (- (second local) (first local)))]))))
[] segments))
;; --- ref :at <-> source : the ONE interpretation of a ref's :at -----------
;; {:ref id :at n}'s :at is a LOCAL frame of id's OWN resolved timeline (n<0 from
;; the end, -1 = the exclusive end). Every :at<->frame conversion goes through
;; id's FULL resolution (target-segs) + the flat helpers, so it is correct whether
;; id is one clip or a scattered multi-clip proxy. Do NOT summarise a target to a
;; single [xs xe] span — that only holds for a single contiguous segment.
(defn- ref-len [scene ref] (length (target-segs scene ref)))
(defn- at->local
"Normalise a ref's :at (n<0 from the end) to a non-negative local frame."
[scene ref at]
(if (neg? at) (+ (ref-len scene ref) at 1) at))
(defn- at->src
"Source frame at ref point {:ref :at} — id's own local frame → source — or nil
if the ref dangles or the frame falls outside id."
[scene ref at]
(when-let [segs (seq (target-segs scene ref))]
(let [l (at->local scene ref at)]
(when (<= 0 l (length segs))
(local->source segs l)))))
(defn- src->at
"Target-local :at for source frame `src` within `ref` — source → id's own
local frame — or nil if outside id."
[scene ref src]
(some-> (seq (target-segs scene ref)) (source->local src)))
(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 (home scene gid)]
{:frame (if parent (local->source (resolve scene parent) point) point)
:track nil})
(map? point)
(when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range
{:frame f})))
(defn- shift-local
"Shift `sub`'s :local so the run starts at 0, WITHOUT touching :mark — pieces keep
the identity of the target they were sliced from. This is the RAW recursion's
output; content-segments uses it so a multi-clip mark stays a run of
individually-addressable clips (their own name/length/ref)."
[sub]
(let [base (or (some-> sub first :local first) 0)]
(mapv (fn [s] (let [[c d] (:local s)]
(assoc s :local [(- c base) (- d base)])))
sub)))
(defn- rebase
"shift-local, then stamp :mark = `id` — the LANE/edit view, where the mark owns
every piece it resolves to (one bar per mark) regardless of which target they
were sliced from. The stamp is the only thing separating this from the raw
recursion (shift-local)."
[id sub]
(mapv #(assoc % :mark id) (shift-local sub)))
(defn- instant-seg
"A zero-length segment at local frame `la` of `tsegs` (for an instant mark),
carrying that frame's src/track/thumb."
[tsegs la]
(let [la* (min la (max 0 (dec (length tsegs))))]
(when-let [s (first (slice tsegs la* (inc la*)))]
(let [[c _] (:local s) [a _] (:src s)]
[(assoc s :local [c c] :src [a a])]))))
(defn resolve-mark
"One mark → its segment(s) (1 for a single-clip ref, 1+ for a proxy/arrangement
ref or an absolute mark), with :local 0-based within the mark. A ref mark
slices its target's resolved timeline in the target's LOCAL frames (:at n,
n<0 from the end), so a scattered-source proxy resolves piece-by-piece just
like a contiguous clip does. nil when a ref dangles or falls out of range."
[scene gid {:keys [id start end track]}]
(if (map? start) ; ref mark (same target both ends)
(when-let [tsegs (seq (target-segs scene (:ref start)))]
(let [len (length tsegs)
at->l #(if (neg? %) (+ len % 1) %)
la (at->l (:at start))
lb (at->l (:at end))]
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
(rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
(let [parent (home scene gid)]
(if parent ; absolute, relative to parent
(rebase id (slice (resolve scene parent) start end))
[{:mark id :track track :src [start end] :local [0 (- end start)]
:thumb (when (= :clip (:type (grp scene gid))) gid)
:thumb-start 0}]))))
(defn resolve-mark [scene _ {:keys [id parts]}]
(mapv #(assoc % :mark id) (concatenate (keep #(clip-segment scene %) parts))))
(defn resolve
"A mark-group → its local timeline: ordered segments laid end to end. Broken
marks (dangling refs) are skipped."
"Compile a group to source segments. Visibility never participates."
[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 mark-bars
"Local (context) bars for one mark of annotation `ann-gid`, given the context's
content-segments — where that single mark lands in the current timeline. Drives
the per-mark playhead-in-range tests (script-note »»» and drawing visibility)."
[scene ann-gid mark-id ctx-segs]
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))
(filter #(= mark-id (:mark %)) (resolve scene ann-gid)))))
(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)))
(defn broken-reason
"A short why for `gid`'s first broken mark, or nil if nothing's broken."
[scene gid]
(when-let [mid (first (broken-marks scene gid))]
(let [ref (->> (:marks (grp scene gid)) (some #(when (= mid (:id %)) %)) :start :ref)]
(if (seq (target-segs scene ref)) "reference trimmed away" "referenced clip deleted"))))
;; --- what the current timeline is made of --------------------------------
(defn- content-mark-segs
"Context-local pieces of mark `m` for content-segments. A ref into a PROXY drills
in and exposes the proxy's per-clip run, each sub-clip mark kept individually
addressable (its own name/length/ref/trim, via shift-local) — instead of
collapsing every piece under `m`'s single id the way resolve does for the LANE
view (rebase). That collapse was the bug: drilling into a proxy-backed range made
every clip read with the FIRST piece's name + length, so sub-range selections
wouldn't save. Any OTHER mark — a plain clip ref, a single mark ref, an absolute
mark — is one piece and stays owned by `m` (resolve-mark), so nested marks there
remain annotation-relative, exactly as before this fix."
[scene gid {:keys [start end] :as m}]
(if (and (map? start) (= :proxy (:type (grp scene (:ref start)))))
(when-let [tsegs (seq (target-segs scene (:ref start)))]
(let [len (length tsegs)
at->l #(if (neg? %) (+ len % 1) %)
la (at->l (:at start))
lb (at->l (:at end))]
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
(shift-local (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
(resolve-mark scene gid m)))
(defn- content-resolve
"`resolve` for content-segments: lays a group's marks end to end, but each piece
keeps its underlying :mark (see content-mark-segs) so multi-clip marks don't
collapse to one addressable unit."
[scene gid]
(loop [[m & more] (:marks (grp scene gid)), off 0, out []]
(if (nil? m)
out
(if-let [segs (seq (content-mark-segs 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)))))
(let [{:keys [type marks duration]} (get-in scene [:groups gid])]
(case type
:clip (if-let [seg (clip-segment scene {:clip gid :start 0 :end duration})]
[(assoc seg :mark gid)] [])
:timeline (->> (:groups scene)
(keep (fn [[id {:keys [type start]}]]
(when (= type :clip)
(let [seg (first (resolve scene id))]
(assoc seg :local [start (+ start (length [seg]))])))))
(sort-by (comp first :local)) vec)
:annotation (concatenate (mapcat #(resolve-mark scene gid %) marks))
[])))
(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` — but
with each piece kept distinct (see content-resolve), not flattened under the
annotation's own mark id. The root timeline doesn't enumerate its clips (they're
a parentless pool), so there it's the pool laid at each clip's TIMELINE position
(:start) with :src = its source range — so the assembled program tiles
contiguously even though the underlying source frames are scattered (and
fractional)."
"Occurrence IDs belong to the view; persisted slices always identify raw clips."
[scene ctx]
(if (= :timeline (:type (grp scene ctx)))
(->> (:groups scene)
(keep (fn [[gid g]]
(when (= :clip (:type g))
(let [seg (first (resolve scene gid))
[sa sb] (:src seg)
st (:start g 0)]
(assoc seg :mark gid :local [st (+ st (- sb sa))])))))
(sort-by (comp first :local))
vec)
(content-resolve scene ctx)))
(mapv (fn [i seg] (assoc seg :mark [ctx i])) (range) (resolve scene ctx)))
(defn- src-intersect
"Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))."
[rs cover]
(vec (for [[a b] rs [c d] cover
:let [lo (max a c) hi (min b d)]
:when (< lo hi)]
[lo hi])))
(defn project-bars
"Project onto every matching clip occurrence; merge only context-contiguous pieces."
[segments context]
(merge-bars
(mapcat (fn [{:keys [thumb] [a b] :src}]
(pieces (filter #(= thumb (:thumb %)) context) a b))
segments)))
(defn lane-bars
"Context-local display bars for annotation `gid`, grouped PER MARK: contiguous
pieces coalesce WITHIN a mark but never across marks, so two abutting-but-
distinct marks stay separate bars — the lane bar matches each mark's highlight
1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id
lets the lane hit-test / highlight / edit one mark; consumers that only want
the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments.
(defn mark-bars [scene gid mid context]
(project-bars (filter #(= mid (:mark %)) (resolve scene gid)) context))
`resolve` already trims each mark through its whole ref chain — a nested mark
is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ …
⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs`
is all the clipping needed (no ancestor re-walk — that was redundant)."
[scene gid ctx-segs]
(->> (resolve scene gid)
(partition-by :mark)
(mapcat (fn [ss]
(let [mid (:mark (first ss))]
(map (fn [[lo hi]] [lo hi mid])
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss))))))
vec))
(defn lane-bars [scene gid context]
(vec (mapcat (fn [{:keys [id] :as mark}]
(map (fn [[lo hi]] [lo hi id])
(project-bars (resolve-mark scene gid mark) context)))
(get-in scene [:groups gid :marks]))))
(defn mark-extent
"EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true
min piece-start / max piece-end, without merge-bars. Endpoint editing must use
this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` =
content-segments of ctx."
[scene gid mark-id ctx-segs]
(let [pcs (->> (resolve scene gid)
(filter #(= mark-id (:mark %)))
(mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))]
(when (seq pcs)
[(reduce min (map first pcs)) (reduce max (map second pcs))])))
(defn broken-marks [scene gid]
(->> (get-in scene [:groups gid :marks])
(filter #(or (empty? (:parts %))
(some (fn [part] (nil? (clip-segment scene part))) (:parts %))))
(mapv :id)))
;; --- placement: :in membership edges --------------------------------------
;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered
;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under
;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in
;; it. The FIRST element is the primary home (where its :content links resolve and
;; where it's edited); the whole vector as a set is its membership. Marks are never
;; moved or re-cut — they resolve to raw clips globally, and that only decides
;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it
;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary.
(defn home
"The primary home of `gid`: the first `:in` edge for an annotation (where its
description links resolve and where it's edited); the structural `:parent` for
anything else (nil for the flat clip/proxy pool and the root timeline)."
[scene gid]
(let [g (grp scene gid)]
(if (= :annotation (:type g)) (first (:in g)) (:parent g))))
(defn broken-reason [scene gid]
(when (seq (broken-marks scene gid)) "missing clip or invalid range"))
(defn membership
"The set of mark-groups annotation `gid` is filed under (its `:in` edges)."
"Unfiled annotations appear at root, including when their last context is deleted."
[scene gid]
(set (:in (grp scene gid))))
(let [edges (filter #(contains? #{:annotation :timeline} (get-in scene [:groups % :type]))
(get-in scene [:groups gid :in]))]
(if (seq edges) (set edges) #{:root})))
(defn child-of?
"Is annotation `gid` filed under `ctx`?"
[scene ctx gid]
(defn child-of? [scene ctx gid]
(contains? (membership scene gid) ctx))
(defn clip-loss?
"True when annotation `gid` loses content once clipped to its primary home — it
references frames outside that parent annotation, so it's (partly) out of range
there. Timeline/root homes contain everything, so they never warn."
[scene gid]
(let [p (home scene gid)]
(when (and p (= :annotation (:type (grp scene p))))
(let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs)))
own (mapv :src (resolve scene gid))]
(< (len (src-intersect own (mapv :src (resolve scene p)))) (len own))))))
(defn selection->parts [scene ctx lo hi]
(mapv (fn [{:keys [thumb thumb-start] [a b] :src}]
{:clip thumb :start thumb-start :end (+ thumb-start (- b a))})
(slice (content-segments scene ctx) lo hi)))
;; --- editing: split a local selection into a run of single-clip marks -----
(defn make-mark [scene ctx lo hi]
{:id (keyword (str (random-uuid))) :parts (selection->parts scene ctx lo hi)})
(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. Inputs and
derived offsets must already be integer frames."
[scene ctx la lb]
(assert-range "selection" [la lb])
(mapv (fn [{:keys [mark src]}]
;; :at is the target's OWN local frame (src->at), matching resolve-mark's
;; slice — correct even when the target is a scattered multi-clip proxy.
;; The piece lies within one target segment, so its length maps 1:1.
(let [[a b] src
a' (src->at scene mark a)]
{:id (str (random-uuid)) ; string so it survives JSON
:start {:ref mark :at (assert-frame "selection start offset" a')}
:end {:ref mark :at (assert-frame "selection end offset" (+ a' (- b a)))}}))
(slice (content-segments scene ctx) la lb)))
(defn seg-length [segs mid]
(some (fn [{m :mark [lo hi] :local}] (when (= m mid) (- hi lo))) segs))
(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))))
(defn seg-local [segs mid frame]
(some (fn [{m :mark [lo _] :local}] (when (= m mid) (+ lo (or frame 0)))) segs))
;; --- proxy synthetic-clips ------------------------------------------------
;; A proxy is a mark-group {:type :proxy} in the flat pool whose marks are the
;; per-clip run of a selection (selection->marks). An annotation references the
;; WHOLE proxy with a single mark {:ref P :at 0 → :at -1}, so the pane shows one
;; collapsed row and the lane one bar, while endpoint edits mutate the proxy's
;; internal run in place — stable interior ids, boundary marks added/dropped
;; (see reconcile-run). Because resolve-mark slices its target, the annotation's
;; one mark resolves through the proxy to the underlying clips piece-by-piece.
;; See annotation_flow_plan.md.
(defn- restore-mark [mark]
(cond-> (-> mark (update :id keyword)
(update :parts #(mapv (fn [part] (update part :clip keyword)) %)))
(:notes mark) (update :notes #(mapv keyword %))
(:drawings mark) (update :drawings #(mapv keyword %))))
(defn make-proxy
"A new proxy mark-group for selection [la lb) of context `ctx`. No gid yet —
the caller assigns one when inserting it into the pool."
[scene ctx la lb]
{:type :proxy :parent nil :marks (selection->marks scene ctx la lb)})
(defn roll-proxy
"Re-derive proxy `p`'s run for a new selection [la lb) of `ctx`, reusing the ids
of interior marks that still target the same segment: rolling an endpoint out
adds a fresh boundary mark, rolling in drops one, the middle never churns."
[scene ctx p la lb]
(assoc p :marks (reconcile-run scene ctx (:marks p) la lb)))
(defn proxy-ref
"The single annotation mark referencing the whole proxy `pid` (as if the proxy
had been clicked): local frame 0 to its exclusive end."
[mark-id pid]
{:id mark-id :start {:ref pid :at 0} :end {:ref pid :at -1}})
;; --- 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- restore-mark [m]
;; keep :id keyworded in lockstep with the refs that target it: a nested
;; annotation's :ref is another mark's :id, and JSON makes both strings — if we
;; keyword one but not the other they stop matching (ref looks "deleted").
(cond-> m
(:id m) (update :id keyword)
(get-in m [:start :ref]) (update-in [:start :ref] keyword)
(get-in m [:end :ref]) (update-in [:end :ref] keyword)
(:track m) (update :track keyword)
(:notes m) (update :notes #(mapv keyword %)) ; bound script-note gids
(:drawings m) (update :drawings #(mapv keyword %)))) ; bound drawing gids
(defn- restore-region
"A script-note region loses keyword-ness through JSON: re-keyword :id and :kind."
[r]
(cond-> r
(:id r) (update :id keyword)
(:kind r) (update :kind keyword)))
;; --- schema versioning ----------------------------------------------------
;; Every stored annotation carries :v, its schema version. When the data model
;; changes, bump schema-version and add a transformer that upgrades the previous
;; version's shape to the new one; old annotations migrate forward on load.
(def schema-version 2) ; current annotation schema — bump on any model change
;; transformers[n] upgrades a schema-v(n) annotation to v(n+1) (and must set
;; :v (n+1)). v1→v2 drops the old per-annotation :script rects — script passages
;; are now first-class :script-note entities bound by id (see [[markgroup-model]]).
(def ^:private transformers
{1 (fn [g] (-> g (dissoc :script) (assoc :v 2)))})
(defn migrate
"Upgrade annotation `g` to the current schema-version by chaining transformers.
Pre-versioned data (no :v) is treated as the original v1."
[g]
(loop [g (update g :v #(or % 1))]
(if (>= (:v g) schema-version)
(assoc g :v schema-version)
(recur ((transformers (:v g)) g)))))
(defn- restore-group [group]
(cond-> (update group :type keyword)
(:in group) (update :in #(mapv keyword %))
(:marks group) (update :marks #(mapv restore-mark %))
(:notes group) (update :notes #(mapv keyword %))
(:regions group) (update :regions #(mapv (fn [r] (-> r (update :id keyword)
(update :kind keyword))) %))))
(defn restore-annotations
"Re-keywordize the fields that lose their keyword-ness through JSON (string
:type/:parent and mark :refs), then migrate each annotation to the current
schema version, before merging into the (keyword-keyed) scene."
[anns]
(into {} (map (fn [[gid g]]
(let [g (-> g (update :type keyword) (update :parent keyword))]
[gid (case (:type g)
:script-note (update g :regions #(mapv restore-region (or % [])))
:proxy (update g :marks #(mapv restore-mark (or % []))) ; synthetic clip: just its run
:drawing g ; pure strokes + seed, JSON round-trips as-is
(-> g
(dissoc :parent) ; annotations are placed by :in alone
(update :marks #(mapv restore-mark (or % [])))
(cond-> (:notes g)
(update :notes #(mapv keyword %))) ; annotation-level bindings
;; membership edges: keyword an existing :in vector,
;; or seed one from a legacy single :parent
(assoc :in (if-let [in (:in g)]
(mapv keyword in)
(when (:parent g) [(:parent g)])))
migrate))])))
anns))
"Decode identifiers in the current JSON format."
[groups]
(update-vals groups restore-group))
(defn display-point
"A ref-point {:ref :at} as a display cell {:seg :f}: the target id plus its OWN
local frame (context-local, whole-frame; not translated to the raw clip). The
shared basis for both the annotation editor rows and the jump popover, so they
can never disagree on how a point reads."
[scene {:keys [ref at]}]
{:seg ref :f (assert-frame "display point" (at->local scene ref at))})
(defn marks->rows [scene ctx marks]
(let [segments (content-segments scene ctx)]
(mapv #(project-bars (resolve-mark scene nil %) segments) marks)))
(defn- clip-row
"Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time."
[scene {:keys [start end]}]
{:s (display-point scene start) :e (display-point scene end)})
(defn mark-row
"One editor row for a mark. A plain clip/subclip ref collapses to {:s :e}
directly; a proxy ref collapses to its run's FIRST-clip start and LAST-clip
end (so a cross-clip drag reads as one span), tagged :proxy <pid> so the form
knows to render it as a single unit rather than an editable clip pair."
[scene {:keys [start] :as mark}]
(let [pid (:ref start)]
(if (= :proxy (:type (grp scene pid)))
(let [rows (mapv #(clip-row scene %) (:marks (grp scene pid)))]
{:s (:s (first rows)) :e (:e (last rows)) :proxy pid})
(clip-row scene mark))))
(defn marks->rows
"Render `marks` as editor rows (one per mark, frames normalised to mark time).
1:1 with `marks`, so row i pairs with mark i. Proxy marks collapse to one
row (see mark-row)."
[scene marks]
(mapv #(mark-row scene %) marks))
;; --- tiny view-state helpers (per-context playhead) ----------------------
(defn set-part-frame [scene mark index which frame]
(let [{:keys [clip start end]} (get-in mark [:parts index])
[lo hi] (if (= which :start) [0 end] [start (get-in scene [:groups clip :duration])])]
(assoc-in mark [:parts index which]
(max lo (min hi (assert-frame "endpoint frame" frame))))))
(defn playhead [view ctx] (get-in view [:playheads ctx] 0))
(defn set-playhead [view ctx lf] (assoc-in view [:playheads ctx] lf))
(defn set-playhead [view ctx frame] (assoc-in view [:playheads ctx] frame))
;; --- seeding from OTIO ----------------------------------------------------
(defn from-otio [{:keys [tracks]}]
(let [video (filter #(= :video (:kind %)) tracks)
clips (for [track video clip (:clips track)]
[(keyword (:id clip))
{:type :clip :name (:name clip) :track (keyword (str "t" (:index track)))
:start (assert-frame "clip position" (:start clip))
:source (assert-frame "clip source" (:media-in clip))
:duration (assert-frame "clip duration" (:duration clip))}])]
{:tracks (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}]) video))
:groups (into {:root {:type :timeline :name "root"}} clips)}))
(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.
(defn clip-name [scene gid] (get-in scene [:groups gid :name]))
(defn ref-length [scene gid] (length (resolve scene gid)))
(defn ref-track-name [scene gid]
(get-in scene [:tracks (:track (first (resolve scene gid))) :name]))
Clip ranges are integer frame ranges. Fractional OTIO input is rejected before
this point; from here on, frame math asserts instead of snapping."
[{:keys [duration tracks]}]
(assert-frame "OTIO duration" duration)
(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)]
(let [start (assert-frame "clip timeline start" (:start c))
media-in (assert-frame "clip media-in" (:media-in c))
duration (assert-frame "clip duration" (:duration c))]
[(keyword (:id c))
{:type :clip :parent nil :name (:name c)
:start start ; timeline position (frames)
:marks [{:id (keyword (str (:id c) "-m"))
:start media-in
:end (+ media-in duration)
: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 seg-point [_ {:keys [thumb thumb-start]} frame]
{:ref thumb :at (+ thumb-start (or frame 0))})
(defn clip-name [scene gid] (:name (grp scene gid)))
(defn link-local [scene ctx {:keys [ref at]}]
(assert-frame "link frame" at)
(if (= ref ctx) at
(ffirst (project-bars (slice (resolve scene ref) at at) (content-segments scene ctx)))))
;; --- context-independent labelling (for transcluded mark rows) ------------
;; A mark collected into an annotation from another timeline (transclusion) has a
;; ref whose clip isn't in the CURRENT context's content-segments, so the context
;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip
;; instead — the mark's own timeline — so the row reads correctly from anywhere.
(defn jump-targets [scene ctx gid]
(let [segs (content-segments scene ctx)]
(mapv (fn [[lo _]]
(let [seg (some (fn [{[a b] :local :as seg}]
(when (<= a lo (dec b)) seg)) segs)]
{:local lo :seg (:mark seg) :f (- lo (first (:local seg)))}))
(project-bars (resolve scene gid) segs))))
(defn ref-length
"Own resolved length (frames) of ref target `ref`, context-independent."
[scene ref]
(length (target-segs scene ref)))
(defn linkables [scene ctx]
(let [segs (content-segments scene ctx)
tracks (for [[track segments] (group-by :track segs)]
{:name (get-in scene [:tracks track :name]) :kind :track
:items (mapv (fn [i {:keys [thumb] [lo hi] :local :as seg}]
{:label (str (get-in scene [:tracks track :name]) " (" (inc i) ")")
:search (clip-name scene thumb)
:point {:ref ctx :at lo} :local lo :len (- hi lo)})
(range) segments)})
annotations (for [[gid g] (:groups scene)
:when (and (= :annotation (:type g)) (child-of? scene ctx gid)
(not (:draft g)))]
{:name (:name g) :kind :annotation
:items (mapv (fn [[lo hi]]
{:label (:name g) :point {:ref ctx :at lo}
:local lo :len (- hi lo)})
(project-bars (resolve scene gid) segs))})]
(vec (concat (sort-by :name tracks) (sort-by :name annotations)))))
(defn ref-track-name
"Name of the TRACK that ref target `ref` resolves onto (its first piece),
context-independent — the useful label for a transcluded mark whose clip isn't
in the current view. The clip's own :name is the shared source file (e.g.
\"Challengers.mov\") — identical for every clip of single-source footage — so
the track (A-roll / B-roll …) is what actually distinguishes them. nil if the
ref dangles."
[scene ref]
(when-let [t (:track (first (target-segs scene ref)))]
(get-in scene [:tracks t :name] (name t))))
(defn path-to [scene gid]
(when (get-in scene [:groups gid])
(if (= gid :root) [:root] [:root gid])))
;; --- links ----------------------------------------------------------------
;; A link is a ref-point {:ref id :at n} — the same shape as a mark endpoint, so
;; it resolves through the usual machinery — named inside an annotation's markdown
;; content as `[label](mark:ref@at)`. The id is just a mark id in the flat pool:
;; a clip group (clip-scoped time), the context itself (absolute time), or another
;; annotation's mark (a moment in that annotation). We only need the ctx-local
;; frame (to seek / label it) and the pickable targets within a context.
(defn link-local
"Local frame within `ctx` for link ref-point `point`, or nil if it no longer
resolves into ctx. An absolute link (:ref = ctx) IS the local frame."
[scene ctx {:keys [ref at] :as point}]
(if (= ref ctx)
at
(when-let [{:keys [frame]} (point-frame scene ctx point)]
(source->local (content-segments scene ctx) frame))))
(defn seg-point
"Ref-point {:ref :at} for mark-time frame `f` within content-segment `seg`
(the convention selection->marks uses, so it resolves identically)."
[scene {:keys [mark src]} f]
{:ref mark :at (+ (src->at scene mark (first src)) (or f 0))})
(defn- runs
"Contiguous runs of `gid`'s marks in `ctx`-local coords, each {:id :lo :len}
where :id is the run's first mark (a discontinuous annotation lists each
piece) and :len is that first mark's frame count — the offset you can pick
into it, since the link's ref only spans that one mark."
[scene ctx gid]
(let [csegs (content-segments scene ctx)
pts (->> (:marks (grp scene gid))
(keep (fn [m] (when-let [seg (first (resolve-mark scene gid m))]
(let [[s e] (:src seg)]
{:id (:id m) :lo (source->local csegs s)
:hi (source->local csegs (dec e))}))))
(filter :lo)
(sort-by :lo))]
(reduce (fn [out {:keys [id lo hi]}]
(if-let [p (peek out)]
(if (and (:hi p) hi (<= (- lo (:hi p)) 1))
(conj (pop out) (assoc p :hi hi)) ; extend run (display only)
(conj out {:id id :lo lo :hi hi :len (inc (- hi lo))}))
[{:id id :lo lo :hi hi :len (inc (- hi lo))}]))
[] pts)))
(defn jump-targets
"One target per discontinuity for an annotation's jump popover, labelled from the
CONTENT SEGMENT the run lands on in `ctx` — its clip/track id + the frame within
it. A mark's :start is its proxy-ref ({:ref proxy :at 0}), so display-point of it
would give the proxy gid (never in `segs` → a bare \"clip\") and frame 0; instead
we read the actual clip under the run's local position, the same segments the
editor labels against. Each: {:local <ctx frame to seek> :seg <content id> :f}."
[scene ctx gid]
(let [csegs (content-segments scene ctx)]
(mapv (fn [{:keys [lo]}]
(let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs)
(some (fn [{[_ d] :local :as s} ] (when (= d lo) s)) csegs)
(last csegs))]
{:local lo
:seg (:mark seg)
:f (assert-frame "jump target frame" (- lo (first (:local seg [0 0]))))}))
(runs scene ctx gid))))
(defn linkables
"Pickable link targets within `ctx`, grouped for the autocomplete: one group
per video track (its clips, by start) and per child annotation (its run
starts). Each candidate is {:label :point {:ref :at} :local}."
[scene ctx]
(let [tracks (->> (content-segments scene ctx)
(group-by :track)
(mapv (fn [[t segs]]
(let [track-name (get-in scene [:tracks t :name] (name t))]
{:name track-name :kind :track
:items (mapv (fn [i {:keys [mark] [c d] :local :as seg}]
{:label (str track-name " (" (inc i) ")")
:search (clip-name scene mark)
:point (seg-point scene seg 0) :local c :len (- d c)})
(range)
(sort-by (comp first :local) segs))}))))
anns (->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (child-of? scene ctx gid)
(not (:draft g)))
{:name (or (:name g) (name gid)) :kind :annotation
:items (mapv (fn [{:keys [id lo len]}]
{:label (or (:name g) (name gid))
:point {:ref id :at 0} :local lo :len len})
(runs scene ctx gid))}))))]
(vec (concat (sort-by :name tracks) (sort-by :name anns)))))
(defn path-to
"Stack path from :root down to `gid` following primary-home links, or nil if an
ancestor is missing — an orphan whose home context was deleted."
[scene gid]
(loop [g gid, acc ()]
(cond
(= g :root) (vec (cons :root acc))
(or (nil? g) (not (contains? (:groups scene) g))) nil
:else (recur (home scene g) (cons g acc)))))
(defn timelines
"Every reachable timeline you can open as a context — root, plus named child
annotations whose parent chain still reaches root — each with the stack path
to reach it and its parent's name (:in) for disambiguation. Orphans (parent
deleted) are dropped."
[scene]
(defn timelines [scene]
(->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (not (:draft g)))
(when-let [path (path-to scene gid)]
(let [parent (home scene gid)]
{:gid gid :name (or (:name g) (name gid))
:in (if (or (nil? parent) (= :root parent))
"root" (get-in scene [:groups parent :name] (name parent)))
:path path})))))
{:gid gid :name (or (:name g) (name gid)) :path (path-to scene gid)})))
(sort-by :name)
(into [{:gid :root :name "root" :in nil :path [:root]}])))
(into [{:gid :root :name "root" :path [:root]}])))

View file

@ -1,21 +0,0 @@
(ns tl.storage
"Persist the authored annotation layer to localStorage as EDN. The OTIO-derived
tracks/clips/root are NOT stored — only annotation mark-groups (never drafts)."
(:require [cljs.reader :as reader]))
(def ^:private k "tl/annotations")
(defn annotations
"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)]
(try (reader/read-string s) (catch :default _ nil))))
(defn save! [scene]
(.setItem js/localStorage k (pr-str (annotations scene))))

View file

@ -6,6 +6,7 @@
(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 ::edit-context (fn [db] (get-in db [:view :edit-context])))
(rf/reg-sub ::pt (fn [db] (get-in db [:view :pt])))
;; routing / projects / auth
@ -18,7 +19,7 @@
(rf/reg-sub ::pane (fn [db] (get-in db [:view :pane] :annotations)))
(rf/reg-sub ::active-note (fn [db] (get-in db [:view :active-note])))
;; the mark most recently created/touched while authoring — drawings bind to it,
;; and the lane + form highlight it (see annotation_flow_plan.md, active-mark).
;; and the lane + form highlight it.
(rf/reg-sub ::active-mark (fn [db] (get-in db [:view :active-mark])))
;; :choosing (fresh draft — marks + title picker only) | :creating (full form).
(rf/reg-sub ::draft-stage (fn [db] (get-in db [:view :draft-stage])))
@ -52,16 +53,14 @@
(rf/reg-sub ::context :<- [::stack] (fn [stack _] (peek stack)))
;; existing annotations a draft's marks can be associated with (transclusion):
;; every reachable non-draft annotation, labelled with its home context for
;; disambiguation. The draft itself is a :draft group, so timelines omits it.
;; Any non-draft annotation can receive marks from the current context.
(rf/reg-sub
::associate-targets
:<- [::scene]
(fn [scene _]
(->> (scene/timelines scene)
(remove #(= :root (:gid %)))
(mapv #(select-keys % [:gid :name :in]))))) ; :in = home context, a display hint only
(mapv #(select-keys % [:gid :name])))))
;; the annotation group currently being authored/edited (the one flagged :draft),
;; with its group id merged in as :gid
@ -111,7 +110,7 @@
;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
(defn- in-bars? [bars ph]
(some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
(some (fn [[lo hi]] (or (= lo hi ph) (and (<= lo ph) (< ph hi)))) bars))
(defn annotations-by-parent
"Group annotation cards by every reference parent they belong to."
@ -135,16 +134,8 @@
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
(fn [[scene ctx segs revealed] _]
(let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
exists? (fn [x] (contains? (:groups scene) x))
;; each annotation → the mark-groups it's FILED UNDER (:in membership). A
;; normal annotation has one; a linked one has several, so it lists under
;; each. Asserted, not derived from where marks resolve. Any :in host that
;; no longer exists (its group was deleted) is dropped; an annotation left
;; with NO surviving host is rescued to root so it stays visible/refileable
;; instead of vanishing into a ghost parent.
parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
(let [ms (filter exists? (scene/membership scene gid))]
[gid (if (seq ms) (set ms) #{:root})])))
[gid (scene/membership scene gid)]))
;; child count per timeline (drives the "Show N" nested badge)
nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents))
;; membership-reveal hierarchy: shows when ctx is a host it's filed under,
@ -163,7 +154,6 @@
(let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
(when (shown? gid #{})
(let [reason (scene/broken-reason scene gid)
oor (boolean (scene/clip-loss? scene gid))
hidden (get-in g [:meta :hidden])
note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
distinct
@ -175,16 +165,15 @@
note-ids)
jumps (scene/jump-targets scene ctx gid)
clips (->> (:marks g)
(mapcat (fn [m] [(get-in m [:start :ref])
(get-in m [:end :ref])]))
(concat (map :seg jumps))
(mapcat :parts)
(map :clip)
(keep (fn [ref]
(let [cg (get-in scene [:groups ref])]
(or (:name cg)
(get-in cg [:media :name])
(some-> ref name)))))
distinct)]
{:id gid :parent (scene/home scene gid) ; primary home = first :in
{:id gid
;; the mark-groups this annotation is filed under (:in) — the
;; pane groups by this, so a linked annotation lists under each.
:parents (parents gid)
@ -197,7 +186,7 @@
:notes note-ids
:script (vec (remove nil? note-text))
:clips (vec clips)
:broken (boolean reason) :reason reason :oor oor
:broken (boolean reason) :reason reason
:hidden (boolean hidden)
:tags (vec (get-in g [:meta :tags]))
;; jump targets labelled from the marks' clip refs (same as
@ -272,32 +261,24 @@
;; depends only on scene/context/segments, NOT the playhead, so it's memoized here
;; and stays put while you scrub or play. The playhead-driven `active-*` subs below
;; then just do cheap interval tests. `bound` picks :notes or :drawings.
(defn- binding-bars [scene ctx segs bound]
(into []
(mapcat
(fn [[gid g]]
;; child annotations of the context OR the context annotation itself
;; (pushing the owner onto the stack makes ctx that annotation)
(when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid)))
(let [src-segs (scene/resolve scene gid)
by-mark (group-by :mark src-segs)
->bars (fn [ss] (scene/merge-bars
(mapcat (fn [{[a b] :src}] (scene/pieces segs a b)) ss)))]
(defn- binding-bars [scene ctx segs annotations bound]
(vec
(mapcat (fn [gid]
(let [g (get-in scene [:groups gid])]
(concat
;; annotation-level bindings (notes only; drawings bind per-mark)
(when-let [gs (seq (bound g))] [{:gids gs :bars (->bars src-segs)}])
;; per-mark bindings
(when (seq (bound g))
[{:gids (bound g) :bars (scene/project-bars (scene/resolve scene gid) segs)}])
(for [m (:marks g) :when (seq (bound m))]
{:gids (bound m) :bars (->bars (get by-mark (:id m)))}))))))
(:groups scene)))
{:gids (bound m) :bars (scene/mark-bars scene gid (:id m) segs)}))))
(conj (set (map :id annotations)) ctx))))
(rf/reg-sub ::drawing-bars
:<- [::scene] :<- [::context] :<- [::segments]
(fn [[scene ctx segs] _] (binding-bars scene ctx segs :drawings)))
:<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations]
(fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :drawings)))
(rf/reg-sub ::note-bars
:<- [::scene] :<- [::context] :<- [::segments]
(fn [[scene ctx segs] _] (binding-bars scene ctx segs :notes)))
:<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations]
(fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :notes)))
(defn- gids-at [entries ph]
(persistent!

View file

@ -466,42 +466,13 @@
(.addEventListener js/document "mousemove" move)
(.addEventListener js/document "mouseup" up)))
(defn- mark-drag!
"Pointer drag for a draft/edit mark's lane bar. `mode` = :move (whole mark) |
:start | :end (one edge). Converts the clientX delta to a frame delta and
rerolls the proxy live; a gesture that never moves past threshold is treated
as a plain click → draw on the mark. `lo`/`hi` = the mark's current extent."
[ann mark-id mode lo hi fps zoom ev]
(.stopPropagation ev) (.preventDefault ev)
(let [start-x (.-clientX ev)
moved? (atom false)
d-of (fn [e] (* (/ (- (.-clientX e) start-x) zoom) fps))
move (fn [e]
(let [d (d-of e)]
(when (or @moved? (> (js/Math.abs d) 3))
(reset! moved? true)
(let [[la lb] (case mode
:move [(frame-index "drag start frame" (+ lo d))
(frame-index "drag end frame" (+ hi d))]
:start [(frame-index "drag start frame" (+ lo d)) hi]
:end [lo (frame-index "drag end frame" (+ hi d))])]
(rf/dispatch [::events/reroll-proxy ann mark-id la lb])))))
up (fn up [_]
(.removeEventListener js/document "mousemove" move)
(.removeEventListener js/document "mouseup" up)
(when-not @moved? ; a click, not a drag → draw
(goto! lo true)
(rf/dispatch [::events/start-drawing ann mark-id])))]
(.addEventListener js/document "mousemove" move)
(.addEventListener js/document "mouseup" up)))
;; live drag-to-select region on the timeline (context-local [lo hi]) while
;; authoring, or nil. Deref'd in the timeline render to draw the preview band.
(defonce ^:private region-sel (r/atom nil))
(defn- region-select!
"On the timeline while authoring: DRAG to select a region [lo hi) → one
selection (a proxy). A plain CLICK (no drag) calls `on-click` — clicking a clip
mark. A plain CLICK (no drag) calls `on-click` — clicking a clip
picks it (draft-click-seg), clicking empty timeline just moves the playhead —
so both still work in marking mode. `content` is the coord ref."
[content fps zoom on-click ev]
@ -667,64 +638,30 @@
label]]))]
[:div.ann-lanes {:style {:height lane-h :width width}
:on-mouse-down #(scrub! @content fps zoom %)}
;; VISUAL bars — one rectangle per piece (solid saved, dashed draft).
;; Interaction is NOT here: a mark can span several pieces, so its
;; drag/handles live on ONE per-mark layer below (that's the fix for
;; handles-at-every-clip-boundary). Draft pieces are pointer-events
;; none so the per-mark layer receives the events.
;; Saved and selected marks use the exact same projected pieces.
(for [a visible
[j [lo hi mid]] (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)
(if linking
(do (.preventDefault e) ; pick: link to this timeline
(fn [e]
(.stopPropagation e)
(cond
(:draft a) (do (goto! lo true)
(rf/dispatch [::events/start-drawing (:id a) mid]))
linking (do (.preventDefault e)
(commit-link! {:kind :timeline :ref (:id a)} (:name a)))
;; jump the playhead to this mark and scroll its
;; card into view (don't drill into the timeline)
(do (goto! lo true)
:else (do (goto! lo true)
(when-let [node (js/document.getElementById
(str "ann-" (name (:id a))))]
(.scrollIntoView node #js {:block "center" :behavior "smooth"}))))))
(.scrollIntoView node #js {:block "center" :behavior "smooth"})))))
:style {:top (+ 2 (* (lane-of (:id a)) 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")
:pointer-events (when (:draft a) "none")
:border-radius 2
:cursor "pointer" :border-radius 2
:box-shadow (when (and (:draft a) (= mid active-mark))
"0 0 0 2px var(--ink)")
:border (str (if (:draft a) "1px dashed " "1px solid ") (:color a))}}])
;; per-MARK interaction layer (draft/edit only): each mark is ONE unit
;; spanning its whole extent — body-drag = move, click = draw, and
;; exactly two end-handles = resize (roll-proxy). No matter how many
;; visual pieces the mark has, it gets one handle pair, at its ends.
(for [a visible :when (:draft a)
mid (distinct (map #(nth % 2) (:bars a)))
;; Exact context-local extent. The drag keeps the fixed endpoint
;; at this value so its mark re-derives identically.
:let [ext (scene/mark-extent scene (:id a) mid segs)]
:when ext
:let [[lo hi] ext
active? (= mid active-mark)]]
^{:key (str "edit-" (:id a) "-" mid)}
[:div.mark-edit {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :move lo hi fps zoom e))
:style {:position "absolute" :top (+ 2 (* (lane-of (:id a)) 18)) :height 14
:left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom))
:cursor "grab" :border-radius 2
:box-shadow (when active? "0 0 0 2px var(--ink)")
:z-index (if active? 4 2)}}
(let [grip {:width 3 :height 9 :border-radius 2
:background "var(--paper)" :border "1px solid var(--ink)"}
zone {:position "absolute" :top 0 :width 9 :height "100%" :cursor "ew-resize"
:display "flex" :align-items "center" :justify-content "center"}]
[:<>
[:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :start lo hi fps zoom e))
:style (assoc zone :left -3)}
[:div {:style grip}]]
[:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :end lo hi fps zoom e))
:style (assoc zone :right -3)}
[:div {:style grip}]]])])
;; visible annotation labels
(for [a visible :let [[lo _] (first (:bars a))] :when lo]
^{:key (str "lbl-" (:id a))}
@ -1145,14 +1082,13 @@
(or (:name g) (get-in g [:media :name]) (some-> gid name)))))
;; The `in:` row — every mark-group this annotation is FILED UNDER (:in). Click a
;; chip to go there; ✕ un-files it (never its primary home). + opens a picker to
;; chip to go there; ✕ removes that visibility edge. + opens a picker to
;; file into any other group (annotation or timeline/act), at any nesting depth —
;; that's the "link across arbitrarily nested groups" gesture (search, not drag).
(defn- membership-chips [scene a authed?]
(r/with-let [adding? (r/atom false)]
(let [gid (:id a)
homes (:parents a)
prim (:parent a)
cands (->> (:groups scene)
(keep (fn [[g grp]]
(when (and (contains? #{:annotation :timeline} (:type grp))
@ -1169,7 +1105,7 @@
[::events/pop-to :root]
[::events/expand h]))}
(group-name scene h)
(when (and authed? (not= h prim))
(when authed?
[:button.in-x {:type "button" :title "Un-file"
:on-click (fn [e] (.stopPropagation e)
(rf/dispatch [::events/unfile gid h]))} "✕"])])
@ -1270,7 +1206,7 @@
(.stopPropagation e) (.preventDefault e) (reset! over? true)))
:on-drag-leave (fn [_] (reset! over? false))
;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS
;; (links, keeping the old home) — file-manager convention.
;; (links, keeping the source edge).
:on-drop (fn [e]
(let [src (.. e -dataTransfer (getData "text/ann"))]
(when (seq src)
@ -1315,7 +1251,6 @@
[:div.ann-title
[:span.ann-swatch {:style {:background (:color a)}}]
(when (:broken a) [:span.ann-warn {:title (:reason a)} "△ "])
(when (:oor a) [:span.ann-warn {:title "Out of range — trimmed by the parent timeline"} "⚠ "])
(:name a)]
[:div.ann-actions
[jump-control open a scene segs]
@ -1358,21 +1293,16 @@
nmap (into {} (map (juxt :id identity)) @(rf/subscribe [::subs/notes]))
revealed @(rf/subscribe [::subs/revealed])]
[:div.commentary
;; this context's own description (links resolve in its parent), with an
;; edit button — Edit drops into the parent timeline so marks are editable.
;; This context's description; frame links resolve in this timeline.
(let [cg (get-in scene [:groups ctx])]
[:div.ctx-content
(when (scene/clip-loss? scene ctx)
[:span.ann-warn {:title "Out of range — this annotation references frames its parent timeline trims"} "⚠ "])
(if (seq (:content cg))
[content-display scene (or (scene/home scene ctx) ctx) (:content cg)]
[content-display scene ctx (:content cg)]
[:div.muted "No description yet."])
(when authed?
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
(if (seq anns)
;; group by REFERENCE parent(s): an annotation is listed under every
;; timeline its marks were authored in (:parents), so a transcluded one
;; shows under each context it belongs to, not just its structural parent.
;; Cards follow visibility edges, independently of their footage.
(let [by-parent (subs/annotations-by-parent anns)]
(doall
(for [a (get by-parent ctx)]
@ -1393,39 +1323,17 @@
(defn- pt-len [scene segs seg]
(or (scene/seg-length segs seg) (scene/ref-length scene seg)))
(defn- frame-chip
"A filled endpoint: clip name + a mark-time frame input (edits `put` the group).
The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)."
[scene segs put d i k {:keys [seg f]}]
(let [len (pt-len scene segs seg)]
[:div.pt-chip
[:span.pt-chip-name (pt-name scene segs seg)]
[:input.pt-frame {:type "number" :min 0 :max len :value f
:on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}]
[:span.pt-dur (str "/" len)]
[:button.pt-chip-x {:type "button" :title "Re-pick this end"
:on-click (fn [e]
(.stopPropagation e)
(rf/dispatch [::events/unset-endpoint (:gid d) i k]))} "✕"]]))
(defn- proxy-frame-chip
"Editable endpoint for a proxy (synthetic-clip) mark: clip name + frame input
that edits the proxy's OWN boundary internal mark's :at in place (`which` =
:start on its first mark, :end on its last). Crossing a clip boundary is the
lane handles' job; this is the whole-frame numeric nudge within a clip. The ✕
clears just this end to re-pick it (the other end stays put)."
[scene segs gid mark-id pid which {:keys [seg f]}]
(let [len (pt-len scene segs seg)]
[:div.pt-chip
[:span.pt-chip-name (pt-name scene segs seg)]
[:input.pt-frame {:type "number" :min 0 :max len :value f
:on-change #(rf/dispatch [::events/set-proxy-frame pid which
(to-frame (.. % -target -value) len)])}]
[:span.pt-dur (str "/" len)]
[:button.pt-chip-x {:type "button" :title "Re-pick this end"
:on-click (fn [e]
(.stopPropagation e)
(rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which]))} "✕"]]))
(defn- part-editor [scene gid mid index {:keys [clip start end]}]
[:div.mark-row
[:span.pt-chip-name (or (scene/clip-name scene clip) (scene/ref-track-name scene clip))]
(for [[which value lo hi] [[:start start 0 end]
[:end end start (scene/ref-length scene clip)]]]
^{:key which}
[:label.pt-chip
(name which)
[:input.pt-frame {:type "number" :min lo :max hi :value value
:on-change #(rf/dispatch [::events/set-part-frame gid mid index which
(to-frame (.. % -target -value) hi)])}]])])
(defn- pending-frame-chip [scene segs {:keys [seg f]}]
(let [len (pt-len scene segs seg)]
@ -1537,10 +1445,7 @@
last-scrolled (atom nil)]
(let [d @(rf/subscribe [::subs/draft-group])
scene @(rf/subscribe [::subs/scene])
;; anchor the form to the draft's home context, not the live stack top:
;; a link-insert timeline preview moves the stack, but this annotation
;; still belongs to its primary home (first :in), so pickers stay stable.
ctx (or (first (:in d)) (:gid d)) ; annotation: its home; root: itself
ctx @(rf/subscribe [::subs/edit-context])
segs (scene/content-segments scene ctx)
pt @(rf/subscribe [::subs/pt])
linking @(rf/subscribe [::subs/linking])
@ -1557,10 +1462,8 @@
nmap (into {} (map (juxt :id identity)) notes)
live @(rf/subscribe [::subs/active-note-set])
active @(rf/subscribe [::subs/active-mark])
;; The root timeline's mark is absolute numeric [start/end], not a ref
;; mark. Root editing is description-only, so do not run it through the
;; annotation mark-row machinery.
rows (when-not root? (scene/marks->rows scene (:marks d)))
;; Root editing is description-only.
rows (when-not root? (scene/marks->rows scene ctx (:marks d)))
broken (if root? #{} (set (scene/broken-marks scene gid))) ; marks whose refs no longer resolve
valid? (or root? (and (not (str/blank? (:name d))) (seq (:marks d))))
save #(when valid?
@ -1625,34 +1528,13 @@
(reset! mark-drag {:src i}))} "⠿"]
(when (contains? broken mark-id)
[:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "])
;; a proxy collapses its cross-clip run to first-clip start →
;; last-clip end; each endpoint edits the proxy's own boundary
;; mark's frame (crossing a clip boundary is the lane handles).
;; A plain clip mark edits its own :at directly.
(if-let [pid (:proxy row)]
;; while re-picking one end (after its ✕) that end becomes a live
;; clip picker in the row; the other end stays a normal chip.
(let [pick (when (and (map? pt) (= (:proxy pt) pid)) (:which pt))]
[:<>
(if (= pick :start)
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
:placeholder "click a clip for start…"
:on-cancel #(rf/dispatch [::events/draft-focus :new])
:on-pick #(when-let [p (local->draft-point segs (:local %))]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]
[proxy-frame-chip scene segs gid mark-id pid :start (:s row)])
[:span.mark-arrow "→"]
(if (= pick :end)
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
:placeholder "click a clip for end…"
:on-cancel #(rf/dispatch [::events/draft-focus :new])
:on-pick #(when-let [p (local->draft-end-point segs (:local %))]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]
[proxy-frame-chip scene segs gid mark-id pid :end (:e row)])])
[:<>
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
[frame-chip scene segs put d i :end (:e row)]])
[:details
[:summary
(if (seq row)
(str/join " · " (map (fn [[lo hi]] (str lo "–" hi "f")) row))
"Outside this timeline")]
(for [[index part] (map-indexed vector (:parts mark))]
^{:key index} [part-editor scene gid mark-id index part])]
[:button.mark-draw {:type "button"
:class (when (seq (:drawings mark)) "has")
:title (if (seq (:drawings mark)) "Edit drawing on this shot" "Draw on this shot")
@ -1671,7 +1553,7 @@
(for [ng (:notes mark) :let [n (nmap ng)] :when n]
^{:key (name ng)}
[mark-note-chip ng n live #(rf/dispatch [::events/unbind-note-mark gid mark-id %])]))))]))
(when (or (= pt :new) (and (map? pt) (not (:proxy pt))))
(when (or (= pt :new) (map? pt))
[pending-mark-block {:scene scene :ctx ctx :segs segs :pt pt :choosing? choosing?}])
[:div.form-hint "Drag across the timeline to select a range (click to move the playhead)."]])
(when-not choosing?

View file

@ -1,245 +1,230 @@
(ns tl.flow-test
"Integration tests that drive the ACTUAL re-frame events the UI dispatches and
read the resulting scene AND live subscriptions back — via day8.re-frame.test's
run-test-sync, so subscriptions resolve in a real reactive context (no 'outside
reactive context' warnings) and dispatch is synchronous. A bug that lives in an
event handler or a subscription (not just a pure scene fn) is caught here.
Placement model under test: an annotation's `:in` is an ordered vector of the
mark-groups it's FILED UNDER (first = primary home). Membership is asserted;
where marks resolve only decides whether bars draw. See tl.scene/membership."
(:require [cljs.test :refer-macros [deftest is testing]]
[day8.re-frame.test :as rf-test]
[re-frame.core :as rf]
[re-frame.db :as rdb]
[tl.events :as ev]
[tl.subs :as subs]
[tl.scene :as s]))
[tl.scene :as s]
[tl.scene-test :as fixture]))
;; stub the browser/player/network fx (views registers the real player fx; we don't
;; require views here, and we never want the net in a test)
(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
:connect-scene :fetch-projects :poll-thumbnails :upload-project]]
(rf/reg-fx k (fn [_] nil)))
;; four clips on four tracks, one shared source file; root spans [0,400)
(def clips-scene
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]}
:clip-a {:type :clip :parent nil :name "Challengers.mov" :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]}
:clip-b {:type :clip :parent nil :name "Challengers.mov" :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
:clip-c {:type :clip :parent nil :name "Challengers.mov" :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}
:clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}})
(defn seed
"clips + annA (over clips A,B, filed under root) + annB (over C,D, filed under
root) + annC (one mark authored inside annA, FILED under annA)."
[]
(let [pA (s/make-proxy clips-scene :root 0 200)
pB (s/make-proxy clips-scene :root 200 400)
sc (-> clips-scene
(assoc-in [:groups :pA] pA)
(assoc-in [:groups :pB] pB)
(assoc-in [:groups :annA] {:type :annotation :in [:root] :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]})
(assoc-in [:groups :annB] {:type :annotation :in [:root] :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]}))
pInA (s/make-proxy sc :annA 10 60)]
(-> sc (assoc-in [:groups :pInA] pInA)
(assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f"
:marks [(s/proxy-ref "ca" :pInA)]}))))
(defn seed []
(let [sc (-> fixture/base
(fixture/annotation :a1 [:root] (s/make-mark fixture/base :root 0 100))
(fixture/annotation :b1 [:root] (s/make-mark fixture/base :root 100 300)))]
(fixture/annotation sc :x [:a1] (s/make-mark sc :a1 10 60))))
(defn setup! [scene stack]
(reset! rdb/app-db {:scene scene :fps 24
:view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}
:project {:id nil}}))
(reset! rdb/app-db {:scene scene :fps 24 :project {:id nil}
:view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}}))
(defn scene* [] (:scene @rdb/app-db))
(defn group [gid] (get-in (scene*) [:groups gid]))
(defn pane-ids [] (set (map :id @(rf/subscribe [::subs/all-annotations]))))
(defn draft-gid [] (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*))))
(defn pane-ids
"The set of annotation gids the pane sub currently lists (in the live context)."
[]
(set (map :id @(rf/subscribe [::subs/all-annotations]))))
(defn card [gid] (some #(when (= gid (:id %)) %) @(rf/subscribe [::subs/all-annotations])))
(defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx)))
;; =========================================================================
;; the annotation pane sub (::all-annotations) lists by membership
;; =========================================================================
(deftest moves-edit-one-edge-in-both-directions
(rf-test/run-test-sync
(setup! (seed) [:root :a1])
(let [marks (:marks (group :x))]
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/ann-drag-start :x :a1])
(rf/dispatch [::ev/reparent :x :root])
(is (= #{:root :b1} (s/membership (scene*) :x)))
(rf/dispatch [::ev/ann-drag-start :x :root])
(rf/dispatch [::ev/reparent :x :a1])
(is (= #{:a1 :b1} (s/membership (scene*) :x)))
(is (= marks (:marks (group :x)))))))
(deftest pane-lists-strictly-by-membership
(deftest moving-to-existing-destination-still-removes-source
(rf-test/run-test-sync
(setup! (seed) [:root :a1])
(rf/dispatch [::ev/file-into :x :root])
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/ann-drag-start :x :a1])
(rf/dispatch [::ev/reparent :x :root])
(is (= #{:root :b1} (s/membership (scene*) :x)))
(is (= 2 (count (:in (group :x)))))))
(deftest every-edge-is-equal-and-links-are-idempotent
(rf-test/run-test-sync
(setup! (seed) [:root])
(testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT"
(is (= #{:annA :annB} (pane-ids)))
(is (= :root @(rf/subscribe [::subs/context])))
(is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)"))
(testing "pushing annA onto the stack lists annC (its child), not annA/annB"
(rf/dispatch [::ev/expand :annA])
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
(is (= :annA @(rf/subscribe [::subs/context])))
(is (contains? (pane-ids) :annC))
(is (not (contains? (pane-ids) :annB))))
(testing "collapsing returns to root's listing"
(rf/dispatch [::ev/collapse])
(is (= #{:annA :annB} (pane-ids))))))
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/unfile :x :a1])
(is (= [:b1] (:in (group :x))))
(rf/dispatch [::ev/file-into :x :x])
(is (= [:b1] (:in (group :x))))
(rf/dispatch [::ev/file-into :x :missing])
(is (= [:b1] (:in (group :x))))))
;; =========================================================================
;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched
;; =========================================================================
(deftest reparent-move-then-link
(deftest visibility-cycles-do-not-create-content-cycles
(rf-test/run-test-sync
(setup! (seed) [:root])
(let [marks0 (get-in (scene*) [:groups :annC :marks])]
(testing "drag annC (grabbed under annA) onto root: the edge MOVES, primary follows"
(rf/dispatch [::ev/ann-drag-start :annC :annA])
(rf/dispatch [::ev/reparent :annC :root]) ; add? falsey ⇒ move
(is (= [:root] (:in (get-in (scene*) [:groups :annC]))))
(is (= :root (s/home (scene*) :annC)))
(is (= marks0 (get-in (scene*) [:groups :annC :marks])) "marks untouched by a move"))
(testing "now annC lists at root and no longer under annA"
(setup! (assoc-in (scene*) [:view] {:stack [:root] :playheads {} :revealed #{} :zoom 1 :row-h 20}) [:root])
(is (contains? (pane-ids) :annC))
(rf/dispatch [::ev/expand :annA])
(is (not (contains? (pane-ids) :annC))))
(testing "⌥-drag (add?) links annC under annB WITHOUT removing root"
(rf/dispatch [::ev/collapse])
(rf/dispatch [::ev/ann-drag-start :annC :root])
(rf/dispatch [::ev/reparent :annC :annB true])
(is (= #{:root :annB} (s/membership (scene*) :annC)))
(is (= :root (s/home (scene*) :annC)) "primary home unchanged by a link")
(is (= marks0 (get-in (scene*) [:groups :annC :marks])))))))
(let [before (s/resolve (scene*) :a1)]
(rf/dispatch [::ev/file-into :a1 :x])
(rf/dispatch [::ev/toggle-children :a1])
(rf/dispatch [::ev/toggle-children :x])
(is (= before (s/resolve (scene*) :a1)))
(is (= #{:a1 :b1 :x} (pane-ids))))))
(deftest reparent-refuses-cycles-and-noops
(deftest associate-from-sibling-adds-footage-and-visibility
(rf-test/run-test-sync
(setup! (seed) [:root])
(testing "filing annA under annC (which is filed under annA) is refused — a cycle"
(rf/dispatch [::ev/file-into :annA :annC])
(is (not (contains? (s/membership (scene*) :annA) :annC))))
(testing "filing under a group it's already filed under is a no-op"
(let [before (:in (get-in (scene*) [:groups :annC]))]
(rf/dispatch [::ev/file-into :annC :annA])
(is (= before (:in (get-in (scene*) [:groups :annC]))))))
(testing "an annotation can't be filed under itself"
(rf/dispatch [::ev/file-into :annC :annC])
(is (not (contains? (s/membership (scene*) :annC) :annC))))))
;; =========================================================================
;; unfile — remove one edge; never the primary home, never the last
;; =========================================================================
(deftest unfile-removes-links-only
(rf-test/run-test-sync
(setup! (seed) [:root])
(rf/dispatch [::ev/file-into :annC :root]) ; annC now [:annA :root]
(is (= [:annA :root] (:in (get-in (scene*) [:groups :annC]))))
(testing "unfiling a non-primary link removes just that edge"
(rf/dispatch [::ev/unfile :annC :root])
(is (= [:annA] (:in (get-in (scene*) [:groups :annC])))))
(testing "the primary home can't be unfiled (nor the last remaining edge)"
(rf/dispatch [::ev/unfile :annC :annA])
(is (= [:annA] (:in (get-in (scene*) [:groups :annC])))))))
;; =========================================================================
;; adding marks from another context (associate-marks) does NOT move placement
;; =========================================================================
(deftest associate-marks-adds-marks-not-membership
(rf-test/run-test-sync
(setup! (seed) [:root])
;; drill into annB, author a range on ITS content, tie it to annC
(rf/dispatch [::ev/expand :annB])
(setup! (seed) [:root :b1])
(rf/dispatch [::ev/open-draft])
(rf/dispatch [::ev/draft-select-range 50 150])
(let [d (draft-gid)]
(is d "a draft exists after open-draft")
(is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB")
(rf/dispatch [::ev/associate-marks d :annC]))
(testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)"
(is (= 2 (count (get-in (scene*) [:groups :annC :marks]))))
(is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks"))
;; associate opened annC in :edit; save it (drops :draft) and leave the form
(rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil])
(rf/dispatch [::ev/associate-marks (draft-gid) :x])
(is (= #{:a1 :b1} (s/membership (scene*) :x)))
(is (= 2 (count (:marks (group :x)))))
(is (contains? (pane-ids) :x))
(is (= :b1 (get-in @rdb/app-db [:view :edit-context])))
(is (= [[:a 10 60] [:b 50 100] [:c 0 50]]
(mapv (juxt :clip :start :end) (mapcat :parts (:marks (group :x))))))
(is (not-any? #(= :proxy (:type %)) (vals (:groups (scene*)))))))
(deftest edit-stays-in-current-context
(rf-test/run-test-sync
(setup! (seed) [:root :b1])
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/edit-annotation :x])
(is (= [:root :b1] (get-in @rdb/app-db [:view :stack])))
(is (= :b1 (get-in @rdb/app-db [:view :edit-context])))))
(deftest range-edit-and-cancel-are-local-to-the-mark
(rf-test/run-test-sync
(setup! (seed) [:root :a1])
(let [original (group :x)
mid (:id (first (:marks original)))
groups (set (keys (:groups (scene*))))]
(rf/dispatch [::ev/edit-annotation :x])
(rf/dispatch [::ev/set-part-frame :x mid 0 :end 80])
(rf/dispatch [::ev/set-part-frame :x mid 0 :start 30])
(is (= [{:clip :a :start 30 :end 80}] (:parts (first (:marks (group :x))))))
(rf/dispatch [::ev/restore-group :x original])
(rf/dispatch [::ev/finish-edit])
(testing "so annC does NOT list under annB — even though its footage resolves there"
(is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB")
(is (= 1 (count (bars-in :annB :annC))) "but its B-mark DOES draw a bar in annB (resolution ≠ membership)")
(is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2))))
(testing "filing it in explicitly is what makes it list under annB"
(rf/dispatch [::ev/file-into :annC :annB])
(is (contains? (pane-ids) :annC))
(is (= #{:annA :annB} (s/membership (scene*) :annC))))))
(is (= original (group :x)))
(is (= groups (set (keys (:groups (scene*)))))))))
;; =========================================================================
;; stack push / pop and reveal-children through the real events
;; =========================================================================
(deftest endpoint-edit-preserves-mark-identity-and-bindings
(rf-test/run-test-sync
(setup! (assoc-in (seed) [:groups :x :marks 0 :drawings] [:drawing]) [:root :a1])
(let [mid (:id (first (:marks (group :x))))]
(rf/dispatch [::ev/edit-annotation :x])
(rf/dispatch [::ev/set-part-frame :x mid 0 :start 20])
(is (= 20 (get-in (group :x) [:marks 0 :parts 0 :start])))
(rf/dispatch [::ev/set-part-frame :x mid 0 :end 90])
(is (= mid (get-in (group :x) [:marks 0 :id])))
(is (= [:drawing] (get-in (group :x) [:marks 0 :drawings])))
(is (= [{:clip :a :start 20 :end 90}] (get-in (group :x) [:marks 0 :parts]))))))
(deftest stack-navigation-and-reveal
(deftest deleting-context-does-not-delete-footage
(rf-test/run-test-sync
(setup! (seed) [:root])
(testing "expand pushes, pop-to truncates, collapse pops"
(rf/dispatch [::ev/expand :annA])
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
(rf/dispatch [::ev/collapse])
(is (= [:root] (:stack (:view @rdb/app-db))))
(rf/dispatch [::ev/expand :annA])
(rf/dispatch [::ev/pop-to :root])
(is (= [:root] (:stack (:view @rdb/app-db)))))
(testing "at root, revealing annA surfaces its child annC in the SAME pane list"
(is (not (contains? (pane-ids) :annC)) "hidden until annA is revealed")
(is (pos? (:nested (card :annA))) "annA advertises a nested child")
(rf/dispatch [::ev/toggle-children :annA])
(is (contains? (pane-ids) :annC) "revealed → annC shows as annA's child at root"))))
(let [before (s/resolve (scene*) :x)]
(rf/dispatch [::ev/delete-annotation :a1])
(is (= before (s/resolve (scene*) :x)))
(is (= [:root :x] (s/path-to (scene*) :x)))
(is (contains? (pane-ids) :x)))))
;; =========================================================================
;; real-data hazard: an annotation whose only host was deleted (an orphan)
;; must NOT vanish — the pane rescues it to root so it stays refileable.
;; (found by loading the actual Challengers project: 3/15 annotations were
;; filed under a since-deleted parent.)
;; =========================================================================
(deftest orphaned-annotation-is-rescued-to-root
(deftest peer-delta-decodes-current-format
(rf-test/run-test-sync
;; annC's sole host (annA) is deleted out from under it, as if by restore of
;; stale data or a peer deleting the parent
(setup! (update (seed) :groups dissoc :annA) [:root])
(testing "annC's :in still points at the now-missing annA"
(is (= [:annA] (:in (get-in (scene*) [:groups :annC]))))
(is (nil? (get-in (scene*) [:groups :annA]))))
(testing "but the pane rescues it to root rather than dropping it"
(is (contains? (pane-ids) :annC) "orphan is visible at root, not lost")
(is (= #{:root} (:parents (card :annC))) "listed under root until re-filed"))
(testing "and it can be re-filed normally from there"
(rf/dispatch [::ev/file-into :annC :annB])
(is (contains? (s/membership (scene*) :annC) :annB)))))
;; =========================================================================
;; JSON wire round-trip of :in (vector, keyworded) via restore-annotations
;; =========================================================================
(deftest legacy-parent-data-migrates-through-peer-delta
(rf-test/run-test-sync
(setup! clips-scene [:root])
;; a reload/peer delivers a legacy annotation — string :parent, no :in, exactly
;; the shape stored in the real DB before the membership migration
(setup! fixture/base [:root])
(rf/dispatch [::ev/peer-delta
{:changed {:ann-legacy {:type "annotation" :parent "root" :name "L"
:marks [{:id "lm" :start {:ref "clip-a" :at 0}
:end {:ref "clip-a" :at 50}}]}}
{:changed {:x {:type "annotation" :in ["root"] :name "X"
:marks [{:id "m" :parts [{:clip "a" :start 10 :end 50}]}]}}
:deleted []}])
(testing "it migrates :parent -> :in [:root] on ingest and drops the old field"
(is (= [:root] (:in (get-in (scene*) [:groups :ann-legacy]))))
(is (nil? (:parent (get-in (scene*) [:groups :ann-legacy])))))
(testing "and shows up in the root pane like any other"
(is (contains? (pane-ids) :ann-legacy)))))
(is (= #{:x} (pane-ids)))
(is (= [{:clip :a :start 10 :end 50}] (get-in (group :x) [:marks 0 :parts])))
(is (= [[1010 1050]] (mapv :src (s/resolve (scene*) :x))))
(is (= (group :x) (:x (fixture/wire {:x (group :x)}))))))
(deftest membership-survives-the-json-wire
(deftest revealed-cards-and-bound-drawings-share-visibility
(rf-test/run-test-sync
(setup! (-> (seed)
(assoc-in [:groups :x :marks 0 :drawings] [:d])
(assoc-in [:groups :d] {:type :drawing :strokes []})
(assoc-in [:groups :x :marks 0 :notes] [:n])
(assoc-in [:groups :n] {:type :script-note :regions []}))
[:root])
(rf/dispatch [::ev/set-playhead :root 20])
(is (not (contains? (pane-ids) :x)))
(is (empty? @(rf/subscribe [::subs/active-drawings])))
(rf/dispatch [::ev/toggle-children :a1])
(is (contains? (pane-ids) :x))
(is (= [:d] (mapv :id @(rf/subscribe [::subs/active-drawings]))))
(is (= #{:n} @(rf/subscribe [::subs/active-note-set])))))
(deftest nested-repeat-projection-is-shared-by-editor-and-lane
(rf-test/run-test-sync
(setup! fixture/base [:root])
(rf/dispatch [::ev/open-draft])
(rf/dispatch [::ev/draft-select-range 10 20])
(let [outer (draft-gid)
original (first (:marks (group outer)))
repeated (assoc (group outer) :name "repeat" :marks
[original (assoc original :id :second)])]
(rf/dispatch [::ev/save-group outer (dissoc repeated :draft) nil])
(rf/dispatch [::ev/finish-edit])
(rf/dispatch [::ev/expand outer])
(is (= [[1010 1020] [1010 1020]] (mapv :src (s/resolve (scene*) outer))))
(rf/dispatch [::ev/open-draft])
(rf/dispatch [::ev/draft-select-range 2 18])
(let [inner (draft-gid)
mark (first (:marks (group inner)))
sc (scene*)]
(is (= [(fixture/part :a 12 20) (fixture/part :a 10 18)] (:parts mark)))
(is (= [[0 20]] (first (s/marks->rows sc outer [mark])))
"Both raw slices project onto both repetitions; touching pieces coalesce")
(is (= (first (s/marks->rows sc outer [mark]))
(mapv #(subvec % 0 2) (s/lane-bars sc inner (s/content-segments sc outer)))))
(rf/dispatch [::ev/file-into outer :root])
(rf/dispatch [::ev/save-group inner (dissoc (group inner) :draft) nil])
(rf/dispatch [::ev/finish-edit])
(rf/dispatch [::ev/expand inner])
(is (= [[1012 1020] [1010 1018]] (mapv :src (s/resolve (scene*) inner))))
(rf/dispatch [::ev/open-draft])
(rf/dispatch [::ev/draft-select-range 6 10])
(is (= [(fixture/part :a 18 20) (fixture/part :a 10 12)]
(:parts (first (:marks (group (draft-gid)))))))))))
(deftest editing-disjoint-reordered-repeated-parts-never-fills-gaps
(rf-test/run-test-sync
(let [parts [(fixture/part :c 10 20) (fixture/part :a 10 20) (fixture/part :c 10 20)]
mark (assoc (apply fixture/mark :m parts) :drawings [:d] :notes [:n])]
(setup! (fixture/annotation fixture/base :x [:root] mark) [:root])
(rf/dispatch [::ev/edit-annotation :x])
(is (= [[[10 20] [210 220]]]
(s/marks->rows (scene*) :root (:marks (group :x)))))
(rf/dispatch [::ev/set-part-frame :x :m 1 :start 12])
(let [edited (first (:marks (group :x)))]
(is (= (assoc-in parts [1 :start] 12) (:parts edited)))
(is (= [:c :a :c] (mapv :clip (:parts edited))))
(is (= [:d] (:drawings edited)))
(is (= [:n] (:notes edited)))
(is (= [[3010 3020] [1012 1020] [3010 3020]]
(mapv :src (s/resolve (scene*) :x))))
(is (= [[[12 20] [210 220]]] (s/marks->rows (scene*) :root [edited])))))))
(deftest endpoint-crossing-clamps-to-an-instant
(rf-test/run-test-sync
(setup! (seed) [:root :a1])
(let [mid (:id (first (:marks (group :x))))]
(rf/dispatch [::ev/set-part-frame :x mid 0 :end 5])
(is (= [(fixture/part :a 10 10)] (get-in (group :x) [:marks 0 :parts])))
(is (= [[1010 1010]] (mapv :src (s/resolve (scene*) :x))))
(rf/dispatch [::ev/set-part-frame :x mid 0 :end 1000])
(rf/dispatch [::ev/set-part-frame :x mid 0 :start -10])
(is (= [(fixture/part :a 0 100)] (get-in (group :x) [:marks 0 :parts]))))))
(deftest last-edge-removal-remains-discoverable-at-root
(rf-test/run-test-sync
(setup! (seed) [:root])
(rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root]
(let [g (get-in (scene*) [:groups :annC])
;; exactly what api/put-scene serializes then reads back
wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true)
back (:annC (s/restore-annotations {:annC wire}))]
(is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)")
(is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved")
(is (= :annA (s/home {:groups {:annC back}} :annC))))))
(rf/dispatch [::ev/unfile :x :a1])
(is (contains? (pane-ids) :x))
(rf/dispatch [::ev/ann-drag-start :x :root])
(rf/dispatch [::ev/reparent :x :b1])
(is (= #{:b1} (s/membership (scene*) :x)))
(is (not (contains? (pane-ids) :x)))))

View file

@ -4,391 +4,152 @@
[tl.otio :as otio]
[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}]}
;; :start = timeline position; here it equals source so root is identity
:clip-a {:type :clip :parent nil :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]}
:clip-b {:type :clip :parent nil :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
:clip-c {:type :clip :parent nil :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}}})
{:tracks {:t0 {:name "A"} :t1 {:name "B"} :t2 {:name "C"}}
:groups {:root {:type :timeline}
:a {:type :clip :track :t0 :start 0 :source 1000 :duration 100}
:b {:type :clip :track :t1 :start 100 :source 2000 :duration 100}
:c {:type :clip :track :t2 :start 200 :source 3000 :duration 100}}})
(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}})
(defn err-msg [f]
(try (f) nil (catch js/Error e (.-message e))))
(defn part [clip start end] {:clip clip :start start :end end})
(defn mark [id & parts] {:id id :parts (vec parts)})
(defn annotation [scene gid edges & marks]
(assoc-in scene [:groups gid] {:type :annotation :name (name gid) :in edges :marks (vec marks)}))
(defn wire [groups]
(s/restore-annotations (js->clj (js/JSON.parse (js/JSON.stringify (clj->js groups))) :keywordize-keys true)))
(defn err-msg [f] (try (f) nil (catch js/Error e (.-message e))))
;; 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 :in [: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 :in [: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"
(deftest root-distinguishes-timeline-and-source-time
(let [segs (s/resolve base :root)]
(is (= 300 (s/length segs)))
(is (= 250 (s/local->source segs 250)))
(is (= [0 300] (:src (first segs)))))))
(is (= [0 100 200] (mapv (comp first :local) segs)))
(is (= [1000 2000 3000] (mapv (comp first :src) segs)))
(is (= 2005 (s/local->source segs 105)))
(is (= #{:t0 :t1 :t2} (s/tracks 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 :in [: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 compilation-preserves-order-repeats-and-trims
(let [sc (annotation base :x [:root]
(mark :m (part :c 20 40) (part :a 0 10) (part :c 20 40)))
segs (s/resolve sc :x)]
(is (= [[3020 3040] [1000 1010] [3020 3040]] (mapv :src segs)))
(is (= [[0 20] [20 30] [30 50]] (mapv :local segs)))
(is (= [3025 1005 3025] (mapv #(s/local->source segs %) [5 25 35])))
(is (= [:m :m :m] (mapv :mark segs)))))
(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 (= [:clip-b :clip-a :clip-b :clip-a] (map :thumb segs)))
(is (= [50 0 0 50] (map :thumb-start segs)))
(is (= #{:t1 :t0} (s/tracks segs))))))
(deftest selections-own-raw-clip-slices
(let [sc (annotation base :x [:root]
(mark :m (part :b 50 100) (part :a 0 50) (part :b 0 50)))
selection (s/make-mark sc :x 40 110)
sc (annotation sc :y [:x] selection)
before (s/resolve sc :y)]
(is (= [(part :b 90 100) (part :a 0 50) (part :b 0 10)] (:parts selection)))
(is (= before (s/resolve (update sc :groups dissoc :x) :y)))
(is (= before (s/resolve (assoc-in sc [:groups :y :in] [:root]) :y)))
(is (= before (s/resolve (assoc-in sc [:groups :x :marks] []) :y)))))
(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 :in [:root]
:marks [{:id :m/s :start {:ref :clip-a :at 20}
:end {:ref :clip-a :at 80}}]})
(with-group :ann-y {:type :annotation :in [: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 selection-through-repeated-footage
(let [sc (annotation base :x [:root] (mark :m (part :a 20 40) (part :a 60 90)))
segs (s/content-segments sc :x)
mid (:mark (second segs))
lo (s/seg-local segs mid 5)]
(is (= 2 (count (distinct (map :mark segs)))))
(is (= 30 (s/seg-length segs mid)))
(is (= 25 lo))
(is (= [(part :a 65 70)] (s/selection->parts sc :x lo (+ lo 5))))))
(deftest tracks-by-membership
(testing "zoom includes exactly the tracks the marks touch"
(let [scene (with-group base :ann
{:type :annotation :in [: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 one-mark-one-row-no-extra-entities
(let [m (s/make-mark base :root 40 210)]
(is (= [(part :a 40 100) (part :b 0 100) (part :c 0 10)] (:parts m)))
(is (= [[[40 210]]] (s/marks->rows base :root [m])))))
(deftest repeat-yields-two-pieces
(testing "a clip referenced twice renders at two local positions"
(let [scene (with-group base :ann
{:type :annotation :in [: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
(deftest projection-preserves-root-clip-identity
(let [sc (-> base
(assoc-in [:groups :b :source] 1000)
(annotation :x [:root] (mark :m (part :a 10 20))))]
(is (= [[10 20 :m]] (s/lane-bars sc :x (s/content-segments sc :root))))))
;; =========================================================================
;; Suite 2 — authoring lifecycle (annotate A, push A, annotate B, mess with A)
;; =========================================================================
(deftest projection-shows-every-repeat
(let [sc (-> base
(annotation :context [:root] (mark :r (part :a 0 100) (part :b 0 100) (part :a 0 100)))
(annotation :x [:context] (mark :m (part :a 10 20))))]
(is (= [[10 20 :m] [210 220 :m]]
(s/lane-bars sc :x (s/content-segments sc :context))))))
(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 contiguity-is-defined-by-render-context
(let [sc (-> base
(annotation :context [:root] (mark :r (part :c 0 100) (part :a 0 100)))
(annotation :x [:context] (mark :m (part :a 0 20) (part :c 80 100))))]
(is (= [[80 120 :m]] (s/lane-bars sc :x (s/content-segments sc :context))))
(is (= [[0 20 :m] [280 300 :m]] (s/lane-bars sc :x (s/content-segments sc :root))))))
(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 projection-clips-partial-overlap-without-changing-content
(let [sc (-> base
(annotation :context [:root] (mark :r (part :a 30 70)))
(annotation :x [:context] (mark :m (part :a 10 50))))
before (s/resolve sc :x)]
(is (= [[0 20 :m]] (s/lane-bars sc :x (s/content-segments sc :context))))
(is (= before (s/resolve sc :x)))))
(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 distinct-marks-never-merge
(let [sc (annotation base :x [:root] (mark :m1 (part :a 0 100)) (mark :m2 (part :b 0 100)))]
(is (= [[0 100 :m1] [100 200 :m2]] (s/lane-bars sc :x (s/content-segments sc :root))))))
(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 instant-and-boundary-frames
(let [sc (annotation base :x [:root] (assoc (s/make-mark base :root 100 100) :id :instant))]
(is (= [(part :b 0 0)] (get-in sc [:groups :x :marks 0 :parts])))
(is (= [[100 100 :instant]] (s/lane-bars sc :x (s/content-segments sc :root))))
(is (= 0 (s/length (s/resolve sc :x))))))
(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 visibility-is-independent-of-compilation
(let [sc (annotation base :x [:root] (mark :m (part :a 0 100)))
moved (assoc-in sc [:groups :x :in] [:other :root])]
(is (= (s/resolve sc :x) (s/resolve moved :x)))
(is (= #{:root} (s/membership moved :x)))
(is (= (s/resolve moved :x)
(s/resolve (assoc-in moved [:groups :x :in] [:root :other]) :x)))))
(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
(deftest missing-clips-are-reported-with-valid-parts-still-visible
(let [sc (annotation base :x [:root] (mark :m (part :missing 0 10) (part :a 0 20)))]
(is (= [:m] (s/broken-marks sc :x)))
(is (= [[1000 1020]] (mapv :src (s/resolve sc :x))))
(is (some? (s/broken-reason sc :x)))))
;; =========================================================================
;; Suite 2b — proxy synthetic-clips (marks-first authoring)
;; =========================================================================
(deftest json-roundtrip-covers-all-authored-types
(let [groups {:x {:type :annotation :in [:root :other] :name "X" :notes [:n]
:marks [(assoc (mark :m (part :a 10 30)) :drawings [:d] :notes [:n])]}
:n {:type :script-note :regions [{:id :r :kind :text :text "hello"}]}
:d {:type :drawing :strokes []}}]
(is (= groups (wire groups)))
(is (= (s/resolve (update base :groups merge groups) :x)
(s/resolve (update base :groups merge (wire groups)) :x)))))
(deftest proxy-resolves-as-one-collapsed-mark
(testing "an annotation referencing a whole proxy resolves to the proxy's full
per-clip run — scattered-source clips pieced back together"
(let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210)
scene (-> base
(with-group :prox p)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 170 (s/length segs))) ; 60 + 100 + 10
(is (= 40 (s/local->source segs 0))) ; A from frame 40
(is (= 100 (s/local->source segs 60))) ; boundary into B
(is (= 200 (s/local->source segs 160))) ; boundary into C
(is (= #{:t0 :t1 :t2} (s/tracks segs))) ; every crossed clip's track
(is (= :m/px (:mark (first segs))))))) ; the one addressable unit
(deftest links-and-jumps-use-context-projection
(let [sc (annotation base :x [:root] (mark :m (part :a 20 30) (part :c 50 60)))
seg (first (s/content-segments sc :x))]
(is (= {:ref :a :at 25} (s/seg-point sc seg 5)))
(is (= 5 (s/link-local sc :x {:ref :a :at 25})))
(is (nil? (s/link-local sc :x {:ref :b :at 25})))
(is (= 42 (s/link-local sc :root {:ref :root :at 42})))
(is (= [20 250] (mapv :local (s/jump-targets sc :root :x))))
(is (= [20 50] (mapv :f (s/jump-targets sc :root :x))))
(is (= 4 (count (s/linkables sc :root))))))
(deftest proxy-of-a-single-clip-is-just-that-clip
(testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip"
(let [p (s/make-proxy base :root 10 60) ; inside A only
scene (-> base (with-group :prox p)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 1 (count (:marks p))))
(is (= 50 (s/length segs)))
(is (= [10 60] (:src (first segs)))))))
(deftest navigation-does-not-follow-visibility
(let [sc (-> base (annotation :x [:y]) (annotation :y [:x]))]
(is (= [:root :x] (s/path-to sc :x)))
(is (= #{:root :x :y} (set (map :gid (s/timelines sc)))))
(is (nil? (s/path-to sc :missing)))))
(deftest roll-proxy-keeps-interior-ids-stable
(testing "growing/shrinking a proxy's endpoints keeps interior ids and edits
boundary marks in place (added out, dropped in)"
(let [p0 (s/make-proxy base :root 40 210) ; A-tail, B, C-head
[a0 b0 c0] (mapv :id (:marks p0))
grow (s/roll-proxy base :root p0 40 300) ; roll end OUT to full C
shrink (s/roll-proxy base :root p0 110 210)] ; roll start IN, dropping A
(is (= 3 (count (:marks p0))))
(testing "grow keeps all three ids; C's boundary mark is edited in place to full"
(is (= [a0 b0 c0] (mapv :id (:marks grow))))
(is (= 100 (get-in (nth (:marks grow) 2) [:end :at]))))
(testing "shrink drops A, keeps B and C ids"
(is (= [b0 c0] (mapv :id (:marks shrink))))))))
(deftest integer-frame-invariants
(is (re-find #"integer frame" (err-msg #(s/selection->parts base :root 0.5 20))))
(is (re-find #"ordered" (err-msg #(s/selection->parts base :root 20 10))))
(is (= [[0 30] [40 50]] (s/merge-bars [[20 30] [0 20] [40 50]]))))
(deftest proxy-mark-collapses-to-one-row
(testing "a proxy ref renders as ONE editor row: first-clip start → last-clip end"
(let [p (s/make-proxy base :root 40 210) ; A-tail, B, C-head
scene (-> base (with-group :prox p))
rows (s/marks->rows scene [(s/proxy-ref :m/px :prox)])]
(is (= 1 (count rows)))
(is (= :prox (:proxy (first rows))))
(is (= {:seg :clip-a :f 40} (:s (first rows)))) ; A from frame 40
(is (= {:seg :clip-c :f 10} (:e (first rows))))))) ; C to frame 10
(deftest plain-clip-mark-still-renders-a-pair
(testing "a non-proxy mark keeps the editable clip→clip row (no :proxy tag)"
(let [rows (s/marks->rows base [(refm :m/m :clip-a 0 -1)])]
(is (nil? (:proxy (first rows))))
(is (= {:seg :clip-a :f 0} (:s (first rows))))
(is (= {:seg :clip-a :f 100} (:e (first rows)))))))
(deftest lane-bars-keep-distinct-marks-separate
(testing "two abutting but DISTINCT marks render as two bars, not one fused bar;
a single cross-clip proxy still coalesces to one bar"
(let [p1 (s/make-proxy base :root 0 200) ; A+B
p2 (s/make-proxy base :root 200 300) ; C (abuts B)
scene (-> base (with-group :p1 p1) (with-group :p2 p2)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/1 :p1)
(s/proxy-ref :m/2 :p2)]}))
segs (s/content-segments scene :root)
bars (s/lane-bars scene :ann segs)]
(is (= [[0 200 :m/1] [200 300 :m/2]] bars)) ; two marks → two bars, tagged + apart
(is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi]
;; and a single cross-clip proxy on its own is one contiguous bar
(let [one (-> base (with-group :p1 p1)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/1 :p1)]}))]
(is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root))))))))
(deftest proxy-survives-restore-roundtrip
(testing "a proxy group (string :type/:parent, string mark ids/refs from JSON)
re-keywords and still resolves through a referencing annotation"
(let [json-like {:prox {:type "proxy" :parent nil
:marks [{:id "p0" :start {:ref "clip-a" :at 40} :end {:ref "clip-a" :at 100}}
{:id "p1" :start {:ref "clip-b" :at 0} :end {:ref "clip-b" :at 100}}
{:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}}
back (:prox (s/restore-annotations json-like))
scene (-> base (with-group :prox back)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))]
(is (= :proxy (:type back)))
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded
(is (= 170 (s/length (s/resolve scene :ann))))))) ; resolves whole
(deftest content-segments-in-a-drilled-proxy-annotation-keeps-clips-distinct
(testing "drilling INTO a proxy-backed range annotation exposes each underlying
clip as its OWN content-segment (distinct :mark, track, length) — NOT
all collapsed under the annotation's single mark id, which made every
clip read with the FIRST piece's name + length and blocked saving a
sub-range selection (the resolve/rebase collapse bug)"
(let [p (s/make-proxy base :root 40 210) ; A-tail=60, B=100, C-head=10
scene (-> base
(with-group :prox p)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/content-segments scene :ann)
ids (mapv :mark segs)]
(is (= 170 (s/length segs)))
(is (= 3 (count segs)))
(is (= 3 (count (distinct ids)))) ; pieces stay distinct…
(is (not-any? #{:m/px} ids)) ; …and are NOT the annotation's mark
(is (= [:t0 :t1 :t2] (mapv :track segs))) ; each keeps its own track
;; per-piece lengths + the seg-length / seg-local lookups the editor & save
;; check rely on — previously every one returned the first piece's numbers
(is (= [60 100 10] (mapv (fn [{[c d] :local}] (- d c)) segs)))
(is (= [60 100 10] (mapv #(s/seg-length segs %) ids)))
(is (= [0 60 160] (mapv #(s/seg-local segs % 0) ids)))))
(testing "resolve (the LANE view) still collapses the proxy under the annotation's
one mark id — one bar per mark — so the two views stay distinct"
(let [p (s/make-proxy base :root 40 210)
scene (-> base (with-group :prox p)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))]
(is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann))))))))
(deftest transcluded-mark-labels-resolve-down-to-the-clip
(testing "a mark whose ref target isn't in the CURRENT context (collected into an
annotation from another timeline — transclusion) still gets a length +
a useful TRACK label by resolving the ref chain down to its clip, not by
a context lookup (which returns 'clip' / no length for a foreign ref).
The clip's :name is the shared source file, so the TRACK is the label."
(let [named (-> base
(assoc-in [:groups :clip-a :name] "Challengers.mov")) ; single-source
pA (s/make-proxy named :root 0 100) ; proxy over clip-a (track t0 = "A-roll")
aid (:id (first (:marks pA))) ; A's sub-clip mark (refs clip-a)
pin {:type :proxy :parent nil ; a mark authored INSIDE A
:marks [{:id :sub-c :start {:ref aid :at 0} :end {:ref aid :at -1}}]}
scene (-> named
(with-group :pA pA)
(with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
(with-group :pin pin))]
;; the ref chain :sub-c → aid → clip-a bottoms out at a clip from anywhere
(is (= 100 (s/ref-length scene :sub-c))) ; clip-a's length, no context
(is (= "A-roll" (s/ref-track-name scene :sub-c))) ; the TRACK, not "Challengers.mov"
(is (= 100 (s/ref-length scene :pin))) ; the whole proxy resolves the same
(is (= "A-roll" (s/ref-track-name scene :pin)))
(is (nil? (s/ref-track-name scene :nope)))))) ; a dangling ref → nil, not a throw
(deftest placement-is-membership-listing-is-decoupled-from-where-bars-draw
(testing "an annotation LISTS under the mark-groups in its :in (asserted), while
its bars DRAW wherever its marks resolve (footage ∩ ctx). The two are
independent: a mark authored on annB's content still draws in annB even
when the annotation is only filed under annA — and it does NOT list in
annB until it's filed there."
(let [four (assoc-in base [:groups :clip-d]
{:type :clip :parent nil :name "D" :start 300
:marks [{:id :m/d :start 300 :end 400 :track :t0}]})
four (assoc-in four [:groups :root :marks] [{:id :m/root :start 0 :end 400}])
pA (s/make-proxy four :root 0 200) ; annA over clips A,B
pB (s/make-proxy four :root 200 400) ; annB over clips C,D
scene (-> four (with-group :pA pA) (with-group :pB pB)
(with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
(with-group :annB {:type :annotation :in [:root] :marks [(s/proxy-ref :mB :pB)]}))
;; annC is FILED under annA only, but holds a mark authored on annA's
;; content AND a mark authored on annB's content (C-tail + D-head)
pInA (s/make-proxy scene :annA 10 60)
pInB (s/make-proxy scene :annB 50 150)
scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB)
(with-group :annC {:type :annotation :in [:annA]
:marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}))]
;; MEMBERSHIP (listing) is exactly :in — asserted, single here
(is (= #{:annA} (s/membership scene :annC)))
(is (= :annA (s/home scene :annC))) ; primary = first :in
(is (s/child-of? scene :annA :annC))
(is (not (s/child-of? scene :annB :annC))) ; NOT filed under B → not listed there
(is (not (s/child-of? scene :root :annC)))
;; RESOLUTION (bars) is independent of membership: the cb mark still draws in
;; annB's lane because its FOOTAGE lands there, even though annC isn't filed in B
(is (= [[50 150 "cb"]] (s/lane-bars scene :annC (s/content-segments scene :annB))))
(is (seq (s/lane-bars scene :annC (s/content-segments scene :annA))))
;; filing annC into annB (an assertion) makes it LIST there too; bars unchanged
(let [scene2 (assoc-in scene [:groups :annC :in] [:annA :annB])]
(is (s/child-of? scene2 :annB :annC))
(is (= #{:annA :annB} (s/membership scene2 :annC)))
(is (= :annA (s/home scene2 :annC))) ; primary still first
(is (= [[50 150 "cb"]] (s/lane-bars scene2 :annC (s/content-segments scene2 :annB))))))))
(deftest jump-targets-label-from-the-clip-not-the-proxy
(testing "a discontinuous annotation's jump popover labels each target from the
CLIP it lands on (+ the frame within it), not from the mark's proxy-ref
start — which would give the proxy gid (→ a bare 'clip') and frame 0"
(let [pa (s/make-proxy base :root 0 50) ; within clip A
pc (s/make-proxy base :root 250 300) ; within clip C (non-adjacent → 2 runs)
scene (-> base (with-group :pa pa) (with-group :pc pc)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :ma :pa) (s/proxy-ref :mc :pc)]}))
segs (s/content-segments scene :root)
jumps (s/jump-targets scene :root :ann)]
(is (= 2 (count jumps))) ; two discontinuous runs
(is (not-any? #{:pa :pc} (map :seg jumps))) ; NOT the proxy gids ("clip 0f")
(is (every? (fn [j] (some #(= (:seg j) (:mark %)) segs)) jumps)) ; every :seg is a real content id → labelable
(is (= [:clip-a :clip-c] (mapv :seg jumps))) ; the clips the runs land on
(is (= [0 50] (mapv :f jumps)))))) ; frame within each clip (250 → C+50)
;; =========================================================================
;; 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))]
(deftest playheads-are-per-context
(let [v (-> {} (s/set-playhead :root 30) (s/set-playhead :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
(is (= [:clip-b :clip-a] (map :thumb segs)))
(is (= [60 0] (map :thumb-start segs))))))
(deftest seek-only-at-boundaries
(testing "source advances 1:1 within a subclip and jumps only at a boundary"
(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
(is (= 80 (s/playhead v :x)))
(is (= 0 (s/playhead v :unvisited)))))
(deftest seed-from-otio
(testing "from-otio seeds tracks + clip mark-groups + root; content-segments at root tiles the clips"
@ -444,220 +205,5 @@
media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))]
(is (seq media-ins))
(is (every? integer? media-ins))
(is (every? integer? (mapcat (fn [[_ g]]
(mapcat (juxt :start :end) (:marks g)))
(:groups scene)))))))
(deftest selection-rejects-fractional-frames
(testing "a selection over fractional clip layout fails instead of changing frames"
(let [scene {:tracks {:t0 {:name "W"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/r :start 0 :end 100}]}
:fr {:type :clip :parent nil :start 0.3 ; fractional timeline pos
:marks [{:id :m/fr :start 10.4 :end 110.4 :track :t0}]}}}
msg (err-msg #(s/selection->marks scene :root 20 60))]
(is (re-find #"integer frame" msg)))))
;; =========================================================================
;; 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 :in [: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 merge-bars-coalesces-continuous-integer-runs
(testing "integer-adjacent bars merge; fractional bars fail"
(is (= [[128 542]]
(s/merge-bars [[128 191] [191 266] [266 386]
[386 414] [414 542]])))
(is (= [[0 50] [200 260]] (s/merge-bars [[0 50] [200 260]]))) ; real gap → two
(is (re-find #"integer frame" (err-msg #(s/merge-bars [[0.2 50]]))))
(is (= [] (s/merge-bars [])))))
(deftest restore-annotations-rekeywordizes-json
(testing "a JSON-roundtripped annotation (string :type/:parent/:ref) is restored + resolves"
(let [json-like {:ann-1 {:type "annotation" :parent "root" :name "x"
:marks [{:id "m1" :start {:ref "clip-a" :at 0}
:end {:ref "clip-a" :at -1}}]}}
g (:ann-1 (s/restore-annotations json-like))]
(is (= :annotation (:type g)))
(is (= [:root] (:in g))) ; legacy :parent migrated to an :in edge
(is (nil? (:parent g))) ; and the old field is dropped
(is (= :clip-a (get-in g [:marks 0 :start :ref])))
(let [scene (assoc-in base [:groups :ann-1] g)]
(is (= [0 100] (:src (first (s/resolve scene :ann-1)))))))))
(defn- json-roundtrip [x]
(js->clj (js/JSON.parse (js/JSON.stringify (clj->js x))) :keywordize-keys true))
(deftest annotations-survive-json-roundtrip
(testing "restore-annotations is the exact inverse of the JSON wire trip — guards
against any keyword-valued field (id/ref/type/parent/track) being missed"
(let [anns {:ann-p {:v s/schema-version :type :annotation :in [:root] :name "p" :color "#abc" :content "hi"
:marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]}
:ann-c {:v s/schema-version :type :annotation :in [:ann-p] :name "c"
:marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}]
(is (= anns (s/restore-annotations (json-roundtrip anns)))))))
(deftest restore-keeps-nested-refs-matching-ids
(testing "a nested annotation's ref to a parent mark survives JSON (id + ref both keyworded)"
(let [json-anns {:ann-p {:type "annotation" :parent "root"
:marks [{:id "m-parent" :start {:ref "clip-a" :at 0}
:end {:ref "clip-a" :at -1}}]}
:ann-c {:type "annotation" :parent "ann-p"
:marks [{:id "m-child" :start {:ref "m-parent" :at 0}
:end {:ref "m-parent" :at 50}}]}}
scene (update base :groups merge (s/restore-annotations json-anns))]
(is (= :m-parent (get-in scene [:groups :ann-p :marks 0 :id]))) ; id keyworded
(is (= :m-parent (get-in scene [:groups :ann-c :marks 0 :start :ref]))) ; ref keyworded to match
(is (empty? (s/broken-marks scene :ann-c))) ; so it isn't "deleted"
(is (= [0 50] (:src (first (s/resolve scene :ann-c))))))))
(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)))))))
;; =========================================================================
;; Suite 5 — a parent breaking a child's mark references
;; =========================================================================
(deftest broken-when-referenced-mark-deleted
(testing "deleting the referenced subclip dangles the child's mark"
(let [del (update-in x+y [:groups :ann-x :marks] #(vec (rest %)))] ; drop s0
(is (= [:m/y0] (s/broken-marks del :ann-y)))
(is (= "referenced clip deleted" (s/broken-reason del :ann-y))))))
(deftest broken-when-boundaries-shift-out-of-range
(testing "shrinking s0 below the child's :at makes the offset unreferenceable"
;; y0 refs s0 at 10..20; trim s0 to length 15 so 20 is past its end
(let [trim (assoc-in x+y [:groups :ann-x :marks 0 :end] {:ref :clip-b :at 65})]
(is (= 15 (s/length (s/resolve-mark trim :ann-x (get-in trim [:groups :ann-x :marks 0])))))
(is (= [:m/y0] (s/broken-marks trim :ann-y)))
(is (= "reference trimmed away" (s/broken-reason trim :ann-y))))))
(deftest broken-cascades-through-a-subclip
(testing "if the subclip's own ref breaks, the child referencing it breaks too"
(let [gone (update x+y :groups dissoc :clip-b)] ; s0 refs clip-b, y0 refs s0
(is (= [:m/y0] (s/broken-marks gone :ann-y)))
(is (= "referenced clip deleted" (s/broken-reason gone :ann-y))))))
(deftest healthy-annotation-has-no-reason
(testing "broken-reason is nil when every mark resolves"
(is (nil? (s/broken-reason x+y :ann-y)))))
(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 :in [: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
;; =========================================================================
;; Suite — links (ref-points named in markdown content)
;; =========================================================================
(deftest parse-content-splits-text-and-links
(testing "content round-trips through link-token / parse-content"
(let [tok (md/link-token {:label "B-roll clip @10" :ref :clip-b :at 10})
s (str "see " tok " here")]
(is (= "[B-roll clip @10](mark:clip-b@10)" tok))
(is (= [[:text "see "]
[:link {:kind :frame :label "B-roll clip @10" :ref :clip-b :at 10}]
[:text " here"]]
(md/parse-content s))))
(testing "labels with parens and @ survive the round-trip"
(let [link {:kind :frame :label "CU Tashi (1) @0f" :ref :t2-c5 :at 0}]
(is (= [[:link link]] (md/parse-content (md/link-token link))))))
(testing "timeline links carry just a ref and round-trip"
(let [tl {:kind :timeline :label "Match point" :ref :ann-1}]
(is (= "[Match point](timeline:ann-1)" (md/link-token tl)))
(is (= [[:link tl]] (md/parse-content (md/link-token tl))))))
(is (= [] (md/parse-content "")))
(is (= [[:text "plain note"]] (md/parse-content "plain note")))))
(deftest path-to-builds-stack-and-drops-orphans
(let [scene {:groups {:root {:type :timeline :parent nil}
:a {:type :annotation :in [:root]}
:b {:type :annotation :in [:a]}
:orphan {:type :annotation :in [:gone]}}}]
(testing "path is root → … → target"
(is (= [:root] (s/path-to scene :root)))
(is (= [:root :a] (s/path-to scene :a)))
(is (= [:root :a :b] (s/path-to scene :b))))
(testing "an orphan (missing ancestor) has no path"
(is (nil? (s/path-to scene :orphan))))
(testing "timelines lists root + reachable annotations, not orphans"
(let [gids (set (map :gid (s/timelines scene)))]
(is (contains? gids :root))
(is (contains? gids :a))
(is (contains? gids :b))
(is (not (contains? gids :orphan)))))))
(deftest schema-migration
(testing "pre-versioned annotations are treated as v1 (the current schema)"
(is (= s/schema-version (:v (s/migrate {:type :annotation :name "x"})))))
(testing "migrate is idempotent at the current version"
(is (= s/schema-version (:v (s/migrate {:v s/schema-version :name "x"})))))
(testing "restore-annotations stamps :v on every annotation"
(is (= s/schema-version
(:v (get (s/restore-annotations {"a" {:type "annotation" :name "x"}}) "a"))))))
(deftest seg-point-and-link-local-round-trip
(testing "a clip-scoped point resolves back to the same ctx-local frame"
(let [seg (some #(when (= :clip-b (:mark %)) %) (s/content-segments base :root))
pt (s/seg-point base seg 10)]
(is (= {:ref :clip-b :at 10} pt))
(is (= 110 (s/link-local base :root pt))))))
(deftest link-local-absolute-is-the-frame
(testing "an absolute link (ref = ctx) is the local frame itself"
(is (= 42 (s/link-local base :root {:ref :root :at 42})))))
(deftest link-local-nil-when-target-gone
(testing "a link to a deleted clip no longer resolves"
(is (nil? (s/link-local (update base :groups dissoc :clip-b)
:root {:ref :clip-b :at 10})))))
(deftest linkables-groups-tracks-and-annotations
(testing "tracks (with their clips) and child annotations are pickable"
(let [ls (s/linkables base :root)
names (set (map :name ls))]
(is (contains? names "A-roll"))
(is (contains? names "B-roll"))
(is (= 1 (count (:items (some #(when (= "B-roll" (:name %)) %) ls)))))
(is (= {:ref :clip-b :at 0}
(:point (first (:items (some #(when (= "B-roll" (:name %)) %) ls)))))))
(testing "a discontinuous annotation collapses contiguous marks into runs"
(let [ann (some #(when (= :annotation (:kind %)) %) (s/linkables inter-x :root))]
(is (some? ann))
(is (= 1 (count (:items ann)))))))) ; X's four subclips tile [0,200) → one run
(is (every? integer? (mapcat (juxt :start :source :duration)
(filter #(= :clip (:type %)) (vals (:groups scene)))))))))