From 06dd2b597c5b95e7fc3e953bef483cdb41510ee0 Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 5 Jul 2026 12:22:17 -0400 Subject: [PATCH 01/10] fix: half-open boundaries, per-mark lane interaction, unified :at addressing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes the resize-drift and boundary bugs found while exercising the marks-first flow, plus Chunk 7 (orphan polish). Frame model made consistent rather than patched. - Boundaries are half-open [start,end) everywhere; drop the merge-bars ≤1-frame fudge and the independent from-otio rounding that created the gaps it papered over. Clips stay EXACT (they tile at shared boundaries); frame-accuracy is applied at the mark the user creates (selection->marks rounds :at) and at display, never by rounding clips or bars. - Unify the ref :at <-> source conversion: at->local / at->src / src->at, all via the target's full resolution, correct for scattered multi-clip (nested) proxy targets. Delete target-range (the lossy single-segment [xs xe] shortcut that made selection->marks / point-frame / at->frame / seg-point wrong when nested). This is what fixed the resize dragging one handle moving the other. - Lane interaction is per-MARK, not per-visual-bar: one draggable unit + two end-handles at the mark's exact extent (scene/mark-extent), driven so the dragged endpoint rounds and the fixed one stays exact. Timeline drag-select; click = scrub. Visible edge grips. - Share display-point between the editor rows and the jump popover (context-local whole frame). Drawing autocommits; toolbar moved off the video. - Chunk 7: broken annotations greyed + sorted down + per-mark warnings. Suite green except the pre-existing annotations-survive-json-roundtrip; app compiles clean. Co-Authored-By: Claude Opus 4.8 --- tl/annotation_flow_plan.md | 12 ++- tl/resources/public/css/app.css | 2 + tl/src/tl/events.cljs | 3 + tl/src/tl/scene.cljs | 137 +++++++++++++++++++------------- tl/src/tl/views.cljs | 85 +++++++++++++------- tl/test/tl/scene_test.cljs | 26 +++--- 6 files changed, 168 insertions(+), 97 deletions(-) diff --git a/tl/annotation_flow_plan.md b/tl/annotation_flow_plan.md index 4d088c6..f41c6da 100644 --- a/tl/annotation_flow_plan.md +++ b/tl/annotation_flow_plan.md @@ -86,7 +86,13 @@ So "the title is the autocomplete": one control forks create-vs-associate. - [ ] Marks editor renders a proxy as ONE row (start clip/frame → end clip/frame), not N rows. - [ ] Active mark highlighted in the pane, matching the lane. -## Chunk 7 — Orphan / stability polish +## Chunk 7 — Orphan / stability polish ✅ -- [ ] Grey-out + drop orphaned annotations to bottom of list with warn indicator. -- [ ] Per-mark broken-ref warnings; keep annotation if at least one mark still resolves. +- [x] Broken annotations sort to the bottom (existing sub) and are **greyed out** (opacity on the card) while staying visible so surviving marks stay usable; `△`/`⚠` warnings on the card (existing). +- [x] **Per-mark broken indicator** in the editor: broken mark rows show `△` + strike-through + dimmed (`scene/broken-marks` set); an annotation keeps rendering as long as ≥1 mark resolves. + +## Fundamental fix — per-mark lane interaction (not per-bar) + +Handles/drag were attached to each visual bar, so a mark rendered as N pieces got N handle pairs (handles at every clip boundary). Two root fixes: +- [x] **Interaction decoupled from visual pieces**: colored bars are per-piece (pointer-events none for draft); a separate per-MARK layer spans the mark's whole extent = one draggable unit + exactly two end-handles + active ring. Robust no matter how many pieces a mark has. +- [x] **`merge-bars` absorbs ≤1-frame gaps**: independent frame-rounding of clip `:start` could leave a 1-frame gap between adjacent clips and spuriously split a mark's bar; a 1-frame gap is a rounding artifact, not real discontinuity, so it now coalesces (still per-mark, never fuses distinct marks). diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index eac3ea9..8443a74 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -700,6 +700,8 @@ html.dark .timeline-head { one a drawing binds to, and which you're about to delete */ .mark-block.active-mark { box-shadow: inset 3px 0 0 var(--ink); background: var(--shade, rgba(128,128,128,.14)); border-radius: 2px; padding: 2px 0 2px 3px; margin-left: -3px; } +.mark-block.broken { opacity: 0.6; } +.mark-block.broken .pt-chip-name { text-decoration: line-through; } .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); } diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 619033c..9fd9337 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -787,6 +787,9 @@ proxy (get-in scene [:groups pid]) ctx (:parent (get-in scene [:groups ann])) len (scene/length (scene/content-segments scene ctx)) + ;; the dragged endpoint is a whole frame; the FIXED endpoint arrives + ;; EXACT (fractional) so its mark re-derives identically. Only the fixed + ;; end must avoid rounding here — the clamp keeps [la lb) valid half-open. la* (max 0 (min la (dec len))) lb* (max (inc la*) (min lb len))] (if (= :proxy (:type proxy)) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index c4d96a7..2f7c64c 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -55,10 +55,12 @@ segs))) (defn merge-bars - "Coalesce [lo hi) ranges that meet at a frame boundary into single bars, so a - continuous selection spanning several clips reads as one piece. Endpoints snap - to whole frames first, which absorbs the sub-frame gaps OTIO's fractional - media offsets leave between adjacent clips; only a real (≥1 frame) gap splits." + "Coalesce [lo hi) ranges that meet at a boundary into single bars, so a + continuous run spanning several clips reads as one piece. Ranges are half-open, + so adjacent clips share a boundary (A.hi == B.lo) and merge exactly — no gap to + fudge. Endpoints snap to whole frames first (a bar covers the frames it + touches); only a real (≥1 frame) gap splits. Called per-mark, so it never fuses + two distinct marks." [bars] (reduce (fn [acc [lo hi]] (let [lo (js/Math.floor lo) hi (js/Math.ceil hi) @@ -88,22 +90,6 @@ (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, timeline, proxy, annotation) or a single mark. One segment for a clip/subclip @@ -115,6 +101,35 @@ (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." @@ -126,12 +141,8 @@ :track nil}) (map? point) - (when-let [{:keys [xs xe track thumb thumb-start]} (target-range scene (:ref point))] - (let [n (:at point) - f (if (neg? n) (+ xe n 1) (+ xs n))] - (when (<= xs f xe) - (cond-> {:frame f :track track} - thumb (assoc :thumb thumb :thumb-at (+ (or thumb-start 0) (- f xs))))))))) ; nil if trimmed out of range + (when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range + {:frame f}))) (defn- rebase "Shift `sub`'s :local to start at 0 and stamp :mark = `id` (the mark now owns @@ -208,7 +219,7 @@ [scene gid] (when-let [mid (first (broken-marks scene gid))] (let [ref (->> (:marks (grp scene gid)) (some #(when (= mid (:id %)) %)) :start :ref)] - (if (target-range scene ref) "reference trimmed away" "referenced clip deleted")))) + (if (seq (target-segs scene ref)) "reference trimmed away" "referenced clip deleted")))) ;; --- what the current timeline is made of -------------------------------- @@ -287,6 +298,18 @@ (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' floor/ceil. Endpoint + editing must use this (not a rounded lane bar) or the fixed end drifts a frame + per re-roll. `ctx-segs` = content-segments of ctx." + [scene ctx gid mark-id ctx-segs] + (let [pcs (->> (nested-src-marks scene ctx gid) + (filter #(= mark-id (:mark %))) + (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))] + (when (seq pcs) + [(reduce min (map first pcs)) (reduce max (map second pcs))]))) + (defn clip-loss? "True when annotation `gid` loses any content once clipped to its immediate parent annotation — it references frames outside the parent timeline, so it's @@ -303,14 +326,19 @@ (defn selection->marks "Split local range [la lb) of context `ctx` into a run of single-clip ref marks, one per content segment it crosses (the 'no cross-clip marks' rule). - Each references the segment's source id with the right offsets." + Each references the segment's source id with the right offsets. Offsets are + ROUNDED to whole frames here — this is where user frame-accuracy is applied + (clips stay exact for tiling; the mark snaps to a whole frame of its clip)." [scene ctx la lb] (mapv (fn [{:keys [mark src]}] - (let [{:keys [xs]} (target-range scene mark) - [a b] src] + ;; :at is the target's OWN local frame (src->at), matching resolve-mark's + ;; slice — correct even when the target is a scattered multi-clip proxy. + ;; The piece lies within one target segment, so its length maps 1:1. + (let [[a b] src + a' (src->at scene mark a)] {:id (str (random-uuid)) ; string so it survives JSON - :start {:ref mark :at (- a xs)} - :end {:ref mark :at (- b xs)}})) + :start {:ref mark :at (js/Math.round a')} + :end {:ref mark :at (js/Math.round (+ a' (- b a)))}})) (slice (content-segments scene ctx) la lb))) (defn reconcile-run @@ -372,12 +400,6 @@ [segs mid f] (some (fn [{m :mark [c _] :local}] (when (= m mid) (+ c (or f 0)))) segs)) -(defn- at->frame - "Normalise a ref's :at to a non-negative mark-time frame (resolves :at -1 etc.)." - [scene ref at] - (if (neg? at) - (let [{:keys [xs xe]} (target-range scene ref)] (+ (- xe xs) at 1)) - at)) (defn- restore-mark [m] ;; keep :id keyworded in lockstep with the refs that target it: a nested @@ -437,13 +459,18 @@ 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 (js/Math.round (at->local scene ref at))}) + (defn- clip-row - "Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time. - Frames are rounded for display — OTIO's fractional media offsets can leave a - ref's :at sub-frame, and the editor/labels want whole frames." + "Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time." [scene {:keys [start end]}] - {:s {:seg (:ref start) :f (js/Math.round (at->frame scene (:ref start) (:at start)))} - :e {:seg (:ref end) :f (js/Math.round (at->frame scene (:ref end) (:at end)))}}) + {:s (display-point scene start) :e (display-point scene end)}) (defn mark-row "One editor row for a mark. A plain clip/subclip ref collapses to {:s :e} @@ -476,25 +503,25 @@ clip mark-group per clip (source range + track), and the root timeline. The otio is only a seed — nothing here reads it again. - Frames are SNAPPED to whole integers here, at the one boundary where OTIO's - fractional RationalTime enters: a frame-based tool has no meaning below a whole - frame, so we round once, at the source, and everything downstream (source - ranges, mark :at offsets, seeks, labels) stays frame-accurate by construction." + Clip ranges are kept EXACT (OTIO's fractional RationalTime), NOT rounded: + adjacent clips must share their half-open boundary exactly to tile without a + gap, and independently rounding :start vs length breaks that. Frame-accuracy is + applied where it belongs — at the mark the user creates (selection->marks + rounds :at) — and at display, never by rounding clips or bars." [{:keys [duration tracks]}] - (let [r (fn [x] (js/Math.round x)) - vtracks (filter #(= :video (:kind %)) tracks) + (let [vtracks (filter #(= :video (:kind %)) tracks) track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks) clips (into {} (for [t vtracks c (:clips t)] [(keyword (:id c)) {:type :clip :parent nil :name (:name c) - :start (r (:start c)) ; timeline position (frames) + :start (:start c) ; timeline position (frames) :marks [{:id (keyword (str (:id c) "-m")) - :start (r (:media-in c)) - :end (r (+ (:media-in c) (:duration c))) + :start (:media-in c) + :end (+ (: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 (r duration)}]})})) + :marks [{:id :root-m :start 0 :end duration}]})})) (defn clip-name [scene gid] (:name (grp scene gid))) @@ -519,7 +546,7 @@ "Ref-point {:ref :at} for mark-time frame `f` within content-segment `seg` (the convention selection->marks uses, so it resolves identically)." [scene {:keys [mark src]} f] - {:ref mark :at (+ (- (first src) (:xs (target-range scene mark))) (or f 0))}) + {:ref mark :at (+ (src->at scene mark (first src)) (or f 0))}) (defn- runs "Contiguous runs of `gid`'s marks in `ctx`-local coords, each {:id :lo :len} @@ -551,7 +578,7 @@ [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)))})) + (assoc (display-point scene st) :local lo))) ; same cell as the editor row (runs scene ctx gid))) (defn linkables diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 8a159c3..334738e 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -471,12 +471,13 @@ (let [d (d-of e)] (when (or @moved? (> (js/Math.abs d) 3)) (reset! moved? true) + ;; round ONLY the dragged endpoint; the fixed endpoint stays + ;; exact so selection->marks re-derives its mark identically. (let [[la lb] (case mode - :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)]))))) + :move [(js/Math.round (+ lo d)) (js/Math.round (+ hi d))] + :start [(js/Math.round (+ lo d)) hi] + :end [lo (js/Math.round (+ hi d))])] + (rf/dispatch [::events/reroll-proxy ann mark-id la lb]))))) up (fn up [_] (.removeEventListener js/document "mousemove" move) (.removeEventListener js/document "mouseup" up) @@ -624,6 +625,7 @@ 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) @@ -656,17 +658,17 @@ label]]))] [:div.ann-lanes {:style {:height lane-h :width width} :on-mouse-down #(scrub! @content fps zoom %)} - ;; annotation bars — solid for saved, dashed for the in-progress draft - ;; visible annotations: full bars with labels, greedily packed into lanes + ;; 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. (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 - (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)) + (when-not (:draft a) (fn [e] (.stopPropagation e) (if linking (do (.preventDefault e) ; pick: link to this timeline @@ -680,25 +682,41 @@ :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) "grab" "pointer") + :cursor (if (:draft a) "default" "pointer") + :pointer-events (when (:draft a) "none") :border-radius 2 - :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}]]]))]) + :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 (never the rounded bar). The drag + ;; keeps the FIXED endpoint at this exact value so its mark + ;; re-derives identically — that's what stops the other end drifting. + :let [ext (scene/mark-extent scene ctx (:id a) mid segs)] + :when ext + :let [[lo hi] ext + active? (= mid active-mark)]] + ^{:key (str "edit-" (:id a) "-" mid)} + [:div.mark-edit {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :move lo hi fps zoom e)) + :style {:position "absolute" :top (+ 2 (* (lane-of (:id a)) 18)) :height 14 + :left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom)) + :cursor "grab" :border-radius 2 + :box-shadow (when active? "0 0 0 2px var(--ink)") + :z-index (if active? 4 2)}} + (let [grip {:width 3 :height 9 :border-radius 2 + :background "var(--paper)" :border "1px solid var(--ink)"} + zone {:position "absolute" :top 0 :width 9 :height "100%" :cursor "ew-resize" + :display "flex" :align-items "center" :justify-content "center"}] + [:<> + [:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :start lo hi fps zoom e)) + :style (assoc zone :left -3)} + [:div {:style grip}]] + [:div.bar-handle {:on-mouse-down (fn [e] (mark-drag! (:id a) mid :end lo hi fps zoom e)) + :style (assoc zone :right -3)} + [:div {:style grip}]]])]) ;; visible annotation labels (for [a visible :let [[lo _] (first (:bars a))] :when lo] ^{:key (str "lbl-" (:id a))} @@ -1173,7 +1191,10 @@ [: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))) - :style {"--ann-color" (:color 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))}) [:div.ann-head [:div.ann-title [:span.ann-swatch {:style {:background (:color a)}}] @@ -1336,6 +1357,7 @@ live @(rf/subscribe [::subs/active-note-set]) active @(rf/subscribe [::subs/active-mark]) rows (scene/marks->rows scene (:marks d)) + broken (set (scene/broken-marks scene gid)) ; marks whose refs no longer resolve valid? (or root? (and (not (str/blank? (:name d))) (seq (:marks d)))) save #(when valid? (rf/dispatch [::events/save-group gid (dissoc d :draft :gid) @@ -1391,6 +1413,7 @@ [: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"))}) [:div.mark-row @@ -1399,6 +1422,8 @@ (.. 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 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. diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index 44b62e8..ccde702 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -294,18 +294,26 @@ (is (= #{:t0 :t1} (s/tracks segs))) (is (= 200 (s/length segs))))))) -(deftest from-otio-snaps-fractional-frames - (testing "OTIO's fractional RationalTime is rounded to whole frames at seed" +(deftest from-otio-keeps-clip-ranges-exact + (testing "clips keep OTIO's exact fractional ranges (so adjacent clips tile); + frame-accuracy is applied at mark creation, not here" (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) - 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)]))))) + mark (first (get-in (s/from-otio parsed) [:groups :t0-c0 :marks]))] + (is (= 188.87 (:start mark))) ; exact, not rounded + (is (= 289.27 (:end mark)))))) + +(deftest selection-rounds-at-to-whole-frames + (testing "a selection over a clip with fractional layout still yields whole-frame + :at offsets (clip stays exact, the mark snaps)" + (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}]}}} + run (s/selection->marks scene :root 20 60)] + (is (seq run)) + (is (every? integer? (mapcat (juxt #(get-in % [:start :at]) #(get-in % [:end :at])) run)))))) ;; ========================================================================= ;; Suite 4 — draft rows <-> marks (the two-input editor) From 7ac8f27b570b9e138076149fd616297779782a2b Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 5 Jul 2026 17:45:49 -0400 Subject: [PATCH 02/10] claud erefactor checkpoint --- tl/data_model.org | 6 ++ tl/src/tl/events.cljs | 66 +++++++++++++++++++++- tl/src/tl/views.cljs | 128 ++++++++++++++++++++++++++++-------------- 3 files changed, 155 insertions(+), 45 deletions(-) diff --git a/tl/data_model.org b/tl/data_model.org index 547ce0d..086a75c 100644 --- a/tl/data_model.org +++ b/tl/data_model.org @@ -34,3 +34,9 @@ decided: a clip/subclip-ref mark never crosses a clip boundary, so the "range wh this brings us to playing. since right now there is only one source video file, we need to be able to seek to arbitrary frames. each context (mark-group) keeps its own local playhead, used when it's the top of the timeline stack. when we hit play, in the example above of annotation X, we find the clip under the playhead, compute the source frame, seek there, and start playing. one correction though: the local playhead has to be the master clock, not the video. you can't derive local position from currentTime -- once an annotation repeats or reorders clips, one source frame maps to several local frames, it's not invertible. so the local playhead advances on its own (wall-clock x fps while playing), and every frame we compute expected = group->media(local) and seek the video there only if round(currentTime*fps) != expected. within a clip, expected tracks the video's natural playback so no seek fires; at a mark boundary it jumps once and we seek. and right -- no recursion at play time: we resolve the current context once into flat ordered spans, and group->media is just the flat lookup the renderer already does. # how do we determine which tracks are included when we zoom into each annotation? for now it should just be if a clip is within the ranges of the mark-group, its track is included in the annotation. # automatically scroll to bottom-most track in mark group range when we hit the start mark? but what if it's massively spread out. maybe not then. scrolling should be an option turned on. thats ok. make it explicit. + + +* update! +- ok so the idea is this. you hit the new annotation button. it does not auto-select a mark for you. you can either click the clip, click the frame button, or drag a range. after you select a range, you are automatically in drawing mode. your drawings are connected to the mark, not the annotation. a mark should only ever appear in one annotation. instead of creating a new annotation mark group by default, this mode also allows you to either create new or associate with an existing annotation. associate with existing gives you our dropdown with only other annotations available. when you pick one, you effectively go into "edit" mode on that annotation with the new marks suddenly added. so this is basically our "transclusion": we can have annotations with marks embedded in other timelines. this is great for if we have subdivided our analysis into "chapters" but want to annotate shared concepts across them while keeping the main annotation pane clear. it's organized. so the big thing is that you don't create the annotation, you create the mark(s) first, then either create or assoc the annotation. +- another crucial thing: if we click and drag and it spans multiple clips, the range we have in our create/add annotation UI in the annotation pane should only show the start and end points relative to the clips at start and end. so the way this will work is we will create a mark group that's not an annotation as our "proxy" marks so that they don't appear in the ui that spans the full range and contains the full sequential clips, and then the mark group on the annotation that contains that mark group will just use that mark group as start and end as if it had been clicked. so, for example: there's clips A, B, C and D contiguous. user drags region from clip A to clip D. in the UI, we should see that our mark starts at clip A frame 0 and ends at clip D last frame, so we need to "pass through" the synthetic unnamed non-annotation mark group to the underlying clips, the synthetic unnamed non-annotation mark group is a proxy.. so that proxy mark group has marks that go from clip A start-clip A end, clip B start - clip B end, clip C start to clip C end, and clip D start to clip D end. makes sense? so what do we do if the user wants to drag adjust endpoint in UI? let's say there's another clip before clip A called clip 0. we move start point BACK to clip 0 frame 50. well, our main mark group just shows the range as we would expect: clip 0 frame 50 TO clip D last frame. but the proxy mark group? it has a new mark range with new mark id at the beginning, but the other mark ids are stable. and the same is true of rolling the end point forward: new mark id, new range, rest are stsable. what if we roll the endpoints inward? same principle but we kill off mark ranges instead of adding new ones. should be clean. so this means we needs we need to change how draft/edit marks look/act in the lane. when in draft/edit mode, clicking on the mark brings up drawing mode for that mark (there can still be a button next to the mark in the edit pane). you can drag the whole mark left to right. and you can also grab handles on the edges of the annotation left to right. and since we consider whatever last created or last touched mark to be the "active" one for associating drawings to, we need to have that visually represented in the timeline, and in the pane where the draft marks or edit annotation is. and these need to share the same look for the mark range,s its only the stuff above it that iwll change. make sense? +- note: when we talk about rolling the whole clip around, we know that the mark ids are going to change if we highlight one clip, unhighlight, then return back. this means that if we annotated a range defined w/r/t that annotation, the underlying gids are broken forever, even if they're rolled back. so that they exist still, right? since the underlying clips will never change, i wonder if we could just give each clip a stable identifier and define our root-most ranges in terms of those stable identifiers? or is that worse? idk diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 9fd9337..d0f6700 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -390,9 +390,18 @@ :else t) note {:type :script-note :name nm :color "#c2864e" :regions [(merge {:id rid :kind :text :content ""} region)]} + target (get-in db [:view :note-target]) db (-> db (assoc-in [:scene :groups gid] note) (assoc-in [:view :active-note] gid) - (assoc :save-error nil))] + (assoc :save-error nil)) + ;; created for a mark → bind it and hop back to the annotation + db (if target + (-> db (update-in [:scene :groups (:gid target) :marks] + (fn [ms] (mapv (fn [m] (if (= (:mark-id target) (:id m)) + (update m :notes add-in gid) m)) ms))) + (assoc-in [:view :note-target] nil) + (assoc-in [:view :pane] :annotations)) + db)] (merge {:db db} (persist-note-fx db gid))))) ;; commentary edits update the note locally (on-change); persist on blur so we @@ -433,6 +442,21 @@ (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) +(rf/reg-event-db ::set-active-mark + (fn [db [_ mark-id]] (assoc-in db [:view :active-mark] mark-id))) + +;; "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 :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 @@ -704,6 +728,18 @@ (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 (:parent (get-in scene [:groups gid])) + segs (scene/content-segments scene ctx) + [lo hi] (scene/mark-extent scene ctx 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"). @@ -737,7 +773,21 @@ [gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene)) segs (scene/content-segments scene (:parent g)) pt (get-in db [:view :pt])] - (if (map? pt) + (cond + ;; re-picking one endpoint of a proxy: roll only that side, keep the other + (:proxy pt) + (let [proxy (get-in scene [:groups (:proxy pt)]) + new-local (if (= (:which pt) :start) + (scene/seg-local segs seg-id (or frame 0)) + (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))) + keep (:keep pt) + lo (js/Math.round (min new-local keep)) + hi (js/Math.round (max new-local keep))] + {:db (-> db (assoc-in [:scene :groups (:proxy pt)] + (scene/roll-proxy scene (:parent g) proxy lo (max (inc lo) hi))) + (assoc-in [:view :pt] :new))}) + + (map? pt) (let [a (scene/seg-local segs (:seg pt) (:f pt)) b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))) lo (min a b) hi (max a b) @@ -758,6 +808,8 @@ (assoc-in [:view :pt] :new))}) ;; new selection (two-click): same completion as a timeline drag. (select-range-fx db gid g lo hi))) + + :else {:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})})))) ;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned @@ -796,6 +848,16 @@ (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 [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 diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 334738e..9000ff9 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -493,9 +493,10 @@ (defn- region-select! "On the timeline while authoring: DRAG to select a region [lo hi) → one - 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] + 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] (.preventDefault ev) (let [rect (.getBoundingClientRect content) sx (.-clientX ev) @@ -513,7 +514,7 @@ (reset! region-sel nil) (if (and was (> (- hi lo) 0.5)) (rf/dispatch [::events/draft-select-range (js/Math.round lo) (js/Math.round hi)]) - (goto! a))))] ; click → move the playhead + (on-click a))))] ; click (no drag) (.addEventListener js/document "mousemove" mv) (.addEventListener js/document "mouseup" up))) @@ -755,7 +756,8 @@ [:div.content.track-content {:ref (fn [n] (reset! content n)) ;; while authoring, drag empty space to select a region :on-mouse-down (if authoring? - #(region-select! @content fps zoom %) + ;; empty timeline: drag = region, click = move playhead + #(region-select! @content fps zoom goto! %) #(scrub! @content fps zoom %)) :style {:width width :height tracks-h}} (for [[i t] (map-indexed vector tracks)] @@ -772,7 +774,10 @@ (if linking (commit-link! (scene/seg-point scene seg 0) (clip-label scene segs (:mark seg))) - (region-select! @content fps zoom e)))) + ;; drag = region; click = pick this clip (two-click flow) + (region-select! @content fps zoom + (fn [_] (rf/dispatch [::events/draft-click-seg (:mark seg)])) + 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"}} @@ -937,7 +942,9 @@ idx (r/atom 0) off (r/atom (or (:offset value) 0)) picked (r/atom value) - open? (r/atom true)] + ;; 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 [cands (point-candidates scene ctx @text timelines?) i (min @idx (max 0 (dec (count cands)))) cur (or (:candidate @picked) (get cands i)) @@ -966,7 +973,12 @@ (reset! open? true) (reset! off 0) (preview! (get cands j) 0))] - [:div.pt-input {:class class} + [: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)))} [:input.pt-text {:auto-focus auto-focus? :placeholder (or placeholder "clip / annotation / frame...") @@ -1274,6 +1286,23 @@ [:button.pt-chip-x {:type "button" :title "Re-pick this end" :on-click #(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 (scene/seg-length segs seg)] + [:div.pt-chip + [:span.pt-chip-name (clip-label 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 #(rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which])} "✕"]])) + ;; --- script-note bindings (annotation form) ------------------------------ ;; 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 @@ -1347,10 +1376,11 @@ gid (:gid d) new? (= :new (:draft d)) 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 + ;; 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]))) put (fn [g] (rf/dispatch [::events/put-group gid (dissoc g :gid)])) notes @(rf/subscribe [::subs/notes]) nmap (into {} (map (juxt :id identity)) notes) @@ -1403,6 +1433,24 @@ [: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) @@ -1424,16 +1472,30 @@ (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 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")]]] + ;; a proxy collapses its cross-clip run to first-clip start → + ;; last-clip end; each endpoint edits the proxy's own boundary + ;; mark's frame (crossing a clip boundary is the lane handles). + ;; A plain clip mark edits its own :at directly. + (if-let [pid (:proxy row)] + ;; while re-picking one end (after its ✕) that end becomes a live + ;; clip picker in the row; the other end stays a normal chip. + (let [pick (when (and (map? pt) (= (:proxy pt) pid)) (:which pt))] + [:<> + (if (= pick :start) + [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true + :placeholder "click a clip for start…" + :on-cancel #(rf/dispatch [::events/draft-focus :new]) + :on-pick #(when-let [p (local->draft-point segs (:local %))] + (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] + [proxy-frame-chip scene segs gid mark-id pid :start (:s row)]) + [:span.mark-arrow "→"] + (if (= pick :end) + [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true + :placeholder "click a clip for end…" + :on-cancel #(rf/dispatch [::events/draft-focus :new]) + :on-pick #(when-let [p (local->draft-end-point segs (:local %))] + (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] + [proxy-frame-chip scene segs gid mark-id pid :end (:e row)])]) [:<> [frame-chip scene segs put d i :start (:s row)] [:span.mark-arrow "→"] @@ -1452,7 +1514,7 @@ [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) + (when (and (map? pt) (not (:proxy pt))) [:div.mark-row [:div.pt-chip [:span.pt-chip-name (str (clip-label scene segs (:seg pt)) " @" (js/Math.round (:f pt)) "f")]] @@ -1472,26 +1534,6 @@ :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 "Script notes"] From dfa92a478fc922fb50638d9f190e32a78a58a785 Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 5 Jul 2026 18:10:44 -0400 Subject: [PATCH 03/10] feat: improve annotation mark editing --- tl/resources/public/css/app.css | 103 +++++++--- tl/src/tl/events.cljs | 82 ++++++-- tl/src/tl/md.cljs | 26 ++- tl/src/tl/subs.cljs | 1 + tl/src/tl/views.cljs | 350 ++++++++++++++++++++------------ 5 files changed, 382 insertions(+), 180 deletions(-) diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index 8443a74..c9334ee 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 { +.pane-tabs button, .track-toggle, .mark-script, .mark-script-new { font-family: var(--chicago); background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; line-height: 1.3; } .jump-btn:hover, .add-btn:hover, .edit-btn:hover, .del-btn:hover, .expand-btn:hover, .back-btn:hover, .crumb:hover, .play-btn:hover, .step-btn:hover, .row-x:hover, .add-mark:hover, .save:hover, .cancel:hover, .hl-ok:hover, .hl-cancel:hover, -.pane-tabs button:hover, .track-toggle:hover { +.pane-tabs button:hover, .track-toggle:hover, .mark-script:hover, .mark-script-new:hover { background: var(--hover); } .jump-btn:active, .add-btn:active, .edit-btn:active, .del-btn:active, .expand-btn:active, .back-btn:active, .crumb:active, .play-btn:active, .step-btn:active, .row-x:active, .add-mark:active, .save:active, .cancel:active, .hl-ok:active, .hl-cancel:active, -.pane-tabs button:active, .track-toggle:active { +.pane-tabs button:active, .track-toggle:active, .mark-script:active, .mark-script-new:active { background: var(--ink); color: var(--paper); } @@ -101,10 +101,13 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; background: none; cursor: pointer; } .draw-tools .draw-wid { width: 56px; } .draw-done { font-weight: bold; } -.mark-draw { background: none; border: 1px solid transparent; border-radius: 0; - font-size: 12px; cursor: pointer; padding: 0 3px; line-height: 1; } -.mark-draw:hover { border-color: var(--ink); } -.mark-draw.has { border-color: var(--ink); background: var(--paper); } +.mark-draw, .mark-script { + width: 28px; height: 26px; flex: none; + display: inline-flex; align-items: center; justify-content: center; + border-radius: 0; font-size: 13px; cursor: pointer; padding: 0; line-height: 1; +} +.mark-draw { background: var(--paper); color: var(--ink); border: 1px solid var(--ink); } +.mark-draw.has, .mark-script.has { background: var(--desktop); background-size: 4px 4px; } .frame-readout { position: absolute; bottom: 6px; right: 8px; z-index: 4; @@ -209,10 +212,13 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .form { flex: 1; min-width: 0; overflow-y: auto; background: var(--paper); border: 1px solid var(--ink); box-sizing: border-box; - padding: 10px 12px; - display: flex; flex-direction: column; gap: 10px; + padding: 12px; + display: flex; flex-direction: column; gap: 12px; +} +.form-head { + font-family: var(--chicago); font-size: 14px; color: var(--ink); + padding-bottom: 6px; border-bottom: 2px solid var(--ink); } -.form-head { font-family: var(--chicago); font-size: 14px; color: var(--ink); } .form-row { display: flex; gap: 8px; align-items: center; } .form-name { flex: 1; } .form input[type=text], .form-name, .form-content { @@ -224,7 +230,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .form-content { width: 100%; min-height: 70px; resize: vertical; box-sizing: border-box; font-family: inherit; } .form-marks-label { font-family: var(--chicago); font-size: 11px; letter-spacing: .5px; - color: var(--ink); margin-top: 4px; } + color: var(--ink); margin-top: 2px; padding-top: 2px; } /* contenteditable content surface + inline link chips */ .content-editor { white-space: pre-wrap; word-break: break-word; outline: none; cursor: text; @@ -239,8 +245,11 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .link-chip .link-f { font-size: 11px; opacity: .7; } .link-chip:hover .link-f { opacity: 1; } -.mark-row { display: flex; flex-wrap: nowrap; align-items: center; gap: 6px; min-width: 0; } -.mark-arrow { color: var(--ink); } +.mark-row { display: flex; flex-wrap: wrap; align-items: center; gap: 6px; min-width: 0; } +.mark-arrow { + color: var(--ink); flex: none; font-family: var(--chicago); + min-width: 16px; text-align: center; +} .row-x, .add-mark { padding: 3px 8px; font-size: 12px; } .add-mark { align-self: flex-start; } @@ -251,7 +260,7 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; /* point editor + autocomplete */ .pt-input { position: relative; flex: 1 1 130px; display: flex; align-items: center; min-width: 0; } -.mark-row .pt-input { flex: 0 1 160px; max-width: 180px; } +.mark-row .pt-input { flex: 1 1 128px; max-width: 190px; } .pt-text { flex: 1; min-width: 0; box-sizing: border-box; background: var(--paper); color: var(--ink); border: 1px solid var(--ink); @@ -277,11 +286,18 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .link-insert { display: flex; align-items: flex-start; gap: 6px; align-self: stretch; } .link-insert .pt-input { flex: 1 1 auto; max-width: none; } +.link-insert-block .pt-input { flex: 1 1 220px; max-width: none; } .hl-ok, .hl-cancel { padding: 2px 9px; font-size: 12px; } -.pt-chip { flex: 1 1 0; min-width: 0; display: flex; align-items: center; gap: 4px; +.pt-chip { flex: 1 1 128px; min-width: 0; display: flex; align-items: center; gap: 4px; background: var(--paper); border: 1px solid var(--ink); border-radius: 0; - padding: 2px 4px; } + padding: 3px 5px; min-height: 20px; box-shadow: inset -1px -1px 0 var(--shade); } +.pt-chip.empty { + border-style: dashed; color: var(--mute); background: var(--shade); + box-shadow: none; +} +.pt-chip.pending { background: var(--paper); } +.pt-chip.pending .pt-frame { color: var(--ink); opacity: 1; } .pt-chip-name { font-size: 12px; color: var(--ink); white-space: nowrap; overflow: hidden; text-overflow: ellipsis; flex: 1; } .pt-frame { width: 56px; background: var(--paper); color: var(--ink); border: 1px solid var(--ink); @@ -658,6 +674,17 @@ html.dark .timeline-head { .zoom-read { font-size: 11px; color: var(--ink); min-width: 42px; text-align: center; } .script-empty { color: var(--mute); font-size: 12px; padding: 20px; } .ann.selected { box-shadow: inset 3px 0 0 var(--ink); } +.script-return { + display: flex; align-items: center; gap: 8px; flex-wrap: wrap; + padding: 6px 10px; border-bottom: 2px solid var(--ink); + background: var(--desktop); background-size: 4px 4px; + font-family: var(--chicago); font-size: 11px; +} +.script-return .hl-cancel { border-radius: 0; padding: 2px 8px; } +.script-return-text { + display: inline-block; background: var(--paper); border: 1px solid var(--ink); + padding: 2px 6px; box-shadow: 1px 1px 0 var(--ink); +} /* note rail (list of project script-notes) */ .note-rail { display: flex; align-items: center; gap: 8px; flex-wrap: wrap; @@ -695,23 +722,42 @@ html.dark .timeline-head { font-size: 11px; border: 1px solid var(--mute); border-radius: 0; padding: 3px; background: var(--paper); color: var(--ink); } /* binding notes to annotations/marks (annotation form + cards) */ -.mark-block { margin-bottom: 4px; } +.mark-block { + margin-bottom: 6px; padding: 5px 6px; + border: 1px solid var(--ink); background: var(--paper); + box-shadow: 2px 2px 0 var(--ink); + cursor: pointer; +} +.mark-block:hover { background: var(--shade); } +.mark-block.pending { cursor: default; } +.mark-block.pending:hover { background: var(--paper); } /* the currently-selected/last-touched mark while authoring — so you know which one a drawing binds to, and which you're about to delete */ -.mark-block.active-mark { box-shadow: inset 3px 0 0 var(--ink); background: var(--shade, rgba(128,128,128,.14)); - border-radius: 2px; padding: 2px 0 2px 3px; margin-left: -3px; } +.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; } -.note-drop { display: flex; align-items: center; flex-wrap: wrap; gap: 4px; min-height: 20px; - margin: 2px 0 2px 14px; padding: 2px 4px; border: 1px dashed var(--mute); border-radius: 0; } -.note-drop-label { font-size: 10px; color: var(--mute); } -.note-drop-hint { font-size: 10px; color: var(--mute); font-style: italic; } -.note-source { display: flex; flex-wrap: wrap; gap: 4px; margin: 4px 0; } -.note-src { display: inline-flex; align-items: center; gap: 4px; font-size: 11px; cursor: grab; - background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 1px 6px; } -.note-src:active { cursor: grabbing; } +.mark-note-list { + display: flex; flex-wrap: wrap; gap: 4px; + margin: 5px 0 0 24px; +} +.mark-script-wrap { position: relative; display: inline-flex; flex: none; } +.mark-script-pop { + position: absolute; right: 0; top: calc(100% + 4px); z-index: 21; + width: 210px; padding: 6px; + background: var(--paper); border: 1px solid var(--ink); box-shadow: 2px 2px 0 var(--ink); +} +.mark-script-pop .pt-input { display: block; max-width: none; } +.mark-script-pop .pt-dropdown { position: static; margin-top: 4px; box-shadow: none; } +.mark-script-new { + width: 100%; margin-top: 6px; padding: 5px 8px; + border-radius: 0; text-align: left; font-size: 11px; +} .bound-note { display: inline-flex; align-items: center; gap: 3px; font-size: 11px; - background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 0 4px; } + background: var(--paper); color: var(--ink); border: 1px solid var(--ink); border-radius: 0; padding: 1px 4px; + cursor: pointer; } .bound-note.live { background: var(--ink); color: var(--paper); } .bound-note-name { max-width: 120px; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; } .note-live { font-weight: bold; } @@ -783,6 +829,7 @@ html.dark .timeline-head { padding: 0 2px; font-size: 13px; line-height: 1; flex: none; align-self: center; } .mark-grip:active { cursor: grabbing; } +.mark-grip.disabled { cursor: default; opacity: .35; } .mark-block.dragging { opacity: 0.4; } .mark-block.drop-before { position: relative; } .mark-block.drop-before::before { diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index d0f6700..7a0c9ac 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -378,6 +378,9 @@ (merge {:id rid :kind :text :content ""} region))] (merge {:db db} (persist-note-fx db gid))))) +(defn- add-in [coll x] (vec (distinct (conj (vec coll) x)))) +(defn- rm-in [coll x] (vec (remove #(= x %) coll))) + ;; select-then-highlight with no active note: spin up a note (named after the ;; selected text) with the region already in it, and make it active. (rf/reg-event-fx ::highlight-into-new-note @@ -421,9 +424,6 @@ ;; The pointer lives on the referrer (annotation or mark), so a shared note stays ;; pure and freely reusable. These mutate the draft in-place (db only) and ride ;; the annotation's Save, exactly like ::set-content and the marks editor. -(defn- add-in [coll x] (vec (distinct (conj (vec coll) x)))) -(defn- rm-in [coll x] (vec (remove #(= x %) coll))) - (rf/reg-event-db ::bind-note-annotation (fn [db [_ gid note-gid]] (update-in db [:scene :groups gid :notes] #(add-in % note-gid)))) @@ -443,8 +443,66 @@ (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) -(rf/reg-event-db ::set-active-mark - (fn [db [_ mark-id]] (assoc-in db [:view :active-mark] mark-id))) +(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 (:parent g))) [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 (:parent (get-in scene [:groups 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 (:parent (get-in db [:scene :groups 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 @@ -452,6 +510,7 @@ (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) @@ -468,14 +527,7 @@ ;; gid. The entity isn't written until ::save-drawing, so cancel is a clean no-op. (rf/reg-event-db ::start-drawing (fn [db [_ ann mark-id]] - (let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m))) - (get-in db [:scene :groups ann :marks])))] - (-> db - (assoc-in [:view :active-mark] mark-id) ; drawing a mark makes it the active one - (assoc-in [:view :draw] - {:ann ann :mark-id mark-id - :gid (or existing (keyword (str "draw-" (random-uuid)))) - :new? (nil? existing)}))))) + (start-drawing-db db ann mark-id))) ;; leave draw mode. Strokes autocommit as you draw, so this is just "done" — ;; nothing to save or discard here (the form's Save/Cancel is the rollback net). @@ -553,7 +605,9 @@ (rf/reg-event-fx ::set-playhead (fn [{:keys [db]} [_ ctx lf]] - (let [next-db (assoc-in db [:view :playheads ctx] lf)] + (let [next-db (-> db + (assoc-in [:view :playheads ctx] lf) + (sync-draft-mark-for-playhead ctx lf))] (sync-route {:db next-db} next-db)))) (rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p))) ;; reveal an annotation's immediate children into the current timeline lane diff --git a/tl/src/tl/md.cljs b/tl/src/tl/md.cljs index 169b9e4..e9b4d6f 100644 --- a/tl/src/tl/md.cljs +++ b/tl/src/tl/md.cljs @@ -18,20 +18,22 @@ ;; Two link kinds share the [label](scheme…) form: ;; frame [label](mark:ref@at) jump the playhead to a spot ;; timeline [label](timeline:gid) push that timeline onto the stack +;; note [label](note:gid) jump to a script note (def ^:private link-re - "\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+))\\)") + "\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+)|note:([^)]+))\\)") (defn link-token "The token for a link map: {:kind :frame :label :ref :at} (the default) or - {:kind :timeline :label :ref}." + {:kind :timeline :label :ref} or {:kind :script-note :label :ref}." [{:keys [kind label ref at]}] - (if (= kind :timeline) - (str "[" label "](timeline:" (name ref) ")") + (case kind + :timeline (str "[" label "](timeline:" (name ref) ")") + :script-note (str "[" label "](note:" (name ref) ")") (str "[" label "](mark:" (name ref) "@" at ")"))) (defn parse-content "Split content `s` into [:text str] / [:link {…}] segments. Each link carries - :kind — :frame (with :ref/:at) or :timeline (with :ref)." + :kind — :frame (with :ref/:at), :timeline (with :ref), or :script-note." [s] (if (empty? s) [] @@ -39,10 +41,11 @@ (loop [out [] last 0] (if-let [m (.exec re s)] (let [idx (.-index m) pre (subs s last idx) - link (if (aget m 4) - {:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))} - {:kind :frame :label (aget m 1) :ref (keyword (aget m 2)) - :at (js/parseInt (aget m 3) 10)})] + link (cond + (aget m 4) {:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))} + (aget m 5) {:kind :script-note :label (aget m 1) :ref (keyword (aget m 5))} + :else {:kind :frame :label (aget m 1) :ref (keyword (aget m 2)) + :at (js/parseInt (aget m 3) 10)})] (recur (cond-> out (seq pre) (conj [:text pre]) :always (conj [:link link])) @@ -57,8 +60,9 @@ (= 3 (.-nodeType n)) (.-textContent n) (= "BR" (.-tagName n)) "\n" (and (.-classList n) (.contains (.-classList n) "link-chip")) - (link-token (if (= "timeline" (.. n -dataset -kind)) - {:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))} + (link-token (case (.. n -dataset -kind) + "timeline" {:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))} + "script-note" {:kind :script-note :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))} {:kind :frame :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref)) :at (js/parseInt (.. n -dataset -at) 10)})) ;; A wrapper element (e.g. the
a browser inserts on Enter): recurse so diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 5153578..4e798e2 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -22,6 +22,7 @@ ;; :choosing (fresh draft — marks + title picker only) | :creating (full form). (rf/reg-sub ::draft-stage (fn [db] (get-in db [:view :draft-stage]))) (rf/reg-sub ::script-jump (fn [db] (get-in db [:view :script-jump]))) +(rf/reg-sub ::note-target (fn [db] (get-in db [:view :note-target]))) (rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{}))) (rf/reg-sub ::hidden-tags (fn [db] (get-in db [:view :hidden-tags] #{}))) (rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus]))) diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 9000ff9..2cad17e 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -790,10 +790,10 @@ :border "1px solid rgba(78,143,194,0.85)" :pointer-events "none" :z-index 5}}])]]]])))) -;; --- 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. +;; --- 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. (defn- link-frame "ctx-local frame for a chip's {:ref :at}, resolved against the live scene." @@ -804,18 +804,30 @@ (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]}] - (if (= :timeline kind) + (case kind + :timeline (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") @@ -827,18 +839,29 @@ (let [span (js/document.createElement "span") scene @(rf/subscribe [::subs/scene]) timeline? (= :timeline kind) - lf (when-not timeline? + note? (= :script-note kind) + lf (when-not (or timeline? note?) (scene/link-local scene @(rf/subscribe [::subs/context]) {:ref ref :at at})) - ok (if timeline? (some? (scene/path-to scene ref)) lf)] + ok (cond + timeline? (some? (scene/path-to scene ref)) + note? (note-link-ok? scene ref) + :else lf)] (set! (.-className span) (if ok "link-chip" "link-chip broken")) (set! (.-contentEditable span) "false") - (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)) + (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)) (aset (.-dataset span) "label" label) (aset (.-dataset span) "ref" (name ref)) (when kind (aset (.-dataset span) "kind" (name kind))) - (when-not timeline? (aset (.-dataset span) "at" (str at))) + (when-not (or timeline? note?) (aset (.-dataset span) "at" (str at))) (when lf (let [f (js/document.createElement "span")] (set! (.-className f) "link-f") @@ -891,10 +914,16 @@ (.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")] - (when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))] - (goto-link! lf))))}])) + (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)))))}])) -(defn- point-candidates [scene ctx q timelines?] +(defn- point-candidates [scene ctx notes q timelines?] (let [needle (str/lower-case q) n (when (re-matches #"-?\d+" q) (js/parseInt q 10))] (vec @@ -915,7 +944,13 @@ (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}))))))))) + :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}}))))))))) (defn- point-label [cand off local] (str (:label cand) " @" (js/Math.round local) "f" @@ -923,7 +958,7 @@ (str " +" off)))) (defn- pick-point [cand off] - (if (= :timeline (:kind cand)) + (if (contains? #{:timeline :script-note} (: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)] @@ -945,7 +980,8 @@ ;; 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 [cands (point-candidates scene ctx @text timelines?) + (let [notes @(rf/subscribe [::subs/notes]) + cands (point-candidates scene ctx notes @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))) @@ -956,6 +992,7 @@ (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] @@ -989,7 +1026,7 @@ (reset! idx 0) (reset! off 0) (reset! open? true) - (preview! (first (point-candidates scene ctx (.. % -target -value) timelines?)) 0)) + (preview! (first (point-candidates scene ctx notes (.. % -target -value) timelines?)) 0)) :on-key-down (fn [e] (case (.-key e) @@ -1022,10 +1059,13 @@ :on-mouse-down #(.preventDefault %) :on-mouse-enter #(go! j) :on-click #(emit! c 0)} - (when timelines? [:span.cand-kind (if (= :timeline (:kind c)) "⤢ " "↪ ")]) + (when timelines? [:span.cand-kind (case (:kind c) + :timeline "⤢ " + :script-note "📄 " + "↪ ")]) [:span.cand-label (:label c)] (when (:group c) [:span.cand-group (str " " (:group c))]) - (when-not (= :timeline (:kind c)) + (when-not (contains? #{:timeline :script-note} (:kind c)) [:span.link-f (str " " (js/Math.round (:local c)) "f")])])))]))) (defn- local->draft-point [segs local] @@ -1093,14 +1133,17 @@ (defn- link-picker [{:keys [scene ctx on-commit on-cancel]}] (r/with-let [picked (r/atom nil)] - [: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} "✕"]])) + [: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} "✕"]]])) (defn- commit-link! "Insert a link chip for ref-point `pt` (label `label`) at the editor caret." @@ -1284,7 +1327,9 @@ :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 #(rf/dispatch [::events/unset-endpoint (:gid d) i k])} "✕"]])) + :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 @@ -1301,41 +1346,89 @@ (to-frame (.. % -target -value) len)])}] [:span.pt-dur (str "/" len)] [:button.pt-chip-x {:type "button" :title "Re-pick this end" - :on-click #(rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which])} "✕"]])) + :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 (scene/seg-length segs seg)] + [:div.pt-chip.pending + [:span.pt-chip-name (clip-label scene segs seg)] + [:input.pt-frame {:type "number" :value (js/Math.round 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} "✕"]]])) ;; --- script-note bindings (annotation form) ------------------------------ -;; 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. +;; 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. -(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"} +(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 "»»» "]) [:span.ann-swatch {:style {:background (:color n)}}] - (:name n)]) + [:span.bound-note-name (:name n)] + [:button.row-x {:type "button" :title "Unbind" + :on-click #(on-unbind ng)} "✕"]]) -(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"])]) +(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"]])]))) ;; 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. @@ -1363,7 +1456,8 @@ :on-drag-end (fn [_] (reset! mark-drag nil))}) (defn annotation-form [] - (r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid)] + (r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid) + last-scrolled (atom nil)] (let [d @(rf/subscribe [::subs/draft-group]) scene @(rf/subscribe [::subs/scene]) ;; anchor the form to the draft's home context, not the live stack top: @@ -1393,6 +1487,12 @@ (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?)) @@ -1401,36 +1501,7 @@ [: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)))}]] - [: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."])]) + :on-change #(put (assoc d :color (.. % -target -value)))}]]]) (when-not root? [:<> ;; the title IS the create/associate control: type a new title to make a @@ -1463,7 +1534,9 @@ (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"))}) + (not= i (:src drag))) "drop-before")) + :data-mark-row mark-id + :on-click #(rf/dispatch [::events/set-active-mark mark-id])}) [:div.mark-row [:span.mark-grip {:draggable true :title "Drag to reorder" :on-drag-start (fn [e] @@ -1508,43 +1581,52 @@ (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? - [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 (and (map? pt) (not (:proxy 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)."] - (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? [:<> - [: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-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-actions (when-not choosing? [:button.save {:type "submit" :disabled (not valid?)} "Save"]) @@ -1875,6 +1957,7 @@ 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) @@ -1916,6 +1999,13 @@ (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 @@ -1947,12 +2037,15 @@ [:button.sel-add {:style {:left (:bx @sel) :top (:by @sel)} :on-mouse-down #(.preventDefault %) ; keep the selection alive :on-click (fn [] - (if active + (if (and active (not note-target)) (rf/dispatch [::events/add-region-text active region]) (rf/dispatch [::events/highlight-into-new-note region])) (.removeAllRanges (.getSelection js/window)) (reset! sel nil))} - (if active (str "+ Highlight → " (:name note)) "+ New note from selection")]))] + (cond + note-target "+ Create note for mark" + active (str "+ Highlight → " (:name note)) + :else "+ New note from selection")]))] (when url [:div.script-empty "Loading script…"]))] (when (and url active note) [note-editor note active scroll-to-region!])] @@ -1967,12 +2060,15 @@ (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 [::events/set-pane :annotations])} "Annotations"] + :on-click #(rf/dispatch [(if note-target + ::events/cancel-note-target + ::events/set-pane) :annotations])} "Annotations"] [:button {:class (when (= pane :script) "active") :on-click #(rf/dispatch [::events/set-pane :script])} "Script"]] [:div.pane-body From 649e36c14c8315b69a12d9f207c68c31db0ec2d8 Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 5 Jul 2026 18:17:09 -0400 Subject: [PATCH 04/10] feat: add annotation search filters --- tl/resources/public/css/app.css | 11 +++++ tl/src/tl/events.cljs | 19 ++++++--- tl/src/tl/filter.cljs | 54 +++++++++++++++++++++++++ tl/src/tl/scene.cljs | 3 +- tl/src/tl/subs.cljs | 71 +++++++++++++++++++++++---------- tl/src/tl/views.cljs | 50 +++++++++++++++-------- tl/test/tl/filter_test.cljs | 55 +++++++++++++++++++++++++ tl/test/tl/scene_test.cljs | 4 +- 8 files changed, 222 insertions(+), 45 deletions(-) create mode 100644 tl/src/tl/filter.cljs create mode 100644 tl/test/tl/filter_test.cljs diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index c9334ee..3c1a902 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -365,6 +365,17 @@ 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; } +.annotation-filter .filter-btn.clear { margin-left: auto; } .form-hint { font-size: 11px; color: var(--mute); } .form-check { display: flex; align-items: center; gap: 6px; font-family: var(--chicago); diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 7a0c9ac..e1afab9 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -332,12 +332,21 @@ (let [s (get-in db [:view :hidden-notes] #{})] (assoc-in db [:view :hidden-notes] (if (contains? s gid) (disj s gid) (conj s gid)))))) -;; per-tag annotation visibility (view-only, ephemeral): eye toggles in the tag -;; filter. A tag in :hidden-tags hides every annotation carrying it. -(rf/reg-event-db ::toggle-tag-filter +;; annotation-pane filters are inclusive: selected tags narrow the list to +;; matching annotations; active-only narrows to annotations under the playhead. +(rf/reg-event-db ::set-annotation-search + (fn [db [_ q]] (assoc-in db [:view :annotation-filter :query] q))) +(rf/reg-event-db ::toggle-annotation-tag-filter (fn [db [_ tag]] - (let [s (get-in db [:view :hidden-tags] #{})] - (assoc-in db [:view :hidden-tags] (if (contains? s tag) (disj s tag) (conj s tag)))))) + (let [s (get-in db [:view :annotation-filter :tags] #{})] + (assoc-in db [:view :annotation-filter :tags] + (if (contains? s tag) (disj s tag) (conj s tag)))))) +(rf/reg-event-db ::toggle-active-annotations-filter + (fn [db _] + (update-in db [:view :annotation-filter :active-only?] not))) +(rf/reg-event-db ::clear-annotation-filter + (fn [db _] (assoc-in db [:view :annotation-filter] + {:query "" :tags #{} :active-only? false}))) ;; click a highlight on the page → activate its note and focus that region's row ;; in the right pane diff --git a/tl/src/tl/filter.cljs b/tl/src/tl/filter.cljs new file mode 100644 index 0000000..8733921 --- /dev/null +++ b/tl/src/tl/filter.cljs @@ -0,0 +1,54 @@ +(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 active-only? active-ids]} ann] + (let [{:keys [scope term]} (parse-query query) + selected-tags (set tags) + active-ids (set active-ids) + 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)) + (or (not active-only?) (contains? active-ids (:id ann))) + (includes-term? haystack term)))) + +(defn filter-annotations [anns filters] + (filterv #(annotation-matches? filters %) anns)) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 2f7c64c..07ade0e 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -455,7 +455,8 @@ :drawing g ; pure strokes + seed, JSON round-trips as-is (-> g (update :marks #(mapv restore-mark (or % []))) - (update :notes #(when % (mapv keyword %))) ; annotation-level bindings + (cond-> (:notes g) + (update :notes #(mapv keyword %))) ; annotation-level bindings migrate))]))) anns)) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 4e798e2..c22ffe1 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -1,6 +1,7 @@ (ns tl.subs (:require [clojure.string :as str] [re-frame.core :as rf] + [tl.filter :as filter] [tl.scene :as scene])) (rf/reg-sub ::status (fn [db] (get-in db [:load :status]))) @@ -24,7 +25,9 @@ (rf/reg-sub ::script-jump (fn [db] (get-in db [:view :script-jump]))) (rf/reg-sub ::note-target (fn [db] (get-in db [:view :note-target]))) (rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{}))) -(rf/reg-sub ::hidden-tags (fn [db] (get-in db [:view :hidden-tags] #{}))) +(rf/reg-sub ::annotation-filter + (fn [db] (merge {:query "" :tags #{} :active-only? false} + (get-in db [:view :annotation-filter])))) (rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus]))) (rf/reg-sub ::linking (fn [db] (get-in db [:view :linking]))) (rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann]))) @@ -105,11 +108,16 @@ (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)) + ;; child annotations of the current context, with their bars in local coords (rf/reg-sub - ::annotations - :<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed] - (fn [[scene ctx segs hidden-tags revealed] _] + ::all-annotations + :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] + (fn [[scene ctx segs 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 @@ -119,16 +127,30 @@ (and (revealed p) (shown? (get-in scene [:groups p :parent])))))] (->> (:groups scene) (keep (fn [[gid g]] - (when (and (= :annotation (:type g)) (shown? (:parent g)) - ;; a hidden tag hides every annotation carrying it; the - ;; :untagged sentinel hides annotations with no tags - (let [tags (get-in g [:meta :tags])] - (not (or (some hidden-tags tags) - (and (empty? tags) (contains? hidden-tags :untagged)))))) + (when (and (= :annotation (:type g)) (shown? (:parent g))) (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])] + 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 (:parent g) :name (:name g) :color (or (:color g) "#4e8fc2") :content (:content g) :children (count (:marks g)) @@ -136,19 +158,33 @@ :draft (boolean (:draft g)) ;; every script-note bound anywhere in this annotation ;; (annotation-level + per-mark), deduped, still-existing only - :notes (->> (concat (:notes g) (mapcat :notes (:marks g))) - distinct - (filterv #(= :script-note (get-in scene [:groups % :type])))) + :notes note-ids + :script (vec (remove nil? note-text)) + :clips (vec clips) :broken (boolean reason) :reason reason :oor oor :hidden (boolean hidden) :tags (vec (get-in g [:meta :tags])) ;; jump targets labelled from the marks' clip refs (same as ;; the editor) — not re-derived from a floored bar frame - :jumps (scene/jump-targets scene ctx gid) + :jumps jumps :start (or (ffirst bars) 0) :bars bars})))) (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom vec)))) +(rf/reg-sub + ::active-annotations-unfiltered + :<- [::all-annotations] :<- [::playhead] + (fn [[anns ph] _] + (into #{} (keep (fn [a] (when (in-bars? (:bars a) ph) + (:id a))) + anns)))) + +(rf/reg-sub + ::annotations + :<- [::all-annotations] :<- [::annotation-filter] :<- [::active-annotations-unfiltered] + (fn [[anns filters active] _] + (filter/filter-annotations anns (assoc filters :active-ids active)))) + ;; 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 @@ -161,11 +197,6 @@ (sort-by str/lower-case) vec))) -;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the -;; next bar only (no double-highlight, no drawing bleeding onto the next clip). -(defn- in-bars? [bars ph] - (some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars)) - ;; the annotation the playhead is currently inside (or the latest one passed) — ;; drives the rolling highlight/scroll in the commentary (rf/reg-sub diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 2cad17e..871d8b7 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -1679,24 +1679,40 @@ ;; "Untagged" is just another item that maps to the :untagged sentinel. (def ^:private untagged-label "Untagged") -(defn- tag-filter [] +(defn- annotation-filter [] (r/with-let [open? (r/atom false)] - (let [tags @(rf/subscribe [::subs/project-tags]) - hidden @(rf/subscribe [::subs/hidden-tags]) + (let [project-tags @(rf/subscribe [::subs/project-tags]) + {:keys [query tags active-only?]} @(rf/subscribe [::subs/annotation-filter]) + chosen (set tags) key-of #(if (= % untagged-label) :untagged %)] - (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)) "🙈" "👁")])}]]])])))) + [: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)])}] + [:button.filter-btn {:class (when active-only? "active") + :title "Only show annotations active at the playhead" + :on-click #(rf/dispatch [::events/toggle-active-annotations-filter])} + "Active"] + (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) active-only?) + [:button.filter-btn.clear {:title "Clear filters" + :on-click #(rf/dispatch [::events/clear-annotation-filter])} + "Clear"])]))) (defn toolbar [] ;; NB: subscribe the coarse ::at-start?/::at-end? edges, not the raw playhead — @@ -1727,7 +1743,6 @@ [: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! @@ -2071,6 +2086,7 @@ ::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] diff --git a/tl/test/tl/filter_test.cljs b/tl/test/tl/filter_test.cljs new file mode 100644 index 0000000..ce81837 --- /dev/null +++ b/tl/test/tl/filter_test.cljs @@ -0,0 +1,55 @@ +(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 active-only-intersects-other-filters + (testing "active-only shows only currently active annotations" + (is (= [:b] (mapv :id (f/filter-annotations anns {:active-only? true + :active-ids #{:b :z}}))))) + (testing "active-only intersects with selected tags" + (is (= [] (mapv :id (f/filter-annotations anns {:tags #{"beat"} + :active-only? true + :active-ids #{:b}})))))) + +(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/scene_test.cljs b/tl/test/tl/scene_test.cljs index ccde702..36c2359 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -373,9 +373,9 @@ (deftest annotations-survive-json-roundtrip (testing "restore-annotations is the exact inverse of the JSON wire trip — guards against any keyword-valued field (id/ref/type/parent/track) being missed" - (let [anns {:ann-p {:v 1 :type :annotation :parent :root :name "p" :color "#abc" :content "hi" + (let [anns {:ann-p {:v s/schema-version :type :annotation :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 1 :type :annotation :parent :ann-p :name "c" + :ann-c {:v s/schema-version :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))))))) From 28f441f172122a58e98513ba79d4dfd5a3afa55d Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 5 Jul 2026 18:20:29 -0400 Subject: [PATCH 05/10] fix: remove active annotation filter --- tl/resources/public/css/app.css | 5 ++++- tl/src/tl/events.cljs | 7 ++----- tl/src/tl/filter.cljs | 4 +--- tl/src/tl/subs.cljs | 16 ++++------------ tl/src/tl/views.cljs | 19 ++++++++++--------- tl/test/tl/filter_test.cljs | 9 --------- 6 files changed, 21 insertions(+), 39 deletions(-) diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index 3c1a902..e34fcc0 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -375,7 +375,10 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; border-radius: 0; padding: 5px 7px; font-family: var(--geneva); font-size: 12px; } .annotation-filter .filter-btn { border-radius: 0; } -.annotation-filter .filter-btn.clear { margin-left: auto; } +.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); diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index e1afab9..cb95aa5 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -333,7 +333,7 @@ (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; active-only narrows to annotations under the playhead. +;; 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 @@ -341,12 +341,9 @@ (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 ::toggle-active-annotations-filter - (fn [db _] - (update-in db [:view :annotation-filter :active-only?] not))) (rf/reg-event-db ::clear-annotation-filter (fn [db _] (assoc-in db [:view :annotation-filter] - {:query "" :tags #{} :active-only? false}))) + {:query "" :tags #{}}))) ;; click a highlight on the page → activate its note and focus that region's row ;; in the right pane diff --git a/tl/src/tl/filter.cljs b/tl/src/tl/filter.cljs index 8733921..3426206 100644 --- a/tl/src/tl/filter.cljs +++ b/tl/src/tl/filter.cljs @@ -32,10 +32,9 @@ (and (contains? selected :untagged) (empty? tags)))))) (defn annotation-matches? - [{:keys [query tags active-only? active-ids]} ann] + [{:keys [query tags]} ann] (let [{:keys [scope term]} (parse-query query) selected-tags (set tags) - active-ids (set active-ids) fields {:timeline [(:name ann) (:content ann)] :script (:script ann) :clip (:clips ann) @@ -47,7 +46,6 @@ :tag (:tag fields) (mapcat fields [:timeline :script :clip :tag]))] (and (tag-match? selected-tags (:tags ann)) - (or (not active-only?) (contains? active-ids (:id ann))) (includes-term? haystack term)))) (defn filter-annotations [anns filters] diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index c22ffe1..98524be 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -26,7 +26,7 @@ (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 #{} :active-only? false} + (fn [db] (merge {:query "" :tags #{}} (get-in db [:view :annotation-filter])))) (rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus]))) (rf/reg-sub ::linking (fn [db] (get-in db [:view :linking]))) @@ -171,19 +171,11 @@ (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom vec)))) -(rf/reg-sub - ::active-annotations-unfiltered - :<- [::all-annotations] :<- [::playhead] - (fn [[anns ph] _] - (into #{} (keep (fn [a] (when (in-bars? (:bars a) ph) - (:id a))) - anns)))) - (rf/reg-sub ::annotations - :<- [::all-annotations] :<- [::annotation-filter] :<- [::active-annotations-unfiltered] - (fn [[anns filters active] _] - (filter/filter-annotations anns (assoc filters :active-ids active)))) + :<- [::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. diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 871d8b7..b4e216a 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -1682,7 +1682,10 @@ (defn- annotation-filter [] (r/with-let [open? (r/atom false)] (let [project-tags @(rf/subscribe [::subs/project-tags]) - {:keys [query tags active-only?]} @(rf/subscribe [::subs/annotation-filter]) + {: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) key-of #(if (= % untagged-label) :untagged %)] [:div.annotation-filter @@ -1691,10 +1694,6 @@ :value query :on-change #(rf/dispatch [::events/set-annotation-search (.. % -target -value)])}] - [:button.filter-btn {:class (when active-only? "active") - :title "Only show annotations active at the playhead" - :on-click #(rf/dispatch [::events/toggle-active-annotations-filter])} - "Active"] (when (seq project-tags) [:span.tag-filter [:button.filter-btn {:class (when (seq chosen) "active") @@ -1709,10 +1708,12 @@ :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) active-only?) - [:button.filter-btn.clear {:title "Clear filters" - :on-click #(rf/dispatch [::events/clear-annotation-filter])} - "Clear"])]))) + (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"]])]))) (defn toolbar [] ;; NB: subscribe the coarse ::at-start?/::at-end? edges, not the raw playhead — diff --git a/tl/test/tl/filter_test.cljs b/tl/test/tl/filter_test.cljs index ce81837..d6a3c48 100644 --- a/tl/test/tl/filter_test.cljs +++ b/tl/test/tl/filter_test.cljs @@ -32,15 +32,6 @@ (testing "untagged is an explicit include bucket" (is (= [:c] (mapv :id (f/filter-annotations anns {:tags #{:untagged}})))))) -(deftest active-only-intersects-other-filters - (testing "active-only shows only currently active annotations" - (is (= [:b] (mapv :id (f/filter-annotations anns {:active-only? true - :active-ids #{:b :z}}))))) - (testing "active-only intersects with selected tags" - (is (= [] (mapv :id (f/filter-annotations anns {:tags #{"beat"} - :active-only? true - :active-ids #{:b}})))))) - (deftest search-scopes (testing "plain text searches title/content/tags/script/clips" (is (= [:a] (mapv :id (f/filter-annotations anns {:query "breakfast"})))) From 40dd3b0d5990bd67c0c23988290860a3ba8b3c0b Mon Sep 17 00:00:00 2001 From: Your Name Date: Mon, 6 Jul 2026 22:54:18 -0400 Subject: [PATCH 06/10] feat: transclusion (wip commit) --- tl/shadow-cljs.edn | 5 +- tl/src/tl/events.cljs | 8 +- tl/src/tl/otio.cljs | 10 +- tl/src/tl/scene.cljs | 215 +++++++++++++++++++++++++++---------- tl/src/tl/subs.cljs | 40 +++++-- tl/src/tl/views.cljs | 39 ++++--- tl/test/tl/flow_test.cljs | 129 ++++++++++++++++++++++ tl/test/tl/scene_test.cljs | 118 +++++++++++++++++++- 8 files changed, 479 insertions(+), 85 deletions(-) create mode 100644 tl/test/tl/flow_test.cljs diff --git a/tl/shadow-cljs.edn b/tl/shadow-cljs.edn index ba215ec..5209343 100644 --- a/tl/shadow-cljs.edn +++ b/tl/shadow-cljs.edn @@ -19,7 +19,10 @@ {:test {:target :node-test :output-to "target/node-tests.js" - :ns-regexp "-test$"} + :ns-regexp "-test$" + ;; minimal browser-global shim so tl.api / tl.routes load under node — lets the + ;; integration tests (tl.flow-test) drive the real re-frame events. No DOM. + :prepend "globalThis.window=globalThis;var __loc={protocol:'http:',hostname:'localhost',host:'localhost',origin:'http://localhost',href:'http://localhost/',hash:'',pathname:'/',search:''};globalThis.location=__loc;globalThis.window.location=__loc;globalThis.document={createElement:function(){return {style:{}};},addEventListener:function(){},removeEventListener:function(){},querySelector:function(){return null;},body:{}};globalThis.navigator={standalone:false,userAgent:'node'};var __ls={};globalThis.localStorage={getItem:function(k){return k in __ls?__ls[k]:null;},setItem:function(k,v){__ls[k]=String(v);},removeItem:function(k){delete __ls[k];}};globalThis.window.matchMedia=function(){return {matches:false,addListener:function(){},removeListener:function(){}};};globalThis.window.addEventListener=function(){};globalThis.window.removeEventListener=function(){};globalThis.window.history={replaceState:function(){},pushState:function(){}};globalThis.XMLHttpRequest=function(){};globalThis.XMLHttpRequest.prototype={open:function(){},send:function(){},setRequestHeader:function(){},abort:function(){}};"} :app {:target :browser diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index cb95aa5..67a47b6 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -797,7 +797,7 @@ (let [scene (:scene db) ctx (:parent (get-in scene [:groups gid])) segs (scene/content-segments scene ctx) - [lo hi] (scene/mark-extent scene ctx gid mark-id segs)] + [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 @@ -897,7 +897,11 @@ pid (->> (get-in scene [:groups ann :marks]) (some #(when (= mark-id (:id %)) (get-in % [:start :ref])))) proxy (get-in scene [:groups pid]) - ctx (:parent (get-in scene [:groups ann])) + ;; roll against the VIEWED timeline (top of the stack), NOT the annotation's + ;; :parent — the drag's frames are local to what you're looking at, and a + ;; transcluded mark is being edited from a context other than its parent. + ;; For a normal (non-transcluded) mark the two are the same. + ctx (peek (get-in db [:view :stack])) len (scene/length (scene/content-segments scene ctx)) ;; the dragged endpoint is a whole frame; the FIXED endpoint arrives ;; EXACT (fractional) so its mark re-derives identically. Only the fixed diff --git a/tl/src/tl/otio.cljs b/tl/src/tl/otio.cljs index e0c5aad..e1d7883 100644 --- a/tl/src/tl/otio.cljs +++ b/tl/src/tl/otio.cljs @@ -13,8 +13,14 @@ (defn- clip? [item] (str/starts-with? (:OTIO_SCHEMA item "") "Clip")) -(defn- frames [rational-time] - (:value rational-time)) +(defn- frames + "Frame number of a RationalTime, as a WHOLE frame. This is the ONE place a + fraction can enter: a rate conform (e.g. 23.976 NTSC) gives fractional source + positions (start_time). A frame is absolute and integer — you can't seek to half + a frame — so we snap here, at the boundary. Everything downstream is integer and + nothing else rounds (durations are already whole, so timeline tiling is exact)." + [rational-time] + (js/Math.round (:value rational-time))) (defn- clip-starts "Source start_time (frames) of every clip across all tracks." diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 07ade0e..8aea34c 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -144,15 +144,25 @@ (when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range {:frame f}))) -(defn- rebase - "Shift `sub`'s :local to start at 0 and stamp :mark = `id` (the mark now owns - these segments regardless of which target they were sliced from)." - [id sub] +(defn- shift-local + "Shift `sub`'s :local so the run starts at 0, WITHOUT touching :mark — pieces keep + the identity of the target they were sliced from. This is the RAW recursion's + output; content-segments uses it so a multi-clip mark stays a run of + individually-addressable clips (their own name/length/ref)." + [sub] (let [base (or (some-> sub first :local first) 0)] (mapv (fn [s] (let [[c d] (:local s)] - (assoc s :mark id :local [(- c base) (- d base)]))) + (assoc s :local [(- c base) (- d base)]))) sub))) +(defn- rebase + "shift-local, then stamp :mark = `id` — the LANE/edit view, where the mark owns + every piece it resolves to (one bar per mark) regardless of which target they + were sliced from. The stamp is the only thing separating this from the raw + recursion (shift-local)." + [id sub] + (mapv #(assoc % :mark id) (shift-local sub))) + (defn- instant-seg "A zero-length segment at local frame `la` of `tsegs` (for an instant mark), carrying that frame's src/track/thumb." @@ -223,13 +233,52 @@ ;; --- what the current timeline is made of -------------------------------- +(defn- content-mark-segs + "Context-local pieces of mark `m` for content-segments. A ref into a PROXY drills + in and exposes the proxy's per-clip run, each sub-clip mark kept individually + addressable (its own name/length/ref/trim, via shift-local) — instead of + collapsing every piece under `m`'s single id the way resolve does for the LANE + view (rebase). That collapse was the bug: drilling into a proxy-backed range made + every clip read with the FIRST piece's name + length, so sub-range selections + wouldn't save. Any OTHER mark — a plain clip ref, a single mark ref, an absolute + mark — is one piece and stays owned by `m` (resolve-mark), so nested marks there + remain annotation-relative, exactly as before this fix." + [scene gid {:keys [start end] :as m}] + (if (and (map? start) (= :proxy (:type (grp scene (:ref start))))) + (when-let [tsegs (seq (target-segs scene (:ref start)))] + (let [len (length tsegs) + at->l #(if (neg? %) (+ len % 1) %) + la (at->l (:at start)) + lb (at->l (:at end))] + (when (and (<= 0 la len) (<= 0 lb len) (<= la lb)) + (shift-local (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb)))))) + (resolve-mark scene gid m))) + +(defn- content-resolve + "`resolve` for content-segments: lays a group's marks end to end, but each piece + keeps its underlying :mark (see content-mark-segs) so multi-clip marks don't + collapse to one addressable unit." + [scene gid] + (loop [[m & more] (:marks (grp scene gid)), off 0, out []] + (if (nil? m) + out + (if-let [segs (seq (content-mark-segs scene gid m))] + (let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs)) + shifted (mapv (fn [s] (let [[c d] (:local s)] + (assoc s :local [(+ off c) (+ off d)]))) + segs)] + (recur more (+ off len) (into out shifted))) + (recur more off out))))) + (defn content-segments "The clip-segments that make up context `ctx` — what you draw and select - against. An annotation's marks reference clips, so that's just `resolve`. The - root timeline doesn't enumerate its clips (they're a parentless pool), so - there it's the pool laid at each clip's TIMELINE position (:start) with :src = - its source range — so the assembled program tiles contiguously even though - the underlying source frames are scattered (and fractional)." + against. An annotation's marks reference clips, so that's just `resolve` — but + with each piece kept distinct (see content-resolve), not flattened under the + annotation's own mark id. The root timeline doesn't enumerate its clips (they're + a parentless pool), so there it's the pool laid at each clip's TIMELINE position + (:start) with :src = its source range — so the assembled program tiles + contiguously even though the underlying source frames are scattered (and + fractional)." [scene ctx] (if (= :timeline (:type (grp scene ctx))) (->> (:groups scene) @@ -241,7 +290,7 @@ (assoc seg :mark gid :local [st (+ st (- sb sa))]))))) (sort-by (comp first :local)) vec) - (resolve scene ctx))) + (content-resolve scene ctx))) (defn- src-intersect "Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))." @@ -251,46 +300,20 @@ :when (< lo hi)] [lo hi]))) -(defn nested-src - "Source ranges of annotation `gid` clipped to every ancestor annotation between - it and `ctx` — what's still visible once the reveal chain trims it, i.e. the - same content you'd see if you expanded into its parent. A direct child of `ctx` - is just its own resolved source (the timeline itself does the clipping later). - Empty ⇒ the annotation is out of range in this reveal chain." - [scene ctx gid] - (loop [p (:parent (grp scene gid)), rs (mapv :src (resolve scene gid))] - (if (or (nil? p) (= p ctx)) - rs - (recur (:parent (grp scene p)) - (src-intersect rs (mapv :src (resolve scene p))))))) - -(defn- clip-segs - "Clip resolved segments `ss` (each {:mark :src …}) to coverage `cover` ([c d)s), - keeping each seg's :mark (the mark-aware sibling of src-intersect)." - [ss cover] - (vec (for [{[a b] :src :as s} ss [c d] cover - :let [lo (max a c) hi (min b d)] - :when (< lo hi)] - (assoc s :src [lo hi])))) - -(defn nested-src-marks - "Like nested-src but preserves :mark on each surviving segment, so lane bars can - be grouped per mark (see lane-bars). Ordered as resolve lays the marks." - [scene ctx gid] - (loop [p (:parent (grp scene gid)), ss (resolve scene gid)] - (if (or (nil? p) (= p ctx)) - ss - (recur (:parent (grp scene p)) (clip-segs ss (mapv :src (resolve scene p))))))) - (defn lane-bars "Context-local display bars for annotation `gid`, grouped PER MARK: contiguous pieces coalesce WITHIN a mark but never across marks, so two abutting-but- distinct marks stay separate bars — the lane bar matches each mark's highlight 1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id lets the lane hit-test / highlight / edit one mark; consumers that only want - the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments." - [scene ctx gid ctx-segs] - (->> (nested-src-marks scene ctx gid) + the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments. + + `resolve` already trims each mark through its whole ref chain — a nested mark + is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ … + ⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs` + is all the clipping needed (no ancestor re-walk — that was redundant)." + [scene gid ctx-segs] + (->> (resolve scene gid) (partition-by :mark) (mapcat (fn [ss] (let [mid (:mark (first ss))] @@ -303,8 +326,8 @@ min piece-start / max piece-end, WITHOUT merge-bars' floor/ceil. Endpoint editing must use this (not a rounded lane bar) or the fixed end drifts a frame per re-roll. `ctx-segs` = content-segments of ctx." - [scene ctx gid mark-id ctx-segs] - (let [pcs (->> (nested-src-marks scene ctx gid) + [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) @@ -321,6 +344,59 @@ own (mapv :src (resolve scene gid))] (< (len (src-intersect own (mapv :src (resolve scene p)))) (len own)))))) +;; --- reference parent: which timeline a mark was authored in --------------- +;; A mark's proxy DIRECTLY references a content unit of exactly one timeline — the +;; one it was authored in. That timeline is the mark's "home"; the annotation +;; holding the mark shows as a child there. This is one hop (a direct reference), +;; NOT transitive resolution down to clips — so a grandchild is a child of its +;; parent, not of the root. An annotation that collected marks from two contexts +;; (transclusion) is a child of both. This is the "fk" the nesting rides on. + +(defn- ref-owner + "The timeline that OWNS content unit `t`: :root for a clip, else the annotation + whose proxy contains the mark `t` (t is one of that annotation's content units). + nil if `t` dangles." + [scene t] + (cond + (= :clip (:type (grp scene t))) :root + (find-mark scene t) + (let [[container _] (find-mark scene t)] + (if (= :proxy (:type (grp scene container))) + (some (fn [[gid g]] + (when (and (= :annotation (:type g)) + (some #(= container (get-in % [:start :ref])) (:marks g))) + gid)) + (:groups scene)) + container)) + :else nil)) + +(defn mark-home + "The timeline mark `m` was authored in — the owner of the content unit its proxy + DIRECTLY references (one hop). :root for a clip-backed mark. The annotation that + holds `m` shows as a child of this timeline. nil if unresolvable." + [scene m] + (let [pid (get-in m [:start :ref]) + t (if (= :proxy (:type (grp scene pid))) + (get-in (first (:marks (grp scene pid))) [:start :ref]) + pid)] + (ref-owner scene t))) + +(defn mark-homes + "The distinct timelines annotation `gid`'s marks are homed in — its reference + parent(s). Usually one; two (or more) when it collected marks from different + contexts (transclusion). Falls back to the structural `:parent` when the + annotation has no resolvable marks (a fresh draft, a fully broken one), so it + still shows somewhere." + [scene gid] + (let [homes (into #{} (keep #(mark-home scene %)) (:marks (grp scene gid)))] + (if (seq homes) homes #{(:parent (grp scene gid))}))) + +(defn child-of? + "Is annotation `gid` a direct child of timeline `ctx` — a mark of its authored + there (homed in ctx)." + [scene ctx gid] + (contains? (mark-homes scene gid) ctx)) + ;; --- editing: split a local selection into a run of single-clip marks ----- (defn selection->marks @@ -526,6 +602,28 @@ (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 @@ -572,15 +670,22 @@ [] pts))) (defn jump-targets - "One target per discontinuity for an annotation's jump popover — labelled from - the owning mark's clip ref + frame, the SAME basis the annotation editor uses - (clip-label of :ref), so the jump label can never disagree with the mark row. - Each: {:local :seg :f }." + "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}." [scene ctx gid] - (mapv (fn [{:keys [id lo]}] - (let [st (:start (some #(when (= id (:id %)) %) (:marks (grp scene gid))))] - (assoc (display-point scene st) :local lo))) ; same cell as the editor row - (runs scene ctx gid))) + (let [csegs (content-segments scene ctx)] + (mapv (fn [{:keys [lo]}] + (let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs) + (some (fn [{[_ d] :local :as s} ] (when (= d lo) s)) csegs) + (last csegs))] + {:local lo + :seg (:mark seg) + :f (js/Math.round (- lo (first (:local seg [0 0]))))})) + (runs scene ctx gid)))) (defn linkables "Pickable link targets within `ctx`, grouped for the autocomplete: one group diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 98524be..56bb6f1 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -118,18 +118,32 @@ ::all-annotations :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] (fn [[scene ctx segs 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])))))] + (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid])))) + ;; each annotation → its reference PARENTS: the timeline(s) its marks were + ;; authored in (mark-homes). A normal annotation has one; a transcluded one + ;; (marks from two contexts) has two, so it shows as a child under BOTH. + parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))] + [gid (scene/mark-homes scene gid)])) + ;; child count per timeline (drives the "Show N" nested badge) + nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents)) + ;; reference-reveal hierarchy: shows when ctx is a reference parent, or a + ;; REVEALED reference-parent that itself shows. `seen` guards ref cycles. + shown? (fn shown? [gid seen] + (and (not (contains? seen gid)) + (boolean (some (fn [p] (or (= ctx p) + (and (ann? p) (revealed p) (shown? p (conj seen gid))))) + (parents gid)))))] (->> (:groups scene) (keep (fn [[gid g]] - (when (and (= :annotation (:type g)) (shown? (:parent g))) - (let [bars (scene/lane-bars scene ctx gid segs) ; one bar per mark; distinct marks never fuse - reason (scene/broken-reason scene gid) + (when (= :annotation (:type g)) + ;; VISIBILITY IS BY REFERENCE: an annotation shows in ctx when a + ;; mark of its was AUTHORED in ctx (homed there) — one hop, not + ;; transitive — so a mark made in ctx shows even if the annotation + ;; is parented elsewhere (transclusion), while a grandchild does + ;; not leak up and a sibling covering the same clips stays out. + (let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse + (when (shown? gid #{}) + (let [reason (scene/broken-reason scene gid) oor (boolean (scene/clip-loss? scene gid)) hidden (get-in g [:meta :hidden]) note-ids (->> (concat (:notes g) (mapcat :notes (:marks g))) @@ -152,6 +166,10 @@ (some-> ref name))))) distinct)] {:id gid :parent (:parent g) + ;; the timeline(s) this annotation is a child of (mark-homes) — + ;; the pane groups by this so a transcluded annotation appears + ;; under every context it was authored in. + :parents (parents gid) :name (:name g) :color (or (:color g) "#4e8fc2") :content (:content g) :children (count (:marks g)) :nested (get nested gid 0) @@ -167,7 +185,7 @@ ;; jump targets labelled from the marks' clip refs (same as ;; the editor) — not re-derived from a floored bar frame :jumps jumps - :start (or (ffirst bars) 0) :bars bars})))) + :start (or (ffirst bars) 0) :bars bars})))))) (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom vec)))) diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index b4e216a..5e28053 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -696,7 +696,7 @@ ;; EXACT context-local extent (never the rounded bar). The drag ;; keeps the FIXED endpoint at this exact value so its mark ;; re-derives identically — that's what stops the other end drifting. - :let [ext (scene/mark-extent scene ctx (:id a) mid segs)] + :let [ext (scene/mark-extent scene (:id a) mid segs)] :when ext :let [[lo hi] ext active? (= mid active-mark)]] @@ -1220,7 +1220,7 @@ (.stopPropagation e) (.preventDefault e) (reset! over? false) (rf/dispatch [::events/reparent (keyword src) (:id a)]))))})) -(defn- annotation-card [a scene ctx segs nmap authed? open by-parent] +(defn- annotation-card [a scene ctx segs nmap authed? open by-parent seen] (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]) @@ -1279,10 +1279,11 @@ [: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 (seq (get by-parent (:id a)))] + (when-let [kids (seq (remove #(contains? seen (:id %)) (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])))])))) + ^{:key (:id k)} + [annotation-card k scene ctx segs nmap authed? open by-parent (conj seen (:id a))])))])))) (defn commentary [] (let [open (r/atom nil)] @@ -1306,23 +1307,37 @@ (when authed? [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])]) (if (seq anns) - (let [by-parent (group-by :parent anns)] ; nest revealed children under their parent + ;; 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 (reduce (fn [m a] (reduce #(update %1 %2 (fnil conj []) a) m (:parents a))) + {} anns)] (doall (for [a (get by-parent ctx)] ^{:key (:id a)} - [annotation-card a scene ctx segs nmap authed? open by-parent]))) + [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 (scene/seg-length segs seg)] + (let [len (pt-len scene segs seg)] [:div.pt-chip - [:span.pt-chip-name (clip-label scene segs seg)] + [:span.pt-chip-name (pt-name scene segs seg)] [:input.pt-frame {:type "number" :min 0 :max len :value f :on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}] [:span.pt-dur (str "/" len)] @@ -1338,9 +1353,9 @@ 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 (scene/seg-length segs seg)] + (let [len (pt-len scene segs seg)] [:div.pt-chip - [:span.pt-chip-name (clip-label scene segs seg)] + [: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)])}] @@ -1351,9 +1366,9 @@ (rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which]))} "✕"]])) (defn- pending-frame-chip [scene segs {:keys [seg f]}] - (let [len (scene/seg-length segs seg)] + (let [len (pt-len scene segs seg)] [:div.pt-chip.pending - [:span.pt-chip-name (clip-label scene segs seg)] + [:span.pt-chip-name (pt-name scene segs seg)] [:input.pt-frame {:type "number" :value (js/Math.round f) :disabled true}] [:span.pt-dur (str "/" len)]])) diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs new file mode 100644 index 0000000..f0da29a --- /dev/null +++ b/tl/test/tl/flow_test.cljs @@ -0,0 +1,129 @@ +(ns tl.flow-test + "Integration tests that drive the ACTUAL re-frame events the UI dispatches + (dispatch-sync) and read the resulting app-db / scene back — so a bug that lives + in an event handler (not a pure scene fn) is caught. Side-effecting fx are + stubbed so the sync path stays pure; project id is nil so nothing hits the net." + (:require [cljs.test :refer-macros [deftest is testing]] + [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))) + +;; single-source footage: four clips, ALL named "Challengers.mov" (this is why the +;; media name is useless as a label — the track+occurrence is what distinguishes) +(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) + annB (over clips C,D) + annC (parented under A, + holding one mark authored inside A) — the state right before you drill into B." + [] + (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 :parent :root :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]}) + (assoc-in [:groups :annB] {:type :annotation :parent :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 :parent :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 bars-in [ctx gid] + (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) + +(deftest tie-marks-to-annotation-in-another-context-then-drag + (testing "author a range while drilled into annB, tie it to annC (parented under + annA), then drag its handle — it must stay one proxy, stay visible in + annB, and NOT vanish when rerolled." + (setup! (seed) [:root]) + ;; drill into annB (real stack-nav event) + (rf/dispatch-sync [::ev/expand :annB]) + (is (= [:root :annB] (get-in @rdb/app-db [:view :stack]))) + ;; new draft + select a range 50..150 (C-tail + D-head), exactly as a lane drag + (rf/dispatch-sync [::ev/open-draft]) + (rf/dispatch-sync [::ev/draft-select-range 50 150]) + (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))] + (is draft-gid "a draft should exist after open-draft") + (is (= 1 (count (get-in (scene*) [:groups draft-gid :marks]))) "one proxy mark, not per-clip") + ;; tie the draft's marks to the existing annC (transclusion) + (rf/dispatch-sync [::ev/associate-marks draft-gid :annC]) + (let [annC (get-in (scene*) [:groups :annC]) + bmk (last (:marks annC)) + bid (:id bmk)] + (is (nil? (get-in (scene*) [:groups draft-gid])) "draft is consumed") + (is (= 2 (count (:marks annC))) "annC now has its A-mark + the new B-mark") + (is (= :proxy (:type (get-in (scene*) [:groups (get-in bmk [:start :ref])]))) + "the tied mark is a single proxy-ref, not expanded into per-clip marks") + + ;; BUG 1 — labels. Viewed from annB: the new B-mark's endpoint is one of + ;; annB's own content units (labels via the context), while annC's A-mark is + ;; foreign here. Its fallback must be the TRACK ("A-roll"), never the shared + ;; source-file name "Challengers.mov". + (let [ctx-ids (into #{} (map :mark) (s/content-segments (scene*) :annB)) + row-seg (fn [gid-mark] (get-in (s/mark-row (scene*) gid-mark) [:s :seg])) + amk (first (:marks annC))] ; the A-mark + (is (contains? ctx-ids (row-seg bmk)) "B-mark endpoint is one of annB's units → context-labelled") + (is (not (contains? ctx-ids (row-seg amk))) "A-mark is foreign in annB") + (is (= "A-roll" (s/ref-track-name (scene*) (row-seg amk))) "foreign label is the track, not Challengers.mov") + (is (not= "Challengers.mov" (s/ref-track-name (scene*) (row-seg amk))))) + + ;; REFERENCE PARENTS — annC is a child of A (its A-mark) and B (its B-mark), + ;; and NOT of root (it's a grandchild there: one hop, not transitive to clips) + (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) + (is (s/child-of? (scene*) :annB :annC)) + (is (not (s/child-of? (scene*) :root :annC))) + + ;; LANE in annB: exactly one bar for annC's B-mark + (is (= 1 (count (bars-in :annB :annC))) "annC shows exactly one bar in annB") + (is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2))) + + ;; ISSUE 1 — the PANE LIST (::all-annotations, grouped by :parents) must + ;; include annC under annB, and must not pull in non-children. + (let [anns @(rf/subscribe [::subs/all-annotations]) + c (some #(when (= :annC (:id %)) %) anns) + under (fn [p] (->> anns (filter #(contains? (:parents %) p)) (map :id) set))] + (is c "annC is present in ::all-annotations while viewing annB") + (is (contains? (:parents c) :annB) "annC's reference parents include annB") + (is (contains? (under :annB) :annC) "the pane lists annC under annB") + (is (not (contains? (under :annB) :annA)) "annA is root's child, not annB's")) + + ;; ISSUE 3 at ROOT — collapse; annC must NOT leak into the root list (it's a + ;; grandchild). ISSUE 2 — revealing annA must then surface annC as its child. + (rf/dispatch-sync [::ev/collapse]) + (is (= [:root] (get-in @rdb/app-db [:view :stack]))) + (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))] + (is (contains? ids :annA) "annA (a root child) shows at root") + (is (not (contains? ids :annC)) "annC does NOT leak into root (grandchild)")) + (rf/dispatch-sync [::ev/toggle-children :annA]) + (let [anns @(rf/subscribe [::subs/all-annotations]) + c (some #(when (= :annC (:id %)) %) anns)] + (is c "revealing annA surfaces annC as its child in the toggle") + (is (contains? (:parents c) :annA))) + + ;; BUG 2 — back in annB, dragging the handle must not delete the mark + ;; (::reroll-proxy must roll against the VIEWED context, not annC's :parent). + (rf/dispatch-sync [::ev/expand :annB]) + (rf/dispatch-sync [::ev/reroll-proxy :annC bid 50 140]) + (let [bars (bars-in :annB :annC)] + (is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)") + (is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140")))))) diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index 36c2359..aa8616c 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -221,14 +221,14 @@ :marks [(s/proxy-ref :m/1 :p1) (s/proxy-ref :m/2 :p2)]})) segs (s/content-segments scene :root) - bars (s/lane-bars scene :root :ann segs)] + bars (s/lane-bars scene :ann segs)] (is (= [[0 200 :m/1] [200 300 :m/2]] bars)) ; two marks → two bars, tagged + apart (is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi] ;; and a single cross-clip proxy on its own is one contiguous bar (let [one (-> base (with-group :p1 p1) (with-group :ann {:type :annotation :parent :root :marks [(s/proxy-ref :m/1 :p1)]}))] - (is (= [[0 200 :m/1]] (s/lane-bars one :root :ann (s/content-segments one :root)))))))) + (is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root)))))))) (deftest proxy-survives-restore-roundtrip (testing "a proxy group (string :type/:parent, string mark ids/refs from JSON) @@ -245,6 +245,120 @@ (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 :parent :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 :parent :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 :parent :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 transclusion-visibility-is-scoped-by-reference-not-clip-overlap + (testing "an annotation shows in a timeline when a mark is BUILT ON that timeline's + content (references its units), not merely when its clips overlap. So a + mark authored in B shows in B though its annotation is parented under A + (transclusion), a mark authored in A shows in A — and a sibling root + annotation that just covers the same clips does NOT leak into B." + (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 :parent :root :marks [(s/proxy-ref :mA :pA)]}) + (with-group :annB {:type :annotation :parent :root :marks [(s/proxy-ref :mB :pB)]})) + ;; annC (parented under A) has a mark authored in A AND a mark authored in B + pInA (s/make-proxy scene :annA 10 60) ; a range inside annA (clip A) + pInB (s/make-proxy scene :annB 50 150) ; a range inside annB (C-tail + D-head) + ;; annD is a SIBLING root annotation that merely covers clip C + pDup (s/make-proxy scene :root 200 280) ; clip C, referenced from root directly + scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB) (with-group :pDup pDup) + (with-group :annC {:type :annotation :parent :annA + :marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}) + (with-group :annD {:type :annotation :parent :root + :marks [(s/proxy-ref "d1" :pDup)]}))] + ;; annC has exactly 2 marks (one per authored range); the B one is a single + ;; proxy whose run spans C-tail + D-head — not expanded into per-clip marks + (is (= 2 (count (:marks (get-in scene [:groups :annC]))))) + (is (= 2 (count (:marks pInB)))) ; run held inside the ONE proxy + ;; annC's marks are homed in A and B → it is a child of BOTH, and NOT of root + ;; (it's a grandchild there — one-hop reference, not transitive to clips) + (is (= #{:annA :annB} (s/mark-homes scene :annC))) + (is (s/child-of? scene :annA :annC)) + (is (s/child-of? scene :annB :annC)) + (is (not (s/child-of? scene :root :annC))) ; grandchild does NOT leak to root + ;; annD only covers clip C from root — homed at root, NOT a child of annB + (is (= #{:root} (s/mark-homes scene :annD))) + (is (not (s/child-of? scene :annB :annD))) ; the over-show bug + (is (s/child-of? scene :root :annD)) + ;; lane bars follow: annC's B-mark renders in B, its A-mark in A, none of annD 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))))))) + +(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 :parent :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 ;; ========================================================================= From d2d803e38b12eb3d1bf803fe2a8635a568f30723 Mon Sep 17 00:00:00 2001 From: Your Name Date: Mon, 6 Jul 2026 23:10:20 -0400 Subject: [PATCH 07/10] feat: transclusion completion by chat --- tl/src/tl/events.cljs | 20 +++---- tl/src/tl/otio.cljs | 36 +++++++------ tl/src/tl/routes.cljs | 12 +++-- tl/src/tl/scene.cljs | 87 +++++++++++++++++++++---------- tl/src/tl/subs.cljs | 2 +- tl/src/tl/views.cljs | 57 +++++++++++--------- tl/test/tl/flow_test.cljs | 32 ++++++++++++ tl/test/tl/frame_policy_test.cljs | 27 ++++++++++ tl/test/tl/routes_test.cljs | 15 ++++++ tl/test/tl/scene_test.cljs | 72 ++++++++++++++++++------- 10 files changed, 259 insertions(+), 101 deletions(-) create mode 100644 tl/test/tl/frame_policy_test.cljs create mode 100644 tl/test/tl/routes_test.cljs diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 67a47b6..969047a 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] playhead)))) + playhead (assoc-in [:playheads ctx] (scene/assert-frame "route playhead" playhead))))) (defn- route-state [db] (let [ctx (peek (get-in db [:view :stack]))] @@ -601,7 +601,8 @@ ;; moved the stack, so snap back to the editing context before seeking the frame. (rf/reg-event-fx ::preview-frame (fn [{:keys [db]} [_ local]] - (let [stack (get-in db [:view :linking :stack]) + (let [local (scene/assert-frame "preview frame" local) + stack (get-in db [:view :linking :stack]) ctx (peek stack) db (-> db (assoc-in [:view :stack] stack) (assoc-in [:view :playheads ctx] local)) @@ -611,7 +612,8 @@ (rf/reg-event-fx ::set-playhead (fn [{:keys [db]} [_ ctx lf]] - (let [next-db (-> db + (let [lf (scene/assert-frame "playhead" lf) + next-db (-> db (assoc-in [:view :playheads ctx] lf) (sync-draft-mark-for-playhead ctx lf))] (sync-route {:db next-db} next-db)))) @@ -841,8 +843,8 @@ (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 (js/Math.round (min new-local keep)) - hi (js/Math.round (max new-local keep))] + 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 (:parent g) proxy lo (max (inc lo) hi))) (assoc-in [:view :pt] :new))}) @@ -903,9 +905,8 @@ ;; For a normal (non-transcluded) mark the two are the same. ctx (peek (get-in db [:view :stack])) len (scene/length (scene/content-segments scene ctx)) - ;; the dragged endpoint is a whole frame; the FIXED endpoint arrives - ;; EXACT (fractional) so its mark re-derives identically. Only the fixed - ;; end must avoid rounding here — the clamp keeps [la lb) valid half-open. + 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)) @@ -918,7 +919,8 @@ (rf/reg-event-db ::set-proxy-frame (fn [db [_ pid which frame]] - (let [marks (get-in db [:scene :groups pid :marks]) + (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)))) diff --git a/tl/src/tl/otio.cljs b/tl/src/tl/otio.cljs index e1d7883..7600a33 100644 --- a/tl/src/tl/otio.cljs +++ b/tl/src/tl/otio.cljs @@ -13,14 +13,20 @@ (defn- clip? [item] (str/starts-with? (:OTIO_SCHEMA item "") "Clip")) -(defn- frames - "Frame number of a RationalTime, as a WHOLE frame. This is the ONE place a - fraction can enter: a rate conform (e.g. 23.976 NTSC) gives fractional source - positions (start_time). A frame is absolute and integer — you can't seek to half - a frame — so we snap here, at the boundary. Everything downstream is integer and - nothing else rounds (durations are already whole, so timeline tiling is exact)." +(defn- timeline-frames + "Frame count/position for timeline math. These must already be integer frames." [rational-time] - (js/Math.round (:value rational-time))) + (let [v (:value rational-time)] + (when-not (integer? v) + (throw (js/Error. (str "OTIO RationalTime value must be an integer frame, got " v)))) + v)) + +(defn- media-frame + "Source media position as an integer frame index. Some OTIO exports carry + rate-conformed source starts as sub-frame RationalTime values; the app model is + frame-index based, so source starts are normalized once at this import boundary." + [rational-time] + (int (:value rational-time))) (defn- clip-starts "Source start_time (frames) of every clip across all tracks." @@ -28,15 +34,15 @@ (for [t tracks c (:children t) :when (clip? c)] - (frames (get-in c [:source_range :start_time])))) + (media-frame (get-in c [:source_range :start_time])))) (defn- parse-track [media-offset idx track] - (loop [pos 0.0 + (loop [pos 0 items (:children track) ci 0 clips (transient [])] (if-let [item (first items)] - (let [dur (frames (get-in item [:source_range :duration])) + (let [dur (timeline-frames (get-in item [:source_range :duration])) is-clip (clip? item)] (recur (+ pos dur) (rest items) @@ -46,7 +52,7 @@ :name (:name item) :start pos ; timeline frame, 0-based :duration dur - :media-in (- (frames (get-in item [:source_range :start_time])) + :media-in (- (media-frame (get-in item [:source_range :start_time])) media-offset)}) ; frame into local .mov clips))) {:id idx @@ -62,11 +68,11 @@ (let [tracks (get-in otio [:tracks :children]) fps (get-in otio [:global_start_time :rate] 24) starts (clip-starts tracks) - media-offset (if (seq starts) (apply min starts) 0.0) + media-offset (if (seq starts) (apply min starts) 0) parsed (vec (map-indexed (partial parse-track media-offset) tracks))] {:fps fps :media-offset media-offset - :duration (reduce max 0.0 (for [t parsed - c (:clips t)] - (+ (:media-in c) (:duration c)))) + :duration (reduce max 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 b2bf1fe..e277b5d 100644 --- a/tl/src/tl/routes.cljs +++ b/tl/src/tl/routes.cljs @@ -2,7 +2,8 @@ (:require [clojure.string :as str] [reitit.frontend :as reitit] - [reitit.frontend.easy :as rfe])) + [reitit.frontend.easy :as rfe] + [tl.scene :as scene])) (def routes [["/" {:name :projects}] @@ -54,15 +55,18 @@ (into {} (map (fn [[k v]] [(keyword k) v]) (:query-params match)))) stack (some-> (:stack qp) (str/split #",")) - f (some-> (:f qp) js/parseFloat)] + fstr (some-> (:f qp) str) + f (when (and fstr (re-matches #"\d+" fstr)) + (scene/assert-frame "route playhead" (js/parseInt fstr 10)))] (cond-> {} (seq stack) (assoc :stack (mapv keyword stack)) - (and f (not (js/isNaN f))) (assoc :playhead f)))) + f (assoc :playhead f)))) (defn project-url [id stack playhead] (let [stack-param (->> (rest stack) (map name) (str/join ",")) query (query-string {:stack stack-param - :f (some-> playhead js/Math.round)})] + :f (when (some? playhead) + (scene/assert-frame "route playhead" playhead))})] (str (href :project/show {:id id}) query))) (defonce ^:private last-replaced (atom nil)) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 8aea34c..79a3551 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -16,6 +16,28 @@ (defn- grp [scene gid] (get-in scene [:groups gid])) +(defn frame? + "True when `n` is a concrete integer frame coordinate." + [n] + (and (number? n) (integer? n) (not (js/isNaN n)))) + +(defn assert-frame + "Return `n` after asserting it is an integer frame. This is intentionally a + runtime check, not cljs.core/assert, so production builds keep the invariant." + [label n] + (when-not (frame? n) + (throw (js/Error. (str label " must be an integer frame, got " (pr-str n))))) + n) + +(defn assert-range + "Return `[lo hi]` after asserting a valid integer half-open frame range." + [label [lo hi]] + (assert-frame (str label " start") lo) + (assert-frame (str label " end") hi) + (when (> lo hi) + (throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi]))))) + [lo hi]) + (defn- find-mark "[owning-gid mark] for a mark id anywhere in the scene, or nil." [scene mid] @@ -31,7 +53,10 @@ (defn local->source "The source frame shown at local frame `lf` (clamped to the end)." [segs lf] + (assert-frame "local frame" lf) (or (some (fn [{:keys [src local]}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[c d] local [a _] src] (when (and (<= c lf) (< lf d)) (+ a (- lf c))))) segs) @@ -40,7 +65,10 @@ (defn source->local "Local frame for source frame `sf` (first segment containing it), or nil." [segs sf] + (assert-frame "source frame" sf) (some (fn [{:keys [src local]}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[a b] src [c _] local] (when (and (<= a sf) (< sf b)) (+ c (- sf a))))) segs)) @@ -48,7 +76,10 @@ (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))]))) @@ -58,13 +89,11 @@ "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. Endpoints snap to whole frames first (a bar covers the frames it - touches); only a real (≥1 frame) gap splits. Called per-mark, so it never fuses - two distinct marks." + fudge. Called per-mark, so it never fuses two distinct marks." [bars] (reduce (fn [acc [lo hi]] - (let [lo (js/Math.floor lo) hi (js/Math.ceil hi) - [plo phi] (peek acc)] + (assert-range "bar" [lo hi]) + (let [[plo phi] (peek acc)] (if (and plo (<= lo phi)) (conj (pop acc) [plo (max phi hi)]) (conj acc [lo hi])))) @@ -74,8 +103,11 @@ (defn slice "Sub-segments of `segs` covering local range [la lb), src + local re-cut." [segs la lb] + (assert-range "slice" [la lb]) (vec (keep (fn [{:keys [src local] :as seg}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[a _] src [c d] local lo (max la c) hi (min lb d)] (when (< lo hi) @@ -323,9 +355,9 @@ (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' floor/ceil. Endpoint - editing must use this (not a rounded lane bar) or the fixed end drifts a frame - per re-roll. `ctx-segs` = content-segments of ctx." + 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 %))) @@ -402,10 +434,10 @@ (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. Offsets are - ROUNDED to whole frames here — this is where user frame-accuracy is applied - (clips stay exact for tiling; the mark snaps to a whole frame of its clip)." + Each references the segment's source id with the right offsets. Inputs and + derived offsets must already be integer frames." [scene ctx la lb] + (assert-range "selection" [la lb]) (mapv (fn [{:keys [mark src]}] ;; :at is the target's OWN local frame (src->at), matching resolve-mark's ;; slice — correct even when the target is a scattered multi-clip proxy. @@ -413,8 +445,8 @@ (let [[a b] src a' (src->at scene mark a)] {:id (str (random-uuid)) ; string so it survives JSON - :start {:ref mark :at (js/Math.round a')} - :end {:ref mark :at (js/Math.round (+ a' (- b a)))}})) + :start {:ref mark :at (assert-frame "selection start offset" a')} + :end {:ref mark :at (assert-frame "selection end offset" (+ a' (- b a)))}})) (slice (content-segments scene ctx) la lb))) (defn reconcile-run @@ -542,7 +574,7 @@ 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 (js/Math.round (at->local scene 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." @@ -580,22 +612,23 @@ 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 kept EXACT (OTIO's fractional RationalTime), NOT rounded: - adjacent clips must share their half-open boundary exactly to tile without a - gap, and independently rounding :start vs length breaks that. Frame-accuracy is - applied where it belongs — at the mark the user creates (selection->marks - rounds :at) — and at display, never by rounding clips or bars." + Clip ranges are integer frame ranges. Fractional OTIO input is rejected before + this point; from here on, frame math asserts instead of snapping." [{:keys [duration tracks]}] + (assert-frame "OTIO duration" duration) (let [vtracks (filter #(= :video (:kind %)) tracks) track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks) clips (into {} (for [t vtracks c (:clips t)] - [(keyword (:id c)) - {:type :clip :parent nil :name (:name c) - :start (:start c) ; timeline position (frames) - :marks [{:id (keyword (str (:id c) "-m")) - :start (:media-in c) - :end (+ (:media-in c) (:duration c)) - :track (keyword (str "t" (:index t)))}]}]))] + (let [start (assert-frame "clip timeline start" (:start c)) + media-in (assert-frame "clip media-in" (:media-in c)) + duration (assert-frame "clip duration" (:duration c))] + [(keyword (:id c)) + {:type :clip :parent nil :name (:name c) + :start start ; timeline position (frames) + :marks [{:id (keyword (str (:id c) "-m")) + :start media-in + :end (+ media-in duration) + :track (keyword (str "t" (:index t)))}]}])))] {:tracks track-map :groups (assoc clips :root {:type :timeline :parent nil :marks [{:id :root-m :start 0 :end duration}]})})) @@ -684,7 +717,7 @@ (last csegs))] {:local lo :seg (:mark seg) - :f (js/Math.round (- lo (first (:local seg [0 0]))))})) + :f (assert-frame "jump target frame" (- lo (first (:local seg [0 0]))))})) (runs scene ctx gid)))) (defn linkables diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 56bb6f1..342dfdb 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -183,7 +183,7 @@ :hidden (boolean hidden) :tags (vec (get-in g [:meta :tags])) ;; jump targets labelled from the marks' clip refs (same as - ;; the editor) — not re-derived from a floored bar frame + ;; the editor) — not re-derived from a display bar frame :jumps jumps :start (or (ffirst bars) 0) :bars bars})))))) (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 5e28053..8daf1f8 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -38,6 +38,14 @@ (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 @@ -125,7 +133,7 @@ (defn- play-tick [] (when-let [{:keys [ctx segs fps idx]} @play] (let [v @video-el - sf (* (.-currentTime v) fps) + sf (frame-index "video source frame" (* (.-currentTime v) fps)) {:keys [pending-ns]} @play {[ss se] :src [ls _] :local} (nth segs idx)] (cond @@ -206,7 +214,8 @@ clip under the landing frame into view vertically — jumps always do both." ([local] (goto! local false)) ([local follow?] - (let [ctx @(rf/subscribe [::subs/context]) + (let [local (scene/assert-frame "goto frame" local) + ctx @(rf/subscribe [::subs/context]) segs @(rf/subscribe [::subs/segments]) fps @(rf/subscribe [::subs/fps]) zoom @(rf/subscribe [::subs/zoom])] @@ -399,10 +408,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 (js/Math.round (- ph (first (:local seg))))) + cf (when seg (scene/assert-frame "clip frame" (- ph (first (:local seg))))) click? (and auth? seg)] [:div.frame-readout - [:span.fr-abs (str (js/Math.round ph) "f")] + [:span.fr-abs (str (scene/assert-frame "playhead" ph) "f")] (when seg [:span.fr-clip {:class (when click? "clickable") :title (when click? (if linking "Click to link this frame" @@ -449,7 +458,7 @@ (.preventDefault ev) (let [to (fn [clientX] (let [x (- clientX (.-left (.getBoundingClientRect content)))] - (goto! (max 0 (* (/ x zoom) fps))))) + (goto! (frame-index "scrub frame" (max 0 (* (/ x zoom) fps)))))) move (fn [e] (to (.-clientX e))) up (fn up [_] (.removeEventListener js/document "mousemove" move) (.removeEventListener js/document "mouseup" up))] @@ -471,12 +480,11 @@ (let [d (d-of e)] (when (or @moved? (> (js/Math.abs d) 3)) (reset! moved? true) - ;; round ONLY the dragged endpoint; the fixed endpoint stays - ;; exact so selection->marks re-derives its mark identically. (let [[la lb] (case mode - :move [(js/Math.round (+ lo d)) (js/Math.round (+ hi d))] - :start [(js/Math.round (+ lo d)) hi] - :end [lo (js/Math.round (+ hi d))])] + :move [(frame-index "drag start frame" (+ lo d)) + (frame-index "drag end frame" (+ hi d))] + :start [(frame-index "drag start frame" (+ lo d)) hi] + :end [lo (frame-index "drag end frame" (+ hi d))])] (rf/dispatch [::events/reroll-proxy ann mark-id la lb]))))) up (fn up [_] (.removeEventListener js/document "mousemove" move) @@ -500,7 +508,7 @@ (.preventDefault ev) (let [rect (.getBoundingClientRect content) sx (.-clientX ev) - to (fn [cx] (max 0 (* (/ (- cx (.-left rect)) zoom) fps))) + to (fn [cx] (frame-index "selection frame" (max 0 (* (/ (- cx (.-left rect)) zoom) fps)))) a (to sx) moved? (atom false) mv (fn [e] @@ -513,7 +521,7 @@ (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 (js/Math.round lo) (js/Math.round hi)]) + (rf/dispatch [::events/draft-select-range lo hi]) (on-click a))))] ; click (no drag) (.addEventListener js/document "mousemove" mv) (.addEventListener js/document "mouseup" up))) @@ -693,9 +701,8 @@ ;; 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 (never the rounded bar). The drag - ;; keeps the FIXED endpoint at this exact value so its mark - ;; re-derives identically — that's what stops the other end drifting. + ;; 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 @@ -833,7 +840,7 @@ :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 " " (js/Math.round lf) "f")])]))))) + (when lf [:span.link-f (str " " (scene/assert-frame "link frame" lf) "f")])]))))) (defn- build-chip [{:keys [label ref at kind]}] (let [span (js/document.createElement "span") @@ -865,7 +872,7 @@ (when lf (let [f (js/document.createElement "span")] (set! (.-className f) "link-f") - (set! (.-textContent f) (str " " (js/Math.round lf) "f")) + (set! (.-textContent f) (str " " (scene/assert-frame "link frame" lf) "f")) (.appendChild span f))) span)) @@ -953,7 +960,7 @@ :point {:kind :script-note :ref id}}))))))))) (defn- point-label [cand off local] - (str (:label cand) " @" (js/Math.round local) "f" + (str (:label cand) " @" (scene/assert-frame "point label frame" local) "f" (when (and (not (:abs cand)) (pos? off)) (str " +" off)))) @@ -1066,18 +1073,18 @@ [: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 " " (js/Math.round (:local c)) "f")])])))]))) + [:span.link-f (str " " (scene/assert-frame "candidate frame" (: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 (js/Math.round (- local c))})) + {:seg m :f (scene/assert-frame "draft point frame" (- 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 (js/Math.round (- local c))})) + {:seg m :f (scene/assert-frame "draft endpoint frame" (- local c))})) segs)) ;; --- shared string autocomplete ------------------------------------------ @@ -1369,7 +1376,7 @@ (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 (js/Math.round f) :disabled true}] + [:input.pt-frame {:type "number" :value (scene/assert-frame "pending frame" f) :disabled true}] [:span.pt-dur (str "/" len)]])) (defn- empty-frame-chip [label] @@ -1741,7 +1748,7 @@ len @(rf/subscribe [::subs/length]) authed? @(rf/subscribe [::subs/authed?]) authoring? (some? @(rf/subscribe [::subs/draft-group])) - ph-now #(js/Math.round @(rf/subscribe [::subs/playhead]))] + ph-now #(scene/assert-frame "playhead" @(rf/subscribe [::subs/playhead]))] [:div.toolbar [:div.transport [:button.step-btn {:title "Previous frame" :disabled start? @@ -2083,7 +2090,7 @@ (when (and url (seq @pages)) [:div.script-controls [:button {:title "Zoom out" :on-click #(bump (fn [z] (* z 0.9)))} "−"] - [:span.zoom-read (str (js/Math.round (* scale 100)) "%")] + [:span.zoom-read (str (int (* scale 100)) "%")] [:button {:title "Zoom in" :on-click #(bump (fn [z] (* z 1.1)))} "+"] [:button {:title "Fit width" :on-click fit!} "Fit"]])])))) @@ -2271,7 +2278,7 @@ (when uploading? [:div.upload-progress [:div.upload-track [:div.upload-fill {:style {:width (str (* 100 prog) "%")}}]] - [:span.upload-pct (str (js/Math.round (* 100 prog)) "%")]]) + [:span.upload-pct (str (int (* 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/flow_test.cljs b/tl/test/tl/flow_test.cljs index f0da29a..079f461 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -127,3 +127,35 @@ (let [bars (bars-in :annB :annC)] (is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)") (is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140")))))) + +(deftest draft-range-events-keep-integer-frames + (testing "basic drag selection through the real event path stores only integer frames" + (setup! clips-scene [:root]) + (rf/dispatch-sync [::ev/open-draft]) + (rf/dispatch-sync [::ev/draft-select-range 25 175]) + (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) + mark (first (:marks g)) + pid (get-in mark [:start :ref]) + proxy (get-in (scene*) [:groups pid]) + ats (mapcat (fn [m] [(get-in m [:start :at]) (get-in m [:end :at])]) (:marks proxy))] + (is gid "draft exists") + (is (= :proxy (:type proxy))) + (is (every? integer? ats)) + (is (= [[25 175 (:id mark)]] (bars-in :root gid))))) + (testing "fractional drag selection fails instead of being changed into nearby frames" + (setup! clips-scene [:root]) + (rf/dispatch-sync [::ev/open-draft]) + (is (thrown-with-msg? js/Error #"integer frame" + (rf/dispatch-sync [::ev/draft-select-range 25.5 175]))))) + +(deftest reroll-proxy-rejects-fractional-frames + (testing "live proxy reroll accepts integer handle positions and rejects fractional ones" + (setup! clips-scene [:root]) + (rf/dispatch-sync [::ev/open-draft]) + (rf/dispatch-sync [::ev/draft-select-range 25 175]) + (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) + mark-id (:id (first (:marks g)))] + (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30 170]) + (is (= [[30 170 mark-id]] (bars-in :root gid))) + (is (thrown-with-msg? js/Error #"integer frame" + (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30.25 170])))))) diff --git a/tl/test/tl/frame_policy_test.cljs b/tl/test/tl/frame_policy_test.cljs new file mode 100644 index 0000000..3c6a7f0 --- /dev/null +++ b/tl/test/tl/frame_policy_test.cljs @@ -0,0 +1,27 @@ +(ns tl.frame-policy-test + (:require [cljs.test :refer-macros [deftest is testing]] + [clojure.string :as str])) + +(def fs (js/require "fs")) +(def path (js/require "path")) + +(defn- cljs-files [dir] + (mapcat (fn [name] + (let [p (.join path dir name) + st (.statSync fs p)] + (cond + (.isDirectory st) (cljs-files p) + (str/ends-with? name ".cljs") [p] + :else []))) + (array-seq (.readdirSync fs dir)))) + +(deftest no-math-round-in-frame-code + (testing "frame code must not use the JS rounding API" + (let [needle (str "Math" "." "round") + hits (->> (concat (cljs-files "src") (cljs-files "test")) + (remove #(str/ends-with? % "frame_policy_test.cljs")) + (keep (fn [p] + (when (str/includes? (.readFileSync fs p "utf8") needle) + p))) + vec)] + (is (= [] hits))))) diff --git a/tl/test/tl/routes_test.cljs b/tl/test/tl/routes_test.cljs new file mode 100644 index 0000000..fd0c111 --- /dev/null +++ b/tl/test/tl/routes_test.cljs @@ -0,0 +1,15 @@ +(ns tl.routes-test + (:require [cljs.test :refer-macros [deftest is testing]] + [tl.routes :as routes])) + +(deftest view-state-parses-integer-frame-query + (testing "route playhead accepts string and numeric integer query params" + (set! (.. js/window -location -hash) "") + (is (= {:playhead 42} + (routes/view-state {:query-params {"f" "42"}}))) + (is (= {:playhead 42} + (routes/view-state {:query-params {"f" 42}})))) + (testing "fractional route playhead is ignored instead of changed" + (set! (.. js/window -location -hash) "") + (is (= {} + (routes/view-state {:query-params {"f" "42.5"}}))))) diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index aa8616c..aca12f9 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -1,6 +1,7 @@ (ns tl.scene-test (:require [cljs.test :refer-macros [deftest is testing]] [tl.md :as md] + [tl.otio :as otio] [tl.scene :as s])) ;; --- shared fixture ------------------------------------------------------- @@ -16,6 +17,8 @@ (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 @@ -408,26 +411,55 @@ (is (= #{:t0 :t1} (s/tracks segs))) (is (= 200 (s/length segs))))))) -(deftest from-otio-keeps-clip-ranges-exact - (testing "clips keep OTIO's exact fractional ranges (so adjacent clips tile); - frame-accuracy is applied at mark creation, not here" - (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}]}]} - mark (first (get-in (s/from-otio parsed) [:groups :t0-c0 :marks]))] - (is (= 188.87 (:start mark))) ; exact, not rounded - (is (= 289.27 (:end mark)))))) +(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 selection-rounds-at-to-whole-frames - (testing "a selection over a clip with fractional layout still yields whole-frame - :at offsets (clip stays exact, the mark snaps)" +(deftest real-otio-source-starts-import-as-integer-media-frames + (testing "the bundled Challengers OTIO has fractional source starts but imports into integer model frames" + (let [raw (js->clj (js/JSON.parse (.readFileSync (js/require "fs") "resources/public/one_two_three.otio" "utf8")) + :keywordize-keys true) + parsed (otio/parse raw) + scene (s/from-otio parsed) + 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}]}}} - run (s/selection->marks scene :root 20 60)] - (is (seq run)) - (is (every? integer? (mapcat (juxt #(get-in % [:start :at]) #(get-in % [:end :at])) run)))))) + msg (err-msg #(s/selection->marks scene :root 20 60))] + (is (re-find #"integer frame" msg))))) ;; ========================================================================= ;; Suite 4 — draft rows <-> marks (the two-input editor) @@ -460,13 +492,13 @@ (is (= 0 (get-in (first marks) [:start :at]))) (is (= 30 (get-in (first marks) [:end :at]))))))) -(deftest merge-bars-coalesces-continuous-run - (testing "sub-frame OTIO gaps collapse to one bar; a real gap stays split" - ;; foobar's real bars (continuous 5-clip selection, ~0.9-frame source gaps) +(deftest merge-bars-coalesces-continuous-integer-runs + (testing "integer-adjacent bars merge; fractional bars fail" (is (= [[128 542]] - (s/merge-bars [[128.87 190.87] [191.80 265.80] [266.73 384.73] - [385.61 413.61] [414.58 541.58]]))) + (s/merge-bars [[128 191] [191 266] [266 386] + [386 414] [414 542]]))) (is (= [[0 50] [200 260]] (s/merge-bars [[0 50] [200 260]]))) ; real gap → two + (is (re-find #"integer frame" (err-msg #(s/merge-bars [[0.2 50]])))) (is (= [] (s/merge-bars []))))) (deftest restore-annotations-rekeywordizes-json From 4b299626775b5e342c64bd7f851103cc4bb479e8 Mon Sep 17 00:00:00 2001 From: Your Name Date: Mon, 6 Jul 2026 23:48:01 -0400 Subject: [PATCH 08/10] transclusion fixes and other things by chat --- .dockerignore | 30 +++++---- tl/package.json | 1 + tl/src/tl/events.cljs | 133 +++++++++++++++++++++++++++++--------- tl/src/tl/scene.cljs | 12 +++- tl/src/tl/subs.cljs | 23 ++++++- tl/src/tl/views.cljs | 33 +++++----- tl/test/tl/flow_test.cljs | 75 ++++++++++++++++++++- 7 files changed, 246 insertions(+), 61 deletions(-) diff --git a/.dockerignore b/.dockerignore index 0b333ca..b34e0f5 100644 --- a/.dockerignore +++ b/.dockerignore @@ -1,16 +1,24 @@ .git -**/.venv -**/node_modules -**/.shadow-cljs -**/target +.venv +**/__pycache__ +**/*.pyc + +tl/node_modules +tl/.shadow-cljs +tl/target tl/resources/public/js/compiled -**/__pycache__/ -db.sqlite3 -media/ -staticfiles/ -*.mp4 -*.pdf + *.log +*.log.* *.mbtree +*.mp4 +*.mov +*.mkv +*.avi +*.pdf + thinking.org -.DS_Store + +staticfiles +media +db.sqlite3 diff --git a/tl/package.json b/tl/package.json index df70558..85053d1 100644 --- a/tl/package.json +++ b/tl/package.json @@ -5,6 +5,7 @@ "dev": "bash dev/dev.sh", "media": "python3 dev/media_server.py", "watch": "npx shadow-cljs watch app", + "test": "npx shadow-cljs compile test && node target/node-tests.js", "release": "npx shadow-cljs release app", "build-report": "npx shadow-cljs run shadow.cljs.build-report app target/build-report.html" }, diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 969047a..6035ef1 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -673,6 +673,23 @@ (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 parent timeline is not the timeline +;; currently being viewed, enter that parent first so mark rows/handles edit in +;; their authored coordinate system. finish-edit pops this temporary parent. +(rf/reg-event-fx + ::edit-annotation + (fn [{:keys [db]} [_ gid]] + (let [parent (get-in db [:scene :groups gid :parent]) + ctx (peek (get-in db [:view :stack])) + push-parent? (and parent (not= parent ctx)) + fx (if push-parent? (enter-ctx db #(conj % parent)) {: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-parent? (assoc-in [:view :edit-pop-parent] parent)))))) + ;; 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. @@ -687,13 +704,18 @@ (fn [{:keys [db]} _] ;; leaving the form (save OR cancel): tear down all authoring ;; transients so draw mode / pending points don't linger. - (let [db (-> db (assoc-in [:view :draw] nil) - (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})))) + (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})))) (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,11 +753,10 @@ {:on-success [::scene-saved] :on-failure [::save-error]})))))) ;; --- move an annotation into another context (drag-drop reparent) --------- -;; Changing :parent re-homes an annotation under a new context. Marks that no -;; longer resolve there just skip (scene/resolve drops them) and reappear if the -;; annotation is moved back — no data loss. Guard against cycles: never drop a -;; group into itself or one of its own descendants (that would make the :parent -;; chain loop forever, hanging path-to / resolve). +;; Drag/drop re-expresses the annotation's visible mark coverage in the target +;; context. The parent is just where the annotation is edited/listed; the marks +;; still decide what actually renders by resolving down to clips and intersecting +;; the target timeline. (defn- descendant? "Is `gid` equal to `anc` or somewhere below it in the :parent tree?" [scene anc gid] @@ -744,26 +765,78 @@ (= g anc) true :else (recur (get-in scene [:groups g :parent]))))) -(rf/reg-event-db ::ann-drag-start (fn [db [_ gid]] (assoc-in db [:view :dragging-ann] gid))) -(rf/reg-event-db ::ann-drag-end (fn [db _] (assoc-in db [:view :dragging-ann] nil))) +(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- rehome-marks + [scene gid source-parent new-parent] + (let [target-segs (scene/content-segments scene new-parent)] + (reduce (fn [{:keys [marks proxies]} m] + (if (= source-parent (scene/mark-home scene m)) + (let [bare (dissoc m :home-marks) + history (:home-marks m {}) + history (assoc history source-parent bare)] + (if-let [saved (get history new-parent)] + {:marks (conj marks (assoc saved :home-marks (dissoc history new-parent))) + :proxies proxies} + (let [bars (scene/mark-bars scene gid (:id m) target-segs)] + (if (seq bars) + (let [pid (keyword (str "prox-" (random-uuid))) + proxy {:type :proxy :parent nil + :marks (mapv identity + (mapcat (fn [[lo hi]] + (scene/selection->marks scene new-parent lo hi)) + bars))} + m* (assoc (merge m (scene/proxy-ref (:id m) pid)) + :home-marks history)] + {:marks (conj marks m*) :proxies (assoc proxies pid proxy)}) + {:marks (conj marks m) :proxies proxies})))) + {:marks (conj marks m) :proxies proxies})) + {:marks [] :proxies {}} + (get-in scene [:groups gid :marks])))) + +(defn- has-home? [scene gid source-parent] + (some #(= source-parent (scene/mark-home scene %)) + (get-in scene [:groups gid :marks]))) (rf/reg-event-fx ::reparent (fn [{:keys [db]} [_ gid new-parent]] - (let [scene (:scene db) - g (get-in scene [:groups gid])] - (if (or (not= :annotation (:type g)) ; only annotations move - (:draft g) ; not while being drafted/edited - (= (:parent g) new-parent) ; no-op: already there - (descendant? scene gid new-parent)) ; target inside gid → cycle - {:db (assoc-in db [:view :dragging-ann] nil)} - (let [id (get-in db [:project :id])] - (cond-> {:db (-> db (assoc-in [:scene :groups gid :parent] new-parent) - (assoc-in [:view :dragging-ann] nil) - (assoc :save-error nil))} - id (assoc :http-xhrio (api/put-scene id {:changed {gid {:parent new-parent}}} - {:on-success [::scene-saved] - :on-failure [::save-error]})))))))) + (let [scene (:scene db) + g (get-in scene [:groups gid]) + source-parent (or (get-in db [:view :dragging-ann-source]) + (peek (get-in db [:view :stack])))] + (if (or (not= :annotation (:type g)) ; only annotations move + (:draft g) ; not while being drafted/edited + (= source-parent new-parent) + (not (has-home? scene gid source-parent)) + (descendant? scene gid new-parent)) ; target inside gid -> cycle + {:db (-> db + (assoc-in [:view :dragging-ann] nil) + (assoc-in [:view :dragging-ann-source] nil))} + (let [id (get-in db [:project :id]) + {:keys [marks proxies]} (rehome-marks scene gid source-parent new-parent) + g* (assoc g :parent new-parent :marks marks) + patch (editable-group g*)] + (cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) + (update-in [:scene :groups] merge proxies) + (assoc-in [:view :dragging-ann] nil) + (assoc-in [:view :dragging-ann-source] nil) + (assoc :save-error nil))} + id (assoc :http-xhrio (api/put-scene id {:changed (merge {gid patch} proxies)} + {: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 @@ -933,7 +1006,9 @@ (fn [{:keys [db]} [_ draft-gid target-gid]] (let [marks (get-in db [:scene :groups draft-gid :marks]) orig-t (get-in db [:scene :groups target-gid]) - target (update orig-t :marks (fnil into []) marks) + target (-> orig-t + (update :marks (fnil into []) marks) + (dissoc :home)) patch (group-patch orig-t target) ; just the :marks change proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref]) pg (get-in db [:scene :groups pid])] diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 79a3551..133a0c8 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -420,8 +420,9 @@ annotation has no resolvable marks (a fresh draft, a fully broken one), so it still shows somewhere." [scene gid] - (let [homes (into #{} (keep #(mark-home scene %)) (:marks (grp scene gid)))] - (if (seq homes) homes #{(:parent (grp scene gid))}))) + (let [g (grp scene gid) + homes (into #{} (keep #(mark-home scene %)) (:marks g))] + (if (seq homes) homes #{(:parent g)}))) (defn child-of? "Is annotation `gid` a direct child of timeline `ctx` — a mark of its authored @@ -519,7 +520,12 @@ (get-in m [:end :ref]) (update-in [:end :ref] keyword) (:track m) (update :track keyword) (:notes m) (update :notes #(mapv keyword %)) ; bound script-note gids - (:drawings m) (update :drawings #(mapv keyword %)))) ; bound drawing gids + (:drawings m) (update :drawings #(mapv keyword %)) ; bound drawing gids + (:home-marks m) (update :home-marks + (fn [homes] + (into {} (map (fn [[home mark]] + [(keyword home) (restore-mark mark)])) + homes))))) (defn- restore-region "A script-note region loses keyword-ness through JSON: re-keyword :id and :kind." diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 342dfdb..cce6113 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -113,6 +113,22 @@ (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 @@ -144,7 +160,12 @@ (let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse (when (shown? gid #{}) (let [reason (scene/broken-reason scene gid) - oor (boolean (scene/clip-loss? scene gid)) + ;; clip-loss compares against the structural :parent. + ;; A transcluded annotation is intentionally authored in + ;; multiple reference parents, so judging all marks + ;; against only :parent creates a false warning. + oor (boolean (and (= (parents gid) #{(:parent g)}) + (scene/clip-loss? scene gid))) hidden (get-in g [:meta :hidden]) note-ids (->> (concat (:notes g) (mapcat :notes (:marks g))) distinct diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 8daf1f8..05e1b47 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -1205,7 +1205,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?] +(defn- ann-drag-props [a authed? over? source-parent] (when authed? {:draggable true ;; cards nest, so stop each drag event at the card it fires on — otherwise it @@ -1215,7 +1215,7 @@ (.stopPropagation e) (.. e -dataTransfer (setData "text/ann" (name (:id a)))) (set! (.. e -dataTransfer -effectAllowed) "move") - (rf/dispatch [::events/ann-drag-start (:id a)])) + (rf/dispatch [::events/ann-drag-start (:id a) source-parent])) :on-drag-end (fn [_] (reset! over? false) (rf/dispatch [::events/ann-drag-end])) :on-drag-over (fn [e] (when (has-type? e "text/ann") @@ -1227,12 +1227,12 @@ (.stopPropagation e) (.preventDefault e) (reset! over? false) (rf/dispatch [::events/reparent (keyword src) (:id a)]))))})) -(defn- annotation-card [a scene ctx segs nmap authed? open by-parent seen] +(defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen] (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))) - drag-props (merge (ann-drag-props a authed? over?) + drag-props (merge (ann-drag-props a authed? over? source-parent) {:class (str (when active? "active ") (when (and drop-ok? @over?) "drop-over ") (when drop-ok? "drop-ready"))})] @@ -1250,7 +1250,7 @@ (: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-draft (:id a)])} "✎"]]] + [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-annotation (:id a)])} "✎"]]] [:div.ann (merge drag-props {:id (str "ann-" (name (:id a))) ;; grey out an annotation with dangling marks (it sorts to the @@ -1268,7 +1268,7 @@ [: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-draft (:id a)])} "✎"]) + [:button.edit-btn {:title "Edit" :on-click #(rf/dispatch [::events/edit-annotation (:id a)])} "✎"]) (when authed? [:button.del-btn {:title "Delete" :on-click #(when (js/confirm (str "Delete \"" (:name a) "\"?")) @@ -1282,15 +1282,15 @@ (into [:div.ann-tags] (for [t (:tags a)] ^{:key t} [tag-chip t]))) (when (pos? (:nested a)) - (let [shown? (contains? @(rf/subscribe [::subs/revealed]) (:id a))] + (let [shown? (contains? 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 (seq (remove #(contains? seen (:id %)) (get by-parent (:id a))))] + (when-let [kids (subs/visible-child-annotations by-parent revealed (:id a) seen)] (into [:div.ann-children] (for [k kids] ^{:key (:id k)} - [annotation-card k scene ctx segs nmap authed? open by-parent (conj seen (:id a))])))])))) + [annotation-card k scene ctx segs nmap authed? open by-parent revealed (:id a) (conj seen (:id a))])))])))) (defn commentary [] (let [open (r/atom nil)] @@ -1300,7 +1300,8 @@ 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]))] + nmap (into {} (map (juxt :id identity)) @(rf/subscribe [::subs/notes])) + revealed @(rf/subscribe [::subs/revealed])] [:div.commentary ;; this context's own description (links resolve in its parent), with an ;; edit button — Edit drops into the parent timeline so marks are editable. @@ -1317,12 +1318,11 @@ ;; 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 (reduce (fn [m a] (reduce #(update %1 %2 (fnil conj []) a) m (:parents a))) - {} anns)] + (let [by-parent (subs/annotations-by-parent anns)] (doall (for [a (get by-parent ctx)] ^{:key (:id a)} - [annotation-card a scene ctx segs nmap authed? open by-parent #{}]))) + [annotation-card a scene ctx segs nmap authed? open by-parent revealed ctx #{}]))) [:div.ann-empty "No annotations here."])])))) (defn- to-frame [v len] @@ -1502,8 +1502,11 @@ nmap (into {} (map (juxt :id identity)) notes) live @(rf/subscribe [::subs/active-note-set]) active @(rf/subscribe [::subs/active-mark]) - rows (scene/marks->rows scene (:marks d)) - broken (set (scene/broken-marks scene gid)) ; marks whose refs no longer resolve + ;; 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 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) diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs index 079f461..a39101b 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -51,6 +51,57 @@ (defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) +(deftest editing-nested-annotation-temporarily-enters-parent + (testing "card edit pushes the parent timeline, and finish-edit pops it back" + (setup! (seed) [:root]) + (rf/dispatch-sync [::ev/edit-annotation :annC]) + (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))) + (is (= :edit (get-in (scene*) [:groups :annC :draft]))) + (is (= :annA (get-in @rdb/app-db [:view :edit-pop-parent]))) + (rf/dispatch-sync [::ev/finish-edit]) + (is (= [:root] (get-in @rdb/app-db [:view :stack]))) + (is (nil? (get-in @rdb/app-db [:view :edit-pop-parent])))) + (testing "editing from the parent context does not push a duplicate parent" + (setup! (seed) [:root :annA]) + (rf/dispatch-sync [::ev/edit-annotation :annC]) + (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))) + (is (nil? (get-in @rdb/app-db [:view :edit-pop-parent]))) + (rf/dispatch-sync [::ev/finish-edit]) + (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))))) + +(deftest dragging-transcluded-annotation-to-root-rehomes-it + (testing "drag/drop root owns placement even when marks were authored under two annotations" + (setup! (seed) [:root]) + (rf/dispatch-sync [::ev/expand :annB]) + (rf/dispatch-sync [::ev/open-draft]) + (rf/dispatch-sync [::ev/draft-select-range 50 150]) + (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))] + (rf/dispatch-sync [::ev/associate-marks draft-gid :annC])) + (rf/dispatch-sync [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil]) + (rf/dispatch-sync [::ev/finish-edit]) + (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) + (let [original-b-mark (second (get-in (scene*) [:groups :annC :marks]))] + (rf/dispatch-sync [::ev/reparent :annC :root]) + (is (= :root (get-in (scene*) [:groups :annC :parent]))) + (is (nil? (get-in (scene*) [:groups :annC :home]))) + (is (= #{:annA :root} (s/mark-homes (scene*) :annC))) + (is (= [:annA :root] + (mapv #(s/mark-home (scene*) %) + (get-in (scene*) [:groups :annC :marks])))) + (is (s/child-of? (scene*) :root :annC)) + (is (s/child-of? (scene*) :annA :annC)) + (is (not (s/child-of? (scene*) :annB :annC))) + (rf/dispatch-sync [::ev/collapse]) + (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))] + (is (contains? ids :annC))) + (rf/dispatch-sync [::ev/reparent :annC :annB]) + (let [restored-b-mark (second (get-in (scene*) [:groups :annC :marks]))] + (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) + (is (= original-b-mark (dissoc restored-b-mark :home-marks))) + (is (contains? (:home-marks restored-b-mark) :root)) + (is (not (s/child-of? (scene*) :root :annC))) + (is (s/child-of? (scene*) :annB :annC)))))) + (deftest tie-marks-to-annotation-in-another-context-then-drag (testing "author a range while drilled into annB, tie it to annC (parented under annA), then drag its handle — it must stay one proxy, stay visible in @@ -104,6 +155,8 @@ under (fn [p] (->> anns (filter #(contains? (:parents %) p)) (map :id) set))] (is c "annC is present in ::all-annotations while viewing annB") (is (contains? (:parents c) :annB) "annC's reference parents include annB") + (is (false? (:oor c)) "transclusion is not out-of-range just because its structural parent is elsewhere") + (is (false? (:broken c)) "transclusion does not render as a broken warning") (is (contains? (under :annB) :annC) "the pane lists annC under annB") (is (not (contains? (under :annB) :annA)) "annA is root's child, not annB's")) @@ -116,9 +169,27 @@ (is (not (contains? ids :annC)) "annC does NOT leak into root (grandchild)")) (rf/dispatch-sync [::ev/toggle-children :annA]) (let [anns @(rf/subscribe [::subs/all-annotations]) - c (some #(when (= :annC (:id %)) %) anns)] + c (some #(when (= :annC (:id %)) %) anns) + by-parent (subs/annotations-by-parent anns) + revealed (get-in @rdb/app-db [:view :revealed])] (is c "revealing annA surfaces annC as its child in the toggle") - (is (contains? (:parents c) :annA))) + (is (contains? (:parents c) :annA)) + (is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annA #{}))) + "annA's open panel renders annC") + (is (nil? (subs/visible-child-annotations by-parent revealed :annB #{})) + "annB's closed panel does not render the same transcluded child")) + (rf/dispatch-sync [::ev/toggle-children :annB]) + (let [anns @(rf/subscribe [::subs/all-annotations]) + by-parent (subs/annotations-by-parent anns) + revealed (get-in @rdb/app-db [:view :revealed])] + (is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annB #{}))) + "annB renders annC only after its own panel opens")) + (rf/dispatch-sync [::ev/toggle-children :annB]) + (let [anns @(rf/subscribe [::subs/all-annotations]) + by-parent (subs/annotations-by-parent anns) + revealed (get-in @rdb/app-db [:view :revealed])] + (is (nil? (subs/visible-child-annotations by-parent revealed :annB #{})) + "hiding annB's panel removes annC from that panel even though annA still reveals it")) ;; BUG 2 — back in annB, dragging the handle must not delete the mark ;; (::reroll-proxy must roll against the VIEWED context, not annC's :parent). From 65a80857be2b234b608248f0611fa233b8119094 Mon Sep 17 00:00:00 2001 From: Your Name Date: Tue, 7 Jul 2026 13:07:49 -0400 Subject: [PATCH 09/10] feat: :in membership edges replace transclusion/mark-home placement MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Placement is now asserted, not derived. An annotation carries :in — an ordered vector of the mark-groups it's filed under (first = primary home, scene/home). Membership decides listing; mark resolution independently decides whether bars draw. Marks are never moved or re-cut. Rebuilt from the clean pre-transclusion base, keeping only the codex frame-integer (assert-frame) work: - delete ref-owner / mark-home / mark-homes / :home-marks / rehome-marks - annotations drop :parent entirely; restore-annotations migrates legacy :parent -> :in [parent]; :in is a vector (JSON-round-trips like :tags/:notes) - file-edge (shared by ::reparent drag + ::file-into picker): move vs add/link; ::unfile guards primary + last; files-under? cycle guard - ::associate-marks no longer auto-files (adding marks != placement) - root identified by (= :timeline (:type)), not (nil? :parent) - membership-chips `in:` row; drag ⌥ = link; .reference cards Tests: real day8.re-frame.test run-test-sync suite driving events + live subscriptions (pane, context, reveal, reparent, associate, unfile, cycle, JSON wire). 62 tests / 243 assertions, 0 failures; 0 residue. Co-Authored-By: Claude Opus 4.8 --- tl/resources/public/css/app.css | 16 ++ tl/shadow-cljs.edn | 1 + tl/src/tl/events.cljs | 188 +++++++++--------- tl/src/tl/scene.cljs | 121 +++++------- tl/src/tl/subs.cljs | 36 ++-- tl/src/tl/views.cljs | 65 +++++- tl/test/tl/flow_test.cljs | 339 +++++++++++++++----------------- tl/test/tl/scene_test.cljs | 111 +++++------ 8 files changed, 447 insertions(+), 430 deletions(-) diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index e34fcc0..e5058b7 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -333,6 +333,22 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .ann-tags .tag { font-size: 9px; padding: 0 6px 0 12px; line-height: 1.6; border-radius: 2px 8px 8px 2px; } .ann-tags .tag::before { width: 3px; height: 3px; left: 5px; } +/* the `in:` membership row — where this annotation is filed (:in edges) */ +.ann-in { display: flex; flex-wrap: wrap; align-items: center; gap: 4px; margin-top: 5px; } +.ann-in-label { font-size: 9px; color: var(--muted, #888); text-transform: uppercase; letter-spacing: .04em; } +.in-chip { display: inline-flex; align-items: center; gap: 2px; font-size: 9px; + padding: 0 5px; line-height: 1.7; background: var(--shade); color: var(--ink); + border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; } +.in-chip:hover { background: var(--ink); color: var(--paper); } +.in-x, .in-plus { font-size: 9px; line-height: 1; padding: 0 1px; background: none; + border: none; color: inherit; cursor: pointer; opacity: .6; } +.in-x:hover, .in-plus:hover { opacity: 1; } +.in-plus { border: 1px dashed var(--ink); border-radius: 8px; padding: 0 5px; line-height: 1.6; opacity: .7; } +.in-add-pop { display: inline-flex; align-items: center; gap: 2px; } +.in-add-pop .ac { min-width: 140px; } +/* a card filed here whose footage doesn't land here — reference only, no bars */ +.ann.reference { border-style: dashed; opacity: .78; } + /* reveal-children toggle at the card bottom + the nested child cards */ .show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px; font-family: var(--chicago); font-size: 11px; text-align: left; diff --git a/tl/shadow-cljs.edn b/tl/shadow-cljs.edn index 5209343..c4a87c1 100644 --- a/tl/shadow-cljs.edn +++ b/tl/shadow-cljs.edn @@ -9,6 +9,7 @@ [re-frame "1.4.7"] [metosin/reitit "0.9.1"] [day8.re-frame/http-fx "0.2.4"] + [day8.re-frame/test "0.1.5"] [binaryage/devtools "1.0.7"]] :dev-http diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 6035ef1..e5773f5 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -463,7 +463,7 @@ (defn- draft-in-ctx [db ctx] (some (fn [[gid g]] - (when (and (:draft g) (= ctx (:parent g))) [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] @@ -489,7 +489,7 @@ (defn- mark-start-local [db ann mark-id] (let [scene (:scene db) - ctx (:parent (get-in scene [:groups ann])) + ctx (scene/home scene ann) segs (scene/content-segments scene ctx)] (ffirst (scene/mark-bars scene ann mark-id segs)))) @@ -499,7 +499,7 @@ (let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack]))) (some (fn [[gid g]] (when (:draft g) [gid g])) (get-in db [:scene :groups]))) - ctx (:parent (get-in db [:scene :groups ann])) + 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) @@ -657,9 +657,10 @@ ;; uuid, not gensym: gensym's counter resets each page load, so a ;; fresh annotation would reuse a prior gid and clobber it on merge. (assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))] - {:type :annotation :parent (peek (get-in db [:view :stack])) - :draft :new :name "" :color "#4e8fc2" :marks [] - :v scene/schema-version}) + (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})) (assoc-in [:view :pt] :new) (assoc-in [:view :active-mark] nil) (assoc-in [:view :draft-stage] :choosing)))) @@ -674,28 +675,28 @@ (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 parent timeline is not the timeline -;; currently being viewed, enter that parent first so mark rows/handles edit in -;; their authored coordinate system. finish-edit pops this temporary parent. +;; 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 [parent (get-in db [:scene :groups gid :parent]) + (let [home (scene/home (:scene db) gid) ctx (peek (get-in db [:view :stack])) - push-parent? (and parent (not= parent ctx)) - fx (if push-parent? (enter-ctx db #(conj % parent)) {:db db})] + 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-parent? (assoc-in [:view :edit-pop-parent] parent)))))) + push-home? (assoc-in [:view :edit-pop-parent] home)))))) ;; Edit the annotation you're currently inside: drop into its parent timeline so ;; its marks are editable there, remembering to pop back when done. Root has no ;; parent (and no marks) — edit it in place. (rf/reg-event-fx ::edit-here (fn [{:keys [db]} [_ gid]] - (let [root? (nil? (get-in db [:scene :groups gid :parent])) + (let [root? (= :timeline (get-in db [:scene :groups gid :type])) fx (if root? {:db db} (enter-ctx db pop))] (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit) (assoc-in [:view :pt] :new) @@ -730,7 +731,7 @@ (let [g (cond-> (editable-group g) (= :annotation (:type g)) (assoc :v scene/schema-version)) patch (group-patch orig g) - root? (nil? (:parent g)) ; the root timeline persists whole + root? (= :timeline (:type g)) ; the root timeline persists whole id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks) ;; proxies this annotation references are synthetic clips in the pool — ;; persist them alongside it or the {:ref proxy} marks dangle on reload. @@ -752,18 +753,24 @@ id (assoc :http-xhrio (api/put-scene id {:deleted [gid]} {:on-success [::scene-saved] :on-failure [::save-error]})))))) -;; --- move an annotation into another context (drag-drop reparent) --------- -;; Drag/drop re-expresses the annotation's visible mark coverage in the target -;; context. The parent is just where the annotation is edited/listed; the marks -;; still decide what actually renders by resolving down to clips and intersecting -;; the target timeline. -(defn- descendant? - "Is `gid` equal to `anc` or somewhere below it in the :parent tree?" - [scene anc gid] - (loop [g gid] - (cond (nil? g) false - (= g anc) true - :else (recur (get-in scene [:groups g :parent]))))) +;; --- membership edges (:in): file an annotation under mark-groups ---------- +;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups +;; the annotation is filed under; the FIRST is the primary home (scene/home) — where +;; it's edited and its links resolve. Marks never move or re-cut — they resolve to +;; raw clips globally, and that only decides whether BARS draw in a context. Three +;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag / +;; file-into picker), remove (× on a chip). + +(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 @@ -779,64 +786,62 @@ (assoc-in [:view :dragging-ann] nil) (assoc-in [:view :dragging-ann-source] nil)))) -(defn- rehome-marks - [scene gid source-parent new-parent] - (let [target-segs (scene/content-segments scene new-parent)] - (reduce (fn [{:keys [marks proxies]} m] - (if (= source-parent (scene/mark-home scene m)) - (let [bare (dissoc m :home-marks) - history (:home-marks m {}) - history (assoc history source-parent bare)] - (if-let [saved (get history new-parent)] - {:marks (conj marks (assoc saved :home-marks (dissoc history new-parent))) - :proxies proxies} - (let [bars (scene/mark-bars scene gid (:id m) target-segs)] - (if (seq bars) - (let [pid (keyword (str "prox-" (random-uuid))) - proxy {:type :proxy :parent nil - :marks (mapv identity - (mapcat (fn [[lo hi]] - (scene/selection->marks scene new-parent lo hi)) - bars))} - m* (assoc (merge m (scene/proxy-ref (:id m) pid)) - :home-marks history)] - {:marks (conj marks m*) :proxies (assoc proxies pid proxy)}) - {:marks (conj marks m) :proxies proxies})))) - {:marks (conj marks m) :proxies proxies})) - {:marks [] :proxies {}} - (get-in scene [:groups gid :marks])))) +(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]}))))) -(defn- has-home? [scene gid source-parent] - (some #(= source-parent (scene/mark-home scene %)) - (get-in scene [:groups gid :marks]))) +;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps +;; existing edges (link); otherwise the edge you grabbed is moved off its source. +;; Marks are untouched either way. +(defn- file-edge [db gid new-parent add? source] + (let [scene (:scene db) + g (get-in scene [:groups gid]) + in (vec (:in g)) + clear #(-> % (assoc-in [:view :dragging-ann] nil) + (assoc-in [:view :dragging-ann-source] nil))] + (if (or (not= :annotation (:type g)) ; only annotations file + (:draft g) ; not mid-draft + (= gid new-parent) ; not under itself + (contains? (set in) new-parent) ; already filed there + (files-under? scene new-parent gid #{})) ; would make a cycle + {:db (clear db)} + (let [in' (if add? + (conj in new-parent) ; link: append, primary unchanged + (let [rest* (vec (remove #{source} in))] + (if (= source (first in)) + (into [new-parent] rest*) ; moved the primary → new home + (conj rest* new-parent)))) + g* (assoc g :in in')] + (update (persist-group db gid g g*) :db clear))))) (rf/reg-event-fx ::reparent - (fn [{:keys [db]} [_ gid new-parent]] - (let [scene (:scene db) - g (get-in scene [:groups gid]) - source-parent (or (get-in db [:view :dragging-ann-source]) - (peek (get-in db [:view :stack])))] - (if (or (not= :annotation (:type g)) ; only annotations move - (:draft g) ; not while being drafted/edited - (= source-parent new-parent) - (not (has-home? scene gid source-parent)) - (descendant? scene gid new-parent)) ; target inside gid -> cycle - {:db (-> db - (assoc-in [:view :dragging-ann] nil) - (assoc-in [:view :dragging-ann-source] nil))} - (let [id (get-in db [:project :id]) - {:keys [marks proxies]} (rehome-marks scene gid source-parent new-parent) - g* (assoc g :parent new-parent :marks marks) - patch (editable-group g*)] - (cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) - (update-in [:scene :groups] merge proxies) - (assoc-in [:view :dragging-ann] nil) - (assoc-in [:view :dragging-ann-source] nil) - (assoc :save-error nil))} - id (assoc :http-xhrio (api/put-scene id {:changed (merge {gid patch} proxies)} - {:on-success [::scene-saved] - :on-failure [::save-error]})))))))) + (fn [{:keys [db]} [_ gid new-parent add?]] + (let [source (or (get-in db [:view :dragging-ann-source]) (peek (get-in db [:view :stack])))] + (file-edge db gid new-parent add? source)))) + +;; file into a group chosen from the picker — always additive (source nil). +(rf/reg-event-fx ::file-into + (fn [{:keys [db]} [_ gid target]] + (file-edge db gid target true nil))) + +;; remove one membership edge (× on a chip). Never the primary home, never the last. +(rf/reg-event-fx + ::unfile + (fn [{:keys [db]} [_ gid target]] + (let [g (get-in db [:scene :groups gid]) + in (vec (:in g))] + (if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1)) + {:db db} + (persist-group db gid g (assoc g :in (vec (remove #{target} in)))))))) (rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil))) (rf/reg-event-db ::save-error @@ -870,7 +875,7 @@ ::unset-proxy-endpoint (fn [db [_ gid mark-id pid which]] (let [scene (:scene db) - ctx (:parent (get-in scene [:groups gid])) + 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)})))) @@ -880,14 +885,14 @@ ;; seek to its start, and drop into drawing mode ("select a range → you're drawing"). (defn- select-range-fx [db gid g lo hi] (let [scene (:scene db) - p (scene/make-proxy scene (:parent g) lo hi) + p (scene/make-proxy scene (scene/home scene gid) lo hi) pgid (keyword (str "prox-" (random-uuid))) mid (str (random-uuid)) - sf (scene/local->source (scene/content-segments scene (:parent g)) lo)] + sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)] {:db (-> db (assoc-in [:scene :groups pgid] p) (update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid)) (assoc-in [:view :active-mark] mid) - (assoc-in [:view :playheads (:parent g)] lo) + (assoc-in [:view :playheads (scene/home scene gid)] lo) (assoc-in [:view :pt] :new)) :player/seek (when sf (/ sf (:fps db))) :fx [[:dispatch [::start-drawing gid mid]]]})) @@ -906,7 +911,7 @@ (fn [{:keys [db]} [_ seg-id frame]] (let [scene (:scene db) [gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene)) - segs (scene/content-segments scene (:parent g)) + segs (scene/content-segments scene (scene/home scene gid)) pt (get-in db [:view :pt])] (cond ;; re-picking one endpoint of a proxy: roll only that side, keep the other @@ -919,7 +924,7 @@ 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 (:parent g) proxy lo (max (inc lo) hi))) + (scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi))) (assoc-in [:view :pt] :new))}) (map? pt) @@ -931,7 +936,7 @@ ;; re-picking an endpoint: reconcile-run keeps the mark id for the ;; piece on the kept clip; re-attach that mark's bindings, and splice ;; the run back into its original slot so order is preserved. - (let [run (->> (scene/reconcile-run scene (:parent g) [old] lo hi) + (let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi) (mapv (fn [m] (if (= (:id m) (:id old)) (cond-> m (:notes old) (assoc :notes (:notes old)) @@ -1006,9 +1011,10 @@ (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]) - target (-> orig-t - (update :marks (fnil into []) marks) - (dissoc :home)) + ;; 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]) pg (get-in db [:scene :groups pid])] diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 133a0c8..a8fc6cd 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -120,7 +120,7 @@ ;; --- resolution ---------------------------------------------------------- -(declare resolve resolve-mark) +(declare resolve resolve-mark home child-of?) (defn- target-segs "Resolved segments (local 0-based) of a referenceable id: a group (clip, @@ -168,7 +168,7 @@ [scene gid point] (cond (number? point) - (let [parent (:parent (grp scene gid))] + (let [parent (home scene gid)] {:frame (if parent (local->source (resolve scene parent) point) point) :track nil}) @@ -219,7 +219,7 @@ lb (at->l (:at end))] (when (and (<= 0 la len) (<= 0 lb len) (<= la lb)) (rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb)))))) - (let [parent (:parent (grp scene gid))] + (let [parent (home scene gid)] (if parent ; absolute, relative to parent (rebase id (slice (resolve scene parent) start end)) [{:mark id :track track :src [start end] :local [0 (- end start)] @@ -365,71 +365,45 @@ (when (seq pcs) [(reduce min (map first pcs)) (reduce max (map second pcs))]))) -(defn clip-loss? - "True when annotation `gid` loses any content once clipped to its immediate - parent annotation — it references frames outside the parent timeline, so it's - (partly) out of range there. Timeline/root parents contain everything." +;; --- placement: :in membership edges -------------------------------------- +;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered +;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under +;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in +;; it. The FIRST element is the primary home (where its :content links resolve and +;; where it's edited); the whole vector as a set is its membership. Marks are never +;; moved or re-cut — they resolve to raw clips globally, and that only decides +;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it +;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary. + +(defn home + "The primary home of `gid`: the first `:in` edge for an annotation (where its + description links resolve and where it's edited); the structural `:parent` for + anything else (nil for the flat clip/proxy pool and the root timeline)." [scene gid] - (let [p (:parent (grp scene gid))] + (let [g (grp scene gid)] + (if (= :annotation (:type g)) (first (:in g)) (:parent g)))) + +(defn membership + "The set of mark-groups annotation `gid` is filed under (its `:in` edges)." + [scene gid] + (set (:in (grp scene gid)))) + +(defn child-of? + "Is annotation `gid` filed under `ctx`?" + [scene ctx gid] + (contains? (membership scene gid) ctx)) + +(defn clip-loss? + "True when annotation `gid` loses content once clipped to its primary home — it + references frames outside that parent annotation, so it's (partly) out of range + there. Timeline/root homes contain everything, so they never warn." + [scene gid] + (let [p (home scene gid)] (when (and p (= :annotation (:type (grp scene p)))) (let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs))) own (mapv :src (resolve scene gid))] (< (len (src-intersect own (mapv :src (resolve scene p)))) (len own)))))) -;; --- reference parent: which timeline a mark was authored in --------------- -;; A mark's proxy DIRECTLY references a content unit of exactly one timeline — the -;; one it was authored in. That timeline is the mark's "home"; the annotation -;; holding the mark shows as a child there. This is one hop (a direct reference), -;; NOT transitive resolution down to clips — so a grandchild is a child of its -;; parent, not of the root. An annotation that collected marks from two contexts -;; (transclusion) is a child of both. This is the "fk" the nesting rides on. - -(defn- ref-owner - "The timeline that OWNS content unit `t`: :root for a clip, else the annotation - whose proxy contains the mark `t` (t is one of that annotation's content units). - nil if `t` dangles." - [scene t] - (cond - (= :clip (:type (grp scene t))) :root - (find-mark scene t) - (let [[container _] (find-mark scene t)] - (if (= :proxy (:type (grp scene container))) - (some (fn [[gid g]] - (when (and (= :annotation (:type g)) - (some #(= container (get-in % [:start :ref])) (:marks g))) - gid)) - (:groups scene)) - container)) - :else nil)) - -(defn mark-home - "The timeline mark `m` was authored in — the owner of the content unit its proxy - DIRECTLY references (one hop). :root for a clip-backed mark. The annotation that - holds `m` shows as a child of this timeline. nil if unresolvable." - [scene m] - (let [pid (get-in m [:start :ref]) - t (if (= :proxy (:type (grp scene pid))) - (get-in (first (:marks (grp scene pid))) [:start :ref]) - pid)] - (ref-owner scene t))) - -(defn mark-homes - "The distinct timelines annotation `gid`'s marks are homed in — its reference - parent(s). Usually one; two (or more) when it collected marks from different - contexts (transclusion). Falls back to the structural `:parent` when the - annotation has no resolvable marks (a fresh draft, a fully broken one), so it - still shows somewhere." - [scene gid] - (let [g (grp scene gid) - homes (into #{} (keep #(mark-home scene %)) (:marks g))] - (if (seq homes) homes #{(:parent g)}))) - -(defn child-of? - "Is annotation `gid` a direct child of timeline `ctx` — a mark of its authored - there (homed in ctx)." - [scene ctx gid] - (contains? (mark-homes scene gid) ctx)) - ;; --- editing: split a local selection into a run of single-clip marks ----- (defn selection->marks @@ -520,12 +494,7 @@ (get-in m [:end :ref]) (update-in [:end :ref] keyword) (:track m) (update :track keyword) (:notes m) (update :notes #(mapv keyword %)) ; bound script-note gids - (:drawings m) (update :drawings #(mapv keyword %)) ; bound drawing gids - (:home-marks m) (update :home-marks - (fn [homes] - (into {} (map (fn [[home mark]] - [(keyword home) (restore-mark mark)])) - homes))))) + (:drawings m) (update :drawings #(mapv keyword %)))) ; bound drawing gids (defn- restore-region "A script-note region loses keyword-ness through JSON: re-keyword :id and :kind." @@ -568,9 +537,15 @@ :proxy (update g :marks #(mapv restore-mark (or % []))) ; synthetic clip: just its run :drawing g ; pure strokes + seed, JSON round-trips as-is (-> g + (dissoc :parent) ; annotations are placed by :in alone (update :marks #(mapv restore-mark (or % []))) (cond-> (:notes g) (update :notes #(mapv keyword %))) ; annotation-level bindings + ;; membership edges: keyword an existing :in vector, + ;; or seed one from a legacy single :parent + (assoc :in (if-let [in (:in g)] + (mapv keyword in) + (when (:parent g) [(:parent g)]))) migrate))]))) anns)) @@ -744,7 +719,7 @@ (sort-by (comp first :local) segs))})))) anns (->> (:groups scene) (keep (fn [[gid g]] - (when (and (= :annotation (:type g)) (= ctx (:parent g)) + (when (and (= :annotation (:type g)) (child-of? scene ctx gid) (not (:draft g))) {:name (or (:name g) (name gid)) :kind :annotation :items (mapv (fn [{:keys [id lo len]}] @@ -754,14 +729,14 @@ (vec (concat (sort-by :name tracks) (sort-by :name anns))))) (defn path-to - "Stack path from :root down to `gid` following :parent links, or nil if an - ancestor is missing — an orphan whose parent context was deleted." + "Stack path from :root down to `gid` following primary-home links, or nil if an + ancestor is missing — an orphan whose home context was deleted." [scene gid] (loop [g gid, acc ()] (cond (= g :root) (vec (cons :root acc)) (or (nil? g) (not (contains? (:groups scene) g))) nil - :else (recur (get-in scene [:groups g :parent]) (cons g acc))))) + :else (recur (home scene g) (cons g acc))))) (defn timelines "Every reachable timeline you can open as a context — root, plus named child @@ -773,7 +748,7 @@ (keep (fn [[gid g]] (when (and (= :annotation (:type g)) (not (:draft g))) (when-let [path (path-to scene gid)] - (let [parent (:parent g)] + (let [parent (home scene gid)] {:gid gid :name (or (:name g) (name gid)) :in (if (or (nil? parent) (= :root parent)) "root" (get-in scene [:groups parent :name] (name parent))) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index cce6113..00861c6 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -135,15 +135,15 @@ :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] (fn [[scene ctx segs revealed] _] (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid])))) - ;; each annotation → its reference PARENTS: the timeline(s) its marks were - ;; authored in (mark-homes). A normal annotation has one; a transcluded one - ;; (marks from two contexts) has two, so it shows as a child under BOTH. + ;; 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. parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))] - [gid (scene/mark-homes scene gid)])) + [gid (scene/membership scene gid)])) ;; child count per timeline (drives the "Show N" nested badge) nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents)) - ;; reference-reveal hierarchy: shows when ctx is a reference parent, or a - ;; REVEALED reference-parent that itself shows. `seen` guards ref cycles. + ;; 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) @@ -152,20 +152,13 @@ (->> (:groups scene) (keep (fn [[gid g]] (when (= :annotation (:type g)) - ;; VISIBILITY IS BY REFERENCE: an annotation shows in ctx when a - ;; mark of its was AUTHORED in ctx (homed there) — one hop, not - ;; transitive — so a mark made in ctx shows even if the annotation - ;; is parented elsewhere (transclusion), while a grandchild does - ;; not leak up and a sibling covering the same clips stays out. + ;; 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) - ;; clip-loss compares against the structural :parent. - ;; A transcluded annotation is intentionally authored in - ;; multiple reference parents, so judging all marks - ;; against only :parent creates a false warning. - oor (boolean (and (= (parents gid) #{(:parent g)}) - (scene/clip-loss? 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 @@ -186,10 +179,9 @@ (get-in cg [:media :name]) (some-> ref name))))) distinct)] - {:id gid :parent (:parent g) - ;; the timeline(s) this annotation is a child of (mark-homes) — - ;; the pane groups by this so a transcluded annotation appears - ;; under every context it was authored in. + {:id gid :parent (scene/home scene gid) ; primary home = first :in + ;; the mark-groups this annotation is filed under (:in) — the + ;; pane groups by this, so a linked annotation lists under each. :parents (parents gid) :name (:name g) :color (or (:color g) "#4e8fc2") :content (:content g) :children (count (:marks g)) @@ -281,7 +273,7 @@ (fn [[gid g]] ;; child annotations of the context OR the context annotation itself ;; (pushing the owner onto the stack makes ctx that annotation) - (when (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid))) + (when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid))) (let [src-segs (scene/resolve scene gid) by-mark (group-by :mark src-segs) ->bars (fn [ss] (scene/merge-bars diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 05e1b47..e0e785e 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -1138,6 +1138,54 @@ [: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 @@ -1221,19 +1269,25 @@ (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)]))))})) + (rf/dispatch [::events/reparent (keyword src) (:id a) (.-altKey e)]))))})) (defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen] (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) {:class (str (when active? "active ") + (when reference? "reference ") (when (and drop-ok? @over?) "drop-over ") (when drop-ok? "drop-ready"))})] (if (:hidden a) @@ -1273,6 +1327,7 @@ [: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 @@ -1310,7 +1365,7 @@ (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 (:parent cg) ctx) (:content cg)] + [content-display scene (or (scene/home scene ctx) ctx) (:content cg)] [:div.muted "No description yet."]) (when authed? [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])]) @@ -1484,14 +1539,14 @@ 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 (:parent d), so its marks/pickers stay stable. - ctx (or (:parent d) (:gid d)) ; annotation: its parent; root: itself + ;; still belongs to its primary home (first :in), so pickers stay stable. + ctx (or (first (:in d)) (:gid d)) ; annotation: its home; root: itself segs (scene/content-segments scene ctx) pt @(rf/subscribe [::subs/pt]) linking @(rf/subscribe [::subs/linking]) gid (:gid d) new? (= :new (:draft d)) - root? (nil? (:parent 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 diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs index a39101b..8412ce5 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -1,9 +1,15 @@ (ns tl.flow-test - "Integration tests that drive the ACTUAL re-frame events the UI dispatches - (dispatch-sync) and read the resulting app-db / scene back — so a bug that lives - in an event handler (not a pure scene fn) is caught. Side-effecting fx are - stubbed so the sync path stays pure; project id is nil so nothing hits the net." + "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] @@ -16,8 +22,7 @@ :connect-scene :fetch-projects :poll-thumbnails :upload-project]] (rf/reg-fx k (fn [_] nil))) -;; single-source footage: four clips, ALL named "Challengers.mov" (this is why the -;; media name is useless as a label — the track+occurrence is what distinguishes) +;; 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}]} @@ -27,19 +32,19 @@ :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) + annB (over clips C,D) + annC (parented under A, - holding one mark authored inside A) — the state right before you drill into B." + "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 :parent :root :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]}) - (assoc-in [:groups :annB] {:type :annotation :parent :root :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :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 :parent :annA :name "C" :color "#00f" + (assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f" :marks [(s/proxy-ref "ca" :pInA)]})))) (defn setup! [scene stack] @@ -48,185 +53,155 @@ :project {:id nil}})) (defn scene* [] (:scene @rdb/app-db)) -(defn bars-in [ctx gid] - (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) +(defn draft-gid [] (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))) +(defn pane-ids + "The set of annotation gids the pane sub currently lists (in the live context)." + [] + (set (map :id @(rf/subscribe [::subs/all-annotations])))) +(defn card [gid] (some #(when (= gid (:id %)) %) @(rf/subscribe [::subs/all-annotations]))) +(defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) -(deftest editing-nested-annotation-temporarily-enters-parent - (testing "card edit pushes the parent timeline, and finish-edit pops it back" - (setup! (seed) [:root]) - (rf/dispatch-sync [::ev/edit-annotation :annC]) - (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))) - (is (= :edit (get-in (scene*) [:groups :annC :draft]))) - (is (= :annA (get-in @rdb/app-db [:view :edit-pop-parent]))) - (rf/dispatch-sync [::ev/finish-edit]) - (is (= [:root] (get-in @rdb/app-db [:view :stack]))) - (is (nil? (get-in @rdb/app-db [:view :edit-pop-parent])))) - (testing "editing from the parent context does not push a duplicate parent" - (setup! (seed) [:root :annA]) - (rf/dispatch-sync [::ev/edit-annotation :annC]) - (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))) - (is (nil? (get-in @rdb/app-db [:view :edit-pop-parent]))) - (rf/dispatch-sync [::ev/finish-edit]) - (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))))) +;; ========================================================================= +;; the annotation pane sub (::all-annotations) lists by membership +;; ========================================================================= -(deftest dragging-transcluded-annotation-to-root-rehomes-it - (testing "drag/drop root owns placement even when marks were authored under two annotations" - (setup! (seed) [:root]) - (rf/dispatch-sync [::ev/expand :annB]) - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 50 150]) - (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))] - (rf/dispatch-sync [::ev/associate-marks draft-gid :annC])) - (rf/dispatch-sync [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil]) - (rf/dispatch-sync [::ev/finish-edit]) - (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) - (let [original-b-mark (second (get-in (scene*) [:groups :annC :marks]))] - (rf/dispatch-sync [::ev/reparent :annC :root]) - (is (= :root (get-in (scene*) [:groups :annC :parent]))) - (is (nil? (get-in (scene*) [:groups :annC :home]))) - (is (= #{:annA :root} (s/mark-homes (scene*) :annC))) - (is (= [:annA :root] - (mapv #(s/mark-home (scene*) %) - (get-in (scene*) [:groups :annC :marks])))) - (is (s/child-of? (scene*) :root :annC)) - (is (s/child-of? (scene*) :annA :annC)) - (is (not (s/child-of? (scene*) :annB :annC))) - (rf/dispatch-sync [::ev/collapse]) - (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))] - (is (contains? ids :annC))) - (rf/dispatch-sync [::ev/reparent :annC :annB]) - (let [restored-b-mark (second (get-in (scene*) [:groups :annC :marks]))] - (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) - (is (= original-b-mark (dissoc restored-b-mark :home-marks))) - (is (contains? (:home-marks restored-b-mark) :root)) - (is (not (s/child-of? (scene*) :root :annC))) - (is (s/child-of? (scene*) :annB :annC)))))) +(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)))))) -(deftest tie-marks-to-annotation-in-another-context-then-drag - (testing "author a range while drilled into annB, tie it to annC (parented under - annA), then drag its handle — it must stay one proxy, stay visible in - annB, and NOT vanish when rerolled." - (setup! (seed) [:root]) - ;; drill into annB (real stack-nav event) - (rf/dispatch-sync [::ev/expand :annB]) - (is (= [:root :annB] (get-in @rdb/app-db [:view :stack]))) - ;; new draft + select a range 50..150 (C-tail + D-head), exactly as a lane drag - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 50 150]) - (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))] - (is draft-gid "a draft should exist after open-draft") - (is (= 1 (count (get-in (scene*) [:groups draft-gid :marks]))) "one proxy mark, not per-clip") - ;; tie the draft's marks to the existing annC (transclusion) - (rf/dispatch-sync [::ev/associate-marks draft-gid :annC]) - (let [annC (get-in (scene*) [:groups :annC]) - bmk (last (:marks annC)) - bid (:id bmk)] - (is (nil? (get-in (scene*) [:groups draft-gid])) "draft is consumed") - (is (= 2 (count (:marks annC))) "annC now has its A-mark + the new B-mark") - (is (= :proxy (:type (get-in (scene*) [:groups (get-in bmk [:start :ref])]))) - "the tied mark is a single proxy-ref, not expanded into per-clip marks") +;; ========================================================================= +;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched +;; ========================================================================= - ;; BUG 1 — labels. Viewed from annB: the new B-mark's endpoint is one of - ;; annB's own content units (labels via the context), while annC's A-mark is - ;; foreign here. Its fallback must be the TRACK ("A-roll"), never the shared - ;; source-file name "Challengers.mov". - (let [ctx-ids (into #{} (map :mark) (s/content-segments (scene*) :annB)) - row-seg (fn [gid-mark] (get-in (s/mark-row (scene*) gid-mark) [:s :seg])) - amk (first (:marks annC))] ; the A-mark - (is (contains? ctx-ids (row-seg bmk)) "B-mark endpoint is one of annB's units → context-labelled") - (is (not (contains? ctx-ids (row-seg amk))) "A-mark is foreign in annB") - (is (= "A-roll" (s/ref-track-name (scene*) (row-seg amk))) "foreign label is the track, not Challengers.mov") - (is (not= "Challengers.mov" (s/ref-track-name (scene*) (row-seg amk))))) +(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]))))))) - ;; REFERENCE PARENTS — annC is a child of A (its A-mark) and B (its B-mark), - ;; and NOT of root (it's a grandchild there: one hop, not transitive to clips) - (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) - (is (s/child-of? (scene*) :annB :annC)) - (is (not (s/child-of? (scene*) :root :annC))) +(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)))))) - ;; LANE in annB: exactly one bar for annC's B-mark - (is (= 1 (count (bars-in :annB :annC))) "annC shows exactly one bar in annB") - (is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2))) +;; ========================================================================= +;; unfile — remove one edge; never the primary home, never the last +;; ========================================================================= - ;; ISSUE 1 — the PANE LIST (::all-annotations, grouped by :parents) must - ;; include annC under annB, and must not pull in non-children. - (let [anns @(rf/subscribe [::subs/all-annotations]) - c (some #(when (= :annC (:id %)) %) anns) - under (fn [p] (->> anns (filter #(contains? (:parents %) p)) (map :id) set))] - (is c "annC is present in ::all-annotations while viewing annB") - (is (contains? (:parents c) :annB) "annC's reference parents include annB") - (is (false? (:oor c)) "transclusion is not out-of-range just because its structural parent is elsewhere") - (is (false? (:broken c)) "transclusion does not render as a broken warning") - (is (contains? (under :annB) :annC) "the pane lists annC under annB") - (is (not (contains? (under :annB) :annA)) "annA is root's child, not annB's")) +(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]))))))) - ;; ISSUE 3 at ROOT — collapse; annC must NOT leak into the root list (it's a - ;; grandchild). ISSUE 2 — revealing annA must then surface annC as its child. - (rf/dispatch-sync [::ev/collapse]) - (is (= [:root] (get-in @rdb/app-db [:view :stack]))) - (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))] - (is (contains? ids :annA) "annA (a root child) shows at root") - (is (not (contains? ids :annC)) "annC does NOT leak into root (grandchild)")) - (rf/dispatch-sync [::ev/toggle-children :annA]) - (let [anns @(rf/subscribe [::subs/all-annotations]) - c (some #(when (= :annC (:id %)) %) anns) - by-parent (subs/annotations-by-parent anns) - revealed (get-in @rdb/app-db [:view :revealed])] - (is c "revealing annA surfaces annC as its child in the toggle") - (is (contains? (:parents c) :annA)) - (is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annA #{}))) - "annA's open panel renders annC") - (is (nil? (subs/visible-child-annotations by-parent revealed :annB #{})) - "annB's closed panel does not render the same transcluded child")) - (rf/dispatch-sync [::ev/toggle-children :annB]) - (let [anns @(rf/subscribe [::subs/all-annotations]) - by-parent (subs/annotations-by-parent anns) - revealed (get-in @rdb/app-db [:view :revealed])] - (is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annB #{}))) - "annB renders annC only after its own panel opens")) - (rf/dispatch-sync [::ev/toggle-children :annB]) - (let [anns @(rf/subscribe [::subs/all-annotations]) - by-parent (subs/annotations-by-parent anns) - revealed (get-in @rdb/app-db [:view :revealed])] - (is (nil? (subs/visible-child-annotations by-parent revealed :annB #{})) - "hiding annB's panel removes annC from that panel even though annA still reveals it")) +;; ========================================================================= +;; adding marks from another context (associate-marks) does NOT move placement +;; ========================================================================= - ;; BUG 2 — back in annB, dragging the handle must not delete the mark - ;; (::reroll-proxy must roll against the VIEWED context, not annC's :parent). - (rf/dispatch-sync [::ev/expand :annB]) - (rf/dispatch-sync [::ev/reroll-proxy :annC bid 50 140]) - (let [bars (bars-in :annB :annC)] - (is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)") - (is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140")))))) +(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)))))) -(deftest draft-range-events-keep-integer-frames - (testing "basic drag selection through the real event path stores only integer frames" - (setup! clips-scene [:root]) - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 25 175]) - (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) - mark (first (:marks g)) - pid (get-in mark [:start :ref]) - proxy (get-in (scene*) [:groups pid]) - ats (mapcat (fn [m] [(get-in m [:start :at]) (get-in m [:end :at])]) (:marks proxy))] - (is gid "draft exists") - (is (= :proxy (:type proxy))) - (is (every? integer? ats)) - (is (= [[25 175 (:id mark)]] (bars-in :root gid))))) - (testing "fractional drag selection fails instead of being changed into nearby frames" - (setup! clips-scene [:root]) - (rf/dispatch-sync [::ev/open-draft]) - (is (thrown-with-msg? js/Error #"integer frame" - (rf/dispatch-sync [::ev/draft-select-range 25.5 175]))))) +;; ========================================================================= +;; stack push / pop and reveal-children through the real events +;; ========================================================================= -(deftest reroll-proxy-rejects-fractional-frames - (testing "live proxy reroll accepts integer handle positions and rejects fractional ones" - (setup! clips-scene [:root]) - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 25 175]) - (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) - mark-id (:id (first (:marks g)))] - (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30 170]) - (is (= [[30 170 mark-id]] (bars-in :root gid))) - (is (thrown-with-msg? js/Error #"integer frame" - (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30.25 170])))))) +(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")))) + +;; ========================================================================= +;; JSON wire round-trip of :in (vector, keyworded) via restore-annotations +;; ========================================================================= + +(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/scene_test.cljs b/tl/test/tl/scene_test.cljs index aca12f9..51f717b 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -23,7 +23,7 @@ ;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips. (def inter-x (with-group base :ann-x - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [{:id :m/s0 :start {:ref :clip-b :at 50} :end {:ref :clip-b :at -1}} ; src [150,200) {:id :m/s1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at 50}} ; src [0,50) {:id :m/s2 :start {:ref :clip-b :at 0} :end {:ref :clip-b :at 50}} ; src [100,150) @@ -32,7 +32,7 @@ ;; Y inside X, referencing two of X's subclips (parent = :ann-x) (def x+y (with-group inter-x :ann-y - {:type :annotation :parent :ann-x + {:type :annotation :in [:ann-x] :marks [{:id :m/y0 :start {:ref :m/s0 :at 10} :end {:ref :m/s0 :at 20}} ; s0 10..20 -> src [160,170) {:id :m/y1 :start {:ref :m/s1 :at 0} :end {:ref :m/s1 :at 5}}]})) ; s1 0..5 -> src [0,5) @@ -50,7 +50,7 @@ (deftest rearrange-and-gap-removal (testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]}) segs (s/resolve scene :ann)] (is (= 200 (s/length segs))) @@ -75,10 +75,10 @@ (testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame" ;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100 (let [scene (-> base - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]}) - (with-group :ann-y {:type :annotation :parent :ann + (with-group :ann-y {:type :annotation :in [:ann] :marks [{:id :m/y :start {:ref :m/s :at 0} :end {:ref :m/s :at -1}}]})) seg (first (s/resolve scene :ann-y))] @@ -88,14 +88,14 @@ (deftest tracks-by-membership (testing "zoom includes exactly the tracks the marks touch" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})] (is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann))))))) (deftest repeat-yields-two-pieces (testing "a clip referenced twice renders at two local positions" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100) (refm :m/r1 :clip-b 0 -1) ; B local [100,200) (refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300) @@ -162,7 +162,7 @@ (let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210) scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]})) segs (s/resolve scene :ann)] (is (= 170 (s/length segs))) ; 60 + 100 + 10 @@ -176,7 +176,7 @@ (testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip" (let [p (s/make-proxy base :root 10 60) ; inside A only scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]})) segs (s/resolve scene :ann)] (is (= 1 (count (:marks p)))) @@ -220,7 +220,7 @@ (let [p1 (s/make-proxy base :root 0 200) ; A+B p2 (s/make-proxy base :root 200 300) ; C (abuts B) scene (-> base (with-group :p1 p1) (with-group :p2 p2) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/1 :p1) (s/proxy-ref :m/2 :p2)]})) segs (s/content-segments scene :root) @@ -229,7 +229,7 @@ (is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi] ;; and a single cross-clip proxy on its own is one contiguous bar (let [one (-> base (with-group :p1 p1) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/1 :p1)]}))] (is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root)))))))) @@ -242,7 +242,7 @@ {:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}} back (:prox (s/restore-annotations json-like)) scene (-> base (with-group :prox back) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]}))] (is (= :proxy (:type back))) (is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded @@ -257,7 +257,7 @@ (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 :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]})) segs (s/content-segments scene :ann) ids (mapv :mark segs)] @@ -275,7 +275,7 @@ 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 :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]}))] (is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann)))))))) @@ -293,7 +293,7 @@ :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 :parent :root :marks [(s/proxy-ref :mA :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 @@ -302,12 +302,12 @@ (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 transclusion-visibility-is-scoped-by-reference-not-clip-overlap - (testing "an annotation shows in a timeline when a mark is BUILT ON that timeline's - content (references its units), not merely when its clips overlap. So a - mark authored in B shows in B though its annotation is parented under A - (transclusion), a mark authored in A shows in A — and a sibling root - annotation that just covers the same clips does NOT leak into B." +(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}]}) @@ -315,35 +315,31 @@ 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 :parent :root :marks [(s/proxy-ref :mA :pA)]}) - (with-group :annB {:type :annotation :parent :root :marks [(s/proxy-ref :mB :pB)]})) - ;; annC (parented under A) has a mark authored in A AND a mark authored in B - pInA (s/make-proxy scene :annA 10 60) ; a range inside annA (clip A) - pInB (s/make-proxy scene :annB 50 150) ; a range inside annB (C-tail + D-head) - ;; annD is a SIBLING root annotation that merely covers clip C - pDup (s/make-proxy scene :root 200 280) ; clip C, referenced from root directly - scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB) (with-group :pDup pDup) - (with-group :annC {:type :annotation :parent :annA - :marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}) - (with-group :annD {:type :annotation :parent :root - :marks [(s/proxy-ref "d1" :pDup)]}))] - ;; annC has exactly 2 marks (one per authored range); the B one is a single - ;; proxy whose run spans C-tail + D-head — not expanded into per-clip marks - (is (= 2 (count (:marks (get-in scene [:groups :annC]))))) - (is (= 2 (count (:marks pInB)))) ; run held inside the ONE proxy - ;; annC's marks are homed in A and B → it is a child of BOTH, and NOT of root - ;; (it's a grandchild there — one-hop reference, not transitive to clips) - (is (= #{:annA :annB} (s/mark-homes scene :annC))) + (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 (s/child-of? scene :annB :annC)) - (is (not (s/child-of? scene :root :annC))) ; grandchild does NOT leak to root - ;; annD only covers clip C from root — homed at root, NOT a child of annB - (is (= #{:root} (s/mark-homes scene :annD))) - (is (not (s/child-of? scene :annB :annD))) ; the over-show bug - (is (s/child-of? scene :root :annD)) - ;; lane bars follow: annC's B-mark renders in B, its A-mark in A, none of annD in B + (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))))))) + (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 @@ -352,7 +348,7 @@ (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 :parent :root + (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)] @@ -481,7 +477,7 @@ (deftest frames-are-mark-time-under-parent-trim (testing "frames are 0-based within the TRIMMED segment, not raw clip time" (let [scene (with-group base :p - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]}) segs (s/content-segments scene :p)] (is (= 60 (s/seg-length segs :m/s))) ; trimmed length, not 100 @@ -508,7 +504,8 @@ :end {:ref "clip-a" :at -1}}]}} g (:ann-1 (s/restore-annotations json-like))] (is (= :annotation (:type g))) - (is (= :root (:parent g))) + (is (= [:root] (:in g))) ; legacy :parent migrated to an :in edge + (is (nil? (:parent g))) ; and the old field is dropped (is (= :clip-a (get-in g [:marks 0 :start :ref]))) (let [scene (assoc-in base [:groups :ann-1] g)] (is (= [0 100] (:src (first (s/resolve scene :ann-1))))))))) @@ -519,9 +516,9 @@ (deftest annotations-survive-json-roundtrip (testing "restore-annotations is the exact inverse of the JSON wire trip — guards against any keyword-valued field (id/ref/type/parent/track) being missed" - (let [anns {:ann-p {:v s/schema-version :type :annotation :parent :root :name "p" :color "#abc" :content "hi" + (let [anns {:ann-p {:v s/schema-version :type :annotation :in [:root] :name "p" :color "#abc" :content "hi" :marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]} - :ann-c {:v s/schema-version :type :annotation :parent :ann-p :name "c" + :ann-c {:v s/schema-version :type :annotation :in [:ann-p] :name "c" :marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}] (is (= anns (s/restore-annotations (json-roundtrip anns))))))) @@ -578,7 +575,7 @@ (deftest repeats-are-unambiguous (testing "two instances of A share a source frame but distinct locals (local is master)" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/r0 :clip-a 0 -1) (refm :m/r1 :clip-b 0 -1) (refm :m/r2 :clip-a 0 -1)]}) segs (s/resolve scene :ann)] (is (= 5 (s/local->source segs 5))) ; first A @@ -610,9 +607,9 @@ (deftest path-to-builds-stack-and-drops-orphans (let [scene {:groups {:root {:type :timeline :parent nil} - :a {:type :annotation :parent :root} - :b {:type :annotation :parent :a} - :orphan {:type :annotation :parent :gone}}}] + :a {:type :annotation :in [:root]} + :b {:type :annotation :in [:a]} + :orphan {:type :annotation :in [:gone]}}}] (testing "path is root → … → target" (is (= [:root] (s/path-to scene :root))) (is (= [:root :a] (s/path-to scene :a))) From d54a6ae8f847a4b7980437cde084bb39c8315a9e Mon Sep 17 00:00:00 2001 From: Your Name Date: Tue, 7 Jul 2026 13:16:20 -0400 Subject: [PATCH 10/10] fix: rescue orphaned annotations to root in the pane MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Found by loading the real Challengers project through re-frame-test: 3 of 15 stored annotations were filed under a since-deleted parent. Under the :in model their sole host was a ghost, so ::all-annotations never surfaced them — invisible and unrefileable. ::all-annotations now drops :in hosts that no longer exist and rescues an annotation left with none to root (full-scene context, so peer-delta safe). Tests (re-frame-test, high-level events + pane sub): - orphaned-annotation-is-rescued-to-root - legacy-parent-data-migrates-through-peer-delta (the real DB shape) Co-Authored-By: Claude Opus 4.8 --- tl/src/tl/subs.cljs | 9 +++++++-- tl/test/tl/flow_test.cljs | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 2 deletions(-) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 00861c6..388c1fb 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -135,11 +135,16 @@ :<- [::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. + ;; 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))] - [gid (scene/membership scene gid)])) + (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, diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs index 8412ce5..6ba878d 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -190,10 +190,48 @@ (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])