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

feat: transclusion (wip commit)

Browse source
This commit is contained in:
Your Name 2026-07-06 22:54:18 -04:00
parent 28f441f172
commit 40dd3b0d59
8 changed files with 479 additions and 85 deletions
Download patch file Download diff file Expand all files Collapse all files

5
tl/shadow-cljs.edn
View file

@ -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

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

@ -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

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

@ -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."

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

@ -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 <ctx frame to seek> :seg <clip ref> :f <mark-time frame>}."
"One target per discontinuity for an annotation's jump popover, labelled from the
CONTENT SEGMENT the run lands on in `ctx` — its clip/track id + the frame within
it. A mark's :start is its proxy-ref ({:ref proxy :at 0}), so display-point of it
would give the proxy gid (never in `segs` → a bare \"clip\") and frame 0; instead
we read the actual clip under the run's local position, the same segments the
editor labels against. Each: {:local <ctx frame to seek> :seg <content id> :f}."
[scene ctx gid]
(mapv (fn [{:keys [id lo]}]
(let [st (:start (some #(when (= id (:id %)) %) (:marks (grp scene gid))))]
(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

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

@ -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))))

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

@ -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)]]))

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

@ -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"))))))

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

@ -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
;; =========================================================================