Compare commits
2 commits
d54a6ae8f8
...
79a87403b5
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
79a87403b5 | ||
|
|
4ae79b6422 |
12 changed files with 633 additions and 2010 deletions
|
|
@ -9,7 +9,7 @@ User = get_user_model()
|
||||||
|
|
||||||
|
|
||||||
def ann(name, content="", **extra):
|
def ann(name, content="", **extra):
|
||||||
return {"type": "annotation", "parent": "root", "name": name,
|
return {"type": "annotation", "in": ["root"], "name": name,
|
||||||
"content": content, "marks": [], **extra}
|
"content": content, "marks": [], **extra}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,7 @@ Use idiomatic ClojureScript formatting with two-space indentation and aligned ma
|
||||||
|
|
||||||
## Testing Guidelines
|
## 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
|
## Commit & Pull Request Guidelines
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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).
|
|
||||||
|
|
@ -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}.
|
Projection cannot be inverted: a bounding range loses gaps, order, and repetition.
|
||||||
- edit a mark's range -> same id -> Y follows it
|
The editor displays each contiguous projected range separately. Expanding a mark's
|
||||||
- reorder marks -> ids travel with them -> Y follows the content, not the slot
|
summary exposes its actual ordered parts for endpoint edits. Endpoint edits clamp
|
||||||
- delete a mark -> id gone -> Y dangles -> orphan (grey out, warn per broken mark, keep if at least one still resolves)
|
within that clip and cannot cross the opposite endpoint. The projected display
|
||||||
- add a mark -> new id
|
never reconstructs or replaces the stored parts. Annotation drag-and-drop changes
|
||||||
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.
|
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.
|
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.
|
||||||
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
|
|
||||||
|
|
|
||||||
|
|
@ -17,8 +17,7 @@
|
||||||
|
|
||||||
;; the whole scene graph (see tl.scene). Seeded from OTIO at load.
|
;; the whole scene graph (see tl.scene). Seeded from OTIO at load.
|
||||||
:scene {:tracks {}
|
:scene {:tracks {}
|
||||||
:groups {:root {:type :timeline :parent nil
|
:groups {:root {:type :timeline :name "root"}}}
|
||||||
:marks [{:id :root-m :start 0 :end 0}]}}}
|
|
||||||
|
|
||||||
;; view state
|
;; view state
|
||||||
:view {:stack [:root] ; timeline-stack; top = current context
|
:view {:stack [:root] ; timeline-stack; top = current context
|
||||||
|
|
|
||||||
|
|
@ -201,6 +201,7 @@
|
||||||
(-> (apply dissoc groups (map keyword deleted))
|
(-> (apply dissoc groups (map keyword deleted))
|
||||||
(into (remove (fn [[gid _]] (contains? drafts gid)) restored))))))))
|
(into (remove (fn [[gid _]] (contains? drafts gid)) restored))))))))
|
||||||
|
|
||||||
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::refresh-project-detail
|
::refresh-project-detail
|
||||||
(fn [{:keys [db]} _]
|
(fn [{:keys [db]} _]
|
||||||
|
|
@ -463,7 +464,7 @@
|
||||||
|
|
||||||
(defn- draft-in-ctx [db ctx]
|
(defn- draft-in-ctx [db ctx]
|
||||||
(some (fn [[gid g]]
|
(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])))
|
(get-in db [:scene :groups])))
|
||||||
|
|
||||||
(defn- draft-mark-at [db ctx lf]
|
(defn- draft-mark-at [db ctx lf]
|
||||||
|
|
@ -489,7 +490,7 @@
|
||||||
|
|
||||||
(defn- mark-start-local [db ann mark-id]
|
(defn- mark-start-local [db ann mark-id]
|
||||||
(let [scene (:scene db)
|
(let [scene (:scene db)
|
||||||
ctx (scene/home scene ann)
|
ctx (get-in db [:view :edit-context])
|
||||||
segs (scene/content-segments scene ctx)]
|
segs (scene/content-segments scene ctx)]
|
||||||
(ffirst (scene/mark-bars scene ann mark-id segs))))
|
(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])))
|
(let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack])))
|
||||||
(some (fn [[gid g]] (when (:draft g) [gid g]))
|
(some (fn [[gid g]] (when (:draft g) [gid g]))
|
||||||
(get-in db [:scene :groups])))
|
(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))
|
local (when ann (mark-start-local db ann mark-id))
|
||||||
db (cond-> db
|
db (cond-> db
|
||||||
ann (start-drawing-db ann mark-id)
|
ann (start-drawing-db ann mark-id)
|
||||||
|
|
@ -659,10 +660,10 @@
|
||||||
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
|
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
|
||||||
(let [ctx (peek (get-in db [:view :stack]))]
|
(let [ctx (peek (get-in db [:view :stack]))]
|
||||||
{:type :annotation :in [ctx] ; filed under the context it's born in
|
{:type :annotation :in [ctx] ; filed under the context it's born in
|
||||||
:draft :new :name "" :color "#4e8fc2" :marks []
|
:draft :new :name "" :color "#4e8fc2" :marks []}))
|
||||||
:v scene/schema-version}))
|
|
||||||
(assoc-in [:view :pt] :new)
|
(assoc-in [:view :pt] :new)
|
||||||
(assoc-in [:view :active-mark] nil)
|
(assoc-in [:view :active-mark] nil)
|
||||||
|
(assoc-in [:view :edit-context] (peek (get-in db [:view :stack])))
|
||||||
(assoc-in [:view :draft-stage] :choosing))))
|
(assoc-in [:view :draft-stage] :choosing))))
|
||||||
|
|
||||||
;; commit a fresh draft to "create new": name it and reveal the full form (color,
|
;; 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)
|
(-> db (assoc-in [:scene :groups gid :name] title)
|
||||||
(assoc-in [:view :draft-stage] :creating))))
|
(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))))
|
(assoc-in [:view :pt] :new))))
|
||||||
|
|
||||||
;; Edit an annotation from a card. If its primary home isn't the context being
|
(rf/reg-event-fx ::edit-annotation
|
||||||
;; viewed, enter that home first so mark rows/handles edit in their authored
|
(fn [_ [_ gid]] {:dispatch [::edit-draft gid]}))
|
||||||
;; 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))))))
|
|
||||||
|
|
||||||
;; Edit the annotation you're currently inside: drop into its parent timeline so
|
;; 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
|
;; 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))]
|
fx (if root? {:db db} (enter-ctx db pop))]
|
||||||
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
|
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
|
||||||
(assoc-in [:view :pt] :new)
|
(assoc-in [:view :pt] :new)
|
||||||
|
(assoc-in [:view :edit-context] (peek (get-in % [:view :stack])))
|
||||||
(assoc-in [:view :edit-return] (when-not root? gid)))))))
|
(assoc-in [:view :edit-return] (when-not root? gid)))))))
|
||||||
(rf/reg-event-fx ::finish-edit
|
(rf/reg-event-fx ::finish-edit
|
||||||
(fn [{:keys [db]} _]
|
(fn [{:keys [db]} _]
|
||||||
;; leaving the form (save OR cancel): tear down all authoring
|
;; leaving the form (save OR cancel): tear down all authoring
|
||||||
;; transients so draw mode / pending points don't linger.
|
;; transients so draw mode / pending points don't linger.
|
||||||
(let [return-g (get-in db [:view :edit-return])
|
(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)
|
db (-> db (assoc-in [:view :draw] nil)
|
||||||
(assoc-in [:view :active-mark] nil)
|
(assoc-in [:view :active-mark] nil)
|
||||||
(assoc-in [:view :pt] nil)
|
(assoc-in [:view :pt] nil)
|
||||||
(assoc-in [:view :draft-stage] nil)
|
(assoc-in [:view :draft-stage] nil)
|
||||||
(assoc-in [:view :edit-return] nil)
|
(assoc-in [:view :edit-return] nil)
|
||||||
(assoc-in [:view :edit-pop-parent] nil))]
|
(assoc-in [:view :edit-context] nil))]
|
||||||
(cond
|
(cond
|
||||||
return-g (enter-ctx db #(conj % return-g))
|
return-g (enter-ctx db #(conj % return-g))
|
||||||
pop? (enter-ctx db #(if (> (count %) 1) (pop %) %))
|
|
||||||
:else {:db db}))))
|
:else {:db db}))))
|
||||||
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
|
(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
|
;; cancelling a draft is local only; saving a real annotation / deleting one
|
||||||
|
|
@ -728,21 +719,13 @@
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::save-group
|
::save-group
|
||||||
(fn [{:keys [db]} [_ gid g orig]]
|
(fn [{:keys [db]} [_ gid g orig]]
|
||||||
(let [g (cond-> (editable-group g)
|
(let [g (editable-group g)
|
||||||
(= :annotation (:type g)) (assoc :v scene/schema-version))
|
|
||||||
patch (group-patch orig g)
|
patch (group-patch orig g)
|
||||||
root? (= :timeline (:type g)) ; the root timeline persists whole
|
root? (= :timeline (:type g)) ; the root timeline persists whole
|
||||||
id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks)
|
id (get-in db [:project :id])]
|
||||||
;; 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)))]
|
|
||||||
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))}
|
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))}
|
||||||
(and id (or (seq patch) (seq proxies)))
|
(and id (seq patch))
|
||||||
(assoc :http-xhrio (api/put-scene id {:changed (merge {gid (if root? g patch)} proxies)}
|
(assoc :http-xhrio (api/put-scene id {:changed {gid (if root? g patch)}}
|
||||||
{:on-success [::scene-saved]
|
{:on-success [::scene-saved]
|
||||||
:on-failure [::save-error]}))))))
|
:on-failure [::save-error]}))))))
|
||||||
(rf/reg-event-fx ::delete-annotation
|
(rf/reg-event-fx ::delete-annotation
|
||||||
|
|
@ -753,24 +736,7 @@
|
||||||
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
|
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
|
||||||
{:on-success [::scene-saved]
|
{:on-success [::scene-saved]
|
||||||
:on-failure [::save-error]}))))))
|
:on-failure [::save-error]}))))))
|
||||||
;; --- membership edges (:in): file an annotation under mark-groups ----------
|
;; --- visibility edges ----------------------------------------------------
|
||||||
;; 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))))))
|
|
||||||
|
|
||||||
(rf/reg-event-db
|
(rf/reg-event-db
|
||||||
::ann-drag-start
|
::ann-drag-start
|
||||||
|
|
@ -798,29 +764,17 @@
|
||||||
{:on-success [::scene-saved]
|
{:on-success [::scene-saved]
|
||||||
:on-failure [::save-error]})))))
|
:on-failure [::save-error]})))))
|
||||||
|
|
||||||
;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps
|
(defn- file-edge [db gid target add? source]
|
||||||
;; existing edges (link); otherwise the edge you grabbed is moved off its source.
|
(let [g (get-in db [:scene :groups gid])
|
||||||
;; Marks are untouched either way.
|
edges (scene/membership (:scene db) gid)
|
||||||
(defn- file-edge [db gid new-parent add? source]
|
edges (if add? edges (disj edges source))
|
||||||
(let [scene (:scene db)
|
next-edges (vec (distinct (cond-> (vec edges) target (conj target))))
|
||||||
g (get-in scene [:groups gid])
|
db (update db :view dissoc :dragging-ann :dragging-ann-source)]
|
||||||
in (vec (:in g))
|
(if (and (= :annotation (:type g)) (not (:draft g)) (not= gid target)
|
||||||
clear #(-> % (assoc-in [:view :dragging-ann] nil)
|
(or (nil? target)
|
||||||
(assoc-in [:view :dragging-ann-source] nil))]
|
(contains? #{:annotation :timeline} (get-in db [:scene :groups target :type]))))
|
||||||
(if (or (not= :annotation (:type g)) ; only annotations file
|
(persist-group db gid g (assoc g :in next-edges))
|
||||||
(:draft g) ; not mid-draft
|
{:db db})))
|
||||||
(= 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)))))
|
|
||||||
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::reparent
|
::reparent
|
||||||
|
|
@ -833,69 +787,25 @@
|
||||||
(fn [{:keys [db]} [_ gid target]]
|
(fn [{:keys [db]} [_ gid target]]
|
||||||
(file-edge db gid target true nil)))
|
(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]]
|
(fn [{:keys [db]} [_ gid target]]
|
||||||
(let [g (get-in db [:scene :groups gid])
|
(file-edge db gid nil false target)))
|
||||||
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))))))))
|
|
||||||
|
|
||||||
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
|
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
|
||||||
(rf/reg-event-db ::save-error
|
(rf/reg-event-db ::save-error
|
||||||
(fn [db [_ failure]]
|
(fn [db [_ failure]]
|
||||||
(assoc db :save-error (api/error-message failure "Couldn't save your changes — they're unsaved."))))
|
(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]
|
(defn- select-range-fx [db gid g lo hi]
|
||||||
(let [scene (:scene db)
|
(let [ctx (get-in db [:view :edit-context])
|
||||||
p (scene/make-proxy scene (scene/home scene gid) lo hi)
|
mark (scene/make-mark (:scene db) ctx lo hi)
|
||||||
pgid (keyword (str "prox-" (random-uuid)))
|
sf (scene/local->source (scene/content-segments (:scene db) ctx) lo)]
|
||||||
mid (str (random-uuid))
|
{:db (-> db (update-in [:scene :groups gid :marks] conj mark)
|
||||||
sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)]
|
(assoc-in [:view :active-mark] (:id mark))
|
||||||
{:db (-> db (assoc-in [:scene :groups pgid] p)
|
(assoc-in [:view :playheads ctx] lo)
|
||||||
(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)
|
|
||||||
(assoc-in [:view :pt] :new))
|
(assoc-in [:view :pt] :new))
|
||||||
:player/seek (when sf (/ sf (:fps db)))
|
: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.
|
;; drag a region directly on the timeline (context-local frames) → one selection.
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
|
|
@ -911,115 +821,34 @@
|
||||||
(fn [{:keys [db]} [_ seg-id frame]]
|
(fn [{:keys [db]} [_ seg-id frame]]
|
||||||
(let [scene (:scene db)
|
(let [scene (:scene db)
|
||||||
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
|
[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])]
|
pt (get-in db [:view :pt])]
|
||||||
(cond
|
(if (map? pt)
|
||||||
;; 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)
|
|
||||||
(let [a (scene/seg-local segs (:seg pt) (:f 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)))
|
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))]
|
||||||
lo (min a b) hi (max a b)
|
(select-range-fx db gid g (min a b) (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
|
|
||||||
{:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})}))))
|
{: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
|
(rf/reg-event-db ::remove-mark
|
||||||
;; 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
|
|
||||||
(fn [db [_ gid i]]
|
(fn [db [_ gid i]]
|
||||||
(let [marks (get-in db [:scene :groups gid :marks])
|
(update-in db [:scene :groups gid :marks]
|
||||||
pid (get-in marks [i :start :ref])
|
#(into (subvec % 0 i) (subvec % (inc i))))))
|
||||||
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)))))
|
|
||||||
|
|
||||||
;; 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
|
(rf/reg-event-db
|
||||||
::reroll-proxy
|
::set-part-frame
|
||||||
(fn [db [_ ann mark-id la lb]]
|
(fn [db [_ gid mid index which frame]]
|
||||||
(let [scene (:scene db)
|
(update-mark db gid mid #(scene/set-part-frame (:scene db) % index which frame))))
|
||||||
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))))
|
|
||||||
|
|
||||||
;; numeric endpoint edit from the pane: set a proxy's boundary internal mark's
|
;; Adding footage and making it visible in the authoring context is one edit.
|
||||||
;; :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.
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::associate-marks
|
::associate-marks
|
||||||
(fn [{:keys [db]} [_ draft-gid target-gid]]
|
(fn [{:keys [db]} [_ draft-gid target-gid]]
|
||||||
(let [marks (get-in db [:scene :groups draft-gid :marks])
|
(let [marks (get-in db [:scene :groups draft-gid :marks])
|
||||||
orig-t (get-in db [:scene :groups target-gid])
|
orig-t (get-in db [:scene :groups target-gid])
|
||||||
;; adding marks does NOT change placement — membership is asserted, never
|
target (-> orig-t
|
||||||
;; derived from where marks were authored. To also list C in this context,
|
(update :marks (fnil into []) marks)
|
||||||
;; file it in explicitly (the + picker / drag).
|
(update :in #(vec (distinct (conj (vec %) (get-in db [:view :edit-context]))))))
|
||||||
target (update orig-t :marks (fnil into []) marks)
|
|
||||||
patch (group-patch orig-t target) ; just the :marks change
|
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])
|
id (get-in db [:project :id])
|
||||||
db (-> db
|
db (-> db
|
||||||
(assoc-in [:scene :groups target-gid] (assoc target :draft :edit))
|
(assoc-in [:scene :groups target-gid] (assoc target :draft :edit))
|
||||||
|
|
@ -1029,6 +858,6 @@
|
||||||
(assoc :save-error nil))]
|
(assoc :save-error nil))]
|
||||||
(cond-> {:db db}
|
(cond-> {:db db}
|
||||||
(and id (seq patch))
|
(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-success [::scene-saved]
|
||||||
:on-failure [::save-error]}))))))
|
:on-failure [::save-error]}))))))
|
||||||
|
|
|
||||||
|
|
@ -1,21 +1,8 @@
|
||||||
(ns tl.scene
|
(ns tl.scene
|
||||||
"The scene graph: a flat pool of mark-groups (the only non-mark-group thing is
|
"Annotations own ordered marks; marks own ordered root-clip slices.
|
||||||
:tracks). Everything here is pure — see data_model.org.
|
:in contains visibility edges only. All frame ranges are integer [start,end)."
|
||||||
|
|
||||||
Conventions
|
|
||||||
- ranges are HALF-OPEN [start end); length = end - start.
|
|
||||||
- a point is either
|
|
||||||
<number> absolute: a frame in the mark's OWNING context
|
|
||||||
{:ref id :at n} relative: frame n of id's resolved range
|
|
||||||
(n>=0 from the start; n<0 from the end, -1 = the
|
|
||||||
exclusive end, -2 = last actual frame)
|
|
||||||
- a ref mark's :start and :end target the SAME id ⇒ exactly one segment;
|
|
||||||
an absolute mark may resolve to several (slice over its parent).
|
|
||||||
- resolve ⇒ ordered segments {:mark id :track t :src [a b] :local [c d]}."
|
|
||||||
(:refer-clojure :exclude [resolve]))
|
(:refer-clojure :exclude [resolve]))
|
||||||
|
|
||||||
(defn- grp [scene gid] (get-in scene [:groups gid]))
|
|
||||||
|
|
||||||
(defn frame?
|
(defn frame?
|
||||||
"True when `n` is a concrete integer frame coordinate."
|
"True when `n` is a concrete integer frame coordinate."
|
||||||
[n]
|
[n]
|
||||||
|
|
@ -38,17 +25,10 @@
|
||||||
(throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi])))))
|
(throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi])))))
|
||||||
[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 ---------------------------------
|
;; --- flat helpers over resolved segments ---------------------------------
|
||||||
|
|
||||||
(defn length [segs]
|
(defn length [segs]
|
||||||
(if (seq segs) (-> segs last :local second) 0))
|
(reduce max 0 (map (comp second :local) segs)))
|
||||||
|
|
||||||
(defn local->source
|
(defn local->source
|
||||||
"The source frame shown at local frame `lf` (clamped to the end)."
|
"The source frame shown at local frame `lf` (clamped to the end)."
|
||||||
|
|
@ -62,17 +42,6 @@
|
||||||
segs)
|
segs)
|
||||||
(when (seq segs) (-> segs last :src second))))
|
(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
|
(defn pieces
|
||||||
"Where source range [sa sb) lands in local coords: a list of [lo hi)."
|
"Where source range [sa sb) lands in local coords: a list of [lo hi)."
|
||||||
[segs sa sb]
|
[segs sa sb]
|
||||||
|
|
@ -82,7 +51,8 @@
|
||||||
(assert-range "segment local" local)
|
(assert-range "segment local" local)
|
||||||
(let [[a b] src [c _] local
|
(let [[a b] src [c _] local
|
||||||
lo (max sa a) hi (min sb b)]
|
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)))
|
segs)))
|
||||||
|
|
||||||
(defn merge-bars
|
(defn merge-bars
|
||||||
|
|
@ -110,7 +80,7 @@
|
||||||
(assert-range "segment local" local)
|
(assert-range "segment local" local)
|
||||||
(let [[a _] src [c d] local
|
(let [[a _] src [c d] local
|
||||||
lo (max la c) hi (min lb d)]
|
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]
|
(cond-> (assoc seg :local [lo hi]
|
||||||
:src [(+ a (- lo c)) (+ a (- hi c))])
|
:src [(+ a (- lo c)) (+ a (- hi c))])
|
||||||
(:thumb-start seg) (update :thumb-start + (- lo c))))))
|
(:thumb-start seg) (update :thumb-start + (- lo c))))))
|
||||||
|
|
@ -118,640 +88,185 @@
|
||||||
|
|
||||||
(defn tracks [segs] (into #{} (keep :track segs)))
|
(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
|
(defn- concatenate [segments]
|
||||||
"Resolved segments (local 0-based) of a referenceable id: a group (clip,
|
(reduce (fn [out {:keys [local] :as segment}]
|
||||||
timeline, proxy, annotation) or a single mark. One segment for a clip/subclip
|
(let [offset (or (some-> out peek :local second) 0)]
|
||||||
by the ref invariant; several for a proxy or an arrangement group."
|
(conj out (assoc segment :local [offset (+ offset (- (second local) (first local)))]))))
|
||||||
[scene id]
|
[] segments))
|
||||||
(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))
|
|
||||||
|
|
||||||
;; --- ref :at <-> source : the ONE interpretation of a ref's :at -----------
|
(defn resolve-mark [scene _ {:keys [id parts]}]
|
||||||
;; {:ref id :at n}'s :at is a LOCAL frame of id's OWN resolved timeline (n<0 from
|
(mapv #(assoc % :mark id) (concatenate (keep #(clip-segment scene %) parts))))
|
||||||
;; 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
|
(defn resolve
|
||||||
"A mark-group → its local timeline: ordered segments laid end to end. Broken
|
"Compile a group to source segments. Visibility never participates."
|
||||||
marks (dangling refs) are skipped."
|
|
||||||
[scene gid]
|
[scene gid]
|
||||||
(loop [[m & more] (:marks (grp scene gid)), off 0, out []]
|
(let [{:keys [type marks duration]} (get-in scene [:groups gid])]
|
||||||
(if (nil? m)
|
(case type
|
||||||
out
|
:clip (if-let [seg (clip-segment scene {:clip gid :start 0 :end duration})]
|
||||||
(if-let [segs (seq (resolve-mark scene gid m))]
|
[(assoc seg :mark gid)] [])
|
||||||
(let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs))
|
:timeline (->> (:groups scene)
|
||||||
shifted (mapv (fn [s] (let [[c d] (:local s)]
|
(keep (fn [[id {:keys [type start]}]]
|
||||||
(assoc s :local [(+ off c) (+ off d)])))
|
(when (= type :clip)
|
||||||
segs)]
|
(let [seg (first (resolve scene id))]
|
||||||
(recur more (+ off len) (into out shifted)))
|
(assoc seg :local [start (+ start (length [seg]))])))))
|
||||||
(recur more off out)))))
|
(sort-by (comp first :local)) vec)
|
||||||
|
:annotation (concatenate (mapcat #(resolve-mark scene gid %) marks))
|
||||||
(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)))))
|
|
||||||
|
|
||||||
(defn content-segments
|
(defn content-segments
|
||||||
"The clip-segments that make up context `ctx` — what you draw and select
|
"Occurrence IDs belong to the view; persisted slices always identify raw clips."
|
||||||
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)."
|
|
||||||
[scene ctx]
|
[scene ctx]
|
||||||
(if (= :timeline (:type (grp scene ctx)))
|
(mapv (fn [i seg] (assoc seg :mark [ctx i])) (range) (resolve 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)))
|
|
||||||
|
|
||||||
(defn- src-intersect
|
(defn project-bars
|
||||||
"Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))."
|
"Project onto every matching clip occurrence; merge only context-contiguous pieces."
|
||||||
[rs cover]
|
[segments context]
|
||||||
(vec (for [[a b] rs [c d] cover
|
(merge-bars
|
||||||
:let [lo (max a c) hi (min b d)]
|
(mapcat (fn [{:keys [thumb] [a b] :src}]
|
||||||
:when (< lo hi)]
|
(pieces (filter #(= thumb (:thumb %)) context) a b))
|
||||||
[lo hi])))
|
segments)))
|
||||||
|
|
||||||
(defn lane-bars
|
(defn mark-bars [scene gid mid context]
|
||||||
"Context-local display bars for annotation `gid`, grouped PER MARK: contiguous
|
(project-bars (filter #(= mid (:mark %)) (resolve scene gid)) context))
|
||||||
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.
|
|
||||||
|
|
||||||
`resolve` already trims each mark through its whole ref chain — a nested mark
|
(defn lane-bars [scene gid context]
|
||||||
is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ …
|
(vec (mapcat (fn [{:keys [id] :as mark}]
|
||||||
⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs`
|
(map (fn [[lo hi]] [lo hi id])
|
||||||
is all the clipping needed (no ancestor re-walk — that was redundant)."
|
(project-bars (resolve-mark scene gid mark) context)))
|
||||||
[scene gid ctx-segs]
|
(get-in scene [:groups gid :marks]))))
|
||||||
(->> (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 mark-extent
|
(defn broken-marks [scene gid]
|
||||||
"EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true
|
(->> (get-in scene [:groups gid :marks])
|
||||||
min piece-start / max piece-end, without merge-bars. Endpoint editing must use
|
(filter #(or (empty? (:parts %))
|
||||||
this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` =
|
(some (fn [part] (nil? (clip-segment scene part))) (:parts %))))
|
||||||
content-segments of ctx."
|
(mapv :id)))
|
||||||
[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))])))
|
|
||||||
|
|
||||||
;; --- placement: :in membership edges --------------------------------------
|
(defn broken-reason [scene gid]
|
||||||
;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered
|
(when (seq (broken-marks scene gid)) "missing clip or invalid range"))
|
||||||
;; 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 membership
|
(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]
|
[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?
|
(defn child-of? [scene ctx gid]
|
||||||
"Is annotation `gid` filed under `ctx`?"
|
|
||||||
[scene ctx gid]
|
|
||||||
(contains? (membership scene gid) ctx))
|
(contains? (membership scene gid) ctx))
|
||||||
|
|
||||||
(defn clip-loss?
|
(defn selection->parts [scene ctx lo hi]
|
||||||
"True when annotation `gid` loses content once clipped to its primary home — it
|
(mapv (fn [{:keys [thumb thumb-start] [a b] :src}]
|
||||||
references frames outside that parent annotation, so it's (partly) out of range
|
{:clip thumb :start thumb-start :end (+ thumb-start (- b a))})
|
||||||
there. Timeline/root homes contain everything, so they never warn."
|
(slice (content-segments scene ctx) lo hi)))
|
||||||
[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))))))
|
|
||||||
|
|
||||||
;; --- 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
|
(defn seg-length [segs mid]
|
||||||
"Split local range [la lb) of context `ctx` into a run of single-clip ref
|
(some (fn [{m :mark [lo hi] :local}] (when (= m mid) (- hi lo))) segs))
|
||||||
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 reconcile-run
|
(defn seg-local [segs mid frame]
|
||||||
"Re-derive the run for selection [la lb), REUSING the id of any `old-run` mark
|
(some (fn [{m :mark [lo _] :local}] (when (= m mid) (+ lo (or frame 0)))) segs))
|
||||||
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))))
|
|
||||||
|
|
||||||
;; --- proxy synthetic-clips ------------------------------------------------
|
(defn- restore-mark [mark]
|
||||||
;; A proxy is a mark-group {:type :proxy} in the flat pool whose marks are the
|
(cond-> (-> mark (update :id keyword)
|
||||||
;; per-clip run of a selection (selection->marks). An annotation references the
|
(update :parts #(mapv (fn [part] (update part :clip keyword)) %)))
|
||||||
;; WHOLE proxy with a single mark {:ref P :at 0 → :at -1}, so the pane shows one
|
(:notes mark) (update :notes #(mapv keyword %))
|
||||||
;; collapsed row and the lane one bar, while endpoint edits mutate the proxy's
|
(:drawings mark) (update :drawings #(mapv keyword %))))
|
||||||
;; 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 make-proxy
|
(defn- restore-group [group]
|
||||||
"A new proxy mark-group for selection [la lb) of context `ctx`. No gid yet —
|
(cond-> (update group :type keyword)
|
||||||
the caller assigns one when inserting it into the pool."
|
(:in group) (update :in #(mapv keyword %))
|
||||||
[scene ctx la lb]
|
(:marks group) (update :marks #(mapv restore-mark %))
|
||||||
{:type :proxy :parent nil :marks (selection->marks scene ctx la lb)})
|
(:notes group) (update :notes #(mapv keyword %))
|
||||||
|
(:regions group) (update :regions #(mapv (fn [r] (-> r (update :id keyword)
|
||||||
(defn roll-proxy
|
(update :kind keyword))) %))))
|
||||||
"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-annotations
|
(defn restore-annotations
|
||||||
"Re-keywordize the fields that lose their keyword-ness through JSON (string
|
"Decode identifiers in the current JSON format."
|
||||||
:type/:parent and mark :refs), then migrate each annotation to the current
|
[groups]
|
||||||
schema version, before merging into the (keyword-keyed) scene."
|
(update-vals groups restore-group))
|
||||||
[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))
|
|
||||||
|
|
||||||
(defn display-point
|
(defn marks->rows [scene ctx marks]
|
||||||
"A ref-point {:ref :at} as a display cell {:seg :f}: the target id plus its OWN
|
(let [segments (content-segments scene ctx)]
|
||||||
local frame (context-local, whole-frame; not translated to the raw clip). The
|
(mapv #(project-bars (resolve-mark scene nil %) segments) marks)))
|
||||||
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- clip-row
|
(defn set-part-frame [scene mark index which frame]
|
||||||
"Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time."
|
(let [{:keys [clip start end]} (get-in mark [:parts index])
|
||||||
[scene {:keys [start end]}]
|
[lo hi] (if (= which :start) [0 end] [start (get-in scene [:groups clip :duration])])]
|
||||||
{:s (display-point scene start) :e (display-point scene end)})
|
(assoc-in mark [:parts index which]
|
||||||
|
(max lo (min hi (assert-frame "endpoint frame" frame))))))
|
||||||
(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 playhead [view ctx] (get-in view [:playheads ctx] 0))
|
(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
|
(defn clip-name [scene gid] (get-in scene [:groups gid :name]))
|
||||||
"Seed a scene from tl.otio/parse output: a video :track per source track, one
|
(defn ref-length [scene gid] (length (resolve scene gid)))
|
||||||
clip mark-group per clip (source range + track), and the root timeline. The
|
(defn ref-track-name [scene gid]
|
||||||
otio is only a seed — nothing here reads it again.
|
(get-in scene [:tracks (:track (first (resolve scene gid))) :name]))
|
||||||
|
|
||||||
Clip ranges are integer frame ranges. Fractional OTIO input is rejected before
|
(defn seg-point [_ {:keys [thumb thumb-start]} frame]
|
||||||
this point; from here on, frame math asserts instead of snapping."
|
{:ref thumb :at (+ thumb-start (or frame 0))})
|
||||||
[{: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 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) ------------
|
(defn jump-targets [scene ctx gid]
|
||||||
;; A mark collected into an annotation from another timeline (transclusion) has a
|
(let [segs (content-segments scene ctx)]
|
||||||
;; ref whose clip isn't in the CURRENT context's content-segments, so the context
|
(mapv (fn [[lo _]]
|
||||||
;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip
|
(let [seg (some (fn [{[a b] :local :as seg}]
|
||||||
;; instead — the mark's own timeline — so the row reads correctly from anywhere.
|
(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
|
(defn linkables [scene ctx]
|
||||||
"Own resolved length (frames) of ref target `ref`, context-independent."
|
(let [segs (content-segments scene ctx)
|
||||||
[scene ref]
|
tracks (for [[track segments] (group-by :track segs)]
|
||||||
(length (target-segs scene ref)))
|
{: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
|
(defn path-to [scene gid]
|
||||||
"Name of the TRACK that ref target `ref` resolves onto (its first piece),
|
(when (get-in scene [:groups gid])
|
||||||
context-independent — the useful label for a transcluded mark whose clip isn't
|
(if (= gid :root) [:root] [:root gid])))
|
||||||
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))))
|
|
||||||
|
|
||||||
;; --- links ----------------------------------------------------------------
|
(defn timelines [scene]
|
||||||
;; 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]
|
|
||||||
(->> (:groups scene)
|
(->> (:groups scene)
|
||||||
(keep (fn [[gid g]]
|
(keep (fn [[gid g]]
|
||||||
(when (and (= :annotation (:type g)) (not (:draft g)))
|
(when (and (= :annotation (:type g)) (not (:draft g)))
|
||||||
(when-let [path (path-to scene gid)]
|
{:gid gid :name (or (:name g) (name gid)) :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})))))
|
|
||||||
(sort-by :name)
|
(sort-by :name)
|
||||||
(into [{:gid :root :name "root" :in nil :path [:root]}])))
|
(into [{:gid :root :name "root" :path [:root]}])))
|
||||||
|
|
|
||||||
|
|
@ -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))))
|
|
||||||
|
|
@ -6,6 +6,7 @@
|
||||||
|
|
||||||
(rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
|
(rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
|
||||||
(rf/reg-sub ::playing? (fn [db] (get-in db [:view :playing?])))
|
(rf/reg-sub ::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])))
|
(rf/reg-sub ::pt (fn [db] (get-in db [:view :pt])))
|
||||||
|
|
||||||
;; routing / projects / auth
|
;; routing / projects / auth
|
||||||
|
|
@ -18,7 +19,7 @@
|
||||||
(rf/reg-sub ::pane (fn [db] (get-in db [:view :pane] :annotations)))
|
(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])))
|
(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,
|
;; 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])))
|
(rf/reg-sub ::active-mark (fn [db] (get-in db [:view :active-mark])))
|
||||||
;; :choosing (fresh draft — marks + title picker only) | :creating (full form).
|
;; :choosing (fresh draft — marks + title picker only) | :creating (full form).
|
||||||
(rf/reg-sub ::draft-stage (fn [db] (get-in db [:view :draft-stage])))
|
(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)))
|
(rf/reg-sub ::context :<- [::stack] (fn [stack _] (peek stack)))
|
||||||
|
|
||||||
;; existing annotations a draft's marks can be associated with (transclusion):
|
;; Any non-draft annotation can receive marks from the current context.
|
||||||
;; every reachable non-draft annotation, labelled with its home context for
|
|
||||||
;; disambiguation. The draft itself is a :draft group, so timelines omits it.
|
|
||||||
(rf/reg-sub
|
(rf/reg-sub
|
||||||
::associate-targets
|
::associate-targets
|
||||||
:<- [::scene]
|
:<- [::scene]
|
||||||
(fn [scene _]
|
(fn [scene _]
|
||||||
(->> (scene/timelines scene)
|
(->> (scene/timelines scene)
|
||||||
(remove #(= :root (:gid %)))
|
(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),
|
;; the annotation group currently being authored/edited (the one flagged :draft),
|
||||||
;; with its group id merged in as :gid
|
;; 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
|
;; 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).
|
;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
|
||||||
(defn- in-bars? [bars ph]
|
(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
|
(defn annotations-by-parent
|
||||||
"Group annotation cards by every reference parent they belong to."
|
"Group annotation cards by every reference parent they belong to."
|
||||||
|
|
@ -135,16 +134,8 @@
|
||||||
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
|
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
|
||||||
(fn [[scene ctx segs revealed] _]
|
(fn [[scene ctx segs revealed] _]
|
||||||
(let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
|
(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))]
|
parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
|
||||||
(let [ms (filter exists? (scene/membership scene gid))]
|
[gid (scene/membership scene gid)]))
|
||||||
[gid (if (seq ms) (set ms) #{:root})])))
|
|
||||||
;; child count per timeline (drives the "Show N" nested badge)
|
;; 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))
|
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,
|
;; 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
|
(let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
|
||||||
(when (shown? gid #{})
|
(when (shown? gid #{})
|
||||||
(let [reason (scene/broken-reason scene gid)
|
(let [reason (scene/broken-reason scene gid)
|
||||||
oor (boolean (scene/clip-loss? scene gid))
|
|
||||||
hidden (get-in g [:meta :hidden])
|
hidden (get-in g [:meta :hidden])
|
||||||
note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
|
note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
|
||||||
distinct
|
distinct
|
||||||
|
|
@ -175,16 +165,15 @@
|
||||||
note-ids)
|
note-ids)
|
||||||
jumps (scene/jump-targets scene ctx gid)
|
jumps (scene/jump-targets scene ctx gid)
|
||||||
clips (->> (:marks g)
|
clips (->> (:marks g)
|
||||||
(mapcat (fn [m] [(get-in m [:start :ref])
|
(mapcat :parts)
|
||||||
(get-in m [:end :ref])]))
|
(map :clip)
|
||||||
(concat (map :seg jumps))
|
|
||||||
(keep (fn [ref]
|
(keep (fn [ref]
|
||||||
(let [cg (get-in scene [:groups ref])]
|
(let [cg (get-in scene [:groups ref])]
|
||||||
(or (:name cg)
|
(or (:name cg)
|
||||||
(get-in cg [:media :name])
|
(get-in cg [:media :name])
|
||||||
(some-> ref name)))))
|
(some-> ref name)))))
|
||||||
distinct)]
|
distinct)]
|
||||||
{:id gid :parent (scene/home scene gid) ; primary home = first :in
|
{:id gid
|
||||||
;; the mark-groups this annotation is filed under (:in) — the
|
;; the mark-groups this annotation is filed under (:in) — the
|
||||||
;; pane groups by this, so a linked annotation lists under each.
|
;; pane groups by this, so a linked annotation lists under each.
|
||||||
:parents (parents gid)
|
:parents (parents gid)
|
||||||
|
|
@ -197,7 +186,7 @@
|
||||||
:notes note-ids
|
:notes note-ids
|
||||||
:script (vec (remove nil? note-text))
|
:script (vec (remove nil? note-text))
|
||||||
:clips (vec clips)
|
:clips (vec clips)
|
||||||
:broken (boolean reason) :reason reason :oor oor
|
:broken (boolean reason) :reason reason
|
||||||
:hidden (boolean hidden)
|
:hidden (boolean hidden)
|
||||||
:tags (vec (get-in g [:meta :tags]))
|
:tags (vec (get-in g [:meta :tags]))
|
||||||
;; jump targets labelled from the marks' clip refs (same as
|
;; 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
|
;; 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
|
;; 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.
|
;; then just do cheap interval tests. `bound` picks :notes or :drawings.
|
||||||
(defn- binding-bars [scene ctx segs bound]
|
(defn- binding-bars [scene ctx segs annotations bound]
|
||||||
(into []
|
(vec
|
||||||
(mapcat
|
(mapcat (fn [gid]
|
||||||
(fn [[gid g]]
|
(let [g (get-in scene [:groups gid])]
|
||||||
;; 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)))]
|
|
||||||
(concat
|
(concat
|
||||||
;; annotation-level bindings (notes only; drawings bind per-mark)
|
(when (seq (bound g))
|
||||||
(when-let [gs (seq (bound g))] [{:gids gs :bars (->bars src-segs)}])
|
[{:gids (bound g) :bars (scene/project-bars (scene/resolve scene gid) segs)}])
|
||||||
;; per-mark bindings
|
|
||||||
(for [m (:marks g) :when (seq (bound m))]
|
(for [m (:marks g) :when (seq (bound m))]
|
||||||
{:gids (bound m) :bars (->bars (get by-mark (:id m)))}))))))
|
{:gids (bound m) :bars (scene/mark-bars scene gid (:id m) segs)}))))
|
||||||
(:groups scene)))
|
(conj (set (map :id annotations)) ctx))))
|
||||||
|
|
||||||
(rf/reg-sub ::drawing-bars
|
(rf/reg-sub ::drawing-bars
|
||||||
:<- [::scene] :<- [::context] :<- [::segments]
|
:<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations]
|
||||||
(fn [[scene ctx segs] _] (binding-bars scene ctx segs :drawings)))
|
(fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :drawings)))
|
||||||
|
|
||||||
(rf/reg-sub ::note-bars
|
(rf/reg-sub ::note-bars
|
||||||
:<- [::scene] :<- [::context] :<- [::segments]
|
:<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations]
|
||||||
(fn [[scene ctx segs] _] (binding-bars scene ctx segs :notes)))
|
(fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :notes)))
|
||||||
|
|
||||||
(defn- gids-at [entries ph]
|
(defn- gids-at [entries ph]
|
||||||
(persistent!
|
(persistent!
|
||||||
|
|
|
||||||
|
|
@ -466,42 +466,13 @@
|
||||||
(.addEventListener js/document "mousemove" move)
|
(.addEventListener js/document "mousemove" move)
|
||||||
(.addEventListener js/document "mouseup" up)))
|
(.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
|
;; 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.
|
;; authoring, or nil. Deref'd in the timeline render to draw the preview band.
|
||||||
(defonce ^:private region-sel (r/atom nil))
|
(defonce ^:private region-sel (r/atom nil))
|
||||||
|
|
||||||
(defn- region-select!
|
(defn- region-select!
|
||||||
"On the timeline while authoring: DRAG to select a region [lo hi) → one
|
"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 —
|
picks it (draft-click-seg), clicking empty timeline just moves the playhead —
|
||||||
so both still work in marking mode. `content` is the coord ref."
|
so both still work in marking mode. `content` is the coord ref."
|
||||||
[content fps zoom on-click ev]
|
[content fps zoom on-click ev]
|
||||||
|
|
@ -667,64 +638,30 @@
|
||||||
label]]))]
|
label]]))]
|
||||||
[:div.ann-lanes {:style {:height lane-h :width width}
|
[:div.ann-lanes {:style {:height lane-h :width width}
|
||||||
:on-mouse-down #(scrub! @content fps zoom %)}
|
:on-mouse-down #(scrub! @content fps zoom %)}
|
||||||
;; VISUAL bars — one rectangle per piece (solid saved, dashed draft).
|
;; Saved and selected marks use the exact same projected pieces.
|
||||||
;; 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.
|
|
||||||
(for [a visible
|
(for [a visible
|
||||||
[j [lo hi mid]] (map-indexed vector (:bars a))]
|
[j [lo hi mid]] (map-indexed vector (:bars a))]
|
||||||
^{:key (str (:id a) "-" j)}
|
^{:key (str (:id a) "-" j)}
|
||||||
[:div.ann-bar {:title (:name a)
|
[:div.ann-bar {:title (:name a)
|
||||||
:on-mouse-down
|
:on-mouse-down
|
||||||
(when-not (:draft a)
|
(fn [e]
|
||||||
(fn [e] (.stopPropagation e)
|
(.stopPropagation e)
|
||||||
(if linking
|
(cond
|
||||||
(do (.preventDefault e) ; pick: link to this timeline
|
(: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)))
|
(commit-link! {:kind :timeline :ref (:id a)} (:name a)))
|
||||||
;; jump the playhead to this mark and scroll its
|
:else (do (goto! lo true)
|
||||||
;; card into view (don't drill into the timeline)
|
|
||||||
(do (goto! lo true)
|
|
||||||
(when-let [node (js/document.getElementById
|
(when-let [node (js/document.getElementById
|
||||||
(str "ann-" (name (:id a))))]
|
(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
|
:style {:top (+ 2 (* (lane-of (:id a)) 18)) :height 14
|
||||||
:left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom))
|
:left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom))
|
||||||
:background (str (:color a) (if (:draft a) "44" "cc"))
|
:background (str (:color a) (if (:draft a) "44" "cc"))
|
||||||
:cursor (if (:draft a) "default" "pointer")
|
:cursor "pointer" :border-radius 2
|
||||||
:pointer-events (when (:draft a) "none")
|
:box-shadow (when (and (:draft a) (= mid active-mark))
|
||||||
:border-radius 2
|
"0 0 0 2px var(--ink)")
|
||||||
:border (str (if (:draft a) "1px dashed " "1px solid ") (:color a))}}])
|
: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
|
;; visible annotation labels
|
||||||
(for [a visible :let [[lo _] (first (:bars a))] :when lo]
|
(for [a visible :let [[lo _] (first (:bars a))] :when lo]
|
||||||
^{:key (str "lbl-" (:id a))}
|
^{:key (str "lbl-" (:id a))}
|
||||||
|
|
@ -1145,14 +1082,13 @@
|
||||||
(or (:name g) (get-in g [:media :name]) (some-> gid name)))))
|
(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
|
;; 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 —
|
;; 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).
|
;; that's the "link across arbitrarily nested groups" gesture (search, not drag).
|
||||||
(defn- membership-chips [scene a authed?]
|
(defn- membership-chips [scene a authed?]
|
||||||
(r/with-let [adding? (r/atom false)]
|
(r/with-let [adding? (r/atom false)]
|
||||||
(let [gid (:id a)
|
(let [gid (:id a)
|
||||||
homes (:parents a)
|
homes (:parents a)
|
||||||
prim (:parent a)
|
|
||||||
cands (->> (:groups scene)
|
cands (->> (:groups scene)
|
||||||
(keep (fn [[g grp]]
|
(keep (fn [[g grp]]
|
||||||
(when (and (contains? #{:annotation :timeline} (:type grp))
|
(when (and (contains? #{:annotation :timeline} (:type grp))
|
||||||
|
|
@ -1169,7 +1105,7 @@
|
||||||
[::events/pop-to :root]
|
[::events/pop-to :root]
|
||||||
[::events/expand h]))}
|
[::events/expand h]))}
|
||||||
(group-name scene h)
|
(group-name scene h)
|
||||||
(when (and authed? (not= h prim))
|
(when authed?
|
||||||
[:button.in-x {:type "button" :title "Un-file"
|
[:button.in-x {:type "button" :title "Un-file"
|
||||||
:on-click (fn [e] (.stopPropagation e)
|
:on-click (fn [e] (.stopPropagation e)
|
||||||
(rf/dispatch [::events/unfile gid h]))} "✕"])])
|
(rf/dispatch [::events/unfile gid h]))} "✕"])])
|
||||||
|
|
@ -1270,7 +1206,7 @@
|
||||||
(.stopPropagation e) (.preventDefault e) (reset! over? true)))
|
(.stopPropagation e) (.preventDefault e) (reset! over? true)))
|
||||||
:on-drag-leave (fn [_] (reset! over? false))
|
:on-drag-leave (fn [_] (reset! over? false))
|
||||||
;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS
|
;; 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]
|
:on-drop (fn [e]
|
||||||
(let [src (.. e -dataTransfer (getData "text/ann"))]
|
(let [src (.. e -dataTransfer (getData "text/ann"))]
|
||||||
(when (seq src)
|
(when (seq src)
|
||||||
|
|
@ -1315,7 +1251,6 @@
|
||||||
[:div.ann-title
|
[:div.ann-title
|
||||||
[:span.ann-swatch {:style {:background (:color a)}}]
|
[:span.ann-swatch {:style {:background (:color a)}}]
|
||||||
(when (:broken a) [:span.ann-warn {:title (:reason 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)]
|
(:name a)]
|
||||||
[:div.ann-actions
|
[:div.ann-actions
|
||||||
[jump-control open a scene segs]
|
[jump-control open a scene segs]
|
||||||
|
|
@ -1358,21 +1293,16 @@
|
||||||
nmap (into {} (map (juxt :id identity)) @(rf/subscribe [::subs/notes]))
|
nmap (into {} (map (juxt :id identity)) @(rf/subscribe [::subs/notes]))
|
||||||
revealed @(rf/subscribe [::subs/revealed])]
|
revealed @(rf/subscribe [::subs/revealed])]
|
||||||
[:div.commentary
|
[:div.commentary
|
||||||
;; this context's own description (links resolve in its parent), with an
|
;; This context's description; frame links resolve in this timeline.
|
||||||
;; edit button — Edit drops into the parent timeline so marks are editable.
|
|
||||||
(let [cg (get-in scene [:groups ctx])]
|
(let [cg (get-in scene [:groups ctx])]
|
||||||
[:div.ctx-content
|
[: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))
|
(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."])
|
[:div.muted "No description yet."])
|
||||||
(when authed?
|
(when authed?
|
||||||
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
|
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
|
||||||
(if (seq anns)
|
(if (seq anns)
|
||||||
;; group by REFERENCE parent(s): an annotation is listed under every
|
;; Cards follow visibility edges, independently of their footage.
|
||||||
;; timeline its marks were authored in (:parents), so a transcluded one
|
|
||||||
;; shows under each context it belongs to, not just its structural parent.
|
|
||||||
(let [by-parent (subs/annotations-by-parent anns)]
|
(let [by-parent (subs/annotations-by-parent anns)]
|
||||||
(doall
|
(doall
|
||||||
(for [a (get by-parent ctx)]
|
(for [a (get by-parent ctx)]
|
||||||
|
|
@ -1393,39 +1323,17 @@
|
||||||
(defn- pt-len [scene segs seg]
|
(defn- pt-len [scene segs seg]
|
||||||
(or (scene/seg-length segs seg) (scene/ref-length scene seg)))
|
(or (scene/seg-length segs seg) (scene/ref-length scene seg)))
|
||||||
|
|
||||||
(defn- frame-chip
|
(defn- part-editor [scene gid mid index {:keys [clip start end]}]
|
||||||
"A filled endpoint: clip name + a mark-time frame input (edits `put` the group).
|
[:div.mark-row
|
||||||
The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)."
|
[:span.pt-chip-name (or (scene/clip-name scene clip) (scene/ref-track-name scene clip))]
|
||||||
[scene segs put d i k {:keys [seg f]}]
|
(for [[which value lo hi] [[:start start 0 end]
|
||||||
(let [len (pt-len scene segs seg)]
|
[:end end start (scene/ref-length scene clip)]]]
|
||||||
[:div.pt-chip
|
^{:key which}
|
||||||
[:span.pt-chip-name (pt-name scene segs seg)]
|
[:label.pt-chip
|
||||||
[:input.pt-frame {:type "number" :min 0 :max len :value f
|
(name which)
|
||||||
:on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}]
|
[:input.pt-frame {:type "number" :min lo :max hi :value value
|
||||||
[:span.pt-dur (str "/" len)]
|
:on-change #(rf/dispatch [::events/set-part-frame gid mid index which
|
||||||
[:button.pt-chip-x {:type "button" :title "Re-pick this end"
|
(to-frame (.. % -target -value) hi)])}]])])
|
||||||
: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- pending-frame-chip [scene segs {:keys [seg f]}]
|
(defn- pending-frame-chip [scene segs {:keys [seg f]}]
|
||||||
(let [len (pt-len scene segs seg)]
|
(let [len (pt-len scene segs seg)]
|
||||||
|
|
@ -1537,10 +1445,7 @@
|
||||||
last-scrolled (atom nil)]
|
last-scrolled (atom nil)]
|
||||||
(let [d @(rf/subscribe [::subs/draft-group])
|
(let [d @(rf/subscribe [::subs/draft-group])
|
||||||
scene @(rf/subscribe [::subs/scene])
|
scene @(rf/subscribe [::subs/scene])
|
||||||
;; anchor the form to the draft's home context, not the live stack top:
|
ctx @(rf/subscribe [::subs/edit-context])
|
||||||
;; 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
|
|
||||||
segs (scene/content-segments scene ctx)
|
segs (scene/content-segments scene ctx)
|
||||||
pt @(rf/subscribe [::subs/pt])
|
pt @(rf/subscribe [::subs/pt])
|
||||||
linking @(rf/subscribe [::subs/linking])
|
linking @(rf/subscribe [::subs/linking])
|
||||||
|
|
@ -1557,10 +1462,8 @@
|
||||||
nmap (into {} (map (juxt :id identity)) notes)
|
nmap (into {} (map (juxt :id identity)) notes)
|
||||||
live @(rf/subscribe [::subs/active-note-set])
|
live @(rf/subscribe [::subs/active-note-set])
|
||||||
active @(rf/subscribe [::subs/active-mark])
|
active @(rf/subscribe [::subs/active-mark])
|
||||||
;; The root timeline's mark is absolute numeric [start/end], not a ref
|
;; Root editing is description-only.
|
||||||
;; mark. Root editing is description-only, so do not run it through the
|
rows (when-not root? (scene/marks->rows scene ctx (:marks d)))
|
||||||
;; annotation mark-row machinery.
|
|
||||||
rows (when-not root? (scene/marks->rows scene (:marks d)))
|
|
||||||
broken (if root? #{} (set (scene/broken-marks scene gid))) ; marks whose refs no longer resolve
|
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))))
|
valid? (or root? (and (not (str/blank? (:name d))) (seq (:marks d))))
|
||||||
save #(when valid?
|
save #(when valid?
|
||||||
|
|
@ -1625,34 +1528,13 @@
|
||||||
(reset! mark-drag {:src i}))} "⠿"]
|
(reset! mark-drag {:src i}))} "⠿"]
|
||||||
(when (contains? broken mark-id)
|
(when (contains? broken mark-id)
|
||||||
[:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "])
|
[:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "])
|
||||||
;; a proxy collapses its cross-clip run to first-clip start →
|
[:details
|
||||||
;; last-clip end; each endpoint edits the proxy's own boundary
|
[:summary
|
||||||
;; mark's frame (crossing a clip boundary is the lane handles).
|
(if (seq row)
|
||||||
;; A plain clip mark edits its own :at directly.
|
(str/join " · " (map (fn [[lo hi]] (str lo "–" hi "f")) row))
|
||||||
(if-let [pid (:proxy row)]
|
"Outside this timeline")]
|
||||||
;; while re-picking one end (after its ✕) that end becomes a live
|
(for [[index part] (map-indexed vector (:parts mark))]
|
||||||
;; clip picker in the row; the other end stays a normal chip.
|
^{:key index} [part-editor scene gid mark-id index part])]
|
||||||
(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)]])
|
|
||||||
[:button.mark-draw {:type "button"
|
[:button.mark-draw {:type "button"
|
||||||
:class (when (seq (:drawings mark)) "has")
|
:class (when (seq (:drawings mark)) "has")
|
||||||
:title (if (seq (:drawings mark)) "Edit drawing on this shot" "Draw on this shot")
|
: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]
|
(for [ng (:notes mark) :let [n (nmap ng)] :when n]
|
||||||
^{:key (name ng)}
|
^{:key (name ng)}
|
||||||
[mark-note-chip ng n live #(rf/dispatch [::events/unbind-note-mark gid mark-id %])]))))]))
|
[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?}])
|
[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)."]])
|
[:div.form-hint "Drag across the timeline to select a range (click to move the playhead)."]])
|
||||||
(when-not choosing?
|
(when-not choosing?
|
||||||
|
|
|
||||||
|
|
@ -1,245 +1,230 @@
|
||||||
(ns tl.flow-test
|
(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]]
|
(:require [cljs.test :refer-macros [deftest is testing]]
|
||||||
[day8.re-frame.test :as rf-test]
|
[day8.re-frame.test :as rf-test]
|
||||||
[re-frame.core :as rf]
|
[re-frame.core :as rf]
|
||||||
[re-frame.db :as rdb]
|
[re-frame.db :as rdb]
|
||||||
[tl.events :as ev]
|
[tl.events :as ev]
|
||||||
[tl.subs :as subs]
|
[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
|
(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
|
||||||
:connect-scene :fetch-projects :poll-thumbnails :upload-project]]
|
:connect-scene :fetch-projects :poll-thumbnails :upload-project]]
|
||||||
(rf/reg-fx k (fn [_] nil)))
|
(rf/reg-fx k (fn [_] nil)))
|
||||||
|
|
||||||
;; four clips on four tracks, one shared source file; root spans [0,400)
|
(defn seed []
|
||||||
(def clips-scene
|
(let [sc (-> fixture/base
|
||||||
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}}
|
(fixture/annotation :a1 [:root] (s/make-mark fixture/base :root 0 100))
|
||||||
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]}
|
(fixture/annotation :b1 [:root] (s/make-mark fixture/base :root 100 300)))]
|
||||||
:clip-a {:type :clip :parent nil :name "Challengers.mov" :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]}
|
(fixture/annotation sc :x [:a1] (s/make-mark sc :a1 10 60))))
|
||||||
: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 setup! [scene stack]
|
(defn setup! [scene stack]
|
||||||
(reset! rdb/app-db {:scene scene :fps 24
|
(reset! rdb/app-db {:scene scene :fps 24 :project {:id nil}
|
||||||
:view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}
|
:view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}}))
|
||||||
:project {:id nil}}))
|
|
||||||
|
|
||||||
(defn scene* [] (:scene @rdb/app-db))
|
(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 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)))
|
|
||||||
|
|
||||||
;; =========================================================================
|
(deftest moves-edit-one-edge-in-both-directions
|
||||||
;; the annotation pane sub (::all-annotations) lists by membership
|
(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
|
(rf-test/run-test-sync
|
||||||
(setup! (seed) [:root])
|
(setup! (seed) [:root])
|
||||||
(testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT"
|
(rf/dispatch [::ev/file-into :x :b1])
|
||||||
(is (= #{:annA :annB} (pane-ids)))
|
(rf/dispatch [::ev/file-into :x :b1])
|
||||||
(is (= :root @(rf/subscribe [::subs/context])))
|
(rf/dispatch [::ev/unfile :x :a1])
|
||||||
(is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)"))
|
(is (= [:b1] (:in (group :x))))
|
||||||
(testing "pushing annA onto the stack lists annC (its child), not annA/annB"
|
(rf/dispatch [::ev/file-into :x :x])
|
||||||
(rf/dispatch [::ev/expand :annA])
|
(is (= [:b1] (:in (group :x))))
|
||||||
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
|
(rf/dispatch [::ev/file-into :x :missing])
|
||||||
(is (= :annA @(rf/subscribe [::subs/context])))
|
(is (= [:b1] (:in (group :x))))))
|
||||||
(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))))))
|
|
||||||
|
|
||||||
;; =========================================================================
|
(deftest visibility-cycles-do-not-create-content-cycles
|
||||||
;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched
|
|
||||||
;; =========================================================================
|
|
||||||
|
|
||||||
(deftest reparent-move-then-link
|
|
||||||
(rf-test/run-test-sync
|
(rf-test/run-test-sync
|
||||||
(setup! (seed) [:root])
|
(setup! (seed) [:root])
|
||||||
(let [marks0 (get-in (scene*) [:groups :annC :marks])]
|
(let [before (s/resolve (scene*) :a1)]
|
||||||
(testing "drag annC (grabbed under annA) onto root: the edge MOVES, primary follows"
|
(rf/dispatch [::ev/file-into :a1 :x])
|
||||||
(rf/dispatch [::ev/ann-drag-start :annC :annA])
|
(rf/dispatch [::ev/toggle-children :a1])
|
||||||
(rf/dispatch [::ev/reparent :annC :root]) ; add? falsey ⇒ move
|
(rf/dispatch [::ev/toggle-children :x])
|
||||||
(is (= [:root] (:in (get-in (scene*) [:groups :annC]))))
|
(is (= before (s/resolve (scene*) :a1)))
|
||||||
(is (= :root (s/home (scene*) :annC)))
|
(is (= #{:a1 :b1 :x} (pane-ids))))))
|
||||||
(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])))))))
|
|
||||||
|
|
||||||
(deftest reparent-refuses-cycles-and-noops
|
(deftest associate-from-sibling-adds-footage-and-visibility
|
||||||
(rf-test/run-test-sync
|
(rf-test/run-test-sync
|
||||||
(setup! (seed) [:root])
|
(setup! (seed) [:root :b1])
|
||||||
(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])
|
|
||||||
(rf/dispatch [::ev/open-draft])
|
(rf/dispatch [::ev/open-draft])
|
||||||
(rf/dispatch [::ev/draft-select-range 50 150])
|
(rf/dispatch [::ev/draft-select-range 50 150])
|
||||||
(let [d (draft-gid)]
|
(rf/dispatch [::ev/associate-marks (draft-gid) :x])
|
||||||
(is d "a draft exists after open-draft")
|
(is (= #{:a1 :b1} (s/membership (scene*) :x)))
|
||||||
(is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB")
|
(is (= 2 (count (:marks (group :x)))))
|
||||||
(rf/dispatch [::ev/associate-marks d :annC]))
|
(is (contains? (pane-ids) :x))
|
||||||
(testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)"
|
(is (= :b1 (get-in @rdb/app-db [:view :edit-context])))
|
||||||
(is (= 2 (count (get-in (scene*) [:groups :annC :marks]))))
|
(is (= [[:a 10 60] [:b 50 100] [:c 0 50]]
|
||||||
(is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks"))
|
(mapv (juxt :clip :start :end) (mapcat :parts (:marks (group :x))))))
|
||||||
;; associate opened annC in :edit; save it (drops :draft) and leave the form
|
(is (not-any? #(= :proxy (:type %)) (vals (:groups (scene*)))))))
|
||||||
(rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil])
|
|
||||||
|
(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])
|
(rf/dispatch [::ev/finish-edit])
|
||||||
(testing "so annC does NOT list under annB — even though its footage resolves there"
|
(is (= original (group :x)))
|
||||||
(is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB")
|
(is (= groups (set (keys (:groups (scene*)))))))))
|
||||||
(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))))))
|
|
||||||
|
|
||||||
;; =========================================================================
|
(deftest endpoint-edit-preserves-mark-identity-and-bindings
|
||||||
;; stack push / pop and reveal-children through the real events
|
(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
|
(rf-test/run-test-sync
|
||||||
(setup! (seed) [:root])
|
(setup! (seed) [:root])
|
||||||
(testing "expand pushes, pop-to truncates, collapse pops"
|
(let [before (s/resolve (scene*) :x)]
|
||||||
(rf/dispatch [::ev/expand :annA])
|
(rf/dispatch [::ev/delete-annotation :a1])
|
||||||
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
|
(is (= before (s/resolve (scene*) :x)))
|
||||||
(rf/dispatch [::ev/collapse])
|
(is (= [:root :x] (s/path-to (scene*) :x)))
|
||||||
(is (= [:root] (:stack (:view @rdb/app-db))))
|
(is (contains? (pane-ids) :x)))))
|
||||||
(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"))))
|
|
||||||
|
|
||||||
;; =========================================================================
|
(deftest peer-delta-decodes-current-format
|
||||||
;; 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
|
|
||||||
(rf-test/run-test-sync
|
(rf-test/run-test-sync
|
||||||
;; annC's sole host (annA) is deleted out from under it, as if by restore of
|
(setup! fixture/base [:root])
|
||||||
;; 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
|
|
||||||
(rf/dispatch [::ev/peer-delta
|
(rf/dispatch [::ev/peer-delta
|
||||||
{:changed {:ann-legacy {:type "annotation" :parent "root" :name "L"
|
{:changed {:x {:type "annotation" :in ["root"] :name "X"
|
||||||
:marks [{:id "lm" :start {:ref "clip-a" :at 0}
|
:marks [{:id "m" :parts [{:clip "a" :start 10 :end 50}]}]}}
|
||||||
:end {:ref "clip-a" :at 50}}]}}
|
|
||||||
:deleted []}])
|
:deleted []}])
|
||||||
(testing "it migrates :parent -> :in [:root] on ingest and drops the old field"
|
(is (= #{:x} (pane-ids)))
|
||||||
(is (= [:root] (:in (get-in (scene*) [:groups :ann-legacy]))))
|
(is (= [{:clip :a :start 10 :end 50}] (get-in (group :x) [:marks 0 :parts])))
|
||||||
(is (nil? (:parent (get-in (scene*) [:groups :ann-legacy])))))
|
(is (= [[1010 1050]] (mapv :src (s/resolve (scene*) :x))))
|
||||||
(testing "and shows up in the root pane like any other"
|
(is (= (group :x) (:x (fixture/wire {:x (group :x)}))))))
|
||||||
(is (contains? (pane-ids) :ann-legacy)))))
|
|
||||||
|
|
||||||
(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
|
(rf-test/run-test-sync
|
||||||
(setup! (seed) [:root])
|
(setup! (seed) [:root])
|
||||||
(rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root]
|
(rf/dispatch [::ev/unfile :x :a1])
|
||||||
(let [g (get-in (scene*) [:groups :annC])
|
(is (contains? (pane-ids) :x))
|
||||||
;; exactly what api/put-scene serializes then reads back
|
(rf/dispatch [::ev/ann-drag-start :x :root])
|
||||||
wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true)
|
(rf/dispatch [::ev/reparent :x :b1])
|
||||||
back (:annC (s/restore-annotations {:annC wire}))]
|
(is (= #{:b1} (s/membership (scene*) :x)))
|
||||||
(is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)")
|
(is (not (contains? (pane-ids) :x)))))
|
||||||
(is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved")
|
|
||||||
(is (= :annA (s/home {:groups {:annC back}} :annC))))))
|
|
||||||
|
|
|
||||||
|
|
@ -4,391 +4,152 @@
|
||||||
[tl.otio :as otio]
|
[tl.otio :as otio]
|
||||||
[tl.scene :as s]))
|
[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
|
(def base
|
||||||
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"}}
|
{:tracks {:t0 {:name "A"} :t1 {:name "B"} :t2 {:name "C"}}
|
||||||
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 300}]}
|
:groups {:root {:type :timeline}
|
||||||
;; :start = timeline position; here it equals source so root is identity
|
:a {:type :clip :track :t0 :start 0 :source 1000 :duration 100}
|
||||||
:clip-a {:type :clip :parent nil :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]}
|
:b {:type :clip :track :t1 :start 100 :source 2000 :duration 100}
|
||||||
:clip-b {:type :clip :parent nil :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
|
:c {:type :clip :track :t2 :start 200 :source 3000 :duration 100}}})
|
||||||
:clip-c {:type :clip :parent nil :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}}})
|
|
||||||
|
|
||||||
(defn with-group [scene gid g] (assoc-in scene [:groups gid] g))
|
(defn part [clip start end] {:clip clip :start start :end end})
|
||||||
(defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}})
|
(defn mark [id & parts] {:id id :parts (vec parts)})
|
||||||
(defn err-msg [f]
|
(defn annotation [scene gid edges & marks]
|
||||||
(try (f) nil (catch js/Error e (.-message e))))
|
(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.
|
(deftest root-distinguishes-timeline-and-source-time
|
||||||
(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"
|
|
||||||
(let [segs (s/resolve base :root)]
|
(let [segs (s/resolve base :root)]
|
||||||
(is (= 300 (s/length segs)))
|
(is (= 300 (s/length segs)))
|
||||||
(is (= 250 (s/local->source segs 250)))
|
(is (= [0 100 200] (mapv (comp first :local) segs)))
|
||||||
(is (= [0 300] (:src (first 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
|
(deftest compilation-preserves-order-repeats-and-trims
|
||||||
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track"
|
(let [sc (annotation base :x [:root]
|
||||||
(let [scene (with-group base :ann
|
(mark :m (part :c 20 40) (part :a 0 10) (part :c 20 40)))
|
||||||
{:type :annotation :in [:root]
|
segs (s/resolve sc :x)]
|
||||||
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})
|
(is (= [[3020 3040] [1000 1010] [3020 3040]] (mapv :src segs)))
|
||||||
segs (s/resolve scene :ann)]
|
(is (= [[0 20] [20 30] [30 50]] (mapv :local segs)))
|
||||||
(is (= 200 (s/length segs)))
|
(is (= [3025 1005 3025] (mapv #(s/local->source segs %) [5 25 35])))
|
||||||
(is (= 200 (s/local->source segs 0))) ; local 0 -> C's source start
|
(is (= [:m :m :m] (mapv :mark segs)))))
|
||||||
(is (= 0 (s/local->source segs 100))) ; local 100 -> A's source start
|
|
||||||
(is (= #{:t2 :t0} (s/tracks segs)))
|
|
||||||
(is (not (contains? (s/tracks segs) :t1))))))
|
|
||||||
|
|
||||||
(deftest inter-x-lays-four-subclips
|
(deftest selections-own-raw-clip-slices
|
||||||
(testing "four 50-frame subclips, in mark order, end to end"
|
(let [sc (annotation base :x [:root]
|
||||||
(let [segs (s/resolve inter-x :ann-x)]
|
(mark :m (part :b 50 100) (part :a 0 50) (part :b 0 50)))
|
||||||
(is (= 4 (count segs)))
|
selection (s/make-mark sc :x 40 110)
|
||||||
(is (= 200 (s/length segs)))
|
sc (annotation sc :y [:x] selection)
|
||||||
(is (= [150 200] (:src (nth segs 0))))
|
before (s/resolve sc :y)]
|
||||||
(is (= 150 (s/local->source segs 0))) ; B's second half
|
(is (= [(part :b 90 100) (part :a 0 50) (part :b 0 10)] (:parts selection)))
|
||||||
(is (= 0 (s/local->source segs 50))) ; boundary into A's first half
|
(is (= before (s/resolve (update sc :groups dissoc :x) :y)))
|
||||||
(is (= [:clip-b :clip-a :clip-b :clip-a] (map :thumb segs)))
|
(is (= before (s/resolve (assoc-in sc [:groups :y :in] [:root]) :y)))
|
||||||
(is (= [50 0 0 50] (map :thumb-start segs)))
|
(is (= before (s/resolve (assoc-in sc [:groups :x :marks] []) :y)))))
|
||||||
(is (= #{:t1 :t0} (s/tracks segs))))))
|
|
||||||
|
|
||||||
(deftest trim-no-clamp
|
(deftest selection-through-repeated-footage
|
||||||
(testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame"
|
(let [sc (annotation base :x [:root] (mark :m (part :a 20 40) (part :a 60 90)))
|
||||||
;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100
|
segs (s/content-segments sc :x)
|
||||||
(let [scene (-> base
|
mid (:mark (second segs))
|
||||||
(with-group :ann {:type :annotation :in [:root]
|
lo (s/seg-local segs mid 5)]
|
||||||
:marks [{:id :m/s :start {:ref :clip-a :at 20}
|
(is (= 2 (count (distinct (map :mark segs)))))
|
||||||
:end {:ref :clip-a :at 80}}]})
|
(is (= 30 (s/seg-length segs mid)))
|
||||||
(with-group :ann-y {:type :annotation :in [:ann]
|
(is (= 25 lo))
|
||||||
:marks [{:id :m/y :start {:ref :m/s :at 0}
|
(is (= [(part :a 65 70)] (s/selection->parts sc :x lo (+ lo 5))))))
|
||||||
:end {:ref :m/s :at -1}}]}))
|
|
||||||
seg (first (s/resolve scene :ann-y))]
|
|
||||||
(is (= [20 80] (:src seg))) ; ends at the subclip's 80, not 100
|
|
||||||
(is (= 60 (s/length (s/resolve scene :ann-y)))))))
|
|
||||||
|
|
||||||
(deftest tracks-by-membership
|
(deftest one-mark-one-row-no-extra-entities
|
||||||
(testing "zoom includes exactly the tracks the marks touch"
|
(let [m (s/make-mark base :root 40 210)]
|
||||||
(let [scene (with-group base :ann
|
(is (= [(part :a 40 100) (part :b 0 100) (part :c 0 10)] (:parts m)))
|
||||||
{:type :annotation :in [:root]
|
(is (= [[[40 210]]] (s/marks->rows base :root [m])))))
|
||||||
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})]
|
|
||||||
(is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann)))))))
|
|
||||||
|
|
||||||
(deftest repeat-yields-two-pieces
|
(deftest projection-preserves-root-clip-identity
|
||||||
(testing "a clip referenced twice renders at two local positions"
|
(let [sc (-> base
|
||||||
(let [scene (with-group base :ann
|
(assoc-in [:groups :b :source] 1000)
|
||||||
{:type :annotation :in [:root]
|
(annotation :x [:root] (mark :m (part :a 10 20))))]
|
||||||
:marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100)
|
(is (= [[10 20 :m]] (s/lane-bars sc :x (s/content-segments sc :root))))))
|
||||||
(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-shows-every-repeat
|
||||||
;; Suite 2 — authoring lifecycle (annotate A, push A, annotate B, mess with A)
|
(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
|
(deftest contiguity-is-defined-by-render-context
|
||||||
(testing "Y's refs track the subclips' CONTENT through a reorder of X"
|
(let [sc (-> base
|
||||||
(let [reordered (update-in x+y [:groups :ann-x :marks] reverse)]
|
(annotation :context [:root] (mark :r (part :c 0 100) (part :a 0 100)))
|
||||||
(is (= (s/resolve x+y :ann-y) (s/resolve reordered :ann-y))))))
|
(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
|
(deftest projection-clips-partial-overlap-without-changing-content
|
||||||
(testing "editing s0's in-point in place (same id) is reflected through Y's ref"
|
(let [sc (-> base
|
||||||
(let [edited (assoc-in x+y [:groups :ann-x :marks 0 :start :at] 40)] ; s0 now B[40,100) src[140,200)
|
(annotation :context [:root] (mark :r (part :a 30 70)))
|
||||||
(is (= [150 160] (:src (first (s/resolve edited :ann-y)))))))) ; s0[10..20] -> [150,160)
|
(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
|
(deftest distinct-marks-never-merge
|
||||||
(testing "deleting s0 dangles Y's first mark; the second still resolves"
|
(let [sc (annotation base :x [:root] (mark :m1 (part :a 0 100)) (mark :m2 (part :b 0 100)))]
|
||||||
(let [del (update-in x+y [:groups :ann-x :marks] #(vec (rest %)))] ; drop s0
|
(is (= [[0 100 :m1] [100 200 :m2]] (s/lane-bars sc :x (s/content-segments sc :root))))))
|
||||||
(is (= [:m/y0] (s/broken-marks del :ann-y)))
|
|
||||||
(is (= 1 (count (s/resolve del :ann-y))))
|
|
||||||
(is (= [0 5] (:src (first (s/resolve del :ann-y)))))))) ; the surviving y1
|
|
||||||
|
|
||||||
(deftest selection-splits-into-a-run
|
(deftest instant-and-boundary-frames
|
||||||
(testing "a selection crossing subclip boundaries becomes one mark per segment"
|
(let [sc (annotation base :x [:root] (assoc (s/make-mark base :root 100 100) :id :instant))]
|
||||||
(let [run (s/selection->marks inter-x :ann-x 40 110)] ; crosses s0, s1, s2
|
(is (= [(part :b 0 0)] (get-in sc [:groups :x :marks 0 :parts])))
|
||||||
(is (= 3 (count run)))
|
(is (= [[100 100 :instant]] (s/lane-bars sc :x (s/content-segments sc :root))))
|
||||||
(is (= [:m/s0 :m/s1 :m/s2] (map #(get-in % [:start :ref]) run)))
|
(is (= 0 (s/length (s/resolve sc :x))))))
|
||||||
;; the s0 piece is its tail (local 40..50 -> offset 40..50 into s0)
|
|
||||||
(is (= 40 (get-in (first run) [:start :at])))
|
|
||||||
(is (= 50 (get-in (first run) [:end :at]))))))
|
|
||||||
|
|
||||||
(deftest root-selection-splits-by-clip
|
(deftest visibility-is-independent-of-compilation
|
||||||
(testing "selecting across A/B/C at the ROOT splits into one ref per clip"
|
(let [sc (annotation base :x [:root] (mark :m (part :a 0 100)))
|
||||||
(let [run (s/selection->marks base :root 40 210)] ; A-tail + B + C-head
|
moved (assoc-in sc [:groups :x :in] [:other :root])]
|
||||||
(is (= 3 (count run)))
|
(is (= (s/resolve sc :x) (s/resolve moved :x)))
|
||||||
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) run)))
|
(is (= #{:root} (s/membership moved :x)))
|
||||||
(is (= 40 (get-in (first run) [:start :at]))) ; A from frame 40
|
(is (= (s/resolve moved :x)
|
||||||
(is (= 0 (get-in (last run) [:start :at])))))) ; C from frame 0
|
(s/resolve (assoc-in moved [:groups :x :in] [:root :other]) :x)))))
|
||||||
|
|
||||||
(deftest reconcile-keeps-ids-across-resize
|
(deftest missing-clips-are-reported-with-valid-parts-still-visible
|
||||||
(testing "resizing a selection keeps the surviving pieces' ids; adds/drops at the ends"
|
(let [sc (annotation base :x [:root] (mark :m (part :missing 0 10) (part :a 0 20)))]
|
||||||
(let [run1 (s/selection->marks base :root 40 110) ; A-tail, B-head
|
(is (= [:m] (s/broken-marks sc :x)))
|
||||||
a-id (:id (first run1))
|
(is (= [[1000 1020]] (mapv :src (s/resolve sc :x))))
|
||||||
run2 (s/reconcile-run base :root run1 40 210) ; grow → A, B, C
|
(is (some? (s/broken-reason sc :x)))))
|
||||||
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 json-roundtrip-covers-all-authored-types
|
||||||
;; Suite 2b — proxy synthetic-clips (marks-first authoring)
|
(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
|
(deftest links-and-jumps-use-context-projection
|
||||||
(testing "an annotation referencing a whole proxy resolves to the proxy's full
|
(let [sc (annotation base :x [:root] (mark :m (part :a 20 30) (part :c 50 60)))
|
||||||
per-clip run — scattered-source clips pieced back together"
|
seg (first (s/content-segments sc :x))]
|
||||||
(let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210)
|
(is (= {:ref :a :at 25} (s/seg-point sc seg 5)))
|
||||||
scene (-> base
|
(is (= 5 (s/link-local sc :x {:ref :a :at 25})))
|
||||||
(with-group :prox p)
|
(is (nil? (s/link-local sc :x {:ref :b :at 25})))
|
||||||
(with-group :ann {:type :annotation :in [:root]
|
(is (= 42 (s/link-local sc :root {:ref :root :at 42})))
|
||||||
:marks [(s/proxy-ref :m/px :prox)]}))
|
(is (= [20 250] (mapv :local (s/jump-targets sc :root :x))))
|
||||||
segs (s/resolve scene :ann)]
|
(is (= [20 50] (mapv :f (s/jump-targets sc :root :x))))
|
||||||
(is (= 170 (s/length segs))) ; 60 + 100 + 10
|
(is (= 4 (count (s/linkables sc :root))))))
|
||||||
(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 proxy-of-a-single-clip-is-just-that-clip
|
(deftest navigation-does-not-follow-visibility
|
||||||
(testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip"
|
(let [sc (-> base (annotation :x [:y]) (annotation :y [:x]))]
|
||||||
(let [p (s/make-proxy base :root 10 60) ; inside A only
|
(is (= [:root :x] (s/path-to sc :x)))
|
||||||
scene (-> base (with-group :prox p)
|
(is (= #{:root :x :y} (set (map :gid (s/timelines sc)))))
|
||||||
(with-group :ann {:type :annotation :in [:root]
|
(is (nil? (s/path-to sc :missing)))))
|
||||||
: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 roll-proxy-keeps-interior-ids-stable
|
(deftest integer-frame-invariants
|
||||||
(testing "growing/shrinking a proxy's endpoints keeps interior ids and edits
|
(is (re-find #"integer frame" (err-msg #(s/selection->parts base :root 0.5 20))))
|
||||||
boundary marks in place (added out, dropped in)"
|
(is (re-find #"ordered" (err-msg #(s/selection->parts base :root 20 10))))
|
||||||
(let [p0 (s/make-proxy base :root 40 210) ; A-tail, B, C-head
|
(is (= [[0 30] [40 50]] (s/merge-bars [[20 30] [0 20] [40 50]]))))
|
||||||
[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 proxy-mark-collapses-to-one-row
|
(deftest playheads-are-per-context
|
||||||
(testing "a proxy ref renders as ONE editor row: first-clip start → last-clip end"
|
(let [v (-> {} (s/set-playhead :root 30) (s/set-playhead :x 80))]
|
||||||
(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))]
|
|
||||||
(is (= 30 (s/playhead v :root)))
|
(is (= 30 (s/playhead v :root)))
|
||||||
(is (= 80 (s/playhead v :ann-x)))
|
(is (= 80 (s/playhead v :x)))
|
||||||
(is (= 0 (s/playhead v :ann-y)))))) ; unvisited -> 0
|
(is (= 0 (s/playhead v :unvisited)))))
|
||||||
|
|
||||||
(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
|
|
||||||
|
|
||||||
(deftest seed-from-otio
|
(deftest seed-from-otio
|
||||||
(testing "from-otio seeds tracks + clip mark-groups + root; content-segments at root tiles the clips"
|
(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))]
|
media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))]
|
||||||
(is (seq media-ins))
|
(is (seq media-ins))
|
||||||
(is (every? integer? media-ins))
|
(is (every? integer? media-ins))
|
||||||
(is (every? integer? (mapcat (fn [[_ g]]
|
(is (every? integer? (mapcat (juxt :start :source :duration)
|
||||||
(mapcat (juxt :start :end) (:marks g)))
|
(filter #(= :clip (:type %)) (vals (:groups scene)))))))))
|
||||||
(: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
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue