diff --git a/.dockerignore b/.dockerignore
index b34e0f5..0b333ca 100644
--- a/.dockerignore
+++ b/.dockerignore
@@ -1,24 +1,16 @@
.git
-.venv
-**/__pycache__
-**/*.pyc
-
-tl/node_modules
-tl/.shadow-cljs
-tl/target
+**/.venv
+**/node_modules
+**/.shadow-cljs
+**/target
tl/resources/public/js/compiled
-
-*.log
-*.log.*
-*.mbtree
-*.mp4
-*.mov
-*.mkv
-*.avi
-*.pdf
-
-thinking.org
-
-staticfiles
-media
+**/__pycache__/
db.sqlite3
+media/
+staticfiles/
+*.mp4
+*.pdf
+*.log
+*.mbtree
+thinking.org
+.DS_Store
diff --git a/tl/annotation_flow_plan.md b/tl/annotation_flow_plan.md
index f41c6da..4d088c6 100644
--- a/tl/annotation_flow_plan.md
+++ b/tl/annotation_flow_plan.md
@@ -86,13 +86,7 @@ So "the title is the autocomplete": one control forks create-vs-associate.
- [ ] Marks editor renders a proxy as ONE row (start clip/frame → end clip/frame), not N rows.
- [ ] Active mark highlighted in the pane, matching the lane.
-## Chunk 7 — Orphan / stability polish ✅
+## Chunk 7 — Orphan / stability polish
-- [x] Broken annotations sort to the bottom (existing sub) and are **greyed out** (opacity on the card) while staying visible so surviving marks stay usable; `△`/`⚠` warnings on the card (existing).
-- [x] **Per-mark broken indicator** in the editor: broken mark rows show `△` + strike-through + dimmed (`scene/broken-marks` set); an annotation keeps rendering as long as ≥1 mark resolves.
-
-## Fundamental fix — per-mark lane interaction (not per-bar)
-
-Handles/drag were attached to each visual bar, so a mark rendered as N pieces got N handle pairs (handles at every clip boundary). Two root fixes:
-- [x] **Interaction decoupled from visual pieces**: colored bars are per-piece (pointer-events none for draft); a separate per-MARK layer spans the mark's whole extent = one draggable unit + exactly two end-handles + active ring. Robust no matter how many pieces a mark has.
-- [x] **`merge-bars` absorbs ≤1-frame gaps**: independent frame-rounding of clip `:start` could leave a 1-frame gap between adjacent clips and spuriously split a mark's bar; a 1-frame gap is a rounding artifact, not real discontinuity, so it now coalesces (still per-mark, never fuses distinct marks).
+- [ ] Grey-out + drop orphaned annotations to bottom of list with warn indicator.
+- [ ] Per-mark broken-ref warnings; keep annotation if at least one mark still resolves.
diff --git a/tl/data_model.org b/tl/data_model.org
index 086a75c..547ce0d 100644
--- a/tl/data_model.org
+++ b/tl/data_model.org
@@ -34,9 +34,3 @@ decided: a clip/subclip-ref mark never crosses a clip boundary, so the "range wh
this brings us to playing. since right now there is only one source video file, we need to be able to seek to arbitrary frames. each context (mark-group) keeps its own local playhead, used when it's the top of the timeline stack. when we hit play, in the example above of annotation X, we find the clip under the playhead, compute the source frame, seek there, and start playing. one correction though: the local playhead has to be the master clock, not the video. you can't derive local position from currentTime -- once an annotation repeats or reorders clips, one source frame maps to several local frames, it's not invertible. so the local playhead advances on its own (wall-clock x fps while playing), and every frame we compute expected = group->media(local) and seek the video there only if round(currentTime*fps) != expected. within a clip, expected tracks the video's natural playback so no seek fires; at a mark boundary it jumps once and we seek. and right -- no recursion at play time: we resolve the current context once into flat ordered spans, and group->media is just the flat lookup the renderer already does.
# how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation.
# automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit.
-
-
-* update!
-- ok so the idea is this. you hit the new annotation button. it does not auto-select a mark for you. you can either click the clip, click the frame button, or drag a range. after you select a range, you are automatically in drawing mode. your drawings are connected to the mark, not the annotation. a mark should only ever appear in one annotation. instead of creating a new annotation mark group by default, this mode also allows you to either create new or associate with an existing annotation. associate with existing gives you our dropdown with only other annotations available. when you pick one, you effectively go into "edit" mode on that annotation with the new marks suddenly added. so this is basically our "transclusion": we can have annotations with marks embedded in other timelines. this is great for if we have subdivided our analysis into "chapters" but want to annotate shared concepts across them while keeping the main annotation pane clear. it's organized. so the big thing is that you don't create the annotation, you create the mark(s) first, then either create or assoc the annotation.
-- another crucial thing: if we click and drag and it spans multiple clips, the range we have in our create/add annotation UI in the annotation pane should only show the start and end points relative to the clips at start and end. so the way this will work is we will create a mark group that's not an annotation as our "proxy" marks so that they don't appear in the ui that spans the full range and contains the full sequential clips, and then the mark group on the annotation that contains that mark group will just use that mark group as start and end as if it had been clicked. so, for example: there's clips A, B, C and D contiguous. user drags region from clip A to clip D. in the UI, we should see that our mark starts at clip A frame 0 and ends at clip D last frame, so we need to "pass through" the synthetic unnamed non-annotation mark group to the underlying clips, the synthetic unnamed non-annotation mark group is a proxy.. so that proxy mark group has marks that go from clip A start-clip A end, clip B start - clip B end, clip C start to clip C end, and clip D start to clip D end. makes sense? so what do we do if the user wants to drag adjust endpoint in UI? let's say there's another clip before clip A called clip 0. we move start point BACK to clip 0 frame 50. well, our main mark group just shows the range as we would expect: clip 0 frame 50 TO clip D last frame. but the proxy mark group? it has a new mark range with new mark id at the beginning, but the other mark ids are stable. and the same is true of rolling the end point forward: new mark id, new range, rest are stsable. what if we roll the endpoints inward? same principle but we kill off mark ranges instead of adding new ones. should be clean. so this means we needs we need to change how draft/edit marks look/act in the lane. when in draft/edit mode, clicking on the mark brings up drawing mode for that mark (there can still be a button next to the mark in the edit pane). you can drag the whole mark left to right. and you can also grab handles on the edges of the annotation left to right. and since we consider whatever last created or last touched mark to be the "active" one for associating drawings to, we need to have that visually represented in the timeline, and in the pane where the draft marks or edit annotation is. and these need to share the same look for the mark range,s its only the stuff above it that iwll change. make sense?
-- note: when we talk about rolling the whole clip around, we know that the mark ids are going to change if we highlight one clip, unhighlight, then return back. this means that if we annotated a range defined w/r/t that annotation, the underlying gids are broken forever, even if they're rolled back. so that they exist still, right? since the underlying clips will never change, i wonder if we could just give each clip a stable identifier and define our root-most ranges in terms of those stable identifiers? or is that worse? idk
diff --git a/tl/package.json b/tl/package.json
index 85053d1..df70558 100644
--- a/tl/package.json
+++ b/tl/package.json
@@ -5,7 +5,6 @@
"dev": "bash dev/dev.sh",
"media": "python3 dev/media_server.py",
"watch": "npx shadow-cljs watch app",
- "test": "npx shadow-cljs compile test && node target/node-tests.js",
"release": "npx shadow-cljs release app",
"build-report": "npx shadow-cljs run shadow.cljs.build-report app target/build-report.html"
},
diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css
index e5058b7..eac3ea9 100644
--- a/tl/resources/public/css/app.css
+++ b/tl/resources/public/css/app.css
@@ -55,20 +55,20 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
press. The default action (.save) gets the heavy Mac "default button" ring. */
.jump-btn, .add-btn, .edit-btn, .del-btn, .expand-btn, .back-btn, .crumb,
.play-btn, .step-btn, .row-x, .add-mark, .save, .cancel, .hl-ok, .hl-cancel,
-.pane-tabs button, .track-toggle, .mark-script, .mark-script-new {
+.pane-tabs button, .track-toggle {
font-family: var(--chicago); background: var(--paper); color: var(--ink);
border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; line-height: 1.3;
}
.jump-btn:hover, .add-btn:hover, .edit-btn:hover, .del-btn:hover, .expand-btn:hover,
.back-btn:hover, .crumb:hover, .play-btn:hover, .step-btn:hover, .row-x:hover,
.add-mark:hover, .save:hover, .cancel:hover, .hl-ok:hover, .hl-cancel:hover,
-.pane-tabs button:hover, .track-toggle:hover, .mark-script:hover, .mark-script-new:hover {
+.pane-tabs button:hover, .track-toggle:hover {
background: var(--hover);
}
.jump-btn:active, .add-btn:active, .edit-btn:active, .del-btn:active, .expand-btn:active,
.back-btn:active, .crumb:active, .play-btn:active, .step-btn:active, .row-x:active,
.add-mark:active, .save:active, .cancel:active, .hl-ok:active, .hl-cancel:active,
-.pane-tabs button:active, .track-toggle:active, .mark-script:active, .mark-script-new:active {
+.pane-tabs button:active, .track-toggle:active {
background: var(--ink); color: var(--paper);
}
@@ -101,13 +101,10 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
background: none; cursor: pointer; }
.draw-tools .draw-wid { width: 56px; }
.draw-done { font-weight: bold; }
-.mark-draw, .mark-script {
- width: 28px; height: 26px; flex: none;
- display: inline-flex; align-items: center; justify-content: center;
- border-radius: 0; font-size: 13px; cursor: pointer; padding: 0; line-height: 1;
-}
-.mark-draw { background: var(--paper); color: var(--ink); border: 1px solid var(--ink); }
-.mark-draw.has, .mark-script.has { background: var(--desktop); background-size: 4px 4px; }
+.mark-draw { background: none; border: 1px solid transparent; border-radius: 0;
+ font-size: 12px; cursor: pointer; padding: 0 3px; line-height: 1; }
+.mark-draw:hover { border-color: var(--ink); }
+.mark-draw.has { border-color: var(--ink); background: var(--paper); }
.frame-readout {
position: absolute; bottom: 6px; right: 8px; z-index: 4;
@@ -212,13 +209,10 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.form {
flex: 1; min-width: 0; overflow-y: auto;
background: var(--paper); border: 1px solid var(--ink); box-sizing: border-box;
- padding: 12px;
- display: flex; flex-direction: column; gap: 12px;
-}
-.form-head {
- font-family: var(--chicago); font-size: 14px; color: var(--ink);
- padding-bottom: 6px; border-bottom: 2px solid var(--ink);
+ padding: 10px 12px;
+ display: flex; flex-direction: column; gap: 10px;
}
+.form-head { font-family: var(--chicago); font-size: 14px; color: var(--ink); }
.form-row { display: flex; gap: 8px; align-items: center; }
.form-name { flex: 1; }
.form input[type=text], .form-name, .form-content {
@@ -230,7 +224,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.form-content { width: 100%; min-height: 70px; resize: vertical; box-sizing: border-box;
font-family: inherit; }
.form-marks-label { font-family: var(--chicago); font-size: 11px; letter-spacing: .5px;
- color: var(--ink); margin-top: 2px; padding-top: 2px; }
+ color: var(--ink); margin-top: 4px; }
/* contenteditable content surface + inline link chips */
.content-editor { white-space: pre-wrap; word-break: break-word; outline: none; cursor: text;
@@ -245,11 +239,8 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.link-chip .link-f { font-size: 11px; opacity: .7; }
.link-chip:hover .link-f { opacity: 1; }
-.mark-row { display: flex; flex-wrap: wrap; align-items: center; gap: 6px; min-width: 0; }
-.mark-arrow {
- color: var(--ink); flex: none; font-family: var(--chicago);
- min-width: 16px; text-align: center;
-}
+.mark-row { display: flex; flex-wrap: nowrap; align-items: center; gap: 6px; min-width: 0; }
+.mark-arrow { color: var(--ink); }
.row-x, .add-mark { padding: 3px 8px; font-size: 12px; }
.add-mark { align-self: flex-start; }
@@ -260,7 +251,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
/* point editor + autocomplete */
.pt-input { position: relative; flex: 1 1 130px; display: flex; align-items: center; min-width: 0; }
-.mark-row .pt-input { flex: 1 1 128px; max-width: 190px; }
+.mark-row .pt-input { flex: 0 1 160px; max-width: 180px; }
.pt-text {
flex: 1; min-width: 0; box-sizing: border-box;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
@@ -286,18 +277,11 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.link-insert { display: flex; align-items: flex-start; gap: 6px; align-self: stretch; }
.link-insert .pt-input { flex: 1 1 auto; max-width: none; }
-.link-insert-block .pt-input { flex: 1 1 220px; max-width: none; }
.hl-ok, .hl-cancel { padding: 2px 9px; font-size: 12px; }
-.pt-chip { flex: 1 1 128px; min-width: 0; display: flex; align-items: center; gap: 4px;
+.pt-chip { flex: 1 1 0; min-width: 0; display: flex; align-items: center; gap: 4px;
background: var(--paper); border: 1px solid var(--ink); border-radius: 0;
- 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; }
+ padding: 2px 4px; }
.pt-chip-name { font-size: 12px; color: var(--ink); white-space: nowrap;
overflow: hidden; text-overflow: ellipsis; flex: 1; }
.pt-frame { width: 56px; background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
@@ -333,22 +317,6 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.ann-tags .tag { font-size: 9px; padding: 0 6px 0 12px; line-height: 1.6; border-radius: 2px 8px 8px 2px; }
.ann-tags .tag::before { width: 3px; height: 3px; left: 5px; }
-/* the `in:` membership row — where this annotation is filed (:in edges) */
-.ann-in { display: flex; flex-wrap: wrap; align-items: center; gap: 4px; margin-top: 5px; }
-.ann-in-label { font-size: 9px; color: var(--muted, #888); text-transform: uppercase; letter-spacing: .04em; }
-.in-chip { display: inline-flex; align-items: center; gap: 2px; font-size: 9px;
- padding: 0 5px; line-height: 1.7; background: var(--shade); color: var(--ink);
- border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; }
-.in-chip:hover { background: var(--ink); color: var(--paper); }
-.in-x, .in-plus { font-size: 9px; line-height: 1; padding: 0 1px; background: none;
- border: none; color: inherit; cursor: pointer; opacity: .6; }
-.in-x:hover, .in-plus:hover { opacity: 1; }
-.in-plus { border: 1px dashed var(--ink); border-radius: 8px; padding: 0 5px; line-height: 1.6; opacity: .7; }
-.in-add-pop { display: inline-flex; align-items: center; gap: 2px; }
-.in-add-pop .ac { min-width: 140px; }
-/* a card filed here whose footage doesn't land here — reference only, no bars */
-.ann.reference { border-style: dashed; opacity: .78; }
-
/* reveal-children toggle at the card bottom + the nested child cards */
.show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px;
font-family: var(--chicago); font-size: 11px; text-align: left;
@@ -381,20 +349,6 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.ac .pt-dropdown li { display: flex; align-items: center; justify-content: space-between; gap: 6px; }
.tag-eye { font-size: 12px; flex: none; }
.pt-x:hover { text-decoration: underline; }
-.annotation-filter {
- display: flex; align-items: center; gap: 6px; flex-wrap: wrap;
- padding: 6px 8px; border-bottom: 1px solid var(--ink); background: var(--paper);
-}
-.annotation-search {
- flex: 1 1 220px; min-width: 0; box-sizing: border-box;
- background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
- border-radius: 0; padding: 5px 7px; font-family: var(--geneva); font-size: 12px;
-}
-.annotation-filter .filter-btn { border-radius: 0; }
-.filter-summary {
- margin-left: auto; display: inline-flex; align-items: center; gap: 6px;
- font-size: 11px; color: var(--mute);
-}
.form-hint { font-size: 11px; color: var(--mute); }
.form-check { display: flex; align-items: center; gap: 6px; font-family: var(--chicago);
@@ -704,17 +658,6 @@ html.dark .timeline-head {
.zoom-read { font-size: 11px; color: var(--ink); min-width: 42px; text-align: center; }
.script-empty { color: var(--mute); font-size: 12px; padding: 20px; }
.ann.selected { box-shadow: inset 3px 0 0 var(--ink); }
-.script-return {
- display: flex; align-items: center; gap: 8px; flex-wrap: wrap;
- padding: 6px 10px; border-bottom: 2px solid var(--ink);
- background: var(--desktop); background-size: 4px 4px;
- font-family: var(--chicago); font-size: 11px;
-}
-.script-return .hl-cancel { border-radius: 0; padding: 2px 8px; }
-.script-return-text {
- display: inline-block; background: var(--paper); border: 1px solid var(--ink);
- padding: 2px 6px; box-shadow: 1px 1px 0 var(--ink);
-}
/* note rail (list of project script-notes) */
.note-rail { display: flex; align-items: center; gap: 8px; flex-wrap: wrap;
@@ -752,42 +695,21 @@ html.dark .timeline-head {
font-size: 11px; border: 1px solid var(--mute); border-radius: 0; padding: 3px; background: var(--paper); color: var(--ink); }
/* binding notes to annotations/marks (annotation form + cards) */
-.mark-block {
- margin-bottom: 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); }
+.mark-block { margin-bottom: 4px; }
/* the currently-selected/last-touched mark while authoring — so you know which
one a drawing binds to, and which you're about to delete */
-.mark-block.active-mark {
- background: var(--desktop); background-size: 4px 4px;
- box-shadow: inset 4px 0 0 var(--ink), 2px 2px 0 var(--ink);
-}
-.mark-block.broken { opacity: 0.6; }
-.mark-block.broken .pt-chip-name { text-decoration: line-through; }
-.mark-note-list {
- display: flex; flex-wrap: wrap; gap: 4px;
- margin: 5px 0 0 24px;
-}
-.mark-script-wrap { position: relative; display: inline-flex; flex: none; }
-.mark-script-pop {
- position: absolute; right: 0; top: calc(100% + 4px); z-index: 21;
- width: 210px; padding: 6px;
- background: var(--paper); border: 1px solid var(--ink); box-shadow: 2px 2px 0 var(--ink);
-}
-.mark-script-pop .pt-input { display: block; max-width: none; }
-.mark-script-pop .pt-dropdown { position: static; margin-top: 4px; box-shadow: none; }
-.mark-script-new {
- width: 100%; margin-top: 6px; padding: 5px 8px;
- border-radius: 0; text-align: left; font-size: 11px;
-}
+.mark-block.active-mark { box-shadow: inset 3px 0 0 var(--ink); background: var(--shade, rgba(128,128,128,.14));
+ border-radius: 2px; padding: 2px 0 2px 3px; margin-left: -3px; }
+.note-drop { display: flex; align-items: center; flex-wrap: wrap; gap: 4px; min-height: 20px;
+ margin: 2px 0 2px 14px; padding: 2px 4px; border: 1px dashed var(--mute); border-radius: 0; }
+.note-drop-label { font-size: 10px; color: var(--mute); }
+.note-drop-hint { font-size: 10px; color: var(--mute); font-style: italic; }
+.note-source { display: flex; flex-wrap: wrap; gap: 4px; margin: 4px 0; }
+.note-src { display: inline-flex; align-items: center; gap: 4px; font-size: 11px; cursor: grab;
+ background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 1px 6px; }
+.note-src:active { cursor: grabbing; }
.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: 1px 4px;
- cursor: pointer; }
+ background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 0 4px; }
.bound-note.live { background: var(--ink); color: var(--paper); }
.bound-note-name { max-width: 120px; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }
.note-live { font-weight: bold; }
@@ -859,7 +781,6 @@ html.dark .timeline-head {
padding: 0 2px; font-size: 13px; line-height: 1; flex: none; align-self: center;
}
.mark-grip:active { cursor: grabbing; }
-.mark-grip.disabled { cursor: default; opacity: .35; }
.mark-block.dragging { opacity: 0.4; }
.mark-block.drop-before { position: relative; }
.mark-block.drop-before::before {
diff --git a/tl/shadow-cljs.edn b/tl/shadow-cljs.edn
index c4a87c1..ba215ec 100644
--- a/tl/shadow-cljs.edn
+++ b/tl/shadow-cljs.edn
@@ -9,7 +9,6 @@
[re-frame "1.4.7"]
[metosin/reitit "0.9.1"]
[day8.re-frame/http-fx "0.2.4"]
- [day8.re-frame/test "0.1.5"]
[binaryage/devtools "1.0.7"]]
:dev-http
@@ -20,10 +19,7 @@
{:test
{:target :node-test
:output-to "target/node-tests.js"
- :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(){}};"}
+ :ns-regexp "-test$"}
:app
{:target :browser
diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs
index e5773f5..619033c 100644
--- a/tl/src/tl/events.cljs
+++ b/tl/src/tl/events.cljs
@@ -75,7 +75,7 @@
(let [stack (vec (valid-stack scene stack))
ctx (peek stack)]
(cond-> (assoc view :stack stack)
- playhead (assoc-in [:playheads ctx] (scene/assert-frame "route playhead" playhead)))))
+ playhead (assoc-in [:playheads ctx] playhead))))
(defn- route-state [db]
(let [ctx (peek (get-in db [:view :stack]))]
@@ -332,18 +332,12 @@
(let [s (get-in db [:view :hidden-notes] #{})]
(assoc-in db [:view :hidden-notes] (if (contains? s gid) (disj s gid) (conj s gid))))))
-;; annotation-pane filters are inclusive: selected tags narrow the list to
-;; matching annotations.
-(rf/reg-event-db ::set-annotation-search
- (fn [db [_ q]] (assoc-in db [:view :annotation-filter :query] q)))
-(rf/reg-event-db ::toggle-annotation-tag-filter
+;; per-tag annotation visibility (view-only, ephemeral): eye toggles in the tag
+;; filter. A tag in :hidden-tags hides every annotation carrying it.
+(rf/reg-event-db ::toggle-tag-filter
(fn [db [_ tag]]
- (let [s (get-in db [:view :annotation-filter :tags] #{})]
- (assoc-in db [:view :annotation-filter :tags]
- (if (contains? s tag) (disj s tag) (conj s tag))))))
-(rf/reg-event-db ::clear-annotation-filter
- (fn [db _] (assoc-in db [:view :annotation-filter]
- {:query "" :tags #{}})))
+ (let [s (get-in db [:view :hidden-tags] #{})]
+ (assoc-in db [:view :hidden-tags] (if (contains? s tag) (disj s tag) (conj s tag))))))
;; click a highlight on the page → activate its note and focus that region's row
;; in the right pane
@@ -384,9 +378,6 @@
(merge {:id rid :kind :text :content ""} region))]
(merge {:db db} (persist-note-fx db gid)))))
-(defn- add-in [coll x] (vec (distinct (conj (vec coll) x))))
-(defn- rm-in [coll x] (vec (remove #(= x %) coll)))
-
;; select-then-highlight with no active note: spin up a note (named after the
;; selected text) with the region already in it, and make it active.
(rf/reg-event-fx ::highlight-into-new-note
@@ -399,18 +390,9 @@
:else t)
note {:type :script-note :name nm :color "#c2864e"
:regions [(merge {:id rid :kind :text :content ""} region)]}
- target (get-in db [:view :note-target])
db (-> db (assoc-in [:scene :groups gid] note)
(assoc-in [:view :active-note] gid)
- (assoc :save-error nil))
- ;; 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)]
+ (assoc :save-error nil))]
(merge {:db db} (persist-note-fx db gid)))))
;; commentary edits update the note locally (on-change); persist on blur so we
@@ -430,6 +412,9 @@
;; The pointer lives on the referrer (annotation or mark), so a shared note stays
;; pure and freely reusable. These mutate the draft in-place (db only) and ride
;; the annotation's Save, exactly like ::set-content and the marks editor.
+(defn- add-in [coll x] (vec (distinct (conj (vec coll) x))))
+(defn- rm-in [coll x] (vec (remove #(= x %) coll)))
+
(rf/reg-event-db ::bind-note-annotation
(fn [db [_ gid note-gid]]
(update-in db [:scene :groups gid :notes] #(add-in % note-gid))))
@@ -448,80 +433,6 @@
(fn [db [_ gid mark-id note-gid]]
(update-mark db gid mark-id #(update % :notes rm-in note-gid))))
-;; click a mark row to make it the active one (drawings/edits target it)
-(defn- drawing-state-for [db ann mark-id]
- (let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m)))
- (get-in db [:scene :groups ann :marks])))]
- {:ann ann :mark-id mark-id
- :gid (or existing (keyword (str "draw-" (random-uuid))))
- :new? (nil? existing)}))
-
-(defn- start-drawing-db [db ann mark-id]
- (-> db
- (assoc-in [:view :active-mark] mark-id)
- (assoc-in [:view :draw] (drawing-state-for db ann mark-id))))
-
-(defn- draft-in-ctx [db ctx]
- (some (fn [[gid g]]
- (when (and (:draft g) (= ctx (scene/home (:scene db) gid))) [gid g]))
- (get-in db [:scene :groups])))
-
-(defn- draft-mark-at [db ctx lf]
- (when-let [[gid g] (draft-in-ctx db ctx)]
- (let [scene (:scene db)
- segs (scene/content-segments scene ctx)]
- (some (fn [m]
- (when (some (fn [[lo hi]] (and (<= lo lf) (< lf hi)))
- (scene/mark-bars scene gid (:id m) segs))
- {:ann gid :mark-id (:id m)}))
- (:marks g)))))
-
-(defn- sync-draft-mark-for-playhead [db ctx lf]
- (if-let [{:keys [ann mark-id]} (draft-mark-at db ctx lf)]
- (if (= mark-id (get-in db [:view :active-mark]))
- db
- (start-drawing-db db ann mark-id))
- (if (draft-in-ctx db ctx)
- (-> db
- (assoc-in [:view :active-mark] nil)
- (assoc-in [:view :draw] nil))
- db)))
-
-(defn- mark-start-local [db ann mark-id]
- (let [scene (:scene db)
- ctx (scene/home scene ann)
- segs (scene/content-segments scene ctx)]
- (ffirst (scene/mark-bars scene ann mark-id segs))))
-
-;; click/select a mark row: make it the drawing target and move the playhead to it.
-(rf/reg-event-fx ::set-active-mark
- (fn [{:keys [db]} [_ mark-id]]
- (let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack])))
- (some (fn [[gid g]] (when (:draft g) [gid g]))
- (get-in db [:scene :groups])))
- ctx (scene/home (:scene db) ann)
- local (when ann (mark-start-local db ann mark-id))
- db (cond-> db
- ann (start-drawing-db ann mark-id)
- (and ctx local) (assoc-in [:view :playheads ctx] local))
- sf (when (and ctx local)
- (scene/local->source
- (scene/content-segments (:scene db) ctx) local))]
- (cond-> (sync-route {:db db} db)
- sf (assoc :player/seek (/ sf (:fps db)))))))
-
-;; "add a new script note for this mark": remember the target mark + hop to the
-;; Script pane. When a note is created there (highlight-into-new-note) it binds to
-;; the target and returns to the annotation; ::cancel-note-target backs out.
-(rf/reg-event-db ::new-note-for-mark
- (fn [db [_ gid mark-id]]
- (-> db (assoc-in [:view :note-target] {:gid gid :mark-id mark-id})
- (assoc-in [:view :active-note] nil)
- (assoc-in [:view :pane] :script))))
-(rf/reg-event-db ::cancel-note-target
- (fn [db _] (-> db (assoc-in [:view :note-target] nil)
- (assoc-in [:view :pane] :annotations))))
-
;; --- drawings -------------------------------------------------------------
;; A drawing is a first-class entity (:type :drawing) — a bag of normalized
;; strokes + a seed for its wiggle boil — bound to a mark via mark :drawings
@@ -533,7 +444,14 @@
;; gid. The entity isn't written until ::save-drawing, so cancel is a clean no-op.
(rf/reg-event-db ::start-drawing
(fn [db [_ ann mark-id]]
- (start-drawing-db db ann mark-id)))
+ (let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m)))
+ (get-in db [:scene :groups ann :marks])))]
+ (-> db
+ (assoc-in [:view :active-mark] mark-id) ; drawing a mark makes it the active one
+ (assoc-in [:view :draw]
+ {:ann ann :mark-id mark-id
+ :gid (or existing (keyword (str "draw-" (random-uuid))))
+ :new? (nil? existing)})))))
;; 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).
@@ -601,8 +519,7 @@
;; moved the stack, so snap back to the editing context before seeking the frame.
(rf/reg-event-fx ::preview-frame
(fn [{:keys [db]} [_ local]]
- (let [local (scene/assert-frame "preview frame" local)
- stack (get-in db [:view :linking :stack])
+ (let [stack (get-in db [:view :linking :stack])
ctx (peek stack)
db (-> db (assoc-in [:view :stack] stack)
(assoc-in [:view :playheads ctx] local))
@@ -612,10 +529,7 @@
(rf/reg-event-fx ::set-playhead
(fn [{:keys [db]} [_ 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))]
+ (let [next-db (assoc-in db [:view :playheads ctx] lf)]
(sync-route {:db next-db} next-db))))
(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p)))
;; reveal an annotation's immediate children into the current timeline lane
@@ -657,10 +571,9 @@
;; uuid, not gensym: gensym's counter resets each page load, so a
;; fresh annotation would reuse a prior gid and clobber it on merge.
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
- (let [ctx (peek (get-in db [:view :stack]))]
- {:type :annotation :in [ctx] ; filed under the context it's born in
- :draft :new :name "" :color "#4e8fc2" :marks []
- :v scene/schema-version}))
+ {:type :annotation :parent (peek (get-in db [:view :stack]))
+ :draft :new :name "" :color "#4e8fc2" :marks []
+ :v scene/schema-version})
(assoc-in [:view :pt] :new)
(assoc-in [:view :active-mark] nil)
(assoc-in [:view :draft-stage] :choosing))))
@@ -674,29 +587,12 @@
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new))))
-
-;; Edit an annotation from a card. If its primary home isn't the context being
-;; viewed, enter that home first so mark rows/handles edit in their authored
-;; coordinate system. finish-edit pops this temporary context.
-(rf/reg-event-fx
- ::edit-annotation
- (fn [{:keys [db]} [_ gid]]
- (let [home (scene/home (:scene db) gid)
- ctx (peek (get-in db [:view :stack]))
- push-home? (and home (not= home ctx))
- fx (if push-home? (enter-ctx db #(conj % home)) {:db db})]
- (update fx :db #(cond-> (-> %
- (assoc-in [:scene :groups gid :draft] :edit)
- (assoc-in [:view :pt] :new)
- (assoc-in [:view :edit-pop-parent] nil))
- push-home? (assoc-in [:view :edit-pop-parent] home))))))
-
;; Edit the annotation you're currently inside: drop into its parent timeline so
;; its marks are editable there, remembering to pop back when done. Root has no
;; parent (and no marks) — edit it in place.
(rf/reg-event-fx ::edit-here
(fn [{:keys [db]} [_ gid]]
- (let [root? (= :timeline (get-in db [:scene :groups gid :type]))
+ (let [root? (nil? (get-in db [:scene :groups gid :parent]))
fx (if root? {:db db} (enter-ctx db pop))]
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
@@ -705,18 +601,13 @@
(fn [{:keys [db]} _]
;; leaving the form (save OR cancel): tear down all authoring
;; transients so draw mode / pending points don't linger.
- (let [return-g (get-in db [:view :edit-return])
- pop? (some? (get-in db [:view :edit-pop-parent]))
- db (-> db (assoc-in [:view :draw] nil)
- (assoc-in [:view :active-mark] nil)
- (assoc-in [:view :pt] nil)
- (assoc-in [:view :draft-stage] nil)
- (assoc-in [:view :edit-return] nil)
- (assoc-in [:view :edit-pop-parent] nil))]
- (cond
- return-g (enter-ctx db #(conj % return-g))
- pop? (enter-ctx db #(if (> (count %) 1) (pop %) %))
- :else {:db db}))))
+ (let [db (-> db (assoc-in [:view :draw] nil)
+ (assoc-in [:view :active-mark] nil)
+ (assoc-in [:view :pt] nil)
+ (assoc-in [:view :draft-stage] nil))]
+ (if-let [g (get-in db [:view :edit-return])]
+ (enter-ctx (assoc-in db [:view :edit-return] nil) #(conj % g))
+ {:db db}))))
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
;; cancelling a draft is local only; saving a real annotation / deleting one
;; pushes a delta to the backend (which merges + attributes it).
@@ -731,7 +622,7 @@
(let [g (cond-> (editable-group g)
(= :annotation (:type g)) (assoc :v scene/schema-version))
patch (group-patch orig g)
- root? (= :timeline (:type g)) ; the root timeline persists whole
+ root? (nil? (:parent g)) ; the root timeline persists whole
id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks)
;; proxies this annotation references are synthetic clips in the pool —
;; persist them alongside it or the {:ref proxy} marks dangle on reload.
@@ -753,95 +644,40 @@
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))
-;; --- membership edges (:in): file an annotation under mark-groups ----------
-;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups
-;; the annotation is filed under; the FIRST is the primary home (scene/home) — where
-;; it's edited and its links resolve. Marks never move or re-cut — they resolve to
-;; raw clips globally, and that only decides whether BARS draw in a context. Three
-;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag /
-;; file-into picker), remove (× on a chip).
+;; --- move an annotation into another context (drag-drop reparent) ---------
+;; Changing :parent re-homes an annotation under a new context. Marks that no
+;; longer resolve there just skip (scene/resolve drops them) and reappear if the
+;; annotation is moved back — no data loss. Guard against cycles: never drop a
+;; group into itself or one of its own descendants (that would make the :parent
+;; chain loop forever, hanging path-to / resolve).
+(defn- descendant?
+ "Is `gid` equal to `anc` or somewhere below it in the :parent tree?"
+ [scene anc gid]
+ (loop [g gid]
+ (cond (nil? g) false
+ (= g anc) true
+ :else (recur (get-in scene [:groups g :parent])))))
-(defn- files-under?
- "Does `desc` reach `anc` by following :in edges (would nesting create a cycle)?"
- [scene desc anc seen]
- (boolean
- (when-not (contains? seen desc)
- (let [ins (scene/membership scene desc)]
- (or (contains? ins anc)
- (some #(and (= :annotation (get-in scene [:groups % :type]))
- (files-under? scene % anc (conj seen desc)))
- ins))))))
-
-(rf/reg-event-db
- ::ann-drag-start
- (fn [db [_ gid source-parent]]
- (-> db
- (assoc-in [:view :dragging-ann] gid)
- (assoc-in [:view :dragging-ann-source] source-parent))))
-
-(rf/reg-event-db
- ::ann-drag-end
- (fn [db _]
- (-> db
- (assoc-in [:view :dragging-ann] nil)
- (assoc-in [:view :dragging-ann-source] nil))))
-
-(defn- persist-group
- "fx map that stores annotation `gid` = `g*` locally and (if online) pushes just
- the changed fields to the backend."
- [db gid orig g*]
- (let [id (get-in db [:project :id])
- patch (group-patch orig g*)]
- (cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) (assoc :save-error nil))}
- (and id (seq patch))
- (assoc :http-xhrio (api/put-scene id {:changed {gid patch}}
- {:on-success [::scene-saved]
- :on-failure [::save-error]})))))
-
-;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps
-;; existing edges (link); otherwise the edge you grabbed is moved off its source.
-;; Marks are untouched either way.
-(defn- file-edge [db gid new-parent add? source]
- (let [scene (:scene db)
- g (get-in scene [:groups gid])
- in (vec (:in g))
- clear #(-> % (assoc-in [:view :dragging-ann] nil)
- (assoc-in [:view :dragging-ann-source] nil))]
- (if (or (not= :annotation (:type g)) ; only annotations file
- (:draft g) ; not mid-draft
- (= gid new-parent) ; not under itself
- (contains? (set in) new-parent) ; already filed there
- (files-under? scene new-parent gid #{})) ; would make a cycle
- {:db (clear db)}
- (let [in' (if add?
- (conj in new-parent) ; link: append, primary unchanged
- (let [rest* (vec (remove #{source} in))]
- (if (= source (first in))
- (into [new-parent] rest*) ; moved the primary → new home
- (conj rest* new-parent))))
- g* (assoc g :in in')]
- (update (persist-group db gid g g*) :db clear)))))
+(rf/reg-event-db ::ann-drag-start (fn [db [_ gid]] (assoc-in db [:view :dragging-ann] gid)))
+(rf/reg-event-db ::ann-drag-end (fn [db _] (assoc-in db [:view :dragging-ann] nil)))
(rf/reg-event-fx
::reparent
- (fn [{:keys [db]} [_ gid new-parent add?]]
- (let [source (or (get-in db [:view :dragging-ann-source]) (peek (get-in db [:view :stack])))]
- (file-edge db gid new-parent add? source))))
-
-;; file into a group chosen from the picker — always additive (source nil).
-(rf/reg-event-fx ::file-into
- (fn [{:keys [db]} [_ gid target]]
- (file-edge db gid target true nil)))
-
-;; remove one membership edge (× on a chip). Never the primary home, never the last.
-(rf/reg-event-fx
- ::unfile
- (fn [{:keys [db]} [_ gid target]]
- (let [g (get-in db [:scene :groups gid])
- in (vec (:in g))]
- (if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1))
- {:db db}
- (persist-group db gid g (assoc g :in (vec (remove #{target} in))))))))
+ (fn [{:keys [db]} [_ gid new-parent]]
+ (let [scene (:scene db)
+ g (get-in scene [:groups gid])]
+ (if (or (not= :annotation (:type g)) ; only annotations move
+ (:draft g) ; not while being drafted/edited
+ (= (:parent g) new-parent) ; no-op: already there
+ (descendant? scene gid new-parent)) ; target inside gid → cycle
+ {:db (assoc-in db [:view :dragging-ann] nil)}
+ (let [id (get-in db [:project :id])]
+ (cond-> {:db (-> db (assoc-in [:scene :groups gid :parent] new-parent)
+ (assoc-in [:view :dragging-ann] nil)
+ (assoc :save-error nil))}
+ id (assoc :http-xhrio (api/put-scene id {:changed {gid {:parent new-parent}}}
+ {:on-success [::scene-saved]
+ :on-failure [::save-error]}))))))))
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
(rf/reg-event-db ::save-error
@@ -868,31 +704,19 @@
(into (subvec marks 0 i) (subvec marks (inc i))))
(assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i i})))))
-;; clear ONE endpoint of a proxy mark to re-pick it: remember the OPPOSITE
-;; endpoint's ctx-local position (kept fixed) so the next clip-click only rerolls
-;; the cleared side — the kept end never turns into the start (the old swap bug).
-(rf/reg-event-db
- ::unset-proxy-endpoint
- (fn [db [_ gid mark-id pid which]]
- (let [scene (:scene db)
- ctx (scene/home scene gid)
- segs (scene/content-segments scene ctx)
- [lo hi] (scene/mark-extent scene gid mark-id segs)]
- (assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)}))))
-
;; complete a selection on the active draft: wrap the run [lo hi) in a proxy (a
;; synthetic clip), give the annotation one mark referencing it, make it active,
;; seek to its start, and drop into drawing mode ("select a range → you're drawing").
(defn- select-range-fx [db gid g lo hi]
(let [scene (:scene db)
- p (scene/make-proxy scene (scene/home scene gid) lo hi)
+ p (scene/make-proxy scene (:parent g) lo hi)
pgid (keyword (str "prox-" (random-uuid)))
mid (str (random-uuid))
- sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)]
+ sf (scene/local->source (scene/content-segments scene (:parent g)) lo)]
{:db (-> db (assoc-in [:scene :groups pgid] p)
(update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid))
(assoc-in [:view :active-mark] mid)
- (assoc-in [:view :playheads (scene/home scene gid)] lo)
+ (assoc-in [:view :playheads (:parent g)] lo)
(assoc-in [:view :pt] :new))
:player/seek (when sf (/ sf (:fps db)))
:fx [[:dispatch [::start-drawing gid mid]]]}))
@@ -911,23 +735,9 @@
(fn [{:keys [db]} [_ seg-id frame]]
(let [scene (:scene db)
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
- segs (scene/content-segments scene (scene/home scene gid))
+ segs (scene/content-segments scene (:parent g))
pt (get-in db [:view :pt])]
- (cond
- ;; re-picking one endpoint of a proxy: roll only that side, keep the other
- (:proxy pt)
- (let [proxy (get-in scene [:groups (:proxy pt)])
- new-local (if (= (:which pt) :start)
- (scene/seg-local segs seg-id (or frame 0))
- (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))))
- keep (:keep pt)
- lo (scene/assert-frame "proxy range start" (min new-local keep))
- hi (scene/assert-frame "proxy range end" (max new-local keep))]
- {:db (-> db (assoc-in [:scene :groups (:proxy pt)]
- (scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi)))
- (assoc-in [:view :pt] :new))})
-
- (map? pt)
+ (if (map? pt)
(let [a (scene/seg-local segs (:seg pt) (:f pt))
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))
lo (min a b) hi (max a b)
@@ -936,7 +746,7 @@
;; re-picking an endpoint: reconcile-run keeps the mark id for the
;; piece on the kept clip; re-attach that mark's bindings, and splice
;; the run back into its original slot so order is preserved.
- (let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi)
+ (let [run (->> (scene/reconcile-run scene (:parent g) [old] lo hi)
(mapv (fn [m] (if (= (:id m) (:id old))
(cond-> m
(:notes old) (assoc :notes (:notes old))
@@ -948,8 +758,6 @@
(assoc-in [:view :pt] :new))})
;; new selection (two-click): same completion as a timeline drag.
(select-range-fx db gid g lo hi)))
-
- :else
{:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})}))))
;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned
@@ -977,31 +785,14 @@
pid (->> (get-in scene [:groups ann :marks])
(some #(when (= mark-id (:id %)) (get-in % [:start :ref]))))
proxy (get-in scene [:groups pid])
- ;; roll against the VIEWED timeline (top of the stack), NOT the annotation's
- ;; :parent — the drag's frames are local to what you're looking at, and a
- ;; transcluded mark is being edited from a context other than its parent.
- ;; For a normal (non-transcluded) mark the two are the same.
- ctx (peek (get-in db [:view :stack]))
+ ctx (:parent (get-in scene [:groups ann]))
len (scene/length (scene/content-segments scene ctx))
- la (scene/assert-frame "proxy roll start" la)
- lb (scene/assert-frame "proxy roll end" lb)
la* (max 0 (min la (dec len)))
lb* (max (inc la*) (min lb len))]
(if (= :proxy (:type proxy))
(assoc-in db [:scene :groups pid] (scene/roll-proxy scene ctx proxy la* lb*))
db))))
-;; numeric endpoint edit from the pane: set a proxy's boundary internal mark's
-;; :at directly (the collapsed row's start = first mark's start, end = last mark's
-;; end). In-place within one clip — no boundary crossing (that's the lane handles).
-(rf/reg-event-db
- ::set-proxy-frame
- (fn [db [_ pid which frame]]
- (let [frame (scene/assert-frame "proxy endpoint frame" frame)
- marks (get-in db [:scene :groups pid :marks])
- idx (if (= which :start) 0 (dec (count marks)))]
- (assoc-in db [:scene :groups pid :marks idx which :at] frame))))
-
;; transclusion: instead of creating a new annotation, append the draft's marks
;; to an EXISTING one and open it in edit mode ("the new marks suddenly added").
;; We persist the attachment now (the marks + their proxies) and discard the draft
@@ -1011,9 +802,6 @@
(fn [{:keys [db]} [_ draft-gid target-gid]]
(let [marks (get-in db [:scene :groups draft-gid :marks])
orig-t (get-in db [:scene :groups target-gid])
- ;; adding marks does NOT change placement — membership is asserted, never
- ;; derived from where marks were authored. To also list C in this context,
- ;; file it in explicitly (the + picker / drag).
target (update orig-t :marks (fnil into []) marks)
patch (group-patch orig-t target) ; just the :marks change
proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref])
diff --git a/tl/src/tl/filter.cljs b/tl/src/tl/filter.cljs
deleted file mode 100644
index 3426206..0000000
--- a/tl/src/tl/filter.cljs
+++ /dev/null
@@ -1,52 +0,0 @@
-(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))
diff --git a/tl/src/tl/md.cljs b/tl/src/tl/md.cljs
index e9b4d6f..169b9e4 100644
--- a/tl/src/tl/md.cljs
+++ b/tl/src/tl/md.cljs
@@ -18,22 +18,20 @@
;; Two link kinds share the [label](scheme…) form:
;; frame [label](mark:ref@at) jump the playhead to a spot
;; timeline [label](timeline:gid) push that timeline onto the stack
-;; note [label](note:gid) jump to a script note
(def ^:private link-re
- "\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+)|note:([^)]+))\\)")
+ "\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+))\\)")
(defn link-token
"The token for a link map: {:kind :frame :label :ref :at} (the default) or
- {:kind :timeline :label :ref} or {:kind :script-note :label :ref}."
+ {:kind :timeline :label :ref}."
[{:keys [kind label ref at]}]
- (case kind
- :timeline (str "[" label "](timeline:" (name ref) ")")
- :script-note (str "[" label "](note:" (name ref) ")")
+ (if (= kind :timeline)
+ (str "[" label "](timeline:" (name ref) ")")
(str "[" label "](mark:" (name ref) "@" at ")")))
(defn parse-content
"Split content `s` into [:text str] / [:link {…}] segments. Each link carries
- :kind — :frame (with :ref/:at), :timeline (with :ref), or :script-note."
+ :kind — :frame (with :ref/:at) or :timeline (with :ref)."
[s]
(if (empty? s)
[]
@@ -41,11 +39,10 @@
(loop [out [] last 0]
(if-let [m (.exec re s)]
(let [idx (.-index m) pre (subs s last idx)
- link (cond
- (aget m 4) {:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))}
- (aget m 5) {:kind :script-note :label (aget m 1) :ref (keyword (aget m 5))}
- :else {:kind :frame :label (aget m 1) :ref (keyword (aget m 2))
- :at (js/parseInt (aget m 3) 10)})]
+ link (if (aget m 4)
+ {:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))}
+ {:kind :frame :label (aget m 1) :ref (keyword (aget m 2))
+ :at (js/parseInt (aget m 3) 10)})]
(recur (cond-> out
(seq pre) (conj [:text pre])
:always (conj [:link link]))
@@ -60,9 +57,8 @@
(= 3 (.-nodeType n)) (.-textContent n)
(= "BR" (.-tagName n)) "\n"
(and (.-classList n) (.contains (.-classList n) "link-chip"))
- (link-token (case (.. n -dataset -kind)
- "timeline" {:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
- "script-note" {:kind :script-note :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
+ (link-token (if (= "timeline" (.. n -dataset -kind))
+ {:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
{:kind :frame :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))
:at (js/parseInt (.. n -dataset -at) 10)}))
;; A wrapper element (e.g. the
a browser inserts on Enter): recurse so
diff --git a/tl/src/tl/otio.cljs b/tl/src/tl/otio.cljs
index 7600a33..e0c5aad 100644
--- a/tl/src/tl/otio.cljs
+++ b/tl/src/tl/otio.cljs
@@ -13,20 +13,8 @@
(defn- clip? [item]
(str/starts-with? (:OTIO_SCHEMA item "") "Clip"))
-(defn- timeline-frames
- "Frame count/position for timeline math. These must already be integer frames."
- [rational-time]
- (let [v (:value rational-time)]
- (when-not (integer? v)
- (throw (js/Error. (str "OTIO RationalTime value must be an integer frame, got " v))))
- v))
-
-(defn- media-frame
- "Source media position as an integer frame index. Some OTIO exports carry
- rate-conformed source starts as sub-frame RationalTime values; the app model is
- frame-index based, so source starts are normalized once at this import boundary."
- [rational-time]
- (int (:value rational-time)))
+(defn- frames [rational-time]
+ (:value rational-time))
(defn- clip-starts
"Source start_time (frames) of every clip across all tracks."
@@ -34,15 +22,15 @@
(for [t tracks
c (:children t)
:when (clip? c)]
- (media-frame (get-in c [:source_range :start_time]))))
+ (frames (get-in c [:source_range :start_time]))))
(defn- parse-track [media-offset idx track]
- (loop [pos 0
+ (loop [pos 0.0
items (:children track)
ci 0
clips (transient [])]
(if-let [item (first items)]
- (let [dur (timeline-frames (get-in item [:source_range :duration]))
+ (let [dur (frames (get-in item [:source_range :duration]))
is-clip (clip? item)]
(recur (+ pos dur)
(rest items)
@@ -52,7 +40,7 @@
:name (:name item)
:start pos ; timeline frame, 0-based
:duration dur
- :media-in (- (media-frame (get-in item [:source_range :start_time]))
+ :media-in (- (frames (get-in item [:source_range :start_time]))
media-offset)}) ; frame into local .mov
clips)))
{:id idx
@@ -68,11 +56,11 @@
(let [tracks (get-in otio [:tracks :children])
fps (get-in otio [:global_start_time :rate] 24)
starts (clip-starts tracks)
- media-offset (if (seq starts) (apply min starts) 0)
+ media-offset (if (seq starts) (apply min starts) 0.0)
parsed (vec (map-indexed (partial parse-track media-offset) tracks))]
{:fps fps
:media-offset media-offset
- :duration (reduce max 0 (for [t parsed
- c (:clips t)]
- (+ (:media-in c) (:duration c))))
+ :duration (reduce max 0.0 (for [t parsed
+ c (:clips t)]
+ (+ (:media-in c) (:duration c))))
:tracks parsed}))
diff --git a/tl/src/tl/routes.cljs b/tl/src/tl/routes.cljs
index e277b5d..b2bf1fe 100644
--- a/tl/src/tl/routes.cljs
+++ b/tl/src/tl/routes.cljs
@@ -2,8 +2,7 @@
(:require
[clojure.string :as str]
[reitit.frontend :as reitit]
- [reitit.frontend.easy :as rfe]
- [tl.scene :as scene]))
+ [reitit.frontend.easy :as rfe]))
(def routes
[["/" {:name :projects}]
@@ -55,18 +54,15 @@
(into {} (map (fn [[k v]] [(keyword k) v])
(:query-params match))))
stack (some-> (:stack qp) (str/split #","))
- fstr (some-> (:f qp) str)
- f (when (and fstr (re-matches #"\d+" fstr))
- (scene/assert-frame "route playhead" (js/parseInt fstr 10)))]
+ f (some-> (:f qp) js/parseFloat)]
(cond-> {}
(seq stack) (assoc :stack (mapv keyword stack))
- f (assoc :playhead f))))
+ (and f (not (js/isNaN f))) (assoc :playhead f))))
(defn project-url [id stack playhead]
(let [stack-param (->> (rest stack) (map name) (str/join ","))
query (query-string {:stack stack-param
- :f (when (some? playhead)
- (scene/assert-frame "route playhead" playhead))})]
+ :f (some-> playhead js/Math.round)})]
(str (href :project/show {:id id}) query)))
(defonce ^:private last-replaced (atom nil))
diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs
index a8fc6cd..c4d96a7 100644
--- a/tl/src/tl/scene.cljs
+++ b/tl/src/tl/scene.cljs
@@ -16,28 +16,6 @@
(defn- grp [scene gid] (get-in scene [:groups gid]))
-(defn frame?
- "True when `n` is a concrete integer frame coordinate."
- [n]
- (and (number? n) (integer? n) (not (js/isNaN n))))
-
-(defn assert-frame
- "Return `n` after asserting it is an integer frame. This is intentionally a
- runtime check, not cljs.core/assert, so production builds keep the invariant."
- [label n]
- (when-not (frame? n)
- (throw (js/Error. (str label " must be an integer frame, got " (pr-str n)))))
- n)
-
-(defn assert-range
- "Return `[lo hi]` after asserting a valid integer half-open frame range."
- [label [lo hi]]
- (assert-frame (str label " start") lo)
- (assert-frame (str label " end") hi)
- (when (> lo hi)
- (throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi])))))
- [lo hi])
-
(defn- find-mark
"[owning-gid mark] for a mark id anywhere in the scene, or nil."
[scene mid]
@@ -53,10 +31,7 @@
(defn local->source
"The source frame shown at local frame `lf` (clamped to the end)."
[segs lf]
- (assert-frame "local frame" lf)
(or (some (fn [{:keys [src local]}]
- (assert-range "segment source" src)
- (assert-range "segment local" local)
(let [[c d] local [a _] src]
(when (and (<= c lf) (< lf d)) (+ a (- lf c)))))
segs)
@@ -65,10 +40,7 @@
(defn source->local
"Local frame for source frame `sf` (first segment containing it), or nil."
[segs sf]
- (assert-frame "source frame" sf)
(some (fn [{:keys [src local]}]
- (assert-range "segment source" src)
- (assert-range "segment local" local)
(let [[a b] src [c _] local]
(when (and (<= a sf) (< sf b)) (+ c (- sf a)))))
segs))
@@ -76,24 +48,21 @@
(defn pieces
"Where source range [sa sb) lands in local coords: a list of [lo hi)."
[segs sa sb]
- (assert-range "source range" [sa sb])
(vec (keep (fn [{:keys [src local]}]
- (assert-range "segment source" src)
- (assert-range "segment local" local)
(let [[a b] src [c _] local
lo (max sa a) hi (min sb b)]
(when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))])))
segs)))
(defn merge-bars
- "Coalesce [lo hi) ranges that meet at a boundary into single bars, so a
- continuous run spanning several clips reads as one piece. Ranges are half-open,
- so adjacent clips share a boundary (A.hi == B.lo) and merge exactly — no gap to
- fudge. Called per-mark, so it never fuses two distinct marks."
+ "Coalesce [lo hi) ranges that meet at a frame boundary into single bars, so a
+ continuous selection spanning several clips reads as one piece. Endpoints snap
+ to whole frames first, which absorbs the sub-frame gaps OTIO's fractional
+ media offsets leave between adjacent clips; only a real (≥1 frame) gap splits."
[bars]
(reduce (fn [acc [lo hi]]
- (assert-range "bar" [lo hi])
- (let [[plo phi] (peek acc)]
+ (let [lo (js/Math.floor lo) hi (js/Math.ceil hi)
+ [plo phi] (peek acc)]
(if (and plo (<= lo phi))
(conj (pop acc) [plo (max phi hi)])
(conj acc [lo hi]))))
@@ -103,11 +72,8 @@
(defn slice
"Sub-segments of `segs` covering local range [la lb), src + local re-cut."
[segs la lb]
- (assert-range "slice" [la lb])
(vec
(keep (fn [{:keys [src local] :as seg}]
- (assert-range "segment source" src)
- (assert-range "segment local" local)
(let [[a _] src [c d] local
lo (max la c) hi (min lb d)]
(when (< lo hi)
@@ -120,7 +86,23 @@
;; --- resolution ----------------------------------------------------------
-(declare resolve resolve-mark home child-of?)
+(declare resolve resolve-mark)
+
+(defn- target-range
+ "Source [xs xe) + :track of a referenceable id (a clip/timeline group, or a
+ single-clip mark). Single-segment by the ref invariant; nil if unknown."
+ [scene id]
+ (let [segs (cond
+ (grp scene id) (resolve scene id)
+ (find-mark scene id) (let [[gid m] (find-mark scene id)]
+ (resolve-mark scene gid m))
+ :else nil)]
+ (when (seq segs)
+ {:xs (-> segs first :src first)
+ :xe (-> segs last :src second)
+ :track (-> segs first :track)
+ :thumb (-> segs first :thumb)
+ :thumb-start (-> segs first :thumb-start)})))
(defn- target-segs
"Resolved segments (local 0-based) of a referenceable id: a group (clip,
@@ -133,67 +115,32 @@
(resolve-mark scene gid m))
:else nil))
-;; --- ref :at <-> source : the ONE interpretation of a ref's :at -----------
-;; {:ref id :at n}'s :at is a LOCAL frame of id's OWN resolved timeline (n<0 from
-;; the end, -1 = the exclusive end). Every :at<->frame conversion goes through
-;; id's FULL resolution (target-segs) + the flat helpers, so it is correct whether
-;; id is one clip or a scattered multi-clip proxy. Do NOT summarise a target to a
-;; single [xs xe] span — that only holds for a single contiguous segment.
-
-(defn- ref-len [scene ref] (length (target-segs scene ref)))
-
-(defn- at->local
- "Normalise a ref's :at (n<0 from the end) to a non-negative local frame."
- [scene ref at]
- (if (neg? at) (+ (ref-len scene ref) at 1) at))
-
-(defn- at->src
- "Source frame at ref point {:ref :at} — id's own local frame → source — or nil
- if the ref dangles or the frame falls outside id."
- [scene ref at]
- (when-let [segs (seq (target-segs scene ref))]
- (let [l (at->local scene ref at)]
- (when (<= 0 l (length segs))
- (local->source segs l)))))
-
-(defn- src->at
- "Target-local :at for source frame `src` within `ref` — source → id's own
- local frame — or nil if outside id."
- [scene ref src]
- (some-> (seq (target-segs scene ref)) (source->local src)))
-
(defn- point-frame
"Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref
dangles."
[scene gid point]
(cond
(number? point)
- (let [parent (home scene gid)]
+ (let [parent (:parent (grp scene gid))]
{:frame (if parent (local->source (resolve scene parent) point) point)
:track nil})
(map? point)
- (when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range
- {:frame f})))
-
-(defn- shift-local
- "Shift `sub`'s :local so the run starts at 0, WITHOUT touching :mark — pieces keep
- the identity of the target they were sliced from. This is the RAW recursion's
- output; content-segments uses it so a multi-clip mark stays a run of
- individually-addressable clips (their own name/length/ref)."
- [sub]
- (let [base (or (some-> sub first :local first) 0)]
- (mapv (fn [s] (let [[c d] (:local s)]
- (assoc s :local [(- c base) (- d base)])))
- sub)))
+ (when-let [{:keys [xs xe track thumb thumb-start]} (target-range scene (:ref point))]
+ (let [n (:at point)
+ f (if (neg? n) (+ xe n 1) (+ xs n))]
+ (when (<= xs f xe)
+ (cond-> {:frame f :track track}
+ thumb (assoc :thumb thumb :thumb-at (+ (or thumb-start 0) (- f xs))))))))) ; nil if trimmed out of range
(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)."
+ "Shift `sub`'s :local to start at 0 and stamp :mark = `id` (the mark now owns
+ these segments regardless of which target they were sliced from)."
[id sub]
- (mapv #(assoc % :mark id) (shift-local sub)))
+ (let [base (or (some-> sub first :local first) 0)]
+ (mapv (fn [s] (let [[c d] (:local s)]
+ (assoc s :mark id :local [(- c base) (- d base)])))
+ sub)))
(defn- instant-seg
"A zero-length segment at local frame `la` of `tsegs` (for an instant mark),
@@ -219,7 +166,7 @@
lb (at->l (:at end))]
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
(rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
- (let [parent (home scene gid)]
+ (let [parent (:parent (grp scene gid))]
(if parent ; absolute, relative to parent
(rebase id (slice (resolve scene parent) start end))
[{:mark id :track track :src [start end] :local [0 (- end start)]
@@ -261,56 +208,17 @@
[scene gid]
(when-let [mid (first (broken-marks scene gid))]
(let [ref (->> (:marks (grp scene gid)) (some #(when (= mid (:id %)) %)) :start :ref)]
- (if (seq (target-segs scene ref)) "reference trimmed away" "referenced clip deleted"))))
+ (if (target-range scene ref) "reference trimmed away" "referenced clip deleted"))))
;; --- what the current timeline is made of --------------------------------
-(defn- content-mark-segs
- "Context-local pieces of mark `m` for content-segments. A ref into a PROXY drills
- in and exposes the proxy's per-clip run, each sub-clip mark kept individually
- addressable (its own name/length/ref/trim, via shift-local) — instead of
- collapsing every piece under `m`'s single id the way resolve does for the LANE
- view (rebase). That collapse was the bug: drilling into a proxy-backed range made
- every clip read with the FIRST piece's name + length, so sub-range selections
- wouldn't save. Any OTHER mark — a plain clip ref, a single mark ref, an absolute
- mark — is one piece and stays owned by `m` (resolve-mark), so nested marks there
- remain annotation-relative, exactly as before this fix."
- [scene gid {:keys [start end] :as m}]
- (if (and (map? start) (= :proxy (:type (grp scene (:ref start)))))
- (when-let [tsegs (seq (target-segs scene (:ref start)))]
- (let [len (length tsegs)
- at->l #(if (neg? %) (+ len % 1) %)
- la (at->l (:at start))
- lb (at->l (:at end))]
- (when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
- (shift-local (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
- (resolve-mark scene gid m)))
-
-(defn- content-resolve
- "`resolve` for content-segments: lays a group's marks end to end, but each piece
- keeps its underlying :mark (see content-mark-segs) so multi-clip marks don't
- collapse to one addressable unit."
- [scene gid]
- (loop [[m & more] (:marks (grp scene gid)), off 0, out []]
- (if (nil? m)
- out
- (if-let [segs (seq (content-mark-segs scene gid m))]
- (let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs))
- shifted (mapv (fn [s] (let [[c d] (:local s)]
- (assoc s :local [(+ off c) (+ off d)])))
- segs)]
- (recur more (+ off len) (into out shifted)))
- (recur more off out)))))
-
(defn content-segments
"The clip-segments that make up context `ctx` — what you draw and select
- against. An annotation's marks reference clips, so that's just `resolve` — but
- with each piece kept distinct (see content-resolve), not flattened under the
- annotation's own mark id. The root timeline doesn't enumerate its clips (they're
- a parentless pool), so there it's the pool laid at each clip's TIMELINE position
- (:start) with :src = its source range — so the assembled program tiles
- contiguously even though the underlying source frames are scattered (and
- fractional)."
+ against. An annotation's marks reference clips, so that's just `resolve`. The
+ root timeline doesn't enumerate its clips (they're a parentless pool), so
+ there it's the pool laid at each clip's TIMELINE position (:start) with :src =
+ its source range — so the assembled program tiles contiguously even though
+ the underlying source frames are scattered (and fractional)."
[scene ctx]
(if (= :timeline (:type (grp scene ctx)))
(->> (:groups scene)
@@ -322,7 +230,7 @@
(assoc seg :mark gid :local [st (+ st (- sb sa))])))))
(sort-by (comp first :local))
vec)
- (content-resolve scene ctx)))
+ (resolve scene ctx)))
(defn- src-intersect
"Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))."
@@ -332,20 +240,46 @@
:when (< lo hi)]
[lo hi])))
+(defn nested-src
+ "Source ranges of annotation `gid` clipped to every ancestor annotation between
+ it and `ctx` — what's still visible once the reveal chain trims it, i.e. the
+ same content you'd see if you expanded into its parent. A direct child of `ctx`
+ is just its own resolved source (the timeline itself does the clipping later).
+ Empty ⇒ the annotation is out of range in this reveal chain."
+ [scene ctx gid]
+ (loop [p (:parent (grp scene gid)), rs (mapv :src (resolve scene gid))]
+ (if (or (nil? p) (= p ctx))
+ rs
+ (recur (:parent (grp scene p))
+ (src-intersect rs (mapv :src (resolve scene p)))))))
+
+(defn- clip-segs
+ "Clip resolved segments `ss` (each {:mark :src …}) to coverage `cover` ([c d)s),
+ keeping each seg's :mark (the mark-aware sibling of src-intersect)."
+ [ss cover]
+ (vec (for [{[a b] :src :as s} ss [c d] cover
+ :let [lo (max a c) hi (min b d)]
+ :when (< lo hi)]
+ (assoc s :src [lo hi]))))
+
+(defn nested-src-marks
+ "Like nested-src but preserves :mark on each surviving segment, so lane bars can
+ be grouped per mark (see lane-bars). Ordered as resolve lays the marks."
+ [scene ctx gid]
+ (loop [p (:parent (grp scene gid)), ss (resolve scene gid)]
+ (if (or (nil? p) (= p ctx))
+ ss
+ (recur (:parent (grp scene p)) (clip-segs ss (mapv :src (resolve scene p)))))))
+
(defn lane-bars
"Context-local display bars for annotation `gid`, grouped PER MARK: contiguous
pieces coalesce WITHIN a mark but never across marks, so two abutting-but-
distinct marks stay separate bars — the lane bar matches each mark's highlight
1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id
lets the lane hit-test / highlight / edit one mark; consumers that only want
- the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments.
-
- `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)
+ the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments."
+ [scene ctx gid ctx-segs]
+ (->> (nested-src-marks scene ctx gid)
(partition-by :mark)
(mapcat (fn [ss]
(let [mid (:mark (first ss))]
@@ -353,52 +287,12 @@
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss))))))
vec))
-(defn mark-extent
- "EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true
- min piece-start / max piece-end, without merge-bars. Endpoint editing must use
- this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` =
- content-segments of ctx."
- [scene gid mark-id ctx-segs]
- (let [pcs (->> (resolve scene gid)
- (filter #(= mark-id (:mark %)))
- (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))]
- (when (seq pcs)
- [(reduce min (map first pcs)) (reduce max (map second pcs))])))
-
-;; --- placement: :in membership edges --------------------------------------
-;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered
-;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under
-;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in
-;; it. The FIRST element is the primary home (where its :content links resolve and
-;; where it's edited); the whole vector as a set is its membership. Marks are never
-;; moved or re-cut — they resolve to raw clips globally, and that only decides
-;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it
-;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary.
-
-(defn home
- "The primary home of `gid`: the first `:in` edge for an annotation (where its
- description links resolve and where it's edited); the structural `:parent` for
- anything else (nil for the flat clip/proxy pool and the root timeline)."
- [scene gid]
- (let [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."
+ "True when annotation `gid` loses any content once clipped to its immediate
+ parent annotation — it references frames outside the parent timeline, so it's
+ (partly) out of range there. Timeline/root parents contain everything."
[scene gid]
- (let [p (home scene gid)]
+ (let [p (:parent (grp scene gid))]
(when (and p (= :annotation (:type (grp scene p))))
(let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs)))
own (mapv :src (resolve scene gid))]
@@ -409,19 +303,14 @@
(defn selection->marks
"Split local range [la lb) of context `ctx` into a run of single-clip ref
marks, one per content segment it crosses (the 'no cross-clip marks' rule).
- Each references the segment's source id with the right offsets. Inputs and
- derived offsets must already be integer frames."
+ Each references the segment's source id with the right offsets."
[scene ctx la lb]
- (assert-range "selection" [la lb])
(mapv (fn [{:keys [mark src]}]
- ;; :at is the target's OWN local frame (src->at), matching resolve-mark's
- ;; slice — correct even when the target is a scattered multi-clip proxy.
- ;; The piece lies within one target segment, so its length maps 1:1.
- (let [[a b] src
- a' (src->at scene mark a)]
+ (let [{:keys [xs]} (target-range scene mark)
+ [a b] src]
{:id (str (random-uuid)) ; string so it survives JSON
- :start {:ref mark :at (assert-frame "selection start offset" a')}
- :end {:ref mark :at (assert-frame "selection end offset" (+ a' (- b a)))}}))
+ :start {:ref mark :at (- a xs)}
+ :end {:ref mark :at (- b xs)}}))
(slice (content-segments scene ctx) la lb)))
(defn reconcile-run
@@ -483,6 +372,12 @@
[segs mid f]
(some (fn [{m :mark [c _] :local}] (when (= m mid) (+ c (or f 0)))) segs))
+(defn- at->frame
+ "Normalise a ref's :at to a non-negative mark-time frame (resolves :at -1 etc.)."
+ [scene ref at]
+ (if (neg? at)
+ (let [{:keys [xs xe]} (target-range scene ref)] (+ (- xe xs) at 1))
+ at))
(defn- restore-mark [m]
;; keep :id keyworded in lockstep with the refs that target it: a nested
@@ -537,30 +432,18 @@
:proxy (update g :marks #(mapv restore-mark (or % []))) ; synthetic clip: just its run
:drawing g ; pure strokes + seed, JSON round-trips as-is
(-> g
- (dissoc :parent) ; annotations are placed by :in alone
(update :marks #(mapv restore-mark (or % [])))
- (cond-> (:notes g)
- (update :notes #(mapv keyword %))) ; annotation-level bindings
- ;; membership edges: keyword an existing :in vector,
- ;; or seed one from a legacy single :parent
- (assoc :in (if-let [in (:in g)]
- (mapv keyword in)
- (when (:parent g) [(:parent g)])))
+ (update :notes #(when % (mapv keyword %))) ; annotation-level bindings
migrate))])))
anns))
-(defn display-point
- "A ref-point {:ref :at} as a display cell {:seg :f}: the target id plus its OWN
- local frame (context-local, whole-frame; not translated to the raw clip). The
- shared basis for both the annotation editor rows and the jump popover, so they
- can never disagree on how a point reads."
- [scene {:keys [ref at]}]
- {:seg ref :f (assert-frame "display point" (at->local scene ref at))})
-
(defn- clip-row
- "Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time."
+ "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]}]
- {:s (display-point scene start) :e (display-point scene end)})
+ {:s {:seg (:ref start) :f (js/Math.round (at->frame scene (:ref start) (:at start)))}
+ :e {:seg (:ref end) :f (js/Math.round (at->frame scene (:ref end) (:at end)))}})
(defn mark-row
"One editor row for a mark. A plain clip/subclip ref collapses to {:s :e}
@@ -593,51 +476,28 @@
clip mark-group per clip (source range + track), and the root timeline. The
otio is only a seed — nothing here reads it again.
- Clip ranges are integer frame ranges. Fractional OTIO input is rejected before
- this point; from here on, frame math asserts instead of snapping."
+ Frames are SNAPPED to whole integers here, at the one boundary where OTIO's
+ fractional RationalTime enters: a frame-based tool has no meaning below a whole
+ frame, so we round once, at the source, and everything downstream (source
+ ranges, mark :at offsets, seeks, labels) stays frame-accurate by construction."
[{:keys [duration tracks]}]
- (assert-frame "OTIO duration" duration)
- (let [vtracks (filter #(= :video (:kind %)) tracks)
+ (let [r (fn [x] (js/Math.round x))
+ vtracks (filter #(= :video (:kind %)) tracks)
track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks)
clips (into {} (for [t vtracks c (:clips t)]
- (let [start (assert-frame "clip timeline start" (:start c))
- media-in (assert-frame "clip media-in" (:media-in c))
- duration (assert-frame "clip duration" (:duration c))]
- [(keyword (:id c))
- {:type :clip :parent nil :name (:name c)
- :start start ; timeline position (frames)
- :marks [{:id (keyword (str (:id c) "-m"))
- :start media-in
- :end (+ media-in duration)
- :track (keyword (str "t" (:index t)))}]}])))]
+ [(keyword (:id c))
+ {:type :clip :parent nil :name (:name c)
+ :start (r (:start c)) ; timeline position (frames)
+ :marks [{:id (keyword (str (:id c) "-m"))
+ :start (r (:media-in c))
+ :end (r (+ (:media-in c) (:duration c)))
+ :track (keyword (str "t" (:index t)))}]}]))]
{:tracks track-map
:groups (assoc clips :root {:type :timeline :parent nil
- :marks [{:id :root-m :start 0 :end duration}]})}))
+ :marks [{:id :root-m :start 0 :end (r duration)}]})}))
(defn clip-name [scene gid] (:name (grp scene gid)))
-;; --- context-independent labelling (for transcluded mark rows) ------------
-;; A mark collected into an annotation from another timeline (transclusion) has a
-;; ref whose clip isn't in the CURRENT context's content-segments, so the context
-;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip
-;; instead — the mark's own timeline — so the row reads correctly from anywhere.
-
-(defn ref-length
- "Own resolved length (frames) of ref target `ref`, context-independent."
- [scene ref]
- (length (target-segs scene ref)))
-
-(defn ref-track-name
- "Name of the TRACK that ref target `ref` resolves onto (its first piece),
- context-independent — the useful label for a transcluded mark whose clip isn't
- in the current view. The clip's own :name is the shared source file (e.g.
- \"Challengers.mov\") — identical for every clip of single-source footage — so
- the track (A-roll / B-roll …) is what actually distinguishes them. nil if the
- ref dangles."
- [scene ref]
- (when-let [t (:track (first (target-segs scene ref)))]
- (get-in scene [:tracks t :name] (name t))))
-
;; --- links ----------------------------------------------------------------
;; A link is a ref-point {:ref id :at n} — the same shape as a mark endpoint, so
;; it resolves through the usual machinery — named inside an annotation's markdown
@@ -659,7 +519,7 @@
"Ref-point {:ref :at} for mark-time frame `f` within content-segment `seg`
(the convention selection->marks uses, so it resolves identically)."
[scene {:keys [mark src]} f]
- {:ref mark :at (+ (src->at scene mark (first src)) (or f 0))})
+ {:ref mark :at (+ (- (first src) (:xs (target-range scene mark))) (or f 0))})
(defn- runs
"Contiguous runs of `gid`'s marks in `ctx`-local coords, each {:id :lo :len}
@@ -684,22 +544,15 @@
[] pts)))
(defn jump-targets
- "One target per discontinuity for an annotation's jump popover, labelled from the
- CONTENT SEGMENT the run lands on in `ctx` — its clip/track id + the frame within
- it. A mark's :start is its proxy-ref ({:ref proxy :at 0}), so display-point of it
- would give the proxy gid (never in `segs` → a bare \"clip\") and frame 0; instead
- we read the actual clip under the run's local position, the same segments the
- editor labels against. Each: {:local :seg :f}."
+ "One target per discontinuity for an annotation's jump popover — labelled from
+ the owning mark's clip ref + frame, the SAME basis the annotation editor uses
+ (clip-label of :ref), so the jump label can never disagree with the mark row.
+ Each: {:local :seg :f }."
[scene ctx gid]
- (let [csegs (content-segments scene ctx)]
- (mapv (fn [{:keys [lo]}]
- (let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs)
- (some (fn [{[_ d] :local :as s} ] (when (= d lo) s)) csegs)
- (last csegs))]
- {:local lo
- :seg (:mark seg)
- :f (assert-frame "jump target frame" (- lo (first (:local seg [0 0]))))}))
- (runs scene ctx gid))))
+ (mapv (fn [{:keys [id lo]}]
+ (let [st (:start (some #(when (= id (:id %)) %) (:marks (grp scene gid))))]
+ {:local lo :seg (:ref st) :f (js/Math.round (at->frame scene (:ref st) (:at st)))}))
+ (runs scene ctx gid)))
(defn linkables
"Pickable link targets within `ctx`, grouped for the autocomplete: one group
@@ -719,7 +572,7 @@
(sort-by (comp first :local) segs))}))))
anns (->> (:groups scene)
(keep (fn [[gid g]]
- (when (and (= :annotation (:type g)) (child-of? scene ctx gid)
+ (when (and (= :annotation (:type g)) (= ctx (:parent g))
(not (:draft g)))
{:name (or (:name g) (name gid)) :kind :annotation
:items (mapv (fn [{:keys [id lo len]}]
@@ -729,14 +582,14 @@
(vec (concat (sort-by :name tracks) (sort-by :name anns)))))
(defn path-to
- "Stack path from :root down to `gid` following primary-home links, or nil if an
- ancestor is missing — an orphan whose home context was deleted."
+ "Stack path from :root down to `gid` following :parent links, or nil if an
+ ancestor is missing — an orphan whose parent context was deleted."
[scene gid]
(loop [g gid, acc ()]
(cond
(= g :root) (vec (cons :root acc))
(or (nil? g) (not (contains? (:groups scene) g))) nil
- :else (recur (home scene g) (cons g acc)))))
+ :else (recur (get-in scene [:groups g :parent]) (cons g acc)))))
(defn timelines
"Every reachable timeline you can open as a context — root, plus named child
@@ -748,7 +601,7 @@
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (not (:draft g)))
(when-let [path (path-to scene gid)]
- (let [parent (home scene gid)]
+ (let [parent (:parent g)]
{:gid gid :name (or (:name g) (name gid))
:in (if (or (nil? parent) (= :root parent))
"root" (get-in scene [:groups parent :name] (name parent)))
diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs
index 388c1fb..5153578 100644
--- a/tl/src/tl/subs.cljs
+++ b/tl/src/tl/subs.cljs
@@ -1,7 +1,6 @@
(ns tl.subs
(:require [clojure.string :as str]
[re-frame.core :as rf]
- [tl.filter :as filter]
[tl.scene :as scene]))
(rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
@@ -23,11 +22,8 @@
;; :choosing (fresh draft — marks + title picker only) | :creating (full form).
(rf/reg-sub ::draft-stage (fn [db] (get-in db [:view :draft-stage])))
(rf/reg-sub ::script-jump (fn [db] (get-in db [:view :script-jump])))
-(rf/reg-sub ::note-target (fn [db] (get-in db [:view :note-target])))
(rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{})))
-(rf/reg-sub ::annotation-filter
- (fn [db] (merge {:query "" :tags #{}}
- (get-in db [:view :annotation-filter]))))
+(rf/reg-sub ::hidden-tags (fn [db] (get-in db [:view :hidden-tags] #{})))
(rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus])))
(rf/reg-sub ::linking (fn [db] (get-in db [:view :linking])))
(rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann])))
@@ -108,111 +104,50 @@
(fn [[scene stack] _]
(mapv (fn [gid] {:id gid :name (or (get-in scene [:groups gid :name]) (name gid))}) stack)))
-;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
-;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
-(defn- in-bars? [bars ph]
- (some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
-
-(defn annotations-by-parent
- "Group annotation cards by every reference parent they belong to."
- [anns]
- (reduce (fn [m a]
- (reduce #(update %1 %2 (fnil conj []) a) m (:parents a)))
- {}
- anns))
-
-(defn visible-child-annotations
- "Nested cards under `parent-id` are controlled by that parent's reveal state.
- A transcluded child may be visible because another parent was revealed, but it
- should not render under this parent until this parent's panel is open."
- [by-parent revealed parent-id seen]
- (when (contains? (or revealed #{}) parent-id)
- (seq (remove #(contains? seen (:id %)) (get by-parent parent-id)))))
-
;; child annotations of the current context, with their bars in local coords
(rf/reg-sub
- ::all-annotations
- :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
- (fn [[scene ctx segs revealed] _]
- (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
- exists? (fn [x] (contains? (:groups scene) x))
- ;; each annotation → the mark-groups it's FILED UNDER (:in membership). A
- ;; normal annotation has one; a linked one has several, so it lists under
- ;; each. Asserted, not derived from where marks resolve. Any :in host that
- ;; no longer exists (its group was deleted) is dropped; an annotation left
- ;; with NO surviving host is rescued to root so it stays visible/refileable
- ;; instead of vanishing into a ghost parent.
- parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
- (let [ms (filter exists? (scene/membership scene gid))]
- [gid (if (seq ms) (set ms) #{:root})])))
- ;; child count per timeline (drives the "Show N" nested badge)
- nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents))
- ;; membership-reveal hierarchy: shows when ctx is a host it's filed under,
- ;; or a REVEALED host annotation that itself shows. `seen` guards cycles.
- shown? (fn shown? [gid seen]
- (and (not (contains? seen gid))
- (boolean (some (fn [p] (or (= ctx p)
- (and (ann? p) (revealed p) (shown? p (conj seen gid)))))
- (parents gid)))))]
+ ::annotations
+ :<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed]
+ (fn [[scene ctx segs hidden-tags revealed] _]
+ (let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g)))
+ (:groups scene)))
+ ;; shown when every ancestor up to ctx is revealed: a direct child of ctx
+ ;; always shows; a deeper annotation shows only if its parent is revealed
+ ;; AND that parent is itself shown.
+ shown? (fn shown? [p] (or (= ctx p)
+ (and (revealed p) (shown? (get-in scene [:groups p :parent])))))]
(->> (:groups scene)
(keep (fn [[gid g]]
- (when (= :annotation (:type g))
- ;; VISIBILITY IS BY MEMBERSHIP (:in): an annotation shows in ctx
- ;; iff it's filed under ctx, or under a revealed host that itself
- ;; shows. Where its marks resolve only decides whether bars draw.
- (let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
- (when (shown? gid #{})
- (let [reason (scene/broken-reason scene gid)
+ (when (and (= :annotation (:type g)) (shown? (:parent g))
+ ;; a hidden tag hides every annotation carrying it; the
+ ;; :untagged sentinel hides annotations with no tags
+ (let [tags (get-in g [:meta :tags])]
+ (not (or (some hidden-tags tags)
+ (and (empty? tags) (contains? hidden-tags :untagged))))))
+ (let [bars (scene/lane-bars scene ctx gid segs) ; one bar per mark; distinct marks never fuse
+ reason (scene/broken-reason scene gid)
oor (boolean (scene/clip-loss? scene gid))
- hidden (get-in g [:meta :hidden])
- note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
- distinct
- (filterv #(= :script-note (get-in scene [:groups % :type]))))
- note-text (mapcat (fn [ng]
- (let [n (get-in scene [:groups ng])]
- (cons (:name n)
- (mapcat (juxt :text :content) (:regions n)))))
- note-ids)
- jumps (scene/jump-targets scene ctx gid)
- clips (->> (:marks g)
- (mapcat (fn [m] [(get-in m [:start :ref])
- (get-in m [:end :ref])]))
- (concat (map :seg jumps))
- (keep (fn [ref]
- (let [cg (get-in scene [:groups ref])]
- (or (:name cg)
- (get-in cg [:media :name])
- (some-> ref name)))))
- distinct)]
- {:id gid :parent (scene/home scene gid) ; primary home = first :in
- ;; the mark-groups this annotation is filed under (:in) — the
- ;; pane groups by this, so a linked annotation lists under each.
- :parents (parents gid)
+ hidden (get-in g [:meta :hidden])]
+ {:id gid :parent (:parent g)
:name (:name g) :color (or (:color g) "#4e8fc2")
:content (:content g) :children (count (:marks g))
:nested (get nested gid 0)
:draft (boolean (:draft g))
;; every script-note bound anywhere in this annotation
;; (annotation-level + per-mark), deduped, still-existing only
- :notes note-ids
- :script (vec (remove nil? note-text))
- :clips (vec clips)
+ :notes (->> (concat (:notes g) (mapcat :notes (:marks g)))
+ distinct
+ (filterv #(= :script-note (get-in scene [:groups % :type]))))
:broken (boolean reason) :reason reason :oor oor
:hidden (boolean hidden)
:tags (vec (get-in g [:meta :tags]))
;; jump targets labelled from the marks' clip refs (same as
- ;; the editor) — not re-derived from a display bar frame
- :jumps jumps
- :start (or (ffirst bars) 0) :bars bars}))))))
+ ;; the editor) — not re-derived from a floored bar frame
+ :jumps (scene/jump-targets scene ctx gid)
+ :start (or (ffirst bars) 0) :bars bars}))))
(sort-by (juxt :broken :start)) ; broken annotations sink to the bottom
vec))))
-(rf/reg-sub
- ::annotations
- :<- [::all-annotations] :<- [::annotation-filter]
- (fn [[anns filters] _]
- (filter/filter-annotations anns filters)))
-
;; every distinct tag used by any annotation in the project — feeds both the tag
;; adder's autocomplete and the timeline tag filter.
(rf/reg-sub
@@ -225,6 +160,11 @@
(sort-by str/lower-case)
vec)))
+;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
+;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
+(defn- in-bars? [bars ph]
+ (some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
+
;; the annotation the playhead is currently inside (or the latest one passed) —
;; drives the rolling highlight/scroll in the commentary
(rf/reg-sub
@@ -278,7 +218,7 @@
(fn [[gid g]]
;; child annotations of the context OR the context annotation itself
;; (pushing the owner onto the stack makes ctx that annotation)
- (when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid)))
+ (when (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid)))
(let [src-segs (scene/resolve scene gid)
by-mark (group-by :mark src-segs)
->bars (fn [ss] (scene/merge-bars
diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs
index e0e785e..8a159c3 100644
--- a/tl/src/tl/views.cljs
+++ b/tl/src/tl/views.cljs
@@ -38,14 +38,6 @@
(defn- px [local fps zoom] (* (/ local fps) zoom))
-(defn- frame-index
- "Convert a continuous UI/video coordinate to the integer frame index it is over.
- After this edge conversion, frame values are asserted, not snapped."
- [label n]
- (when-not (and (number? n) (not (js/isNaN n)))
- (throw (js/Error. (str label " must be numeric, got " (pr-str n)))))
- (scene/assert-frame label (int n)))
-
(defn- clip-thumbnail-layer [thumbs fps zoom row-h {:keys [mark thumb thumb-start local]}]
(when-let [tiles (seq (get-in thumbs [:clips (or thumb mark)]))]
(let [[c d] local
@@ -133,7 +125,7 @@
(defn- play-tick []
(when-let [{:keys [ctx segs fps idx]} @play]
(let [v @video-el
- sf (frame-index "video source frame" (* (.-currentTime v) fps))
+ sf (* (.-currentTime v) fps)
{:keys [pending-ns]} @play
{[ss se] :src [ls _] :local} (nth segs idx)]
(cond
@@ -214,8 +206,7 @@
clip under the landing frame into view vertically — jumps always do both."
([local] (goto! local false))
([local follow?]
- (let [local (scene/assert-frame "goto frame" local)
- ctx @(rf/subscribe [::subs/context])
+ (let [ctx @(rf/subscribe [::subs/context])
segs @(rf/subscribe [::subs/segments])
fps @(rf/subscribe [::subs/fps])
zoom @(rf/subscribe [::subs/zoom])]
@@ -408,10 +399,10 @@
linking @(rf/subscribe [::subs/linking])
auth? (some? @(rf/subscribe [::subs/draft-group]))
seg (some (fn [{[c d] :local :as s}] (when (and (<= c ph) (< ph d)) s)) segs)
- cf (when seg (scene/assert-frame "clip frame" (- ph (first (:local seg)))))
+ cf (when seg (js/Math.round (- ph (first (:local seg)))))
click? (and auth? seg)]
[:div.frame-readout
- [:span.fr-abs (str (scene/assert-frame "playhead" ph) "f")]
+ [:span.fr-abs (str (js/Math.round ph) "f")]
(when seg
[:span.fr-clip {:class (when click? "clickable")
:title (when click? (if linking "Click to link this frame"
@@ -458,7 +449,7 @@
(.preventDefault ev)
(let [to (fn [clientX]
(let [x (- clientX (.-left (.getBoundingClientRect content)))]
- (goto! (frame-index "scrub frame" (max 0 (* (/ x zoom) fps))))))
+ (goto! (max 0 (* (/ x zoom) fps)))))
move (fn [e] (to (.-clientX e)))
up (fn up [_] (.removeEventListener js/document "mousemove" move)
(.removeEventListener js/document "mouseup" up))]
@@ -481,11 +472,11 @@
(when (or @moved? (> (js/Math.abs d) 3))
(reset! moved? true)
(let [[la lb] (case mode
- :move [(frame-index "drag start frame" (+ lo d))
- (frame-index "drag end frame" (+ hi d))]
- :start [(frame-index "drag start frame" (+ lo d)) hi]
- :end [lo (frame-index "drag end frame" (+ hi d))])]
- (rf/dispatch [::events/reroll-proxy ann mark-id la lb])))))
+ :move [(+ lo d) (+ hi d)]
+ :start [(+ lo d) hi]
+ :end [lo (+ hi d)])]
+ (rf/dispatch [::events/reroll-proxy ann mark-id
+ (js/Math.round la) (js/Math.round lb)])))))
up (fn up [_]
(.removeEventListener js/document "mousemove" move)
(.removeEventListener js/document "mouseup" up)
@@ -501,14 +492,13 @@
(defn- region-select!
"On the timeline while authoring: DRAG to select a region [lo hi) → one
- selection (a proxy). A plain CLICK (no drag) calls `on-click` — clicking a clip
- picks it (draft-click-seg), clicking empty timeline just moves the playhead —
- so both still work in marking mode. `content` is the coord ref."
- [content fps zoom on-click ev]
+ selection (a proxy); a plain CLICK (no drag) just moves the playhead, so you
+ can still scrub in marking mode. `content` is the coord ref."
+ [content fps zoom ev]
(.preventDefault ev)
(let [rect (.getBoundingClientRect content)
sx (.-clientX ev)
- to (fn [cx] (frame-index "selection frame" (max 0 (* (/ (- cx (.-left rect)) zoom) fps))))
+ to (fn [cx] (max 0 (* (/ (- cx (.-left rect)) zoom) fps)))
a (to sx)
moved? (atom false)
mv (fn [e]
@@ -521,8 +511,8 @@
(let [was @moved? b (to (.-clientX e)) lo (min a b) hi (max a b)]
(reset! region-sel nil)
(if (and was (> (- hi lo) 0.5))
- (rf/dispatch [::events/draft-select-range lo hi])
- (on-click a))))] ; click (no drag)
+ (rf/dispatch [::events/draft-select-range (js/Math.round lo) (js/Math.round hi)])
+ (goto! a))))] ; click → move the playhead
(.addEventListener js/document "mousemove" mv)
(.addEventListener js/document "mouseup" up)))
@@ -634,7 +624,6 @@
thumbs @(rf/subscribe [::subs/thumbnails])
authoring? (some? @(rf/subscribe [::subs/draft-group]))
active-mark @(rf/subscribe [::subs/active-mark])
- ctx @(rf/subscribe [::subs/context])
linking @(rf/subscribe [::subs/linking])
len @(rf/subscribe [::subs/length])
width (px len fps zoom)
@@ -667,17 +656,17 @@
label]]))]
[:div.ann-lanes {:style {:height lane-h :width width}
:on-mouse-down #(scrub! @content fps zoom %)}
- ;; VISUAL bars — one rectangle per piece (solid saved, dashed draft).
- ;; Interaction is NOT here: a mark can span several pieces, so its
- ;; drag/handles live on ONE per-mark layer below (that's the fix for
- ;; handles-at-every-clip-boundary). Draft pieces are pointer-events
- ;; none so the per-mark layer receives the events.
+ ;; annotation bars — solid for saved, dashed for the in-progress draft
+ ;; visible annotations: full bars with labels, greedily packed into lanes
(for [a visible
[j [lo hi mid]] (map-indexed vector (:bars a))]
^{:key (str (:id a) "-" j)}
[:div.ann-bar {:title (:name a)
:on-mouse-down
- (when-not (:draft a)
+ (if (:draft a)
+ ;; draft/edit: drag the whole mark, or click (no drag)
+ ;; to draw on it. Both make it the active mark.
+ (fn [e] (mark-drag! (:id a) mid :move lo hi fps zoom e))
(fn [e] (.stopPropagation e)
(if linking
(do (.preventDefault e) ; pick: link to this timeline
@@ -691,40 +680,25 @@
:style {:top (+ 2 (* (lane-of (:id a)) 18)) :height 14
:left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom))
:background (str (:color a) (if (:draft a) "44" "cc"))
- :cursor (if (:draft a) "default" "pointer")
- :pointer-events (when (:draft a) "none")
+ :cursor (if (:draft a) "grab" "pointer")
:border-radius 2
- :border (str (if (:draft a) "1px dashed " "1px solid ") (:color a))}}])
- ;; per-MARK interaction layer (draft/edit only): each mark is ONE unit
- ;; spanning its whole extent — body-drag = move, click = draw, and
- ;; exactly two end-handles = resize (roll-proxy). No matter how many
- ;; visual pieces the mark has, it gets one handle pair, at its ends.
- (for [a visible :when (:draft a)
- mid (distinct (map #(nth % 2) (:bars a)))
- ;; Exact context-local extent. The drag keeps the fixed endpoint
- ;; at this value so its mark re-derives identically.
- :let [ext (scene/mark-extent scene (:id a) mid segs)]
- :when ext
- :let [[lo hi] ext
- active? (= mid active-mark)]]
- ^{:key (str "edit-" (:id a) "-" mid)}
- [:div.mark-edit {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :move lo hi fps zoom e))
- :style {:position "absolute" :top (+ 2 (* (lane-of (:id a)) 18)) :height 14
- :left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom))
- :cursor "grab" :border-radius 2
- :box-shadow (when active? "0 0 0 2px var(--ink)")
- :z-index (if active? 4 2)}}
- (let [grip {:width 3 :height 9 :border-radius 2
- :background "var(--paper)" :border "1px solid var(--ink)"}
- zone {:position "absolute" :top 0 :width 9 :height "100%" :cursor "ew-resize"
- :display "flex" :align-items "center" :justify-content "center"}]
- [:<>
- [:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :start lo hi fps zoom e))
- :style (assoc zone :left -3)}
- [:div {:style grip}]]
- [:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :end lo hi fps zoom e))
- :style (assoc zone :right -3)}
- [:div {:style grip}]]])])
+ :border (str (if (:draft a) "1px dashed " "1px solid ") (:color a))
+ :box-shadow (when (and mid (= mid active-mark)) "0 0 0 2px var(--ink)")
+ :z-index (when (and mid (= mid active-mark)) 3)}}
+ ;; edge handles: drag to roll one endpoint (adds/drops clips as it
+ ;; crosses a boundary via roll-proxy). Only on the draft/edit mark.
+ (when (:draft a)
+ (let [grip {:width 3 :height 9 :border-radius 2
+ :background "var(--paper)" :border "1px solid var(--ink)"}
+ zone {:position "absolute" :top 0 :width 9 :height "100%" :cursor "ew-resize"
+ :display "flex" :align-items "center" :justify-content "center"}]
+ [:<>
+ [:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :start lo hi fps zoom e))
+ :style (assoc zone :left -3)}
+ [:div {:style grip}]]
+ [:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :end lo hi fps zoom e))
+ :style (assoc zone :right -3)}
+ [:div {:style grip}]]]))])
;; visible annotation labels
(for [a visible :let [[lo _] (first (:bars a))] :when lo]
^{:key (str "lbl-" (:id a))}
@@ -763,8 +737,7 @@
[:div.content.track-content {:ref (fn [n] (reset! content n))
;; while authoring, drag empty space to select a region
:on-mouse-down (if authoring?
- ;; empty timeline: drag = region, click = move playhead
- #(region-select! @content fps zoom goto! %)
+ #(region-select! @content fps zoom %)
#(scrub! @content fps zoom %))
:style {:width width :height tracks-h}}
(for [[i t] (map-indexed vector tracks)]
@@ -781,10 +754,7 @@
(if linking
(commit-link! (scene/seg-point scene seg 0)
(clip-label scene segs (:mark seg)))
- ;; drag = region; click = pick this clip (two-click flow)
- (region-select! @content fps zoom
- (fn [_] (rf/dispatch [::events/draft-click-seg (:mark seg)]))
- e))))
+ (region-select! @content fps zoom e))))
:style {:left (px c fps zoom) :width (max 1 (px (- d c) fps zoom))
:top (* (get track-y track 0) row-h) :height (- row-h 2)
:line-height (str (- row-h 2) "px") :position "absolute"}}
@@ -797,10 +767,10 @@
:border "1px solid rgba(78,143,194,0.85)"
:pointer-events "none" :z-index 5}}])]]]]))))
-;; --- links: inline markdown chips -----------------------------------------
-;; Content links are named tokens like `[label](mark:ref@at)`,
-;; `[label](timeline:gid)`, or `[label](note:gid)` (see tl.md). The editor is a
-;; contenteditable surface where links live as atomic chips.
+;; --- links: inline markdown chips that seek the timeline ------------------
+;; A link is a ref-point named in the content as `[label](mark:ref@at)` (see
+;; tl.scene). The editor is a contenteditable surface where links live as atomic
+;; chips (delete with backspace, click to seek); everything else is plain text.
(defn- link-frame
"ctx-local frame for a chip's {:ref :at}, resolved against the live scene."
@@ -811,68 +781,45 @@
(defn- goto-link! [local]
(when local (goto! local true)))
-(defn- note-link-ok? [scene ref]
- (= :script-note (get-in scene [:groups ref :type])))
-
(defn content-display
"Read-only render of annotation `content`: markdown blocks (headings, lists,
paragraphs) with inline formatting plus clickable link chips."
[scene ctx content]
(md/render content
(fn [{:keys [kind label ref at]}]
- (case kind
- :timeline
+ (if (= :timeline kind)
(let [path (scene/path-to scene ref)]
[:span.link-chip {:class (when-not path "broken")
:title (when-not path "timeline no longer here")
:on-click #(when path (rf/dispatch [::events/open-stack path]))}
"⤢ " label])
-
- :script-note
- (let [ok? (note-link-ok? scene ref)]
- [:span.link-chip {:class (when-not ok? "broken")
- :title (when-not ok? "script note no longer here")
- :on-click #(when ok? (rf/dispatch [::events/jump-to-note ref]))}
- (if ok? "📄 " "△ ") label])
-
(let [lf (scene/link-local scene ctx {:ref ref :at at})]
[:span.link-chip {:class (when-not lf "broken")
:title (when-not lf "linked clip no longer in this timeline")
:on-click #(goto-link! lf)}
(when-not lf "△ ") label
- (when lf [:span.link-f (str " " (scene/assert-frame "link frame" lf) "f")])])))))
+ (when lf [:span.link-f (str " " (js/Math.round lf) "f")])])))))
(defn- build-chip [{:keys [label ref at kind]}]
(let [span (js/document.createElement "span")
scene @(rf/subscribe [::subs/scene])
timeline? (= :timeline kind)
- note? (= :script-note kind)
- lf (when-not (or timeline? note?)
+ lf (when-not timeline?
(scene/link-local scene @(rf/subscribe [::subs/context]) {:ref ref :at at}))
- ok (cond
- timeline? (some? (scene/path-to scene ref))
- note? (note-link-ok? scene ref)
- :else lf)]
+ ok (if timeline? (some? (scene/path-to scene ref)) lf)]
(set! (.-className span) (if ok "link-chip" "link-chip broken"))
(set! (.-contentEditable span) "false")
- (when-not ok (set! (.-title span) (cond
- timeline? "timeline no longer here"
- note? "script note no longer here"
- :else "linked clip no longer in this timeline")))
- (set! (.-textContent span) (str (cond
- timeline? "⤢ "
- note? "📄 "
- (not ok) "△ "
- :else "")
- label))
+ (when-not ok (set! (.-title span) (if timeline? "timeline no longer here"
+ "linked clip no longer in this timeline")))
+ (set! (.-textContent span) (str (cond timeline? "⤢ " (not ok) "△ ") label))
(aset (.-dataset span) "label" label)
(aset (.-dataset span) "ref" (name ref))
(when kind (aset (.-dataset span) "kind" (name kind)))
- (when-not (or timeline? note?) (aset (.-dataset span) "at" (str at)))
+ (when-not timeline? (aset (.-dataset span) "at" (str at)))
(when lf
(let [f (js/document.createElement "span")]
(set! (.-className f) "link-f")
- (set! (.-textContent f) (str " " (scene/assert-frame "link frame" lf) "f"))
+ (set! (.-textContent f) (str " " (js/Math.round lf) "f"))
(.appendChild span f)))
span))
@@ -921,16 +868,10 @@
(.removeAllRanges s) (.addRange s r))))
:on-input emit :on-key-up save! :on-mouse-up save! :on-blur save!
:on-click (fn [e] (when-let [chip (.closest (.-target e) ".link-chip")]
- (case (.. chip -dataset -kind)
- "timeline" (when-let [path (scene/path-to @(rf/subscribe [::subs/scene])
- (keyword (.. chip -dataset -ref)))]
- (rf/dispatch [::events/open-stack path]))
- "script-note" (rf/dispatch [::events/jump-to-note
- (keyword (.. chip -dataset -ref))])
- (when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))]
- (goto-link! lf)))))}]))
+ (when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))]
+ (goto-link! lf))))}]))
-(defn- point-candidates [scene ctx notes q timelines?]
+(defn- point-candidates [scene ctx q timelines?]
(let [needle (str/lower-case q)
n (when (re-matches #"-?\d+" q) (js/parseInt q 10))]
(vec
@@ -951,21 +892,15 @@
(keep (fn [{:keys [gid name in path]}]
(when (str/includes? (str/lower-case (str "timeline " name " " in)) needle)
{:label name :kind :timeline :group (when in (str "in " in))
- :point {:kind :timeline :ref gid} :path path})))))
- (when timelines?
- (->> notes
- (keep (fn [{:keys [id name]}]
- (when (str/includes? (str/lower-case (str "note script " name)) needle)
- {:label name :kind :script-note :group "script note"
- :point {:kind :script-note :ref id}})))))))))
+ :point {:kind :timeline :ref gid} :path path})))))))))
(defn- point-label [cand off local]
- (str (:label cand) " @" (scene/assert-frame "point label frame" local) "f"
+ (str (:label cand) " @" (js/Math.round local) "f"
(when (and (not (:abs cand)) (pos? off))
(str " +" off))))
(defn- pick-point [cand off]
- (if (contains? #{:timeline :script-note} (:kind cand))
+ (if (= :timeline (:kind cand))
(assoc (:point cand) :label (:label cand) :local (:local cand) :candidate cand :offset 0)
(let [o (if (:abs cand) 0 (min (max 0 off) (max 0 (dec (or (:len cand) 1)))))
local (+ (:local cand) o)]
@@ -984,11 +919,8 @@
idx (r/atom 0)
off (r/atom (or (:offset value) 0))
picked (r/atom value)
- ;; start CLOSED; only opens on focus (an auto-focused picker opens
- ;; itself via :on-focus). Was defaulting open even when unfocused.
- open? (r/atom (boolean auto-focus?))]
- (let [notes @(rf/subscribe [::subs/notes])
- cands (point-candidates scene ctx notes @text timelines?)
+ open? (r/atom true)]
+ (let [cands (point-candidates scene ctx @text timelines?)
i (min @idx (max 0 (dec (count cands))))
cur (or (:candidate @picked) (get cands i))
maxo (max 0 (dec (or (:len cur) 1)))
@@ -999,7 +931,6 @@
(cond
(not timelines?) (goto! (:local (pick-point cand o2)))
(= :timeline (:kind cand)) (rf/dispatch [::events/open-stack (:path cand)])
- (= :script-note (:kind cand)) nil
:else (rf/dispatch [::events/preview-frame
(:local (pick-point cand o2))]))))
emit! (fn [cand o2]
@@ -1017,12 +948,7 @@
(reset! open? true)
(reset! off 0)
(preview! (get cands j) 0))]
- [:div.pt-input {:class class
- ;; close the dropdown once focus leaves the picker entirely
- ;; (but not when it just moves between the text/frame inputs)
- :on-blur (fn [e]
- (when-not (.contains (.-currentTarget e) (.-relatedTarget e))
- (reset! open? false)))}
+ [:div.pt-input {:class class}
[:input.pt-text
{:auto-focus auto-focus?
:placeholder (or placeholder "clip / annotation / frame...")
@@ -1033,7 +959,7 @@
(reset! idx 0)
(reset! off 0)
(reset! open? true)
- (preview! (first (point-candidates scene ctx notes (.. % -target -value) timelines?)) 0))
+ (preview! (first (point-candidates scene ctx (.. % -target -value) timelines?)) 0))
:on-key-down
(fn [e]
(case (.-key e)
@@ -1066,25 +992,22 @@
:on-mouse-down #(.preventDefault %)
:on-mouse-enter #(go! j)
:on-click #(emit! c 0)}
- (when timelines? [:span.cand-kind (case (:kind c)
- :timeline "⤢ "
- :script-note "📄 "
- "↪ ")])
+ (when timelines? [:span.cand-kind (if (= :timeline (:kind c)) "⤢ " "↪ ")])
[:span.cand-label (:label c)]
(when (:group c) [:span.cand-group (str " " (:group c))])
- (when-not (contains? #{:timeline :script-note} (:kind c))
- [:span.link-f (str " " (scene/assert-frame "candidate frame" (:local c)) "f")])])))])))
+ (when-not (= :timeline (:kind c))
+ [:span.link-f (str " " (js/Math.round (:local c)) "f")])])))])))
(defn- local->draft-point [segs local]
(some (fn [{m :mark [c d] :local}]
(when (and (<= c local) (< local d))
- {:seg m :f (scene/assert-frame "draft point frame" (- local c))}))
+ {:seg m :f (js/Math.round (- local c))}))
segs))
(defn- local->draft-end-point [segs local]
(some (fn [{m :mark [c d] :local}]
(when (and (<= c local) (<= local d))
- {:seg m :f (scene/assert-frame "draft endpoint frame" (- local c))}))
+ {:seg m :f (js/Math.round (- local c))}))
segs))
;; --- shared string autocomplete ------------------------------------------
@@ -1138,67 +1061,16 @@
[:span.tag t (when on-remove [:button.tag-x {:type "button" :title "Remove tag"
:on-click #(on-remove t)} "✕"])])
-(defn- group-name [scene gid]
- (if (or (nil? gid) (= :root gid))
- "root"
- (let [g (get-in scene [:groups gid])]
- (or (:name g) (get-in g [:media :name]) (some-> gid name)))))
-
-;; The `in:` row — every mark-group this annotation is FILED UNDER (:in). Click a
-;; chip to go there; ✕ un-files it (never its primary home). + opens a picker to
-;; file into any other group (annotation or timeline/act), at any nesting depth —
-;; that's the "link across arbitrarily nested groups" gesture (search, not drag).
-(defn- membership-chips [scene a authed?]
- (r/with-let [adding? (r/atom false)]
- (let [gid (:id a)
- homes (:parents a)
- prim (:parent a)
- cands (->> (:groups scene)
- (keep (fn [[g grp]]
- (when (and (contains? #{:annotation :timeline} (:type grp))
- (not= g gid)
- (not (contains? homes g)))
- {:gid g :label (group-name scene g)})))
- (sort-by :label))]
- [:div.ann-in
- [:span.ann-in-label "in:"]
- (for [h (sort homes)]
- ^{:key (str h)}
- [:span.in-chip {:title (str "Go to " (group-name scene h))
- :on-click #(rf/dispatch (if (= h :root)
- [::events/pop-to :root]
- [::events/expand h]))}
- (group-name scene h)
- (when (and authed? (not= h prim))
- [:button.in-x {:type "button" :title "Un-file"
- :on-click (fn [e] (.stopPropagation e)
- (rf/dispatch [::events/unfile gid h]))} "✕"])])
- (when authed?
- (if @adding?
- [:span.in-add-pop
- [autocomplete {:items (mapv :label cands) :placeholder "file into…"
- :auto-focus? true
- :on-choose (fn [label]
- (when-let [c (some #(when (= label (:label %)) %) cands)]
- (rf/dispatch [::events/file-into gid (:gid c)]))
- (reset! adding? false))}]
- [:button.in-x {:type "button" :on-click #(reset! adding? false)} "✕"]]
- [:button.in-plus {:type "button" :title "File into another group"
- :on-click #(reset! adding? true)} "+"]))])))
-
(defn- link-picker [{:keys [scene ctx on-commit on-cancel]}]
(r/with-let [picked (r/atom nil)]
- [:div.mark-block.pending.link-insert-block
- [:div.mark-row
- [:span.mark-grip.disabled {:title "Insert link"} "↪"]
- [point-picker {:scene scene :ctx ctx :value @picked :auto-focus? true :timelines? true
- :placeholder "clip / annotation / timeline / note..."
- :on-pick #(reset! picked %)
- :on-cancel on-cancel}]
- [:button.hl-ok {:type "button" :title "Insert link" :disabled (nil? @picked)
- :on-click #(when @picked (on-commit @picked))}
- "✓"]
- [:button.hl-cancel {:type "button" :title "Cancel" :on-click on-cancel} "✕"]]]))
+ [:div.link-insert
+ [point-picker {:scene scene :ctx ctx :value @picked :auto-focus? true :timelines? true
+ :on-pick #(reset! picked %)
+ :on-cancel on-cancel}]
+ [:button.hl-ok {:type "button" :title "Insert link" :disabled (nil? @picked)
+ :on-click #(when @picked (on-commit @picked))}
+ "✓"]
+ [:button.hl-cancel {:type "button" :title "Cancel" :on-click on-cancel} "✕"]]))
(defn- commit-link!
"Insert a link chip for ref-point `pt` (label `label`) at the editor caret."
@@ -1253,7 +1125,7 @@
;; Drag-drop wiring shared by both card variants: an annotation is a drag source
;; (carries its gid) AND a drop target (drop another annotation onto it to make it
;; a child). `over?` is a local atom driving the drop-target highlight.
-(defn- ann-drag-props [a authed? over? source-parent]
+(defn- ann-drag-props [a authed? over?]
(when authed?
{:draggable true
;; cards nest, so stop each drag event at the card it fires on — otherwise it
@@ -1263,31 +1135,25 @@
(.stopPropagation e)
(.. e -dataTransfer (setData "text/ann" (name (:id a))))
(set! (.. e -dataTransfer -effectAllowed) "move")
- (rf/dispatch [::events/ann-drag-start (:id a) source-parent]))
+ (rf/dispatch [::events/ann-drag-start (:id a)]))
:on-drag-end (fn [_] (reset! over? false) (rf/dispatch [::events/ann-drag-end]))
:on-drag-over (fn [e]
(when (has-type? e "text/ann")
(.stopPropagation e) (.preventDefault e) (reset! over? true)))
:on-drag-leave (fn [_] (reset! over? false))
- ;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS
- ;; (links, keeping the old home) — file-manager convention.
:on-drop (fn [e]
(let [src (.. e -dataTransfer (getData "text/ann"))]
(when (seq src)
(.stopPropagation e) (.preventDefault e) (reset! over? false)
- (rf/dispatch [::events/reparent (keyword src) (:id a) (.-altKey e)]))))}))
+ (rf/dispatch [::events/reparent (keyword src) (:id a)]))))}))
-(defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen]
+(defn- annotation-card [a scene ctx segs nmap authed? open by-parent]
(r/with-let [over? (r/atom false) hov? (r/atom false)]
(let [active? @(rf/subscribe [::subs/annotation-active? (:id a)])
dragging @(rf/subscribe [::subs/dragging-ann])
drop-ok? (and dragging (not= dragging (:id a)))
- ;; filed here but its footage doesn't land in this context → a reference
- ;; card: listed for organisation, no bars to draw. Jump still works.
- reference? (and (not (:draft a)) (empty? (:bars a)))
- drag-props (merge (ann-drag-props a authed? over? source-parent)
+ drag-props (merge (ann-drag-props a authed? over?)
{:class (str (when active? "active ")
- (when reference? "reference ")
(when (and drop-ok? @over?) "drop-over ")
(when drop-ok? "drop-ready"))})]
(if (:hidden a)
@@ -1304,13 +1170,10 @@
(:name a)]
[:div {:style {:display "flex" :gap "2px" :visibility (if @hov? "visible" "hidden")}}
[:button.expand-btn {:title "Expand" :on-click #(rf/dispatch [::events/expand (:id a)])} "⤢"]
- [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-annotation (:id a)])} "✎"]]]
+ [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-draft (:id a)])} "✎"]]]
[:div.ann (merge drag-props
{:id (str "ann-" (name (:id a)))
- ;; grey out an annotation with dangling marks (it sorts to the
- ;; bottom too) — still shown so its surviving marks stay usable
- :style (cond-> {"--ann-color" (:color a)}
- (:broken a) (assoc :opacity 0.55))})
+ :style {"--ann-color" (:color a)}})
[:div.ann-head
[:div.ann-title
[:span.ann-swatch {:style {:background (:color a)}}]
@@ -1322,12 +1185,11 @@
[:button.expand-btn {:title "Expand" :on-click #(rf/dispatch [::events/expand (:id a)])}
"⤢" (when (pos? (:nested a)) [:span.nest-badge (:nested a)])]
(when authed?
- [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-annotation (:id a)])} "✎"])
+ [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-draft (:id a)])} "✎"])
(when authed?
[:button.del-btn {:title "Delete"
:on-click #(when (js/confirm (str "Delete \"" (:name a) "\"?"))
(rf/dispatch [::events/delete-annotation (:id a)]))} "✕"])]]
- [membership-chips scene a authed?]
(when (not-empty (:content a)) [content-display scene ctx (:content a)])
(when (seq (:notes a))
[:div.ann-notes
@@ -1337,15 +1199,14 @@
(into [:div.ann-tags]
(for [t (:tags a)] ^{:key t} [tag-chip t])))
(when (pos? (:nested a))
- (let [shown? (contains? revealed (:id a))]
+ (let [shown? (contains? @(rf/subscribe [::subs/revealed]) (:id a))]
[:button.show-children {:on-click #(rf/dispatch [::events/toggle-children (:id a)])}
(str (if shown? "▾ Hide " "▸ Show ") (:nested a)
(if (= 1 (:nested a)) " annotation" " annotations"))]))
- (when-let [kids (subs/visible-child-annotations by-parent revealed (:id a) seen)]
+ (when-let [kids (seq (get by-parent (:id a)))]
(into [:div.ann-children]
(for [k kids]
- ^{:key (:id k)}
- [annotation-card k scene ctx segs nmap authed? open by-parent revealed (:id a) (conj seen (:id a))])))]))))
+ ^{:key (:id k)} [annotation-card k scene ctx segs nmap authed? open by-parent])))]))))
(defn commentary []
(let [open (r/atom nil)]
@@ -1355,8 +1216,7 @@
scene @(rf/subscribe [::subs/scene])
ctx @(rf/subscribe [::subs/context])
segs @(rf/subscribe [::subs/segments])
- nmap (into {} (map (juxt :id identity)) @(rf/subscribe [::subs/notes]))
- revealed @(rf/subscribe [::subs/revealed])]
+ nmap (into {} (map (juxt :id identity)) @(rf/subscribe [::subs/notes]))]
[:div.commentary
;; this context's own description (links resolve in its parent), with an
;; edit button — Edit drops into the parent timeline so marks are editable.
@@ -1365,147 +1225,67 @@
(when (scene/clip-loss? scene ctx)
[:span.ann-warn {:title "Out of range — this annotation references frames its parent timeline trims"} "⚠ "])
(if (seq (:content cg))
- [content-display scene (or (scene/home scene ctx) ctx) (:content cg)]
+ [content-display scene (or (:parent cg) ctx) (:content cg)]
[:div.muted "No description yet."])
(when authed?
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
(if (seq anns)
- ;; group by REFERENCE parent(s): an annotation is listed under every
- ;; timeline its marks were authored in (:parents), so a transcluded one
- ;; shows under each context it belongs to, not just its structural parent.
- (let [by-parent (subs/annotations-by-parent anns)]
+ (let [by-parent (group-by :parent anns)] ; nest revealed children under their parent
(doall
(for [a (get by-parent ctx)]
^{:key (:id a)}
- [annotation-card a scene ctx segs nmap authed? open by-parent revealed ctx #{}])))
+ [annotation-card a scene ctx segs nmap authed? open by-parent])))
[:div.ann-empty "No annotations here."])]))))
(defn- to-frame [v len]
(let [n (js/parseInt v 10)] (-> (if (js/isNaN n) 0 n) (max 0) (min len))))
-;; A mark row's endpoint reads its name/length from the current context's segs;
-;; a TRANSCLUDED mark (collected from another timeline) has no segment here, so
-;; fall back to the track it resolves onto (its clip's source file name is shared
-;; and useless) — a stable identity, from anywhere.
-(defn- pt-name [scene segs seg]
- (let [l (clip-label scene segs seg)]
- (if (= l "clip") (or (scene/ref-track-name scene seg) "clip") l)))
-(defn- pt-len [scene segs seg]
- (or (scene/seg-length segs seg) (scene/ref-length scene seg)))
-
(defn- frame-chip
"A filled endpoint: clip name + a mark-time frame input (edits `put` the group).
The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)."
[scene segs put d i k {:keys [seg f]}]
- (let [len (pt-len scene segs seg)]
+ (let [len (scene/seg-length segs seg)]
[:div.pt-chip
- [:span.pt-chip-name (pt-name scene segs seg)]
+ [:span.pt-chip-name (clip-label scene segs seg)]
[:input.pt-frame {:type "number" :min 0 :max len :value f
:on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}]
[:span.pt-dur (str "/" len)]
[:button.pt-chip-x {:type "button" :title "Re-pick this end"
- :on-click (fn [e]
- (.stopPropagation e)
- (rf/dispatch [::events/unset-endpoint (:gid d) i k]))} "✕"]]))
-
-(defn- proxy-frame-chip
- "Editable endpoint for a proxy (synthetic-clip) mark: clip name + frame input
- that edits the proxy's OWN boundary internal mark's :at in place (`which` =
- :start on its first mark, :end on its last). Crossing a clip boundary is the
- lane handles' job; this is the whole-frame numeric nudge within a clip. The ✕
- clears just this end to re-pick it (the other end stays put)."
- [scene segs gid mark-id pid which {:keys [seg f]}]
- (let [len (pt-len scene segs seg)]
- [:div.pt-chip
- [:span.pt-chip-name (pt-name scene segs seg)]
- [:input.pt-frame {:type "number" :min 0 :max len :value f
- :on-change #(rf/dispatch [::events/set-proxy-frame pid which
- (to-frame (.. % -target -value) len)])}]
- [:span.pt-dur (str "/" len)]
- [:button.pt-chip-x {:type "button" :title "Re-pick this end"
- :on-click (fn [e]
- (.stopPropagation e)
- (rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which]))} "✕"]]))
-
-(defn- pending-frame-chip [scene segs {:keys [seg f]}]
- (let [len (pt-len scene segs seg)]
- [:div.pt-chip.pending
- [:span.pt-chip-name (pt-name scene segs seg)]
- [:input.pt-frame {:type "number" :value (scene/assert-frame "pending frame" f) :disabled true}]
- [:span.pt-dur (str "/" len)]]))
-
-(defn- empty-frame-chip [label]
- [:div.pt-chip.empty
- [:span.pt-chip-name label]
- [:span.pt-dur "empty"]])
-
-(defn- pending-mark-block [{:keys [scene ctx segs pt choosing?]}]
- (let [picked? (map? pt)]
- [:div.mark-block.pending
- [:div.mark-row
- [:span.mark-grip.disabled {:title "New mark"} "⠿"]
- (if picked?
- [pending-frame-chip scene segs pt]
- [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
- :placeholder "click start clip..."
- :on-pick #(when-let [p (local->draft-point segs (:local %))]
- (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}])
- [:span.mark-arrow "→"]
- (if picked?
- [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
- :placeholder "click end clip..."
- :on-pick #(let [end-local (if (and (zero? (:offset %))
- (pos? (or (get-in % [:candidate :len]) 0)))
- (+ (:local %) (get-in % [:candidate :len]))
- (:local %))]
- (when-let [p (local->draft-end-point segs end-local)]
- (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)])))}]
- [empty-frame-chip "End point"])
- [:button.mark-draw {:type "button" :title "Finish the mark before drawing" :disabled true} "🖼+"]
- (when-not choosing?
- [:button.mark-script {:type "button" :title "Finish the mark before adding a script note" :disabled true} "📄+"])
- [:button.row-x {:type "button" :title "Finish or cancel from the timeline" :disabled true} "✕"]]]))
+ :on-click #(rf/dispatch [::events/unset-endpoint (:gid d) i k])} "✕"]]))
;; --- script-note bindings (annotation form) ------------------------------
-;; The pointer lives on the mark and rides the annotation's Save. Existing notes
-;; bind from a compact autocomplete; Add new jumps to the script pane and binds
-;; the highlighted note when it is created.
+;; A note is bound by dragging its chip from the source list onto a drop target
+;; (a mark row, or the annotation-level target). The pointer lives on the referrer
+;; and rides the annotation's Save.
-(defn- mark-note-chip [ng n live on-unbind]
- [:span.bound-note {:class (when (contains? live ng) "live")
- :title "Jump to this passage in the script"
- :on-click #(rf/dispatch [::events/jump-to-note ng])}
- (when (contains? live ng) [:span.note-live "»»» "])
+(defn- note-src-chip
+ "Draggable source chip for note `n`; click also toggles an annotation-level bind."
+ [gid n]
+ [:span.note-src {:draggable true
+ :on-drag-start (fn [e] (.. e -dataTransfer (setData "text/note" (name (:id n)))))
+ :on-click #(rf/dispatch [::events/bind-note-annotation gid (:id n)])
+ :title "Drag onto a mark, or click to bind to the whole annotation"}
[:span.ann-swatch {:style {:background (:color n)}}]
- [:span.bound-note-name (:name n)]
- [:button.row-x {:type "button" :title "Unbind"
- :on-click #(on-unbind ng)} "✕"]])
+ (:name n)])
-(defn- mark-script-picker [gid mark-id notes bound]
- (r/with-let [open? (r/atom false)]
- (let [bound? (set bound)
- choices (remove #(contains? bound? (:id %)) notes)
- by-name (into {} (map (juxt :name :id)) choices)]
- [:span.mark-script-wrap
- [:button.mark-script {:type "button"
- :class (when (seq bound) "has")
- :title "Attach script note"
- :on-click #(swap! open? not)}
- (if (seq bound) "📄" "📄+")]
- (when @open?
- [:div.mark-script-pop {:on-click #(.stopPropagation %)}
- [autocomplete {:items (mapv :name choices)
- :placeholder "script note…"
- :auto-focus? true
- :on-choose (fn [choice]
- (when-let [note-gid (by-name choice)]
- (rf/dispatch [::events/bind-note-mark gid mark-id note-gid])
- (reset! open? false)))}]
- [:button.mark-script-new {:type "button"
- :on-click (fn []
- (reset! open? false)
- (rf/dispatch [::events/new-note-for-mark gid mark-id]))}
- "+ Add new"]])])))
+(defn- note-drop
+ "Drop zone rendering `bound` note-gids as removable chips; a dropped note calls
+ (on-bind note-gid), a chip's ✕ calls (on-unbind note-gid)."
+ [label bound nmap live on-bind on-unbind]
+ [:div.note-drop {:on-drag-over #(.preventDefault %)
+ :on-drop (fn [e] (.preventDefault e)
+ (let [g (.. e -dataTransfer (getData "text/note"))]
+ (when (seq g) (on-bind (keyword g)))))}
+ (when label [:span.note-drop-label label])
+ (if (seq bound)
+ (for [ng bound :let [n (nmap ng)] :when n]
+ ^{:key (name ng)}
+ [:span.bound-note {:class (when (contains? live ng) "live")}
+ (when (contains? live ng) [:span.note-live "»»» "])
+ [:span.ann-swatch {:style {:background (:color n)}}]
+ [:span.bound-note-name (:name n)]
+ [:button.row-x {:type "button" :title "Unbind" :on-click #(on-unbind ng)} "✕"]])
+ [:span.note-drop-hint "drop a note"])])
;; drag-to-reorder marks: one live drag at a time, so a single module atom holds
;; {:src i :over j}. Deref'd in the form so the drop line follows the cursor.
@@ -1533,46 +1313,34 @@
:on-drag-end (fn [_] (reset! mark-drag nil))})
(defn annotation-form []
- (r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid)
- last-scrolled (atom nil)]
+ (r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid)]
(let [d @(rf/subscribe [::subs/draft-group])
scene @(rf/subscribe [::subs/scene])
;; anchor the form to the draft's home context, not the live stack top:
;; a link-insert timeline preview moves the stack, but this annotation
- ;; still belongs to its primary home (first :in), so pickers stay stable.
- ctx (or (first (:in d)) (:gid d)) ; annotation: its home; root: itself
+ ;; still belongs to (:parent d), so its marks/pickers stay stable.
+ ctx (or (:parent d) (:gid d)) ; annotation: its parent; root: itself
segs (scene/content-segments scene ctx)
pt @(rf/subscribe [::subs/pt])
linking @(rf/subscribe [::subs/linking])
gid (:gid d)
new? (= :new (:draft d))
- root? (= :timeline (:type d))
- ;; ONE shared form for new + edit. In draft/new we HIDE the lower fields
- ;; (content, notes, save) until a title is picked — pick a new title to
- ;; "create new", or an existing annotation to "edit existing". The title
- ;; sits at the top (above the marks), same place the name does in edit.
- choosing? (and new? (not root?) (= :choosing @(rf/subscribe [::subs/draft-stage])))
+ root? (nil? (:parent d))
+ ;; a fresh draft starts in the "choosing" stage: just marks + a title
+ ;; autocomplete (pick an existing annotation → associate; type a new
+ ;; title → create). Everything else appears once you've committed.
+ choosing? (and new? (not root?) (= :choosing @(rf/subscribe [::subs/draft-stage]))) ; the root timeline: content only
put (fn [g] (rf/dispatch [::events/put-group gid (dissoc g :gid)]))
notes @(rf/subscribe [::subs/notes])
nmap (into {} (map (juxt :id identity)) notes)
live @(rf/subscribe [::subs/active-note-set])
active @(rf/subscribe [::subs/active-mark])
- ;; The root timeline's mark is absolute numeric [start/end], not a ref
- ;; mark. Root editing is description-only, so do not run it through the
- ;; annotation mark-row machinery.
- rows (when-not root? (scene/marks->rows scene (:marks d)))
- broken (if root? #{} (set (scene/broken-marks scene gid))) ; marks whose refs no longer resolve
+ rows (scene/marks->rows scene (:marks d))
valid? (or root? (and (not (str/blank? (:name d))) (seq (:marks d))))
save #(when valid?
(rf/dispatch [::events/save-group gid (dissoc d :draft :gid)
(when-not new? orig)])
(rf/dispatch [::events/finish-edit]))]
- (when (and active (not= active @last-scrolled))
- (reset! last-scrolled active)
- (r/after-render
- #(when-let [node (js/document.querySelector
- (str "[data-mark-row='" active "']"))]
- (.scrollIntoView node #js {:block "nearest" :behavior "smooth"}))))
[:form.form {:on-submit (fn [e] (.preventDefault e) (save))}
[:div.form-head (cond root? "Edit description" new? "New annotation" :else "Edit annotation")]
(when (and (not root?) (not choosing?))
@@ -1581,27 +1349,38 @@
[:input.form-name {:placeholder "Name" :value (:name d)
:on-change #(put (assoc d :name (.. % -target -value)))}]
[:input.form-color {:type "color" :value (:color d)
- :on-change #(put (assoc d :color (.. % -target -value)))}]]])
+ :on-change #(put (assoc d :color (.. % -target -value)))}]]
+ [:label.form-check {:title "During playback, scroll each of this annotation's clips into view as the playhead reaches it"}
+ [:input {:type "checkbox" :checked (boolean (get-in d [:meta :scroll-to]))
+ :on-change #(put (assoc-in d [:meta :scroll-to] (.. % -target -checked)))}]
+ [:span "Follow clips during playback"]]
+ [:label.form-check {:title "Hide this annotation from the timeline lane (still usable in links)"}
+ [:input {:type "checkbox" :checked (boolean (get-in d [:meta :hidden]))
+ :on-change #(put (assoc-in d [:meta :hidden] (.. % -target -checked)))}]
+ [:span "Hide from timeline"]]
+ [:div.form-marks-label "Tags"]
+ (let [tags (vec (get-in d [:meta :tags]))]
+ [:div.tag-editor
+ (into [:div.tag-list]
+ (for [t tags]
+ ^{:key t} [tag-chip t #(put (assoc-in d [:meta :tags] (vec (remove #{%} tags))))]))
+ [autocomplete {:items (filterv (complement (set tags)) @(rf/subscribe [::subs/project-tags]))
+ :placeholder "add tag…" :allow-new? true
+ :on-choose #(put (assoc-in d [:meta :tags] (conj tags %)))}]])])
+ (when-not choosing?
+ [:<>
+ [:div.form-marks-label "Content"]
+ ^{:key gid} [content-editor gid (:content orig)]
+ (if (and linking (= gid (:gid linking)))
+ [link-picker {:scene scene :ctx ctx
+ :on-commit #(commit-link! (select-keys % [:ref :at :kind]) (:label %))
+ :on-cancel #(rf/dispatch [::events/cancel-linking])}]
+ [:button.add-mark {:type "button" :on-click #(rf/dispatch [::events/start-linking gid])}
+ "Insert link"])
+ (when (and linking (= gid (:gid linking)))
+ [:div.form-hint "Click a clip or the frame-readout to link it, or pick above."])])
(when-not root?
[:<>
- ;; the title IS the create/associate control: type a new title to make a
- ;; fresh annotation with these marks, or pick an existing annotation to
- ;; add them to it (transclusion). Above the marks + autofocused so you can
- ;; name it first thing.
- (when choosing?
- (let [targets @(rf/subscribe [::subs/associate-targets])
- by-name (into {} (map (juxt :name :gid)) targets)
- ctx-of (into {} (map (juxt :name :in)) targets)]
- [:div.form-associate
- [:div.form-marks-label "Title"]
- [autocomplete {:items (mapv :name targets) :allow-new? true :auto-focus? true
- :placeholder "new title, or pick an annotation to add to…"
- :item-suffix (fn [n] (when-let [c (ctx-of n)]
- [:span.cand-group (str " · " c)]))
- :on-choose (fn [choice]
- (if-let [g (by-name choice)]
- (rf/dispatch [::events/associate-marks gid g])
- (rf/dispatch [::events/create-named gid choice])))}]]))
[:div.form-marks-label "Marks"]
(doall
(for [[i row] (map-indexed vector rows)
@@ -1612,43 +1391,24 @@
[:div.mark-block (merge (mark-drag-props put d i)
{:class (str (when (= i (:src drag)) "dragging ")
(when (= mark-id active) "active-mark ")
- (when (contains? broken mark-id) "broken ")
(when (and (:src drag) (= i (:over drag))
- (not= i (:src drag))) "drop-before"))
- :data-mark-row mark-id
- :on-click #(rf/dispatch [::events/set-active-mark mark-id])})
+ (not= i (:src drag))) "drop-before"))})
[:div.mark-row
[:span.mark-grip {:draggable true :title "Drag to reorder"
:on-drag-start (fn [e]
(.. e -dataTransfer (setData "text/mark-idx" (str i)))
(set! (.. e -dataTransfer -effectAllowed) "move")
(reset! mark-drag {:src i}))} "⠿"]
- (when (contains? broken mark-id)
- [:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "])
- ;; a proxy collapses its cross-clip run to first-clip start →
- ;; last-clip end; each endpoint edits the proxy's own boundary
- ;; mark's frame (crossing a clip boundary is the lane handles).
- ;; A plain clip mark edits its own :at directly.
- (if-let [pid (:proxy row)]
- ;; while re-picking one end (after its ✕) that end becomes a live
- ;; clip picker in the row; the other end stays a normal chip.
- (let [pick (when (and (map? pt) (= (:proxy pt) pid)) (:which pt))]
- [:<>
- (if (= pick :start)
- [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
- :placeholder "click a clip for start…"
- :on-cancel #(rf/dispatch [::events/draft-focus :new])
- :on-pick #(when-let [p (local->draft-point segs (:local %))]
- (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]
- [proxy-frame-chip scene segs gid mark-id pid :start (:s row)])
- [:span.mark-arrow "→"]
- (if (= pick :end)
- [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
- :placeholder "click a clip for end…"
- :on-cancel #(rf/dispatch [::events/draft-focus :new])
- :on-pick #(when-let [p (local->draft-end-point segs (:local %))]
- (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]
- [proxy-frame-chip scene segs gid mark-id pid :end (:e row)])])
+ ;; a proxy collapses its cross-clip run to one read-only span
+ ;; (first-clip start → last-clip end); endpoint editing is via the
+ ;; lane handles (a later chunk). A plain clip mark stays editable.
+ (if (:proxy row)
+ [:<>
+ [:span.pt-chip.proxy [:span.pt-chip-name
+ (str (clip-label scene segs (:seg (:s row))) " @" (:f (:s row)) "f")]]
+ [:span.mark-arrow "→"]
+ [:span.pt-chip.proxy [:span.pt-chip-name
+ (str (clip-label scene segs (:seg (:e row))) " @" (:f (:e row)) "f")]]]
[:<>
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
@@ -1661,52 +1421,63 @@
(goto! s true))
(rf/dispatch [::events/start-drawing gid mark-id]))}
(if (seq (:drawings mark)) "🖼" "🖼+")]
- (when-not choosing?
- [mark-script-picker gid mark-id notes (:notes mark)])
[:button.row-x {:type "button" :title "Remove"
:on-click #(rf/dispatch [::events/remove-mark gid i])} "✕"]]
(when-not choosing?
- (when (seq (:notes mark))
- (into [:div.mark-note-list]
- (for [ng (:notes mark) :let [n (nmap ng)] :when n]
- ^{:key (name ng)}
- [mark-note-chip ng n live #(rf/dispatch [::events/unbind-note-mark gid mark-id %])]))))]))
- (when (or (= pt :new) (and (map? pt) (not (:proxy pt))))
- [pending-mark-block {:scene scene :ctx ctx :segs segs :pt pt :choosing? choosing?}])
- [:div.form-hint "Drag across the timeline to select a range (click to move the playhead)."]])
- (when-not choosing?
- [:<>
- (when-not root?
+ [note-drop nil (:notes mark) nmap live
+ #(rf/dispatch [::events/bind-note-mark gid mark-id %])
+ #(rf/dispatch [::events/unbind-note-mark gid mark-id %])])]))
+ (when (map? pt)
+ [:div.mark-row
+ [:div.pt-chip [:span.pt-chip-name (str (clip-label scene segs (:seg pt))
+ " @" (js/Math.round (:f pt)) "f")]]
+ [:span.mark-arrow "→"]
+ [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
+ :placeholder "click end clip..."
+ :on-pick #(let [end-local (if (and (zero? (:offset %))
+ (pos? (or (get-in % [:candidate :len]) 0)))
+ (+ (:local %) (get-in % [:candidate :len]))
+ (:local %))]
+ (when-let [p (local->draft-end-point segs end-local)]
+ (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)])))}]])
+ (when (= pt :new)
+ [:div.mark-row
+ [point-picker {:scene scene :ctx ctx :class "active"
+ :placeholder "click a clip..."
+ :on-pick #(when-let [p (local->draft-point segs (:local %))]
+ (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]])
+ [:div.form-hint "Drag across the timeline to select a range (click to move the playhead)."]
+ ;; the title IS the create/associate control: type a new title to make a
+ ;; fresh annotation with these marks, or pick an existing annotation to
+ ;; add them to it (dropping straight into its edit form). Transclusion.
+ (when choosing?
+ (let [targets @(rf/subscribe [::subs/associate-targets])
+ ;; match on the plain NAME (round-trips cleanly); the home
+ ;; context is a dropdown-only hint via :item-suffix, so it never
+ ;; leaks into a newly-created annotation's name.
+ by-name (into {} (map (juxt :name :gid)) targets)
+ ctx-of (into {} (map (juxt :name :in)) targets)]
+ [:div.form-associate
+ [:div.form-marks-label "Title"]
+ [autocomplete {:items (mapv :name targets) :allow-new? true
+ :placeholder "new title, or pick an annotation to add to…"
+ :item-suffix (fn [n] (when-let [c (ctx-of n)]
+ [:span.cand-group (str " · " c)]))
+ :on-choose (fn [choice]
+ (if-let [g (by-name choice)]
+ (rf/dispatch [::events/associate-marks gid g])
+ (rf/dispatch [::events/create-named gid choice])))}]]))
+ (when-not choosing?
[:<>
- [:div.form-marks-label "Tags"]
- (let [tags (vec (get-in d [:meta :tags]))]
- [:div.tag-editor
- (into [:div.tag-list]
- (for [t tags]
- ^{:key t} [tag-chip t #(put (assoc-in d [:meta :tags] (vec (remove #{%} tags))))]))
- [autocomplete {:items (filterv (complement (set tags)) @(rf/subscribe [::subs/project-tags]))
- :placeholder "add tag…" :allow-new? true
- :on-choose #(put (assoc-in d [:meta :tags] (conj tags %)))}]])])
- [:div.form-marks-label "Content"]
- ^{:key gid} [content-editor gid (:content orig)]
- (if (and linking (= gid (:gid linking)))
- [link-picker {:scene scene :ctx ctx
- :on-commit #(commit-link! (select-keys % [:ref :at :kind]) (:label %))
- :on-cancel #(rf/dispatch [::events/cancel-linking])}]
- [:button.add-mark {:type "button" :on-click #(rf/dispatch [::events/start-linking gid])}
- "Insert link"])
- (when (and linking (= gid (:gid linking)))
- [:div.form-hint "Click a clip or the frame-readout to link it, or pick above."])
- (when-not root?
- [:<>
- [:label.form-check {:title "During playback, scroll each of this annotation's clips into view as the playhead reaches it"}
- [:input {:type "checkbox" :checked (boolean (get-in d [:meta :scroll-to]))
- :on-change #(put (assoc-in d [:meta :scroll-to] (.. % -target -checked)))}]
- [:span "Follow clips during playback"]]
- [:label.form-check {:title "Hide this annotation from the timeline lane (still usable in links)"}
- [:input {:type "checkbox" :checked (boolean (get-in d [:meta :hidden]))
- :on-change #(put (assoc-in d [:meta :hidden] (.. % -target -checked)))}]
- [:span "Hide from timeline"]]])])
+ [:div.form-marks-label "Script notes"]
+ [note-drop "Whole annotation" (:notes d) nmap live
+ #(rf/dispatch [::events/bind-note-annotation gid %])
+ #(rf/dispatch [::events/unbind-note-annotation gid %])]
+ (if (seq notes)
+ [:div.note-source
+ (for [n notes] ^{:key (name (:id n))} [note-src-chip gid n])]
+ [:div.form-hint "No script notes yet — create them in the Script tab."])
+ [:div.form-hint "Drag a note onto a mark (or the whole-annotation target). It shows »»» while the playhead is in range."]])])
[:div.form-actions
(when-not choosing?
[:button.save {:type "submit" :disabled (not valid?)} "Save"])
@@ -1759,41 +1530,24 @@
;; "Untagged" is just another item that maps to the :untagged sentinel.
(def ^:private untagged-label "Untagged")
-(defn- annotation-filter []
+(defn- tag-filter []
(r/with-let [open? (r/atom false)]
- (let [project-tags @(rf/subscribe [::subs/project-tags])
- {:keys [query tags]} @(rf/subscribe [::subs/annotation-filter])
- total (count @(rf/subscribe [::subs/all-annotations]))
- shown (count @(rf/subscribe [::subs/annotations]))
- filtered (- total shown)
- chosen (set tags)
+ (let [tags @(rf/subscribe [::subs/project-tags])
+ hidden @(rf/subscribe [::subs/hidden-tags])
key-of #(if (= % untagged-label) :untagged %)]
- [:div.annotation-filter
- [:input.annotation-search {:type "search"
- :placeholder "Search all, or prefix timeline:, script:, clip:, tag:"
- :value query
- :on-change #(rf/dispatch [::events/set-annotation-search
- (.. % -target -value)])}]
- (when (seq project-tags)
- [:span.tag-filter
- [:button.filter-btn {:class (when (seq chosen) "active")
- :title "Filter annotations by tag"
- :on-click #(swap! open? not)}
- "Tags" (when (seq chosen) (str " (" (count chosen) ")"))]
- (when @open?
- [:<>
- [:div.menu-backdrop {:on-click #(reset! open? false)}]
- [:div.filter-pop
- [autocomplete {:items (into [untagged-label] project-tags)
- :placeholder "include tags…" :clear-on-choose? false :auto-focus? true
- :on-choose #(rf/dispatch [::events/toggle-annotation-tag-filter (key-of %)])
- :item-suffix (fn [t] [:span.tag-eye (if (contains? chosen (key-of t)) "✓" "")])}]]])])
- (when (or (seq query) (seq chosen))
- [:span.filter-summary
- (when (pos? filtered) (str filtered " others filtered"))
- [:button.filter-btn.clear {:title "Clear filters"
- :on-click #(rf/dispatch [::events/clear-annotation-filter])}
- "Clear"]])])))
+ (when (seq tags)
+ [:span.tag-filter
+ [:button.filter-btn {:class (when (seq hidden) "active") :title "Show / hide annotations by tag"
+ :on-click #(swap! open? not)}
+ "▽ Tags" (when (seq hidden) (str " (" (count hidden) ")"))]
+ (when @open?
+ [:<>
+ [:div.menu-backdrop {:on-click #(reset! open? false)}]
+ [:div.filter-pop
+ [autocomplete {:items (into [untagged-label] tags)
+ :placeholder "filter tags…" :clear-on-choose? false :auto-focus? true
+ :on-choose #(rf/dispatch [::events/toggle-tag-filter (key-of %)])
+ :item-suffix (fn [t] [:span.tag-eye (if (contains? hidden (key-of t)) "🙈" "👁")])}]]])]))))
(defn toolbar []
;; NB: subscribe the coarse ::at-start?/::at-end? edges, not the raw playhead —
@@ -1806,7 +1560,7 @@
len @(rf/subscribe [::subs/length])
authed? @(rf/subscribe [::subs/authed?])
authoring? (some? @(rf/subscribe [::subs/draft-group]))
- ph-now #(scene/assert-frame "playhead" @(rf/subscribe [::subs/playhead]))]
+ ph-now #(js/Math.round @(rf/subscribe [::subs/playhead]))]
[:div.toolbar
[:div.transport
[:button.step-btn {:title "Previous frame" :disabled start?
@@ -1824,6 +1578,7 @@
[:label.slider {:title "Vertical zoom"} "↕"
[:input {:type "range" :min 8 :max 120 :value row-h
:on-change #(rf/dispatch [::events/set-row-h (js/parseFloat (.. % -target -value))])}]]
+ [tag-filter]
[dark-toggle]]))
(defn- drag-top!
@@ -2053,7 +1808,6 @@
live @(rf/subscribe [::subs/active-note-set])
hidden @(rf/subscribe [::subs/hidden-notes])
authed? @(rf/subscribe [::subs/authed?])
- note-target @(rf/subscribe [::subs/note-target])
script-err @(rf/subscribe [::subs/script-error])
scale (or @zoom 1)
;; notes whose highlights are drawn on the page (eye toggle off)
@@ -2095,13 +1849,6 @@
(reset! scrolled live-note)
(scroll-to-region! rid))))))
[:div.script-pane
- (when note-target
- [:div.script-return
- [:button.hl-cancel {:type "button"
- :title "Back to annotation"
- :on-click #(rf/dispatch [::events/cancel-note-target])}
- "‹ Back"]
- [:span.script-return-text "Highlight script text to make a note for this mark."]])
(if url
[note-rail notes active hidden authed?]
[:div.script-hint
@@ -2133,22 +1880,19 @@
[:button.sel-add {:style {:left (:bx @sel) :top (:by @sel)}
:on-mouse-down #(.preventDefault %) ; keep the selection alive
:on-click (fn []
- (if (and active (not note-target))
+ (if active
(rf/dispatch [::events/add-region-text active region])
(rf/dispatch [::events/highlight-into-new-note region]))
(.removeAllRanges (.getSelection js/window))
(reset! sel nil))}
- (cond
- note-target "+ Create note for mark"
- active (str "+ Highlight → " (:name note))
- :else "+ New note from selection")]))]
+ (if active (str "+ Highlight → " (:name note)) "+ New note from selection")]))]
(when url [:div.script-empty "Loading script…"]))]
(when (and url active note)
[note-editor note active scroll-to-region!])]
(when (and url (seq @pages))
[:div.script-controls
[:button {:title "Zoom out" :on-click #(bump (fn [z] (* z 0.9)))} "−"]
- [:span.zoom-read (str (int (* scale 100)) "%")]
+ [:span.zoom-read (str (js/Math.round (* scale 100)) "%")]
[:button {:title "Zoom in" :on-click #(bump (fn [z] (* z 1.1)))} "+"]
[:button {:title "Fit width" :on-click fit!} "Fit"]])]))))
@@ -2156,18 +1900,14 @@
(let [pane @(rf/subscribe [::subs/pane])
draft @(rf/subscribe [::subs/draft-group])
draft? (some? draft)
- note-target @(rf/subscribe [::subs/note-target])
save-err @(rf/subscribe [::subs/save-error])]
[:div.pane-wrap
(when save-err [:div.err {:style {:padding "4px 8px"}} "△ " save-err])
[:div.pane-tabs
[:button {:class (when (= pane :annotations) "active")
- :on-click #(rf/dispatch [(if note-target
- ::events/cancel-note-target
- ::events/set-pane) :annotations])} "Annotations"]
+ :on-click #(rf/dispatch [::events/set-pane :annotations])} "Annotations"]
[:button {:class (when (= pane :script) "active")
:on-click #(rf/dispatch [::events/set-pane :script])} "Script"]]
- (when (= pane :annotations) [annotation-filter])
[:div.pane-body
(if (= pane :script)
[script-pane]
@@ -2336,7 +2076,7 @@
(when uploading?
[:div.upload-progress
[:div.upload-track [:div.upload-fill {:style {:width (str (* 100 prog) "%")}}]]
- [:span.upload-pct (str (int (* 100 prog)) "%")]])
+ [:span.upload-pct (str (js/Math.round (* 100 prog)) "%")]])
[:div.form-actions
[:button.save {:disabled (or uploading? (str/blank? @pname) (not @otio) (not @clip))
:on-click #(rf/dispatch [::events/create-project @pname @otio @clip])}
diff --git a/tl/test/tl/filter_test.cljs b/tl/test/tl/filter_test.cljs
deleted file mode 100644
index d6a3c48..0000000
--- a/tl/test/tl/filter_test.cljs
+++ /dev/null
@@ -1,46 +0,0 @@
-(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"}))))))
diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs
deleted file mode 100644
index 6ba878d..0000000
--- a/tl/test/tl/flow_test.cljs
+++ /dev/null
@@ -1,245 +0,0 @@
-(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))))))
diff --git a/tl/test/tl/frame_policy_test.cljs b/tl/test/tl/frame_policy_test.cljs
deleted file mode 100644
index 3c6a7f0..0000000
--- a/tl/test/tl/frame_policy_test.cljs
+++ /dev/null
@@ -1,27 +0,0 @@
-(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)))))
diff --git a/tl/test/tl/routes_test.cljs b/tl/test/tl/routes_test.cljs
deleted file mode 100644
index fd0c111..0000000
--- a/tl/test/tl/routes_test.cljs
+++ /dev/null
@@ -1,15 +0,0 @@
-(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"}})))))
diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs
index 51f717b..44b62e8 100644
--- a/tl/test/tl/scene_test.cljs
+++ b/tl/test/tl/scene_test.cljs
@@ -1,7 +1,6 @@
(ns tl.scene-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.md :as md]
- [tl.otio :as otio]
[tl.scene :as s]))
;; --- shared fixture -------------------------------------------------------
@@ -17,13 +16,11 @@
(defn with-group [scene gid g] (assoc-in scene [:groups gid] g))
(defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}})
-(defn err-msg [f]
- (try (f) nil (catch js/Error e (.-message e))))
;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips.
(def inter-x
(with-group base :ann-x
- {:type :annotation :in [:root]
+ {:type :annotation :parent :root
:marks [{:id :m/s0 :start {:ref :clip-b :at 50} :end {:ref :clip-b :at -1}} ; src [150,200)
{:id :m/s1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at 50}} ; src [0,50)
{:id :m/s2 :start {:ref :clip-b :at 0} :end {:ref :clip-b :at 50}} ; src [100,150)
@@ -32,7 +29,7 @@
;; Y inside X, referencing two of X's subclips (parent = :ann-x)
(def x+y
(with-group inter-x :ann-y
- {:type :annotation :in [:ann-x]
+ {:type :annotation :parent :ann-x
:marks [{:id :m/y0 :start {:ref :m/s0 :at 10} :end {:ref :m/s0 :at 20}} ; s0 10..20 -> src [160,170)
{:id :m/y1 :start {:ref :m/s1 :at 0} :end {:ref :m/s1 :at 5}}]})) ; s1 0..5 -> src [0,5)
@@ -50,7 +47,7 @@
(deftest rearrange-and-gap-removal
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track"
(let [scene (with-group base :ann
- {:type :annotation :in [:root]
+ {:type :annotation :parent :root
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})
segs (s/resolve scene :ann)]
(is (= 200 (s/length segs)))
@@ -75,10 +72,10 @@
(testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame"
;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100
(let [scene (-> base
- (with-group :ann {:type :annotation :in [:root]
+ (with-group :ann {:type :annotation :parent :root
:marks [{:id :m/s :start {:ref :clip-a :at 20}
:end {:ref :clip-a :at 80}}]})
- (with-group :ann-y {:type :annotation :in [:ann]
+ (with-group :ann-y {:type :annotation :parent :ann
:marks [{:id :m/y :start {:ref :m/s :at 0}
:end {:ref :m/s :at -1}}]}))
seg (first (s/resolve scene :ann-y))]
@@ -88,14 +85,14 @@
(deftest tracks-by-membership
(testing "zoom includes exactly the tracks the marks touch"
(let [scene (with-group base :ann
- {:type :annotation :in [:root]
+ {:type :annotation :parent :root
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})]
(is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann)))))))
(deftest repeat-yields-two-pieces
(testing "a clip referenced twice renders at two local positions"
(let [scene (with-group base :ann
- {:type :annotation :in [:root]
+ {:type :annotation :parent :root
:marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100)
(refm :m/r1 :clip-b 0 -1) ; B local [100,200)
(refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300)
@@ -162,7 +159,7 @@
(let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210)
scene (-> base
(with-group :prox p)
- (with-group :ann {:type :annotation :in [:root]
+ (with-group :ann {:type :annotation :parent :root
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 170 (s/length segs))) ; 60 + 100 + 10
@@ -176,7 +173,7 @@
(testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip"
(let [p (s/make-proxy base :root 10 60) ; inside A only
scene (-> base (with-group :prox p)
- (with-group :ann {:type :annotation :in [:root]
+ (with-group :ann {:type :annotation :parent :root
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 1 (count (:marks p))))
@@ -220,18 +217,18 @@
(let [p1 (s/make-proxy base :root 0 200) ; A+B
p2 (s/make-proxy base :root 200 300) ; C (abuts B)
scene (-> base (with-group :p1 p1) (with-group :p2 p2)
- (with-group :ann {:type :annotation :in [:root]
+ (with-group :ann {:type :annotation :parent :root
:marks [(s/proxy-ref :m/1 :p1)
(s/proxy-ref :m/2 :p2)]}))
segs (s/content-segments scene :root)
- bars (s/lane-bars scene :ann segs)]
+ bars (s/lane-bars scene :root :ann segs)]
(is (= [[0 200 :m/1] [200 300 :m/2]] bars)) ; two marks → two bars, tagged + apart
(is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi]
;; and a single cross-clip proxy on its own is one contiguous bar
(let [one (-> base (with-group :p1 p1)
- (with-group :ann {:type :annotation :in [:root]
+ (with-group :ann {:type :annotation :parent :root
:marks [(s/proxy-ref :m/1 :p1)]}))]
- (is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root))))))))
+ (is (= [[0 200 :m/1]] (s/lane-bars one :root :ann (s/content-segments one :root))))))))
(deftest proxy-survives-restore-roundtrip
(testing "a proxy group (string :type/:parent, string mark ids/refs from JSON)
@@ -242,122 +239,12 @@
{:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}}
back (:prox (s/restore-annotations json-like))
scene (-> base (with-group :prox back)
- (with-group :ann {:type :annotation :in [:root]
+ (with-group :ann {:type :annotation :parent :root
:marks [(s/proxy-ref :m/px :prox)]}))]
(is (= :proxy (:type back)))
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded
(is (= 170 (s/length (s/resolve scene :ann))))))) ; resolves whole
-(deftest content-segments-in-a-drilled-proxy-annotation-keeps-clips-distinct
- (testing "drilling INTO a proxy-backed range annotation exposes each underlying
- clip as its OWN content-segment (distinct :mark, track, length) — NOT
- all collapsed under the annotation's single mark id, which made every
- clip read with the FIRST piece's name + length and blocked saving a
- sub-range selection (the resolve/rebase collapse bug)"
- (let [p (s/make-proxy base :root 40 210) ; A-tail=60, B=100, C-head=10
- scene (-> base
- (with-group :prox p)
- (with-group :ann {:type :annotation :in [:root]
- :marks [(s/proxy-ref :m/px :prox)]}))
- segs (s/content-segments scene :ann)
- ids (mapv :mark segs)]
- (is (= 170 (s/length segs)))
- (is (= 3 (count segs)))
- (is (= 3 (count (distinct ids)))) ; pieces stay distinct…
- (is (not-any? #{:m/px} ids)) ; …and are NOT the annotation's mark
- (is (= [:t0 :t1 :t2] (mapv :track segs))) ; each keeps its own track
- ;; per-piece lengths + the seg-length / seg-local lookups the editor & save
- ;; check rely on — previously every one returned the first piece's numbers
- (is (= [60 100 10] (mapv (fn [{[c d] :local}] (- d c)) segs)))
- (is (= [60 100 10] (mapv #(s/seg-length segs %) ids)))
- (is (= [0 60 160] (mapv #(s/seg-local segs % 0) ids)))))
- (testing "resolve (the LANE view) still collapses the proxy under the annotation's
- one mark id — one bar per mark — so the two views stay distinct"
- (let [p (s/make-proxy base :root 40 210)
- scene (-> base (with-group :prox p)
- (with-group :ann {:type :annotation :in [:root]
- :marks [(s/proxy-ref :m/px :prox)]}))]
- (is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann))))))))
-
-(deftest transcluded-mark-labels-resolve-down-to-the-clip
- (testing "a mark whose ref target isn't in the CURRENT context (collected into an
- annotation from another timeline — transclusion) still gets a length +
- a useful TRACK label by resolving the ref chain down to its clip, not by
- a context lookup (which returns 'clip' / no length for a foreign ref).
- The clip's :name is the shared source file, so the TRACK is the label."
- (let [named (-> base
- (assoc-in [:groups :clip-a :name] "Challengers.mov")) ; single-source
- pA (s/make-proxy named :root 0 100) ; proxy over clip-a (track t0 = "A-roll")
- aid (:id (first (:marks pA))) ; A's sub-clip mark (refs clip-a)
- pin {:type :proxy :parent nil ; a mark authored INSIDE A
- :marks [{:id :sub-c :start {:ref aid :at 0} :end {:ref aid :at -1}}]}
- scene (-> named
- (with-group :pA pA)
- (with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
- (with-group :pin pin))]
- ;; the ref chain :sub-c → aid → clip-a bottoms out at a clip from anywhere
- (is (= 100 (s/ref-length scene :sub-c))) ; clip-a's length, no context
- (is (= "A-roll" (s/ref-track-name scene :sub-c))) ; the TRACK, not "Challengers.mov"
- (is (= 100 (s/ref-length scene :pin))) ; the whole proxy resolves the same
- (is (= "A-roll" (s/ref-track-name scene :pin)))
- (is (nil? (s/ref-track-name scene :nope)))))) ; a dangling ref → nil, not a throw
-
-(deftest placement-is-membership-listing-is-decoupled-from-where-bars-draw
- (testing "an annotation LISTS under the mark-groups in its :in (asserted), while
- its bars DRAW wherever its marks resolve (footage ∩ ctx). The two are
- independent: a mark authored on annB's content still draws in annB even
- when the annotation is only filed under annA — and it does NOT list in
- annB until it's filed there."
- (let [four (assoc-in base [:groups :clip-d]
- {:type :clip :parent nil :name "D" :start 300
- :marks [{:id :m/d :start 300 :end 400 :track :t0}]})
- four (assoc-in four [:groups :root :marks] [{:id :m/root :start 0 :end 400}])
- pA (s/make-proxy four :root 0 200) ; annA over clips A,B
- pB (s/make-proxy four :root 200 400) ; annB over clips C,D
- scene (-> four (with-group :pA pA) (with-group :pB pB)
- (with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
- (with-group :annB {:type :annotation :in [:root] :marks [(s/proxy-ref :mB :pB)]}))
- ;; annC is FILED under annA only, but holds a mark authored on annA's
- ;; content AND a mark authored on annB's content (C-tail + D-head)
- pInA (s/make-proxy scene :annA 10 60)
- pInB (s/make-proxy scene :annB 50 150)
- scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB)
- (with-group :annC {:type :annotation :in [:annA]
- :marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}))]
- ;; MEMBERSHIP (listing) is exactly :in — asserted, single here
- (is (= #{:annA} (s/membership scene :annC)))
- (is (= :annA (s/home scene :annC))) ; primary = first :in
- (is (s/child-of? scene :annA :annC))
- (is (not (s/child-of? scene :annB :annC))) ; NOT filed under B → not listed there
- (is (not (s/child-of? scene :root :annC)))
- ;; RESOLUTION (bars) is independent of membership: the cb mark still draws in
- ;; annB's lane because its FOOTAGE lands there, even though annC isn't filed in B
- (is (= [[50 150 "cb"]] (s/lane-bars scene :annC (s/content-segments scene :annB))))
- (is (seq (s/lane-bars scene :annC (s/content-segments scene :annA))))
- ;; filing annC into annB (an assertion) makes it LIST there too; bars unchanged
- (let [scene2 (assoc-in scene [:groups :annC :in] [:annA :annB])]
- (is (s/child-of? scene2 :annB :annC))
- (is (= #{:annA :annB} (s/membership scene2 :annC)))
- (is (= :annA (s/home scene2 :annC))) ; primary still first
- (is (= [[50 150 "cb"]] (s/lane-bars scene2 :annC (s/content-segments scene2 :annB))))))))
-
-(deftest jump-targets-label-from-the-clip-not-the-proxy
- (testing "a discontinuous annotation's jump popover labels each target from the
- CLIP it lands on (+ the frame within it), not from the mark's proxy-ref
- start — which would give the proxy gid (→ a bare 'clip') and frame 0"
- (let [pa (s/make-proxy base :root 0 50) ; within clip A
- pc (s/make-proxy base :root 250 300) ; within clip C (non-adjacent → 2 runs)
- scene (-> base (with-group :pa pa) (with-group :pc pc)
- (with-group :ann {:type :annotation :in [:root]
- :marks [(s/proxy-ref :ma :pa) (s/proxy-ref :mc :pc)]}))
- segs (s/content-segments scene :root)
- jumps (s/jump-targets scene :root :ann)]
- (is (= 2 (count jumps))) ; two discontinuous runs
- (is (not-any? #{:pa :pc} (map :seg jumps))) ; NOT the proxy gids ("clip 0f")
- (is (every? (fn [j] (some #(= (:seg j) (:mark %)) segs)) jumps)) ; every :seg is a real content id → labelable
- (is (= [:clip-a :clip-c] (mapv :seg jumps))) ; the clips the runs land on
- (is (= [0 50] (mapv :f jumps)))))) ; frame within each clip (250 → C+50)
-
;; =========================================================================
;; Suite 3 — playhead & playback
;; =========================================================================
@@ -407,55 +294,18 @@
(is (= #{:t0 :t1} (s/tracks segs)))
(is (= 200 (s/length segs)))))))
-(deftest otio-normalizes-source-starts-and-rejects-fractional-durations
- (testing "fractional OTIO source starts are normalized at import"
- (let [clip {:OTIO_SCHEMA "Clip.2"
- :name "a"
- :source_range {:start_time {:value 10.5 :rate 24}
- :duration {:value 5 :rate 24}}}
- otio {:global_start_time {:rate 24}
- :tracks {:children [{:name "V" :kind "Video" :children [clip]}]}}
- parsed (otio/parse otio)]
- (is (= 10 (:media-offset parsed)))
- (is (= 0 (get-in parsed [:tracks 0 :clips 0 :media-in])))
- (is (integer? (get-in parsed [:tracks 0 :clips 0 :media-in])))))
- (testing "fractional OTIO durations still fail because timeline math is integer"
- (let [clip {:OTIO_SCHEMA "Clip.2"
- :name "a"
- :source_range {:start_time {:value 10 :rate 24}
- :duration {:value 5.5 :rate 24}}}
- otio {:global_start_time {:rate 24}
- :tracks {:children [{:name "V" :kind "Video" :children [clip]}]}}
- msg (err-msg #(otio/parse otio))]
- (is (re-find #"integer frame" msg))))
- (testing "from-otio also asserts parsed frame fields are integers"
- (let [clip {:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4}
- parsed {:fps 24 :duration 199.6
- :tracks [{:index 0 :kind :video :name "W" :clips [clip]}]}
- msg (err-msg #(s/from-otio parsed))]
- (is (re-find #"integer frame" msg)))))
-
-(deftest real-otio-source-starts-import-as-integer-media-frames
- (testing "the bundled Challengers OTIO has fractional source starts but imports into integer model frames"
- (let [raw (js->clj (js/JSON.parse (.readFileSync (js/require "fs") "resources/public/one_two_three.otio" "utf8"))
- :keywordize-keys true)
- parsed (otio/parse raw)
+(deftest from-otio-snaps-fractional-frames
+ (testing "OTIO's fractional RationalTime is rounded to whole frames at seed"
+ (let [parsed {:fps 24 :duration 199.6
+ :tracks [{:index 0 :kind :video :name "W"
+ :clips [{:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4}]}]}
scene (s/from-otio parsed)
- media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))]
- (is (seq media-ins))
- (is (every? integer? media-ins))
- (is (every? integer? (mapcat (fn [[_ g]]
- (mapcat (juxt :start :end) (:marks g)))
- (:groups scene)))))))
-
-(deftest selection-rejects-fractional-frames
- (testing "a selection over fractional clip layout fails instead of changing frames"
- (let [scene {:tracks {:t0 {:name "W"}}
- :groups {:root {:type :timeline :parent nil :marks [{:id :m/r :start 0 :end 100}]}
- :fr {:type :clip :parent nil :start 0.3 ; fractional timeline pos
- :marks [{:id :m/fr :start 10.4 :end 110.4 :track :t0}]}}}
- msg (err-msg #(s/selection->marks scene :root 20 60))]
- (is (re-find #"integer frame" msg)))))
+ mark (first (get-in scene [:groups :t0-c0 :marks]))]
+ (is (= 0 (get-in scene [:groups :t0-c0 :start]))) ; 0.2 -> 0
+ (is (= 189 (:start mark))) ; media-in 188.87 -> 189
+ (is (= 289 (:end mark))) ; 188.87+100.4=289.27 -> 289
+ (is (= 200 (get-in scene [:groups :root :marks 0 :end]))) ; 199.6 -> 200
+ (is (every? integer? [(:start mark) (:end mark)])))))
;; =========================================================================
;; Suite 4 — draft rows <-> marks (the two-input editor)
@@ -477,7 +327,7 @@
(deftest frames-are-mark-time-under-parent-trim
(testing "frames are 0-based within the TRIMMED segment, not raw clip time"
(let [scene (with-group base :p
- {:type :annotation :in [:root]
+ {:type :annotation :parent :root
:marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]})
segs (s/content-segments scene :p)]
(is (= 60 (s/seg-length segs :m/s))) ; trimmed length, not 100
@@ -488,13 +338,13 @@
(is (= 0 (get-in (first marks) [:start :at])))
(is (= 30 (get-in (first marks) [:end :at])))))))
-(deftest merge-bars-coalesces-continuous-integer-runs
- (testing "integer-adjacent bars merge; fractional bars fail"
+(deftest merge-bars-coalesces-continuous-run
+ (testing "sub-frame OTIO gaps collapse to one bar; a real gap stays split"
+ ;; foobar's real bars (continuous 5-clip selection, ~0.9-frame source gaps)
(is (= [[128 542]]
- (s/merge-bars [[128 191] [191 266] [266 386]
- [386 414] [414 542]])))
+ (s/merge-bars [[128.87 190.87] [191.80 265.80] [266.73 384.73]
+ [385.61 413.61] [414.58 541.58]])))
(is (= [[0 50] [200 260]] (s/merge-bars [[0 50] [200 260]]))) ; real gap → two
- (is (re-find #"integer frame" (err-msg #(s/merge-bars [[0.2 50]]))))
(is (= [] (s/merge-bars [])))))
(deftest restore-annotations-rekeywordizes-json
@@ -504,8 +354,7 @@
:end {:ref "clip-a" :at -1}}]}}
g (:ann-1 (s/restore-annotations json-like))]
(is (= :annotation (:type g)))
- (is (= [:root] (:in g))) ; legacy :parent migrated to an :in edge
- (is (nil? (:parent g))) ; and the old field is dropped
+ (is (= :root (:parent g)))
(is (= :clip-a (get-in g [:marks 0 :start :ref])))
(let [scene (assoc-in base [:groups :ann-1] g)]
(is (= [0 100] (:src (first (s/resolve scene :ann-1)))))))))
@@ -516,9 +365,9 @@
(deftest annotations-survive-json-roundtrip
(testing "restore-annotations is the exact inverse of the JSON wire trip — guards
against any keyword-valued field (id/ref/type/parent/track) being missed"
- (let [anns {:ann-p {:v s/schema-version :type :annotation :in [:root] :name "p" :color "#abc" :content "hi"
+ (let [anns {:ann-p {:v 1 :type :annotation :parent :root :name "p" :color "#abc" :content "hi"
:marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]}
- :ann-c {:v s/schema-version :type :annotation :in [:ann-p] :name "c"
+ :ann-c {:v 1 :type :annotation :parent :ann-p :name "c"
:marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}]
(is (= anns (s/restore-annotations (json-roundtrip anns)))))))
@@ -575,7 +424,7 @@
(deftest repeats-are-unambiguous
(testing "two instances of A share a source frame but distinct locals (local is master)"
(let [scene (with-group base :ann
- {:type :annotation :in [:root]
+ {:type :annotation :parent :root
:marks [(refm :m/r0 :clip-a 0 -1) (refm :m/r1 :clip-b 0 -1) (refm :m/r2 :clip-a 0 -1)]})
segs (s/resolve scene :ann)]
(is (= 5 (s/local->source segs 5))) ; first A
@@ -607,9 +456,9 @@
(deftest path-to-builds-stack-and-drops-orphans
(let [scene {:groups {:root {:type :timeline :parent nil}
- :a {:type :annotation :in [:root]}
- :b {:type :annotation :in [:a]}
- :orphan {:type :annotation :in [:gone]}}}]
+ :a {:type :annotation :parent :root}
+ :b {:type :annotation :parent :a}
+ :orphan {:type :annotation :parent :gone}}}]
(testing "path is root → … → target"
(is (= [:root] (s/path-to scene :root)))
(is (= [:root :a] (s/path-to scene :a)))