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

refactor: anchor annotation marks to clips and unify visibility edges

Browse source
This commit is contained in:
Your Name 2026-09-17 15:10:52 -04:00
parent d54a6ae8f8
commit 4ae79b6422
9 changed files with 527 additions and 1759 deletions
Download patch file Download diff file Expand all files Collapse all files

2
scenes/tests.py
View file

@ -9,7 +9,7 @@ User = get_user_model()
def ann(name, content="", **extra): def ann(name, content="", **extra):
return {"type": "annotation", "parent": "root", "name": name, return {"type": "annotation", "in": ["root"], "name": name,
"content": content, "marks": [], **extra} "content": content, "marks": [], **extra}

3
tl/src/tl/db.cljs
View file

@ -17,8 +17,7 @@
;; the whole scene graph (see tl.scene). Seeded from OTIO at load. ;; the whole scene graph (see tl.scene). Seeded from OTIO at load.
:scene {:tracks {} :scene {:tracks {}
:groups {:root {:type :timeline :parent nil :groups {:root {:type :timeline :name "root"}}}
:marks [{:id :root-m :start 0 :end 0}]}}}
;; view state ;; view state
:view {:stack [:root] ; timeline-stack; top = current context :view {:stack [:root] ; timeline-stack; top = current context

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

@ -201,6 +201,7 @@
(-> (apply dissoc groups (map keyword deleted)) (-> (apply dissoc groups (map keyword deleted))
(into (remove (fn [[gid _]] (contains? drafts gid)) restored)))))))) (into (remove (fn [[gid _]] (contains? drafts gid)) restored))))))))
(rf/reg-event-fx (rf/reg-event-fx
::refresh-project-detail ::refresh-project-detail
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
@ -463,7 +464,7 @@
(defn- draft-in-ctx [db ctx] (defn- draft-in-ctx [db ctx]
(some (fn [[gid g]] (some (fn [[gid g]]
(when (and (:draft g) (= ctx (scene/home (:scene db) gid))) [gid g])) (when (and (:draft g) (= ctx (get-in db [:view :edit-context]))) [gid g]))
(get-in db [:scene :groups]))) (get-in db [:scene :groups])))
(defn- draft-mark-at [db ctx lf] (defn- draft-mark-at [db ctx lf]
@ -489,7 +490,7 @@
(defn- mark-start-local [db ann mark-id] (defn- mark-start-local [db ann mark-id]
(let [scene (:scene db) (let [scene (:scene db)
ctx (scene/home scene ann) ctx (get-in db [:view :edit-context])
segs (scene/content-segments scene ctx)] segs (scene/content-segments scene ctx)]
(ffirst (scene/mark-bars scene ann mark-id segs)))) (ffirst (scene/mark-bars scene ann mark-id segs))))
@ -499,7 +500,7 @@
(let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack]))) (let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack])))
(some (fn [[gid g]] (when (:draft g) [gid g])) (some (fn [[gid g]] (when (:draft g) [gid g]))
(get-in db [:scene :groups]))) (get-in db [:scene :groups])))
ctx (scene/home (:scene db) ann) ctx (get-in db [:view :edit-context])
local (when ann (mark-start-local db ann mark-id)) local (when ann (mark-start-local db ann mark-id))
db (cond-> db db (cond-> db
ann (start-drawing-db ann mark-id) ann (start-drawing-db ann mark-id)
@ -659,10 +660,10 @@
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))] (assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
(let [ctx (peek (get-in db [:view :stack]))] (let [ctx (peek (get-in db [:view :stack]))]
{:type :annotation :in [ctx] ; filed under the context it's born in {:type :annotation :in [ctx] ; filed under the context it's born in
:draft :new :name "" :color "#4e8fc2" :marks [] :draft :new :name "" :color "#4e8fc2" :marks []}))
:v scene/schema-version}))
(assoc-in [:view :pt] :new) (assoc-in [:view :pt] :new)
(assoc-in [:view :active-mark] nil) (assoc-in [:view :active-mark] nil)
(assoc-in [:view :edit-context] (peek (get-in db [:view :stack])))
(assoc-in [:view :draft-stage] :choosing)))) (assoc-in [:view :draft-stage] :choosing))))
;; commit a fresh draft to "create new": name it and reveal the full form (color, ;; commit a fresh draft to "create new": name it and reveal the full form (color,
@ -672,24 +673,15 @@
(-> db (assoc-in [:scene :groups gid :name] title) (-> db (assoc-in [:scene :groups gid :name] title)
(assoc-in [:view :draft-stage] :creating)))) (assoc-in [:view :draft-stage] :creating))))
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit) (rf/reg-event-db ::edit-draft
(fn [db [_ gid]]
(-> db
(assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :edit-context] (peek (get-in db [:view :stack])))
(assoc-in [:view :pt] :new)))) (assoc-in [:view :pt] :new))))
;; Edit an annotation from a card. If its primary home isn't the context being (rf/reg-event-fx ::edit-annotation
;; viewed, enter that home first so mark rows/handles edit in their authored (fn [_ [_ gid]] {:dispatch [::edit-draft gid]}))
;; coordinate system. finish-edit pops this temporary context.
(rf/reg-event-fx
::edit-annotation
(fn [{:keys [db]} [_ gid]]
(let [home (scene/home (:scene db) gid)
ctx (peek (get-in db [:view :stack]))
push-home? (and home (not= home ctx))
fx (if push-home? (enter-ctx db #(conj % home)) {:db db})]
(update fx :db #(cond-> (-> %
(assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
(assoc-in [:view :edit-pop-parent] nil))
push-home? (assoc-in [:view :edit-pop-parent] home))))))
;; Edit the annotation you're currently inside: drop into its parent timeline so ;; Edit the annotation you're currently inside: drop into its parent timeline so
;; its marks are editable there, remembering to pop back when done. Root has no ;; its marks are editable there, remembering to pop back when done. Root has no
@ -700,22 +692,21 @@
fx (if root? {:db db} (enter-ctx db pop))] fx (if root? {:db db} (enter-ctx db pop))]
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit) (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new) (assoc-in [:view :pt] :new)
(assoc-in [:view :edit-context] (peek (get-in % [:view :stack])))
(assoc-in [:view :edit-return] (when-not root? gid))))))) (assoc-in [:view :edit-return] (when-not root? gid)))))))
(rf/reg-event-fx ::finish-edit (rf/reg-event-fx ::finish-edit
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
;; leaving the form (save OR cancel): tear down all authoring ;; leaving the form (save OR cancel): tear down all authoring
;; transients so draw mode / pending points don't linger. ;; transients so draw mode / pending points don't linger.
(let [return-g (get-in db [:view :edit-return]) (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) db (-> db (assoc-in [:view :draw] nil)
(assoc-in [:view :active-mark] nil) (assoc-in [:view :active-mark] nil)
(assoc-in [:view :pt] nil) (assoc-in [:view :pt] nil)
(assoc-in [:view :draft-stage] nil) (assoc-in [:view :draft-stage] nil)
(assoc-in [:view :edit-return] nil) (assoc-in [:view :edit-return] nil)
(assoc-in [:view :edit-pop-parent] nil))] (assoc-in [:view :edit-context] nil))]
(cond (cond
return-g (enter-ctx db #(conj % return-g)) return-g (enter-ctx db #(conj % return-g))
pop? (enter-ctx db #(if (> (count %) 1) (pop %) %))
:else {:db db})))) :else {:db db}))))
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt))) (rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
;; cancelling a draft is local only; saving a real annotation / deleting one ;; cancelling a draft is local only; saving a real annotation / deleting one
@ -728,21 +719,13 @@
(rf/reg-event-fx (rf/reg-event-fx
::save-group ::save-group
(fn [{:keys [db]} [_ gid g orig]] (fn [{:keys [db]} [_ gid g orig]]
(let [g (cond-> (editable-group g) (let [g (editable-group g)
(= :annotation (:type g)) (assoc :v scene/schema-version))
patch (group-patch orig g) patch (group-patch orig g)
root? (= :timeline (:type g)) ; the root timeline persists whole root? (= :timeline (:type g)) ; the root timeline persists whole
id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks) id (get-in db [:project :id])]
;; proxies this annotation references are synthetic clips in the pool —
;; persist them alongside it or the {:ref proxy} marks dangle on reload.
proxies (into {} (keep (fn [m]
(let [pid (get-in m [:start :ref])
pg (get-in db [:scene :groups pid])]
(when (= :proxy (:type pg)) [pid pg])))
(:marks g)))]
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))} (cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))}
(and id (or (seq patch) (seq proxies))) (and id (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed (merge {gid (if root? g patch)} proxies)} (assoc :http-xhrio (api/put-scene id {:changed {gid (if root? g patch)}}
{:on-success [::scene-saved] {:on-success [::scene-saved]
:on-failure [::save-error]})))))) :on-failure [::save-error]}))))))
(rf/reg-event-fx ::delete-annotation (rf/reg-event-fx ::delete-annotation
@ -753,24 +736,7 @@
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]} id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
{:on-success [::scene-saved] {:on-success [::scene-saved]
:on-failure [::save-error]})))))) :on-failure [::save-error]}))))))
;; --- membership edges (:in): file an annotation under mark-groups ---------- ;; --- visibility edges ----------------------------------------------------
;; 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 (rf/reg-event-db
::ann-drag-start ::ann-drag-start
@ -798,29 +764,16 @@
{:on-success [::scene-saved] {:on-success [::scene-saved]
:on-failure [::save-error]}))))) :on-failure [::save-error]})))))
;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps (defn- file-edge [db gid target add? source]
;; existing edges (link); otherwise the edge you grabbed is moved off its source. (let [g (get-in db [:scene :groups gid])
;; Marks are untouched either way. edges (if add? (:in g) (remove #{source} (:in g)))
(defn- file-edge [db gid new-parent add? source] next-edges (vec (distinct (cond-> (vec edges) target (conj target))))
(let [scene (:scene db) db (update db :view dissoc :dragging-ann :dragging-ann-source)]
g (get-in scene [:groups gid]) (if (and (= :annotation (:type g)) (not (:draft g)) (not= gid target)
in (vec (:in g)) (or (nil? target)
clear #(-> % (assoc-in [:view :dragging-ann] nil) (contains? #{:annotation :timeline} (get-in db [:scene :groups target :type]))))
(assoc-in [:view :dragging-ann-source] nil))] (persist-group db gid g (assoc g :in next-edges))
(if (or (not= :annotation (:type g)) ; only annotations file {:db db})))
(:draft g) ; not mid-draft
(= gid new-parent) ; not under itself
(contains? (set in) new-parent) ; already filed there
(files-under? scene new-parent gid #{})) ; would make a cycle
{:db (clear db)}
(let [in' (if add?
(conj in new-parent) ; link: append, primary unchanged
(let [rest* (vec (remove #{source} in))]
(if (= source (first in))
(into [new-parent] rest*) ; moved the primary → new home
(conj rest* new-parent))))
g* (assoc g :in in')]
(update (persist-group db gid g g*) :db clear)))))
(rf/reg-event-fx (rf/reg-event-fx
::reparent ::reparent
@ -833,69 +786,33 @@
(fn [{:keys [db]} [_ gid target]] (fn [{:keys [db]} [_ gid target]]
(file-edge db gid target true nil))) (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
(rf/reg-event-fx
::unfile
(fn [{:keys [db]} [_ gid target]] (fn [{:keys [db]} [_ gid target]]
(let [g (get-in db [:scene :groups gid]) (file-edge db gid nil false target)))
in (vec (:in g))]
(if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1))
{:db db}
(persist-group db gid g (assoc g :in (vec (remove #{target} in))))))))
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil))) (rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
(rf/reg-event-db ::save-error (rf/reg-event-db ::save-error
(fn [db [_ failure]] (fn [db [_ failure]]
(assoc db :save-error (api/error-message failure "Couldn't save your changes — they're unsaved.")))) (assoc db :save-error (api/error-message failure "Couldn't save your changes — they're unsaved."))))
;; click a clip while authoring: first click sets a pending start, the second
;; completes the span as a run of single-clip marks. `frame` (mark time) is
;; optional — clicking a clip uses whole-clip defaults (0 / clip end), clicking
;; the video frame-readout passes the exact frame under the playhead.
;; Unset one endpoint of an existing mark to re-pick it: seed the pending-point
;; state with the endpoint we're keeping, so the existing "one end set, click the
;; other" UI takes over. We stash the original mark (:mark) + its slot (:i) so the
;; rebuilt mark keeps its id — and thus its note/drawing bindings (see the repick
;; branch of ::draft-click-seg). selection->marks re-sorts by min/max, so it
;; doesn't matter that the kept end was the start or the end.
(rf/reg-event-db (rf/reg-event-db
::unset-endpoint ::unset-endpoint
(fn [db [_ gid i which]] (fn [db [_ gid mark-id which]]
(let [marks (get-in db [:scene :groups gid :marks]) (let [segs (scene/content-segments (:scene db) (get-in db [:view :edit-context]))
mark (get marks i) [lo hi] (scene/mark-extent (:scene db) gid mark-id segs)]
keep (if (= which :start) (:end mark) (:start mark))] (assoc-in db [:view :pt] {:mark-id mark-id :which which
(-> db (assoc-in [:scene :groups gid :marks] :keep (if (= which :start) hi lo)}))))
(into (subvec marks 0 i) (subvec marks (inc i))))
(assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i i})))))
;; clear ONE endpoint of a proxy mark to re-pick it: remember the OPPOSITE
;; endpoint's ctx-local position (kept fixed) so the next clip-click only rerolls
;; the cleared side — the kept end never turns into the start (the old swap bug).
(rf/reg-event-db
::unset-proxy-endpoint
(fn [db [_ gid mark-id pid which]]
(let [scene (:scene db)
ctx (scene/home scene gid)
segs (scene/content-segments scene ctx)
[lo hi] (scene/mark-extent scene gid mark-id segs)]
(assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)}))))
;; complete a selection on the active draft: wrap the run [lo hi) in a proxy (a
;; synthetic clip), give the annotation one mark referencing it, make it active,
;; seek to its start, and drop into drawing mode ("select a range → you're drawing").
(defn- select-range-fx [db gid g lo hi] (defn- select-range-fx [db gid g lo hi]
(let [scene (:scene db) (let [ctx (get-in db [:view :edit-context])
p (scene/make-proxy scene (scene/home scene gid) lo hi) mark (scene/make-mark (:scene db) ctx lo hi)
pgid (keyword (str "prox-" (random-uuid))) sf (scene/local->source (scene/content-segments (:scene db) ctx) lo)]
mid (str (random-uuid)) {:db (-> db (update-in [:scene :groups gid :marks] conj mark)
sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)] (assoc-in [:view :active-mark] (:id mark))
{:db (-> db (assoc-in [:scene :groups pgid] p) (assoc-in [:view :playheads ctx] lo)
(update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid))
(assoc-in [:view :active-mark] mid)
(assoc-in [:view :playheads (scene/home scene gid)] lo)
(assoc-in [:view :pt] :new)) (assoc-in [:view :pt] :new))
:player/seek (when sf (/ sf (:fps db))) :player/seek (when sf (/ sf (:fps db)))
:fx [[:dispatch [::start-drawing gid mid]]]})) :fx [[:dispatch [::start-drawing gid (:id mark)]]]}))
;; drag a region directly on the timeline (context-local frames) → one selection. ;; drag a region directly on the timeline (context-local frames) → one selection.
(rf/reg-event-fx (rf/reg-event-fx
@ -911,115 +828,63 @@
(fn [{:keys [db]} [_ seg-id frame]] (fn [{:keys [db]} [_ seg-id frame]]
(let [scene (:scene db) (let [scene (:scene db)
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene)) [gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
segs (scene/content-segments scene (scene/home scene gid)) ctx (get-in db [:view :edit-context])
segs (scene/content-segments scene ctx)
pt (get-in db [:view :pt])] pt (get-in db [:view :pt])]
(cond (if (map? pt)
;; re-picking one endpoint of a proxy: roll only that side, keep the other (let [a (if (:mark-id pt) (:keep pt) (scene/seg-local segs (:seg pt) (:f pt)))
(:proxy pt)
(let [proxy (get-in scene [:groups (:proxy pt)])
new-local (if (= (:which pt) :start)
(scene/seg-local segs seg-id (or frame 0))
(scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))))
keep (:keep pt)
lo (scene/assert-frame "proxy range start" (min new-local keep))
hi (scene/assert-frame "proxy range end" (max new-local keep))]
{:db (-> db (assoc-in [:scene :groups (:proxy pt)]
(scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi)))
(assoc-in [:view :pt] :new))})
(map? pt)
(let [a (scene/seg-local segs (:seg pt) (:f pt))
b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))) b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))
lo (min a b) hi (max a b) lo (min a b) hi (max a b)]
old (:mark pt)] (if-let [mid (:mark-id pt)]
(if old {:db (-> db
;; re-picking an endpoint: reconcile-run keeps the mark id for the (update-in [:scene :groups gid :marks]
;; piece on the kept clip; re-attach that mark's bindings, and splice (fn [marks] (mapv #(if (= mid (:id %))
;; the run back into its original slot so order is preserved. (assoc % :parts (scene/selection->parts scene ctx lo hi)) %)
(let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi) marks)))
(mapv (fn [m] (if (= (:id m) (:id old)) (assoc-in [:view :pt] :new))}
(cond-> m
(:notes old) (assoc :notes (:notes old))
(:drawings old) (assoc :drawings (:drawings old)))
m))))
i (:i pt)]
{:db (-> db (update-in [:scene :groups gid :marks]
#(into (into (subvec % 0 i) run) (subvec % i)))
(assoc-in [:view :pt] :new))})
;; new selection (two-click): same completion as a timeline drag.
(select-range-fx db gid g lo hi))) (select-range-fx db gid g lo hi)))
:else
{:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})})))) {:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})}))))
;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned (rf/reg-event-db ::remove-mark
;; proxy group too (a draft's proxies are local until save, so a db-only dissoc
;; is enough — a saved-annotation edit will diff it away on Save).
(rf/reg-event-db
::remove-mark
(fn [db [_ gid i]] (fn [db [_ gid i]]
(let [marks (get-in db [:scene :groups gid :marks]) (update-in db [:scene :groups gid :marks]
pid (get-in marks [i :start :ref]) #(into (subvec % 0 i) (subvec % (inc i))))))
prox? (= :proxy (get-in db [:scene :groups pid :type]))]
(cond-> (update-in db [:scene :groups gid :marks]
#(into (subvec % 0 i) (subvec % (inc i))))
prox? (update-in [:scene :groups] dissoc pid)))))
;; live lane edit of a proxy mark: re-derive its run for a new context-local
;; range [la lb) (whole-mark move, or one edge dragged). roll-proxy reuses the
;; ids of interior pieces (stable), adds/drops boundary marks as edges cross clip
;; boundaries. The annotation's {:ref proxy} mark and its drawing bindings never
;; move; only the proxy's internals change. Persists on the annotation's Save.
(rf/reg-event-db (rf/reg-event-db
::reroll-proxy ::resize-mark
(fn [db [_ ann mark-id la lb]] (fn [db [_ gid mid la lb]]
(let [scene (:scene db) (let [scene (:scene db)
pid (->> (get-in scene [:groups ann :marks])
(some #(when (= mark-id (:id %)) (get-in % [:start :ref]))))
proxy (get-in scene [:groups pid])
;; roll against the VIEWED timeline (top of the stack), NOT the annotation's
;; :parent — the drag's frames are local to what you're looking at, and a
;; transcluded mark is being edited from a context other than its parent.
;; For a normal (non-transcluded) mark the two are the same.
ctx (peek (get-in db [:view :stack])) ctx (peek (get-in db [:view :stack]))
len (scene/length (scene/content-segments scene ctx)) len (scene/length (scene/content-segments scene ctx))
la (scene/assert-frame "proxy roll start" la) lo (max 0 (min (scene/assert-frame "range start" la) (dec len)))
lb (scene/assert-frame "proxy roll end" lb) hi (max (inc lo) (min (scene/assert-frame "range end" lb) len))]
la* (max 0 (min la (dec len))) (update-in db [:scene :groups gid :marks]
lb* (max (inc la*) (min lb len))] (fn [marks] (mapv #(if (= mid (:id %))
(if (= :proxy (:type proxy)) (assoc % :parts (scene/selection->parts scene ctx lo hi)) %)
(assoc-in db [:scene :groups pid] (scene/roll-proxy scene ctx proxy la* lb*)) marks))))))
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 (rf/reg-event-db
::set-proxy-frame ::set-mark-frame
(fn [db [_ pid which frame]] (fn [db [_ gid mid which frame]]
(let [frame (scene/assert-frame "proxy endpoint frame" frame) (update-in db [:scene :groups gid :marks]
marks (get-in db [:scene :groups pid :marks]) (fn [marks]
idx (if (= which :start) 0 (dec (count marks)))] (mapv (fn [m]
(assoc-in db [:scene :groups pid :marks idx which :at] frame)))) (if (= mid (:id m))
(let [i (if (= which :start) 0 (dec (count (:parts m))))]
(assoc-in m [:parts i which]
(scene/assert-frame "endpoint frame" frame)))
m)) marks)))))
;; transclusion: instead of creating a new annotation, append the draft's marks ;; Adding footage and making it visible in the authoring context is one edit.
;; 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
;; shell (never saved); further tweaks in the reopened form diff against this state.
(rf/reg-event-fx (rf/reg-event-fx
::associate-marks ::associate-marks
(fn [{:keys [db]} [_ draft-gid target-gid]] (fn [{:keys [db]} [_ draft-gid target-gid]]
(let [marks (get-in db [:scene :groups draft-gid :marks]) (let [marks (get-in db [:scene :groups draft-gid :marks])
orig-t (get-in db [:scene :groups target-gid]) orig-t (get-in db [:scene :groups target-gid])
;; adding marks does NOT change placement — membership is asserted, never target (-> orig-t
;; derived from where marks were authored. To also list C in this context, (update :marks (fnil into []) marks)
;; file it in explicitly (the ＋ picker / drag). (update :in #(vec (distinct (conj (vec %) (get-in db [:view :edit-context]))))))
target (update orig-t :marks (fnil into []) marks)
patch (group-patch orig-t target) ; just the :marks change patch (group-patch orig-t target) ; just the :marks change
proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref])
pg (get-in db [:scene :groups pid])]
(when (= :proxy (:type pg)) [pid pg])))
marks))
id (get-in db [:project :id]) id (get-in db [:project :id])
db (-> db db (-> db
(assoc-in [:scene :groups target-gid] (assoc target :draft :edit)) (assoc-in [:scene :groups target-gid] (assoc target :draft :edit))
@ -1029,6 +894,6 @@
(assoc :save-error nil))] (assoc :save-error nil))]
(cond-> {:db db} (cond-> {:db db}
(and id (seq patch)) (and id (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed (merge {target-gid patch} proxies)} (assoc :http-xhrio (api/put-scene id {:changed {target-gid patch}}
{:on-success [::scene-saved] {:on-success [::scene-saved]
:on-failure [::save-error]})))))) :on-failure [::save-error]}))))))

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

@ -1,21 +1,8 @@
(ns tl.scene (ns tl.scene
"The scene graph: a flat pool of mark-groups (the only non-mark-group thing is "Annotations own ordered marks; marks own ordered root-clip slices.
:tracks). Everything here is pure — see data_model.org. :in contains visibility edges only. All frame ranges are integer [start,end)."
Conventions
- ranges are HALF-OPEN [start end); length = end - start.
- a point is either
<number> absolute: a frame in the mark's OWNING context
{:ref id :at n} relative: frame n of id's resolved range
(n>=0 from the start; n<0 from the end, -1 = the
exclusive end, -2 = last actual frame)
- a ref mark's :start and :end target the SAME id ⇒ exactly one segment;
an absolute mark may resolve to several (slice over its parent).
- resolve ⇒ ordered segments {:mark id :track t :src [a b] :local [c d]}."
(:refer-clojure :exclude [resolve])) (:refer-clojure :exclude [resolve]))
(defn- grp [scene gid] (get-in scene [:groups gid]))
(defn frame? (defn frame?
"True when `n` is a concrete integer frame coordinate." "True when `n` is a concrete integer frame coordinate."
[n] [n]
@ -38,17 +25,10 @@
(throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi]))))) (throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi])))))
[lo hi]) [lo hi])
(defn- find-mark
"[owning-gid mark] for a mark id anywhere in the scene, or nil."
[scene mid]
(some (fn [[gid g]]
(some (fn [m] (when (= mid (:id m)) [gid m])) (:marks g)))
(:groups scene)))
;; --- flat helpers over resolved segments --------------------------------- ;; --- flat helpers over resolved segments ---------------------------------
(defn length [segs] (defn length [segs]
(if (seq segs) (-> segs last :local second) 0)) (reduce max 0 (map (comp second :local) segs)))
(defn local->source (defn local->source
"The source frame shown at local frame `lf` (clamped to the end)." "The source frame shown at local frame `lf` (clamped to the end)."
@ -82,7 +62,8 @@
(assert-range "segment local" local) (assert-range "segment local" local)
(let [[a b] src [c _] local (let [[a b] src [c _] local
lo (max sa a) hi (min sb b)] lo (max sa a) hi (min sb b)]
(when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))]))) (when (or (< lo hi) (and (= sa sb) (<= a sa) (< sa b)))
[(+ c (- lo a)) (+ c (- hi a))])))
segs))) segs)))
(defn merge-bars (defn merge-bars
@ -110,7 +91,7 @@
(assert-range "segment local" local) (assert-range "segment local" local)
(let [[a _] src [c d] local (let [[a _] src [c d] local
lo (max la c) hi (min lb d)] lo (max la c) hi (min lb d)]
(when (< lo hi) (when (or (< lo hi) (and (= la lb) (<= c la) (< la d)))
(cond-> (assoc seg :local [lo hi] (cond-> (assoc seg :local [lo hi]
:src [(+ a (- lo c)) (+ a (- hi c))]) :src [(+ a (- lo c)) (+ a (- hi c))])
(:thumb-start seg) (update :thumb-start + (- lo c)))))) (:thumb-start seg) (update :thumb-start + (- lo c))))))
@ -118,640 +99,181 @@
(defn tracks [segs] (into #{} (keep :track segs))) (defn tracks [segs] (into #{} (keep :track segs)))
;; --- resolution ----------------------------------------------------------
(declare resolve resolve-mark home child-of?) (defn- clip-segment [scene {:keys [clip start end]}]
(let [{:keys [type source duration track]} (get-in scene [:groups clip])]
(assert-range "clip slice" [start end])
(when (and (= type :clip) (<= 0 start end duration))
{:thumb clip :thumb-start start :track track
:src [(+ source start) (+ source end)] :local [0 (- end start)]})))
(defn- target-segs (defn- concatenate [segments]
"Resolved segments (local 0-based) of a referenceable id: a group (clip, (reduce (fn [out {:keys [local] :as segment}]
timeline, proxy, annotation) or a single mark. One segment for a clip/subclip (let [offset (or (some-> out peek :local second) 0)]
by the ref invariant; several for a proxy or an arrangement group." (conj out (assoc segment :local [offset (+ offset (- (second local) (first local)))]))))
[scene id] [] segments))
(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))
;; --- ref :at <-> source : the ONE interpretation of a ref's :at ----------- (defn resolve-mark [scene _ {:keys [id parts]}]
;; {:ref id :at n}'s :at is a LOCAL frame of id's OWN resolved timeline (n<0 from (mapv #(assoc % :mark id) (concatenate (keep #(clip-segment scene %) parts))))
;; the end, -1 = the exclusive end). Every :at<->frame conversion goes through
;; id's FULL resolution (target-segs) + the flat helpers, so it is correct whether
;; id is one clip or a scattered multi-clip proxy. Do NOT summarise a target to a
;; single [xs xe] span — that only holds for a single contiguous segment.
(defn- ref-len [scene ref] (length (target-segs scene ref)))
(defn- at->local
"Normalise a ref's :at (n<0 from the end) to a non-negative local frame."
[scene ref at]
(if (neg? at) (+ (ref-len scene ref) at 1) at))
(defn- at->src
"Source frame at ref point {:ref :at} — id's own local frame → source — or nil
if the ref dangles or the frame falls outside id."
[scene ref at]
(when-let [segs (seq (target-segs scene ref))]
(let [l (at->local scene ref at)]
(when (<= 0 l (length segs))
(local->source segs l)))))
(defn- src->at
"Target-local :at for source frame `src` within `ref` — source → id's own
local frame — or nil if outside id."
[scene ref src]
(some-> (seq (target-segs scene ref)) (source->local src)))
(defn- point-frame
"Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref
dangles."
[scene gid point]
(cond
(number? point)
(let [parent (home scene gid)]
{:frame (if parent (local->source (resolve scene parent) point) point)
:track nil})
(map? point)
(when-let [f (at->src scene (:ref point) (:at point))] ; nil if dangling / out of range
{:frame f})))
(defn- shift-local
"Shift `sub`'s :local so the run starts at 0, WITHOUT touching :mark — pieces keep
the identity of the target they were sliced from. This is the RAW recursion's
output; content-segments uses it so a multi-clip mark stays a run of
individually-addressable clips (their own name/length/ref)."
[sub]
(let [base (or (some-> sub first :local first) 0)]
(mapv (fn [s] (let [[c d] (:local s)]
(assoc s :local [(- c base) (- d base)])))
sub)))
(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."
[tsegs la]
(let [la* (min la (max 0 (dec (length tsegs))))]
(when-let [s (first (slice tsegs la* (inc la*)))]
(let [[c _] (:local s) [a _] (:src s)]
[(assoc s :local [c c] :src [a a])]))))
(defn resolve-mark
"One mark → its segment(s) (1 for a single-clip ref, 1+ for a proxy/arrangement
ref or an absolute mark), with :local 0-based within the mark. A ref mark
slices its target's resolved timeline in the target's LOCAL frames (:at n,
n<0 from the end), so a scattered-source proxy resolves piece-by-piece just
like a contiguous clip does. nil when a ref dangles or falls out of range."
[scene gid {:keys [id start end track]}]
(if (map? start) ; ref mark (same target both ends)
(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))
(rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
(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)]
:thumb (when (= :clip (:type (grp scene gid))) gid)
:thumb-start 0}]))))
(defn resolve (defn resolve
"A mark-group → its local timeline: ordered segments laid end to end. Broken "Compile a group to source segments. Visibility never participates."
marks (dangling refs) are skipped."
[scene gid] [scene gid]
(loop [[m & more] (:marks (grp scene gid)), off 0, out []] (let [{:keys [type marks duration]} (get-in scene [:groups gid])]
(if (nil? m) (case type
out :clip (if-let [seg (clip-segment scene {:clip gid :start 0 :end duration})]
(if-let [segs (seq (resolve-mark scene gid m))] [(assoc seg :mark gid)] [])
(let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs)) :timeline (->> (:groups scene)
shifted (mapv (fn [s] (let [[c d] (:local s)] (keep (fn [[id {:keys [type start]}]]
(assoc s :local [(+ off c) (+ off d)]))) (when (= type :clip)
segs)] (let [seg (first (resolve scene id))]
(recur more (+ off len) (into out shifted))) (assoc seg :local [start (+ start (length [seg]))])))))
(recur more off out))))) (sort-by (comp first :local)) vec)
:annotation (concatenate (mapcat #(resolve-mark scene gid %) marks))
(defn mark-bars [])))
"Local (context) bars for one mark of annotation `ann-gid`, given the context's
content-segments — where that single mark lands in the current timeline. Drives
the per-mark playhead-in-range tests (script-note »»» and drawing visibility)."
[scene ann-gid mark-id ctx-segs]
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))
(filter #(= mark-id (:mark %)) (resolve scene ann-gid)))))
(defn broken-marks
"Mark ids in `gid` whose refs no longer resolve."
[scene gid]
(->> (:marks (grp scene gid))
(filterv (fn [m] (empty? (resolve-mark scene gid m))))
(mapv :id)))
(defn broken-reason
"A short why for `gid`'s first broken mark, or nil if nothing's broken."
[scene gid]
(when-let [mid (first (broken-marks scene gid))]
(let [ref (->> (:marks (grp scene gid)) (some #(when (= mid (:id %)) %)) :start :ref)]
(if (seq (target-segs scene ref)) "reference trimmed away" "referenced clip deleted"))))
;; --- what the current timeline is made of --------------------------------
(defn- content-mark-segs
"Context-local pieces of mark `m` for content-segments. A ref into a PROXY drills
in and exposes the proxy's per-clip run, each sub-clip mark kept individually
addressable (its own name/length/ref/trim, via shift-local) — instead of
collapsing every piece under `m`'s single id the way resolve does for the LANE
view (rebase). That collapse was the bug: drilling into a proxy-backed range made
every clip read with the FIRST piece's name + length, so sub-range selections
wouldn't save. Any OTHER mark — a plain clip ref, a single mark ref, an absolute
mark — is one piece and stays owned by `m` (resolve-mark), so nested marks there
remain annotation-relative, exactly as before this fix."
[scene gid {:keys [start end] :as m}]
(if (and (map? start) (= :proxy (:type (grp scene (:ref start)))))
(when-let [tsegs (seq (target-segs scene (:ref start)))]
(let [len (length tsegs)
at->l #(if (neg? %) (+ len % 1) %)
la (at->l (:at start))
lb (at->l (:at end))]
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
(shift-local (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
(resolve-mark scene gid m)))
(defn- content-resolve
"`resolve` for content-segments: lays a group's marks end to end, but each piece
keeps its underlying :mark (see content-mark-segs) so multi-clip marks don't
collapse to one addressable unit."
[scene gid]
(loop [[m & more] (:marks (grp scene gid)), off 0, out []]
(if (nil? m)
out
(if-let [segs (seq (content-mark-segs scene gid m))]
(let [len (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs))
shifted (mapv (fn [s] (let [[c d] (:local s)]
(assoc s :local [(+ off c) (+ off d)])))
segs)]
(recur more (+ off len) (into out shifted)))
(recur more off out)))))
(defn content-segments (defn content-segments
"The clip-segments that make up context `ctx` — what you draw and select "Occurrence IDs belong to the view; persisted slices always identify raw clips."
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] [scene ctx]
(if (= :timeline (:type (grp scene ctx))) (mapv (fn [i seg] (assoc seg :mark [ctx i])) (range) (resolve scene ctx)))
(->> (:groups scene)
(keep (fn [[gid g]]
(when (= :clip (:type g))
(let [seg (first (resolve scene gid))
[sa sb] (:src seg)
st (:start g 0)]
(assoc seg :mark gid :local [st (+ st (- sb sa))])))))
(sort-by (comp first :local))
vec)
(content-resolve scene ctx)))
(defn- src-intersect (defn project-bars
"Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))." "Project onto every matching clip occurrence; merge only context-contiguous pieces."
[rs cover] [segments context]
(vec (for [[a b] rs [c d] cover (merge-bars
:let [lo (max a c) hi (min b d)] (mapcat (fn [{:keys [thumb] [a b] :src}]
:when (< lo hi)] (pieces (filter #(= thumb (:thumb %)) context) a b))
[lo hi]))) segments)))
(defn lane-bars (defn mark-bars [scene gid mid context]
"Context-local display bars for annotation `gid`, grouped PER MARK: contiguous (project-bars (filter #(= mid (:mark %)) (resolve scene gid)) context))
pieces coalesce WITHIN a mark but never across marks, so two abutting-but-
distinct marks stay separate bars — the lane bar matches each mark's highlight
1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id
lets the lane hit-test / highlight / edit one mark; consumers that only want
the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments.
`resolve` already trims each mark through its whole ref chain — a nested mark (defn lane-bars [scene gid context]
is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ … (vec (mapcat (fn [{:keys [id] :as mark}]
⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs` (map (fn [[lo hi]] [lo hi id])
is all the clipping needed (no ancestor re-walk — that was redundant)." (project-bars (resolve-mark scene gid mark) context)))
[scene gid ctx-segs] (get-in scene [:groups gid :marks]))))
(->> (resolve scene gid)
(partition-by :mark)
(mapcat (fn [ss]
(let [mid (:mark (first ss))]
(map (fn [[lo hi]] [lo hi mid])
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss))))))
vec))
(defn mark-extent (defn mark-extent [scene gid mid context]
"EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true (let [bars (mark-bars scene gid mid context)]
min piece-start / max piece-end, without merge-bars. Endpoint editing must use (when (seq bars) [(ffirst bars) (second (last bars))])))
this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` =
content-segments of ctx."
[scene gid mark-id ctx-segs]
(let [pcs (->> (resolve scene gid)
(filter #(= mark-id (:mark %)))
(mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))]
(when (seq pcs)
[(reduce min (map first pcs)) (reduce max (map second pcs))])))
;; --- placement: :in membership edges -------------------------------------- (defn broken-marks [scene gid]
;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered (->> (get-in scene [:groups gid :marks])
;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under (filter #(or (empty? (:parts %))
;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in (some (fn [part] (nil? (clip-segment scene part))) (:parts %))))
;; it. The FIRST element is the primary home (where its :content links resolve and (mapv :id)))
;; 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 (defn broken-reason [scene gid]
"The primary home of `gid`: the first `:in` edge for an annotation (where its (when (seq (broken-marks scene gid)) "missing clip or invalid range"))
description links resolve and where it's edited); the structural `:parent` for
anything else (nil for the flat clip/proxy pool and the root timeline)."
[scene gid]
(let [g (grp scene gid)]
(if (= :annotation (:type g)) (first (:in g)) (:parent g))))
(defn membership (defn membership [scene gid]
"The set of mark-groups annotation `gid` is filed under (its `:in` edges)." (set (get-in scene [:groups gid :in])))
[scene gid]
(set (:in (grp scene gid))))
(defn child-of? (defn child-of? [scene ctx gid]
"Is annotation `gid` filed under `ctx`?"
[scene ctx gid]
(contains? (membership scene gid) ctx)) (contains? (membership scene gid) ctx))
(defn clip-loss? (defn selection->parts [scene ctx lo hi]
"True when annotation `gid` loses content once clipped to its primary home — it (mapv (fn [{:keys [thumb thumb-start] [a b] :src}]
references frames outside that parent annotation, so it's (partly) out of range {:clip thumb :start thumb-start :end (+ thumb-start (- b a))})
there. Timeline/root homes contain everything, so they never warn." (slice (content-segments scene ctx) lo hi)))
[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))))))
;; --- editing: split a local selection into a run of single-clip marks ----- (defn make-mark [scene ctx lo hi]
{:id (keyword (str (random-uuid))) :parts (selection->parts scene ctx lo hi)})
(defn selection->marks (defn seg-length [segs mid]
"Split local range [la lb) of context `ctx` into a run of single-clip ref (some (fn [{m :mark [lo hi] :local}] (when (= m mid) (- hi lo))) segs))
marks, one per content segment it crosses (the 'no cross-clip marks' rule).
Each references the segment's source id with the right offsets. Inputs and
derived offsets must already be integer frames."
[scene ctx la lb]
(assert-range "selection" [la lb])
(mapv (fn [{:keys [mark src]}]
;; :at is the target's OWN local frame (src->at), matching resolve-mark's
;; slice — correct even when the target is a scattered multi-clip proxy.
;; The piece lies within one target segment, so its length maps 1:1.
(let [[a b] src
a' (src->at scene mark a)]
{:id (str (random-uuid)) ; string so it survives JSON
:start {:ref mark :at (assert-frame "selection start offset" a')}
:end {:ref mark :at (assert-frame "selection end offset" (+ a' (- b a)))}}))
(slice (content-segments scene ctx) la lb)))
(defn reconcile-run (defn seg-local [segs mid frame]
"Re-derive the run for selection [la lb), REUSING the id of any `old-run` mark (some (fn [{m :mark [lo _] :local}] (when (= m mid) (+ lo (or frame 0)))) segs))
that targets the same segment — so resizing a selection keeps ids stable
(middle pieces untouched, boundary pieces edited in place), drops pieces that
fall out, and gives fresh ids to new ones. This is the merge/unmerge the
annotation editor needs; it never touches the model, just chooses ids."
[scene ctx old-run la lb]
(let [by-ref (into {} (map (juxt #(get-in % [:start :ref]) :id)) old-run)]
(mapv (fn [m] (if-let [id (by-ref (get-in m [:start :ref]))]
(assoc m :id id)
m))
(selection->marks scene ctx la lb))))
;; --- proxy synthetic-clips ------------------------------------------------ (defn- restore-mark [mark]
;; A proxy is a mark-group {:type :proxy} in the flat pool whose marks are the (cond-> (-> mark (update :id keyword)
;; per-clip run of a selection (selection->marks). An annotation references the (update :parts #(mapv (fn [part] (update part :clip keyword)) %)))
;; WHOLE proxy with a single mark {:ref P :at 0 → :at -1}, so the pane shows one (:notes mark) (update :notes #(mapv keyword %))
;; collapsed row and the lane one bar, while endpoint edits mutate the proxy's (:drawings mark) (update :drawings #(mapv keyword %))))
;; internal run in place — stable interior ids, boundary marks added/dropped
;; (see reconcile-run). Because resolve-mark slices its target, the annotation's
;; one mark resolves through the proxy to the underlying clips piece-by-piece.
;; See annotation_flow_plan.md.
(defn make-proxy (defn- restore-group [group]
"A new proxy mark-group for selection [la lb) of context `ctx`. No gid yet — (cond-> (update group :type keyword)
the caller assigns one when inserting it into the pool." (:in group) (update :in #(mapv keyword %))
[scene ctx la lb] (:marks group) (update :marks #(mapv restore-mark %))
{:type :proxy :parent nil :marks (selection->marks scene ctx la lb)}) (:notes group) (update :notes #(mapv keyword %))
(:regions group) (update :regions #(mapv (fn [r] (-> r (update :id keyword)
(defn roll-proxy (update :kind keyword))) %))))
"Re-derive proxy `p`'s run for a new selection [la lb) of `ctx`, reusing the ids
of interior marks that still target the same segment: rolling an endpoint out
adds a fresh boundary mark, rolling in drops one, the middle never churns."
[scene ctx p la lb]
(assoc p :marks (reconcile-run scene ctx (:marks p) la lb)))
(defn proxy-ref
"The single annotation mark referencing the whole proxy `pid` (as if the proxy
had been clicked): local frame 0 to its exclusive end."
[mark-id pid]
{:id mark-id :start {:ref pid :at 0} :end {:ref pid :at -1}})
;; --- mark-time helpers for the two-input annotation editor ----------------
;; The editor works in MARK TIME — a 0-based frame within a VISIBLE content
;; segment — so it already accounts for the segment being trimmed by the parent
;; timeline (we ref the segment's own :mark, whose resolved length is the
;; segment's length). A clip selection start≠end expands, via selection->marks,
;; into a run of single-clip marks.
(defn seg-length
"Length (mark-time frames) of the content segment with :mark = `mid`, or nil."
[segs mid]
(some (fn [{m :mark [c d] :local}] (when (= m mid) (- d c))) segs))
(defn seg-local
"Local (context) frame for mark-time frame `f` within content segment `mid`."
[segs mid f]
(some (fn [{m :mark [c _] :local}] (when (= m mid) (+ c (or f 0)))) segs))
(defn- restore-mark [m]
;; keep :id keyworded in lockstep with the refs that target it: a nested
;; annotation's :ref is another mark's :id, and JSON makes both strings — if we
;; keyword one but not the other they stop matching (ref looks "deleted").
(cond-> m
(:id m) (update :id keyword)
(get-in m [:start :ref]) (update-in [:start :ref] keyword)
(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
(defn- restore-region
"A script-note region loses keyword-ness through JSON: re-keyword :id and :kind."
[r]
(cond-> r
(:id r) (update :id keyword)
(:kind r) (update :kind keyword)))
;; --- schema versioning ----------------------------------------------------
;; Every stored annotation carries :v, its schema version. When the data model
;; changes, bump schema-version and add a transformer that upgrades the previous
;; version's shape to the new one; old annotations migrate forward on load.
(def schema-version 2) ; current annotation schema — bump on any model change
;; transformers[n] upgrades a schema-v(n) annotation to v(n+1) (and must set
;; :v (n+1)). v1→v2 drops the old per-annotation :script rects — script passages
;; are now first-class :script-note entities bound by id (see [[markgroup-model]]).
(def ^:private transformers
{1 (fn [g] (-> g (dissoc :script) (assoc :v 2)))})
(defn migrate
"Upgrade annotation `g` to the current schema-version by chaining transformers.
Pre-versioned data (no :v) is treated as the original v1."
[g]
(loop [g (update g :v #(or % 1))]
(if (>= (:v g) schema-version)
(assoc g :v schema-version)
(recur ((transformers (:v g)) g)))))
(defn restore-annotations (defn restore-annotations
"Re-keywordize the fields that lose their keyword-ness through JSON (string "Decode identifiers in the current JSON format."
:type/:parent and mark :refs), then migrate each annotation to the current [groups]
schema version, before merging into the (keyword-keyed) scene." (update-vals groups restore-group))
[anns]
(into {} (map (fn [[gid g]]
(let [g (-> g (update :type keyword) (update :parent keyword))]
[gid (case (:type g)
:script-note (update g :regions #(mapv restore-region (or % [])))
: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))
(defn display-point (defn marks->rows [_ marks]
"A ref-point {:ref :at} as a display cell {:seg :f}: the target id plus its OWN (mapv (fn [{:keys [parts]}]
local frame (context-local, whole-frame; not translated to the raw clip). The {:s {:seg (:clip (first parts)) :f (:start (first parts))}
shared basis for both the annotation editor rows and the jump popover, so they :e {:seg (:clip (last parts)) :f (:end (last parts))}})
can never disagree on how a point reads." marks))
[scene {:keys [ref at]}]
{:seg ref :f (assert-frame "display point" (at->local scene ref at))})
(defn- clip-row
"Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time."
[scene {:keys [start 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}
directly; a proxy ref collapses to its run's FIRST-clip start and LAST-clip
end (so a cross-clip drag reads as one span), tagged :proxy <pid> so the form
knows to render it as a single unit rather than an editable clip pair."
[scene {:keys [start] :as mark}]
(let [pid (:ref start)]
(if (= :proxy (:type (grp scene pid)))
(let [rows (mapv #(clip-row scene %) (:marks (grp scene pid)))]
{:s (:s (first rows)) :e (:e (last rows)) :proxy pid})
(clip-row scene mark))))
(defn marks->rows
"Render `marks` as editor rows (one per mark, frames normalised to mark time).
1:1 with `marks`, so row i pairs with mark i. Proxy marks collapse to one
row (see mark-row)."
[scene marks]
(mapv #(mark-row scene %) marks))
;; --- tiny view-state helpers (per-context playhead) ----------------------
(defn playhead [view ctx] (get-in view [:playheads ctx] 0)) (defn playhead [view ctx] (get-in view [:playheads ctx] 0))
(defn set-playhead [view ctx lf] (assoc-in view [:playheads ctx] lf)) (defn set-playhead [view ctx frame] (assoc-in view [:playheads ctx] frame))
;; --- seeding from OTIO ---------------------------------------------------- (defn from-otio [{:keys [tracks]}]
(let [video (filter #(= :video (:kind %)) tracks)
clips (for [track video clip (:clips track)]
[(keyword (:id clip))
{:type :clip :name (:name clip) :track (keyword (str "t" (:index track)))
:start (assert-frame "clip position" (:start clip))
:source (assert-frame "clip source" (:media-in clip))
:duration (assert-frame "clip duration" (:duration clip))}])]
{:tracks (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}]) video))
:groups (into {:root {:type :timeline :name "root"}} clips)}))
(defn from-otio (defn clip-name [scene gid] (get-in scene [:groups gid :name]))
"Seed a scene from tl.otio/parse output: a video :track per source track, one (defn ref-length [scene gid] (length (resolve scene gid)))
clip mark-group per clip (source range + track), and the root timeline. The (defn ref-track-name [scene gid]
otio is only a seed — nothing here reads it again. (get-in scene [:tracks (:track (first (resolve scene gid))) :name]))
Clip ranges are integer frame ranges. Fractional OTIO input is rejected before (defn seg-point [_ {:keys [thumb thumb-start]} frame]
this point; from here on, frame math asserts instead of snapping." {:ref thumb :at (+ thumb-start (or frame 0))})
[{: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)]
(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}]})}))
(defn clip-name [scene gid] (:name (grp scene gid))) (defn link-local [scene ctx {:keys [ref at]}]
(assert-frame "link frame" at)
(if (= ref ctx) at
(ffirst (project-bars (slice (resolve scene ref) at at) (content-segments scene ctx)))))
;; --- context-independent labelling (for transcluded mark rows) ------------ (defn jump-targets [scene ctx gid]
;; A mark collected into an annotation from another timeline (transclusion) has a (let [segs (content-segments scene ctx)]
;; ref whose clip isn't in the CURRENT context's content-segments, so the context (mapv (fn [[lo _]]
;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip (let [seg (some (fn [{[a b] :local :as seg}]
;; instead — the mark's own timeline — so the row reads correctly from anywhere. (when (<= a lo (dec b)) seg)) segs)]
{:local lo :seg (:mark seg) :f (- lo (first (:local seg)))}))
(project-bars (resolve scene gid) segs))))
(defn ref-length (defn linkables [scene ctx]
"Own resolved length (frames) of ref target `ref`, context-independent." (let [segs (content-segments scene ctx)
[scene ref] tracks (for [[track segments] (group-by :track segs)]
(length (target-segs scene ref))) {:name (get-in scene [:tracks track :name]) :kind :track
:items (mapv (fn [i {:keys [thumb] [lo hi] :local :as seg}]
{:label (str (get-in scene [:tracks track :name]) " (" (inc i) ")")
:search (clip-name scene thumb)
:point {:ref ctx :at lo} :local lo :len (- hi lo)})
(range) segments)})
annotations (for [[gid g] (:groups scene)
:when (and (= :annotation (:type g)) (child-of? scene ctx gid)
(not (:draft g)))]
{:name (:name g) :kind :annotation
:items (mapv (fn [[lo hi]]
{:label (:name g) :point {:ref ctx :at lo}
:local lo :len (- hi lo)})
(project-bars (resolve scene gid) segs))})]
(vec (concat (sort-by :name tracks) (sort-by :name annotations)))))
(defn ref-track-name (defn path-to [scene gid]
"Name of the TRACK that ref target `ref` resolves onto (its first piece), (when (get-in scene [:groups gid])
context-independent — the useful label for a transcluded mark whose clip isn't (if (= gid :root) [:root] [:root gid])))
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 ---------------------------------------------------------------- (defn timelines [scene]
;; 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
;; content as `[label](mark:ref@at)`. The id is just a mark id in the flat pool:
;; a clip group (clip-scoped time), the context itself (absolute time), or another
;; annotation's mark (a moment in that annotation). We only need the ctx-local
;; frame (to seek / label it) and the pickable targets within a context.
(defn link-local
"Local frame within `ctx` for link ref-point `point`, or nil if it no longer
resolves into ctx. An absolute link (:ref = ctx) IS the local frame."
[scene ctx {:keys [ref at] :as point}]
(if (= ref ctx)
at
(when-let [{:keys [frame]} (point-frame scene ctx point)]
(source->local (content-segments scene ctx) frame))))
(defn seg-point
"Ref-point {:ref :at} for mark-time frame `f` within content-segment `seg`
(the convention selection->marks uses, so it resolves identically)."
[scene {:keys [mark src]} f]
{:ref mark :at (+ (src->at scene mark (first src)) (or f 0))})
(defn- runs
"Contiguous runs of `gid`'s marks in `ctx`-local coords, each {:id :lo :len}
where :id is the run's first mark (a discontinuous annotation lists each
piece) and :len is that first mark's frame count — the offset you can pick
into it, since the link's ref only spans that one mark."
[scene ctx gid]
(let [csegs (content-segments scene ctx)
pts (->> (:marks (grp scene gid))
(keep (fn [m] (when-let [seg (first (resolve-mark scene gid m))]
(let [[s e] (:src seg)]
{:id (:id m) :lo (source->local csegs s)
:hi (source->local csegs (dec e))}))))
(filter :lo)
(sort-by :lo))]
(reduce (fn [out {:keys [id lo hi]}]
(if-let [p (peek out)]
(if (and (:hi p) hi (<= (- lo (:hi p)) 1))
(conj (pop out) (assoc p :hi hi)) ; extend run (display only)
(conj out {:id id :lo lo :hi hi :len (inc (- hi lo))}))
[{:id id :lo lo :hi hi :len (inc (- hi lo))}]))
[] pts)))
(defn jump-targets
"One target per discontinuity for an annotation's jump popover, labelled from the
CONTENT SEGMENT the run lands on in `ctx` — its clip/track id + the frame within
it. A mark's :start is its proxy-ref ({:ref proxy :at 0}), so display-point of it
would give the proxy gid (never in `segs` → a bare \"clip\") and frame 0; instead
we read the actual clip under the run's local position, the same segments the
editor labels against. Each: {:local <ctx frame to seek> :seg <content id> :f}."
[scene ctx gid]
(let [csegs (content-segments scene ctx)]
(mapv (fn [{:keys [lo]}]
(let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs)
(some (fn [{[_ d] :local :as s} ] (when (= d lo) s)) csegs)
(last csegs))]
{:local lo
:seg (:mark seg)
:f (assert-frame "jump target frame" (- lo (first (:local seg [0 0]))))}))
(runs scene ctx gid))))
(defn linkables
"Pickable link targets within `ctx`, grouped for the autocomplete: one group
per video track (its clips, by start) and per child annotation (its run
starts). Each candidate is {:label :point {:ref :at} :local}."
[scene ctx]
(let [tracks (->> (content-segments scene ctx)
(group-by :track)
(mapv (fn [[t segs]]
(let [track-name (get-in scene [:tracks t :name] (name t))]
{:name track-name :kind :track
:items (mapv (fn [i {:keys [mark] [c d] :local :as seg}]
{:label (str track-name " (" (inc i) ")")
:search (clip-name scene mark)
:point (seg-point scene seg 0) :local c :len (- d c)})
(range)
(sort-by (comp first :local) segs))}))))
anns (->> (:groups scene)
(keep (fn [[gid 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]}]
{:label (or (:name g) (name gid))
:point {:ref id :at 0} :local lo :len len})
(runs scene ctx gid))}))))]
(vec (concat (sort-by :name tracks) (sort-by :name anns)))))
(defn path-to
"Stack path from :root down to `gid` following primary-home links, or nil if an
ancestor is missing — an orphan whose home context was deleted."
[scene gid]
(loop [g gid, acc ()]
(cond
(= g :root) (vec (cons :root acc))
(or (nil? g) (not (contains? (:groups scene) g))) nil
:else (recur (home scene g) (cons g acc)))))
(defn timelines
"Every reachable timeline you can open as a context — root, plus named child
annotations whose parent chain still reaches root — each with the stack path
to reach it and its parent's name (:in) for disambiguation. Orphans (parent
deleted) are dropped."
[scene]
(->> (:groups scene) (->> (:groups scene)
(keep (fn [[gid g]] (keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (not (:draft g))) (when (and (= :annotation (:type g)) (not (:draft g)))
(when-let [path (path-to scene gid)] {:gid gid :name (or (:name g) (name gid)) :path (path-to scene gid)})))
(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)))
:path path})))))
(sort-by :name) (sort-by :name)
(into [{:gid :root :name "root" :in nil :path [:root]}]))) (into [{:gid :root :name "root" :path [:root]}])))

21
tl/src/tl/storage.cljs
View file

@ -1,21 +0,0 @@
(ns tl.storage
"Persist the authored annotation layer to localStorage as EDN. The OTIO-derived
tracks/clips/root are NOT stored — only annotation mark-groups (never drafts)."
(:require [cljs.reader :as reader]))
(def ^:private k "tl/annotations")
(defn annotations
"The non-draft annotation groups of a scene, as a {gid group} map."
[scene]
(into {} (filter (fn [[_ g]] (and (= :annotation (:type g)) (not (:draft g))))
(:groups scene))))
(defn load
"The saved {gid group} map, or nil if absent/corrupt."
[]
(when-let [s (.getItem js/localStorage k)]
(try (reader/read-string s) (catch :default _ nil))))
(defn save! [scene]
(.setItem js/localStorage k (pr-str (annotations scene))))

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

@ -6,6 +6,7 @@
(rf/reg-sub ::status (fn [db] (get-in db [:load :status]))) (rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
(rf/reg-sub ::playing? (fn [db] (get-in db [:view :playing?]))) (rf/reg-sub ::playing? (fn [db] (get-in db [:view :playing?])))
(rf/reg-sub ::edit-context (fn [db] (get-in db [:view :edit-context])))
(rf/reg-sub ::pt (fn [db] (get-in db [:view :pt]))) (rf/reg-sub ::pt (fn [db] (get-in db [:view :pt])))
;; routing / projects / auth ;; routing / projects / auth
@ -61,7 +62,7 @@
(fn [scene _] (fn [scene _]
(->> (scene/timelines scene) (->> (scene/timelines scene)
(remove #(= :root (:gid %))) (remove #(= :root (:gid %)))
(mapv #(select-keys % [:gid :name :in]))))) ; :in = home context, a display hint only (mapv #(select-keys % [:gid :name])))))
;; the annotation group currently being authored/edited (the one flagged :draft), ;; the annotation group currently being authored/edited (the one flagged :draft),
;; with its group id merged in as :gid ;; with its group id merged in as :gid
@ -111,7 +112,7 @@
;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the ;; 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). ;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
(defn- in-bars? [bars ph] (defn- in-bars? [bars ph]
(some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars)) (some (fn [[lo hi]] (or (= lo hi ph) (and (<= lo ph) (< ph hi)))) bars))
(defn annotations-by-parent (defn annotations-by-parent
"Group annotation cards by every reference parent they belong to." "Group annotation cards by every reference parent they belong to."
@ -135,16 +136,8 @@
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
(fn [[scene ctx segs revealed] _] (fn [[scene ctx segs revealed] _]
(let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid])))) (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
exists? (fn [x] (contains? (:groups scene) x))
;; each annotation → the mark-groups it's FILED UNDER (:in membership). A
;; normal annotation has one; a linked one has several, so it lists under
;; each. Asserted, not derived from where marks resolve. Any :in host that
;; no longer exists (its group was deleted) is dropped; an annotation left
;; with NO surviving host is rescued to root so it stays visible/refileable
;; instead of vanishing into a ghost parent.
parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))] parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
(let [ms (filter exists? (scene/membership scene gid))] [gid (scene/membership scene gid)]))
[gid (if (seq ms) (set ms) #{:root})])))
;; child count per timeline (drives the "Show N" nested badge) ;; 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)) 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, ;; membership-reveal hierarchy: shows when ctx is a host it's filed under,
@ -163,7 +156,6 @@
(let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse (let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
(when (shown? gid #{}) (when (shown? gid #{})
(let [reason (scene/broken-reason scene gid) (let [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))) note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
distinct distinct
@ -175,16 +167,15 @@
note-ids) note-ids)
jumps (scene/jump-targets scene ctx gid) jumps (scene/jump-targets scene ctx gid)
clips (->> (:marks g) clips (->> (:marks g)
(mapcat (fn [m] [(get-in m [:start :ref]) (mapcat :parts)
(get-in m [:end :ref])])) (map :clip)
(concat (map :seg jumps))
(keep (fn [ref] (keep (fn [ref]
(let [cg (get-in scene [:groups ref])] (let [cg (get-in scene [:groups ref])]
(or (:name cg) (or (:name cg)
(get-in cg [:media :name]) (get-in cg [:media :name])
(some-> ref name))))) (some-> ref name)))))
distinct)] distinct)]
{:id gid :parent (scene/home scene gid) ; primary home = first :in {:id gid
;; the mark-groups this annotation is filed under (:in) — the ;; the mark-groups this annotation is filed under (:in) — the
;; pane groups by this, so a linked annotation lists under each. ;; pane groups by this, so a linked annotation lists under each.
:parents (parents gid) :parents (parents gid)
@ -197,7 +188,7 @@
:notes note-ids :notes note-ids
:script (vec (remove nil? note-text)) :script (vec (remove nil? note-text))
:clips (vec clips) :clips (vec clips)
:broken (boolean reason) :reason reason :oor oor :broken (boolean reason) :reason reason
:hidden (boolean hidden) :hidden (boolean hidden)
:tags (vec (get-in g [:meta :tags])) :tags (vec (get-in g [:meta :tags]))
;; jump targets labelled from the marks' clip refs (same as ;; jump targets labelled from the marks' clip refs (same as
@ -272,32 +263,24 @@
;; depends only on scene/context/segments, NOT the playhead, so it's memoized here ;; depends only on scene/context/segments, NOT the playhead, so it's memoized here
;; and stays put while you scrub or play. The playhead-driven `active-*` subs below ;; and stays put while you scrub or play. The playhead-driven `active-*` subs below
;; then just do cheap interval tests. `bound` picks :notes or :drawings. ;; then just do cheap interval tests. `bound` picks :notes or :drawings.
(defn- binding-bars [scene ctx segs bound] (defn- binding-bars [scene ctx segs annotations bound]
(into [] (vec
(mapcat (mapcat (fn [gid]
(fn [[gid g]] (let [g (get-in scene [:groups gid])]
;; child annotations of the context OR the context annotation itself
;; (pushing the owner onto the stack makes ctx that annotation)
(when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid)))
(let [src-segs (scene/resolve scene gid)
by-mark (group-by :mark src-segs)
->bars (fn [ss] (scene/merge-bars
(mapcat (fn [{[a b] :src}] (scene/pieces segs a b)) ss)))]
(concat (concat
;; annotation-level bindings (notes only; drawings bind per-mark) (when (seq (bound g))
(when-let [gs (seq (bound g))] [{:gids gs :bars (->bars src-segs)}]) [{:gids (bound g) :bars (scene/project-bars (scene/resolve scene gid) segs)}])
;; per-mark bindings
(for [m (:marks g) :when (seq (bound m))] (for [m (:marks g) :when (seq (bound m))]
{:gids (bound m) :bars (->bars (get by-mark (:id m)))})))))) {:gids (bound m) :bars (scene/mark-bars scene gid (:id m) segs)}))))
(:groups scene))) (conj (set (map :id annotations)) ctx))))
(rf/reg-sub ::drawing-bars (rf/reg-sub ::drawing-bars
:<- [::scene] :<- [::context] :<- [::segments] :<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations]
(fn [[scene ctx segs] _] (binding-bars scene ctx segs :drawings))) (fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :drawings)))
(rf/reg-sub ::note-bars (rf/reg-sub ::note-bars
:<- [::scene] :<- [::context] :<- [::segments] :<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations]
(fn [[scene ctx segs] _] (binding-bars scene ctx segs :notes))) (fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :notes)))
(defn- gids-at [entries ph] (defn- gids-at [entries ph]
(persistent! (persistent!

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

@ -485,7 +485,7 @@
(frame-index "drag end frame" (+ hi d))] (frame-index "drag end frame" (+ hi d))]
:start [(frame-index "drag start frame" (+ lo d)) hi] :start [(frame-index "drag start frame" (+ lo d)) hi]
:end [lo (frame-index "drag end frame" (+ hi d))])] :end [lo (frame-index "drag end frame" (+ hi d))])]
(rf/dispatch [::events/reroll-proxy ann mark-id la lb]))))) (rf/dispatch [::events/resize-mark ann mark-id la lb])))))
up (fn up [_] up (fn up [_]
(.removeEventListener js/document "mousemove" move) (.removeEventListener js/document "mousemove" move)
(.removeEventListener js/document "mouseup" up) (.removeEventListener js/document "mouseup" up)
@ -1152,7 +1152,6 @@
(r/with-let [adding? (r/atom false)] (r/with-let [adding? (r/atom false)]
(let [gid (:id a) (let [gid (:id a)
homes (:parents a) homes (:parents a)
prim (:parent a)
cands (->> (:groups scene) cands (->> (:groups scene)
(keep (fn [[g grp]] (keep (fn [[g grp]]
(when (and (contains? #{:annotation :timeline} (:type grp)) (when (and (contains? #{:annotation :timeline} (:type grp))
@ -1169,7 +1168,7 @@
[::events/pop-to :root] [::events/pop-to :root]
[::events/expand h]))} [::events/expand h]))}
(group-name scene h) (group-name scene h)
(when (and authed? (not= h prim)) (when authed?
[:button.in-x {:type "button" :title "Un-file" [:button.in-x {:type "button" :title "Un-file"
:on-click (fn [e] (.stopPropagation e) :on-click (fn [e] (.stopPropagation e)
(rf/dispatch [::events/unfile gid h]))} "✕"])]) (rf/dispatch [::events/unfile gid h]))} "✕"])])
@ -1362,10 +1361,8 @@
;; edit button — Edit drops into the parent timeline so marks are editable. ;; edit button — Edit drops into the parent timeline so marks are editable.
(let [cg (get-in scene [:groups ctx])] (let [cg (get-in scene [:groups ctx])]
[:div.ctx-content [:div.ctx-content
(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)) (if (seq (:content cg))
[content-display scene (or (scene/home scene ctx) ctx) (:content cg)] [content-display scene ctx (:content cg)]
[:div.muted "No description yet."]) [:div.muted "No description yet."])
(when authed? (when authed?
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])]) [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
@ -1393,39 +1390,18 @@
(defn- pt-len [scene segs seg] (defn- pt-len [scene segs seg]
(or (scene/seg-length segs seg) (scene/ref-length scene seg))) (or (scene/seg-length segs seg) (scene/ref-length scene seg)))
(defn- frame-chip (defn- frame-chip [scene segs gid mark-id which {:keys [seg f]}]
"A filled endpoint: clip name + a mark-time frame input (edits `put` the group). (let [len (scene/ref-length scene seg)]
The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)."
[scene segs put d i k {:keys [seg f]}]
(let [len (pt-len scene segs seg)]
[:div.pt-chip [:div.pt-chip
[:span.pt-chip-name (pt-name scene segs seg)] [:span.pt-chip-name (pt-name scene segs seg)]
[:input.pt-frame {:type "number" :min 0 :max len :value f [: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)))}] :on-change #(rf/dispatch [::events/set-mark-frame gid mark-id which
[:span.pt-dur (str "/" len)]
[:button.pt-chip-x {:type "button" :title "Re-pick this end"
:on-click (fn [e]
(.stopPropagation e)
(rf/dispatch [::events/unset-endpoint (:gid d) i k]))} "✕"]]))
(defn- proxy-frame-chip
"Editable endpoint for a proxy (synthetic-clip) mark: clip name + frame input
that edits the proxy's OWN boundary internal mark's :at in place (`which` =
:start on its first mark, :end on its last). Crossing a clip boundary is the
lane handles' job; this is the whole-frame numeric nudge within a clip. The ✕
clears just this end to re-pick it (the other end stays put)."
[scene segs gid mark-id pid which {:keys [seg f]}]
(let [len (pt-len scene segs seg)]
[:div.pt-chip
[:span.pt-chip-name (pt-name scene segs seg)]
[:input.pt-frame {:type "number" :min 0 :max len :value f
:on-change #(rf/dispatch [::events/set-proxy-frame pid which
(to-frame (.. % -target -value) len)])}] (to-frame (.. % -target -value) len)])}]
[:span.pt-dur (str "/" len)] [:span.pt-dur (str "/" len)]
[:button.pt-chip-x {:type "button" :title "Re-pick this end" [:button.pt-chip-x {:type "button" :title "Re-pick this end"
:on-click (fn [e] :on-click (fn [e]
(.stopPropagation e) (.stopPropagation e)
(rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which]))} "✕"]])) (rf/dispatch [::events/unset-endpoint gid mark-id which]))} "✕"]]))
(defn- pending-frame-chip [scene segs {:keys [seg f]}] (defn- pending-frame-chip [scene segs {:keys [seg f]}]
(let [len (pt-len scene segs seg)] (let [len (pt-len scene segs seg)]
@ -1537,10 +1513,7 @@
last-scrolled (atom nil)] last-scrolled (atom nil)]
(let [d @(rf/subscribe [::subs/draft-group]) (let [d @(rf/subscribe [::subs/draft-group])
scene @(rf/subscribe [::subs/scene]) scene @(rf/subscribe [::subs/scene])
;; anchor the form to the draft's home context, not the live stack top: ctx @(rf/subscribe [::subs/edit-context])
;; a link-insert timeline preview moves the stack, but this annotation
;; still belongs to its primary home (first :in), so pickers stay stable.
ctx (or (first (:in d)) (:gid d)) ; annotation: its home; root: itself
segs (scene/content-segments scene ctx) segs (scene/content-segments scene ctx)
pt @(rf/subscribe [::subs/pt]) pt @(rf/subscribe [::subs/pt])
linking @(rf/subscribe [::subs/linking]) linking @(rf/subscribe [::subs/linking])
@ -1625,14 +1598,7 @@
(reset! mark-drag {:src i}))} "⠿"] (reset! mark-drag {:src i}))} "⠿"]
(when (contains? broken mark-id) (when (contains? broken mark-id)
[:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "]) [:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "])
;; a proxy collapses its cross-clip run to first-clip start → (let [pick (when (= (:mark-id pt) mark-id) (:which pt))]
;; 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) (if (= pick :start)
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
@ -1640,7 +1606,7 @@
:on-cancel #(rf/dispatch [::events/draft-focus :new]) :on-cancel #(rf/dispatch [::events/draft-focus :new])
:on-pick #(when-let [p (local->draft-point segs (:local %))] :on-pick #(when-let [p (local->draft-point segs (:local %))]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]
[proxy-frame-chip scene segs gid mark-id pid :start (:s row)]) [frame-chip scene segs gid mark-id :start (:s row)])
[:span.mark-arrow "→"] [:span.mark-arrow "→"]
(if (= pick :end) (if (= pick :end)
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
@ -1648,11 +1614,7 @@
:on-cancel #(rf/dispatch [::events/draft-focus :new]) :on-cancel #(rf/dispatch [::events/draft-focus :new])
:on-pick #(when-let [p (local->draft-end-point segs (:local %))] :on-pick #(when-let [p (local->draft-end-point segs (:local %))]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] (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 gid mark-id :end (:e row)])])
[:<>
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
[frame-chip scene segs put d i :end (:e row)]])
[:button.mark-draw {:type "button" [:button.mark-draw {:type "button"
:class (when (seq (:drawings mark)) "has") :class (when (seq (:drawings mark)) "has")
:title (if (seq (:drawings mark)) "Edit drawing on this shot" "Draw on this shot") :title (if (seq (:drawings mark)) "Edit drawing on this shot" "Draw on this shot")
@ -1671,7 +1633,7 @@
(for [ng (:notes mark) :let [n (nmap ng)] :when n] (for [ng (:notes mark) :let [n (nmap ng)] :when n]
^{:key (name ng)} ^{:key (name ng)}
[mark-note-chip ng n live #(rf/dispatch [::events/unbind-note-mark gid mark-id %])]))))])) [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)))) (when (or (= pt :new) (and (map? pt) (not (:mark-id pt))))
[pending-mark-block {:scene scene :ctx ctx :segs segs :pt pt :choosing? choosing?}]) [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)."]]) [:div.form-hint "Drag across the timeline to select a range (click to move the playhead)."]])
(when-not choosing? (when-not choosing?

326
tl/test/tl/flow_test.cljs
View file

@ -1,245 +1,157 @@
(ns tl.flow-test (ns tl.flow-test
"Integration tests that drive the ACTUAL re-frame events the UI dispatches and
read the resulting scene AND live subscriptions back — via day8.re-frame.test's
run-test-sync, so subscriptions resolve in a real reactive context (no 'outside
reactive context' warnings) and dispatch is synchronous. A bug that lives in an
event handler or a subscription (not just a pure scene fn) is caught here.
Placement model under test: an annotation's `:in` is an ordered vector of the
mark-groups it's FILED UNDER (first = primary home). Membership is asserted;
where marks resolve only decides whether bars draw. See tl.scene/membership."
(:require [cljs.test :refer-macros [deftest is testing]] (:require [cljs.test :refer-macros [deftest is testing]]
[day8.re-frame.test :as rf-test] [day8.re-frame.test :as rf-test]
[re-frame.core :as rf] [re-frame.core :as rf]
[re-frame.db :as rdb] [re-frame.db :as rdb]
[tl.events :as ev] [tl.events :as ev]
[tl.subs :as subs] [tl.subs :as subs]
[tl.scene :as s])) [tl.scene :as s]
[tl.scene-test :as fixture]))
;; 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 (doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
:connect-scene :fetch-projects :poll-thumbnails :upload-project]] :connect-scene :fetch-projects :poll-thumbnails :upload-project]]
(rf/reg-fx k (fn [_] nil))) (rf/reg-fx k (fn [_] nil)))
;; four clips on four tracks, one shared source file; root spans [0,400) (defn seed []
(def clips-scene (let [sc (-> fixture/base
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}} (fixture/annotation :a1 [:root] (s/make-mark fixture/base :root 0 100))
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]} (fixture/annotation :b1 [:root] (s/make-mark fixture/base :root 100 300)))]
:clip-a {:type :clip :parent nil :name "Challengers.mov" :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]} (fixture/annotation sc :x [:a1] (s/make-mark sc :a1 10 60))))
:clip-b {:type :clip :parent nil :name "Challengers.mov" :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
:clip-c {:type :clip :parent nil :name "Challengers.mov" :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}
:clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}})
(defn seed
"clips + annA (over clips A,B, filed under root) + annB (over C,D, filed under
root) + annC (one mark authored inside annA, FILED under annA)."
[]
(let [pA (s/make-proxy clips-scene :root 0 200)
pB (s/make-proxy clips-scene :root 200 400)
sc (-> clips-scene
(assoc-in [:groups :pA] pA)
(assoc-in [:groups :pB] pB)
(assoc-in [:groups :annA] {:type :annotation :in [:root] :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]})
(assoc-in [:groups :annB] {:type :annotation :in [:root] :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]}))
pInA (s/make-proxy sc :annA 10 60)]
(-> sc (assoc-in [:groups :pInA] pInA)
(assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f"
:marks [(s/proxy-ref "ca" :pInA)]}))))
(defn setup! [scene stack] (defn setup! [scene stack]
(reset! rdb/app-db {:scene scene :fps 24 (reset! rdb/app-db {:scene scene :fps 24 :project {:id nil}
:view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20} :view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}}))
:project {:id nil}}))
(defn scene* [] (:scene @rdb/app-db)) (defn scene* [] (:scene @rdb/app-db))
(defn group [gid] (get-in (scene*) [:groups gid]))
(defn pane-ids [] (set (map :id @(rf/subscribe [::subs/all-annotations]))))
(defn draft-gid [] (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))) (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 moves-edit-one-edge-in-both-directions
;; the annotation pane sub (::all-annotations) lists by membership (rf-test/run-test-sync
;; ========================================================================= (setup! (seed) [:root :a1])
(let [marks (:marks (group :x))]
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/ann-drag-start :x :a1])
(rf/dispatch [::ev/reparent :x :root])
(is (= #{:root :b1} (s/membership (scene*) :x)))
(rf/dispatch [::ev/ann-drag-start :x :root])
(rf/dispatch [::ev/reparent :x :a1])
(is (= #{:a1 :b1} (s/membership (scene*) :x)))
(is (= marks (:marks (group :x)))))))
(deftest pane-lists-strictly-by-membership (deftest moving-to-existing-destination-still-removes-source
(rf-test/run-test-sync
(setup! (seed) [:root :a1])
(rf/dispatch [::ev/file-into :x :root])
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/ann-drag-start :x :a1])
(rf/dispatch [::ev/reparent :x :root])
(is (= #{:root :b1} (s/membership (scene*) :x)))
(is (= 2 (count (:in (group :x)))))))
(deftest every-edge-is-equal-and-links-are-idempotent
(rf-test/run-test-sync (rf-test/run-test-sync
(setup! (seed) [:root]) (setup! (seed) [:root])
(testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT" (rf/dispatch [::ev/file-into :x :b1])
(is (= #{:annA :annB} (pane-ids))) (rf/dispatch [::ev/file-into :x :b1])
(is (= :root @(rf/subscribe [::subs/context]))) (rf/dispatch [::ev/unfile :x :a1])
(is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)")) (is (= [:b1] (:in (group :x))))
(testing "pushing annA onto the stack lists annC (its child), not annA/annB" (rf/dispatch [::ev/file-into :x :x])
(rf/dispatch [::ev/expand :annA]) (is (= [:b1] (:in (group :x))))
(is (= [:root :annA] (:stack (:view @rdb/app-db)))) (rf/dispatch [::ev/file-into :x :missing])
(is (= :annA @(rf/subscribe [::subs/context]))) (is (= [:b1] (:in (group :x))))))
(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 visibility-cycles-do-not-create-content-cycles
;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched
;; =========================================================================
(deftest reparent-move-then-link
(rf-test/run-test-sync (rf-test/run-test-sync
(setup! (seed) [:root]) (setup! (seed) [:root])
(let [marks0 (get-in (scene*) [:groups :annC :marks])] (let [before (s/resolve (scene*) :a1)]
(testing "drag annC (grabbed under annA) onto root: the edge MOVES, primary follows" (rf/dispatch [::ev/file-into :a1 :x])
(rf/dispatch [::ev/ann-drag-start :annC :annA]) (rf/dispatch [::ev/toggle-children :a1])
(rf/dispatch [::ev/reparent :annC :root]) ; add? falsey ⇒ move (rf/dispatch [::ev/toggle-children :x])
(is (= [:root] (:in (get-in (scene*) [:groups :annC])))) (is (= before (s/resolve (scene*) :a1)))
(is (= :root (s/home (scene*) :annC))) (is (= #{:a1 :b1 :x} (pane-ids))))))
(is (= marks0 (get-in (scene*) [:groups :annC :marks])) "marks untouched by a move"))
(testing "now annC lists at root and no longer under annA"
(setup! (assoc-in (scene*) [:view] {:stack [:root] :playheads {} :revealed #{} :zoom 1 :row-h 20}) [:root])
(is (contains? (pane-ids) :annC))
(rf/dispatch [::ev/expand :annA])
(is (not (contains? (pane-ids) :annC))))
(testing "⌥-drag (add?) links annC under annB WITHOUT removing root"
(rf/dispatch [::ev/collapse])
(rf/dispatch [::ev/ann-drag-start :annC :root])
(rf/dispatch [::ev/reparent :annC :annB true])
(is (= #{:root :annB} (s/membership (scene*) :annC)))
(is (= :root (s/home (scene*) :annC)) "primary home unchanged by a link")
(is (= marks0 (get-in (scene*) [:groups :annC :marks])))))))
(deftest reparent-refuses-cycles-and-noops (deftest associate-from-sibling-adds-footage-and-visibility
(rf-test/run-test-sync (rf-test/run-test-sync
(setup! (seed) [:root]) (setup! (seed) [:root :b1])
(testing "filing annA under annC (which is filed under annA) is refused — a cycle"
(rf/dispatch [::ev/file-into :annA :annC])
(is (not (contains? (s/membership (scene*) :annA) :annC))))
(testing "filing under a group it's already filed under is a no-op"
(let [before (:in (get-in (scene*) [:groups :annC]))]
(rf/dispatch [::ev/file-into :annC :annA])
(is (= before (:in (get-in (scene*) [:groups :annC]))))))
(testing "an annotation can't be filed under itself"
(rf/dispatch [::ev/file-into :annC :annC])
(is (not (contains? (s/membership (scene*) :annC) :annC))))))
;; =========================================================================
;; unfile — remove one edge; never the primary home, never the last
;; =========================================================================
(deftest unfile-removes-links-only
(rf-test/run-test-sync
(setup! (seed) [:root])
(rf/dispatch [::ev/file-into :annC :root]) ; annC now [:annA :root]
(is (= [:annA :root] (:in (get-in (scene*) [:groups :annC]))))
(testing "unfiling a non-primary link removes just that edge"
(rf/dispatch [::ev/unfile :annC :root])
(is (= [:annA] (:in (get-in (scene*) [:groups :annC])))))
(testing "the primary home can't be unfiled (nor the last remaining edge)"
(rf/dispatch [::ev/unfile :annC :annA])
(is (= [:annA] (:in (get-in (scene*) [:groups :annC])))))))
;; =========================================================================
;; adding marks from another context (associate-marks) does NOT move placement
;; =========================================================================
(deftest associate-marks-adds-marks-not-membership
(rf-test/run-test-sync
(setup! (seed) [:root])
;; drill into annB, author a range on ITS content, tie it to annC
(rf/dispatch [::ev/expand :annB])
(rf/dispatch [::ev/open-draft]) (rf/dispatch [::ev/open-draft])
(rf/dispatch [::ev/draft-select-range 50 150]) (rf/dispatch [::ev/draft-select-range 50 150])
(let [d (draft-gid)] (rf/dispatch [::ev/associate-marks (draft-gid) :x])
(is d "a draft exists after open-draft") (is (= #{:a1 :b1} (s/membership (scene*) :x)))
(is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB") (is (= 2 (count (:marks (group :x)))))
(rf/dispatch [::ev/associate-marks d :annC])) (is (contains? (pane-ids) :x))
(testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)" (is (= :b1 (get-in @rdb/app-db [:view :edit-context])))
(is (= 2 (count (get-in (scene*) [:groups :annC :marks])))) (is (= [[:a 10 60] [:b 50 100] [:c 0 50]]
(is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks")) (mapv (juxt :clip :start :end) (mapcat :parts (:marks (group :x))))))
;; associate opened annC in :edit; save it (drops :draft) and leave the form (is (not-any? #(= :proxy (:type %)) (vals (:groups (scene*)))))))
(rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil])
(deftest edit-stays-in-current-context
(rf-test/run-test-sync
(setup! (seed) [:root :b1])
(rf/dispatch [::ev/file-into :x :b1])
(rf/dispatch [::ev/edit-annotation :x])
(is (= [:root :b1] (get-in @rdb/app-db [:view :stack])))
(is (= :b1 (get-in @rdb/app-db [:view :edit-context])))))
(deftest range-edit-and-cancel-are-local-to-the-mark
(rf-test/run-test-sync
(setup! (seed) [:root :a1])
(let [original (group :x)
mid (:id (first (:marks original)))
groups (set (keys (:groups (scene*))))]
(rf/dispatch [::ev/edit-annotation :x])
(rf/dispatch [::ev/resize-mark :x mid 30 80])
(is (= [{:clip :a :start 30 :end 80}] (:parts (first (:marks (group :x))))))
(rf/dispatch [::ev/restore-group :x original])
(rf/dispatch [::ev/finish-edit]) (rf/dispatch [::ev/finish-edit])
(testing "so annC does NOT list under annB — even though its footage resolves there" (is (= original (group :x)))
(is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB") (is (= groups (set (keys (:groups (scene*)))))))))
(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 endpoint-edit-preserves-mark-identity-and-bindings
;; stack push / pop and reveal-children through the real events (rf-test/run-test-sync
;; ========================================================================= (setup! (assoc-in (seed) [:groups :x :marks 0 :drawings] [:drawing]) [:root :a1])
(let [mid (:id (first (:marks (group :x))))]
(rf/dispatch [::ev/edit-annotation :x])
(rf/dispatch [::ev/set-mark-frame :x mid :start 20])
(is (= 20 (get-in (group :x) [:marks 0 :parts 0 :start])))
(rf/dispatch [::ev/unset-endpoint :x mid :end])
(rf/dispatch [::ev/draft-click-seg [:a1 0] 90])
(is (= mid (get-in (group :x) [:marks 0 :id])))
(is (= [:drawing] (get-in (group :x) [:marks 0 :drawings])))
(is (= [{:clip :a :start 20 :end 90}] (get-in (group :x) [:marks 0 :parts]))))))
(deftest stack-navigation-and-reveal (deftest deleting-context-does-not-delete-footage
(rf-test/run-test-sync (rf-test/run-test-sync
(setup! (seed) [:root]) (setup! (seed) [:root])
(testing "expand pushes, pop-to truncates, collapse pops" (let [before (s/resolve (scene*) :x)]
(rf/dispatch [::ev/expand :annA]) (rf/dispatch [::ev/delete-annotation :a1])
(is (= [:root :annA] (:stack (:view @rdb/app-db)))) (is (= before (s/resolve (scene*) :x)))
(rf/dispatch [::ev/collapse]) (is (= [:root :x] (s/path-to (scene*) :x))))))
(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"))))
;; ========================================================================= (deftest peer-delta-decodes-current-format
;; 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 (rf-test/run-test-sync
;; annC's sole host (annA) is deleted out from under it, as if by restore of (setup! fixture/base [:root])
;; 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 (rf/dispatch [::ev/peer-delta
{:changed {:ann-legacy {:type "annotation" :parent "root" :name "L" {:changed {:x {:type "annotation" :in ["root"] :name "X"
:marks [{:id "lm" :start {:ref "clip-a" :at 0} :marks [{:id "m" :parts [{:clip "a" :start 10 :end 50}]}]}}
:end {:ref "clip-a" :at 50}}]}}
:deleted []}]) :deleted []}])
(testing "it migrates :parent -> :in [:root] on ingest and drops the old field" (is (= #{:x} (pane-ids)))
(is (= [:root] (:in (get-in (scene*) [:groups :ann-legacy])))) (is (= [{:clip :a :start 10 :end 50}] (get-in (group :x) [:marks 0 :parts])))
(is (nil? (:parent (get-in (scene*) [:groups :ann-legacy]))))) (is (= [[1010 1050]] (mapv :src (s/resolve (scene*) :x))))
(testing "and shows up in the root pane like any other" (is (= (group :x) (:x (fixture/wire {:x (group :x)}))))))
(is (contains? (pane-ids) :ann-legacy)))))
(deftest membership-survives-the-json-wire (deftest revealed-cards-and-bound-drawings-share-visibility
(rf-test/run-test-sync (rf-test/run-test-sync
(setup! (seed) [:root]) (setup! (-> (seed)
(rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root] (assoc-in [:groups :x :marks 0 :drawings] [:d])
(let [g (get-in (scene*) [:groups :annC]) (assoc-in [:groups :d] {:type :drawing :strokes []})
;; exactly what api/put-scene serializes then reads back (assoc-in [:groups :x :marks 0 :notes] [:n])
wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true) (assoc-in [:groups :n] {:type :script-note :regions []}))
back (:annC (s/restore-annotations {:annC wire}))] [:root])
(is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)") (rf/dispatch [::ev/set-playhead :root 20])
(is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved") (is (not (contains? (pane-ids) :x)))
(is (= :annA (s/home {:groups {:annC back}} :annC)))))) (is (empty? @(rf/subscribe [::subs/active-drawings])))
(rf/dispatch [::ev/toggle-children :a1])
(is (contains? (pane-ids) :x))
(is (= [:d] (mapv :id @(rf/subscribe [::subs/active-drawings]))))
(is (= #{:n} @(rf/subscribe [::subs/active-note-set])))))

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

@ -4,391 +4,152 @@
[tl.otio :as otio] [tl.otio :as otio]
[tl.scene :as s])) [tl.scene :as s]))
;; --- shared fixture -------------------------------------------------------
;; three contiguous clips on three tracks (half-open source ranges).
;; A [0,100)@t0 B [100,200)@t1 C [200,300)@t2 root [0,300)
(def base (def base
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"}} {:tracks {:t0 {:name "A"} :t1 {:name "B"} :t2 {:name "C"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 300}]} :groups {:root {:type :timeline}
;; :start = timeline position; here it equals source so root is identity :a {:type :clip :track :t0 :start 0 :source 1000 :duration 100}
:clip-a {:type :clip :parent nil :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]} :b {:type :clip :track :t1 :start 100 :source 2000 :duration 100}
:clip-b {:type :clip :parent nil :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]} :c {:type :clip :track :t2 :start 200 :source 3000 :duration 100}}})
:clip-c {:type :clip :parent nil :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}}})
(defn with-group [scene gid g] (assoc-in scene [:groups gid] g)) (defn part [clip start end] {:clip clip :start start :end end})
(defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}}) (defn mark [id & parts] {:id id :parts (vec parts)})
(defn err-msg [f] (defn annotation [scene gid edges & marks]
(try (f) nil (catch js/Error e (.-message e)))) (assoc-in scene [:groups gid] {:type :annotation :name (name gid) :in edges :marks (vec marks)}))
(defn wire [groups]
(s/restore-annotations (js->clj (js/JSON.parse (js/JSON.stringify (clj->js groups))) :keywordize-keys true)))
(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. (deftest root-distinguishes-timeline-and-source-time
(def inter-x
(with-group base :ann-x
{: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)
{:id :m/s3 :start {:ref :clip-a :at 50} :end {:ref :clip-a :at -1}}]})) ; src [50,100)
;; Y inside X, referencing two of X's subclips (parent = :ann-x)
(def x+y
(with-group inter-x :ann-y
{:type :annotation :in [:ann-x]
: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)
;; =========================================================================
;; Suite 1 — resolve / layout
;; =========================================================================
(deftest root-is-identity
(testing "the root timeline maps local 1:1 to source"
(let [segs (s/resolve base :root)] (let [segs (s/resolve base :root)]
(is (= 300 (s/length segs))) (is (= 300 (s/length segs)))
(is (= 250 (s/local->source segs 250))) (is (= [0 100 200] (mapv (comp first :local) segs)))
(is (= [0 300] (:src (first segs))))))) (is (= [1000 2000 3000] (mapv (comp first :src) segs)))
(is (= 2005 (s/local->source segs 105)))
(is (= #{:t0 :t1 :t2} (s/tracks segs)))))
(deftest rearrange-and-gap-removal (deftest compilation-preserves-order-repeats-and-trims
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track" (let [sc (annotation base :x [:root]
(let [scene (with-group base :ann (mark :m (part :c 20 40) (part :a 0 10) (part :c 20 40)))
{:type :annotation :in [:root] segs (s/resolve sc :x)]
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]}) (is (= [[3020 3040] [1000 1010] [3020 3040]] (mapv :src segs)))
segs (s/resolve scene :ann)] (is (= [[0 20] [20 30] [30 50]] (mapv :local segs)))
(is (= 200 (s/length segs))) (is (= [3025 1005 3025] (mapv #(s/local->source segs %) [5 25 35])))
(is (= 200 (s/local->source segs 0))) ; local 0 -> C's source start (is (= [:m :m :m] (mapv :mark segs)))))
(is (= 0 (s/local->source segs 100))) ; local 100 -> A's source start
(is (= #{:t2 :t0} (s/tracks segs)))
(is (not (contains? (s/tracks segs) :t1))))))
(deftest inter-x-lays-four-subclips (deftest selections-own-raw-clip-slices
(testing "four 50-frame subclips, in mark order, end to end" (let [sc (annotation base :x [:root]
(let [segs (s/resolve inter-x :ann-x)] (mark :m (part :b 50 100) (part :a 0 50) (part :b 0 50)))
(is (= 4 (count segs))) selection (s/make-mark sc :x 40 110)
(is (= 200 (s/length segs))) sc (annotation sc :y [:x] selection)
(is (= [150 200] (:src (nth segs 0)))) before (s/resolve sc :y)]
(is (= 150 (s/local->source segs 0))) ; B's second half (is (= [(part :b 90 100) (part :a 0 50) (part :b 0 10)] (:parts selection)))
(is (= 0 (s/local->source segs 50))) ; boundary into A's first half (is (= before (s/resolve (update sc :groups dissoc :x) :y)))
(is (= [:clip-b :clip-a :clip-b :clip-a] (map :thumb segs))) (is (= before (s/resolve (assoc-in sc [:groups :y :in] [:root]) :y)))
(is (= [50 0 0 50] (map :thumb-start segs))) (is (= before (s/resolve (assoc-in sc [:groups :x :marks] []) :y)))))
(is (= #{:t1 :t0} (s/tracks segs))))))
(deftest trim-no-clamp (deftest selection-through-repeated-footage
(testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame" (let [sc (annotation base :x [:root] (mark :m (part :a 20 40) (part :a 60 90)))
;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100 segs (s/content-segments sc :x)
(let [scene (-> base mid (:mark (second segs))
(with-group :ann {:type :annotation :in [:root] lo (s/seg-local segs mid 5)]
:marks [{:id :m/s :start {:ref :clip-a :at 20} (is (= 2 (count (distinct (map :mark segs)))))
:end {:ref :clip-a :at 80}}]}) (is (= 30 (s/seg-length segs mid)))
(with-group :ann-y {:type :annotation :in [:ann] (is (= 25 lo))
:marks [{:id :m/y :start {:ref :m/s :at 0} (is (= [(part :a 65 70)] (s/selection->parts sc :x lo (+ lo 5))))))
:end {:ref :m/s :at -1}}]}))
seg (first (s/resolve scene :ann-y))]
(is (= [20 80] (:src seg))) ; ends at the subclip's 80, not 100
(is (= 60 (s/length (s/resolve scene :ann-y)))))))
(deftest tracks-by-membership (deftest one-mark-one-row-no-extra-entities
(testing "zoom includes exactly the tracks the marks touch" (let [m (s/make-mark base :root 40 210)]
(let [scene (with-group base :ann (is (= [(part :a 40 100) (part :b 0 100) (part :c 0 10)] (:parts m)))
{:type :annotation :in [:root] (is (= [{:s {:seg :a :f 40} :e {:seg :c :f 10}}] (s/marks->rows base [m])))))
: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 (deftest projection-preserves-root-clip-identity
(testing "a clip referenced twice renders at two local positions" (let [sc (-> base
(let [scene (with-group base :ann (assoc-in [:groups :b :source] 1000)
{:type :annotation :in [:root] (annotation :x [:root] (mark :m (part :a 10 20))))]
:marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100) (is (= [[10 20 :m]] (s/lane-bars sc :x (s/content-segments sc :root))))))
(refm :m/r1 :clip-b 0 -1) ; B local [100,200)
(refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300)
segs (s/resolve scene :ann)]
(is (= [[0 100] [200 300]] (s/pieces segs 0 100)))))) ; clip-a's two pieces
;; ========================================================================= (deftest projection-shows-every-repeat
;; Suite 2 — authoring lifecycle (annotate A, push A, annotate B, mess with A) (let [sc (-> base
;; ========================================================================= (annotation :context [:root] (mark :r (part :a 0 100) (part :b 0 100) (part :a 0 100)))
(annotation :x [:context] (mark :m (part :a 10 20))))]
(is (= [[10 20 :m] [210 220 :m]]
(s/lane-bars sc :x (s/content-segments sc :context))))))
(deftest y-follows-x-reorder (deftest contiguity-is-defined-by-render-context
(testing "Y's refs track the subclips' CONTENT through a reorder of X" (let [sc (-> base
(let [reordered (update-in x+y [:groups :ann-x :marks] reverse)] (annotation :context [:root] (mark :r (part :c 0 100) (part :a 0 100)))
(is (= (s/resolve x+y :ann-y) (s/resolve reordered :ann-y)))))) (annotation :x [:context] (mark :m (part :a 0 20) (part :c 80 100))))]
(is (= [[80 120 :m]] (s/lane-bars sc :x (s/content-segments sc :context))))
(is (= [[0 20 :m] [280 300 :m]] (s/lane-bars sc :x (s/content-segments sc :root))))))
(deftest y-follows-x-inplace-edit (deftest projection-clips-partial-overlap-without-changing-content
(testing "editing s0's in-point in place (same id) is reflected through Y's ref" (let [sc (-> base
(let [edited (assoc-in x+y [:groups :ann-x :marks 0 :start :at] 40)] ; s0 now B[40,100) src[140,200) (annotation :context [:root] (mark :r (part :a 30 70)))
(is (= [150 160] (:src (first (s/resolve edited :ann-y)))))))) ; s0[10..20] -> [150,160) (annotation :x [:context] (mark :m (part :a 10 50))))
before (s/resolve sc :x)]
(is (= [[0 20 :m]] (s/lane-bars sc :x (s/content-segments sc :context))))
(is (= before (s/resolve sc :x)))))
(deftest y-orphans-partially-on-delete (deftest distinct-marks-never-merge
(testing "deleting s0 dangles Y's first mark; the second still resolves" (let [sc (annotation base :x [:root] (mark :m1 (part :a 0 100)) (mark :m2 (part :b 0 100)))]
(let [del (update-in x+y [:groups :ann-x :marks] #(vec (rest %)))] ; drop s0 (is (= [[0 100 :m1] [100 200 :m2]] (s/lane-bars sc :x (s/content-segments sc :root))))))
(is (= [:m/y0] (s/broken-marks del :ann-y)))
(is (= 1 (count (s/resolve del :ann-y))))
(is (= [0 5] (:src (first (s/resolve del :ann-y)))))))) ; the surviving y1
(deftest selection-splits-into-a-run (deftest instant-and-boundary-frames
(testing "a selection crossing subclip boundaries becomes one mark per segment" (let [sc (annotation base :x [:root] (assoc (s/make-mark base :root 100 100) :id :instant))]
(let [run (s/selection->marks inter-x :ann-x 40 110)] ; crosses s0, s1, s2 (is (= [(part :b 0 0)] (get-in sc [:groups :x :marks 0 :parts])))
(is (= 3 (count run))) (is (= [[100 100 :instant]] (s/lane-bars sc :x (s/content-segments sc :root))))
(is (= [:m/s0 :m/s1 :m/s2] (map #(get-in % [:start :ref]) run))) (is (= 0 (s/length (s/resolve sc :x))))))
;; the s0 piece is its tail (local 40..50 -> offset 40..50 into s0)
(is (= 40 (get-in (first run) [:start :at])))
(is (= 50 (get-in (first run) [:end :at]))))))
(deftest root-selection-splits-by-clip (deftest visibility-is-independent-of-compilation
(testing "selecting across A/B/C at the ROOT splits into one ref per clip" (let [sc (annotation base :x [:root] (mark :m (part :a 0 100)))
(let [run (s/selection->marks base :root 40 210)] ; A-tail + B + C-head moved (assoc-in sc [:groups :x :in] [:other :root])]
(is (= 3 (count run))) (is (= (s/resolve sc :x) (s/resolve moved :x)))
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) run))) (is (= #{:root :other} (s/membership moved :x)))
(is (= 40 (get-in (first run) [:start :at]))) ; A from frame 40 (is (= (s/resolve moved :x)
(is (= 0 (get-in (last run) [:start :at])))))) ; C from frame 0 (s/resolve (assoc-in moved [:groups :x :in] [:root :other]) :x)))))
(deftest reconcile-keeps-ids-across-resize (deftest missing-clips-are-reported-with-valid-parts-still-visible
(testing "resizing a selection keeps the surviving pieces' ids; adds/drops at the ends" (let [sc (annotation base :x [:root] (mark :m (part :missing 0 10) (part :a 0 20)))]
(let [run1 (s/selection->marks base :root 40 110) ; A-tail, B-head (is (= [:m] (s/broken-marks sc :x)))
a-id (:id (first run1)) (is (= [[1000 1020]] (mapv :src (s/resolve sc :x))))
run2 (s/reconcile-run base :root run1 40 210) ; grow → A, B, C (is (some? (s/broken-reason sc :x)))))
run3 (s/reconcile-run base :root run2 40 90)] ; shrink → A only
(is (= 2 (count run1)))
(is (= 3 (count run2)))
(is (= a-id (:id (first run2)))) ; A's id survived the grow
(is (= 1 (count run3)))
(is (= a-id (:id (first run3))))))) ; …and the shrink
;; ========================================================================= (deftest json-roundtrip-covers-all-authored-types
;; Suite 2b — proxy synthetic-clips (marks-first authoring) (let [groups {:x {:type :annotation :in [:root :other] :name "X" :notes [:n]
;; ========================================================================= :marks [(assoc (mark :m (part :a 10 30)) :drawings [:d] :notes [:n])]}
:n {:type :script-note :regions [{:id :r :kind :text :text "hello"}]}
:d {:type :drawing :strokes []}}]
(is (= groups (wire groups)))
(is (= (s/resolve (update base :groups merge groups) :x)
(s/resolve (update base :groups merge (wire groups)) :x)))))
(deftest proxy-resolves-as-one-collapsed-mark (deftest links-and-jumps-use-context-projection
(testing "an annotation referencing a whole proxy resolves to the proxy's full (let [sc (annotation base :x [:root] (mark :m (part :a 20 30) (part :c 50 60)))
per-clip run — scattered-source clips pieced back together" seg (first (s/content-segments sc :x))]
(let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210) (is (= {:ref :a :at 25} (s/seg-point sc seg 5)))
scene (-> base (is (= 5 (s/link-local sc :x {:ref :a :at 25})))
(with-group :prox p) (is (nil? (s/link-local sc :x {:ref :b :at 25})))
(with-group :ann {:type :annotation :in [:root] (is (= 42 (s/link-local sc :root {:ref :root :at 42})))
:marks [(s/proxy-ref :m/px :prox)]})) (is (= [20 250] (mapv :local (s/jump-targets sc :root :x))))
segs (s/resolve scene :ann)] (is (= [20 50] (mapv :f (s/jump-targets sc :root :x))))
(is (= 170 (s/length segs))) ; 60 + 100 + 10 (is (= 4 (count (s/linkables sc :root))))))
(is (= 40 (s/local->source segs 0))) ; A from frame 40
(is (= 100 (s/local->source segs 60))) ; boundary into B
(is (= 200 (s/local->source segs 160))) ; boundary into C
(is (= #{:t0 :t1 :t2} (s/tracks segs))) ; every crossed clip's track
(is (= :m/px (:mark (first segs))))))) ; the one addressable unit
(deftest proxy-of-a-single-clip-is-just-that-clip (deftest navigation-does-not-follow-visibility
(testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip" (let [sc (-> base (annotation :x [:y]) (annotation :y [:x]))]
(let [p (s/make-proxy base :root 10 60) ; inside A only (is (= [:root :x] (s/path-to sc :x)))
scene (-> base (with-group :prox p) (is (= #{:root :x :y} (set (map :gid (s/timelines sc)))))
(with-group :ann {:type :annotation :in [:root] (is (nil? (s/path-to sc :missing)))))
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/resolve scene :ann)]
(is (= 1 (count (:marks p))))
(is (= 50 (s/length segs)))
(is (= [10 60] (:src (first segs)))))))
(deftest roll-proxy-keeps-interior-ids-stable (deftest integer-frame-invariants
(testing "growing/shrinking a proxy's endpoints keeps interior ids and edits (is (re-find #"integer frame" (err-msg #(s/selection->parts base :root 0.5 20))))
boundary marks in place (added out, dropped in)" (is (re-find #"ordered" (err-msg #(s/selection->parts base :root 20 10))))
(let [p0 (s/make-proxy base :root 40 210) ; A-tail, B, C-head (is (= [[0 30] [40 50]] (s/merge-bars [[20 30] [0 20] [40 50]]))))
[a0 b0 c0] (mapv :id (:marks p0))
grow (s/roll-proxy base :root p0 40 300) ; roll end OUT to full C
shrink (s/roll-proxy base :root p0 110 210)] ; roll start IN, dropping A
(is (= 3 (count (:marks p0))))
(testing "grow keeps all three ids; C's boundary mark is edited in place to full"
(is (= [a0 b0 c0] (mapv :id (:marks grow))))
(is (= 100 (get-in (nth (:marks grow) 2) [:end :at]))))
(testing "shrink drops A, keeps B and C ids"
(is (= [b0 c0] (mapv :id (:marks shrink))))))))
(deftest proxy-mark-collapses-to-one-row (deftest playheads-are-per-context
(testing "a proxy ref renders as ONE editor row: first-clip start → last-clip end" (let [v (-> {} (s/set-playhead :root 30) (s/set-playhead :x 80))]
(let [p (s/make-proxy base :root 40 210) ; A-tail, B, C-head
scene (-> base (with-group :prox p))
rows (s/marks->rows scene [(s/proxy-ref :m/px :prox)])]
(is (= 1 (count rows)))
(is (= :prox (:proxy (first rows))))
(is (= {:seg :clip-a :f 40} (:s (first rows)))) ; A from frame 40
(is (= {:seg :clip-c :f 10} (:e (first rows))))))) ; C to frame 10
(deftest plain-clip-mark-still-renders-a-pair
(testing "a non-proxy mark keeps the editable clip→clip row (no :proxy tag)"
(let [rows (s/marks->rows base [(refm :m/m :clip-a 0 -1)])]
(is (nil? (:proxy (first rows))))
(is (= {:seg :clip-a :f 0} (:s (first rows))))
(is (= {:seg :clip-a :f 100} (:e (first rows)))))))
(deftest lane-bars-keep-distinct-marks-separate
(testing "two abutting but DISTINCT marks render as two bars, not one fused bar;
a single cross-clip proxy still coalesces to one bar"
(let [p1 (s/make-proxy base :root 0 200) ; A+B
p2 (s/make-proxy base :root 200 300) ; C (abuts B)
scene (-> base (with-group :p1 p1) (with-group :p2 p2)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/1 :p1)
(s/proxy-ref :m/2 :p2)]}))
segs (s/content-segments scene :root)
bars (s/lane-bars scene :ann segs)]
(is (= [[0 200 :m/1] [200 300 :m/2]] bars)) ; two marks → two bars, tagged + apart
(is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi]
;; and a single cross-clip proxy on its own is one contiguous bar
(let [one (-> base (with-group :p1 p1)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/1 :p1)]}))]
(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)
re-keywords and still resolves through a referencing annotation"
(let [json-like {:prox {:type "proxy" :parent nil
:marks [{:id "p0" :start {:ref "clip-a" :at 40} :end {:ref "clip-a" :at 100}}
{:id "p1" :start {:ref "clip-b" :at 0} :end {:ref "clip-b" :at 100}}
{:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}}
back (:prox (s/restore-annotations json-like))
scene (-> base (with-group :prox back)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))]
(is (= :proxy (:type back)))
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded
(is (= 170 (s/length (s/resolve scene :ann))))))) ; resolves whole
(deftest content-segments-in-a-drilled-proxy-annotation-keeps-clips-distinct
(testing "drilling INTO a proxy-backed range annotation exposes each underlying
clip as its OWN content-segment (distinct :mark, track, length) — NOT
all collapsed under the annotation's single mark id, which made every
clip read with the FIRST piece's name + length and blocked saving a
sub-range selection (the resolve/rebase collapse bug)"
(let [p (s/make-proxy base :root 40 210) ; A-tail=60, B=100, C-head=10
scene (-> base
(with-group :prox p)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))
segs (s/content-segments scene :ann)
ids (mapv :mark segs)]
(is (= 170 (s/length segs)))
(is (= 3 (count segs)))
(is (= 3 (count (distinct ids)))) ; pieces stay distinct…
(is (not-any? #{:m/px} ids)) ; …and are NOT the annotation's mark
(is (= [:t0 :t1 :t2] (mapv :track segs))) ; each keeps its own track
;; per-piece lengths + the seg-length / seg-local lookups the editor & save
;; check rely on — previously every one returned the first piece's numbers
(is (= [60 100 10] (mapv (fn [{[c d] :local}] (- d c)) segs)))
(is (= [60 100 10] (mapv #(s/seg-length segs %) ids)))
(is (= [0 60 160] (mapv #(s/seg-local segs % 0) ids)))))
(testing "resolve (the LANE view) still collapses the proxy under the annotation's
one mark id — one bar per mark — so the two views stay distinct"
(let [p (s/make-proxy base :root 40 210)
scene (-> base (with-group :prox p)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :m/px :prox)]}))]
(is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann))))))))
(deftest transcluded-mark-labels-resolve-down-to-the-clip
(testing "a mark whose ref target isn't in the CURRENT context (collected into an
annotation from another timeline — transclusion) still gets a length +
a useful TRACK label by resolving the ref chain down to its clip, not by
a context lookup (which returns 'clip' / no length for a foreign ref).
The clip's :name is the shared source file, so the TRACK is the label."
(let [named (-> base
(assoc-in [:groups :clip-a :name] "Challengers.mov")) ; single-source
pA (s/make-proxy named :root 0 100) ; proxy over clip-a (track t0 = "A-roll")
aid (:id (first (:marks pA))) ; A's sub-clip mark (refs clip-a)
pin {:type :proxy :parent nil ; a mark authored INSIDE A
:marks [{:id :sub-c :start {:ref aid :at 0} :end {:ref aid :at -1}}]}
scene (-> named
(with-group :pA pA)
(with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
(with-group :pin pin))]
;; the ref chain :sub-c → aid → clip-a bottoms out at a clip from anywhere
(is (= 100 (s/ref-length scene :sub-c))) ; clip-a's length, no context
(is (= "A-roll" (s/ref-track-name scene :sub-c))) ; the TRACK, not "Challengers.mov"
(is (= 100 (s/ref-length scene :pin))) ; the whole proxy resolves the same
(is (= "A-roll" (s/ref-track-name scene :pin)))
(is (nil? (s/ref-track-name scene :nope)))))) ; a dangling ref → nil, not a throw
(deftest placement-is-membership-listing-is-decoupled-from-where-bars-draw
(testing "an annotation LISTS under the mark-groups in its :in (asserted), while
its bars DRAW wherever its marks resolve (footage ∩ ctx). The two are
independent: a mark authored on annB's content still draws in annB even
when the annotation is only filed under annA — and it does NOT list in
annB until it's filed there."
(let [four (assoc-in base [:groups :clip-d]
{:type :clip :parent nil :name "D" :start 300
:marks [{:id :m/d :start 300 :end 400 :track :t0}]})
four (assoc-in four [:groups :root :marks] [{:id :m/root :start 0 :end 400}])
pA (s/make-proxy four :root 0 200) ; annA over clips A,B
pB (s/make-proxy four :root 200 400) ; annB over clips C,D
scene (-> four (with-group :pA pA) (with-group :pB pB)
(with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
(with-group :annB {:type :annotation :in [:root] :marks [(s/proxy-ref :mB :pB)]}))
;; annC is FILED under annA only, but holds a mark authored on annA's
;; content AND a mark authored on annB's content (C-tail + D-head)
pInA (s/make-proxy scene :annA 10 60)
pInB (s/make-proxy scene :annB 50 150)
scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB)
(with-group :annC {:type :annotation :in [:annA]
:marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}))]
;; MEMBERSHIP (listing) is exactly :in — asserted, single here
(is (= #{:annA} (s/membership scene :annC)))
(is (= :annA (s/home scene :annC))) ; primary = first :in
(is (s/child-of? scene :annA :annC))
(is (not (s/child-of? scene :annB :annC))) ; NOT filed under B → not listed there
(is (not (s/child-of? scene :root :annC)))
;; RESOLUTION (bars) is independent of membership: the cb mark still draws in
;; annB's lane because its FOOTAGE lands there, even though annC isn't filed in B
(is (= [[50 150 "cb"]] (s/lane-bars scene :annC (s/content-segments scene :annB))))
(is (seq (s/lane-bars scene :annC (s/content-segments scene :annA))))
;; filing annC into annB (an assertion) makes it LIST there too; bars unchanged
(let [scene2 (assoc-in scene [:groups :annC :in] [:annA :annB])]
(is (s/child-of? scene2 :annB :annC))
(is (= #{:annA :annB} (s/membership scene2 :annC)))
(is (= :annA (s/home scene2 :annC))) ; primary still first
(is (= [[50 150 "cb"]] (s/lane-bars scene2 :annC (s/content-segments scene2 :annB))))))))
(deftest jump-targets-label-from-the-clip-not-the-proxy
(testing "a discontinuous annotation's jump popover labels each target from the
CLIP it lands on (+ the frame within it), not from the mark's proxy-ref
start — which would give the proxy gid (→ a bare 'clip') and frame 0"
(let [pa (s/make-proxy base :root 0 50) ; within clip A
pc (s/make-proxy base :root 250 300) ; within clip C (non-adjacent → 2 runs)
scene (-> base (with-group :pa pa) (with-group :pc pc)
(with-group :ann {:type :annotation :in [:root]
:marks [(s/proxy-ref :ma :pa) (s/proxy-ref :mc :pc)]}))
segs (s/content-segments scene :root)
jumps (s/jump-targets scene :root :ann)]
(is (= 2 (count jumps))) ; two discontinuous runs
(is (not-any? #{:pa :pc} (map :seg jumps))) ; NOT the proxy gids ("clip 0f")
(is (every? (fn [j] (some #(= (:seg j) (:mark %)) segs)) jumps)) ; every :seg is a real content id → labelable
(is (= [:clip-a :clip-c] (mapv :seg jumps))) ; the clips the runs land on
(is (= [0 50] (mapv :f jumps)))))) ; frame within each clip (250 → C+50)
;; =========================================================================
;; Suite 3 — playhead & playback
;; =========================================================================
(deftest per-context-playhead
(testing "each context keeps its own playhead, independent of the stack"
(let [v (-> {} (s/set-playhead :root 30) (s/set-playhead :ann-x 80))]
(is (= 30 (s/playhead v :root))) (is (= 30 (s/playhead v :root)))
(is (= 80 (s/playhead v :ann-x))) (is (= 80 (s/playhead v :x)))
(is (= 0 (s/playhead v :ann-y)))))) ; unvisited -> 0 (is (= 0 (s/playhead v :unvisited)))))
(deftest source-to-local
(testing "source->local inverts local->source within a segment (video-clock playback)"
(let [segs (s/resolve inter-x :ann-x)] ; s0 = src[150,200) at local[0,50)
(is (= 10 (s/source->local segs 160))) ; src 160 -> local 10
(is (= 50 (s/source->local segs 0))) ; src 0 (start of s1) -> local 50
(is (nil? (s/source->local segs 999)))))) ; source not in view -> nil
(deftest recursive-following
(testing "a local frame in Y (nested 2 deep) resolves down Y->X->clip to source"
(let [segs (s/resolve x+y :ann-y)]
(is (= 165 (s/local->source segs 5))) ; inside y0 -> B src 165
(is (= 2 (s/local->source segs 12))) ; across the boundary -> A src 2
(is (= [:clip-b :clip-a] (map :thumb segs)))
(is (= [60 0] (map :thumb-start segs))))))
(deftest seek-only-at-boundaries
(testing "source advances 1:1 within a subclip and jumps only at a boundary"
(let [segs (s/resolve inter-x :ann-x)]
(is (= 1 (- (s/local->source segs 25) (s/local->source segs 24)))) ; within s0
(is (not= 1 (- (s/local->source segs 50) (s/local->source segs 49))))))) ; s0 -> s1
(deftest seed-from-otio (deftest seed-from-otio
(testing "from-otio seeds tracks + clip mark-groups + root; content-segments at root tiles the clips" (testing "from-otio seeds tracks + clip mark-groups + root; content-segments at root tiles the clips"
@ -444,220 +205,5 @@
media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))] media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))]
(is (seq media-ins)) (is (seq media-ins))
(is (every? integer? media-ins)) (is (every? integer? media-ins))
(is (every? integer? (mapcat (fn [[_ g]] (is (every? integer? (mapcat (juxt :start :source :duration)
(mapcat (juxt :start :end) (:marks g))) (filter #(= :clip (:type %)) (vals (:groups scene)))))))))
(:groups scene)))))))
(deftest selection-rejects-fractional-frames
(testing "a selection over fractional clip layout fails instead of changing frames"
(let [scene {:tracks {:t0 {:name "W"}}
:groups {:root {:type :timeline :parent nil :marks [{:id :m/r :start 0 :end 100}]}
:fr {:type :clip :parent nil :start 0.3 ; fractional timeline pos
:marks [{:id :m/fr :start 10.4 :end 110.4 :track :t0}]}}}
msg (err-msg #(s/selection->marks scene :root 20 60))]
(is (re-find #"integer frame" msg)))))
;; =========================================================================
;; Suite 4 — draft rows <-> marks (the two-input editor)
;; =========================================================================
(deftest seg-length-is-mark-time
(testing "a content segment's length is its visible length, in mark time"
(is (= 100 (s/seg-length (s/content-segments base :root) :clip-a)))))
(deftest seg-local-maps-mark-time-to-context
(testing "seg-local + selection->marks: a clip selection start A@0 → end C@100"
(let [segs (s/content-segments base :root)]
(is (= 0 (s/seg-local segs :clip-a 0)))
(is (= 150 (s/seg-local segs :clip-b 50)))
(let [la (s/seg-local segs :clip-a 0) lb (s/seg-local segs :clip-c 100)
marks (s/selection->marks base :root la lb)]
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) marks)))))))
(deftest frames-are-mark-time-under-parent-trim
(testing "frames are 0-based within the TRIMMED segment, not raw clip time"
(let [scene (with-group base :p
{:type :annotation :in [:root]
: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
(let [la (s/seg-local segs :m/s 0) lb (s/seg-local segs :m/s 30)
marks (s/selection->marks scene :p la lb)]
(is (= 1 (count marks)))
(is (= :m/s (get-in (first marks) [:start :ref])))
(is (= 0 (get-in (first marks) [:start :at])))
(is (= 30 (get-in (first marks) [:end :at])))))))
(deftest merge-bars-coalesces-continuous-integer-runs
(testing "integer-adjacent bars merge; fractional bars fail"
(is (= [[128 542]]
(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
(testing "a JSON-roundtripped annotation (string :type/:parent/:ref) is restored + resolves"
(let [json-like {:ann-1 {:type "annotation" :parent "root" :name "x"
:marks [{:id "m1" :start {:ref "clip-a" :at 0}
:end {:ref "clip-a" :at -1}}]}}
g (:ann-1 (s/restore-annotations json-like))]
(is (= :annotation (:type g)))
(is (= [:root] (:in g))) ; legacy :parent migrated to an :in edge
(is (nil? (:parent g))) ; and the old field is dropped
(is (= :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)))))))))
(defn- json-roundtrip [x]
(js->clj (js/JSON.parse (js/JSON.stringify (clj->js x))) :keywordize-keys true))
(deftest annotations-survive-json-roundtrip
(testing "restore-annotations is the exact inverse of the JSON wire trip — guards
against any keyword-valued field (id/ref/type/parent/track) being missed"
(let [anns {:ann-p {:v s/schema-version :type :annotation :in [:root] :name "p" :color "#abc" :content "hi"
:marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]}
:ann-c {:v s/schema-version :type :annotation :in [:ann-p] :name "c"
:marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}]
(is (= anns (s/restore-annotations (json-roundtrip anns)))))))
(deftest restore-keeps-nested-refs-matching-ids
(testing "a nested annotation's ref to a parent mark survives JSON (id + ref both keyworded)"
(let [json-anns {:ann-p {:type "annotation" :parent "root"
:marks [{:id "m-parent" :start {:ref "clip-a" :at 0}
:end {:ref "clip-a" :at -1}}]}
:ann-c {:type "annotation" :parent "ann-p"
:marks [{:id "m-child" :start {:ref "m-parent" :at 0}
:end {:ref "m-parent" :at 50}}]}}
scene (update base :groups merge (s/restore-annotations json-anns))]
(is (= :m-parent (get-in scene [:groups :ann-p :marks 0 :id]))) ; id keyworded
(is (= :m-parent (get-in scene [:groups :ann-c :marks 0 :start :ref]))) ; ref keyworded to match
(is (empty? (s/broken-marks scene :ann-c))) ; so it isn't "deleted"
(is (= [0 50] (:src (first (s/resolve scene :ann-c))))))))
(deftest marks-to-rows-normalises-frames
(testing "marks->rows is 1:1 with marks and normalises :at -1 to the length"
(let [rows (s/marks->rows base [{:id :m :start {:ref :clip-a :at 0}
:end {:ref :clip-a :at -1}}])]
(is (= 1 (count rows)))
(is (= {:seg :clip-a :f 0} (:s (first rows))))
(is (= {:seg :clip-a :f 100} (:e (first rows)))))))
;; =========================================================================
;; Suite 5 — a parent breaking a child's mark references
;; =========================================================================
(deftest broken-when-referenced-mark-deleted
(testing "deleting the referenced subclip dangles the child's mark"
(let [del (update-in x+y [:groups :ann-x :marks] #(vec (rest %)))] ; drop s0
(is (= [:m/y0] (s/broken-marks del :ann-y)))
(is (= "referenced clip deleted" (s/broken-reason del :ann-y))))))
(deftest broken-when-boundaries-shift-out-of-range
(testing "shrinking s0 below the child's :at makes the offset unreferenceable"
;; y0 refs s0 at 10..20; trim s0 to length 15 so 20 is past its end
(let [trim (assoc-in x+y [:groups :ann-x :marks 0 :end] {:ref :clip-b :at 65})]
(is (= 15 (s/length (s/resolve-mark trim :ann-x (get-in trim [:groups :ann-x :marks 0])))))
(is (= [:m/y0] (s/broken-marks trim :ann-y)))
(is (= "reference trimmed away" (s/broken-reason trim :ann-y))))))
(deftest broken-cascades-through-a-subclip
(testing "if the subclip's own ref breaks, the child referencing it breaks too"
(let [gone (update x+y :groups dissoc :clip-b)] ; s0 refs clip-b, y0 refs s0
(is (= [:m/y0] (s/broken-marks gone :ann-y)))
(is (= "referenced clip deleted" (s/broken-reason gone :ann-y))))))
(deftest healthy-annotation-has-no-reason
(testing "broken-reason is nil when every mark resolves"
(is (nil? (s/broken-reason x+y :ann-y)))))
(deftest repeats-are-unambiguous
(testing "two instances of A share a source frame but distinct locals (local is master)"
(let [scene (with-group base :ann
{:type :annotation :in [:root]
: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
(is (= 5 (s/local->source segs 205))) ; second A — same source frame
(is (= 100 (s/local->source segs 100)))))) ; crossing into B
;; =========================================================================
;; Suite — links (ref-points named in markdown content)
;; =========================================================================
(deftest parse-content-splits-text-and-links
(testing "content round-trips through link-token / parse-content"
(let [tok (md/link-token {:label "B-roll clip @10" :ref :clip-b :at 10})
s (str "see " tok " here")]
(is (= "[B-roll clip @10](mark:clip-b@10)" tok))
(is (= [[:text "see "]
[:link {:kind :frame :label "B-roll clip @10" :ref :clip-b :at 10}]
[:text " here"]]
(md/parse-content s))))
(testing "labels with parens and @ survive the round-trip"
(let [link {:kind :frame :label "CU Tashi (1) @0f" :ref :t2-c5 :at 0}]
(is (= [[:link link]] (md/parse-content (md/link-token link))))))
(testing "timeline links carry just a ref and round-trip"
(let [tl {:kind :timeline :label "Match point" :ref :ann-1}]
(is (= "[Match point](timeline:ann-1)" (md/link-token tl)))
(is (= [[:link tl]] (md/parse-content (md/link-token tl))))))
(is (= [] (md/parse-content "")))
(is (= [[:text "plain note"]] (md/parse-content "plain note")))))
(deftest path-to-builds-stack-and-drops-orphans
(let [scene {:groups {:root {:type :timeline :parent nil}
:a {:type :annotation :in [:root]}
:b {:type :annotation :in [:a]}
:orphan {:type :annotation :in [:gone]}}}]
(testing "path is root → … → target"
(is (= [:root] (s/path-to scene :root)))
(is (= [:root :a] (s/path-to scene :a)))
(is (= [:root :a :b] (s/path-to scene :b))))
(testing "an orphan (missing ancestor) has no path"
(is (nil? (s/path-to scene :orphan))))
(testing "timelines lists root + reachable annotations, not orphans"
(let [gids (set (map :gid (s/timelines scene)))]
(is (contains? gids :root))
(is (contains? gids :a))
(is (contains? gids :b))
(is (not (contains? gids :orphan)))))))
(deftest schema-migration
(testing "pre-versioned annotations are treated as v1 (the current schema)"
(is (= s/schema-version (:v (s/migrate {:type :annotation :name "x"})))))
(testing "migrate is idempotent at the current version"
(is (= s/schema-version (:v (s/migrate {:v s/schema-version :name "x"})))))
(testing "restore-annotations stamps :v on every annotation"
(is (= s/schema-version
(:v (get (s/restore-annotations {"a" {:type "annotation" :name "x"}}) "a"))))))
(deftest seg-point-and-link-local-round-trip
(testing "a clip-scoped point resolves back to the same ctx-local frame"
(let [seg (some #(when (= :clip-b (:mark %)) %) (s/content-segments base :root))
pt (s/seg-point base seg 10)]
(is (= {:ref :clip-b :at 10} pt))
(is (= 110 (s/link-local base :root pt))))))
(deftest link-local-absolute-is-the-frame
(testing "an absolute link (ref = ctx) is the local frame itself"
(is (= 42 (s/link-local base :root {:ref :root :at 42})))))
(deftest link-local-nil-when-target-gone
(testing "a link to a deleted clip no longer resolves"
(is (nil? (s/link-local (update base :groups dissoc :clip-b)
:root {:ref :clip-b :at 10})))))
(deftest linkables-groups-tracks-and-annotations
(testing "tracks (with their clips) and child annotations are pickable"
(let [ls (s/linkables base :root)
names (set (map :name ls))]
(is (contains? names "A-roll"))
(is (contains? names "B-roll"))
(is (= 1 (count (:items (some #(when (= "B-roll" (:name %)) %) ls)))))
(is (= {:ref :clip-b :at 0}
(:point (first (:items (some #(when (= "B-roll" (:name %)) %) ls)))))))
(testing "a discontinuous annotation collapses contiguous marks into runs"
(let [ann (some #(when (= :annotation (:kind %)) %) (s/linkables inter-x :root))]
(is (some? ann))
(is (= 1 (count (:items ann)))))))) ; X's four subclips tile [0,200) → one run