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

Compare commits

base: noe:213602c4cb5176014d3463ee33708c8195f96ea8
Branches Tags
noe:main
..
compare: noe:d54a6ae8f847a4b7980437cde084bb39c8315a9e
Branches Tags
noe:main

10 commits
213602c4cb ... d54a6ae8f8

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
Download patch file Download diff file Expand all files Collapse all files

30
.dockerignore
View file

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

12
tl/annotation_flow_plan.md
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. - [ ] 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. - [ ] 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. - [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).
- [ ] Per-mark broken-ref warnings; keep annotation if at least one mark still resolves. - [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).

6
tl/data_model.org
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. this brings us to playing. since right now there is only one source video file, we need to be able to seek to arbitrary frames. each context (mark-group) keeps its own local playhead, used when it's the top of the timeline stack. when we hit play, in the example above of annotation X, we find the clip under the playhead, compute the source frame, seek there, and start playing. one correction though: the local playhead has to be the master clock, not the video. you can't derive local position from currentTime -- once an annotation repeats or reorders clips, one source frame maps to several local frames, it's not invertible. so the local playhead advances on its own (wall-clock x fps while playing), and every frame we compute expected = group->media(local) and seek the video there only if round(currentTime*fps) != expected. within a clip, expected tracks the video's natural playback so no seek fires; at a mark boundary it jumps once and we seek. and right -- no recursion at play time: we resolve the current context once into flat ordered spans, and group->media is just the flat lookup the renderer already does.
# how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation. # how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation.
# automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit. # automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit.
* 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

1
tl/package.json
View file

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

135
tl/resources/public/css/app.css
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. */ 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, .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, .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); font-family: var(--chicago); background: var(--paper); color: var(--ink);
border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; line-height: 1.3; 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, .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, .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, .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); background: var(--hover);
} }
.jump-btn:active, .add-btn:active, .edit-btn:active, .del-btn:active, .expand-btn:active, .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, .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, .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); background: var(--ink); color: var(--paper);
} }
@ -101,10 +101,13 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
background: none; cursor: pointer; } background: none; cursor: pointer; }
.draw-tools .draw-wid { width: 56px; } .draw-tools .draw-wid { width: 56px; }
.draw-done { font-weight: bold; } .draw-done { font-weight: bold; }
.mark-draw { background: none; border: 1px solid transparent; border-radius: 0; .mark-draw, .mark-script {
font-size: 12px; cursor: pointer; padding: 0 3px; line-height: 1; } width: 28px; height: 26px; flex: none;
.mark-draw:hover { border-color: var(--ink); } display: inline-flex; align-items: center; justify-content: center;
.mark-draw.has { border-color: var(--ink); background: var(--paper); } 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 { .frame-readout {
position: absolute; bottom: 6px; right: 8px; z-index: 4; position: absolute; bottom: 6px; right: 8px; z-index: 4;
@ -209,10 +212,13 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.form { .form {
flex: 1; min-width: 0; overflow-y: auto; flex: 1; min-width: 0; overflow-y: auto;
background: var(--paper); border: 1px solid var(--ink); box-sizing: border-box; background: var(--paper); border: 1px solid var(--ink); box-sizing: border-box;
padding: 10px 12px; padding: 12px;
display: flex; flex-direction: column; gap: 10px; 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-row { display: flex; gap: 8px; align-items: center; }
.form-name { flex: 1; } .form-name { flex: 1; }
.form input[type=text], .form-name, .form-content { .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; .form-content { width: 100%; min-height: 70px; resize: vertical; box-sizing: border-box;
font-family: inherit; } font-family: inherit; }
.form-marks-label { font-family: var(--chicago); font-size: 11px; letter-spacing: .5px; .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 */ /* contenteditable content surface + inline link chips */
.content-editor { white-space: pre-wrap; word-break: break-word; outline: none; cursor: text; .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 .link-f { font-size: 11px; opacity: .7; }
.link-chip:hover .link-f { opacity: 1; } .link-chip:hover .link-f { opacity: 1; }
.mark-row { display: flex; flex-wrap: nowrap; align-items: center; gap: 6px; min-width: 0; } .mark-row { display: flex; flex-wrap: wrap; align-items: center; gap: 6px; min-width: 0; }
.mark-arrow { color: var(--ink); } .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; } .row-x, .add-mark { padding: 3px 8px; font-size: 12px; }
.add-mark { align-self: flex-start; } .add-mark { align-self: flex-start; }
@ -251,7 +260,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
/* point editor + autocomplete */ /* point editor + autocomplete */
.pt-input { position: relative; flex: 1 1 130px; display: flex; align-items: center; min-width: 0; } .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 { .pt-text {
flex: 1; min-width: 0; box-sizing: border-box; flex: 1; min-width: 0; box-sizing: border-box;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink); 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 { display: flex; align-items: flex-start; gap: 6px; align-self: stretch; }
.link-insert .pt-input { flex: 1 1 auto; max-width: none; } .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; } .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; 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; .pt-chip-name { font-size: 12px; color: var(--ink); white-space: nowrap;
overflow: hidden; text-overflow: ellipsis; flex: 1; } overflow: hidden; text-overflow: ellipsis; flex: 1; }
.pt-frame { width: 56px; background: var(--paper); color: var(--ink); border: 1px solid var(--ink); .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 { 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; } .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 */ /* reveal-children toggle at the card bottom + the nested child cards */
.show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px; .show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px;
font-family: var(--chicago); font-size: 11px; text-align: left; 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; } .ac .pt-dropdown li { display: flex; align-items: center; justify-content: space-between; gap: 6px; }
.tag-eye { font-size: 12px; flex: none; } .tag-eye { font-size: 12px; flex: none; }
.pt-x:hover { text-decoration: underline; } .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-hint { font-size: 11px; color: var(--mute); }
.form-check { display: flex; align-items: center; gap: 6px; font-family: var(--chicago); .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; } .zoom-read { font-size: 11px; color: var(--ink); min-width: 42px; text-align: center; }
.script-empty { color: var(--mute); font-size: 12px; padding: 20px; } .script-empty { color: var(--mute); font-size: 12px; padding: 20px; }
.ann.selected { box-shadow: inset 3px 0 0 var(--ink); } .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 (list of project script-notes) */
.note-rail { display: flex; align-items: center; gap: 8px; flex-wrap: wrap; .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); } 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) */ /* 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 /* the currently-selected/last-touched mark while authoring — so you know which
one a drawing binds to, and which you're about to delete */ 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)); .mark-block.active-mark {
border-radius: 2px; padding: 2px 0 2px 3px; margin-left: -3px; } background: var(--desktop); background-size: 4px 4px;
.note-drop { display: flex; align-items: center; flex-wrap: wrap; gap: 4px; min-height: 20px; box-shadow: inset 4px 0 0 var(--ink), 2px 2px 0 var(--ink);
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); } .mark-block.broken { opacity: 0.6; }
.note-drop-hint { font-size: 10px; color: var(--mute); font-style: italic; } .mark-block.broken .pt-chip-name { text-decoration: line-through; }
.note-source { display: flex; flex-wrap: wrap; gap: 4px; margin: 4px 0; } .mark-note-list {
.note-src { display: inline-flex; align-items: center; gap: 4px; font-size: 11px; cursor: grab; display: flex; flex-wrap: wrap; gap: 4px;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 1px 6px; } margin: 5px 0 0 24px;
.note-src:active { cursor: grabbing; } }
.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; .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.live { background: var(--ink); color: var(--paper); }
.bound-note-name { max-width: 120px; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; } .bound-note-name { max-width: 120px; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }
.note-live { font-weight: bold; } .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; padding: 0 2px; font-size: 13px; line-height: 1; flex: none; align-self: center;
} }
.mark-grip:active { cursor: grabbing; } .mark-grip:active { cursor: grabbing; }
.mark-grip.disabled { cursor: default; opacity: .35; }
.mark-block.dragging { opacity: 0.4; } .mark-block.dragging { opacity: 0.4; }
.mark-block.drop-before { position: relative; } .mark-block.drop-before { position: relative; }
.mark-block.drop-before::before { .mark-block.drop-before::before {

6
tl/shadow-cljs.edn
View file

@ -9,6 +9,7 @@
[re-frame "1.4.7"] [re-frame "1.4.7"]
[metosin/reitit "0.9.1"] [metosin/reitit "0.9.1"]
[day8.re-frame/http-fx "0.2.4"] [day8.re-frame/http-fx "0.2.4"]
[day8.re-frame/test "0.1.5"]
[binaryage/devtools "1.0.7"]] [binaryage/devtools "1.0.7"]]
:dev-http :dev-http
@ -19,7 +20,10 @@
{:test {:test
{:target :node-test {:target :node-test
:output-to "target/node-tests.js" :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 :app
{:target :browser {:target :browser

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

@ -75,7 +75,7 @@
(let [stack (vec (valid-stack scene stack)) (let [stack (vec (valid-stack scene stack))
ctx (peek stack)] ctx (peek stack)]
(cond-> (assoc view :stack 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] (defn- route-state [db]
(let [ctx (peek (get-in db [:view :stack]))] (let [ctx (peek (get-in db [:view :stack]))]
@ -332,12 +332,18 @@
(let [s (get-in db [:view :hidden-notes] #{})] (let [s (get-in db [:view :hidden-notes] #{})]
(assoc-in db [:view :hidden-notes] (if (contains? s gid) (disj s gid) (conj s gid)))))) (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 ;; annotation-pane filters are inclusive: selected tags narrow the list to
;; filter. A tag in :hidden-tags hides every annotation carrying it. ;; matching annotations.
(rf/reg-event-db ::toggle-tag-filter (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]] (fn [db [_ tag]]
(let [s (get-in db [:view :hidden-tags] #{})] (let [s (get-in db [:view :annotation-filter :tags] #{})]
(assoc-in db [:view :hidden-tags] (if (contains? s tag) (disj s tag) (conj s tag)))))) (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 ;; click a highlight on the page → activate its note and focus that region's row
;; in the right pane ;; in the right pane
@ -378,6 +384,9 @@
(merge {:id rid :kind :text :content ""} region))] (merge {:id rid :kind :text :content ""} region))]
(merge {:db db} (persist-note-fx db gid))))) (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 ;; 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. ;; selected text) with the region already in it, and make it active.
(rf/reg-event-fx ::highlight-into-new-note (rf/reg-event-fx ::highlight-into-new-note
@ -390,9 +399,18 @@
:else t) :else t)
note {:type :script-note :name nm :color "#c2864e" note {:type :script-note :name nm :color "#c2864e"
:regions [(merge {:id rid :kind :text :content ""} region)]} :regions [(merge {:id rid :kind :text :content ""} region)]}
target (get-in db [:view :note-target])
db (-> db (assoc-in [:scene :groups gid] note) db (-> db (assoc-in [:scene :groups gid] note)
(assoc-in [:view :active-note] gid) (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))))) (merge {:db db} (persist-note-fx db gid)))))
;; commentary edits update the note locally (on-change); persist on blur so we ;; 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 ;; 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 ;; 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. ;; 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 (rf/reg-event-db ::bind-note-annotation
(fn [db [_ gid note-gid]] (fn [db [_ gid note-gid]]
(update-in db [:scene :groups gid :notes] #(add-in % note-gid)))) (update-in db [:scene :groups gid :notes] #(add-in % note-gid))))
@ -433,6 +448,80 @@
(fn [db [_ gid mark-id note-gid]] (fn [db [_ gid mark-id note-gid]]
(update-mark db gid mark-id #(update % :notes rm-in 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 ------------------------------------------------------------- ;; --- drawings -------------------------------------------------------------
;; A drawing is a first-class entity (:type :drawing) — a bag of normalized ;; 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 ;; 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. ;; gid. The entity isn't written until ::save-drawing, so cancel is a clean no-op.
(rf/reg-event-db ::start-drawing (rf/reg-event-db ::start-drawing
(fn [db [_ ann mark-id]] (fn [db [_ ann mark-id]]
(let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m))) (start-drawing-db db ann mark-id)))
(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)})))))
;; leave draw mode. Strokes autocommit as you draw, so this is just "done" — ;; 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). ;; 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. ;; moved the stack, so snap back to the editing context before seeking the frame.
(rf/reg-event-fx ::preview-frame (rf/reg-event-fx ::preview-frame
(fn [{:keys [db]} [_ local]] (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) ctx (peek stack)
db (-> db (assoc-in [:view :stack] stack) db (-> db (assoc-in [:view :stack] stack)
(assoc-in [:view :playheads ctx] local)) (assoc-in [:view :playheads ctx] local))
@ -529,7 +612,10 @@
(rf/reg-event-fx ::set-playhead (rf/reg-event-fx ::set-playhead
(fn [{:keys [db]} [_ ctx lf]] (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)))) (sync-route {:db next-db} next-db))))
(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p))) (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 ;; 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 ;; uuid, not gensym: gensym's counter resets each page load, so a
;; fresh annotation would reuse a prior gid and clobber it on merge. ;; fresh annotation would reuse a prior gid and clobber it on merge.
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))] (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 [] :draft :new :name "" :color "#4e8fc2" :marks []
:v scene/schema-version}) :v scene/schema-version}))
(assoc-in [:view :pt] :new) (assoc-in [:view :pt] :new)
(assoc-in [:view :active-mark] nil) (assoc-in [:view :active-mark] nil)
(assoc-in [:view :draft-stage] :choosing)))) (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) (rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)))) (assoc-in [:view :pt] :new))))
;; Edit an annotation from a card. If its primary home isn't the context being
;; 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 ;; Edit the annotation you're currently inside: drop into its parent timeline so
;; its marks are editable there, remembering to pop back when done. Root has no ;; its marks are editable there, remembering to pop back when done. Root has no
;; parent (and no marks) — edit it in place. ;; parent (and no marks) — edit it in place.
(rf/reg-event-fx ::edit-here (rf/reg-event-fx ::edit-here
(fn [{:keys [db]} [_ gid]] (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))] fx (if root? {:db db} (enter-ctx db pop))]
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit) (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new) (assoc-in [:view :pt] :new)
@ -601,13 +705,18 @@
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
;; leaving the form (save OR cancel): tear down all authoring ;; leaving the form (save OR cancel): tear down all authoring
;; transients so draw mode / pending points don't linger. ;; transients so draw mode / pending points don't linger.
(let [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 :active-mark] nil)
(assoc-in [:view :pt] nil) (assoc-in [:view :pt] nil)
(assoc-in [:view :draft-stage] nil))] (assoc-in [:view :draft-stage] nil)
(if-let [g (get-in db [:view :edit-return])] (assoc-in [:view :edit-return] nil)
(enter-ctx (assoc-in db [:view :edit-return] nil) #(conj % g)) (assoc-in [:view :edit-pop-parent] nil))]
{:db db})))) (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))) (rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
;; cancelling a draft is local only; saving a real annotation / deleting one ;; cancelling a draft is local only; saving a real annotation / deleting one
;; pushes a delta to the backend (which merges + attributes it). ;; pushes a delta to the backend (which merges + attributes it).
@ -622,7 +731,7 @@
(let [g (cond-> (editable-group g) (let [g (cond-> (editable-group g)
(= :annotation (:type g)) (assoc :v scene/schema-version)) (= :annotation (:type g)) (assoc :v scene/schema-version))
patch (group-patch orig g) 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) id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks)
;; proxies this annotation references are synthetic clips in the pool — ;; proxies this annotation references are synthetic clips in the pool —
;; persist them alongside it or the {:ref proxy} marks dangle on reload. ;; 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]} id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
{:on-success [::scene-saved] {:on-success [::scene-saved]
:on-failure [::save-error]})))))) :on-failure [::save-error]}))))))
;; --- move an annotation into another context (drag-drop reparent) --------- ;; --- membership edges (:in): file an annotation under mark-groups ----------
;; Changing :parent re-homes an annotation under a new context. Marks that no ;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups
;; longer resolve there just skip (scene/resolve drops them) and reappear if the ;; the annotation is filed under; the FIRST is the primary home (scene/home) — where
;; annotation is moved back — no data loss. Guard against cycles: never drop a ;; it's edited and its links resolve. Marks never move or re-cut — they resolve to
;; group into itself or one of its own descendants (that would make the :parent ;; raw clips globally, and that only decides whether BARS draw in a context. Three
;; chain loop forever, hanging path-to / resolve). ;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag /
(defn- descendant? ;; file-into picker), remove (× on a chip).
"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])))))
(rf/reg-event-db ::ann-drag-start (fn [db [_ gid]] (assoc-in db [:view :dragging-ann] gid))) (defn- files-under?
(rf/reg-event-db ::ann-drag-end (fn [db _] (assoc-in db [:view :dragging-ann] nil))) "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 (rf/reg-event-fx
::reparent ::reparent
(fn [{:keys [db]} [_ gid new-parent]] (fn [{:keys [db]} [_ gid new-parent add?]]
(let [scene (:scene db) (let [source (or (get-in db [:view :dragging-ann-source]) (peek (get-in db [:view :stack])))]
g (get-in scene [:groups gid])] (file-edge db gid new-parent add? source))))
(if (or (not= :annotation (:type g)) ; only annotations move
(:draft g) ; not while being drafted/edited ;; file into a group chosen from the picker — always additive (source nil).
(= (:parent g) new-parent) ; no-op: already there (rf/reg-event-fx ::file-into
(descendant? scene gid new-parent)) ; target inside gid → cycle (fn [{:keys [db]} [_ gid target]]
{:db (assoc-in db [:view :dragging-ann] nil)} (file-edge db gid target true nil)))
(let [id (get-in db [:project :id])]
(cond-> {:db (-> db (assoc-in [:scene :groups gid :parent] new-parent) ;; remove one membership edge (× on a chip). Never the primary home, never the last.
(assoc-in [:view :dragging-ann] nil) (rf/reg-event-fx
(assoc :save-error nil))} ::unfile
id (assoc :http-xhrio (api/put-scene id {:changed {gid {:parent new-parent}}} (fn [{:keys [db]} [_ gid target]]
{:on-success [::scene-saved] (let [g (get-in db [:scene :groups gid])
:on-failure [::save-error]})))))))) in (vec (:in g))]
(if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1))
{:db db}
(persist-group db gid g (assoc g :in (vec (remove #{target} in))))))))
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil))) (rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
(rf/reg-event-db ::save-error (rf/reg-event-db ::save-error
@ -704,19 +868,31 @@
(into (subvec marks 0 i) (subvec marks (inc i)))) (into (subvec marks 0 i) (subvec marks (inc i))))
(assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i 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 ;; 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, ;; 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"). ;; seek to its start, and drop into drawing mode ("select a range → you're drawing").
(defn- select-range-fx [db gid g lo hi] (defn- select-range-fx [db gid g lo hi]
(let [scene (:scene db) (let [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))) pgid (keyword (str "prox-" (random-uuid)))
mid (str (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) {:db (-> db (assoc-in [:scene :groups pgid] p)
(update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid)) (update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid))
(assoc-in [:view :active-mark] mid) (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)) (assoc-in [:view :pt] :new))
:player/seek (when sf (/ sf (:fps db))) :player/seek (when sf (/ sf (:fps db)))
:fx [[:dispatch [::start-drawing gid mid]]]})) :fx [[:dispatch [::start-drawing gid mid]]]}))
@ -735,9 +911,23 @@
(fn [{:keys [db]} [_ seg-id frame]] (fn [{:keys [db]} [_ seg-id frame]]
(let [scene (:scene db) (let [scene (:scene db)
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene)) [gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
segs (scene/content-segments scene (:parent g)) segs (scene/content-segments scene (scene/home scene gid))
pt (get-in db [:view :pt])] 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)) (let [a (scene/seg-local segs (:seg pt) (:f pt))
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))) b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))
lo (min a b) hi (max a b) lo (min a b) hi (max a b)
@ -746,7 +936,7 @@
;; re-picking an endpoint: reconcile-run keeps the mark id for the ;; 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 ;; piece on the kept clip; re-attach that mark's bindings, and splice
;; the run back into its original slot so order is preserved. ;; 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)) (mapv (fn [m] (if (= (:id m) (:id old))
(cond-> m (cond-> m
(:notes old) (assoc :notes (:notes old)) (:notes old) (assoc :notes (:notes old))
@ -758,6 +948,8 @@
(assoc-in [:view :pt] :new))}) (assoc-in [:view :pt] :new))})
;; new selection (two-click): same completion as a timeline drag. ;; new selection (two-click): same completion as a timeline drag.
(select-range-fx db gid g lo hi))) (select-range-fx db gid g lo hi)))
:else
{:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})})))) {:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})}))))
;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned ;; 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]) pid (->> (get-in scene [:groups ann :marks])
(some #(when (= mark-id (:id %)) (get-in % [:start :ref])))) (some #(when (= mark-id (:id %)) (get-in % [:start :ref]))))
proxy (get-in scene [:groups pid]) 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)) 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))) la* (max 0 (min la (dec len)))
lb* (max (inc la*) (min lb len))] lb* (max (inc la*) (min lb len))]
(if (= :proxy (:type proxy)) (if (= :proxy (:type proxy))
(assoc-in db [:scene :groups pid] (scene/roll-proxy scene ctx proxy la* lb*)) (assoc-in db [:scene :groups pid] (scene/roll-proxy scene ctx proxy la* lb*))
db)))) 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 ;; 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"). ;; 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 ;; We persist the attachment now (the marks + their proxies) and discard the draft
@ -802,6 +1011,9 @@
(fn [{:keys [db]} [_ draft-gid target-gid]] (fn [{:keys [db]} [_ draft-gid target-gid]]
(let [marks (get-in db [:scene :groups draft-gid :marks]) (let [marks (get-in db [:scene :groups draft-gid :marks])
orig-t (get-in db [:scene :groups target-gid]) orig-t (get-in db [:scene :groups target-gid])
;; adding marks does NOT change placement — membership is asserted, never
;; derived from where marks were authored. To also list C in this context,
;; file it in explicitly (the ＋ picker / drag).
target (update orig-t :marks (fnil into []) marks) target (update orig-t :marks (fnil into []) marks)
patch (group-patch orig-t target) ; just the :marks change patch (group-patch orig-t target) ; just the :marks change
proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref]) 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))

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

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

28
tl/src/tl/otio.cljs
View file

@ -13,8 +13,20 @@
(defn- clip? [item] (defn- clip? [item]
(str/starts-with? (:OTIO_SCHEMA item "") "Clip")) (str/starts-with? (:OTIO_SCHEMA item "") "Clip"))
(defn- frames [rational-time] (defn- timeline-frames
(:value rational-time)) "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 (defn- clip-starts
"Source start_time (frames) of every clip across all tracks." "Source start_time (frames) of every clip across all tracks."
@ -22,15 +34,15 @@
(for [t tracks (for [t tracks
c (:children t) c (:children t)
:when (clip? c)] :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] (defn- parse-track [media-offset idx track]
(loop [pos 0.0 (loop [pos 0
items (:children track) items (:children track)
ci 0 ci 0
clips (transient [])] clips (transient [])]
(if-let [item (first items)] (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)] is-clip (clip? item)]
(recur (+ pos dur) (recur (+ pos dur)
(rest items) (rest items)
@ -40,7 +52,7 @@
:name (:name item) :name (:name item)
:start pos ; timeline frame, 0-based :start pos ; timeline frame, 0-based
:duration dur :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 media-offset)}) ; frame into local .mov
clips))) clips)))
{:id idx {:id idx
@ -56,11 +68,11 @@
(let [tracks (get-in otio [:tracks :children]) (let [tracks (get-in otio [:tracks :children])
fps (get-in otio [:global_start_time :rate] 24) fps (get-in otio [:global_start_time :rate] 24)
starts (clip-starts tracks) 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))] parsed (vec (map-indexed (partial parse-track media-offset) tracks))]
{:fps fps {:fps fps
:media-offset media-offset :media-offset media-offset
:duration (reduce max 0.0 (for [t parsed :duration (reduce max 0 (for [t parsed
c (:clips t)] c (:clips t)]
(+ (:media-in c) (:duration c)))) (+ (:media-in c) (:duration c))))
:tracks parsed})) :tracks parsed}))

12
tl/src/tl/routes.cljs
View file

@ -2,7 +2,8 @@
(:require (:require
[clojure.string :as str] [clojure.string :as str]
[reitit.frontend :as reitit] [reitit.frontend :as reitit]
[reitit.frontend.easy :as rfe])) [reitit.frontend.easy :as rfe]
[tl.scene :as scene]))
(def routes (def routes
[["/" {:name :projects}] [["/" {:name :projects}]
@ -54,15 +55,18 @@
(into {} (map (fn [[k v]] [(keyword k) v]) (into {} (map (fn [[k v]] [(keyword k) v])
(:query-params match)))) (:query-params match))))
stack (some-> (:stack qp) (str/split #",")) 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-> {} (cond-> {}
(seq stack) (assoc :stack (mapv keyword stack)) (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] (defn project-url [id stack playhead]
(let [stack-param (->> (rest stack) (map name) (str/join ",")) (let [stack-param (->> (rest stack) (map name) (str/join ","))
query (query-string {:stack stack-param 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))) (str (href :project/show {:id id}) query)))
(defonce ^:private last-replaced (atom nil)) (defonce ^:private last-replaced (atom nil))

395
tl/src/tl/scene.cljs
View file

@ -16,6 +16,28 @@
(defn- grp [scene gid] (get-in scene [:groups gid])) (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 (defn- find-mark
"[owning-gid mark] for a mark id anywhere in the scene, or nil." "[owning-gid mark] for a mark id anywhere in the scene, or nil."
[scene mid] [scene mid]
@ -31,7 +53,10 @@
(defn local->source (defn local->source
"The source frame shown at local frame `lf` (clamped to the end)." "The source frame shown at local frame `lf` (clamped to the end)."
[segs lf] [segs lf]
(assert-frame "local frame" lf)
(or (some (fn [{:keys [src local]}] (or (some (fn [{:keys [src local]}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[c d] local [a _] src] (let [[c d] local [a _] src]
(when (and (<= c lf) (< lf d)) (+ a (- lf c))))) (when (and (<= c lf) (< lf d)) (+ a (- lf c)))))
segs) segs)
@ -40,7 +65,10 @@
(defn source->local (defn source->local
"Local frame for source frame `sf` (first segment containing it), or nil." "Local frame for source frame `sf` (first segment containing it), or nil."
[segs sf] [segs sf]
(assert-frame "source frame" sf)
(some (fn [{:keys [src local]}] (some (fn [{:keys [src local]}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[a b] src [c _] local] (let [[a b] src [c _] local]
(when (and (<= a sf) (< sf b)) (+ c (- sf a))))) (when (and (<= a sf) (< sf b)) (+ c (- sf a)))))
segs)) segs))
@ -48,21 +76,24 @@
(defn pieces (defn pieces
"Where source range [sa sb) lands in local coords: a list of [lo hi)." "Where source range [sa sb) lands in local coords: a list of [lo hi)."
[segs sa sb] [segs sa sb]
(assert-range "source range" [sa sb])
(vec (keep (fn [{:keys [src local]}] (vec (keep (fn [{:keys [src local]}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[a b] src [c _] local (let [[a b] src [c _] local
lo (max sa a) hi (min sb b)] lo (max sa a) hi (min sb b)]
(when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))]))) (when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))])))
segs))) segs)))
(defn merge-bars (defn merge-bars
"Coalesce [lo hi) ranges that meet at a frame boundary into single bars, so a "Coalesce [lo hi) ranges that meet at a boundary into single bars, so a
continuous selection spanning several clips reads as one piece. Endpoints snap continuous run spanning several clips reads as one piece. Ranges are half-open,
to whole frames first, which absorbs the sub-frame gaps OTIO's fractional so adjacent clips share a boundary (A.hi == B.lo) and merge exactly — no gap to
media offsets leave between adjacent clips; only a real (≥1 frame) gap splits." fudge. Called per-mark, so it never fuses two distinct marks."
[bars] [bars]
(reduce (fn [acc [lo hi]] (reduce (fn [acc [lo hi]]
(let [lo (js/Math.floor lo) hi (js/Math.ceil hi) (assert-range "bar" [lo hi])
[plo phi] (peek acc)] (let [[plo phi] (peek acc)]
(if (and plo (<= lo phi)) (if (and plo (<= lo phi))
(conj (pop acc) [plo (max phi hi)]) (conj (pop acc) [plo (max phi hi)])
(conj acc [lo hi])))) (conj acc [lo hi]))))
@ -72,8 +103,11 @@
(defn slice (defn slice
"Sub-segments of `segs` covering local range [la lb), src + local re-cut." "Sub-segments of `segs` covering local range [la lb), src + local re-cut."
[segs la lb] [segs la lb]
(assert-range "slice" [la lb])
(vec (vec
(keep (fn [{:keys [src local] :as seg}] (keep (fn [{:keys [src local] :as seg}]
(assert-range "segment source" src)
(assert-range "segment local" local)
(let [[a _] src [c d] local (let [[a _] src [c d] local
lo (max la c) hi (min lb d)] lo (max la c) hi (min lb d)]
(when (< lo hi) (when (< lo hi)
@ -86,23 +120,7 @@
;; --- resolution ---------------------------------------------------------- ;; --- resolution ----------------------------------------------------------
(declare resolve resolve-mark) (declare resolve resolve-mark home child-of?)
(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)})))
(defn- target-segs (defn- target-segs
"Resolved segments (local 0-based) of a referenceable id: a group (clip, "Resolved segments (local 0-based) of a referenceable id: a group (clip,
@ -115,33 +133,68 @@
(resolve-mark scene gid m)) (resolve-mark scene gid m))
:else nil)) :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 (defn- point-frame
"Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref "Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref
dangles." dangles."
[scene gid point] [scene gid point]
(cond (cond
(number? point) (number? point)
(let [parent (:parent (grp scene gid))] (let [parent (home scene gid)]
{:frame (if parent (local->source (resolve scene parent) point) point) {:frame (if parent (local->source (resolve scene parent) point) point)
:track nil}) :track nil})
(map? point) (map? point)
(when-let [{:keys [xs xe track thumb thumb-start]} (target-range scene (:ref point))] (when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range
(let [n (:at point) {:frame f})))
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
(defn- rebase (defn- shift-local
"Shift `sub`'s :local to start at 0 and stamp :mark = `id` (the mark now owns "Shift `sub`'s :local so the run starts at 0, WITHOUT touching :mark — pieces keep
these segments regardless of which target they were sliced from)." the identity of the target they were sliced from. This is the RAW recursion's
[id sub] 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)] (let [base (or (some-> sub first :local first) 0)]
(mapv (fn [s] (let [[c d] (:local s)] (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))) 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 (defn- instant-seg
"A zero-length segment at local frame `la` of `tsegs` (for an instant mark), "A zero-length segment at local frame `la` of `tsegs` (for an instant mark),
carrying that frame's src/track/thumb." carrying that frame's src/track/thumb."
@ -166,7 +219,7 @@
lb (at->l (:at end))] lb (at->l (:at end))]
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb)) (when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
(rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs 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 (if parent ; absolute, relative to parent
(rebase id (slice (resolve scene parent) start end)) (rebase id (slice (resolve scene parent) start end))
[{:mark id :track track :src [start end] :local [0 (- end start)] [{:mark id :track track :src [start end] :local [0 (- end start)]
@ -208,17 +261,56 @@
[scene gid] [scene gid]
(when-let [mid (first (broken-marks scene gid))] (when-let [mid (first (broken-marks scene gid))]
(let [ref (->> (:marks (grp scene gid)) (some #(when (= mid (:id %)) %)) :start :ref)] (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 -------------------------------- ;; --- what the current timeline is made of --------------------------------
(defn- content-mark-segs
"Context-local pieces of mark `m` for content-segments. A ref into a PROXY drills
in and exposes the proxy's per-clip run, each sub-clip mark kept individually
addressable (its own name/length/ref/trim, via shift-local) — instead of
collapsing every piece under `m`'s single id the way resolve does for the LANE
view (rebase). That collapse was the bug: drilling into a proxy-backed range made
every clip read with the FIRST piece's name + length, so sub-range selections
wouldn't save. Any OTHER mark — a plain clip ref, a single mark ref, an absolute
mark — is one piece and stays owned by `m` (resolve-mark), so nested marks there
remain annotation-relative, exactly as before this fix."
[scene gid {:keys [start end] :as m}]
(if (and (map? start) (= :proxy (:type (grp scene (:ref start)))))
(when-let [tsegs (seq (target-segs scene (:ref start)))]
(let [len (length tsegs)
at->l #(if (neg? %) (+ len % 1) %)
la (at->l (:at start))
lb (at->l (:at end))]
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
(shift-local (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
(resolve-mark scene gid m)))
(defn- content-resolve
"`resolve` for content-segments: lays a group's marks end to end, but each piece
keeps its underlying :mark (see content-mark-segs) so multi-clip marks don't
collapse to one addressable unit."
[scene gid]
(loop [[m & more] (:marks (grp scene gid)), off 0, out []]
(if (nil? m)
out
(if-let [segs (seq (content-mark-segs scene gid m))]
(let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs))
shifted (mapv (fn [s] (let [[c d] (:local s)]
(assoc s :local [(+ off c) (+ off d)])))
segs)]
(recur more (+ off len) (into out shifted)))
(recur more off out)))))
(defn content-segments (defn content-segments
"The clip-segments that make up context `ctx` — what you draw and select "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 against. An annotation's marks reference clips, so that's just `resolve` — but
root timeline doesn't enumerate its clips (they're a parentless pool), so with each piece kept distinct (see content-resolve), not flattened under the
there it's the pool laid at each clip's TIMELINE position (:start) with :src = annotation's own mark id. The root timeline doesn't enumerate its clips (they're
its source range — so the assembled program tiles contiguously even though a parentless pool), so there it's the pool laid at each clip's TIMELINE position
the underlying source frames are scattered (and fractional)." (:start) with :src = its source range — so the assembled program tiles
contiguously even though the underlying source frames are scattered (and
fractional)."
[scene ctx] [scene ctx]
(if (= :timeline (:type (grp scene ctx))) (if (= :timeline (:type (grp scene ctx)))
(->> (:groups scene) (->> (:groups scene)
@ -230,7 +322,7 @@
(assoc seg :mark gid :local [st (+ st (- sb sa))]))))) (assoc seg :mark gid :local [st (+ st (- sb sa))])))))
(sort-by (comp first :local)) (sort-by (comp first :local))
vec) vec)
(resolve scene ctx))) (content-resolve scene ctx)))
(defn- src-intersect (defn- src-intersect
"Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))." "Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))."
@ -240,46 +332,20 @@
:when (< lo hi)] :when (< lo hi)]
[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 (defn lane-bars
"Context-local display bars for annotation `gid`, grouped PER MARK: contiguous "Context-local display bars for annotation `gid`, grouped PER MARK: contiguous
pieces coalesce WITHIN a mark but never across marks, so two abutting-but- 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 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 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 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." the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments.
[scene ctx gid ctx-segs]
(->> (nested-src-marks scene ctx gid) `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) (partition-by :mark)
(mapcat (fn [ss] (mapcat (fn [ss]
(let [mid (:mark (first ss))] (let [mid (:mark (first ss))]
@ -287,12 +353,52 @@
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss)))))) (merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss))))))
vec)) vec))
(defn clip-loss? (defn mark-extent
"True when annotation `gid` loses any content once clipped to its immediate "EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true
parent annotation — it references frames outside the parent timeline, so it's min piece-start / max piece-end, without merge-bars. Endpoint editing must use
(partly) out of range there. Timeline/root parents contain everything." 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] [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)))) (when (and p (= :annotation (:type (grp scene p))))
(let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs))) (let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs)))
own (mapv :src (resolve scene gid))] own (mapv :src (resolve scene gid))]
@ -303,14 +409,19 @@
(defn selection->marks (defn selection->marks
"Split local range [la lb) of context `ctx` into a run of single-clip ref "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). 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] [scene ctx la lb]
(assert-range "selection" [la lb])
(mapv (fn [{:keys [mark src]}] (mapv (fn [{:keys [mark src]}]
(let [{:keys [xs]} (target-range scene mark) ;; :at is the target's OWN local frame (src->at), matching resolve-mark's
[a b] src] ;; 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 {:id (str (random-uuid)) ; string so it survives JSON
:start {:ref mark :at (- a xs)} :start {:ref mark :at (assert-frame "selection start offset" a')}
:end {:ref mark :at (- b xs)}})) :end {:ref mark :at (assert-frame "selection end offset" (+ a' (- b a)))}}))
(slice (content-segments scene ctx) la lb))) (slice (content-segments scene ctx) la lb)))
(defn reconcile-run (defn reconcile-run
@ -372,12 +483,6 @@
[segs mid f] [segs mid f]
(some (fn [{m :mark [c _] :local}] (when (= m mid) (+ c (or f 0)))) segs)) (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] (defn- restore-mark [m]
;; keep :id keyworded in lockstep with the refs that target it: a nested ;; 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 :proxy (update g :marks #(mapv restore-mark (or % []))) ; synthetic clip: just its run
:drawing g ; pure strokes + seed, JSON round-trips as-is :drawing g ; pure strokes + seed, JSON round-trips as-is
(-> g (-> g
(dissoc :parent) ; annotations are placed by :in alone
(update :marks #(mapv restore-mark (or % []))) (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))]))) migrate))])))
anns)) 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 (defn- clip-row
"Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time. "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."
[scene {:keys [start end]}] [scene {:keys [start end]}]
{:s {:seg (:ref start) :f (js/Math.round (at->frame scene (:ref start) (:at start)))} {:s (display-point scene start) :e (display-point scene end)})
:e {:seg (:ref end) :f (js/Math.round (at->frame scene (:ref end) (:at end)))}})
(defn mark-row (defn mark-row
"One editor row for a mark. A plain clip/subclip ref collapses to {:s :e} "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 clip mark-group per clip (source range + track), and the root timeline. The
otio is only a seed — nothing here reads it again. otio is only a seed — nothing here reads it again.
Frames are SNAPPED to whole integers here, at the one boundary where OTIO's Clip ranges are integer frame ranges. Fractional OTIO input is rejected before
fractional RationalTime enters: a frame-based tool has no meaning below a whole this point; from here on, frame math asserts instead of snapping."
frame, so we round once, at the source, and everything downstream (source
ranges, mark :at offsets, seeks, labels) stays frame-accurate by construction."
[{:keys [duration tracks]}] [{:keys [duration tracks]}]
(let [r (fn [x] (js/Math.round x)) (assert-frame "OTIO duration" duration)
vtracks (filter #(= :video (:kind %)) tracks) (let [vtracks (filter #(= :video (:kind %)) tracks)
track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks) track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks)
clips (into {} (for [t vtracks c (:clips t)] 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)) [(keyword (:id c))
{:type :clip :parent nil :name (:name 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")) :marks [{:id (keyword (str (:id c) "-m"))
:start (r (:media-in c)) :start media-in
:end (r (+ (:media-in c) (:duration c))) :end (+ media-in duration)
:track (keyword (str "t" (:index t)))}]}]))] :track (keyword (str "t" (:index t)))}]}])))]
{:tracks track-map {:tracks track-map
:groups (assoc clips :root {:type :timeline :parent nil :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))) (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 ---------------------------------------------------------------- ;; --- links ----------------------------------------------------------------
;; A link is a ref-point {:ref id :at n} — the same shape as a mark endpoint, so ;; 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 ;; 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` "Ref-point {:ref :at} for mark-time frame `f` within content-segment `seg`
(the convention selection->marks uses, so it resolves identically)." (the convention selection->marks uses, so it resolves identically)."
[scene {:keys [mark src]} f] [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 (defn- runs
"Contiguous runs of `gid`'s marks in `ctx`-local coords, each {:id :lo :len} "Contiguous runs of `gid`'s marks in `ctx`-local coords, each {:id :lo :len}
@ -544,15 +684,22 @@
[] pts))) [] pts)))
(defn jump-targets (defn jump-targets
"One target per discontinuity for an annotation's jump popover — labelled from "One target per discontinuity for an annotation's jump popover, labelled from the
the owning mark's clip ref + frame, the SAME basis the annotation editor uses CONTENT SEGMENT the run lands on in `ctx` — its clip/track id + the frame within
(clip-label of :ref), so the jump label can never disagree with the mark row. it. A mark's :start is its proxy-ref ({:ref proxy :at 0}), so display-point of it
Each: {:local <ctx frame to seek> :seg <clip ref> :f <mark-time frame>}." 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] [scene ctx gid]
(mapv (fn [{:keys [id lo]}] (let [csegs (content-segments scene ctx)]
(let [st (:start (some #(when (= id (:id %)) %) (:marks (grp scene gid))))] (mapv (fn [{:keys [lo]}]
{:local lo :seg (:ref st) :f (js/Math.round (at->frame scene (:ref st) (:at st)))})) (let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs)
(runs scene ctx gid))) (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 (defn linkables
"Pickable link targets within `ctx`, grouped for the autocomplete: one group "Pickable link targets within `ctx`, grouped for the autocomplete: one group
@ -572,7 +719,7 @@
(sort-by (comp first :local) segs))})))) (sort-by (comp first :local) segs))}))))
anns (->> (:groups scene) anns (->> (:groups scene)
(keep (fn [[gid g]] (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))) (not (:draft g)))
{:name (or (:name g) (name gid)) :kind :annotation {:name (or (:name g) (name gid)) :kind :annotation
:items (mapv (fn [{:keys [id lo len]}] :items (mapv (fn [{:keys [id lo len]}]
@ -582,14 +729,14 @@
(vec (concat (sort-by :name tracks) (sort-by :name anns))))) (vec (concat (sort-by :name tracks) (sort-by :name anns)))))
(defn path-to (defn path-to
"Stack path from :root down to `gid` following :parent links, or nil if an "Stack path from :root down to `gid` following primary-home links, or nil if an
ancestor is missing — an orphan whose parent context was deleted." ancestor is missing — an orphan whose home context was deleted."
[scene gid] [scene gid]
(loop [g gid, acc ()] (loop [g gid, acc ()]
(cond (cond
(= g :root) (vec (cons :root acc)) (= g :root) (vec (cons :root acc))
(or (nil? g) (not (contains? (:groups scene) g))) nil (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 (defn timelines
"Every reachable timeline you can open as a context — root, plus named child "Every reachable timeline you can open as a context — root, plus named child
@ -601,7 +748,7 @@
(keep (fn [[gid g]] (keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (not (:draft g))) (when (and (= :annotation (:type g)) (not (:draft g)))
(when-let [path (path-to scene gid)] (when-let [path (path-to scene gid)]
(let [parent (:parent g)] (let [parent (home scene gid)]
{:gid gid :name (or (:name g) (name gid)) {:gid gid :name (or (:name g) (name gid))
:in (if (or (nil? parent) (= :root parent)) :in (if (or (nil? parent) (= :root parent))
"root" (get-in scene [:groups parent :name] (name parent))) "root" (get-in scene [:groups parent :name] (name parent)))

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

@ -1,6 +1,7 @@
(ns tl.subs (ns tl.subs
(:require [clojure.string :as str] (:require [clojure.string :as str]
[re-frame.core :as rf] [re-frame.core :as rf]
[tl.filter :as filter]
[tl.scene :as scene])) [tl.scene :as scene]))
(rf/reg-sub ::status (fn [db] (get-in db [:load :status]))) (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). ;; :choosing (fresh draft — marks + title picker only) | :creating (full form).
(rf/reg-sub ::draft-stage (fn [db] (get-in db [:view :draft-stage]))) (rf/reg-sub ::draft-stage (fn [db] (get-in db [:view :draft-stage])))
(rf/reg-sub ::script-jump (fn [db] (get-in db [:view :script-jump]))) (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-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 ::region-focus (fn [db] (get-in db [:view :region-focus])))
(rf/reg-sub ::linking (fn [db] (get-in db [:view :linking]))) (rf/reg-sub ::linking (fn [db] (get-in db [:view :linking])))
(rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann]))) (rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann])))
@ -104,50 +108,111 @@
(fn [[scene stack] _] (fn [[scene stack] _]
(mapv (fn [gid] {:id gid :name (or (get-in scene [:groups gid :name]) (name gid))}) 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 ;; child annotations of the current context, with their bars in local coords
(rf/reg-sub (rf/reg-sub
::annotations ::all-annotations
:<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed] :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
(fn [[scene ctx segs hidden-tags revealed] _] (fn [[scene ctx segs revealed] _]
(let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g))) (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
(:groups scene))) exists? (fn [x] (contains? (:groups scene) x))
;; shown when every ancestor up to ctx is revealed: a direct child of ctx ;; each annotation → the mark-groups it's FILED UNDER (:in membership). A
;; always shows; a deeper annotation shows only if its parent is revealed ;; normal annotation has one; a linked one has several, so it lists under
;; AND that parent is itself shown. ;; each. Asserted, not derived from where marks resolve. Any :in host that
shown? (fn shown? [p] (or (= ctx p) ;; no longer exists (its group was deleted) is dropped; an annotation left
(and (revealed p) (shown? (get-in scene [:groups p :parent])))))] ;; 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) (->> (:groups scene)
(keep (fn [[gid g]] (keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (shown? (:parent g)) (when (= :annotation (:type g))
;; a hidden tag hides every annotation carrying it; the ;; VISIBILITY IS BY MEMBERSHIP (:in): an annotation shows in ctx
;; :untagged sentinel hides annotations with no tags ;; iff it's filed under ctx, or under a revealed host that itself
(let [tags (get-in g [:meta :tags])] ;; shows. Where its marks resolve only decides whether bars draw.
(not (or (some hidden-tags tags) (let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
(and (empty? tags) (contains? hidden-tags :untagged)))))) (when (shown? gid #{})
(let [bars (scene/lane-bars scene ctx gid segs) ; one bar per mark; distinct marks never fuse (let [reason (scene/broken-reason scene gid)
reason (scene/broken-reason scene gid)
oor (boolean (scene/clip-loss? scene gid)) oor (boolean (scene/clip-loss? scene gid))
hidden (get-in g [:meta :hidden])] hidden (get-in g [:meta :hidden])
{:id gid :parent (:parent g) 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") :name (:name g) :color (or (:color g) "#4e8fc2")
:content (:content g) :children (count (:marks g)) :content (:content g) :children (count (:marks g))
:nested (get nested gid 0) :nested (get nested gid 0)
:draft (boolean (:draft g)) :draft (boolean (:draft g))
;; every script-note bound anywhere in this annotation ;; every script-note bound anywhere in this annotation
;; (annotation-level + per-mark), deduped, still-existing only ;; (annotation-level + per-mark), deduped, still-existing only
:notes (->> (concat (:notes g) (mapcat :notes (:marks g))) :notes note-ids
distinct :script (vec (remove nil? note-text))
(filterv #(= :script-note (get-in scene [:groups % :type])))) :clips (vec clips)
:broken (boolean reason) :reason reason :oor oor :broken (boolean reason) :reason reason :oor oor
:hidden (boolean hidden) :hidden (boolean hidden)
:tags (vec (get-in g [:meta :tags])) :tags (vec (get-in g [:meta :tags]))
;; jump targets labelled from the marks' clip refs (same as ;; jump targets labelled from the marks' clip refs (same as
;; the editor) — not re-derived from a floored bar frame ;; the editor) — not re-derived from a display bar frame
:jumps (scene/jump-targets scene ctx gid) :jumps jumps
:start (or (ffirst bars) 0) :bars bars})))) :start (or (ffirst bars) 0) :bars bars}))))))
(sort-by (juxt :broken :start)) ; broken annotations sink to the bottom (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom
vec)))) 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 ;; every distinct tag used by any annotation in the project — feeds both the tag
;; adder's autocomplete and the timeline tag filter. ;; adder's autocomplete and the timeline tag filter.
(rf/reg-sub (rf/reg-sub
@ -160,11 +225,6 @@
(sort-by str/lower-case) (sort-by str/lower-case)
vec))) 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) — ;; the annotation the playhead is currently inside (or the latest one passed) —
;; drives the rolling highlight/scroll in the commentary ;; drives the rolling highlight/scroll in the commentary
(rf/reg-sub (rf/reg-sub
@ -218,7 +278,7 @@
(fn [[gid g]] (fn [[gid g]]
;; child annotations of the context OR the context annotation itself ;; child annotations of the context OR the context annotation itself
;; (pushing the owner onto the stack makes ctx that annotation) ;; (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) (let [src-segs (scene/resolve scene gid)
by-mark (group-by :mark src-segs) by-mark (group-by :mark src-segs)
->bars (fn [ss] (scene/merge-bars ->bars (fn [ss] (scene/merge-bars

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

File diff suppressed because it is too large Load diff

46
tl/test/tl/filter_test.cljs Normal file
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))))))

27
tl/test/tl/frame_policy_test.cljs Normal file
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)))))

15
tl/test/tl/routes_test.cljs Normal file
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"}})))))

227
tl/test/tl/scene_test.cljs
View file

@ -1,6 +1,7 @@
(ns tl.scene-test (ns tl.scene-test
(:require [cljs.test :refer-macros [deftest is testing]] (:require [cljs.test :refer-macros [deftest is testing]]
[tl.md :as md] [tl.md :as md]
[tl.otio :as otio]
[tl.scene :as s])) [tl.scene :as s]))
;; --- shared fixture ------------------------------------------------------- ;; --- shared fixture -------------------------------------------------------
@ -16,11 +17,13 @@
(defn with-group [scene gid g] (assoc-in scene [:groups gid] g)) (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 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. ;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips.
(def inter-x (def inter-x
(with-group base :ann-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) :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/s1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at 50}} ; src [0,50)
{:id :m/s2 :start {:ref :clip-b :at 0} :end {:ref :clip-b :at 50}} ; src [100,150) {:id :m/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) ;; Y inside X, referencing two of X's subclips (parent = :ann-x)
(def x+y (def x+y
(with-group inter-x :ann-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) :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) {: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 (deftest rearrange-and-gap-removal
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track" (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 (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)]}) :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})
segs (s/resolve scene :ann)] segs (s/resolve scene :ann)]
(is (= 200 (s/length segs))) (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" (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 ;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100
(let [scene (-> base (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} :marks [{:id :m/s :start {:ref :clip-a :at 20}
:end {:ref :clip-a :at 80}}]}) :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} :marks [{:id :m/y :start {:ref :m/s :at 0}
:end {:ref :m/s :at -1}}]})) :end {:ref :m/s :at -1}}]}))
seg (first (s/resolve scene :ann-y))] seg (first (s/resolve scene :ann-y))]
@ -85,14 +88,14 @@
(deftest tracks-by-membership (deftest tracks-by-membership
(testing "zoom includes exactly the tracks the marks touch" (testing "zoom includes exactly the tracks the marks touch"
(let [scene (with-group base :ann (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)]})] :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})]
(is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann))))))) (is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann)))))))
(deftest repeat-yields-two-pieces (deftest repeat-yields-two-pieces
(testing "a clip referenced twice renders at two local positions" (testing "a clip referenced twice renders at two local positions"
(let [scene (with-group base :ann (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) :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/r1 :clip-b 0 -1) ; B local [100,200)
(refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300) (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) (let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210)
scene (-> base scene (-> base
(with-group :prox p) (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)]})) :marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)] segs (s/resolve scene :ann)]
(is (= 170 (s/length segs))) ; 60 + 100 + 10 (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" (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 (let [p (s/make-proxy base :root 10 60) ; inside A only
scene (-> base (with-group :prox p) 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)]})) :marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)] segs (s/resolve scene :ann)]
(is (= 1 (count (:marks p)))) (is (= 1 (count (:marks p))))
@ -217,18 +220,18 @@
(let [p1 (s/make-proxy base :root 0 200) ; A+B (let [p1 (s/make-proxy base :root 0 200) ; A+B
p2 (s/make-proxy base :root 200 300) ; C (abuts B) p2 (s/make-proxy base :root 200 300) ; C (abuts B)
scene (-> base (with-group :p1 p1) (with-group :p2 p2) 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) :marks [(s/proxy-ref :m/1 :p1)
(s/proxy-ref :m/2 :p2)]})) (s/proxy-ref :m/2 :p2)]}))
segs (s/content-segments scene :root) 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 :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] (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 ;; and a single cross-clip proxy on its own is one contiguous bar
(let [one (-> base (with-group :p1 p1) (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)]}))] :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 (deftest proxy-survives-restore-roundtrip
(testing "a proxy group (string :type/:parent, string mark ids/refs from JSON) (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}}]}} {:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}}
back (:prox (s/restore-annotations json-like)) back (:prox (s/restore-annotations json-like))
scene (-> base (with-group :prox back) 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)]}))] :marks [(s/proxy-ref :m/px :prox)]}))]
(is (= :proxy (:type back))) (is (= :proxy (:type back)))
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded (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 (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 ;; Suite 3 — playhead & playback
;; ========================================================================= ;; =========================================================================
@ -294,18 +407,55 @@
(is (= #{:t0 :t1} (s/tracks segs))) (is (= #{:t0 :t1} (s/tracks segs)))
(is (= 200 (s/length segs))))))) (is (= 200 (s/length segs)))))))
(deftest from-otio-snaps-fractional-frames (deftest otio-normalizes-source-starts-and-rejects-fractional-durations
(testing "OTIO's fractional RationalTime is rounded to whole frames at seed" (testing "fractional OTIO source starts are normalized at import"
(let [parsed {:fps 24 :duration 199.6 (let [clip {:OTIO_SCHEMA "Clip.2"
:tracks [{:index 0 :kind :video :name "W" :name "a"
:clips [{:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4}]}]} :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) scene (s/from-otio parsed)
mark (first (get-in scene [:groups :t0-c0 :marks]))] media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))]
(is (= 0 (get-in scene [:groups :t0-c0 :start]))) ; 0.2 -> 0 (is (seq media-ins))
(is (= 189 (:start mark))) ; media-in 188.87 -> 189 (is (every? integer? media-ins))
(is (= 289 (:end mark))) ; 188.87+100.4=289.27 -> 289 (is (every? integer? (mapcat (fn [[_ g]]
(is (= 200 (get-in scene [:groups :root :marks 0 :end]))) ; 199.6 -> 200 (mapcat (juxt :start :end) (:marks g)))
(is (every? integer? [(:start mark) (:end mark)]))))) (: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) ;; Suite 4 — draft rows <-> marks (the two-input editor)
@ -327,7 +477,7 @@
(deftest frames-are-mark-time-under-parent-trim (deftest frames-are-mark-time-under-parent-trim
(testing "frames are 0-based within the TRIMMED segment, not raw clip time" (testing "frames are 0-based within the TRIMMED segment, not raw clip time"
(let [scene (with-group base :p (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}}]}) :marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]})
segs (s/content-segments scene :p)] segs (s/content-segments scene :p)]
(is (= 60 (s/seg-length segs :m/s))) ; trimmed length, not 100 (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 (= 0 (get-in (first marks) [:start :at])))
(is (= 30 (get-in (first marks) [:end :at]))))))) (is (= 30 (get-in (first marks) [:end :at])))))))
(deftest merge-bars-coalesces-continuous-run (deftest merge-bars-coalesces-continuous-integer-runs
(testing "sub-frame OTIO gaps collapse to one bar; a real gap stays split" (testing "integer-adjacent bars merge; fractional bars fail"
;; foobar's real bars (continuous 5-clip selection, ~0.9-frame source gaps)
(is (= [[128 542]] (is (= [[128 542]]
(s/merge-bars [[128.87 190.87] [191.80 265.80] [266.73 384.73] (s/merge-bars [[128 191] [191 266] [266 386]
[385.61 413.61] [414.58 541.58]]))) [386 414] [414 542]])))
(is (= [[0 50] [200 260]] (s/merge-bars [[0 50] [200 260]]))) ; real gap → two (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 []))))) (is (= [] (s/merge-bars [])))))
(deftest restore-annotations-rekeywordizes-json (deftest restore-annotations-rekeywordizes-json
@ -354,7 +504,8 @@
:end {:ref "clip-a" :at -1}}]}} :end {:ref "clip-a" :at -1}}]}}
g (:ann-1 (s/restore-annotations json-like))] g (:ann-1 (s/restore-annotations json-like))]
(is (= :annotation (:type g))) (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]))) (is (= :clip-a (get-in g [:marks 0 :start :ref])))
(let [scene (assoc-in base [:groups :ann-1] g)] (let [scene (assoc-in base [:groups :ann-1] g)]
(is (= [0 100] (:src (first (s/resolve scene :ann-1))))))))) (is (= [0 100] (:src (first (s/resolve scene :ann-1)))))))))
@ -365,9 +516,9 @@
(deftest annotations-survive-json-roundtrip (deftest annotations-survive-json-roundtrip
(testing "restore-annotations is the exact inverse of the JSON wire trip — guards (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" 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}]} :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}}]}}] :marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}]
(is (= anns (s/restore-annotations (json-roundtrip anns))))))) (is (= anns (s/restore-annotations (json-roundtrip anns)))))))
@ -424,7 +575,7 @@
(deftest repeats-are-unambiguous (deftest repeats-are-unambiguous
(testing "two instances of A share a source frame but distinct locals (local is master)" (testing "two instances of A share a source frame but distinct locals (local is master)"
(let [scene (with-group base :ann (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)]}) :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)] segs (s/resolve scene :ann)]
(is (= 5 (s/local->source segs 5))) ; first A (is (= 5 (s/local->source segs 5))) ; first A
@ -456,9 +607,9 @@
(deftest path-to-builds-stack-and-drops-orphans (deftest path-to-builds-stack-and-drops-orphans
(let [scene {:groups {:root {:type :timeline :parent nil} (let [scene {:groups {:root {:type :timeline :parent nil}
:a {:type :annotation :parent :root} :a {:type :annotation :in [:root]}
:b {:type :annotation :parent :a} :b {:type :annotation :in [:a]}
:orphan {:type :annotation :parent :gone}}}] :orphan {:type :annotation :in [:gone]}}}]
(testing "path is root → … → target" (testing "path is root → … → target"
(is (= [:root] (s/path-to scene :root))) (is (= [:root] (s/path-to scene :root)))
(is (= [:root :a] (s/path-to scene :a))) (is (= [:root :a] (s/path-to scene :a)))