From 40dd3b0d5990bd67c0c23988290860a3ba8b3c0b Mon Sep 17 00:00:00 2001 From: Your Name Date: Mon, 6 Jul 2026 22:54:18 -0400 Subject: [PATCH] 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 ;; =========================================================================