diff --git a/scenes/tests.py b/scenes/tests.py index 4a8ffdf..097c416 100644 --- a/scenes/tests.py +++ b/scenes/tests.py @@ -9,7 +9,7 @@ User = get_user_model() def ann(name, content="", **extra): - return {"type": "annotation", "parent": "root", "name": name, + return {"type": "annotation", "in": ["root"], "name": name, "content": content, "marks": [], **extra} diff --git a/tl/src/tl/db.cljs b/tl/src/tl/db.cljs index 25d42fb..aaea77a 100644 --- a/tl/src/tl/db.cljs +++ b/tl/src/tl/db.cljs @@ -17,8 +17,7 @@ ;; the whole scene graph (see tl.scene). Seeded from OTIO at load. :scene {:tracks {} - :groups {:root {:type :timeline :parent nil - :marks [{:id :root-m :start 0 :end 0}]}}} + :groups {:root {:type :timeline :name "root"}}} ;; view state :view {:stack [:root] ; timeline-stack; top = current context diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index e5773f5..e50e8b3 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -201,6 +201,7 @@ (-> (apply dissoc groups (map keyword deleted)) (into (remove (fn [[gid _]] (contains? drafts gid)) restored)))))))) + (rf/reg-event-fx ::refresh-project-detail (fn [{:keys [db]} _] @@ -463,7 +464,7 @@ (defn- draft-in-ctx [db ctx] (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]))) (defn- draft-mark-at [db ctx lf] @@ -489,7 +490,7 @@ (defn- mark-start-local [db ann mark-id] (let [scene (:scene db) - ctx (scene/home scene ann) + ctx (get-in db [:view :edit-context]) segs (scene/content-segments scene ctx)] (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]))) (some (fn [[gid g]] (when (:draft g) [gid g])) (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)) db (cond-> db ann (start-drawing-db ann mark-id) @@ -659,10 +660,10 @@ (assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))] (let [ctx (peek (get-in db [:view :stack]))] {:type :annotation :in [ctx] ; filed under the context it's born in - :draft :new :name "" :color "#4e8fc2" :marks [] - :v scene/schema-version})) + :draft :new :name "" :color "#4e8fc2" :marks []})) (assoc-in [:view :pt] :new) (assoc-in [:view :active-mark] nil) + (assoc-in [:view :edit-context] (peek (get-in db [:view :stack]))) (assoc-in [:view :draft-stage] :choosing)))) ;; 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) (assoc-in [:view :draft-stage] :creating)))) -(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit) - (assoc-in [:view :pt] :new)))) +(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)))) -;; Edit an annotation from a card. If its primary home isn't the context being -;; viewed, enter that home first so mark rows/handles edit in their authored -;; coordinate system. finish-edit pops this temporary context. -(rf/reg-event-fx - ::edit-annotation - (fn [{:keys [db]} [_ gid]] - (let [home (scene/home (:scene db) gid) - ctx (peek (get-in db [:view :stack])) - push-home? (and home (not= home ctx)) - fx (if push-home? (enter-ctx db #(conj % home)) {:db db})] - (update fx :db #(cond-> (-> % - (assoc-in [:scene :groups gid :draft] :edit) - (assoc-in [:view :pt] :new) - (assoc-in [:view :edit-pop-parent] nil)) - push-home? (assoc-in [:view :edit-pop-parent] home)))))) +(rf/reg-event-fx ::edit-annotation + (fn [_ [_ gid]] {:dispatch [::edit-draft gid]})) ;; 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 @@ -700,22 +692,21 @@ fx (if root? {:db db} (enter-ctx db pop))] (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit) (assoc-in [:view :pt] :new) + (assoc-in [:view :edit-context] (peek (get-in % [:view :stack]))) (assoc-in [:view :edit-return] (when-not root? gid))))))) (rf/reg-event-fx ::finish-edit (fn [{:keys [db]} _] ;; leaving the form (save OR cancel): tear down all authoring ;; transients so draw mode / pending points don't linger. (let [return-g (get-in db [:view :edit-return]) - pop? (some? (get-in db [:view :edit-pop-parent])) db (-> db (assoc-in [:view :draw] nil) (assoc-in [:view :active-mark] nil) (assoc-in [:view :pt] nil) (assoc-in [:view :draft-stage] nil) (assoc-in [:view :edit-return] nil) - (assoc-in [:view :edit-pop-parent] nil))] + (assoc-in [:view :edit-context] nil))] (cond return-g (enter-ctx db #(conj % return-g)) - pop? (enter-ctx db #(if (> (count %) 1) (pop %) %)) :else {:db db})))) (rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt))) ;; cancelling a draft is local only; saving a real annotation / deleting one @@ -728,21 +719,13 @@ (rf/reg-event-fx ::save-group (fn [{:keys [db]} [_ gid g orig]] - (let [g (cond-> (editable-group g) - (= :annotation (:type g)) (assoc :v scene/schema-version)) + (let [g (editable-group g) patch (group-patch orig g) root? (= :timeline (:type g)) ; the root timeline persists whole - id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks) - ;; proxies this annotation references are synthetic clips in the pool — - ;; persist them alongside it or the {:ref proxy} marks dangle on reload. - 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)))] + id (get-in db [:project :id])] (cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))} - (and id (or (seq patch) (seq proxies))) - (assoc :http-xhrio (api/put-scene id {:changed (merge {gid (if root? g patch)} proxies)} + (and id (seq patch)) + (assoc :http-xhrio (api/put-scene id {:changed {gid (if root? g patch)}} {:on-success [::scene-saved] :on-failure [::save-error]})))))) (rf/reg-event-fx ::delete-annotation @@ -753,24 +736,7 @@ id (assoc :http-xhrio (api/put-scene id {:deleted [gid]} {:on-success [::scene-saved] :on-failure [::save-error]})))))) -;; --- membership edges (:in): file an annotation under mark-groups ---------- -;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups -;; the annotation is filed under; the FIRST is the primary home (scene/home) — where -;; it's edited and its links resolve. Marks never move or re-cut — they resolve to -;; raw clips globally, and that only decides whether BARS draw in a context. Three -;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag / -;; file-into picker), remove (× on a chip). - -(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)))))) +;; --- visibility edges ---------------------------------------------------- (rf/reg-event-db ::ann-drag-start @@ -798,29 +764,16 @@ {:on-success [::scene-saved] :on-failure [::save-error]}))))) -;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps -;; existing edges (link); otherwise the edge you grabbed is moved off its source. -;; Marks are untouched either way. -(defn- file-edge [db gid new-parent add? source] - (let [scene (:scene db) - g (get-in scene [:groups gid]) - in (vec (:in g)) - clear #(-> % (assoc-in [:view :dragging-ann] nil) - (assoc-in [:view :dragging-ann-source] nil))] - (if (or (not= :annotation (:type g)) ; only annotations file - (:draft g) ; not mid-draft - (= gid new-parent) ; not under itself - (contains? (set in) new-parent) ; already filed there - (files-under? scene new-parent gid #{})) ; would make a cycle - {:db (clear db)} - (let [in' (if add? - (conj in new-parent) ; link: append, primary unchanged - (let [rest* (vec (remove #{source} in))] - (if (= source (first in)) - (into [new-parent] rest*) ; moved the primary → new home - (conj rest* new-parent)))) - g* (assoc g :in in')] - (update (persist-group db gid g g*) :db clear))))) +(defn- file-edge [db gid target add? source] + (let [g (get-in db [:scene :groups gid]) + edges (if add? (:in g) (remove #{source} (:in g))) + next-edges (vec (distinct (cond-> (vec edges) target (conj target)))) + db (update db :view dissoc :dragging-ann :dragging-ann-source)] + (if (and (= :annotation (:type g)) (not (:draft g)) (not= gid target) + (or (nil? target) + (contains? #{:annotation :timeline} (get-in db [:scene :groups target :type])))) + (persist-group db gid g (assoc g :in next-edges)) + {:db db}))) (rf/reg-event-fx ::reparent @@ -833,69 +786,33 @@ (fn [{:keys [db]} [_ gid target]] (file-edge db gid target true nil))) -;; remove one membership edge (× on a chip). Never the primary home, never the last. -(rf/reg-event-fx - ::unfile - (fn [{:keys [db]} [_ gid target]] - (let [g (get-in db [:scene :groups gid]) - in (vec (:in g))] - (if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1)) - {:db db} - (persist-group db gid g (assoc g :in (vec (remove #{target} in)))))))) +(rf/reg-event-fx ::unfile + (fn [{:keys [db]} [_ gid target]] + (file-edge db gid nil false target))) (rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil))) (rf/reg-event-db ::save-error (fn [db [_ failure]] (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 ::unset-endpoint - (fn [db [_ gid i which]] - (let [marks (get-in db [:scene :groups gid :marks]) - mark (get marks i) - keep (if (= which :start) (:end mark) (:start mark))] - (-> db (assoc-in [:scene :groups gid :marks] - (into (subvec marks 0 i) (subvec marks (inc i)))) - (assoc-in [:view :pt] {:seg (:ref keep) :f (:at keep) :mark mark :i i}))))) + (fn [db [_ gid mark-id which]] + (let [segs (scene/content-segments (:scene db) (get-in db [:view :edit-context])) + [lo hi] (scene/mark-extent (:scene db) gid mark-id segs)] + (assoc-in db [:view :pt] {:mark-id mark-id :which which + :keep (if (= which :start) hi lo)})))) -;; clear ONE endpoint of a proxy mark to re-pick it: remember the OPPOSITE -;; endpoint's ctx-local position (kept fixed) so the next clip-click only rerolls -;; the cleared side — the kept end never turns into the start (the old swap bug). -(rf/reg-event-db - ::unset-proxy-endpoint - (fn [db [_ gid mark-id pid which]] - (let [scene (:scene db) - ctx (scene/home scene gid) - segs (scene/content-segments scene ctx) - [lo hi] (scene/mark-extent scene gid mark-id segs)] - (assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)})))) - -;; complete a selection on the active draft: wrap the run [lo hi) in a proxy (a -;; synthetic clip), give the annotation one mark referencing it, make it active, -;; seek to its start, and drop into drawing mode ("select a range → you're drawing"). (defn- select-range-fx [db gid g lo hi] - (let [scene (:scene db) - p (scene/make-proxy scene (scene/home scene gid) lo hi) - pgid (keyword (str "prox-" (random-uuid))) - mid (str (random-uuid)) - sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)] - {:db (-> db (assoc-in [:scene :groups pgid] p) - (update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid)) - (assoc-in [:view :active-mark] mid) - (assoc-in [:view :playheads (scene/home scene gid)] lo) + (let [ctx (get-in db [:view :edit-context]) + mark (scene/make-mark (:scene db) ctx lo hi) + sf (scene/local->source (scene/content-segments (:scene db) ctx) lo)] + {:db (-> db (update-in [:scene :groups gid :marks] conj mark) + (assoc-in [:view :active-mark] (:id mark)) + (assoc-in [:view :playheads ctx] lo) (assoc-in [:view :pt] :new)) :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. (rf/reg-event-fx @@ -909,117 +826,65 @@ (rf/reg-event-fx ::draft-click-seg (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)) - segs (scene/content-segments scene (scene/home scene gid)) - pt (get-in db [:view :pt])] - (cond - ;; re-picking one endpoint of a proxy: roll only that side, keep the other - (: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))) - lo (min a b) hi (max a b) - old (:mark pt)] - (if old - ;; re-picking an endpoint: reconcile-run keeps the mark id for the - ;; piece on the kept clip; re-attach that mark's bindings, and splice - ;; the run back into its original slot so order is preserved. - (let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi) - (mapv (fn [m] (if (= (:id m) (:id old)) - (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. + ctx (get-in db [:view :edit-context]) + segs (scene/content-segments scene ctx) + pt (get-in db [:view :pt])] + (if (map? pt) + (let [a (if (:mark-id pt) (:keep pt) (scene/seg-local segs (:seg pt) (:f pt))) + b (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id))) + lo (min a b) hi (max a b)] + (if-let [mid (:mark-id pt)] + {:db (-> db + (update-in [:scene :groups gid :marks] + (fn [marks] (mapv #(if (= mid (:id %)) + (assoc % :parts (scene/selection->parts scene ctx lo hi)) %) + marks))) + (assoc-in [:view :pt] :new))} (select-range-fx db gid g lo hi))) - - :else {:db (assoc-in db [:view :pt] {:seg seg-id :f (or frame 0)})})))) -;; remove mark `i` from `gid`; if it referenced a proxy, drop the now-orphaned -;; 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]] - (let [marks (get-in db [:scene :groups gid :marks]) - pid (get-in marks [i :start :ref]) - 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))))) +(rf/reg-event-db ::remove-mark + (fn [db [_ gid i]] + (update-in db [:scene :groups gid :marks] + #(into (subvec % 0 i) (subvec % (inc i)))))) -;; 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 - ::reroll-proxy - (fn [db [_ ann mark-id la lb]] + ::resize-mark + (fn [db [_ gid mid la lb]] (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])) - len (scene/length (scene/content-segments scene ctx)) - la (scene/assert-frame "proxy roll start" la) - lb (scene/assert-frame "proxy roll end" lb) - la* (max 0 (min la (dec len))) - lb* (max (inc la*) (min lb len))] - (if (= :proxy (:type proxy)) - (assoc-in db [:scene :groups pid] (scene/roll-proxy scene ctx proxy la* lb*)) - db)))) + ctx (peek (get-in db [:view :stack])) + len (scene/length (scene/content-segments scene ctx)) + lo (max 0 (min (scene/assert-frame "range start" la) (dec len))) + hi (max (inc lo) (min (scene/assert-frame "range end" lb) len))] + (update-in db [:scene :groups gid :marks] + (fn [marks] (mapv #(if (= mid (:id %)) + (assoc % :parts (scene/selection->parts scene ctx lo hi)) %) + marks)))))) -;; numeric endpoint edit from the pane: set a proxy's boundary internal mark's -;; :at directly (the collapsed row's start = first mark's start, end = last mark's -;; end). In-place within one clip — no boundary crossing (that's the lane handles). (rf/reg-event-db - ::set-proxy-frame - (fn [db [_ pid which frame]] - (let [frame (scene/assert-frame "proxy endpoint frame" frame) - marks (get-in db [:scene :groups pid :marks]) - idx (if (= which :start) 0 (dec (count marks)))] - (assoc-in db [:scene :groups pid :marks idx which :at] frame)))) + ::set-mark-frame + (fn [db [_ gid mid which frame]] + (update-in db [:scene :groups gid :marks] + (fn [marks] + (mapv (fn [m] + (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 -;; 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. +;; Adding footage and making it visible in the authoring context is one edit. (rf/reg-event-fx ::associate-marks (fn [{:keys [db]} [_ draft-gid target-gid]] (let [marks (get-in db [:scene :groups draft-gid :marks]) orig-t (get-in db [:scene :groups target-gid]) - ;; adding marks does NOT change placement — membership is asserted, never - ;; derived from where marks were authored. To also list C in this context, - ;; file it in explicitly (the ＋ picker / drag). - target (update orig-t :marks (fnil into []) marks) + target (-> orig-t + (update :marks (fnil into []) marks) + (update :in #(vec (distinct (conj (vec %) (get-in db [:view :edit-context])))))) 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]) db (-> db (assoc-in [:scene :groups target-gid] (assoc target :draft :edit)) @@ -1029,6 +894,6 @@ (assoc :save-error nil))] (cond-> {:db db} (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-failure [::save-error]})))))) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index a8fc6cd..ce5813e 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -1,21 +1,8 @@ (ns tl.scene - "The scene graph: a flat pool of mark-groups (the only non-mark-group thing is - :tracks). Everything here is pure — see data_model.org. - - Conventions - - ranges are HALF-OPEN [start end); length = end - start. - - a point is either - 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]}." + "Annotations own ordered marks; marks own ordered root-clip slices. + :in contains visibility edges only. All frame ranges are integer [start,end)." (:refer-clojure :exclude [resolve])) -(defn- grp [scene gid] (get-in scene [:groups gid])) - (defn frame? "True when `n` is a concrete integer frame coordinate." [n] @@ -38,17 +25,10 @@ (throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi]))))) [lo hi]) -(defn- find-mark - "[owning-gid mark] for a mark id anywhere in the scene, or nil." - [scene mid] - (some (fn [[gid g]] - (some (fn [m] (when (= mid (:id m)) [gid m])) (:marks g))) - (:groups scene))) - ;; --- flat helpers over resolved segments --------------------------------- (defn length [segs] - (if (seq segs) (-> segs last :local second) 0)) + (reduce max 0 (map (comp second :local) segs))) (defn local->source "The source frame shown at local frame `lf` (clamped to the end)." @@ -82,7 +62,8 @@ (assert-range "segment local" local) (let [[a b] src [c _] local lo (max sa a) hi (min sb b)] - (when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))]))) + (when (or (< lo hi) (and (= sa sb) (<= a sa) (< sa b))) + [(+ c (- lo a)) (+ c (- hi a))]))) segs))) (defn merge-bars @@ -110,7 +91,7 @@ (assert-range "segment local" local) (let [[a _] src [c d] local 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] :src [(+ a (- lo c)) (+ a (- hi c))]) (:thumb-start seg) (update :thumb-start + (- lo c)))))) @@ -118,640 +99,181 @@ (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 - "Resolved segments (local 0-based) of a referenceable id: a group (clip, - timeline, proxy, annotation) or a single mark. One segment for a clip/subclip - by the ref invariant; several for a proxy or an arrangement group." - [scene id] - (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)) +(defn- concatenate [segments] + (reduce (fn [out {:keys [local] :as segment}] + (let [offset (or (some-> out peek :local second) 0)] + (conj out (assoc segment :local [offset (+ offset (- (second local) (first local)))])))) + [] segments)) -;; --- ref :at <-> source : the ONE interpretation of a ref's :at ----------- -;; {:ref id :at n}'s :at is a LOCAL frame of id's OWN resolved timeline (n<0 from -;; the end, -1 = the exclusive end). Every :at<->frame conversion goes through -;; id's FULL resolution (target-segs) + the flat helpers, so it is correct whether -;; id is one clip or a scattered multi-clip proxy. Do NOT summarise a target to a -;; single [xs xe] span — that only holds for a single contiguous segment. - -(defn- ref-len [scene ref] (length (target-segs scene ref))) - -(defn- at->local - "Normalise a ref's :at (n<0 from the end) to a non-negative local frame." - [scene ref at] - (if (neg? at) (+ (ref-len scene ref) at 1) at)) - -(defn- at->src - "Source frame at ref point {:ref :at} — id's own local frame → source — or nil - if the ref dangles or the frame falls outside id." - [scene ref at] - (when-let [segs (seq (target-segs scene ref))] - (let [l (at->local scene ref at)] - (when (<= 0 l (length segs)) - (local->source segs l))))) - -(defn- src->at - "Target-local :at for source frame `src` within `ref` — source → id's own - local frame — or nil if outside id." - [scene ref src] - (some-> (seq (target-segs scene ref)) (source->local src))) - -(defn- point-frame - "Resolve a point (living in group `gid`) to {:frame :track}, or nil if a ref - dangles." - [scene gid point] - (cond - (number? point) - (let [parent (home scene gid)] - {: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-mark [scene _ {:keys [id parts]}] + (mapv #(assoc % :mark id) (concatenate (keep #(clip-segment scene %) parts)))) (defn resolve - "A mark-group → its local timeline: ordered segments laid end to end. Broken - marks (dangling refs) are skipped." + "Compile a group to source segments. Visibility never participates." [scene gid] - (loop [[m & more] (:marks (grp scene gid)), off 0, out []] - (if (nil? m) - out - (if-let [segs (seq (resolve-mark 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 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))))) + (let [{:keys [type marks duration]} (get-in scene [:groups gid])] + (case type + :clip (if-let [seg (clip-segment scene {:clip gid :start 0 :end duration})] + [(assoc seg :mark gid)] []) + :timeline (->> (:groups scene) + (keep (fn [[id {:keys [type start]}]] + (when (= type :clip) + (let [seg (first (resolve scene id))] + (assoc seg :local [start (+ start (length [seg]))]))))) + (sort-by (comp first :local)) vec) + :annotation (concatenate (mapcat #(resolve-mark scene gid %) marks)) + []))) (defn content-segments - "The clip-segments that make up context `ctx` — what you draw and select - against. An annotation's marks reference clips, so that's just `resolve` — but - with each piece kept distinct (see content-resolve), not flattened under the - annotation's own mark id. The root timeline doesn't enumerate its clips (they're - a parentless pool), so there it's the pool laid at each clip's TIMELINE position - (:start) with :src = its source range — so the assembled program tiles - contiguously even though the underlying source frames are scattered (and - fractional)." + "Occurrence IDs belong to the view; persisted slices always identify raw clips." [scene ctx] - (if (= :timeline (:type (grp 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))) + (mapv (fn [i seg] (assoc seg :mark [ctx i])) (range) (resolve scene ctx))) -(defn- src-intersect - "Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))." - [rs cover] - (vec (for [[a b] rs [c d] cover - :let [lo (max a c) hi (min b d)] - :when (< lo hi)] - [lo hi]))) +(defn project-bars + "Project onto every matching clip occurrence; merge only context-contiguous pieces." + [segments context] + (merge-bars + (mapcat (fn [{:keys [thumb] [a b] :src}] + (pieces (filter #(= thumb (:thumb %)) context) a b)) + segments))) -(defn lane-bars - "Context-local display bars for annotation `gid`, grouped PER MARK: contiguous - pieces coalesce WITHIN a mark but never across marks, so two abutting-but- - distinct marks stay separate bars — the lane bar matches each mark's highlight - 1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id - lets the lane hit-test / highlight / edit one mark; consumers that only want - the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments. +(defn mark-bars [scene gid mid context] + (project-bars (filter #(= mid (:mark %)) (resolve scene gid)) context)) - `resolve` already trims each mark through its whole ref chain — a nested mark - is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ … - ⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs` - is all the clipping needed (no ancestor re-walk — that was redundant)." - [scene gid ctx-segs] - (->> (resolve scene gid) - (partition-by :mark) - (mapcat (fn [ss] - (let [mid (:mark (first ss))] - (map (fn [[lo hi]] [lo hi mid]) - (merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b)) ss)))))) - vec)) +(defn lane-bars [scene gid context] + (vec (mapcat (fn [{:keys [id] :as mark}] + (map (fn [[lo hi]] [lo hi id]) + (project-bars (resolve-mark scene gid mark) context))) + (get-in scene [:groups gid :marks])))) -(defn mark-extent - "EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true - min piece-start / max piece-end, without merge-bars. Endpoint editing must use - this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` = - content-segments of ctx." - [scene gid mark-id ctx-segs] - (let [pcs (->> (resolve scene gid) - (filter #(= mark-id (:mark %))) - (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))] - (when (seq pcs) - [(reduce min (map first pcs)) (reduce max (map second pcs))]))) +(defn mark-extent [scene gid mid context] + (let [bars (mark-bars scene gid mid context)] + (when (seq bars) [(ffirst bars) (second (last bars))]))) -;; --- placement: :in membership edges -------------------------------------- -;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered -;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under -;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in -;; it. The FIRST element is the primary home (where its :content links resolve and -;; where it's edited); the whole vector as a set is its membership. Marks are never -;; moved or re-cut — they resolve to raw clips globally, and that only decides -;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it -;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary. +(defn broken-marks [scene gid] + (->> (get-in scene [:groups gid :marks]) + (filter #(or (empty? (:parts %)) + (some (fn [part] (nil? (clip-segment scene part))) (:parts %)))) + (mapv :id))) -(defn home - "The primary home of `gid`: the first `:in` edge for an annotation (where its - description links resolve and where it's edited); the structural `:parent` for - anything else (nil for the flat clip/proxy pool and the root timeline)." - [scene gid] - (let [g (grp scene gid)] - (if (= :annotation (:type g)) (first (:in g)) (:parent g)))) +(defn broken-reason [scene gid] + (when (seq (broken-marks scene gid)) "missing clip or invalid range")) -(defn membership - "The set of mark-groups annotation `gid` is filed under (its `:in` edges)." - [scene gid] - (set (:in (grp scene gid)))) +(defn membership [scene gid] + (set (get-in scene [:groups gid :in]))) -(defn child-of? - "Is annotation `gid` filed under `ctx`?" - [scene ctx gid] +(defn child-of? [scene ctx gid] (contains? (membership scene gid) ctx)) -(defn clip-loss? - "True when annotation `gid` loses content once clipped to its primary home — it - references frames outside that parent annotation, so it's (partly) out of range - there. Timeline/root homes contain everything, so they never warn." - [scene gid] - (let [p (home scene gid)] - (when (and p (= :annotation (:type (grp scene p)))) - (let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs))) - own (mapv :src (resolve scene gid))] - (< (len (src-intersect own (mapv :src (resolve scene p)))) (len own)))))) +(defn selection->parts [scene ctx lo hi] + (mapv (fn [{:keys [thumb thumb-start] [a b] :src}] + {:clip thumb :start thumb-start :end (+ thumb-start (- b a))}) + (slice (content-segments scene ctx) lo hi))) -;; --- 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 - "Split local range [la lb) of context `ctx` into a run of single-clip ref - marks, one per content segment it crosses (the 'no cross-clip marks' rule). - Each references the segment's source id with the right offsets. Inputs and - derived offsets must already be integer frames." - [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 seg-length [segs mid] + (some (fn [{m :mark [lo hi] :local}] (when (= m mid) (- hi lo))) segs)) -(defn reconcile-run - "Re-derive the run for selection [la lb), REUSING the id of any `old-run` mark - 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)))) +(defn seg-local [segs mid frame] + (some (fn [{m :mark [lo _] :local}] (when (= m mid) (+ lo (or frame 0)))) segs)) -;; --- proxy synthetic-clips ------------------------------------------------ -;; A proxy is a mark-group {:type :proxy} in the flat pool whose marks are the -;; per-clip run of a selection (selection->marks). An annotation references the -;; WHOLE proxy with a single mark {:ref P :at 0 → :at -1}, so the pane shows one -;; collapsed row and the lane one bar, while endpoint edits mutate the proxy's -;; 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- restore-mark [mark] + (cond-> (-> mark (update :id keyword) + (update :parts #(mapv (fn [part] (update part :clip keyword)) %))) + (:notes mark) (update :notes #(mapv keyword %)) + (:drawings mark) (update :drawings #(mapv keyword %)))) -(defn make-proxy - "A new proxy mark-group for selection [la lb) of context `ctx`. No gid yet — - the caller assigns one when inserting it into the pool." - [scene ctx la lb] - {:type :proxy :parent nil :marks (selection->marks scene ctx la lb)}) - -(defn roll-proxy - "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-group [group] + (cond-> (update group :type keyword) + (:in group) (update :in #(mapv keyword %)) + (:marks group) (update :marks #(mapv restore-mark %)) + (:notes group) (update :notes #(mapv keyword %)) + (:regions group) (update :regions #(mapv (fn [r] (-> r (update :id keyword) + (update :kind keyword))) %)))) (defn restore-annotations - "Re-keywordize the fields that lose their keyword-ness through JSON (string - :type/:parent and mark :refs), then migrate each annotation to the current - schema version, before merging into the (keyword-keyed) scene." - [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)) + "Decode identifiers in the current JSON format." + [groups] + (update-vals groups restore-group)) -(defn display-point - "A ref-point {:ref :at} as a display cell {:seg :f}: the target id plus its OWN - local frame (context-local, whole-frame; not translated to the raw clip). The - shared basis for both the annotation editor rows and the jump popover, so they - can never disagree on how a point reads." - [scene {:keys [ref at]}] - {:seg ref :f (assert-frame "display point" (at->local scene ref at))}) - -(defn- clip-row - "Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time." - [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 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 marks->rows [_ marks] + (mapv (fn [{:keys [parts]}] + {:s {:seg (:clip (first parts)) :f (:start (first parts))} + :e {:seg (:clip (last parts)) :f (:end (last parts))}}) + marks)) (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 - "Seed a scene from tl.otio/parse output: a video :track per source track, one - clip mark-group per clip (source range + track), and the root timeline. The - otio is only a seed — nothing here reads it again. +(defn clip-name [scene gid] (get-in scene [:groups gid :name])) +(defn ref-length [scene gid] (length (resolve scene gid))) +(defn ref-track-name [scene gid] + (get-in scene [:tracks (:track (first (resolve scene gid))) :name])) - Clip ranges are integer frame ranges. Fractional OTIO input is rejected before - this point; from here on, frame math asserts instead of snapping." - [{:keys [duration tracks]}] - (assert-frame "OTIO duration" duration) - (let [vtracks (filter #(= :video (:kind %)) tracks) - track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks) - clips (into {} (for [t vtracks c (:clips t)] - (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 seg-point [_ {:keys [thumb thumb-start]} frame] + {:ref thumb :at (+ thumb-start (or frame 0))}) -(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) ------------ -;; A mark collected into an annotation from another timeline (transclusion) has a -;; ref whose clip isn't in the CURRENT context's content-segments, so the context -;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip -;; instead — the mark's own timeline — so the row reads correctly from anywhere. +(defn jump-targets [scene ctx gid] + (let [segs (content-segments scene ctx)] + (mapv (fn [[lo _]] + (let [seg (some (fn [{[a b] :local :as seg}] + (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 - "Own resolved length (frames) of ref target `ref`, context-independent." - [scene ref] - (length (target-segs scene ref))) +(defn linkables [scene ctx] + (let [segs (content-segments scene ctx) + tracks (for [[track segments] (group-by :track segs)] + {: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 - "Name of the TRACK that ref target `ref` resolves onto (its first piece), - context-independent — the useful label for a transcluded mark whose clip isn't - in the current view. The clip's own :name is the shared source file (e.g. - \"Challengers.mov\") — identical for every clip of single-source footage — so - the track (A-roll / B-roll …) is what actually distinguishes them. nil if the - ref dangles." - [scene ref] - (when-let [t (:track (first (target-segs scene ref)))] - (get-in scene [:tracks t :name] (name t)))) +(defn path-to [scene gid] + (when (get-in scene [:groups gid]) + (if (= gid :root) [:root] [:root gid]))) -;; --- links ---------------------------------------------------------------- -;; A link is a ref-point {:ref id :at n} — the same shape as a mark endpoint, so -;; it resolves through the usual machinery — named inside an annotation's markdown -;; 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 :seg :f}." - [scene ctx gid] - (let [csegs (content-segments scene ctx)] - (mapv (fn [{:keys [lo]}] - (let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs) - (some (fn [{[_ d] :local :as s} ] (when (= d lo) s)) csegs) - (last csegs))] - {:local lo - :seg (:mark seg) - :f (assert-frame "jump target frame" (- lo (first (:local seg [0 0]))))})) - (runs scene ctx gid)))) - -(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] +(defn timelines [scene] (->> (:groups scene) (keep (fn [[gid g]] (when (and (= :annotation (:type g)) (not (:draft g))) - (when-let [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}))))) + {:gid gid :name (or (:name g) (name gid)) :path (path-to scene gid)}))) (sort-by :name) - (into [{:gid :root :name "root" :in nil :path [:root]}]))) + (into [{:gid :root :name "root" :path [:root]}]))) diff --git a/tl/src/tl/storage.cljs b/tl/src/tl/storage.cljs deleted file mode 100644 index ab2c94d..0000000 --- a/tl/src/tl/storage.cljs +++ /dev/null @@ -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)))) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 388c1fb..cc22748 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -6,6 +6,7 @@ (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 ::edit-context (fn [db] (get-in db [:view :edit-context]))) (rf/reg-sub ::pt (fn [db] (get-in db [:view :pt]))) ;; routing / projects / auth @@ -61,7 +62,7 @@ (fn [scene _] (->> (scene/timelines scene) (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), ;; 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 ;; next bar only (no double-highlight, no drawing bleeding onto the next clip). (defn- in-bars? [bars ph] - (some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars)) + (some (fn [[lo hi]] (or (= lo hi ph) (and (<= lo ph) (< ph hi)))) bars)) (defn annotations-by-parent "Group annotation cards by every reference parent they belong to." @@ -135,16 +136,8 @@ :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] (fn [[scene ctx segs revealed] _] (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid])))) - exists? (fn [x] (contains? (:groups scene) x)) - ;; each annotation → the mark-groups it's FILED UNDER (:in membership). A - ;; normal annotation has one; a linked one has several, so it lists under - ;; each. Asserted, not derived from where marks resolve. Any :in host that - ;; no longer exists (its group was deleted) is dropped; an annotation left - ;; with NO surviving host is rescued to root so it stays visible/refileable - ;; instead of vanishing into a ghost parent. parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))] - (let [ms (filter exists? (scene/membership scene gid))] - [gid (if (seq ms) (set ms) #{:root})]))) + [gid (scene/membership scene gid)])) ;; child count per timeline (drives the "Show N" nested badge) nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents)) ;; 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 (when (shown? gid #{}) (let [reason (scene/broken-reason scene gid) - oor (boolean (scene/clip-loss? scene gid)) hidden (get-in g [:meta :hidden]) note-ids (->> (concat (:notes g) (mapcat :notes (:marks g))) distinct @@ -175,16 +167,15 @@ note-ids) jumps (scene/jump-targets scene ctx gid) clips (->> (:marks g) - (mapcat (fn [m] [(get-in m [:start :ref]) - (get-in m [:end :ref])])) - (concat (map :seg jumps)) + (mapcat :parts) + (map :clip) (keep (fn [ref] (let [cg (get-in scene [:groups ref])] (or (:name cg) (get-in cg [:media :name]) (some-> ref name))))) distinct)] - {:id gid :parent (scene/home scene gid) ; primary home = first :in + {:id gid ;; the mark-groups this annotation is filed under (:in) — the ;; pane groups by this, so a linked annotation lists under each. :parents (parents gid) @@ -197,7 +188,7 @@ :notes note-ids :script (vec (remove nil? note-text)) :clips (vec clips) - :broken (boolean reason) :reason reason :oor oor + :broken (boolean reason) :reason reason :hidden (boolean hidden) :tags (vec (get-in g [:meta :tags])) ;; 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 ;; 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. -(defn- binding-bars [scene ctx segs bound] - (into [] - (mapcat - (fn [[gid g]] - ;; child annotations of the context OR the context annotation itself - ;; (pushing the owner onto the stack makes ctx that annotation) - (when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid))) - (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)))] +(defn- binding-bars [scene ctx segs annotations bound] + (vec + (mapcat (fn [gid] + (let [g (get-in scene [:groups gid])] (concat - ;; annotation-level bindings (notes only; drawings bind per-mark) - (when-let [gs (seq (bound g))] [{:gids gs :bars (->bars src-segs)}]) - ;; per-mark bindings + (when (seq (bound g)) + [{:gids (bound g) :bars (scene/project-bars (scene/resolve scene gid) segs)}]) (for [m (:marks g) :when (seq (bound m))] - {:gids (bound m) :bars (->bars (get by-mark (:id m)))})))))) - (:groups scene))) + {:gids (bound m) :bars (scene/mark-bars scene gid (:id m) segs)})))) + (conj (set (map :id annotations)) ctx)))) (rf/reg-sub ::drawing-bars - :<- [::scene] :<- [::context] :<- [::segments] - (fn [[scene ctx segs] _] (binding-bars scene ctx segs :drawings))) + :<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations] + (fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :drawings))) (rf/reg-sub ::note-bars - :<- [::scene] :<- [::context] :<- [::segments] - (fn [[scene ctx segs] _] (binding-bars scene ctx segs :notes))) + :<- [::scene] :<- [::context] :<- [::segments] :<- [::all-annotations] + (fn [[scene ctx segs annotations] _] (binding-bars scene ctx segs annotations :notes))) (defn- gids-at [entries ph] (persistent! diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index e0e785e..c190709 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -485,7 +485,7 @@ (frame-index "drag end frame" (+ hi d))] :start [(frame-index "drag start frame" (+ lo d)) hi] :end [lo (frame-index "drag end frame" (+ hi d))])] - (rf/dispatch [::events/reroll-proxy ann mark-id la lb]))))) + (rf/dispatch [::events/resize-mark ann mark-id la lb]))))) up (fn up [_] (.removeEventListener js/document "mousemove" move) (.removeEventListener js/document "mouseup" up) @@ -1152,7 +1152,6 @@ (r/with-let [adding? (r/atom false)] (let [gid (:id a) homes (:parents a) - prim (:parent a) cands (->> (:groups scene) (keep (fn [[g grp]] (when (and (contains? #{:annotation :timeline} (:type grp)) @@ -1169,7 +1168,7 @@ [::events/pop-to :root] [::events/expand h]))} (group-name scene h) - (when (and authed? (not= h prim)) + (when authed? [:button.in-x {:type "button" :title "Un-file" :on-click (fn [e] (.stopPropagation e) (rf/dispatch [::events/unfile gid h]))} "✕"])]) @@ -1362,10 +1361,8 @@ ;; edit button — Edit drops into the parent timeline so marks are editable. (let [cg (get-in scene [:groups ctx])] [: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)) - [content-display scene (or (scene/home scene ctx) ctx) (:content cg)] + [content-display scene ctx (:content cg)] [:div.muted "No description yet."]) (when authed? [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])]) @@ -1393,39 +1390,18 @@ (defn- pt-len [scene segs seg] (or (scene/seg-length segs seg) (scene/ref-length scene seg))) -(defn- frame-chip - "A filled endpoint: clip name + a mark-time frame input (edits `put` the group). - The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)." - [scene segs put d i k {:keys [seg f]}] - (let [len (pt-len scene segs seg)] +(defn- frame-chip [scene segs gid mark-id which {:keys [seg f]}] + (let [len (scene/ref-length scene 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 #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}] - [:span.pt-dur (str "/" len)] - [:button.pt-chip-x {:type "button" :title "Re-pick this end" - :on-click (fn [e] - (.stopPropagation e) - (rf/dispatch [::events/unset-endpoint (:gid d) i k]))} "✕"]])) - -(defn- proxy-frame-chip - "Editable endpoint for a proxy (synthetic-clip) mark: clip name + frame input - that edits the proxy's OWN boundary internal mark's :at in place (`which` = - :start on its first mark, :end on its last). Crossing a clip boundary is the - lane handles' job; this is the whole-frame numeric nudge within a clip. The ✕ - clears just this end to re-pick it (the other end stays put)." - [scene segs gid mark-id pid which {:keys [seg f]}] - (let [len (pt-len scene segs seg)] - [:div.pt-chip - [:span.pt-chip-name (pt-name scene segs seg)] - [:input.pt-frame {:type "number" :min 0 :max len :value f - :on-change #(rf/dispatch [::events/set-proxy-frame pid which + :on-change #(rf/dispatch [::events/set-mark-frame gid mark-id which (to-frame (.. % -target -value) len)])}] [:span.pt-dur (str "/" len)] [:button.pt-chip-x {:type "button" :title "Re-pick this end" :on-click (fn [e] (.stopPropagation e) - (rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which]))} "✕"]])) + (rf/dispatch [::events/unset-endpoint gid mark-id which]))} "✕"]])) (defn- pending-frame-chip [scene segs {:keys [seg f]}] (let [len (pt-len scene segs seg)] @@ -1537,10 +1513,7 @@ last-scrolled (atom nil)] (let [d @(rf/subscribe [::subs/draft-group]) scene @(rf/subscribe [::subs/scene]) - ;; anchor the form to the draft's home context, not the live stack top: - ;; 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 + ctx @(rf/subscribe [::subs/edit-context]) segs (scene/content-segments scene ctx) pt @(rf/subscribe [::subs/pt]) linking @(rf/subscribe [::subs/linking]) @@ -1625,34 +1598,23 @@ (reset! mark-drag {:src i}))} "⠿"] (when (contains? broken mark-id) [:span.ann-warn {:title "This mark's clip/reference no longer resolves"} "△ "]) - ;; a proxy collapses its cross-clip run to first-clip start → - ;; last-clip end; each endpoint edits the proxy's own boundary - ;; mark's frame (crossing a clip boundary is the lane handles). - ;; A plain clip mark edits its own :at directly. - (if-let [pid (:proxy row)] - ;; while re-picking one end (after its ✕) that end becomes a live - ;; clip picker in the row; the other end stays a normal chip. - (let [pick (when (and (map? pt) (= (:proxy pt) pid)) (:which pt))] - [:<> - (if (= pick :start) - [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true - :placeholder "click a clip for start…" - :on-cancel #(rf/dispatch [::events/draft-focus :new]) - :on-pick #(when-let [p (local->draft-point segs (:local %))] - (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] - [proxy-frame-chip scene segs gid mark-id pid :start (:s row)]) - [:span.mark-arrow "→"] - (if (= pick :end) - [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true - :placeholder "click a clip for end…" - :on-cancel #(rf/dispatch [::events/draft-focus :new]) - :on-pick #(when-let [p (local->draft-end-point segs (:local %))] - (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] - [proxy-frame-chip scene segs gid mark-id pid :end (:e row)])]) + (let [pick (when (= (:mark-id pt) mark-id) (:which pt))] [:<> - [frame-chip scene segs put d i :start (:s row)] + (if (= pick :start) + [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true + :placeholder "click a clip for start…" + :on-cancel #(rf/dispatch [::events/draft-focus :new]) + :on-pick #(when-let [p (local->draft-point segs (:local %))] + (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] + [frame-chip scene segs gid mark-id :start (:s row)]) [:span.mark-arrow "→"] - [frame-chip scene segs put d i :end (:e row)]]) + (if (= pick :end) + [point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true + :placeholder "click a clip for end…" + :on-cancel #(rf/dispatch [::events/draft-focus :new]) + :on-pick #(when-let [p (local->draft-end-point segs (:local %))] + (rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}] + [frame-chip scene segs gid mark-id :end (:e row)])]) [:button.mark-draw {:type "button" :class (when (seq (:drawings mark)) "has") :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] ^{:key (name ng)} [mark-note-chip ng n live #(rf/dispatch [::events/unbind-note-mark gid mark-id %])]))))])) - (when (or (= pt :new) (and (map? pt) (not (:proxy pt)))) + (when (or (= pt :new) (and (map? pt) (not (:mark-id pt)))) [pending-mark-block {:scene scene :ctx ctx :segs segs :pt pt :choosing? choosing?}]) [:div.form-hint "Drag across the timeline to select a range (click to move the playhead)."]]) (when-not choosing? diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs index 6ba878d..2f6f066 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -1,245 +1,157 @@ (ns tl.flow-test - "Integration tests that drive the ACTUAL re-frame events the UI dispatches and - read the resulting scene AND live subscriptions back — via day8.re-frame.test's - run-test-sync, so subscriptions resolve in a real reactive context (no 'outside - reactive context' warnings) and dispatch is synchronous. A bug that lives in an - event handler or a subscription (not just a pure scene fn) is caught here. - - Placement model under test: an annotation's `:in` is an ordered vector of the - mark-groups it's FILED UNDER (first = primary home). Membership is asserted; - where marks resolve only decides whether bars draw. See tl.scene/membership." (:require [cljs.test :refer-macros [deftest is testing]] [day8.re-frame.test :as rf-test] [re-frame.core :as rf] [re-frame.db :as rdb] [tl.events :as ev] [tl.subs :as subs] - [tl.scene :as s])) + [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 :connect-scene :fetch-projects :poll-thumbnails :upload-project]] (rf/reg-fx k (fn [_] nil))) -;; four clips on four tracks, one shared source file; root spans [0,400) -(def clips-scene - {:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}} - :groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]} - :clip-a {:type :clip :parent nil :name "Challengers.mov" :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]} - :clip-b {:type :clip :parent nil :name "Challengers.mov" :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]} - :clip-c {:type :clip :parent nil :name "Challengers.mov" :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]} - :clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}}) - -(defn seed - "clips + annA (over clips A,B, filed under root) + annB (over C,D, filed under - root) + annC (one mark authored inside annA, FILED under annA)." - [] - (let [pA (s/make-proxy clips-scene :root 0 200) - pB (s/make-proxy clips-scene :root 200 400) - sc (-> clips-scene - (assoc-in [:groups :pA] pA) - (assoc-in [:groups :pB] pB) - (assoc-in [:groups :annA] {:type :annotation :in [:root] :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]}) - (assoc-in [:groups :annB] {:type :annotation :in [:root] :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]})) - pInA (s/make-proxy sc :annA 10 60)] - (-> sc (assoc-in [:groups :pInA] pInA) - (assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f" - :marks [(s/proxy-ref "ca" :pInA)]})))) +(defn seed [] + (let [sc (-> fixture/base + (fixture/annotation :a1 [:root] (s/make-mark fixture/base :root 0 100)) + (fixture/annotation :b1 [:root] (s/make-mark fixture/base :root 100 300)))] + (fixture/annotation sc :x [:a1] (s/make-mark sc :a1 10 60)))) (defn setup! [scene stack] - (reset! rdb/app-db {:scene scene :fps 24 - :view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20} - :project {:id nil}})) - + (reset! rdb/app-db {:scene scene :fps 24 :project {:id nil} + :view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}})) (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 pane-ids - "The set of annotation gids the pane sub currently lists (in the live context)." - [] - (set (map :id @(rf/subscribe [::subs/all-annotations])))) -(defn card [gid] (some #(when (= gid (:id %)) %) @(rf/subscribe [::subs/all-annotations]))) -(defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) -;; ========================================================================= -;; the annotation pane sub (::all-annotations) lists by membership -;; ========================================================================= +(deftest moves-edit-one-edge-in-both-directions + (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 (setup! (seed) [:root]) - (testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT" - (is (= #{:annA :annB} (pane-ids))) - (is (= :root @(rf/subscribe [::subs/context]))) - (is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)")) - (testing "pushing annA onto the stack lists annC (its child), not annA/annB" - (rf/dispatch [::ev/expand :annA]) - (is (= [:root :annA] (:stack (:view @rdb/app-db)))) - (is (= :annA @(rf/subscribe [::subs/context]))) - (is (contains? (pane-ids) :annC)) - (is (not (contains? (pane-ids) :annB)))) - (testing "collapsing returns to root's listing" - (rf/dispatch [::ev/collapse]) - (is (= #{:annA :annB} (pane-ids)))))) + (rf/dispatch [::ev/file-into :x :b1]) + (rf/dispatch [::ev/file-into :x :b1]) + (rf/dispatch [::ev/unfile :x :a1]) + (is (= [:b1] (:in (group :x)))) + (rf/dispatch [::ev/file-into :x :x]) + (is (= [:b1] (:in (group :x)))) + (rf/dispatch [::ev/file-into :x :missing]) + (is (= [:b1] (:in (group :x)))))) -;; ========================================================================= -;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched -;; ========================================================================= - -(deftest reparent-move-then-link +(deftest visibility-cycles-do-not-create-content-cycles (rf-test/run-test-sync (setup! (seed) [:root]) - (let [marks0 (get-in (scene*) [:groups :annC :marks])] - (testing "drag annC (grabbed under annA) onto root: the edge MOVES, primary follows" - (rf/dispatch [::ev/ann-drag-start :annC :annA]) - (rf/dispatch [::ev/reparent :annC :root]) ; add? falsey ⇒ move - (is (= [:root] (:in (get-in (scene*) [:groups :annC])))) - (is (= :root (s/home (scene*) :annC))) - (is (= marks0 (get-in (scene*) [:groups :annC :marks])) "marks untouched by a move")) - (testing "now annC lists at root and no longer under annA" - (setup! (assoc-in (scene*) [:view] {:stack [:root] :playheads {} :revealed #{} :zoom 1 :row-h 20}) [:root]) - (is (contains? (pane-ids) :annC)) - (rf/dispatch [::ev/expand :annA]) - (is (not (contains? (pane-ids) :annC)))) - (testing "⌥-drag (add?) links annC under annB WITHOUT removing root" - (rf/dispatch [::ev/collapse]) - (rf/dispatch [::ev/ann-drag-start :annC :root]) - (rf/dispatch [::ev/reparent :annC :annB true]) - (is (= #{:root :annB} (s/membership (scene*) :annC))) - (is (= :root (s/home (scene*) :annC)) "primary home unchanged by a link") - (is (= marks0 (get-in (scene*) [:groups :annC :marks]))))))) + (let [before (s/resolve (scene*) :a1)] + (rf/dispatch [::ev/file-into :a1 :x]) + (rf/dispatch [::ev/toggle-children :a1]) + (rf/dispatch [::ev/toggle-children :x]) + (is (= before (s/resolve (scene*) :a1))) + (is (= #{:a1 :b1 :x} (pane-ids)))))) -(deftest reparent-refuses-cycles-and-noops +(deftest associate-from-sibling-adds-footage-and-visibility (rf-test/run-test-sync - (setup! (seed) [:root]) - (testing "filing annA under annC (which is filed under annA) is refused — a cycle" - (rf/dispatch [::ev/file-into :annA :annC]) - (is (not (contains? (s/membership (scene*) :annA) :annC)))) - (testing "filing under a group it's already filed under is a no-op" - (let [before (:in (get-in (scene*) [:groups :annC]))] - (rf/dispatch [::ev/file-into :annC :annA]) - (is (= before (:in (get-in (scene*) [:groups :annC])))))) - (testing "an annotation can't be filed under itself" - (rf/dispatch [::ev/file-into :annC :annC]) - (is (not (contains? (s/membership (scene*) :annC) :annC)))))) - -;; ========================================================================= -;; unfile — remove one edge; never the primary home, never the last -;; ========================================================================= - -(deftest unfile-removes-links-only - (rf-test/run-test-sync - (setup! (seed) [:root]) - (rf/dispatch [::ev/file-into :annC :root]) ; annC now [:annA :root] - (is (= [:annA :root] (:in (get-in (scene*) [:groups :annC])))) - (testing "unfiling a non-primary link removes just that edge" - (rf/dispatch [::ev/unfile :annC :root]) - (is (= [:annA] (:in (get-in (scene*) [:groups :annC]))))) - (testing "the primary home can't be unfiled (nor the last remaining edge)" - (rf/dispatch [::ev/unfile :annC :annA]) - (is (= [:annA] (:in (get-in (scene*) [:groups :annC]))))))) - -;; ========================================================================= -;; adding marks from another context (associate-marks) does NOT move placement -;; ========================================================================= - -(deftest associate-marks-adds-marks-not-membership - (rf-test/run-test-sync - (setup! (seed) [:root]) - ;; drill into annB, author a range on ITS content, tie it to annC - (rf/dispatch [::ev/expand :annB]) + (setup! (seed) [:root :b1]) (rf/dispatch [::ev/open-draft]) (rf/dispatch [::ev/draft-select-range 50 150]) - (let [d (draft-gid)] - (is d "a draft exists after open-draft") - (is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB") - (rf/dispatch [::ev/associate-marks d :annC])) - (testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)" - (is (= 2 (count (get-in (scene*) [:groups :annC :marks])))) - (is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks")) - ;; associate opened annC in :edit; save it (drops :draft) and leave the form - (rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil]) - (rf/dispatch [::ev/finish-edit]) - (testing "so annC does NOT list under annB — even though its footage resolves there" - (is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB") - (is (= 1 (count (bars-in :annB :annC))) "but its B-mark DOES draw a bar in annB (resolution ≠ membership)") - (is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2)))) - (testing "filing it in explicitly is what makes it list under annB" - (rf/dispatch [::ev/file-into :annC :annB]) - (is (contains? (pane-ids) :annC)) - (is (= #{:annA :annB} (s/membership (scene*) :annC)))))) + (rf/dispatch [::ev/associate-marks (draft-gid) :x]) + (is (= #{:a1 :b1} (s/membership (scene*) :x))) + (is (= 2 (count (:marks (group :x))))) + (is (contains? (pane-ids) :x)) + (is (= :b1 (get-in @rdb/app-db [:view :edit-context]))) + (is (= [[:a 10 60] [:b 50 100] [:c 0 50]] + (mapv (juxt :clip :start :end) (mapcat :parts (:marks (group :x)))))) + (is (not-any? #(= :proxy (:type %)) (vals (:groups (scene*))))))) -;; ========================================================================= -;; stack push / pop and reveal-children through the real events -;; ========================================================================= +(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 stack-navigation-and-reveal +(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]) + (is (= original (group :x))) + (is (= groups (set (keys (:groups (scene*))))))))) + +(deftest endpoint-edit-preserves-mark-identity-and-bindings + (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 deleting-context-does-not-delete-footage (rf-test/run-test-sync (setup! (seed) [:root]) - (testing "expand pushes, pop-to truncates, collapse pops" - (rf/dispatch [::ev/expand :annA]) - (is (= [:root :annA] (:stack (:view @rdb/app-db)))) - (rf/dispatch [::ev/collapse]) - (is (= [:root] (:stack (:view @rdb/app-db)))) - (rf/dispatch [::ev/expand :annA]) - (rf/dispatch [::ev/pop-to :root]) - (is (= [:root] (:stack (:view @rdb/app-db))))) - (testing "at root, revealing annA surfaces its child annC in the SAME pane list" - (is (not (contains? (pane-ids) :annC)) "hidden until annA is revealed") - (is (pos? (:nested (card :annA))) "annA advertises a nested child") - (rf/dispatch [::ev/toggle-children :annA]) - (is (contains? (pane-ids) :annC) "revealed → annC shows as annA's child at root")))) + (let [before (s/resolve (scene*) :x)] + (rf/dispatch [::ev/delete-annotation :a1]) + (is (= before (s/resolve (scene*) :x))) + (is (= [:root :x] (s/path-to (scene*) :x)))))) -;; ========================================================================= -;; 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 +(deftest peer-delta-decodes-current-format (rf-test/run-test-sync - ;; annC's sole host (annA) is deleted out from under it, as if by restore of - ;; stale data or a peer deleting the parent - (setup! (update (seed) :groups dissoc :annA) [:root]) - (testing "annC's :in still points at the now-missing annA" - (is (= [:annA] (:in (get-in (scene*) [:groups :annC])))) - (is (nil? (get-in (scene*) [:groups :annA])))) - (testing "but the pane rescues it to root rather than dropping it" - (is (contains? (pane-ids) :annC) "orphan is visible at root, not lost") - (is (= #{:root} (:parents (card :annC))) "listed under root until re-filed")) - (testing "and it can be re-filed normally from there" - (rf/dispatch [::ev/file-into :annC :annB]) - (is (contains? (s/membership (scene*) :annC) :annB))))) - -;; ========================================================================= -;; JSON wire round-trip of :in (vector, keyworded) via restore-annotations -;; ========================================================================= - -(deftest legacy-parent-data-migrates-through-peer-delta - (rf-test/run-test-sync - (setup! clips-scene [:root]) - ;; a reload/peer delivers a legacy annotation — string :parent, no :in, exactly - ;; the shape stored in the real DB before the membership migration + (setup! fixture/base [:root]) (rf/dispatch [::ev/peer-delta - {:changed {:ann-legacy {:type "annotation" :parent "root" :name "L" - :marks [{:id "lm" :start {:ref "clip-a" :at 0} - :end {:ref "clip-a" :at 50}}]}} + {:changed {:x {:type "annotation" :in ["root"] :name "X" + :marks [{:id "m" :parts [{:clip "a" :start 10 :end 50}]}]}} :deleted []}]) - (testing "it migrates :parent -> :in [:root] on ingest and drops the old field" - (is (= [:root] (:in (get-in (scene*) [:groups :ann-legacy])))) - (is (nil? (:parent (get-in (scene*) [:groups :ann-legacy]))))) - (testing "and shows up in the root pane like any other" - (is (contains? (pane-ids) :ann-legacy))))) + (is (= #{:x} (pane-ids))) + (is (= [{:clip :a :start 10 :end 50}] (get-in (group :x) [:marks 0 :parts]))) + (is (= [[1010 1050]] (mapv :src (s/resolve (scene*) :x)))) + (is (= (group :x) (:x (fixture/wire {:x (group :x)})))))) -(deftest membership-survives-the-json-wire +(deftest revealed-cards-and-bound-drawings-share-visibility (rf-test/run-test-sync - (setup! (seed) [:root]) - (rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root] - (let [g (get-in (scene*) [:groups :annC]) - ;; exactly what api/put-scene serializes then reads back - wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true) - back (:annC (s/restore-annotations {:annC wire}))] - (is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)") - (is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved") - (is (= :annA (s/home {:groups {:annC back}} :annC)))))) + (setup! (-> (seed) + (assoc-in [:groups :x :marks 0 :drawings] [:d]) + (assoc-in [:groups :d] {:type :drawing :strokes []}) + (assoc-in [:groups :x :marks 0 :notes] [:n]) + (assoc-in [:groups :n] {:type :script-note :regions []})) + [:root]) + (rf/dispatch [::ev/set-playhead :root 20]) + (is (not (contains? (pane-ids) :x))) + (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]))))) diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index 51f717b..b2a2aa1 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -4,391 +4,152 @@ [tl.otio :as otio] [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 - {:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"}} - :groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 300}]} - ;; :start = timeline position; here it equals source so root is identity - :clip-a {:type :clip :parent nil :start 0 :marks [{:id :m/a :start 0 :end 100 :track :t0}]} - :clip-b {:type :clip :parent nil :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]} - :clip-c {:type :clip :parent nil :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}}}) + {:tracks {:t0 {:name "A"} :t1 {:name "B"} :t2 {:name "C"}} + :groups {:root {:type :timeline} + :a {:type :clip :track :t0 :start 0 :source 1000 :duration 100} + :b {:type :clip :track :t1 :start 100 :source 2000 :duration 100} + :c {:type :clip :track :t2 :start 200 :source 3000 :duration 100}}}) -(defn with-group [scene gid g] (assoc-in scene [:groups gid] g)) -(defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}}) -(defn err-msg [f] - (try (f) nil (catch js/Error e (.-message e)))) +(defn part [clip start end] {:clip clip :start start :end end}) +(defn mark [id & parts] {:id id :parts (vec parts)}) +(defn annotation [scene gid edges & marks] + (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. -(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) +(deftest root-distinguishes-timeline-and-source-time + (let [segs (s/resolve base :root)] + (is (= 300 (s/length segs))) + (is (= [0 100 200] (mapv (comp first :local) segs))) + (is (= [1000 2000 3000] (mapv (comp first :src) segs))) + (is (= 2005 (s/local->source segs 105))) + (is (= #{:t0 :t1 :t2} (s/tracks segs))))) -;; 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) +(deftest compilation-preserves-order-repeats-and-trims + (let [sc (annotation base :x [:root] + (mark :m (part :c 20 40) (part :a 0 10) (part :c 20 40))) + segs (s/resolve sc :x)] + (is (= [[3020 3040] [1000 1010] [3020 3040]] (mapv :src segs))) + (is (= [[0 20] [20 30] [30 50]] (mapv :local segs))) + (is (= [3025 1005 3025] (mapv #(s/local->source segs %) [5 25 35]))) + (is (= [:m :m :m] (mapv :mark segs))))) -;; ========================================================================= -;; Suite 1 — resolve / layout -;; ========================================================================= +(deftest selections-own-raw-clip-slices + (let [sc (annotation base :x [:root] + (mark :m (part :b 50 100) (part :a 0 50) (part :b 0 50))) + selection (s/make-mark sc :x 40 110) + sc (annotation sc :y [:x] selection) + before (s/resolve sc :y)] + (is (= [(part :b 90 100) (part :a 0 50) (part :b 0 10)] (:parts selection))) + (is (= before (s/resolve (update sc :groups dissoc :x) :y))) + (is (= before (s/resolve (assoc-in sc [:groups :y :in] [:root]) :y))) + (is (= before (s/resolve (assoc-in sc [:groups :x :marks] []) :y))))) -(deftest root-is-identity - (testing "the root timeline maps local 1:1 to source" - (let [segs (s/resolve base :root)] - (is (= 300 (s/length segs))) - (is (= 250 (s/local->source segs 250))) - (is (= [0 300] (:src (first segs))))))) +(deftest selection-through-repeated-footage + (let [sc (annotation base :x [:root] (mark :m (part :a 20 40) (part :a 60 90))) + segs (s/content-segments sc :x) + mid (:mark (second segs)) + lo (s/seg-local segs mid 5)] + (is (= 2 (count (distinct (map :mark segs))))) + (is (= 30 (s/seg-length segs mid))) + (is (= 25 lo)) + (is (= [(part :a 65 70)] (s/selection->parts sc :x lo (+ lo 5)))))) -(deftest rearrange-and-gap-removal - (testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track" - (let [scene (with-group base :ann - {:type :annotation :in [:root] - :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]}) - segs (s/resolve scene :ann)] - (is (= 200 (s/length segs))) - (is (= 200 (s/local->source segs 0))) ; local 0 -> C's source start - (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 one-mark-one-row-no-extra-entities + (let [m (s/make-mark base :root 40 210)] + (is (= [(part :a 40 100) (part :b 0 100) (part :c 0 10)] (:parts m))) + (is (= [{:s {:seg :a :f 40} :e {:seg :c :f 10}}] (s/marks->rows base [m]))))) -(deftest inter-x-lays-four-subclips - (testing "four 50-frame subclips, in mark order, end to end" - (let [segs (s/resolve inter-x :ann-x)] - (is (= 4 (count segs))) - (is (= 200 (s/length segs))) - (is (= [150 200] (:src (nth segs 0)))) - (is (= 150 (s/local->source segs 0))) ; B's second half - (is (= 0 (s/local->source segs 50))) ; boundary into A's first half - (is (= [:clip-b :clip-a :clip-b :clip-a] (map :thumb segs))) - (is (= [50 0 0 50] (map :thumb-start segs))) - (is (= #{:t1 :t0} (s/tracks segs)))))) +(deftest projection-preserves-root-clip-identity + (let [sc (-> base + (assoc-in [:groups :b :source] 1000) + (annotation :x [:root] (mark :m (part :a 10 20))))] + (is (= [[10 20 :m]] (s/lane-bars sc :x (s/content-segments sc :root)))))) -(deftest trim-no-clamp - (testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame" - ;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100 - (let [scene (-> base - (with-group :ann {:type :annotation :in [:root] - :marks [{:id :m/s :start {:ref :clip-a :at 20} - :end {:ref :clip-a :at 80}}]}) - (with-group :ann-y {:type :annotation :in [:ann] - :marks [{:id :m/y :start {:ref :m/s :at 0} - :end {:ref :m/s :at -1}}]})) - seg (first (s/resolve scene :ann-y))] - (is (= [20 80] (:src seg))) ; ends at the subclip's 80, not 100 - (is (= 60 (s/length (s/resolve scene :ann-y))))))) +(deftest projection-shows-every-repeat + (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 tracks-by-membership - (testing "zoom includes exactly the tracks the marks touch" - (let [scene (with-group base :ann - {:type :annotation :in [:root] - :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})] - (is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann))))))) +(deftest contiguity-is-defined-by-render-context + (let [sc (-> base + (annotation :context [:root] (mark :r (part :c 0 100) (part :a 0 100))) + (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 repeat-yields-two-pieces - (testing "a clip referenced twice renders at two local positions" - (let [scene (with-group base :ann - {:type :annotation :in [:root] - :marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100) - (refm :m/r1 :clip-b 0 -1) ; B local [100,200) - (refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300) - segs (s/resolve scene :ann)] - (is (= [[0 100] [200 300]] (s/pieces segs 0 100)))))) ; clip-a's two pieces +(deftest projection-clips-partial-overlap-without-changing-content + (let [sc (-> base + (annotation :context [:root] (mark :r (part :a 30 70))) + (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))))) -;; ========================================================================= -;; Suite 2 — authoring lifecycle (annotate A, push A, annotate B, mess with A) -;; ========================================================================= +(deftest distinct-marks-never-merge + (let [sc (annotation base :x [:root] (mark :m1 (part :a 0 100)) (mark :m2 (part :b 0 100)))] + (is (= [[0 100 :m1] [100 200 :m2]] (s/lane-bars sc :x (s/content-segments sc :root)))))) -(deftest y-follows-x-reorder - (testing "Y's refs track the subclips' CONTENT through a reorder of X" - (let [reordered (update-in x+y [:groups :ann-x :marks] reverse)] - (is (= (s/resolve x+y :ann-y) (s/resolve reordered :ann-y)))))) +(deftest instant-and-boundary-frames + (let [sc (annotation base :x [:root] (assoc (s/make-mark base :root 100 100) :id :instant))] + (is (= [(part :b 0 0)] (get-in sc [:groups :x :marks 0 :parts]))) + (is (= [[100 100 :instant]] (s/lane-bars sc :x (s/content-segments sc :root)))) + (is (= 0 (s/length (s/resolve sc :x)))))) -(deftest y-follows-x-inplace-edit - (testing "editing s0's in-point in place (same id) is reflected through Y's ref" - (let [edited (assoc-in x+y [:groups :ann-x :marks 0 :start :at] 40)] ; s0 now B[40,100) src[140,200) - (is (= [150 160] (:src (first (s/resolve edited :ann-y)))))))) ; s0[10..20] -> [150,160) +(deftest visibility-is-independent-of-compilation + (let [sc (annotation base :x [:root] (mark :m (part :a 0 100))) + moved (assoc-in sc [:groups :x :in] [:other :root])] + (is (= (s/resolve sc :x) (s/resolve moved :x))) + (is (= #{:root :other} (s/membership moved :x))) + (is (= (s/resolve moved :x) + (s/resolve (assoc-in moved [:groups :x :in] [:root :other]) :x))))) -(deftest y-orphans-partially-on-delete - (testing "deleting s0 dangles Y's first mark; the second still resolves" - (let [del (update-in x+y [:groups :ann-x :marks] #(vec (rest %)))] ; drop s0 - (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 missing-clips-are-reported-with-valid-parts-still-visible + (let [sc (annotation base :x [:root] (mark :m (part :missing 0 10) (part :a 0 20)))] + (is (= [:m] (s/broken-marks sc :x))) + (is (= [[1000 1020]] (mapv :src (s/resolve sc :x)))) + (is (some? (s/broken-reason sc :x))))) -(deftest selection-splits-into-a-run - (testing "a selection crossing subclip boundaries becomes one mark per segment" - (let [run (s/selection->marks inter-x :ann-x 40 110)] ; crosses s0, s1, s2 - (is (= 3 (count run))) - (is (= [:m/s0 :m/s1 :m/s2] (map #(get-in % [:start :ref]) run))) - ;; 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 json-roundtrip-covers-all-authored-types + (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 root-selection-splits-by-clip - (testing "selecting across A/B/C at the ROOT splits into one ref per clip" - (let [run (s/selection->marks base :root 40 210)] ; A-tail + B + C-head - (is (= 3 (count run))) - (is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) run))) - (is (= 40 (get-in (first run) [:start :at]))) ; A from frame 40 - (is (= 0 (get-in (last run) [:start :at])))))) ; C from frame 0 +(deftest links-and-jumps-use-context-projection + (let [sc (annotation base :x [:root] (mark :m (part :a 20 30) (part :c 50 60))) + seg (first (s/content-segments sc :x))] + (is (= {:ref :a :at 25} (s/seg-point sc seg 5))) + (is (= 5 (s/link-local sc :x {:ref :a :at 25}))) + (is (nil? (s/link-local sc :x {:ref :b :at 25}))) + (is (= 42 (s/link-local sc :root {:ref :root :at 42}))) + (is (= [20 250] (mapv :local (s/jump-targets sc :root :x)))) + (is (= [20 50] (mapv :f (s/jump-targets sc :root :x)))) + (is (= 4 (count (s/linkables sc :root)))))) -(deftest reconcile-keeps-ids-across-resize - (testing "resizing a selection keeps the surviving pieces' ids; adds/drops at the ends" - (let [run1 (s/selection->marks base :root 40 110) ; A-tail, B-head - a-id (:id (first run1)) - run2 (s/reconcile-run base :root run1 40 210) ; grow → A, B, C - 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 navigation-does-not-follow-visibility + (let [sc (-> base (annotation :x [:y]) (annotation :y [:x]))] + (is (= [:root :x] (s/path-to sc :x))) + (is (= #{:root :x :y} (set (map :gid (s/timelines sc))))) + (is (nil? (s/path-to sc :missing))))) -;; ========================================================================= -;; Suite 2b — proxy synthetic-clips (marks-first authoring) -;; ========================================================================= +(deftest integer-frame-invariants + (is (re-find #"integer frame" (err-msg #(s/selection->parts base :root 0.5 20)))) + (is (re-find #"ordered" (err-msg #(s/selection->parts base :root 20 10)))) + (is (= [[0 30] [40 50]] (s/merge-bars [[20 30] [0 20] [40 50]])))) -(deftest proxy-resolves-as-one-collapsed-mark - (testing "an annotation referencing a whole proxy resolves to the proxy's full - per-clip run — scattered-source clips pieced back together" - (let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210) - scene (-> base - (with-group :prox p) - (with-group :ann {:type :annotation :in [:root] - :marks [(s/proxy-ref :m/px :prox)]})) - segs (s/resolve scene :ann)] - (is (= 170 (s/length segs))) ; 60 + 100 + 10 - (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 - (testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip" - (let [p (s/make-proxy base :root 10 60) ; inside A only - scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :in [:root] - :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 - (testing "growing/shrinking a proxy's endpoints keeps interior ids and edits - boundary marks in place (added out, dropped in)" - (let [p0 (s/make-proxy base :root 40 210) ; A-tail, B, C-head - [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 - (testing "a proxy ref renders as ONE editor row: first-clip start → last-clip end" - (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 (= 80 (s/playhead v :ann-x))) - (is (= 0 (s/playhead v :ann-y)))))) ; unvisited -> 0 - -(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 playheads-are-per-context + (let [v (-> {} (s/set-playhead :root 30) (s/set-playhead :x 80))] + (is (= 30 (s/playhead v :root))) + (is (= 80 (s/playhead v :x))) + (is (= 0 (s/playhead v :unvisited))))) (deftest seed-from-otio (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))] (is (seq media-ins)) (is (every? integer? media-ins)) - (is (every? integer? (mapcat (fn [[_ g]] - (mapcat (juxt :start :end) (:marks g))) - (:groups scene))))))) - -(deftest selection-rejects-fractional-frames - (testing "a selection over fractional clip layout fails instead of changing frames" - (let [scene {:tracks {:t0 {:name "W"}} - :groups {:root {:type :timeline :parent nil :marks [{:id :m/r :start 0 :end 100}]} - :fr {:type :clip :parent nil :start 0.3 ; fractional timeline pos - :marks [{:id :m/fr :start 10.4 :end 110.4 :track :t0}]}}} - msg (err-msg #(s/selection->marks scene :root 20 60))] - (is (re-find #"integer frame" msg))))) - -;; ========================================================================= -;; 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 + (is (every? integer? (mapcat (juxt :start :source :duration) + (filter #(= :clip (:type %)) (vals (:groups scene)))))))))