Compare commits

..

10 commits

Author SHA1 Message Date
Your Name
d54a6ae8f8 fix: rescue orphaned annotations to root in the pane
Found by loading the real Challengers project through re-frame-test:
3 of 15 stored annotations were filed under a since-deleted parent.
Under the :in model their sole host was a ghost, so ::all-annotations
never surfaced them — invisible and unrefileable.

::all-annotations now drops :in hosts that no longer exist and rescues an
annotation left with none to root (full-scene context, so peer-delta safe).

Tests (re-frame-test, high-level events + pane sub):
- orphaned-annotation-is-rescued-to-root
- legacy-parent-data-migrates-through-peer-delta (the real DB shape)

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-07 13:16:20 -04:00
Your Name
65a80857be feat: :in membership edges replace transclusion/mark-home placement
Placement is now asserted, not derived. An annotation carries :in — an
ordered vector of the mark-groups it's filed under (first = primary home,
scene/home). Membership decides listing; mark resolution independently
decides whether bars draw. Marks are never moved or re-cut.

Rebuilt from the clean pre-transclusion base, keeping only the codex
frame-integer (assert-frame) work:
- delete ref-owner / mark-home / mark-homes / :home-marks / rehome-marks
- annotations drop :parent entirely; restore-annotations migrates
  legacy :parent -> :in [parent]; :in is a vector (JSON-round-trips
  like :tags/:notes)
- file-edge (shared by ::reparent drag + ::file-into picker): move vs
  add/link; ::unfile guards primary + last; files-under? cycle guard
- ::associate-marks no longer auto-files (adding marks != placement)
- root identified by (= :timeline (:type)), not (nil? :parent)
- membership-chips `in:` row; drag ⌥ = link; .reference cards

Tests: real day8.re-frame.test run-test-sync suite driving events +
live subscriptions (pane, context, reveal, reparent, associate, unfile,
cycle, JSON wire). 62 tests / 243 assertions, 0 failures; 0 residue.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-07 13:07:49 -04:00
Your Name
4b29962677 transclusion fixes and other things by chat 2026-07-06 23:48:01 -04:00
Your Name
d2d803e38b feat: transclusion completion by chat 2026-07-06 23:10:20 -04:00
Your Name
40dd3b0d59 feat: transclusion (wip commit) 2026-07-06 22:54:46 -04:00
Your Name
28f441f172 fix: remove active annotation filter 2026-07-05 18:20:29 -04:00
Your Name
649e36c14c feat: add annotation search filters 2026-07-05 18:17:09 -04:00
Your Name
dfa92a478f feat: improve annotation mark editing 2026-07-05 18:10:44 -04:00
Your Name
7ac8f27b57 claud erefactor checkpoint 2026-07-05 17:45:49 -04:00
Your Name
06dd2b597c fix: half-open boundaries, per-mark lane interaction, unified :at addressing
Fixes the resize-drift and boundary bugs found while exercising the marks-first
flow, plus Chunk 7 (orphan polish). Frame model made consistent rather than
patched.

- Boundaries are half-open [start,end) everywhere; drop the merge-bars ≤1-frame
  fudge and the independent from-otio rounding that created the gaps it papered
  over. Clips stay EXACT (they tile at shared boundaries); frame-accuracy is
  applied at the mark the user creates (selection->marks rounds :at) and at
  display, never by rounding clips or bars.
- Unify the ref :at <-> source conversion: at->local / at->src / src->at, all via
  the target's full resolution, correct for scattered multi-clip (nested) proxy
  targets. Delete target-range (the lossy single-segment [xs xe] shortcut that
  made selection->marks / point-frame / at->frame / seg-point wrong when nested).
  This is what fixed the resize dragging one handle moving the other.
- Lane interaction is per-MARK, not per-visual-bar: one draggable unit + two
  end-handles at the mark's exact extent (scene/mark-extent), driven so the
  dragged endpoint rounds and the fixed one stays exact. Timeline drag-select;
  click = scrub. Visible edge grips.
- Share display-point between the editor rows and the jump popover (context-local
  whole frame). Drawing autocommits; toolbar moved off the video.
- Chunk 7: broken annotations greyed + sorted down + per-mark warnings.

Suite green except the pre-existing annotations-survive-json-roundtrip; app
compiles clean.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-05 12:22:17 -04:00
19 changed files with 1925 additions and 586 deletions

View file

@ -1,16 +1,24 @@
.git
**/.venv
**/node_modules
**/.shadow-cljs
**/target
.venv
**/__pycache__
**/*.pyc
tl/node_modules
tl/.shadow-cljs
tl/target
tl/resources/public/js/compiled
**/__pycache__/
db.sqlite3
media/
staticfiles/
*.mp4
*.pdf
*.log
*.log.*
*.mbtree
*.mp4
*.mov
*.mkv
*.avi
*.pdf
thinking.org
.DS_Store
staticfiles
media
db.sqlite3

View file

@ -86,7 +86,13 @@ So "the title is the autocomplete": one control forks create-vs-associate.
- [ ] 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
## Chunk 7 — Orphan / stability polish ✅
- [ ] Grey-out + drop orphaned annotations to bottom of list with warn indicator.
- [ ] Per-mark broken-ref warnings; keep annotation if at least one mark still resolves.
- [x] Broken annotations sort to the bottom (existing sub) and are **greyed out** (opacity on the card) while staying visible so surviving marks stay usable; `△`/`⚠` warnings on the card (existing).
- [x] **Per-mark broken indicator** in the editor: broken mark rows show `△` + strike-through + dimmed (`scene/broken-marks` set); an annotation keeps rendering as long as ≥1 mark resolves.
## Fundamental fix — per-mark lane interaction (not per-bar)
Handles/drag were attached to each visual bar, so a mark rendered as N pieces got N handle pairs (handles at every clip boundary). Two root fixes:
- [x] **Interaction decoupled from visual pieces**: colored bars are per-piece (pointer-events none for draft); a separate per-MARK layer spans the mark's whole extent = one draggable unit + exactly two end-handles + active ring. Robust no matter how many pieces a mark has.
- [x] **`merge-bars` absorbs ≤1-frame gaps**: independent frame-rounding of clip `:start` could leave a 1-frame gap between adjacent clips and spuriously split a mark's bar; a 1-frame gap is a rounding artifact, not real discontinuity, so it now coalesces (still per-mark, never fuses distinct marks).

View file

@ -34,3 +34,9 @@ decided: a clip/subclip-ref mark never crosses a clip boundary, so the "range wh
this brings us to playing. since right now there is only one source video file, we need to be able to seek to arbitrary frames. each context (mark-group) keeps its own local playhead, used when it's the top of the timeline stack. when we hit play, in the example above of annotation X, we find the clip under the playhead, compute the source frame, seek there, and start playing. one correction though: the local playhead has to be the master clock, not the video. you can't derive local position from currentTime -- once an annotation repeats or reorders clips, one source frame maps to several local frames, it's not invertible. so the local playhead advances on its own (wall-clock x fps while playing), and every frame we compute expected = group->media(local) and seek the video there only if round(currentTime*fps) != expected. within a clip, expected tracks the video's natural playback so no seek fires; at a mark boundary it jumps once and we seek. and right -- no recursion at play time: we resolve the current context once into flat ordered spans, and group->media is just the flat lookup the renderer already does.
# how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation.
# automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit.
* update!
- ok so the idea is this. you hit the new annotation button. it does not auto-select a mark for you. you can either click the clip, click the frame button, or drag a range. after you select a range, you are automatically in drawing mode. your drawings are connected to the mark, not the annotation. a mark should only ever appear in one annotation. instead of creating a new annotation mark group by default, this mode also allows you to either create new or associate with an existing annotation. associate with existing gives you our dropdown with only other annotations available. when you pick one, you effectively go into "edit" mode on that annotation with the new marks suddenly added. so this is basically our "transclusion": we can have annotations with marks embedded in other timelines. this is great for if we have subdivided our analysis into "chapters" but want to annotate shared concepts across them while keeping the main annotation pane clear. it's organized. so the big thing is that you don't create the annotation, you create the mark(s) first, then either create or assoc the annotation.
- another crucial thing: if we click and drag and it spans multiple clips, the range we have in our create/add annotation UI in the annotation pane should only show the start and end points relative to the clips at start and end. so the way this will work is we will create a mark group that's not an annotation as our "proxy" marks so that they don't appear in the ui that spans the full range and contains the full sequential clips, and then the mark group on the annotation that contains that mark group will just use that mark group as start and end as if it had been clicked. so, for example: there's clips A, B, C and D contiguous. user drags region from clip A to clip D. in the UI, we should see that our mark starts at clip A frame 0 and ends at clip D last frame, so we need to "pass through" the synthetic unnamed non-annotation mark group to the underlying clips, the synthetic unnamed non-annotation mark group is a proxy.. so that proxy mark group has marks that go from clip A start-clip A end, clip B start - clip B end, clip C start to clip C end, and clip D start to clip D end. makes sense? so what do we do if the user wants to drag adjust endpoint in UI? let's say there's another clip before clip A called clip 0. we move start point BACK to clip 0 frame 50. well, our main mark group just shows the range as we would expect: clip 0 frame 50 TO clip D last frame. but the proxy mark group? it has a new mark range with new mark id at the beginning, but the other mark ids are stable. and the same is true of rolling the end point forward: new mark id, new range, rest are stsable. what if we roll the endpoints inward? same principle but we kill off mark ranges instead of adding new ones. should be clean. so this means we needs we need to change how draft/edit marks look/act in the lane. when in draft/edit mode, clicking on the mark brings up drawing mode for that mark (there can still be a button next to the mark in the edit pane). you can drag the whole mark left to right. and you can also grab handles on the edges of the annotation left to right. and since we consider whatever last created or last touched mark to be the "active" one for associating drawings to, we need to have that visually represented in the timeline, and in the pane where the draft marks or edit annotation is. and these need to share the same look for the mark range,s its only the stuff above it that iwll change. make sense?
- note: when we talk about rolling the whole clip around, we know that the mark ids are going to change if we highlight one clip, unhighlight, then return back. this means that if we annotated a range defined w/r/t that annotation, the underlying gids are broken forever, even if they're rolled back. so that they exist still, right? since the underlying clips will never change, i wonder if we could just give each clip a stable identifier and define our root-most ranges in terms of those stable identifiers? or is that worse? idk

View file

@ -5,6 +5,7 @@
"dev": "bash dev/dev.sh",
"media": "python3 dev/media_server.py",
"watch": "npx shadow-cljs watch app",
"test": "npx shadow-cljs compile test && node target/node-tests.js",
"release": "npx shadow-cljs release app",
"build-report": "npx shadow-cljs run shadow.cljs.build-report app target/build-report.html"
},

View file

@ -55,20 +55,20 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
press. The default action (.save) gets the heavy Mac "default button" ring. */
.jump-btn, .add-btn, .edit-btn, .del-btn, .expand-btn, .back-btn, .crumb,
.play-btn, .step-btn, .row-x, .add-mark, .save, .cancel, .hl-ok, .hl-cancel,
.pane-tabs button, .track-toggle {
.pane-tabs button, .track-toggle, .mark-script, .mark-script-new {
font-family: var(--chicago); background: var(--paper); color: var(--ink);
border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; line-height: 1.3;
}
.jump-btn:hover, .add-btn:hover, .edit-btn:hover, .del-btn:hover, .expand-btn:hover,
.back-btn:hover, .crumb:hover, .play-btn:hover, .step-btn:hover, .row-x:hover,
.add-mark:hover, .save:hover, .cancel:hover, .hl-ok:hover, .hl-cancel:hover,
.pane-tabs button:hover, .track-toggle:hover {
.pane-tabs button:hover, .track-toggle:hover, .mark-script:hover, .mark-script-new:hover {
background: var(--hover);
}
.jump-btn:active, .add-btn:active, .edit-btn:active, .del-btn:active, .expand-btn:active,
.back-btn:active, .crumb:active, .play-btn:active, .step-btn:active, .row-x:active,
.add-mark:active, .save:active, .cancel:active, .hl-ok:active, .hl-cancel:active,
.pane-tabs button:active, .track-toggle:active {
.pane-tabs button:active, .track-toggle:active, .mark-script:active, .mark-script-new:active {
background: var(--ink); color: var(--paper);
}
@ -101,10 +101,13 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
background: none; cursor: pointer; }
.draw-tools .draw-wid { width: 56px; }
.draw-done { font-weight: bold; }
.mark-draw { background: none; border: 1px solid transparent; border-radius: 0;
font-size: 12px; cursor: pointer; padding: 0 3px; line-height: 1; }
.mark-draw:hover { border-color: var(--ink); }
.mark-draw.has { border-color: var(--ink); background: var(--paper); }
.mark-draw, .mark-script {
width: 28px; height: 26px; flex: none;
display: inline-flex; align-items: center; justify-content: center;
border-radius: 0; font-size: 13px; cursor: pointer; padding: 0; line-height: 1;
}
.mark-draw { background: var(--paper); color: var(--ink); border: 1px solid var(--ink); }
.mark-draw.has, .mark-script.has { background: var(--desktop); background-size: 4px 4px; }
.frame-readout {
position: absolute; bottom: 6px; right: 8px; z-index: 4;
@ -209,10 +212,13 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.form {
flex: 1; min-width: 0; overflow-y: auto;
background: var(--paper); border: 1px solid var(--ink); box-sizing: border-box;
padding: 10px 12px;
display: flex; flex-direction: column; gap: 10px;
padding: 12px;
display: flex; flex-direction: column; gap: 12px;
}
.form-head {
font-family: var(--chicago); font-size: 14px; color: var(--ink);
padding-bottom: 6px; border-bottom: 2px solid var(--ink);
}
.form-head { font-family: var(--chicago); font-size: 14px; color: var(--ink); }
.form-row { display: flex; gap: 8px; align-items: center; }
.form-name { flex: 1; }
.form input[type=text], .form-name, .form-content {
@ -224,7 +230,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.form-content { width: 100%; min-height: 70px; resize: vertical; box-sizing: border-box;
font-family: inherit; }
.form-marks-label { font-family: var(--chicago); font-size: 11px; letter-spacing: .5px;
color: var(--ink); margin-top: 4px; }
color: var(--ink); margin-top: 2px; padding-top: 2px; }
/* contenteditable content surface + inline link chips */
.content-editor { white-space: pre-wrap; word-break: break-word; outline: none; cursor: text;
@ -239,8 +245,11 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.link-chip .link-f { font-size: 11px; opacity: .7; }
.link-chip:hover .link-f { opacity: 1; }
.mark-row { display: flex; flex-wrap: nowrap; align-items: center; gap: 6px; min-width: 0; }
.mark-arrow { color: var(--ink); }
.mark-row { display: flex; flex-wrap: wrap; align-items: center; gap: 6px; min-width: 0; }
.mark-arrow {
color: var(--ink); flex: none; font-family: var(--chicago);
min-width: 16px; text-align: center;
}
.row-x, .add-mark { padding: 3px 8px; font-size: 12px; }
.add-mark { align-self: flex-start; }
@ -251,7 +260,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
/* point editor + autocomplete */
.pt-input { position: relative; flex: 1 1 130px; display: flex; align-items: center; min-width: 0; }
.mark-row .pt-input { flex: 0 1 160px; max-width: 180px; }
.mark-row .pt-input { flex: 1 1 128px; max-width: 190px; }
.pt-text {
flex: 1; min-width: 0; box-sizing: border-box;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
@ -277,11 +286,18 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.link-insert { display: flex; align-items: flex-start; gap: 6px; align-self: stretch; }
.link-insert .pt-input { flex: 1 1 auto; max-width: none; }
.link-insert-block .pt-input { flex: 1 1 220px; max-width: none; }
.hl-ok, .hl-cancel { padding: 2px 9px; font-size: 12px; }
.pt-chip { flex: 1 1 0; min-width: 0; display: flex; align-items: center; gap: 4px;
.pt-chip { flex: 1 1 128px; min-width: 0; display: flex; align-items: center; gap: 4px;
background: var(--paper); border: 1px solid var(--ink); border-radius: 0;
padding: 2px 4px; }
padding: 3px 5px; min-height: 20px; box-shadow: inset -1px -1px 0 var(--shade); }
.pt-chip.empty {
border-style: dashed; color: var(--mute); background: var(--shade);
box-shadow: none;
}
.pt-chip.pending { background: var(--paper); }
.pt-chip.pending .pt-frame { color: var(--ink); opacity: 1; }
.pt-chip-name { font-size: 12px; color: var(--ink); white-space: nowrap;
overflow: hidden; text-overflow: ellipsis; flex: 1; }
.pt-frame { width: 56px; background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
@ -317,6 +333,22 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.ann-tags .tag { font-size: 9px; padding: 0 6px 0 12px; line-height: 1.6; border-radius: 2px 8px 8px 2px; }
.ann-tags .tag::before { width: 3px; height: 3px; left: 5px; }
/* the `in:` membership row — where this annotation is filed (:in edges) */
.ann-in { display: flex; flex-wrap: wrap; align-items: center; gap: 4px; margin-top: 5px; }
.ann-in-label { font-size: 9px; color: var(--muted, #888); text-transform: uppercase; letter-spacing: .04em; }
.in-chip { display: inline-flex; align-items: center; gap: 2px; font-size: 9px;
padding: 0 5px; line-height: 1.7; background: var(--shade); color: var(--ink);
border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; }
.in-chip:hover { background: var(--ink); color: var(--paper); }
.in-x, .in-plus { font-size: 9px; line-height: 1; padding: 0 1px; background: none;
border: none; color: inherit; cursor: pointer; opacity: .6; }
.in-x:hover, .in-plus:hover { opacity: 1; }
.in-plus { border: 1px dashed var(--ink); border-radius: 8px; padding: 0 5px; line-height: 1.6; opacity: .7; }
.in-add-pop { display: inline-flex; align-items: center; gap: 2px; }
.in-add-pop .ac { min-width: 140px; }
/* a card filed here whose footage doesn't land here — reference only, no bars */
.ann.reference { border-style: dashed; opacity: .78; }
/* reveal-children toggle at the card bottom + the nested child cards */
.show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px;
font-family: var(--chicago); font-size: 11px; text-align: left;
@ -349,6 +381,20 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.ac .pt-dropdown li { display: flex; align-items: center; justify-content: space-between; gap: 6px; }
.tag-eye { font-size: 12px; flex: none; }
.pt-x:hover { text-decoration: underline; }
.annotation-filter {
display: flex; align-items: center; gap: 6px; flex-wrap: wrap;
padding: 6px 8px; border-bottom: 1px solid var(--ink); background: var(--paper);
}
.annotation-search {
flex: 1 1 220px; min-width: 0; box-sizing: border-box;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
border-radius: 0; padding: 5px 7px; font-family: var(--geneva); font-size: 12px;
}
.annotation-filter .filter-btn { border-radius: 0; }
.filter-summary {
margin-left: auto; display: inline-flex; align-items: center; gap: 6px;
font-size: 11px; color: var(--mute);
}
.form-hint { font-size: 11px; color: var(--mute); }
.form-check { display: flex; align-items: center; gap: 6px; font-family: var(--chicago);
@ -658,6 +704,17 @@ html.dark .timeline-head {
.zoom-read { font-size: 11px; color: var(--ink); min-width: 42px; text-align: center; }
.script-empty { color: var(--mute); font-size: 12px; padding: 20px; }
.ann.selected { box-shadow: inset 3px 0 0 var(--ink); }
.script-return {
display: flex; align-items: center; gap: 8px; flex-wrap: wrap;
padding: 6px 10px; border-bottom: 2px solid var(--ink);
background: var(--desktop); background-size: 4px 4px;
font-family: var(--chicago); font-size: 11px;
}
.script-return .hl-cancel { border-radius: 0; padding: 2px 8px; }
.script-return-text {
display: inline-block; background: var(--paper); border: 1px solid var(--ink);
padding: 2px 6px; box-shadow: 1px 1px 0 var(--ink);
}
/* note rail (list of project script-notes) */
.note-rail { display: flex; align-items: center; gap: 8px; flex-wrap: wrap;
@ -695,21 +752,42 @@ html.dark .timeline-head {
font-size: 11px; border: 1px solid var(--mute); border-radius: 0; padding: 3px; background: var(--paper); color: var(--ink); }
/* binding notes to annotations/marks (annotation form + cards) */
.mark-block { margin-bottom: 4px; }
.mark-block {
margin-bottom: 6px; padding: 5px 6px;
border: 1px solid var(--ink); background: var(--paper);
box-shadow: 2px 2px 0 var(--ink);
cursor: pointer;
}
.mark-block:hover { background: var(--shade); }
.mark-block.pending { cursor: default; }
.mark-block.pending:hover { background: var(--paper); }
/* the currently-selected/last-touched mark while authoring — so you know which
one a drawing binds to, and which you're about to delete */
.mark-block.active-mark { box-shadow: inset 3px 0 0 var(--ink); background: var(--shade, rgba(128,128,128,.14));
border-radius: 2px; padding: 2px 0 2px 3px; margin-left: -3px; }
.note-drop { display: flex; align-items: center; flex-wrap: wrap; gap: 4px; min-height: 20px;
margin: 2px 0 2px 14px; padding: 2px 4px; border: 1px dashed var(--mute); border-radius: 0; }
.note-drop-label { font-size: 10px; color: var(--mute); }
.note-drop-hint { font-size: 10px; color: var(--mute); font-style: italic; }
.note-source { display: flex; flex-wrap: wrap; gap: 4px; margin: 4px 0; }
.note-src { display: inline-flex; align-items: center; gap: 4px; font-size: 11px; cursor: grab;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 1px 6px; }
.note-src:active { cursor: grabbing; }
.mark-block.active-mark {
background: var(--desktop); background-size: 4px 4px;
box-shadow: inset 4px 0 0 var(--ink), 2px 2px 0 var(--ink);
}
.mark-block.broken { opacity: 0.6; }
.mark-block.broken .pt-chip-name { text-decoration: line-through; }
.mark-note-list {
display: flex; flex-wrap: wrap; gap: 4px;
margin: 5px 0 0 24px;
}
.mark-script-wrap { position: relative; display: inline-flex; flex: none; }
.mark-script-pop {
position: absolute; right: 0; top: calc(100% + 4px); z-index: 21;
width: 210px; padding: 6px;
background: var(--paper); border: 1px solid var(--ink); box-shadow: 2px 2px 0 var(--ink);
}
.mark-script-pop .pt-input { display: block; max-width: none; }
.mark-script-pop .pt-dropdown { position: static; margin-top: 4px; box-shadow: none; }
.mark-script-new {
width: 100%; margin-top: 6px; padding: 5px 8px;
border-radius: 0; text-align: left; font-size: 11px;
}
.bound-note { display: inline-flex; align-items: center; gap: 3px; font-size: 11px;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 0 4px; }
background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 1px 4px;
cursor: pointer; }
.bound-note.live { background: var(--ink); color: var(--paper); }
.bound-note-name { max-width: 120px; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }
.note-live { font-weight: bold; }
@ -781,6 +859,7 @@ html.dark .timeline-head {
padding: 0 2px; font-size: 13px; line-height: 1; flex: none; align-self: center;
}
.mark-grip:active { cursor: grabbing; }
.mark-grip.disabled { cursor: default; opacity: .35; }
.mark-block.dragging { opacity: 0.4; }
.mark-block.drop-before { position: relative; }
.mark-block.drop-before::before {

View file

@ -9,6 +9,7 @@
[re-frame "1.4.7"]
[metosin/reitit "0.9.1"]
[day8.re-frame/http-fx "0.2.4"]
[day8.re-frame/test "0.1.5"]
[binaryage/devtools "1.0.7"]]
:dev-http
@ -19,7 +20,10 @@
{:test
{:target :node-test
:output-to "target/node-tests.js"
:ns-regexp "-test$"}
:ns-regexp "-test$"
;; minimal browser-global shim so tl.api / tl.routes load under node — lets the
;; integration tests (tl.flow-test) drive the real re-frame events. No DOM.
:prepend "globalThis.window=globalThis;var __loc={protocol:'http:',hostname:'localhost',host:'localhost',origin:'http://localhost',href:'http://localhost/',hash:'',pathname:'/',search:''};globalThis.location=__loc;globalThis.window.location=__loc;globalThis.document={createElement:function(){return {style:{}};},addEventListener:function(){},removeEventListener:function(){},querySelector:function(){return null;},body:{}};globalThis.navigator={standalone:false,userAgent:'node'};var __ls={};globalThis.localStorage={getItem:function(k){return k in __ls?__ls[k]:null;},setItem:function(k,v){__ls[k]=String(v);},removeItem:function(k){delete __ls[k];}};globalThis.window.matchMedia=function(){return {matches:false,addListener:function(){},removeListener:function(){}};};globalThis.window.addEventListener=function(){};globalThis.window.removeEventListener=function(){};globalThis.window.history={replaceState:function(){},pushState:function(){}};globalThis.XMLHttpRequest=function(){};globalThis.XMLHttpRequest.prototype={open:function(){},send:function(){},setRequestHeader:function(){},abort:function(){}};"}
:app
{:target :browser

View file

@ -75,7 +75,7 @@
(let [stack (vec (valid-stack scene stack))
ctx (peek stack)]
(cond-> (assoc view :stack stack)
playhead (assoc-in [:playheads ctx] playhead))))
playhead (assoc-in [:playheads ctx] (scene/assert-frame "route playhead" playhead)))))
(defn- route-state [db]
(let [ctx (peek (get-in db [:view :stack]))]
@ -332,12 +332,18 @@
(let [s (get-in db [:view :hidden-notes] #{})]
(assoc-in db [:view :hidden-notes] (if (contains? s gid) (disj s gid) (conj s gid))))))
;; per-tag annotation visibility (view-only, ephemeral): eye toggles in the tag
;; filter. A tag in :hidden-tags hides every annotation carrying it.
(rf/reg-event-db ::toggle-tag-filter
;; annotation-pane filters are inclusive: selected tags narrow the list to
;; matching annotations.
(rf/reg-event-db ::set-annotation-search
(fn [db [_ q]] (assoc-in db [:view :annotation-filter :query] q)))
(rf/reg-event-db ::toggle-annotation-tag-filter
(fn [db [_ tag]]
(let [s (get-in db [:view :hidden-tags] #{})]
(assoc-in db [:view :hidden-tags] (if (contains? s tag) (disj s tag) (conj s tag))))))
(let [s (get-in db [:view :annotation-filter :tags] #{})]
(assoc-in db [:view :annotation-filter :tags]
(if (contains? s tag) (disj s tag) (conj s tag))))))
(rf/reg-event-db ::clear-annotation-filter
(fn [db _] (assoc-in db [:view :annotation-filter]
{:query "" :tags #{}})))
;; click a highlight on the page → activate its note and focus that region's row
;; in the right pane
@ -378,6 +384,9 @@
(merge {:id rid :kind :text :content ""} region))]
(merge {:db db} (persist-note-fx db gid)))))
(defn- add-in [coll x] (vec (distinct (conj (vec coll) x))))
(defn- rm-in [coll x] (vec (remove #(= x %) coll)))
;; select-then-highlight with no active note: spin up a note (named after the
;; selected text) with the region already in it, and make it active.
(rf/reg-event-fx ::highlight-into-new-note
@ -390,9 +399,18 @@
:else t)
note {:type :script-note :name nm :color "#c2864e"
:regions [(merge {:id rid :kind :text :content ""} region)]}
target (get-in db [:view :note-target])
db (-> db (assoc-in [:scene :groups gid] note)
(assoc-in [:view :active-note] gid)
(assoc :save-error nil))]
(assoc :save-error nil))
;; created for a mark → bind it and hop back to the annotation
db (if target
(-> db (update-in [:scene :groups (:gid target) :marks]
(fn [ms] (mapv (fn [m] (if (= (:mark-id target) (:id m))
(update m :notes add-in gid) m)) ms)))
(assoc-in [:view :note-target] nil)
(assoc-in [:view :pane] :annotations))
db)]
(merge {:db db} (persist-note-fx db gid)))))
;; commentary edits update the note locally (on-change); persist on blur so we
@ -412,9 +430,6 @@
;; The pointer lives on the referrer (annotation or mark), so a shared note stays
;; pure and freely reusable. These mutate the draft in-place (db only) and ride
;; the annotation's Save, exactly like ::set-content and the marks editor.
(defn- add-in [coll x] (vec (distinct (conj (vec coll) x))))
(defn- rm-in [coll x] (vec (remove #(= x %) coll)))
(rf/reg-event-db ::bind-note-annotation
(fn [db [_ gid note-gid]]
(update-in db [:scene :groups gid :notes] #(add-in % note-gid))))
@ -433,6 +448,80 @@
(fn [db [_ gid mark-id note-gid]]
(update-mark db gid mark-id #(update % :notes rm-in note-gid))))
;; click a mark row to make it the active one (drawings/edits target it)
(defn- drawing-state-for [db ann mark-id]
(let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m)))
(get-in db [:scene :groups ann :marks])))]
{:ann ann :mark-id mark-id
:gid (or existing (keyword (str "draw-" (random-uuid))))
:new? (nil? existing)}))
(defn- start-drawing-db [db ann mark-id]
(-> db
(assoc-in [:view :active-mark] mark-id)
(assoc-in [:view :draw] (drawing-state-for db ann mark-id))))
(defn- draft-in-ctx [db ctx]
(some (fn [[gid g]]
(when (and (:draft g) (= ctx (scene/home (:scene db) gid))) [gid g]))
(get-in db [:scene :groups])))
(defn- draft-mark-at [db ctx lf]
(when-let [[gid g] (draft-in-ctx db ctx)]
(let [scene (:scene db)
segs (scene/content-segments scene ctx)]
(some (fn [m]
(when (some (fn [[lo hi]] (and (<= lo lf) (< lf hi)))
(scene/mark-bars scene gid (:id m) segs))
{:ann gid :mark-id (:id m)}))
(:marks g)))))
(defn- sync-draft-mark-for-playhead [db ctx lf]
(if-let [{:keys [ann mark-id]} (draft-mark-at db ctx lf)]
(if (= mark-id (get-in db [:view :active-mark]))
db
(start-drawing-db db ann mark-id))
(if (draft-in-ctx db ctx)
(-> db
(assoc-in [:view :active-mark] nil)
(assoc-in [:view :draw] nil))
db)))
(defn- mark-start-local [db ann mark-id]
(let [scene (:scene db)
ctx (scene/home scene ann)
segs (scene/content-segments scene ctx)]
(ffirst (scene/mark-bars scene ann mark-id segs))))
;; click/select a mark row: make it the drawing target and move the playhead to it.
(rf/reg-event-fx ::set-active-mark
(fn [{:keys [db]} [_ mark-id]]
(let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack])))
(some (fn [[gid g]] (when (:draft g) [gid g]))
(get-in db [:scene :groups])))
ctx (scene/home (:scene db) ann)
local (when ann (mark-start-local db ann mark-id))
db (cond-> db
ann (start-drawing-db ann mark-id)
(and ctx local) (assoc-in [:view :playheads ctx] local))
sf (when (and ctx local)
(scene/local->source
(scene/content-segments (:scene db) ctx) local))]
(cond-> (sync-route {:db db} db)
sf (assoc :player/seek (/ sf (:fps db)))))))
;; "add a new script note for this mark": remember the target mark + hop to the
;; Script pane. When a note is created there (highlight-into-new-note) it binds to
;; the target and returns to the annotation; ::cancel-note-target backs out.
(rf/reg-event-db ::new-note-for-mark
(fn [db [_ gid mark-id]]
(-> db (assoc-in [:view :note-target] {:gid gid :mark-id mark-id})
(assoc-in [:view :active-note] nil)
(assoc-in [:view :pane] :script))))
(rf/reg-event-db ::cancel-note-target
(fn [db _] (-> db (assoc-in [:view :note-target] nil)
(assoc-in [:view :pane] :annotations))))
;; --- drawings -------------------------------------------------------------
;; A drawing is a first-class entity (:type :drawing) — a bag of normalized
;; strokes + a seed for its wiggle boil — bound to a mark via mark :drawings
@ -444,14 +533,7 @@
;; gid. The entity isn't written until ::save-drawing, so cancel is a clean no-op.
(rf/reg-event-db ::start-drawing
(fn [db [_ ann mark-id]]
(let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m)))
(get-in db [:scene :groups ann :marks])))]
(-> db
(assoc-in [:view :active-mark] mark-id) ; drawing a mark makes it the active one
(assoc-in [:view :draw]
{:ann ann :mark-id mark-id
:gid (or existing (keyword (str "draw-" (random-uuid))))
:new? (nil? existing)})))))
(start-drawing-db db ann mark-id)))
;; leave draw mode. Strokes autocommit as you draw, so this is just "done" —
;; nothing to save or discard here (the form's Save/Cancel is the rollback net).
@ -519,7 +601,8 @@
;; moved the stack, so snap back to the editing context before seeking the frame.
(rf/reg-event-fx ::preview-frame
(fn [{:keys [db]} [_ local]]
(let [stack (get-in db [:view :linking :stack])
(let [local (scene/assert-frame "preview frame" local)
stack (get-in db [:view :linking :stack])
ctx (peek stack)
db (-> db (assoc-in [:view :stack] stack)
(assoc-in [:view :playheads ctx] local))
@ -529,7 +612,10 @@
(rf/reg-event-fx ::set-playhead
(fn [{:keys [db]} [_ ctx lf]]
(let [next-db (assoc-in db [:view :playheads ctx] lf)]
(let [lf (scene/assert-frame "playhead" lf)
next-db (-> db
(assoc-in [:view :playheads ctx] lf)
(sync-draft-mark-for-playhead ctx lf))]
(sync-route {:db next-db} next-db))))
(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p)))
;; reveal an annotation's immediate children into the current timeline lane
@ -571,9 +657,10 @@
;; uuid, not gensym: gensym's counter resets each page load, so a
;; fresh annotation would reuse a prior gid and clobber it on merge.
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
{:type :annotation :parent (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
:draft :new :name "" :color "#4e8fc2" :marks []
:v scene/schema-version})
:v scene/schema-version}))
(assoc-in [:view :pt] :new)
(assoc-in [:view :active-mark] nil)
(assoc-in [:view :draft-stage] :choosing))))
@ -587,12 +674,29 @@
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new))))
;; Edit an annotation from a card. If its primary home isn't the context being
;; viewed, enter that home first so mark rows/handles edit in their authored
;; coordinate system. finish-edit pops this temporary context.
(rf/reg-event-fx
::edit-annotation
(fn [{:keys [db]} [_ gid]]
(let [home (scene/home (:scene db) gid)
ctx (peek (get-in db [:view :stack]))
push-home? (and home (not= home ctx))
fx (if push-home? (enter-ctx db #(conj % home)) {:db db})]
(update fx :db #(cond-> (-> %
(assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
(assoc-in [:view :edit-pop-parent] nil))
push-home? (assoc-in [:view :edit-pop-parent] home))))))
;; 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
;; parent (and no marks) — edit it in place.
(rf/reg-event-fx ::edit-here
(fn [{:keys [db]} [_ gid]]
(let [root? (nil? (get-in db [:scene :groups gid :parent]))
(let [root? (= :timeline (get-in db [:scene :groups gid :type]))
fx (if root? {:db db} (enter-ctx db pop))]
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
@ -601,13 +705,18 @@
(fn [{:keys [db]} _]
;; leaving the form (save OR cancel): tear down all authoring
;; transients so draw mode / pending points don't linger.
(let [db (-> db (assoc-in [:view :draw] nil)
(let [return-g (get-in db [:view :edit-return])
pop? (some? (get-in db [:view :edit-pop-parent]))
db (-> db (assoc-in [:view :draw] nil)
(assoc-in [:view :active-mark] nil)
(assoc-in [:view :pt] nil)
(assoc-in [:view :draft-stage] nil))]
(if-let [g (get-in db [:view :edit-return])]
(enter-ctx (assoc-in db [:view :edit-return] nil) #(conj % g))
{:db db}))))
(assoc-in [:view :draft-stage] nil)
(assoc-in [:view :edit-return] nil)
(assoc-in [:view :edit-pop-parent] nil))]
(cond
return-g (enter-ctx db #(conj % return-g))
pop? (enter-ctx db #(if (> (count %) 1) (pop %) %))
:else {:db db}))))
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
;; cancelling a draft is local only; saving a real annotation / deleting one
;; pushes a delta to the backend (which merges + attributes it).
@ -622,7 +731,7 @@
(let [g (cond-> (editable-group g)
(= :annotation (:type g)) (assoc :v scene/schema-version))
patch (group-patch orig g)
root? (nil? (:parent 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)
;; proxies this annotation references are synthetic clips in the pool —
;; persist them alongside it or the {:ref proxy} marks dangle on reload.
@ -644,40 +753,95 @@
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))
;; --- move an annotation into another context (drag-drop reparent) ---------
;; Changing :parent re-homes an annotation under a new context. Marks that no
;; longer resolve there just skip (scene/resolve drops them) and reappear if the
;; annotation is moved back — no data loss. Guard against cycles: never drop a
;; group into itself or one of its own descendants (that would make the :parent
;; chain loop forever, hanging path-to / resolve).
(defn- descendant?
"Is `gid` equal to `anc` or somewhere below it in the :parent tree?"
[scene anc gid]
(loop [g gid]
(cond (nil? g) false
(= g anc) true
:else (recur (get-in scene [:groups g :parent])))))
;; --- membership edges (:in): file an annotation under mark-groups ----------
;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups
;; the annotation is filed under; the FIRST is the primary home (scene/home) — where
;; it's edited and its links resolve. Marks never move or re-cut — they resolve to
;; raw clips globally, and that only decides whether BARS draw in a context. Three
;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag /
;; file-into picker), remove (× on a chip).
(rf/reg-event-db ::ann-drag-start (fn [db [_ gid]] (assoc-in db [:view :dragging-ann] gid)))
(rf/reg-event-db ::ann-drag-end (fn [db _] (assoc-in db [:view :dragging-ann] nil)))
(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
::ann-drag-start
(fn [db [_ gid source-parent]]
(-> db
(assoc-in [:view :dragging-ann] gid)
(assoc-in [:view :dragging-ann-source] source-parent))))
(rf/reg-event-db
::ann-drag-end
(fn [db _]
(-> db
(assoc-in [:view :dragging-ann] nil)
(assoc-in [:view :dragging-ann-source] nil))))
(defn- persist-group
"fx map that stores annotation `gid` = `g*` locally and (if online) pushes just
the changed fields to the backend."
[db gid orig g*]
(let [id (get-in db [:project :id])
patch (group-patch orig g*)]
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) (assoc :save-error nil))}
(and id (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed {gid patch}}
{:on-success [::scene-saved]
:on-failure [::save-error]})))))
;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps
;; existing edges (link); otherwise the edge you grabbed is moved off its source.
;; Marks are untouched either way.
(defn- file-edge [db gid new-parent add? source]
(let [scene (:scene db)
g (get-in scene [:groups gid])
in (vec (:in g))
clear #(-> % (assoc-in [:view :dragging-ann] nil)
(assoc-in [:view :dragging-ann-source] nil))]
(if (or (not= :annotation (:type g)) ; only annotations file
(:draft g) ; not mid-draft
(= gid new-parent) ; not under itself
(contains? (set in) new-parent) ; already filed there
(files-under? scene new-parent gid #{})) ; would make a cycle
{:db (clear db)}
(let [in' (if add?
(conj in new-parent) ; link: append, primary unchanged
(let [rest* (vec (remove #{source} in))]
(if (= source (first in))
(into [new-parent] rest*) ; moved the primary → new home
(conj rest* new-parent))))
g* (assoc g :in in')]
(update (persist-group db gid g g*) :db clear)))))
(rf/reg-event-fx
::reparent
(fn [{:keys [db]} [_ gid new-parent]]
(let [scene (:scene db)
g (get-in scene [:groups gid])]
(if (or (not= :annotation (:type g)) ; only annotations move
(:draft g) ; not while being drafted/edited
(= (:parent g) new-parent) ; no-op: already there
(descendant? scene gid new-parent)) ; target inside gid → cycle
{:db (assoc-in db [:view :dragging-ann] nil)}
(let [id (get-in db [:project :id])]
(cond-> {:db (-> db (assoc-in [:scene :groups gid :parent] new-parent)
(assoc-in [:view :dragging-ann] nil)
(assoc :save-error nil))}
id (assoc :http-xhrio (api/put-scene id {:changed {gid {:parent new-parent}}}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))))
(fn [{:keys [db]} [_ gid new-parent add?]]
(let [source (or (get-in db [:view :dragging-ann-source]) (peek (get-in db [:view :stack])))]
(file-edge db gid new-parent add? source))))
;; file into a group chosen from the picker — always additive (source nil).
(rf/reg-event-fx ::file-into
(fn [{:keys [db]} [_ gid target]]
(file-edge db gid target true nil)))
;; remove one membership edge (× on a chip). Never the primary home, never the last.
(rf/reg-event-fx
::unfile
(fn [{:keys [db]} [_ gid target]]
(let [g (get-in db [:scene :groups gid])
in (vec (:in g))]
(if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1))
{:db db}
(persist-group db gid g (assoc g :in (vec (remove #{target} in))))))))
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
(rf/reg-event-db ::save-error
@ -704,19 +868,31 @@
(into (subvec marks 0 i) (subvec marks (inc i))))
(assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i i})))))
;; clear ONE endpoint of a proxy mark to re-pick it: remember the OPPOSITE
;; endpoint's ctx-local position (kept fixed) so the next clip-click only rerolls
;; the cleared side — the kept end never turns into the start (the old swap bug).
(rf/reg-event-db
::unset-proxy-endpoint
(fn [db [_ gid mark-id pid which]]
(let [scene (:scene db)
ctx (scene/home scene gid)
segs (scene/content-segments scene ctx)
[lo hi] (scene/mark-extent scene gid mark-id segs)]
(assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)}))))
;; complete a selection on the active draft: wrap the run [lo hi) in a proxy (a
;; synthetic clip), give the annotation one mark referencing it, make it active,
;; seek to its start, and drop into drawing mode ("select a range → you're drawing").
(defn- select-range-fx [db gid g lo hi]
(let [scene (:scene db)
p (scene/make-proxy scene (:parent g) lo hi)
p (scene/make-proxy scene (scene/home scene gid) lo hi)
pgid (keyword (str "prox-" (random-uuid)))
mid (str (random-uuid))
sf (scene/local->source (scene/content-segments scene (:parent g)) lo)]
sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)]
{:db (-> db (assoc-in [:scene :groups pgid] p)
(update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid))
(assoc-in [:view :active-mark] mid)
(assoc-in [:view :playheads (:parent g)] lo)
(assoc-in [:view :playheads (scene/home scene gid)] lo)
(assoc-in [:view :pt] :new))
:player/seek (when sf (/ sf (:fps db)))
:fx [[:dispatch [::start-drawing gid mid]]]}))
@ -735,9 +911,23 @@
(fn [{:keys [db]} [_ seg-id frame]]
(let [scene (:scene db)
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
segs (scene/content-segments scene (:parent g))
segs (scene/content-segments scene (scene/home scene gid))
pt (get-in db [:view :pt])]
(if (map? pt)
(cond
;; re-picking one endpoint of a proxy: roll only that side, keep the other
(:proxy pt)
(let [proxy (get-in scene [:groups (:proxy pt)])
new-local (if (= (:which pt) :start)
(scene/seg-local segs seg-id (or frame 0))
(scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))))
keep (:keep pt)
lo (scene/assert-frame "proxy range start" (min new-local keep))
hi (scene/assert-frame "proxy range end" (max new-local keep))]
{:db (-> db (assoc-in [:scene :groups (:proxy pt)]
(scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi)))
(assoc-in [:view :pt] :new))})
(map? pt)
(let [a (scene/seg-local segs (:seg pt) (:f pt))
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))
lo (min a b) hi (max a b)
@ -746,7 +936,7 @@
;; 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 (:parent g) [old] lo hi)
(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))
@ -758,6 +948,8 @@
(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)})}))))
;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned
@ -785,14 +977,31 @@
pid (->> (get-in scene [:groups ann :marks])
(some #(when (= mark-id (:id %)) (get-in % [:start :ref]))))
proxy (get-in scene [:groups pid])
ctx (:parent (get-in scene [:groups ann]))
;; 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
;; :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
@ -802,6 +1011,9 @@
(fn [{:keys [db]} [_ draft-gid target-gid]]
(let [marks (get-in db [:scene :groups draft-gid :marks])
orig-t (get-in db [:scene :groups target-gid])
;; adding marks does NOT change placement — membership is asserted, never
;; derived from where marks were authored. To also list C in this context,
;; file it in explicitly (the + picker / drag).
target (update orig-t :marks (fnil into []) marks)
patch (group-patch orig-t target) ; just the :marks change
proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref])

52
tl/src/tl/filter.cljs Normal file
View file

@ -0,0 +1,52 @@
(ns tl.filter
(:require [clojure.string :as str]))
(def ^:private prefix-aliases
{"timeline" :timeline
"annotation" :timeline
"title" :timeline
"script" :script
"note" :script
"notes" :script
"clip" :clip
"clips" :clip
"tag" :tag
"tags" :tag})
(defn parse-query [q]
(let [s (str/trim (or q ""))]
(if-let [[_ prefix body] (re-matches #"(?i)^([a-z]+)\s*:\s*(.*)$" s)]
(if-let [scope (prefix-aliases (str/lower-case prefix))]
{:scope scope :term (str/lower-case (str/trim body))}
{:scope :all :term (str/lower-case s)})
{:scope :all :term (str/lower-case s)})))
(defn- includes-term? [xs term]
(or (str/blank? term)
(some #(str/includes? (str/lower-case (str %)) term) xs)))
(defn- tag-match? [selected tags]
(or (empty? selected)
(let [tags (set tags)]
(or (some tags selected)
(and (contains? selected :untagged) (empty? tags))))))
(defn annotation-matches?
[{:keys [query tags]} ann]
(let [{:keys [scope term]} (parse-query query)
selected-tags (set tags)
fields {:timeline [(:name ann) (:content ann)]
:script (:script ann)
:clip (:clips ann)
:tag (:tags ann)}
haystack (case scope
:timeline (:timeline fields)
:script (:script fields)
:clip (:clip fields)
:tag (:tag fields)
(mapcat fields [:timeline :script :clip :tag]))]
(and (tag-match? selected-tags (:tags ann))
(includes-term? haystack term))))
(defn filter-annotations [anns filters]
(filterv #(annotation-matches? filters %) anns))

View file

@ -18,20 +18,22 @@
;; Two link kinds share the [label](scheme…) form:
;; frame [label](mark:ref@at) jump the playhead to a spot
;; timeline [label](timeline:gid) push that timeline onto the stack
;; note [label](note:gid) jump to a script note
(def ^:private link-re
"\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+))\\)")
"\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+)|note:([^)]+))\\)")
(defn link-token
"The token for a link map: {:kind :frame :label :ref :at} (the default) or
{:kind :timeline :label :ref}."
{:kind :timeline :label :ref} or {:kind :script-note :label :ref}."
[{:keys [kind label ref at]}]
(if (= kind :timeline)
(str "[" label "](timeline:" (name ref) ")")
(case kind
:timeline (str "[" label "](timeline:" (name ref) ")")
:script-note (str "[" label "](note:" (name ref) ")")
(str "[" label "](mark:" (name ref) "@" at ")")))
(defn parse-content
"Split content `s` into [:text str] / [:link {…}] segments. Each link carries
:kind — :frame (with :ref/:at) or :timeline (with :ref)."
:kind — :frame (with :ref/:at), :timeline (with :ref), or :script-note."
[s]
(if (empty? s)
[]
@ -39,9 +41,10 @@
(loop [out [] last 0]
(if-let [m (.exec re s)]
(let [idx (.-index m) pre (subs s last idx)
link (if (aget m 4)
{:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))}
{:kind :frame :label (aget m 1) :ref (keyword (aget m 2))
link (cond
(aget m 4) {:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))}
(aget m 5) {:kind :script-note :label (aget m 1) :ref (keyword (aget m 5))}
:else {:kind :frame :label (aget m 1) :ref (keyword (aget m 2))
:at (js/parseInt (aget m 3) 10)})]
(recur (cond-> out
(seq pre) (conj [:text pre])
@ -57,8 +60,9 @@
(= 3 (.-nodeType n)) (.-textContent n)
(= "BR" (.-tagName n)) "\n"
(and (.-classList n) (.contains (.-classList n) "link-chip"))
(link-token (if (= "timeline" (.. n -dataset -kind))
{:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
(link-token (case (.. n -dataset -kind)
"timeline" {:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
"script-note" {:kind :script-note :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
{:kind :frame :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))
:at (js/parseInt (.. n -dataset -at) 10)}))
;; A wrapper element (e.g. the <div> a browser inserts on Enter): recurse so

View file

@ -13,8 +13,20 @@
(defn- clip? [item]
(str/starts-with? (:OTIO_SCHEMA item "") "Clip"))
(defn- frames [rational-time]
(:value rational-time))
(defn- timeline-frames
"Frame count/position for timeline math. These must already be integer frames."
[rational-time]
(let [v (:value rational-time)]
(when-not (integer? v)
(throw (js/Error. (str "OTIO RationalTime value must be an integer frame, got " v))))
v))
(defn- media-frame
"Source media position as an integer frame index. Some OTIO exports carry
rate-conformed source starts as sub-frame RationalTime values; the app model is
frame-index based, so source starts are normalized once at this import boundary."
[rational-time]
(int (:value rational-time)))
(defn- clip-starts
"Source start_time (frames) of every clip across all tracks."
@ -22,15 +34,15 @@
(for [t tracks
c (:children t)
:when (clip? c)]
(frames (get-in c [:source_range :start_time]))))
(media-frame (get-in c [:source_range :start_time]))))
(defn- parse-track [media-offset idx track]
(loop [pos 0.0
(loop [pos 0
items (:children track)
ci 0
clips (transient [])]
(if-let [item (first items)]
(let [dur (frames (get-in item [:source_range :duration]))
(let [dur (timeline-frames (get-in item [:source_range :duration]))
is-clip (clip? item)]
(recur (+ pos dur)
(rest items)
@ -40,7 +52,7 @@
:name (:name item)
:start pos ; timeline frame, 0-based
:duration dur
:media-in (- (frames (get-in item [:source_range :start_time]))
:media-in (- (media-frame (get-in item [:source_range :start_time]))
media-offset)}) ; frame into local .mov
clips)))
{:id idx
@ -56,11 +68,11 @@
(let [tracks (get-in otio [:tracks :children])
fps (get-in otio [:global_start_time :rate] 24)
starts (clip-starts tracks)
media-offset (if (seq starts) (apply min starts) 0.0)
media-offset (if (seq starts) (apply min starts) 0)
parsed (vec (map-indexed (partial parse-track media-offset) tracks))]
{:fps fps
:media-offset media-offset
:duration (reduce max 0.0 (for [t parsed
:duration (reduce max 0 (for [t parsed
c (:clips t)]
(+ (:media-in c) (:duration c))))
:tracks parsed}))

View file

@ -2,7 +2,8 @@
(:require
[clojure.string :as str]
[reitit.frontend :as reitit]
[reitit.frontend.easy :as rfe]))
[reitit.frontend.easy :as rfe]
[tl.scene :as scene]))
(def routes
[["/" {:name :projects}]
@ -54,15 +55,18 @@
(into {} (map (fn [[k v]] [(keyword k) v])
(:query-params match))))
stack (some-> (:stack qp) (str/split #","))
f (some-> (:f qp) js/parseFloat)]
fstr (some-> (:f qp) str)
f (when (and fstr (re-matches #"\d+" fstr))
(scene/assert-frame "route playhead" (js/parseInt fstr 10)))]
(cond-> {}
(seq stack) (assoc :stack (mapv keyword stack))
(and f (not (js/isNaN f))) (assoc :playhead f))))
f (assoc :playhead f))))
(defn project-url [id stack playhead]
(let [stack-param (->> (rest stack) (map name) (str/join ","))
query (query-string {:stack stack-param
:f (some-> playhead js/Math.round)})]
:f (when (some? playhead)
(scene/assert-frame "route playhead" playhead))})]
(str (href :project/show {:id id}) query)))
(defonce ^:private last-replaced (atom nil))

View file

@ -16,6 +16,28 @@
(defn- grp [scene gid] (get-in scene [:groups gid]))
(defn frame?
"True when `n` is a concrete integer frame coordinate."
[n]
(and (number? n) (integer? n) (not (js/isNaN n))))
(defn assert-frame
"Return `n` after asserting it is an integer frame. This is intentionally a
runtime check, not cljs.core/assert, so production builds keep the invariant."
[label n]
(when-not (frame? n)
(throw (js/Error. (str label " must be an integer frame, got " (pr-str n)))))
n)
(defn assert-range
"Return `[lo hi]` after asserting a valid integer half-open frame range."
[label [lo hi]]
(assert-frame (str label " start") lo)
(assert-frame (str label " end") hi)
(when (> lo hi)
(throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi])))))
[lo hi])
(defn- find-mark
"[owning-gid mark] for a mark id anywhere in the scene, or nil."
[scene mid]
@ -31,7 +53,10 @@
(defn local->source
"The source frame shown at local frame `lf` (clamped to the end)."
[segs lf]
(assert-frame "local frame" lf)
(or (some (fn [{:keys [src local]}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[c d] local [a _] src]
(when (and (<= c lf) (< lf d)) (+ a (- lf c)))))
segs)
@ -40,7 +65,10 @@
(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))
@ -48,21 +76,24 @@
(defn pieces
"Where source range [sa sb) lands in local coords: a list of [lo hi)."
[segs sa sb]
(assert-range "source range" [sa sb])
(vec (keep (fn [{:keys [src local]}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[a b] src [c _] local
lo (max sa a) hi (min sb b)]
(when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))])))
segs)))
(defn merge-bars
"Coalesce [lo hi) ranges that meet at a frame boundary into single bars, so a
continuous selection spanning several clips reads as one piece. Endpoints snap
to whole frames first, which absorbs the sub-frame gaps OTIO's fractional
media offsets leave between adjacent clips; only a real (≥1 frame) gap splits."
"Coalesce [lo hi) ranges that meet at a boundary into single bars, so a
continuous run spanning several clips reads as one piece. Ranges are half-open,
so adjacent clips share a boundary (A.hi == B.lo) and merge exactly — no gap to
fudge. Called per-mark, so it never fuses two distinct marks."
[bars]
(reduce (fn [acc [lo hi]]
(let [lo (js/Math.floor lo) hi (js/Math.ceil hi)
[plo phi] (peek acc)]
(assert-range "bar" [lo hi])
(let [[plo phi] (peek acc)]
(if (and plo (<= lo phi))
(conj (pop acc) [plo (max phi hi)])
(conj acc [lo hi]))))
@ -72,8 +103,11 @@
(defn slice
"Sub-segments of `segs` covering local range [la lb), src + local re-cut."
[segs la lb]
(assert-range "slice" [la lb])
(vec
(keep (fn [{:keys [src local] :as seg}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[a _] src [c d] local
lo (max la c) hi (min lb d)]
(when (< lo hi)
@ -86,23 +120,7 @@
;; --- resolution ----------------------------------------------------------
(declare resolve resolve-mark)
(defn- target-range
"Source [xs xe) + :track of a referenceable id (a clip/timeline group, or a
single-clip mark). Single-segment by the ref invariant; nil if unknown."
[scene id]
(let [segs (cond
(grp scene id) (resolve scene id)
(find-mark scene id) (let [[gid m] (find-mark scene id)]
(resolve-mark scene gid m))
:else nil)]
(when (seq segs)
{:xs (-> segs first :src first)
:xe (-> segs last :src second)
:track (-> segs first :track)
:thumb (-> segs first :thumb)
:thumb-start (-> segs first :thumb-start)})))
(declare resolve resolve-mark home child-of?)
(defn- target-segs
"Resolved segments (local 0-based) of a referenceable id: a group (clip,
@ -115,33 +133,68 @@
(resolve-mark scene gid m))
:else nil))
;; --- ref :at <-> source : the ONE interpretation of a ref's :at -----------
;; {:ref id :at n}'s :at is a LOCAL frame of id's OWN resolved timeline (n<0 from
;; the end, -1 = the exclusive end). Every :at<->frame conversion goes through
;; id's FULL resolution (target-segs) + the flat helpers, so it is correct whether
;; id is one clip or a scattered multi-clip proxy. Do NOT summarise a target to a
;; single [xs xe] span — that only holds for a single contiguous segment.
(defn- ref-len [scene ref] (length (target-segs scene ref)))
(defn- at->local
"Normalise a ref's :at (n<0 from the end) to a non-negative local frame."
[scene ref at]
(if (neg? at) (+ (ref-len scene ref) at 1) at))
(defn- at->src
"Source frame at ref point {:ref :at} — id's own local frame → source — or nil
if the ref dangles or the frame falls outside id."
[scene ref at]
(when-let [segs (seq (target-segs scene ref))]
(let [l (at->local scene ref at)]
(when (<= 0 l (length segs))
(local->source segs l)))))
(defn- src->at
"Target-local :at for source frame `src` within `ref` — source → id's own
local frame — or nil if outside id."
[scene ref src]
(some-> (seq (target-segs scene ref)) (source->local src)))
(defn- point-frame
"Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref
dangles."
[scene gid point]
(cond
(number? point)
(let [parent (:parent (grp scene gid))]
(let [parent (home scene gid)]
{:frame (if parent (local->source (resolve scene parent) point) point)
:track nil})
(map? point)
(when-let [{:keys [xs xe track thumb thumb-start]} (target-range scene (:ref point))]
(let [n (:at point)
f (if (neg? n) (+ xe n 1) (+ xs n))]
(when (<= xs f xe)
(cond-> {:frame f :track track}
thumb (assoc :thumb thumb :thumb-at (+ (or thumb-start 0) (- f xs))))))))) ; nil if trimmed out of range
(when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range
{:frame f})))
(defn- rebase
"Shift `sub`'s :local to start at 0 and stamp :mark = `id` (the mark now owns
these segments regardless of which target they were sliced from)."
[id sub]
(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 :mark id :local [(- c base) (- d base)])))
(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."
@ -166,7 +219,7 @@
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 (:parent (grp scene gid))]
(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)]
@ -208,17 +261,56 @@
[scene gid]
(when-let [mid (first (broken-marks scene gid))]
(let [ref (->> (:marks (grp scene gid)) (some #(when (= mid (:id %)) %)) :start :ref)]
(if (target-range scene ref) "reference trimmed away" "referenced clip deleted"))))
(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
"The clip-segments that make up context `ctx` — what you draw and select
against. An annotation's marks reference clips, so that's just `resolve`. The
root timeline doesn't enumerate its clips (they're a parentless pool), so
there it's the pool laid 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)."
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]
(if (= :timeline (:type (grp scene ctx)))
(->> (:groups scene)
@ -230,7 +322,7 @@
(assoc seg :mark gid :local [st (+ st (- sb sa))])))))
(sort-by (comp first :local))
vec)
(resolve scene ctx)))
(content-resolve scene ctx)))
(defn- src-intersect
"Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))."
@ -240,46 +332,20 @@
:when (< lo hi)]
[lo hi])))
(defn nested-src
"Source ranges of annotation `gid` clipped to every ancestor annotation between
it and `ctx` — what's still visible once the reveal chain trims it, i.e. the
same content you'd see if you expanded into its parent. A direct child of `ctx`
is just its own resolved source (the timeline itself does the clipping later).
Empty ⇒ the annotation is out of range in this reveal chain."
[scene ctx gid]
(loop [p (:parent (grp scene gid)), rs (mapv :src (resolve scene gid))]
(if (or (nil? p) (= p ctx))
rs
(recur (:parent (grp scene p))
(src-intersect rs (mapv :src (resolve scene p)))))))
(defn- clip-segs
"Clip resolved segments `ss` (each {:mark :src …}) to coverage `cover` ([c d)s),
keeping each seg's :mark (the mark-aware sibling of src-intersect)."
[ss cover]
(vec (for [{[a b] :src :as s} ss [c d] cover
:let [lo (max a c) hi (min b d)]
:when (< lo hi)]
(assoc s :src [lo hi]))))
(defn nested-src-marks
"Like nested-src but preserves :mark on each surviving segment, so lane bars can
be grouped per mark (see lane-bars). Ordered as resolve lays the marks."
[scene ctx gid]
(loop [p (:parent (grp scene gid)), ss (resolve scene gid)]
(if (or (nil? p) (= p ctx))
ss
(recur (:parent (grp scene p)) (clip-segs ss (mapv :src (resolve scene p)))))))
(defn lane-bars
"Context-local display bars for annotation `gid`, grouped PER MARK: contiguous
pieces coalesce WITHIN a mark but never across marks, so two abutting-but-
distinct marks stay separate bars — the lane bar matches each mark's highlight
1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id
lets the lane hit-test / highlight / edit one mark; consumers that only want
the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments."
[scene ctx gid ctx-segs]
(->> (nested-src-marks scene ctx gid)
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
is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ …
⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs`
is all the clipping needed (no ancestor re-walk — that was redundant)."
[scene gid ctx-segs]
(->> (resolve scene gid)
(partition-by :mark)
(mapcat (fn [ss]
(let [mid (:mark (first ss))]
@ -287,12 +353,52 @@
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss))))))
vec))
(defn clip-loss?
"True when annotation `gid` loses any content once clipped to its immediate
parent annotation — it references frames outside the parent timeline, so it's
(partly) out of range there. Timeline/root parents contain everything."
(defn mark-extent
"EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true
min piece-start / max piece-end, without merge-bars. Endpoint editing must use
this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` =
content-segments of ctx."
[scene gid mark-id ctx-segs]
(let [pcs (->> (resolve scene gid)
(filter #(= mark-id (:mark %)))
(mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))]
(when (seq pcs)
[(reduce min (map first pcs)) (reduce max (map second pcs))])))
;; --- placement: :in membership edges --------------------------------------
;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered
;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under
;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in
;; it. The FIRST element is the primary home (where its :content links resolve and
;; where it's edited); the whole vector as a set is its membership. Marks are never
;; moved or re-cut — they resolve to raw clips globally, and that only decides
;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it
;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary.
(defn home
"The primary home of `gid`: the first `:in` edge for an annotation (where its
description links resolve and where it's edited); the structural `:parent` for
anything else (nil for the flat clip/proxy pool and the root timeline)."
[scene gid]
(let [p (:parent (grp scene gid))]
(let [g (grp scene gid)]
(if (= :annotation (:type g)) (first (:in g)) (:parent g))))
(defn membership
"The set of mark-groups annotation `gid` is filed under (its `:in` edges)."
[scene gid]
(set (:in (grp scene gid))))
(defn child-of?
"Is annotation `gid` filed under `ctx`?"
[scene ctx gid]
(contains? (membership scene gid) ctx))
(defn clip-loss?
"True when annotation `gid` loses content once clipped to its primary home — it
references frames outside that parent annotation, so it's (partly) out of range
there. Timeline/root homes contain everything, so they never warn."
[scene gid]
(let [p (home scene gid)]
(when (and p (= :annotation (:type (grp scene p))))
(let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs)))
own (mapv :src (resolve scene gid))]
@ -303,14 +409,19 @@
(defn selection->marks
"Split local range [la lb) of context `ctx` into a run of single-clip ref
marks, one per content segment it crosses (the 'no cross-clip marks' rule).
Each references the segment's source id with the right offsets."
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]}]
(let [{:keys [xs]} (target-range scene mark)
[a b] 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 (- a xs)}
:end {:ref mark :at (- b xs)}}))
: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
@ -372,12 +483,6 @@
[segs mid f]
(some (fn [{m :mark [c _] :local}] (when (= m mid) (+ c (or f 0)))) segs))
(defn- at->frame
"Normalise a ref's :at to a non-negative mark-time frame (resolves :at -1 etc.)."
[scene ref at]
(if (neg? at)
(let [{:keys [xs xe]} (target-range scene ref)] (+ (- xe xs) at 1))
at))
(defn- restore-mark [m]
;; keep :id keyworded in lockstep with the refs that target it: a nested
@ -432,18 +537,30 @@
: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 % [])))
(update :notes #(when % (mapv keyword %))) ; annotation-level bindings
(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
"A ref-point {:ref :at} as a display cell {:seg :f}: the target id plus its OWN
local frame (context-local, whole-frame; not translated to the raw clip). The
shared basis for both the annotation editor rows and the jump popover, so they
can never disagree on how a point reads."
[scene {:keys [ref at]}]
{:seg ref :f (assert-frame "display point" (at->local scene ref at))})
(defn- clip-row
"Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time.
Frames are rounded for display — OTIO's fractional media offsets can leave a
ref's :at sub-frame, and the editor/labels want whole frames."
"Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time."
[scene {:keys [start end]}]
{:s {:seg (:ref start) :f (js/Math.round (at->frame scene (:ref start) (:at start)))}
:e {:seg (:ref end) :f (js/Math.round (at->frame scene (:ref end) (:at end)))}})
{:s (display-point scene start) :e (display-point scene end)})
(defn mark-row
"One editor row for a mark. A plain clip/subclip ref collapses to {:s :e}
@ -476,28 +593,51 @@
clip mark-group per clip (source range + track), and the root timeline. The
otio is only a seed — nothing here reads it again.
Frames are SNAPPED to whole integers here, at the one boundary where OTIO's
fractional RationalTime enters: a frame-based tool has no meaning below a whole
frame, so we round once, at the source, and everything downstream (source
ranges, mark :at offsets, seeks, labels) stays frame-accurate by construction."
Clip ranges are integer frame ranges. Fractional OTIO input is rejected before
this point; from here on, frame math asserts instead of snapping."
[{:keys [duration tracks]}]
(let [r (fn [x] (js/Math.round x))
vtracks (filter #(= :video (:kind %)) 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 (r (:start c)) ; timeline position (frames)
:start start ; timeline position (frames)
:marks [{:id (keyword (str (:id c) "-m"))
:start (r (:media-in c))
:end (r (+ (:media-in c) (:duration c)))
:track (keyword (str "t" (:index t)))}]}]))]
: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 (r duration)}]})}))
:marks [{:id :root-m :start 0 :end duration}]})}))
(defn clip-name [scene gid] (:name (grp scene gid)))
;; --- context-independent labelling (for transcluded mark rows) ------------
;; A mark collected into an annotation from another timeline (transclusion) has a
;; ref whose clip isn't in the CURRENT context's content-segments, so the context
;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip
;; instead — the mark's own timeline — so the row reads correctly from anywhere.
(defn ref-length
"Own resolved length (frames) of ref target `ref`, context-independent."
[scene ref]
(length (target-segs scene ref)))
(defn ref-track-name
"Name of the TRACK that ref target `ref` resolves onto (its first piece),
context-independent — the useful label for a transcluded mark whose clip isn't
in the current view. The clip's own :name is the shared source file (e.g.
\"Challengers.mov\") — identical for every clip of single-source footage — so
the track (A-roll / B-roll …) is what actually distinguishes them. nil if the
ref dangles."
[scene ref]
(when-let [t (:track (first (target-segs scene ref)))]
(get-in scene [:tracks t :name] (name t))))
;; --- links ----------------------------------------------------------------
;; A link is a ref-point {:ref id :at n} — the same shape as a mark endpoint, so
;; it resolves through the usual machinery — named inside an annotation's markdown
@ -519,7 +659,7 @@
"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 (+ (- (first src) (:xs (target-range scene mark))) (or f 0))})
{: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}
@ -544,15 +684,22 @@
[] pts)))
(defn jump-targets
"One target per discontinuity for an annotation's jump popover — labelled from
the owning mark's clip ref + frame, the SAME basis the annotation editor uses
(clip-label of :ref), so the jump label can never disagree with the mark row.
Each: {:local <ctx frame to seek> :seg <clip ref> :f <mark-time frame>}."
"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]
(mapv (fn [{:keys [id lo]}]
(let [st (:start (some #(when (= id (:id %)) %) (:marks (grp scene gid))))]
{:local lo :seg (:ref st) :f (js/Math.round (at->frame scene (:ref st) (:at st)))}))
(runs 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
@ -572,7 +719,7 @@
(sort-by (comp first :local) segs))}))))
anns (->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (= ctx (:parent 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]}]
@ -582,14 +729,14 @@
(vec (concat (sort-by :name tracks) (sort-by :name anns)))))
(defn path-to
"Stack path from :root down to `gid` following :parent links, or nil if an
ancestor is missing — an orphan whose parent context was deleted."
"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 (get-in scene [:groups g :parent]) (cons g acc)))))
:else (recur (home scene g) (cons g acc)))))
(defn timelines
"Every reachable timeline you can open as a context — root, plus named child
@ -601,7 +748,7 @@
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (not (:draft g)))
(when-let [path (path-to scene gid)]
(let [parent (:parent g)]
(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)))

View file

@ -1,6 +1,7 @@
(ns tl.subs
(:require [clojure.string :as str]
[re-frame.core :as rf]
[tl.filter :as filter]
[tl.scene :as scene]))
(rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
@ -22,8 +23,11 @@
;; :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 ::script-jump (fn [db] (get-in db [:view :script-jump])))
(rf/reg-sub ::note-target (fn [db] (get-in db [:view :note-target])))
(rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{})))
(rf/reg-sub ::hidden-tags (fn [db] (get-in db [:view :hidden-tags] #{})))
(rf/reg-sub ::annotation-filter
(fn [db] (merge {:query "" :tags #{}}
(get-in db [:view :annotation-filter]))))
(rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus])))
(rf/reg-sub ::linking (fn [db] (get-in db [:view :linking])))
(rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann])))
@ -104,50 +108,111 @@
(fn [[scene stack] _]
(mapv (fn [gid] {:id gid :name (or (get-in scene [:groups gid :name]) (name gid))}) stack)))
;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
(defn- in-bars? [bars ph]
(some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
(defn annotations-by-parent
"Group annotation cards by every reference parent they belong to."
[anns]
(reduce (fn [m a]
(reduce #(update %1 %2 (fnil conj []) a) m (:parents a)))
{}
anns))
(defn visible-child-annotations
"Nested cards under `parent-id` are controlled by that parent's reveal state.
A transcluded child may be visible because another parent was revealed, but it
should not render under this parent until this parent's panel is open."
[by-parent revealed parent-id seen]
(when (contains? (or revealed #{}) parent-id)
(seq (remove #(contains? seen (:id %)) (get by-parent parent-id)))))
;; child annotations of the current context, with their bars in local coords
(rf/reg-sub
::annotations
:<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed]
(fn [[scene ctx segs hidden-tags revealed] _]
(let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g)))
(:groups scene)))
;; shown when every ancestor up to ctx is revealed: a direct child of ctx
;; always shows; a deeper annotation shows only if its parent is revealed
;; AND that parent is itself shown.
shown? (fn shown? [p] (or (= ctx p)
(and (revealed p) (shown? (get-in scene [:groups p :parent])))))]
::all-annotations
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
(fn [[scene ctx segs revealed] _]
(let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
exists? (fn [x] (contains? (:groups scene) x))
;; each annotation → the mark-groups it's FILED UNDER (:in membership). A
;; normal annotation has one; a linked one has several, so it lists under
;; each. Asserted, not derived from where marks resolve. Any :in host that
;; no longer exists (its group was deleted) is dropped; an annotation left
;; with NO surviving host is rescued to root so it stays visible/refileable
;; instead of vanishing into a ghost parent.
parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
(let [ms (filter exists? (scene/membership scene gid))]
[gid (if (seq ms) (set ms) #{:root})])))
;; child count per timeline (drives the "Show N" nested badge)
nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents))
;; membership-reveal hierarchy: shows when ctx is a host it's filed under,
;; or a REVEALED host annotation that itself shows. `seen` guards cycles.
shown? (fn shown? [gid seen]
(and (not (contains? seen gid))
(boolean (some (fn [p] (or (= ctx p)
(and (ann? p) (revealed p) (shown? p (conj seen gid)))))
(parents gid)))))]
(->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (shown? (:parent g))
;; a hidden tag hides every annotation carrying it; the
;; :untagged sentinel hides annotations with no tags
(let [tags (get-in g [:meta :tags])]
(not (or (some hidden-tags tags)
(and (empty? tags) (contains? hidden-tags :untagged))))))
(let [bars (scene/lane-bars scene ctx gid segs) ; one bar per mark; distinct marks never fuse
reason (scene/broken-reason scene gid)
(when (= :annotation (:type g))
;; VISIBILITY IS BY MEMBERSHIP (:in): an annotation shows in ctx
;; iff it's filed under ctx, or under a revealed host that itself
;; shows. Where its marks resolve only decides whether bars draw.
(let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
(when (shown? gid #{})
(let [reason (scene/broken-reason scene gid)
oor (boolean (scene/clip-loss? scene gid))
hidden (get-in g [:meta :hidden])]
{:id gid :parent (:parent g)
hidden (get-in g [:meta :hidden])
note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
distinct
(filterv #(= :script-note (get-in scene [:groups % :type]))))
note-text (mapcat (fn [ng]
(let [n (get-in scene [:groups ng])]
(cons (:name n)
(mapcat (juxt :text :content) (:regions n)))))
note-ids)
jumps (scene/jump-targets scene ctx gid)
clips (->> (:marks g)
(mapcat (fn [m] [(get-in m [:start :ref])
(get-in m [:end :ref])]))
(concat (map :seg jumps))
(keep (fn [ref]
(let [cg (get-in scene [:groups ref])]
(or (:name cg)
(get-in cg [:media :name])
(some-> ref name)))))
distinct)]
{:id gid :parent (scene/home scene gid) ; primary home = first :in
;; the mark-groups this annotation is filed under (:in) — the
;; pane groups by this, so a linked annotation lists under each.
:parents (parents gid)
:name (:name g) :color (or (:color g) "#4e8fc2")
:content (:content g) :children (count (:marks g))
:nested (get nested gid 0)
:draft (boolean (:draft g))
;; every script-note bound anywhere in this annotation
;; (annotation-level + per-mark), deduped, still-existing only
:notes (->> (concat (:notes g) (mapcat :notes (:marks g)))
distinct
(filterv #(= :script-note (get-in scene [:groups % :type]))))
:notes note-ids
:script (vec (remove nil? note-text))
:clips (vec clips)
:broken (boolean reason) :reason reason :oor oor
:hidden (boolean hidden)
:tags (vec (get-in g [:meta :tags]))
;; jump targets labelled from the marks' clip refs (same as
;; the editor) — not re-derived from a floored bar frame
:jumps (scene/jump-targets scene ctx gid)
:start (or (ffirst bars) 0) :bars bars}))))
;; the editor) — not re-derived from a display bar frame
:jumps jumps
:start (or (ffirst bars) 0) :bars bars}))))))
(sort-by (juxt :broken :start)) ; broken annotations sink to the bottom
vec))))
(rf/reg-sub
::annotations
:<- [::all-annotations] :<- [::annotation-filter]
(fn [[anns filters] _]
(filter/filter-annotations anns filters)))
;; every distinct tag used by any annotation in the project — feeds both the tag
;; adder's autocomplete and the timeline tag filter.
(rf/reg-sub
@ -160,11 +225,6 @@
(sort-by str/lower-case)
vec)))
;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
(defn- in-bars? [bars ph]
(some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
;; the annotation the playhead is currently inside (or the latest one passed) —
;; drives the rolling highlight/scroll in the commentary
(rf/reg-sub
@ -218,7 +278,7 @@
(fn [[gid g]]
;; child annotations of the context OR the context annotation itself
;; (pushing the owner onto the stack makes ctx that annotation)
(when (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid)))
(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

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,46 @@
(ns tl.filter-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.filter :as f]))
(def anns
[{:id :a
:name "Kitchen argument"
:content "A tense exchange at breakfast"
:tags ["beat" "performance"]
:script ["INT. KITCHEN - MORNING" "I can't keep doing this."]
:clips ["kitchen_wide.mov" "closeup_alex.mov"]}
{:id :b
:name "Street pickup"
:content "Car arrives outside"
:tags ["blocking"]
:script ["EXT. STREET - NIGHT"]
:clips ["street_driving.mov"]}
{:id :c
:name "Untitled reaction"
:content "Silent look"
:tags []
:script []
:clips ["reaction_insert.mov"]}])
(deftest tag-filters-include-matches
(testing "no tag selection leaves the list unconstrained"
(is (= [:a :b :c] (mapv :id (f/filter-annotations anns {:tags #{}})))))
(testing "selecting a tag includes matching annotations instead of hiding them"
(is (= [:a] (mapv :id (f/filter-annotations anns {:tags #{"beat"}})))))
(testing "multiple selected tags are an OR"
(is (= [:a :b] (mapv :id (f/filter-annotations anns {:tags #{"beat" "blocking"}})))))
(testing "untagged is an explicit include bucket"
(is (= [:c] (mapv :id (f/filter-annotations anns {:tags #{:untagged}}))))))
(deftest search-scopes
(testing "plain text searches title/content/tags/script/clips"
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "breakfast"}))))
(is (= [:b] (mapv :id (f/filter-annotations anns {:query "street_driving"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "can't keep"})))))
(testing "prefixes are case-insensitive and restrict the search field"
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "Timeline: kitchen"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "script: kitchen"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "clip: kitchen"}))))
(is (= [] (mapv :id (f/filter-annotations anns {:query "script: closeup"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "clip: closeup"}))))
(is (= [:b] (mapv :id (f/filter-annotations anns {:query "tag: block"}))))))

245
tl/test/tl/flow_test.cljs Normal file
View file

@ -0,0 +1,245 @@
(ns tl.flow-test
"Integration tests that drive the ACTUAL re-frame events the UI dispatches and
read the resulting scene AND live subscriptions back — via day8.re-frame.test's
run-test-sync, so subscriptions resolve in a real reactive context (no 'outside
reactive context' warnings) and dispatch is synchronous. A bug that lives in an
event handler or a subscription (not just a pure scene fn) is caught here.
Placement model under test: an annotation's `:in` is an ordered vector of the
mark-groups it's FILED UNDER (first = primary home). Membership is asserted;
where marks resolve only decides whether bars draw. See tl.scene/membership."
(:require [cljs.test :refer-macros [deftest is testing]]
[day8.re-frame.test :as rf-test]
[re-frame.core :as rf]
[re-frame.db :as rdb]
[tl.events :as ev]
[tl.subs :as subs]
[tl.scene :as s]))
;; stub the browser/player/network fx (views registers the real player fx; we don't
;; require views here, and we never want the net in a test)
(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
:connect-scene :fetch-projects :poll-thumbnails :upload-project]]
(rf/reg-fx k (fn [_] nil)))
;; four clips on four tracks, one shared source file; root spans [0,400)
(def clips-scene
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]}
:clip-a {:type :clip :parent nil :name "Challengers.mov" :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]}
:clip-b {:type :clip :parent nil :name "Challengers.mov" :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
:clip-c {:type :clip :parent nil :name "Challengers.mov" :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}
:clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}})
(defn seed
"clips + annA (over clips A,B, filed under root) + annB (over C,D, filed under
root) + annC (one mark authored inside annA, FILED under annA)."
[]
(let [pA (s/make-proxy clips-scene :root 0 200)
pB (s/make-proxy clips-scene :root 200 400)
sc (-> clips-scene
(assoc-in [:groups :pA] pA)
(assoc-in [:groups :pB] pB)
(assoc-in [:groups :annA] {:type :annotation :in [:root] :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]})
(assoc-in [:groups :annB] {:type :annotation :in [:root] :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]}))
pInA (s/make-proxy sc :annA 10 60)]
(-> sc (assoc-in [:groups :pInA] pInA)
(assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f"
:marks [(s/proxy-ref "ca" :pInA)]}))))
(defn setup! [scene stack]
(reset! rdb/app-db {:scene scene :fps 24
:view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}
:project {:id nil}}))
(defn scene* [] (:scene @rdb/app-db))
(defn draft-gid [] (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*))))
(defn pane-ids
"The set of annotation gids the pane sub currently lists (in the live context)."
[]
(set (map :id @(rf/subscribe [::subs/all-annotations]))))
(defn card [gid] (some #(when (= gid (:id %)) %) @(rf/subscribe [::subs/all-annotations])))
(defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx)))
;; =========================================================================
;; the annotation pane sub (::all-annotations) lists by membership
;; =========================================================================
(deftest pane-lists-strictly-by-membership
(rf-test/run-test-sync
(setup! (seed) [:root])
(testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT"
(is (= #{:annA :annB} (pane-ids)))
(is (= :root @(rf/subscribe [::subs/context])))
(is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)"))
(testing "pushing annA onto the stack lists annC (its child), not annA/annB"
(rf/dispatch [::ev/expand :annA])
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
(is (= :annA @(rf/subscribe [::subs/context])))
(is (contains? (pane-ids) :annC))
(is (not (contains? (pane-ids) :annB))))
(testing "collapsing returns to root's listing"
(rf/dispatch [::ev/collapse])
(is (= #{:annA :annB} (pane-ids))))))
;; =========================================================================
;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched
;; =========================================================================
(deftest reparent-move-then-link
(rf-test/run-test-sync
(setup! (seed) [:root])
(let [marks0 (get-in (scene*) [:groups :annC :marks])]
(testing "drag annC (grabbed under annA) onto root: the edge MOVES, primary follows"
(rf/dispatch [::ev/ann-drag-start :annC :annA])
(rf/dispatch [::ev/reparent :annC :root]) ; add? falsey ⇒ move
(is (= [:root] (:in (get-in (scene*) [:groups :annC]))))
(is (= :root (s/home (scene*) :annC)))
(is (= marks0 (get-in (scene*) [:groups :annC :marks])) "marks untouched by a move"))
(testing "now annC lists at root and no longer under annA"
(setup! (assoc-in (scene*) [:view] {:stack [:root] :playheads {} :revealed #{} :zoom 1 :row-h 20}) [:root])
(is (contains? (pane-ids) :annC))
(rf/dispatch [::ev/expand :annA])
(is (not (contains? (pane-ids) :annC))))
(testing "⌥-drag (add?) links annC under annB WITHOUT removing root"
(rf/dispatch [::ev/collapse])
(rf/dispatch [::ev/ann-drag-start :annC :root])
(rf/dispatch [::ev/reparent :annC :annB true])
(is (= #{:root :annB} (s/membership (scene*) :annC)))
(is (= :root (s/home (scene*) :annC)) "primary home unchanged by a link")
(is (= marks0 (get-in (scene*) [:groups :annC :marks])))))))
(deftest reparent-refuses-cycles-and-noops
(rf-test/run-test-sync
(setup! (seed) [:root])
(testing "filing annA under annC (which is filed under annA) is refused — a cycle"
(rf/dispatch [::ev/file-into :annA :annC])
(is (not (contains? (s/membership (scene*) :annA) :annC))))
(testing "filing under a group it's already filed under is a no-op"
(let [before (:in (get-in (scene*) [:groups :annC]))]
(rf/dispatch [::ev/file-into :annC :annA])
(is (= before (:in (get-in (scene*) [:groups :annC]))))))
(testing "an annotation can't be filed under itself"
(rf/dispatch [::ev/file-into :annC :annC])
(is (not (contains? (s/membership (scene*) :annC) :annC))))))
;; =========================================================================
;; unfile — remove one edge; never the primary home, never the last
;; =========================================================================
(deftest unfile-removes-links-only
(rf-test/run-test-sync
(setup! (seed) [:root])
(rf/dispatch [::ev/file-into :annC :root]) ; annC now [:annA :root]
(is (= [:annA :root] (:in (get-in (scene*) [:groups :annC]))))
(testing "unfiling a non-primary link removes just that edge"
(rf/dispatch [::ev/unfile :annC :root])
(is (= [:annA] (:in (get-in (scene*) [:groups :annC])))))
(testing "the primary home can't be unfiled (nor the last remaining edge)"
(rf/dispatch [::ev/unfile :annC :annA])
(is (= [:annA] (:in (get-in (scene*) [:groups :annC])))))))
;; =========================================================================
;; adding marks from another context (associate-marks) does NOT move placement
;; =========================================================================
(deftest associate-marks-adds-marks-not-membership
(rf-test/run-test-sync
(setup! (seed) [:root])
;; drill into annB, author a range on ITS content, tie it to annC
(rf/dispatch [::ev/expand :annB])
(rf/dispatch [::ev/open-draft])
(rf/dispatch [::ev/draft-select-range 50 150])
(let [d (draft-gid)]
(is d "a draft exists after open-draft")
(is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB")
(rf/dispatch [::ev/associate-marks d :annC]))
(testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)"
(is (= 2 (count (get-in (scene*) [:groups :annC :marks]))))
(is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks"))
;; associate opened annC in :edit; save it (drops :draft) and leave the form
(rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil])
(rf/dispatch [::ev/finish-edit])
(testing "so annC does NOT list under annB — even though its footage resolves there"
(is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB")
(is (= 1 (count (bars-in :annB :annC))) "but its B-mark DOES draw a bar in annB (resolution ≠ membership)")
(is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2))))
(testing "filing it in explicitly is what makes it list under annB"
(rf/dispatch [::ev/file-into :annC :annB])
(is (contains? (pane-ids) :annC))
(is (= #{:annA :annB} (s/membership (scene*) :annC))))))
;; =========================================================================
;; stack push / pop and reveal-children through the real events
;; =========================================================================
(deftest stack-navigation-and-reveal
(rf-test/run-test-sync
(setup! (seed) [:root])
(testing "expand pushes, pop-to truncates, collapse pops"
(rf/dispatch [::ev/expand :annA])
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
(rf/dispatch [::ev/collapse])
(is (= [:root] (:stack (:view @rdb/app-db))))
(rf/dispatch [::ev/expand :annA])
(rf/dispatch [::ev/pop-to :root])
(is (= [:root] (:stack (:view @rdb/app-db)))))
(testing "at root, revealing annA surfaces its child annC in the SAME pane list"
(is (not (contains? (pane-ids) :annC)) "hidden until annA is revealed")
(is (pos? (:nested (card :annA))) "annA advertises a nested child")
(rf/dispatch [::ev/toggle-children :annA])
(is (contains? (pane-ids) :annC) "revealed → annC shows as annA's child at root"))))
;; =========================================================================
;; 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
;; annC's sole host (annA) is deleted out from under it, as if by restore of
;; stale data or a peer deleting the parent
(setup! (update (seed) :groups dissoc :annA) [:root])
(testing "annC's :in still points at the now-missing annA"
(is (= [:annA] (:in (get-in (scene*) [:groups :annC]))))
(is (nil? (get-in (scene*) [:groups :annA]))))
(testing "but the pane rescues it to root rather than dropping it"
(is (contains? (pane-ids) :annC) "orphan is visible at root, not lost")
(is (= #{:root} (:parents (card :annC))) "listed under root until re-filed"))
(testing "and it can be re-filed normally from there"
(rf/dispatch [::ev/file-into :annC :annB])
(is (contains? (s/membership (scene*) :annC) :annB)))))
;; =========================================================================
;; JSON wire round-trip of :in (vector, keyworded) via restore-annotations
;; =========================================================================
(deftest legacy-parent-data-migrates-through-peer-delta
(rf-test/run-test-sync
(setup! clips-scene [:root])
;; a reload/peer delivers a legacy annotation — string :parent, no :in, exactly
;; the shape stored in the real DB before the membership migration
(rf/dispatch [::ev/peer-delta
{:changed {:ann-legacy {:type "annotation" :parent "root" :name "L"
:marks [{:id "lm" :start {:ref "clip-a" :at 0}
:end {:ref "clip-a" :at 50}}]}}
:deleted []}])
(testing "it migrates :parent -> :in [:root] on ingest and drops the old field"
(is (= [:root] (:in (get-in (scene*) [:groups :ann-legacy]))))
(is (nil? (:parent (get-in (scene*) [:groups :ann-legacy])))))
(testing "and shows up in the root pane like any other"
(is (contains? (pane-ids) :ann-legacy)))))
(deftest membership-survives-the-json-wire
(rf-test/run-test-sync
(setup! (seed) [:root])
(rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root]
(let [g (get-in (scene*) [:groups :annC])
;; exactly what api/put-scene serializes then reads back
wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true)
back (:annC (s/restore-annotations {:annC wire}))]
(is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)")
(is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved")
(is (= :annA (s/home {:groups {:annC back}} :annC))))))

View file

@ -0,0 +1,27 @@
(ns tl.frame-policy-test
(:require [cljs.test :refer-macros [deftest is testing]]
[clojure.string :as str]))
(def fs (js/require "fs"))
(def path (js/require "path"))
(defn- cljs-files [dir]
(mapcat (fn [name]
(let [p (.join path dir name)
st (.statSync fs p)]
(cond
(.isDirectory st) (cljs-files p)
(str/ends-with? name ".cljs") [p]
:else [])))
(array-seq (.readdirSync fs dir))))
(deftest no-math-round-in-frame-code
(testing "frame code must not use the JS rounding API"
(let [needle (str "Math" "." "round")
hits (->> (concat (cljs-files "src") (cljs-files "test"))
(remove #(str/ends-with? % "frame_policy_test.cljs"))
(keep (fn [p]
(when (str/includes? (.readFileSync fs p "utf8") needle)
p)))
vec)]
(is (= [] hits)))))

View file

@ -0,0 +1,15 @@
(ns tl.routes-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.routes :as routes]))
(deftest view-state-parses-integer-frame-query
(testing "route playhead accepts string and numeric integer query params"
(set! (.. js/window -location -hash) "")
(is (= {:playhead 42}
(routes/view-state {:query-params {"f" "42"}})))
(is (= {:playhead 42}
(routes/view-state {:query-params {"f" 42}}))))
(testing "fractional route playhead is ignored instead of changed"
(set! (.. js/window -location -hash) "")
(is (= {}
(routes/view-state {:query-params {"f" "42.5"}})))))

View file

@ -1,6 +1,7 @@
(ns tl.scene-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.md :as md]
[tl.otio :as otio]
[tl.scene :as s]))
;; --- shared fixture -------------------------------------------------------
@ -16,11 +17,13 @@
(defn with-group [scene gid g] (assoc-in scene [:groups gid] g))
(defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}})
(defn err-msg [f]
(try (f) nil (catch js/Error e (.-message e))))
;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips.
(def inter-x
(with-group base :ann-x
{:type :annotation :parent :root
{: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)
@ -29,7 +32,7 @@
;; Y inside X, referencing two of X's subclips (parent = :ann-x)
(def x+y
(with-group inter-x :ann-y
{:type :annotation :parent :ann-x
{: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)
@ -47,7 +50,7 @@
(deftest rearrange-and-gap-removal
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track"
(let [scene (with-group base :ann
{:type :annotation :parent :root
{:type :annotation :in [:root]
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})
segs (s/resolve scene :ann)]
(is (= 200 (s/length segs)))
@ -72,10 +75,10 @@
(testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame"
;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100
(let [scene (-> base
(with-group :ann {:type :annotation :parent :root
(with-group :ann {:type :annotation :in [:root]
:marks [{:id :m/s :start {:ref :clip-a :at 20}
:end {:ref :clip-a :at 80}}]})
(with-group :ann-y {:type :annotation :parent :ann
(with-group :ann-y {:type :annotation :in [:ann]
:marks [{:id :m/y :start {:ref :m/s :at 0}
:end {:ref :m/s :at -1}}]}))
seg (first (s/resolve scene :ann-y))]
@ -85,14 +88,14 @@
(deftest tracks-by-membership
(testing "zoom includes exactly the tracks the marks touch"
(let [scene (with-group base :ann
{:type :annotation :parent :root
{:type :annotation :in [:root]
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})]
(is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann)))))))
(deftest repeat-yields-two-pieces
(testing "a clip referenced twice renders at two local positions"
(let [scene (with-group base :ann
{:type :annotation :parent :root
{:type :annotation :in [:root]
:marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100)
(refm :m/r1 :clip-b 0 -1) ; B local [100,200)
(refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300)
@ -159,7 +162,7 @@
(let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210)
scene (-> base
(with-group :prox p)
(with-group :ann {:type :annotation :parent :root
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 170 (s/length segs))) ; 60 + 100 + 10
@ -173,7 +176,7 @@
(testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip"
(let [p (s/make-proxy base :root 10 60) ; inside A only
scene (-> base (with-group :prox p)
(with-group :ann {:type :annotation :parent :root
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 1 (count (:marks p))))
@ -217,18 +220,18 @@
(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 :parent :root
(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 :root :ann segs)]
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 :parent :root
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/1 :p1)]}))]
(is (= [[0 200 :m/1]] (s/lane-bars one :root :ann (s/content-segments one :root))))))))
(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)
@ -239,12 +242,122 @@
{: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 :parent :root
(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
;; =========================================================================
@ -294,18 +407,55 @@
(is (= #{:t0 :t1} (s/tracks segs)))
(is (= 200 (s/length segs)))))))
(deftest from-otio-snaps-fractional-frames
(testing "OTIO's fractional RationalTime is rounded to whole frames at seed"
(let [parsed {:fps 24 :duration 199.6
:tracks [{:index 0 :kind :video :name "W"
:clips [{:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4}]}]}
(deftest otio-normalizes-source-starts-and-rejects-fractional-durations
(testing "fractional OTIO source starts are normalized at import"
(let [clip {:OTIO_SCHEMA "Clip.2"
:name "a"
:source_range {:start_time {:value 10.5 :rate 24}
:duration {:value 5 :rate 24}}}
otio {:global_start_time {:rate 24}
:tracks {:children [{:name "V" :kind "Video" :children [clip]}]}}
parsed (otio/parse otio)]
(is (= 10 (:media-offset parsed)))
(is (= 0 (get-in parsed [:tracks 0 :clips 0 :media-in])))
(is (integer? (get-in parsed [:tracks 0 :clips 0 :media-in])))))
(testing "fractional OTIO durations still fail because timeline math is integer"
(let [clip {:OTIO_SCHEMA "Clip.2"
:name "a"
:source_range {:start_time {:value 10 :rate 24}
:duration {:value 5.5 :rate 24}}}
otio {:global_start_time {:rate 24}
:tracks {:children [{:name "V" :kind "Video" :children [clip]}]}}
msg (err-msg #(otio/parse otio))]
(is (re-find #"integer frame" msg))))
(testing "from-otio also asserts parsed frame fields are integers"
(let [clip {:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4}
parsed {:fps 24 :duration 199.6
:tracks [{:index 0 :kind :video :name "W" :clips [clip]}]}
msg (err-msg #(s/from-otio parsed))]
(is (re-find #"integer frame" msg)))))
(deftest real-otio-source-starts-import-as-integer-media-frames
(testing "the bundled Challengers OTIO has fractional source starts but imports into integer model frames"
(let [raw (js->clj (js/JSON.parse (.readFileSync (js/require "fs") "resources/public/one_two_three.otio" "utf8"))
:keywordize-keys true)
parsed (otio/parse raw)
scene (s/from-otio parsed)
mark (first (get-in scene [:groups :t0-c0 :marks]))]
(is (= 0 (get-in scene [:groups :t0-c0 :start]))) ; 0.2 -> 0
(is (= 189 (:start mark))) ; media-in 188.87 -> 189
(is (= 289 (:end mark))) ; 188.87+100.4=289.27 -> 289
(is (= 200 (get-in scene [:groups :root :marks 0 :end]))) ; 199.6 -> 200
(is (every? integer? [(:start mark) (:end mark)])))))
media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))]
(is (seq media-ins))
(is (every? integer? media-ins))
(is (every? integer? (mapcat (fn [[_ g]]
(mapcat (juxt :start :end) (:marks g)))
(:groups scene)))))))
(deftest selection-rejects-fractional-frames
(testing "a selection over fractional clip layout fails instead of changing frames"
(let [scene {:tracks {:t0 {:name "W"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/r :start 0 :end 100}]}
:fr {:type :clip :parent nil :start 0.3 ; fractional timeline pos
:marks [{:id :m/fr :start 10.4 :end 110.4 :track :t0}]}}}
msg (err-msg #(s/selection->marks scene :root 20 60))]
(is (re-find #"integer frame" msg)))))
;; =========================================================================
;; Suite 4 — draft rows <-> marks (the two-input editor)
@ -327,7 +477,7 @@
(deftest frames-are-mark-time-under-parent-trim
(testing "frames are 0-based within the TRIMMED segment, not raw clip time"
(let [scene (with-group base :p
{:type :annotation :parent :root
{: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
@ -338,13 +488,13 @@
(is (= 0 (get-in (first marks) [:start :at])))
(is (= 30 (get-in (first marks) [:end :at])))))))
(deftest merge-bars-coalesces-continuous-run
(testing "sub-frame OTIO gaps collapse to one bar; a real gap stays split"
;; foobar's real bars (continuous 5-clip selection, ~0.9-frame source gaps)
(deftest merge-bars-coalesces-continuous-integer-runs
(testing "integer-adjacent bars merge; fractional bars fail"
(is (= [[128 542]]
(s/merge-bars [[128.87 190.87] [191.80 265.80] [266.73 384.73]
[385.61 413.61] [414.58 541.58]])))
(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
@ -354,7 +504,8 @@
:end {:ref "clip-a" :at -1}}]}}
g (:ann-1 (s/restore-annotations json-like))]
(is (= :annotation (:type g)))
(is (= :root (:parent 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)))))))))
@ -365,9 +516,9 @@
(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 1 :type :annotation :parent :root :name "p" :color "#abc" :content "hi"
(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 1 :type :annotation :parent :ann-p :name "c"
: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)))))))
@ -424,7 +575,7 @@
(deftest repeats-are-unambiguous
(testing "two instances of A share a source frame but distinct locals (local is master)"
(let [scene (with-group base :ann
{:type :annotation :parent :root
{: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
@ -456,9 +607,9 @@
(deftest path-to-builds-stack-and-drops-orphans
(let [scene {:groups {:root {:type :timeline :parent nil}
:a {:type :annotation :parent :root}
:b {:type :annotation :parent :a}
:orphan {:type :annotation :parent :gone}}}]
: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)))