feat: :in membership edges replace transclusion/mark-home placement
Placement is now asserted, not derived. An annotation carries :in — an ordered vector of the mark-groups it's filed under (first = primary home, scene/home). Membership decides listing; mark resolution independently decides whether bars draw. Marks are never moved or re-cut. Rebuilt from the clean pre-transclusion base, keeping only the codex frame-integer (assert-frame) work: - delete ref-owner / mark-home / mark-homes / :home-marks / rehome-marks - annotations drop :parent entirely; restore-annotations migrates legacy :parent -> :in [parent]; :in is a vector (JSON-round-trips like :tags/:notes) - file-edge (shared by ::reparent drag + ::file-into picker): move vs add/link; ::unfile guards primary + last; files-under? cycle guard - ::associate-marks no longer auto-files (adding marks != placement) - root identified by (= :timeline (:type)), not (nil? :parent) - membership-chips `in:` row; drag ⌥ = link; .reference cards Tests: real day8.re-frame.test run-test-sync suite driving events + live subscriptions (pane, context, reveal, reparent, associate, unfile, cycle, JSON wire). 62 tests / 243 assertions, 0 failures; 0 residue. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Your Name
parent
4b29962677
commit
65a80857be
8 changed files with 447 additions and 430 deletions
|
|
@ -333,6 +333,22 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
|
|||
.ann-tags .tag { font-size: 9px; padding: 0 6px 0 12px; line-height: 1.6; border-radius: 2px 8px 8px 2px; }
|
||||
.ann-tags .tag::before { width: 3px; height: 3px; left: 5px; }
|
||||
|
||||
/* the `in:` membership row — where this annotation is filed (:in edges) */
|
||||
.ann-in { display: flex; flex-wrap: wrap; align-items: center; gap: 4px; margin-top: 5px; }
|
||||
.ann-in-label { font-size: 9px; color: var(--muted, #888); text-transform: uppercase; letter-spacing: .04em; }
|
||||
.in-chip { display: inline-flex; align-items: center; gap: 2px; font-size: 9px;
|
||||
padding: 0 5px; line-height: 1.7; background: var(--shade); color: var(--ink);
|
||||
border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; }
|
||||
.in-chip:hover { background: var(--ink); color: var(--paper); }
|
||||
.in-x, .in-plus { font-size: 9px; line-height: 1; padding: 0 1px; background: none;
|
||||
border: none; color: inherit; cursor: pointer; opacity: .6; }
|
||||
.in-x:hover, .in-plus:hover { opacity: 1; }
|
||||
.in-plus { border: 1px dashed var(--ink); border-radius: 8px; padding: 0 5px; line-height: 1.6; opacity: .7; }
|
||||
.in-add-pop { display: inline-flex; align-items: center; gap: 2px; }
|
||||
.in-add-pop .ac { min-width: 140px; }
|
||||
/* a card filed here whose footage doesn't land here — reference only, no bars */
|
||||
.ann.reference { border-style: dashed; opacity: .78; }
|
||||
|
||||
/* reveal-children toggle at the card bottom + the nested child cards */
|
||||
.show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px;
|
||||
font-family: var(--chicago); font-size: 11px; text-align: left;
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@
|
|||
[re-frame "1.4.7"]
|
||||
[metosin/reitit "0.9.1"]
|
||||
[day8.re-frame/http-fx "0.2.4"]
|
||||
[day8.re-frame/test "0.1.5"]
|
||||
[binaryage/devtools "1.0.7"]]
|
||||
|
||||
:dev-http
|
||||
|
|
|
|||
|
|
@ -463,7 +463,7 @@
|
|||
|
||||
(defn- draft-in-ctx [db ctx]
|
||||
(some (fn [[gid g]]
|
||||
(when (and (:draft g) (= ctx (:parent g))) [gid g]))
|
||||
(when (and (:draft g) (= ctx (scene/home (:scene db) gid))) [gid g]))
|
||||
(get-in db [:scene :groups])))
|
||||
|
||||
(defn- draft-mark-at [db ctx lf]
|
||||
|
|
@ -489,7 +489,7 @@
|
|||
|
||||
(defn- mark-start-local [db ann mark-id]
|
||||
(let [scene (:scene db)
|
||||
ctx (:parent (get-in scene [:groups ann]))
|
||||
ctx (scene/home scene ann)
|
||||
segs (scene/content-segments scene ctx)]
|
||||
(ffirst (scene/mark-bars scene ann mark-id segs))))
|
||||
|
||||
|
|
@ -499,7 +499,7 @@
|
|||
(let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack])))
|
||||
(some (fn [[gid g]] (when (:draft g) [gid g]))
|
||||
(get-in db [:scene :groups])))
|
||||
ctx (:parent (get-in db [:scene :groups ann]))
|
||||
ctx (scene/home (:scene db) ann)
|
||||
local (when ann (mark-start-local db ann mark-id))
|
||||
db (cond-> db
|
||||
ann (start-drawing-db ann mark-id)
|
||||
|
|
@ -657,9 +657,10 @@
|
|||
;; uuid, not gensym: gensym's counter resets each page load, so a
|
||||
;; fresh annotation would reuse a prior gid and clobber it on merge.
|
||||
(assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))]
|
||||
{:type :annotation :parent (peek (get-in db [:view :stack]))
|
||||
(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})
|
||||
:v scene/schema-version}))
|
||||
(assoc-in [:view :pt] :new)
|
||||
(assoc-in [:view :active-mark] nil)
|
||||
(assoc-in [:view :draft-stage] :choosing))))
|
||||
|
|
@ -674,28 +675,28 @@
|
|||
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
|
||||
(assoc-in [:view :pt] :new))))
|
||||
|
||||
;; Edit an annotation from a card. If its parent timeline is not the timeline
|
||||
;; currently being viewed, enter that parent first so mark rows/handles edit in
|
||||
;; their authored coordinate system. finish-edit pops this temporary parent.
|
||||
;; Edit an annotation from a card. If its primary home isn't the context being
|
||||
;; viewed, enter that home first so mark rows/handles edit in their authored
|
||||
;; coordinate system. finish-edit pops this temporary context.
|
||||
(rf/reg-event-fx
|
||||
::edit-annotation
|
||||
(fn [{:keys [db]} [_ gid]]
|
||||
(let [parent (get-in db [:scene :groups gid :parent])
|
||||
(let [home (scene/home (:scene db) gid)
|
||||
ctx (peek (get-in db [:view :stack]))
|
||||
push-parent? (and parent (not= parent ctx))
|
||||
fx (if push-parent? (enter-ctx db #(conj % parent)) {:db db})]
|
||||
push-home? (and home (not= home ctx))
|
||||
fx (if push-home? (enter-ctx db #(conj % home)) {:db db})]
|
||||
(update fx :db #(cond-> (-> %
|
||||
(assoc-in [:scene :groups gid :draft] :edit)
|
||||
(assoc-in [:view :pt] :new)
|
||||
(assoc-in [:view :edit-pop-parent] nil))
|
||||
push-parent? (assoc-in [:view :edit-pop-parent] parent))))))
|
||||
push-home? (assoc-in [:view :edit-pop-parent] home))))))
|
||||
|
||||
;; Edit the annotation you're currently inside: drop into its parent timeline so
|
||||
;; its marks are editable there, remembering to pop back when done. Root has no
|
||||
;; parent (and no marks) — edit it in place.
|
||||
(rf/reg-event-fx ::edit-here
|
||||
(fn [{:keys [db]} [_ gid]]
|
||||
(let [root? (nil? (get-in db [:scene :groups gid :parent]))
|
||||
(let [root? (= :timeline (get-in db [:scene :groups gid :type]))
|
||||
fx (if root? {:db db} (enter-ctx db pop))]
|
||||
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
|
||||
(assoc-in [:view :pt] :new)
|
||||
|
|
@ -730,7 +731,7 @@
|
|||
(let [g (cond-> (editable-group g)
|
||||
(= :annotation (:type g)) (assoc :v scene/schema-version))
|
||||
patch (group-patch orig g)
|
||||
root? (nil? (:parent g)) ; the root timeline persists whole
|
||||
root? (= :timeline (:type g)) ; the root timeline persists whole
|
||||
id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks)
|
||||
;; proxies this annotation references are synthetic clips in the pool —
|
||||
;; persist them alongside it or the {:ref proxy} marks dangle on reload.
|
||||
|
|
@ -752,18 +753,24 @@
|
|||
id (assoc :http-xhrio (api/put-scene id {:deleted [gid]}
|
||||
{:on-success [::scene-saved]
|
||||
:on-failure [::save-error]}))))))
|
||||
;; --- move an annotation into another context (drag-drop reparent) ---------
|
||||
;; Drag/drop re-expresses the annotation's visible mark coverage in the target
|
||||
;; context. The parent is just where the annotation is edited/listed; the marks
|
||||
;; still decide what actually renders by resolving down to clips and intersecting
|
||||
;; the target timeline.
|
||||
(defn- descendant?
|
||||
"Is `gid` equal to `anc` or somewhere below it in the :parent tree?"
|
||||
[scene anc gid]
|
||||
(loop [g gid]
|
||||
(cond (nil? g) false
|
||||
(= g anc) true
|
||||
:else (recur (get-in scene [:groups g :parent])))))
|
||||
;; --- membership edges (:in): file an annotation under mark-groups ----------
|
||||
;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups
|
||||
;; the annotation is filed under; the FIRST is the primary home (scene/home) — where
|
||||
;; it's edited and its links resolve. Marks never move or re-cut — they resolve to
|
||||
;; raw clips globally, and that only decides whether BARS draw in a context. Three
|
||||
;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag /
|
||||
;; file-into picker), remove (× on a chip).
|
||||
|
||||
(defn- files-under?
|
||||
"Does `desc` reach `anc` by following :in edges (would nesting create a cycle)?"
|
||||
[scene desc anc seen]
|
||||
(boolean
|
||||
(when-not (contains? seen desc)
|
||||
(let [ins (scene/membership scene desc)]
|
||||
(or (contains? ins anc)
|
||||
(some #(and (= :annotation (get-in scene [:groups % :type]))
|
||||
(files-under? scene % anc (conj seen desc)))
|
||||
ins))))))
|
||||
|
||||
(rf/reg-event-db
|
||||
::ann-drag-start
|
||||
|
|
@ -779,64 +786,62 @@
|
|||
(assoc-in [:view :dragging-ann] nil)
|
||||
(assoc-in [:view :dragging-ann-source] nil))))
|
||||
|
||||
(defn- rehome-marks
|
||||
[scene gid source-parent new-parent]
|
||||
(let [target-segs (scene/content-segments scene new-parent)]
|
||||
(reduce (fn [{:keys [marks proxies]} m]
|
||||
(if (= source-parent (scene/mark-home scene m))
|
||||
(let [bare (dissoc m :home-marks)
|
||||
history (:home-marks m {})
|
||||
history (assoc history source-parent bare)]
|
||||
(if-let [saved (get history new-parent)]
|
||||
{:marks (conj marks (assoc saved :home-marks (dissoc history new-parent)))
|
||||
:proxies proxies}
|
||||
(let [bars (scene/mark-bars scene gid (:id m) target-segs)]
|
||||
(if (seq bars)
|
||||
(let [pid (keyword (str "prox-" (random-uuid)))
|
||||
proxy {:type :proxy :parent nil
|
||||
:marks (mapv identity
|
||||
(mapcat (fn [[lo hi]]
|
||||
(scene/selection->marks scene new-parent lo hi))
|
||||
bars))}
|
||||
m* (assoc (merge m (scene/proxy-ref (:id m) pid))
|
||||
:home-marks history)]
|
||||
{:marks (conj marks m*) :proxies (assoc proxies pid proxy)})
|
||||
{:marks (conj marks m) :proxies proxies}))))
|
||||
{:marks (conj marks m) :proxies proxies}))
|
||||
{:marks [] :proxies {}}
|
||||
(get-in scene [:groups gid :marks]))))
|
||||
(defn- persist-group
|
||||
"fx map that stores annotation `gid` = `g*` locally and (if online) pushes just
|
||||
the changed fields to the backend."
|
||||
[db gid orig g*]
|
||||
(let [id (get-in db [:project :id])
|
||||
patch (group-patch orig g*)]
|
||||
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) (assoc :save-error nil))}
|
||||
(and id (seq patch))
|
||||
(assoc :http-xhrio (api/put-scene id {:changed {gid patch}}
|
||||
{:on-success [::scene-saved]
|
||||
:on-failure [::save-error]})))))
|
||||
|
||||
(defn- has-home? [scene gid source-parent]
|
||||
(some #(= source-parent (scene/mark-home scene %))
|
||||
(get-in scene [:groups gid :marks])))
|
||||
;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps
|
||||
;; existing edges (link); otherwise the edge you grabbed is moved off its source.
|
||||
;; Marks are untouched either way.
|
||||
(defn- file-edge [db gid new-parent add? source]
|
||||
(let [scene (:scene db)
|
||||
g (get-in scene [:groups gid])
|
||||
in (vec (:in g))
|
||||
clear #(-> % (assoc-in [:view :dragging-ann] nil)
|
||||
(assoc-in [:view :dragging-ann-source] nil))]
|
||||
(if (or (not= :annotation (:type g)) ; only annotations file
|
||||
(:draft g) ; not mid-draft
|
||||
(= gid new-parent) ; not under itself
|
||||
(contains? (set in) new-parent) ; already filed there
|
||||
(files-under? scene new-parent gid #{})) ; would make a cycle
|
||||
{:db (clear db)}
|
||||
(let [in' (if add?
|
||||
(conj in new-parent) ; link: append, primary unchanged
|
||||
(let [rest* (vec (remove #{source} in))]
|
||||
(if (= source (first in))
|
||||
(into [new-parent] rest*) ; moved the primary → new home
|
||||
(conj rest* new-parent))))
|
||||
g* (assoc g :in in')]
|
||||
(update (persist-group db gid g g*) :db clear)))))
|
||||
|
||||
(rf/reg-event-fx
|
||||
::reparent
|
||||
(fn [{:keys [db]} [_ gid new-parent]]
|
||||
(let [scene (:scene db)
|
||||
g (get-in scene [:groups gid])
|
||||
source-parent (or (get-in db [:view :dragging-ann-source])
|
||||
(peek (get-in db [:view :stack])))]
|
||||
(if (or (not= :annotation (:type g)) ; only annotations move
|
||||
(:draft g) ; not while being drafted/edited
|
||||
(= source-parent new-parent)
|
||||
(not (has-home? scene gid source-parent))
|
||||
(descendant? scene gid new-parent)) ; target inside gid -> cycle
|
||||
{:db (-> db
|
||||
(assoc-in [:view :dragging-ann] nil)
|
||||
(assoc-in [:view :dragging-ann-source] nil))}
|
||||
(let [id (get-in db [:project :id])
|
||||
{:keys [marks proxies]} (rehome-marks scene gid source-parent new-parent)
|
||||
g* (assoc g :parent new-parent :marks marks)
|
||||
patch (editable-group g*)]
|
||||
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g*)
|
||||
(update-in [:scene :groups] merge proxies)
|
||||
(assoc-in [:view :dragging-ann] nil)
|
||||
(assoc-in [:view :dragging-ann-source] nil)
|
||||
(assoc :save-error nil))}
|
||||
id (assoc :http-xhrio (api/put-scene id {:changed (merge {gid patch} proxies)}
|
||||
{:on-success [::scene-saved]
|
||||
:on-failure [::save-error]}))))))))
|
||||
(fn [{:keys [db]} [_ gid new-parent add?]]
|
||||
(let [source (or (get-in db [:view :dragging-ann-source]) (peek (get-in db [:view :stack])))]
|
||||
(file-edge db gid new-parent add? source))))
|
||||
|
||||
;; file into a group chosen from the picker — always additive (source nil).
|
||||
(rf/reg-event-fx ::file-into
|
||||
(fn [{:keys [db]} [_ gid target]]
|
||||
(file-edge db gid target true nil)))
|
||||
|
||||
;; remove one membership edge (× on a chip). Never the primary home, never the last.
|
||||
(rf/reg-event-fx
|
||||
::unfile
|
||||
(fn [{:keys [db]} [_ gid target]]
|
||||
(let [g (get-in db [:scene :groups gid])
|
||||
in (vec (:in g))]
|
||||
(if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1))
|
||||
{:db db}
|
||||
(persist-group db gid g (assoc g :in (vec (remove #{target} in))))))))
|
||||
|
||||
(rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil)))
|
||||
(rf/reg-event-db ::save-error
|
||||
|
|
@ -870,7 +875,7 @@
|
|||
::unset-proxy-endpoint
|
||||
(fn [db [_ gid mark-id pid which]]
|
||||
(let [scene (:scene db)
|
||||
ctx (:parent (get-in scene [:groups gid]))
|
||||
ctx (scene/home scene gid)
|
||||
segs (scene/content-segments scene ctx)
|
||||
[lo hi] (scene/mark-extent scene gid mark-id segs)]
|
||||
(assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)}))))
|
||||
|
|
@ -880,14 +885,14 @@
|
|||
;; seek to its start, and drop into drawing mode ("select a range → you're drawing").
|
||||
(defn- select-range-fx [db gid g lo hi]
|
||||
(let [scene (:scene db)
|
||||
p (scene/make-proxy scene (:parent g) lo hi)
|
||||
p (scene/make-proxy scene (scene/home scene gid) lo hi)
|
||||
pgid (keyword (str "prox-" (random-uuid)))
|
||||
mid (str (random-uuid))
|
||||
sf (scene/local->source (scene/content-segments scene (:parent g)) lo)]
|
||||
sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)]
|
||||
{:db (-> db (assoc-in [:scene :groups pgid] p)
|
||||
(update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid))
|
||||
(assoc-in [:view :active-mark] mid)
|
||||
(assoc-in [:view :playheads (:parent g)] lo)
|
||||
(assoc-in [:view :playheads (scene/home scene gid)] lo)
|
||||
(assoc-in [:view :pt] :new))
|
||||
:player/seek (when sf (/ sf (:fps db)))
|
||||
:fx [[:dispatch [::start-drawing gid mid]]]}))
|
||||
|
|
@ -906,7 +911,7 @@
|
|||
(fn [{:keys [db]} [_ seg-id frame]]
|
||||
(let [scene (:scene db)
|
||||
[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene))
|
||||
segs (scene/content-segments scene (:parent g))
|
||||
segs (scene/content-segments scene (scene/home scene gid))
|
||||
pt (get-in db [:view :pt])]
|
||||
(cond
|
||||
;; re-picking one endpoint of a proxy: roll only that side, keep the other
|
||||
|
|
@ -919,7 +924,7 @@
|
|||
lo (scene/assert-frame "proxy range start" (min new-local keep))
|
||||
hi (scene/assert-frame "proxy range end" (max new-local keep))]
|
||||
{:db (-> db (assoc-in [:scene :groups (:proxy pt)]
|
||||
(scene/roll-proxy scene (:parent g) proxy lo (max (inc lo) hi)))
|
||||
(scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi)))
|
||||
(assoc-in [:view :pt] :new))})
|
||||
|
||||
(map? pt)
|
||||
|
|
@ -931,7 +936,7 @@
|
|||
;; re-picking an endpoint: reconcile-run keeps the mark id for the
|
||||
;; piece on the kept clip; re-attach that mark's bindings, and splice
|
||||
;; the run back into its original slot so order is preserved.
|
||||
(let [run (->> (scene/reconcile-run scene (:parent g) [old] lo hi)
|
||||
(let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi)
|
||||
(mapv (fn [m] (if (= (:id m) (:id old))
|
||||
(cond-> m
|
||||
(:notes old) (assoc :notes (:notes old))
|
||||
|
|
@ -1006,9 +1011,10 @@
|
|||
(fn [{:keys [db]} [_ draft-gid target-gid]]
|
||||
(let [marks (get-in db [:scene :groups draft-gid :marks])
|
||||
orig-t (get-in db [:scene :groups target-gid])
|
||||
target (-> orig-t
|
||||
(update :marks (fnil into []) marks)
|
||||
(dissoc :home))
|
||||
;; adding marks does NOT change placement — membership is asserted, never
|
||||
;; derived from where marks were authored. To also list C in this context,
|
||||
;; file it in explicitly (the ＋ picker / drag).
|
||||
target (update orig-t :marks (fnil into []) marks)
|
||||
patch (group-patch orig-t target) ; just the :marks change
|
||||
proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref])
|
||||
pg (get-in db [:scene :groups pid])]
|
||||
|
|
|
|||
|
|
@ -120,7 +120,7 @@
|
|||
|
||||
;; --- resolution ----------------------------------------------------------
|
||||
|
||||
(declare resolve resolve-mark)
|
||||
(declare resolve resolve-mark home child-of?)
|
||||
|
||||
(defn- target-segs
|
||||
"Resolved segments (local 0-based) of a referenceable id: a group (clip,
|
||||
|
|
@ -168,7 +168,7 @@
|
|||
[scene gid point]
|
||||
(cond
|
||||
(number? point)
|
||||
(let [parent (:parent (grp scene gid))]
|
||||
(let [parent (home scene gid)]
|
||||
{:frame (if parent (local->source (resolve scene parent) point) point)
|
||||
:track nil})
|
||||
|
||||
|
|
@ -219,7 +219,7 @@
|
|||
lb (at->l (:at end))]
|
||||
(when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
|
||||
(rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
|
||||
(let [parent (:parent (grp scene gid))]
|
||||
(let [parent (home scene gid)]
|
||||
(if parent ; absolute, relative to parent
|
||||
(rebase id (slice (resolve scene parent) start end))
|
||||
[{:mark id :track track :src [start end] :local [0 (- end start)]
|
||||
|
|
@ -365,71 +365,45 @@
|
|||
(when (seq pcs)
|
||||
[(reduce min (map first pcs)) (reduce max (map second pcs))])))
|
||||
|
||||
(defn clip-loss?
|
||||
"True when annotation `gid` loses any content once clipped to its immediate
|
||||
parent annotation — it references frames outside the parent timeline, so it's
|
||||
(partly) out of range there. Timeline/root parents contain everything."
|
||||
;; --- placement: :in membership edges --------------------------------------
|
||||
;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered
|
||||
;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under
|
||||
;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in
|
||||
;; it. The FIRST element is the primary home (where its :content links resolve and
|
||||
;; where it's edited); the whole vector as a set is its membership. Marks are never
|
||||
;; moved or re-cut — they resolve to raw clips globally, and that only decides
|
||||
;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it
|
||||
;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary.
|
||||
|
||||
(defn home
|
||||
"The primary home of `gid`: the first `:in` edge for an annotation (where its
|
||||
description links resolve and where it's edited); the structural `:parent` for
|
||||
anything else (nil for the flat clip/proxy pool and the root timeline)."
|
||||
[scene gid]
|
||||
(let [p (:parent (grp scene gid))]
|
||||
(let [g (grp scene gid)]
|
||||
(if (= :annotation (:type g)) (first (:in g)) (:parent g))))
|
||||
|
||||
(defn membership
|
||||
"The set of mark-groups annotation `gid` is filed under (its `:in` edges)."
|
||||
[scene gid]
|
||||
(set (:in (grp scene gid))))
|
||||
|
||||
(defn child-of?
|
||||
"Is annotation `gid` filed under `ctx`?"
|
||||
[scene ctx gid]
|
||||
(contains? (membership scene gid) ctx))
|
||||
|
||||
(defn clip-loss?
|
||||
"True when annotation `gid` loses content once clipped to its primary home — it
|
||||
references frames outside that parent annotation, so it's (partly) out of range
|
||||
there. Timeline/root homes contain everything, so they never warn."
|
||||
[scene gid]
|
||||
(let [p (home scene gid)]
|
||||
(when (and p (= :annotation (:type (grp scene p))))
|
||||
(let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs)))
|
||||
own (mapv :src (resolve scene gid))]
|
||||
(< (len (src-intersect own (mapv :src (resolve scene p)))) (len own))))))
|
||||
|
||||
;; --- reference parent: which timeline a mark was authored in ---------------
|
||||
;; A mark's proxy DIRECTLY references a content unit of exactly one timeline — the
|
||||
;; one it was authored in. That timeline is the mark's "home"; the annotation
|
||||
;; holding the mark shows as a child there. This is one hop (a direct reference),
|
||||
;; NOT transitive resolution down to clips — so a grandchild is a child of its
|
||||
;; parent, not of the root. An annotation that collected marks from two contexts
|
||||
;; (transclusion) is a child of both. This is the "fk" the nesting rides on.
|
||||
|
||||
(defn- ref-owner
|
||||
"The timeline that OWNS content unit `t`: :root for a clip, else the annotation
|
||||
whose proxy contains the mark `t` (t is one of that annotation's content units).
|
||||
nil if `t` dangles."
|
||||
[scene t]
|
||||
(cond
|
||||
(= :clip (:type (grp scene t))) :root
|
||||
(find-mark scene t)
|
||||
(let [[container _] (find-mark scene t)]
|
||||
(if (= :proxy (:type (grp scene container)))
|
||||
(some (fn [[gid g]]
|
||||
(when (and (= :annotation (:type g))
|
||||
(some #(= container (get-in % [:start :ref])) (:marks g)))
|
||||
gid))
|
||||
(:groups scene))
|
||||
container))
|
||||
:else nil))
|
||||
|
||||
(defn mark-home
|
||||
"The timeline mark `m` was authored in — the owner of the content unit its proxy
|
||||
DIRECTLY references (one hop). :root for a clip-backed mark. The annotation that
|
||||
holds `m` shows as a child of this timeline. nil if unresolvable."
|
||||
[scene m]
|
||||
(let [pid (get-in m [:start :ref])
|
||||
t (if (= :proxy (:type (grp scene pid)))
|
||||
(get-in (first (:marks (grp scene pid))) [:start :ref])
|
||||
pid)]
|
||||
(ref-owner scene t)))
|
||||
|
||||
(defn mark-homes
|
||||
"The distinct timelines annotation `gid`'s marks are homed in — its reference
|
||||
parent(s). Usually one; two (or more) when it collected marks from different
|
||||
contexts (transclusion). Falls back to the structural `:parent` when the
|
||||
annotation has no resolvable marks (a fresh draft, a fully broken one), so it
|
||||
still shows somewhere."
|
||||
[scene gid]
|
||||
(let [g (grp scene gid)
|
||||
homes (into #{} (keep #(mark-home scene %)) (:marks g))]
|
||||
(if (seq homes) homes #{(:parent g)})))
|
||||
|
||||
(defn child-of?
|
||||
"Is annotation `gid` a direct child of timeline `ctx` — a mark of its authored
|
||||
there (homed in ctx)."
|
||||
[scene ctx gid]
|
||||
(contains? (mark-homes scene gid) ctx))
|
||||
|
||||
;; --- editing: split a local selection into a run of single-clip marks -----
|
||||
|
||||
(defn selection->marks
|
||||
|
|
@ -520,12 +494,7 @@
|
|||
(get-in m [:end :ref]) (update-in [:end :ref] keyword)
|
||||
(:track m) (update :track keyword)
|
||||
(:notes m) (update :notes #(mapv keyword %)) ; bound script-note gids
|
||||
(:drawings m) (update :drawings #(mapv keyword %)) ; bound drawing gids
|
||||
(:home-marks m) (update :home-marks
|
||||
(fn [homes]
|
||||
(into {} (map (fn [[home mark]]
|
||||
[(keyword home) (restore-mark mark)]))
|
||||
homes)))))
|
||||
(:drawings m) (update :drawings #(mapv keyword %)))) ; bound drawing gids
|
||||
|
||||
(defn- restore-region
|
||||
"A script-note region loses keyword-ness through JSON: re-keyword :id and :kind."
|
||||
|
|
@ -568,9 +537,15 @@
|
|||
:proxy (update g :marks #(mapv restore-mark (or % []))) ; synthetic clip: just its run
|
||||
:drawing g ; pure strokes + seed, JSON round-trips as-is
|
||||
(-> g
|
||||
(dissoc :parent) ; annotations are placed by :in alone
|
||||
(update :marks #(mapv restore-mark (or % [])))
|
||||
(cond-> (:notes g)
|
||||
(update :notes #(mapv keyword %))) ; annotation-level bindings
|
||||
;; membership edges: keyword an existing :in vector,
|
||||
;; or seed one from a legacy single :parent
|
||||
(assoc :in (if-let [in (:in g)]
|
||||
(mapv keyword in)
|
||||
(when (:parent g) [(:parent g)])))
|
||||
migrate))])))
|
||||
anns))
|
||||
|
||||
|
|
@ -744,7 +719,7 @@
|
|||
(sort-by (comp first :local) segs))}))))
|
||||
anns (->> (:groups scene)
|
||||
(keep (fn [[gid g]]
|
||||
(when (and (= :annotation (:type g)) (= ctx (:parent g))
|
||||
(when (and (= :annotation (:type g)) (child-of? scene ctx gid)
|
||||
(not (:draft g)))
|
||||
{:name (or (:name g) (name gid)) :kind :annotation
|
||||
:items (mapv (fn [{:keys [id lo len]}]
|
||||
|
|
@ -754,14 +729,14 @@
|
|||
(vec (concat (sort-by :name tracks) (sort-by :name anns)))))
|
||||
|
||||
(defn path-to
|
||||
"Stack path from :root down to `gid` following :parent links, or nil if an
|
||||
ancestor is missing — an orphan whose parent context was deleted."
|
||||
"Stack path from :root down to `gid` following primary-home links, or nil if an
|
||||
ancestor is missing — an orphan whose home context was deleted."
|
||||
[scene gid]
|
||||
(loop [g gid, acc ()]
|
||||
(cond
|
||||
(= g :root) (vec (cons :root acc))
|
||||
(or (nil? g) (not (contains? (:groups scene) g))) nil
|
||||
:else (recur (get-in scene [:groups g :parent]) (cons g acc)))))
|
||||
:else (recur (home scene g) (cons g acc)))))
|
||||
|
||||
(defn timelines
|
||||
"Every reachable timeline you can open as a context — root, plus named child
|
||||
|
|
@ -773,7 +748,7 @@
|
|||
(keep (fn [[gid g]]
|
||||
(when (and (= :annotation (:type g)) (not (:draft g)))
|
||||
(when-let [path (path-to scene gid)]
|
||||
(let [parent (:parent g)]
|
||||
(let [parent (home scene gid)]
|
||||
{:gid gid :name (or (:name g) (name gid))
|
||||
:in (if (or (nil? parent) (= :root parent))
|
||||
"root" (get-in scene [:groups parent :name] (name parent)))
|
||||
|
|
|
|||
|
|
@ -135,15 +135,15 @@
|
|||
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
|
||||
(fn [[scene ctx segs revealed] _]
|
||||
(let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
|
||||
;; each annotation → its reference PARENTS: the timeline(s) its marks were
|
||||
;; authored in (mark-homes). A normal annotation has one; a transcluded one
|
||||
;; (marks from two contexts) has two, so it shows as a child under BOTH.
|
||||
;; each annotation → the mark-groups it's FILED UNDER (:in membership). A
|
||||
;; normal annotation has one; a linked one has several, so it lists under
|
||||
;; each. Asserted, not derived from where marks resolve.
|
||||
parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
|
||||
[gid (scene/mark-homes scene gid)]))
|
||||
[gid (scene/membership scene gid)]))
|
||||
;; child count per timeline (drives the "Show N" nested badge)
|
||||
nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents))
|
||||
;; reference-reveal hierarchy: shows when ctx is a reference parent, or a
|
||||
;; REVEALED reference-parent that itself shows. `seen` guards ref cycles.
|
||||
;; membership-reveal hierarchy: shows when ctx is a host it's filed under,
|
||||
;; or a REVEALED host annotation that itself shows. `seen` guards cycles.
|
||||
shown? (fn shown? [gid seen]
|
||||
(and (not (contains? seen gid))
|
||||
(boolean (some (fn [p] (or (= ctx p)
|
||||
|
|
@ -152,20 +152,13 @@
|
|||
(->> (:groups scene)
|
||||
(keep (fn [[gid g]]
|
||||
(when (= :annotation (:type g))
|
||||
;; VISIBILITY IS BY REFERENCE: an annotation shows in ctx when a
|
||||
;; mark of its was AUTHORED in ctx (homed there) — one hop, not
|
||||
;; transitive — so a mark made in ctx shows even if the annotation
|
||||
;; is parented elsewhere (transclusion), while a grandchild does
|
||||
;; not leak up and a sibling covering the same clips stays out.
|
||||
;; VISIBILITY IS BY MEMBERSHIP (:in): an annotation shows in ctx
|
||||
;; iff it's filed under ctx, or under a revealed host that itself
|
||||
;; shows. Where its marks resolve only decides whether bars draw.
|
||||
(let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse
|
||||
(when (shown? gid #{})
|
||||
(let [reason (scene/broken-reason scene gid)
|
||||
;; clip-loss compares against the structural :parent.
|
||||
;; A transcluded annotation is intentionally authored in
|
||||
;; multiple reference parents, so judging all marks
|
||||
;; against only :parent creates a false warning.
|
||||
oor (boolean (and (= (parents gid) #{(:parent g)})
|
||||
(scene/clip-loss? scene gid)))
|
||||
oor (boolean (scene/clip-loss? scene gid))
|
||||
hidden (get-in g [:meta :hidden])
|
||||
note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
|
||||
distinct
|
||||
|
|
@ -186,10 +179,9 @@
|
|||
(get-in cg [:media :name])
|
||||
(some-> ref name)))))
|
||||
distinct)]
|
||||
{:id gid :parent (:parent g)
|
||||
;; the timeline(s) this annotation is a child of (mark-homes) —
|
||||
;; the pane groups by this so a transcluded annotation appears
|
||||
;; under every context it was authored in.
|
||||
{:id gid :parent (scene/home scene gid) ; primary home = first :in
|
||||
;; the mark-groups this annotation is filed under (:in) — the
|
||||
;; pane groups by this, so a linked annotation lists under each.
|
||||
:parents (parents gid)
|
||||
:name (:name g) :color (or (:color g) "#4e8fc2")
|
||||
:content (:content g) :children (count (:marks g))
|
||||
|
|
@ -281,7 +273,7 @@
|
|||
(fn [[gid g]]
|
||||
;; child annotations of the context OR the context annotation itself
|
||||
;; (pushing the owner onto the stack makes ctx that annotation)
|
||||
(when (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid)))
|
||||
(when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid)))
|
||||
(let [src-segs (scene/resolve scene gid)
|
||||
by-mark (group-by :mark src-segs)
|
||||
->bars (fn [ss] (scene/merge-bars
|
||||
|
|
|
|||
|
|
@ -1138,6 +1138,54 @@
|
|||
[:span.tag t (when on-remove [:button.tag-x {:type "button" :title "Remove tag"
|
||||
:on-click #(on-remove t)} "✕"])])
|
||||
|
||||
(defn- group-name [scene gid]
|
||||
(if (or (nil? gid) (= :root gid))
|
||||
"root"
|
||||
(let [g (get-in scene [:groups gid])]
|
||||
(or (:name g) (get-in g [:media :name]) (some-> gid name)))))
|
||||
|
||||
;; The `in:` row — every mark-group this annotation is FILED UNDER (:in). Click a
|
||||
;; chip to go there; ✕ un-files it (never its primary home). ＋ opens a picker to
|
||||
;; file into any other group (annotation or timeline/act), at any nesting depth —
|
||||
;; that's the "link across arbitrarily nested groups" gesture (search, not drag).
|
||||
(defn- membership-chips [scene a authed?]
|
||||
(r/with-let [adding? (r/atom false)]
|
||||
(let [gid (:id a)
|
||||
homes (:parents a)
|
||||
prim (:parent a)
|
||||
cands (->> (:groups scene)
|
||||
(keep (fn [[g grp]]
|
||||
(when (and (contains? #{:annotation :timeline} (:type grp))
|
||||
(not= g gid)
|
||||
(not (contains? homes g)))
|
||||
{:gid g :label (group-name scene g)})))
|
||||
(sort-by :label))]
|
||||
[:div.ann-in
|
||||
[:span.ann-in-label "in:"]
|
||||
(for [h (sort homes)]
|
||||
^{:key (str h)}
|
||||
[:span.in-chip {:title (str "Go to " (group-name scene h))
|
||||
:on-click #(rf/dispatch (if (= h :root)
|
||||
[::events/pop-to :root]
|
||||
[::events/expand h]))}
|
||||
(group-name scene h)
|
||||
(when (and authed? (not= h prim))
|
||||
[:button.in-x {:type "button" :title "Un-file"
|
||||
:on-click (fn [e] (.stopPropagation e)
|
||||
(rf/dispatch [::events/unfile gid h]))} "✕"])])
|
||||
(when authed?
|
||||
(if @adding?
|
||||
[:span.in-add-pop
|
||||
[autocomplete {:items (mapv :label cands) :placeholder "file into…"
|
||||
:auto-focus? true
|
||||
:on-choose (fn [label]
|
||||
(when-let [c (some #(when (= label (:label %)) %) cands)]
|
||||
(rf/dispatch [::events/file-into gid (:gid c)]))
|
||||
(reset! adding? false))}]
|
||||
[:button.in-x {:type "button" :on-click #(reset! adding? false)} "✕"]]
|
||||
[:button.in-plus {:type "button" :title "File into another group"
|
||||
:on-click #(reset! adding? true)} "＋"]))])))
|
||||
|
||||
(defn- link-picker [{:keys [scene ctx on-commit on-cancel]}]
|
||||
(r/with-let [picked (r/atom nil)]
|
||||
[:div.mark-block.pending.link-insert-block
|
||||
|
|
@ -1221,19 +1269,25 @@
|
|||
(when (has-type? e "text/ann")
|
||||
(.stopPropagation e) (.preventDefault e) (reset! over? true)))
|
||||
:on-drag-leave (fn [_] (reset! over? false))
|
||||
;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS
|
||||
;; (links, keeping the old home) — file-manager convention.
|
||||
:on-drop (fn [e]
|
||||
(let [src (.. e -dataTransfer (getData "text/ann"))]
|
||||
(when (seq src)
|
||||
(.stopPropagation e) (.preventDefault e) (reset! over? false)
|
||||
(rf/dispatch [::events/reparent (keyword src) (:id a)]))))}))
|
||||
(rf/dispatch [::events/reparent (keyword src) (:id a) (.-altKey e)]))))}))
|
||||
|
||||
(defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen]
|
||||
(r/with-let [over? (r/atom false) hov? (r/atom false)]
|
||||
(let [active? @(rf/subscribe [::subs/annotation-active? (:id a)])
|
||||
dragging @(rf/subscribe [::subs/dragging-ann])
|
||||
drop-ok? (and dragging (not= dragging (:id a)))
|
||||
;; filed here but its footage doesn't land in this context → a reference
|
||||
;; card: listed for organisation, no bars to draw. Jump still works.
|
||||
reference? (and (not (:draft a)) (empty? (:bars a)))
|
||||
drag-props (merge (ann-drag-props a authed? over? source-parent)
|
||||
{:class (str (when active? "active ")
|
||||
(when reference? "reference ")
|
||||
(when (and drop-ok? @over?) "drop-over ")
|
||||
(when drop-ok? "drop-ready"))})]
|
||||
(if (:hidden a)
|
||||
|
|
@ -1273,6 +1327,7 @@
|
|||
[:button.del-btn {:title "Delete"
|
||||
:on-click #(when (js/confirm (str "Delete \"" (:name a) "\"?"))
|
||||
(rf/dispatch [::events/delete-annotation (:id a)]))} "✕"])]]
|
||||
[membership-chips scene a authed?]
|
||||
(when (not-empty (:content a)) [content-display scene ctx (:content a)])
|
||||
(when (seq (:notes a))
|
||||
[:div.ann-notes
|
||||
|
|
@ -1310,7 +1365,7 @@
|
|||
(when (scene/clip-loss? scene ctx)
|
||||
[:span.ann-warn {:title "Out of range — this annotation references frames its parent timeline trims"} "⚠ "])
|
||||
(if (seq (:content cg))
|
||||
[content-display scene (or (:parent cg) ctx) (:content cg)]
|
||||
[content-display scene (or (scene/home scene ctx) ctx) (:content cg)]
|
||||
[:div.muted "No description yet."])
|
||||
(when authed?
|
||||
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
|
||||
|
|
@ -1484,14 +1539,14 @@
|
|||
scene @(rf/subscribe [::subs/scene])
|
||||
;; anchor the form to the draft's home context, not the live stack top:
|
||||
;; a link-insert timeline preview moves the stack, but this annotation
|
||||
;; still belongs to (:parent d), so its marks/pickers stay stable.
|
||||
ctx (or (:parent d) (:gid d)) ; annotation: its parent; root: itself
|
||||
;; still belongs to its primary home (first :in), so pickers stay stable.
|
||||
ctx (or (first (:in d)) (:gid d)) ; annotation: its home; root: itself
|
||||
segs (scene/content-segments scene ctx)
|
||||
pt @(rf/subscribe [::subs/pt])
|
||||
linking @(rf/subscribe [::subs/linking])
|
||||
gid (:gid d)
|
||||
new? (= :new (:draft d))
|
||||
root? (nil? (:parent d))
|
||||
root? (= :timeline (:type d))
|
||||
;; ONE shared form for new + edit. In draft/new we HIDE the lower fields
|
||||
;; (content, notes, save) until a title is picked — pick a new title to
|
||||
;; "create new", or an existing annotation to "edit existing". The title
|
||||
|
|
|
|||
|
|
@ -1,9 +1,15 @@
|
|||
(ns tl.flow-test
|
||||
"Integration tests that drive the ACTUAL re-frame events the UI dispatches
|
||||
(dispatch-sync) and read the resulting app-db / scene back — so a bug that lives
|
||||
in an event handler (not a pure scene fn) is caught. Side-effecting fx are
|
||||
stubbed so the sync path stays pure; project id is nil so nothing hits the net."
|
||||
"Integration tests that drive the ACTUAL re-frame events the UI dispatches and
|
||||
read the resulting scene AND live subscriptions back — via day8.re-frame.test's
|
||||
run-test-sync, so subscriptions resolve in a real reactive context (no 'outside
|
||||
reactive context' warnings) and dispatch is synchronous. A bug that lives in an
|
||||
event handler or a subscription (not just a pure scene fn) is caught here.
|
||||
|
||||
Placement model under test: an annotation's `:in` is an ordered vector of the
|
||||
mark-groups it's FILED UNDER (first = primary home). Membership is asserted;
|
||||
where marks resolve only decides whether bars draw. See tl.scene/membership."
|
||||
(:require [cljs.test :refer-macros [deftest is testing]]
|
||||
[day8.re-frame.test :as rf-test]
|
||||
[re-frame.core :as rf]
|
||||
[re-frame.db :as rdb]
|
||||
[tl.events :as ev]
|
||||
|
|
@ -16,8 +22,7 @@
|
|||
:connect-scene :fetch-projects :poll-thumbnails :upload-project]]
|
||||
(rf/reg-fx k (fn [_] nil)))
|
||||
|
||||
;; single-source footage: four clips, ALL named "Challengers.mov" (this is why the
|
||||
;; media name is useless as a label — the track+occurrence is what distinguishes)
|
||||
;; four clips on four tracks, one shared source file; root spans [0,400)
|
||||
(def clips-scene
|
||||
{:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}}
|
||||
:groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]}
|
||||
|
|
@ -27,19 +32,19 @@
|
|||
:clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}})
|
||||
|
||||
(defn seed
|
||||
"clips + annA (over clips A,B) + annB (over clips C,D) + annC (parented under A,
|
||||
holding one mark authored inside A) — the state right before you drill into B."
|
||||
"clips + annA (over clips A,B, filed under root) + annB (over C,D, filed under
|
||||
root) + annC (one mark authored inside annA, FILED under annA)."
|
||||
[]
|
||||
(let [pA (s/make-proxy clips-scene :root 0 200)
|
||||
pB (s/make-proxy clips-scene :root 200 400)
|
||||
sc (-> clips-scene
|
||||
(assoc-in [:groups :pA] pA)
|
||||
(assoc-in [:groups :pB] pB)
|
||||
(assoc-in [:groups :annA] {:type :annotation :parent :root :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]})
|
||||
(assoc-in [:groups :annB] {:type :annotation :parent :root :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]}))
|
||||
(assoc-in [:groups :annA] {:type :annotation :in [:root] :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]})
|
||||
(assoc-in [:groups :annB] {:type :annotation :in [:root] :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]}))
|
||||
pInA (s/make-proxy sc :annA 10 60)]
|
||||
(-> sc (assoc-in [:groups :pInA] pInA)
|
||||
(assoc-in [:groups :annC] {:type :annotation :parent :annA :name "C" :color "#00f"
|
||||
(assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f"
|
||||
:marks [(s/proxy-ref "ca" :pInA)]}))))
|
||||
|
||||
(defn setup! [scene stack]
|
||||
|
|
@ -48,185 +53,155 @@
|
|||
:project {:id nil}}))
|
||||
|
||||
(defn scene* [] (:scene @rdb/app-db))
|
||||
(defn bars-in [ctx gid]
|
||||
(s/lane-bars (scene*) gid (s/content-segments (scene*) ctx)))
|
||||
(defn draft-gid [] (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*))))
|
||||
(defn pane-ids
|
||||
"The set of annotation gids the pane sub currently lists (in the live context)."
|
||||
[]
|
||||
(set (map :id @(rf/subscribe [::subs/all-annotations]))))
|
||||
(defn card [gid] (some #(when (= gid (:id %)) %) @(rf/subscribe [::subs/all-annotations])))
|
||||
(defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx)))
|
||||
|
||||
(deftest editing-nested-annotation-temporarily-enters-parent
|
||||
(testing "card edit pushes the parent timeline, and finish-edit pops it back"
|
||||
;; =========================================================================
|
||||
;; the annotation pane sub (::all-annotations) lists by membership
|
||||
;; =========================================================================
|
||||
|
||||
(deftest pane-lists-strictly-by-membership
|
||||
(rf-test/run-test-sync
|
||||
(setup! (seed) [:root])
|
||||
(rf/dispatch-sync [::ev/edit-annotation :annC])
|
||||
(is (= [:root :annA] (get-in @rdb/app-db [:view :stack])))
|
||||
(is (= :edit (get-in (scene*) [:groups :annC :draft])))
|
||||
(is (= :annA (get-in @rdb/app-db [:view :edit-pop-parent])))
|
||||
(rf/dispatch-sync [::ev/finish-edit])
|
||||
(is (= [:root] (get-in @rdb/app-db [:view :stack])))
|
||||
(is (nil? (get-in @rdb/app-db [:view :edit-pop-parent]))))
|
||||
(testing "editing from the parent context does not push a duplicate parent"
|
||||
(setup! (seed) [:root :annA])
|
||||
(rf/dispatch-sync [::ev/edit-annotation :annC])
|
||||
(is (= [:root :annA] (get-in @rdb/app-db [:view :stack])))
|
||||
(is (nil? (get-in @rdb/app-db [:view :edit-pop-parent])))
|
||||
(rf/dispatch-sync [::ev/finish-edit])
|
||||
(is (= [:root :annA] (get-in @rdb/app-db [:view :stack])))))
|
||||
(testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT"
|
||||
(is (= #{:annA :annB} (pane-ids)))
|
||||
(is (= :root @(rf/subscribe [::subs/context])))
|
||||
(is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)"))
|
||||
(testing "pushing annA onto the stack lists annC (its child), not annA/annB"
|
||||
(rf/dispatch [::ev/expand :annA])
|
||||
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
|
||||
(is (= :annA @(rf/subscribe [::subs/context])))
|
||||
(is (contains? (pane-ids) :annC))
|
||||
(is (not (contains? (pane-ids) :annB))))
|
||||
(testing "collapsing returns to root's listing"
|
||||
(rf/dispatch [::ev/collapse])
|
||||
(is (= #{:annA :annB} (pane-ids))))))
|
||||
|
||||
(deftest dragging-transcluded-annotation-to-root-rehomes-it
|
||||
(testing "drag/drop root owns placement even when marks were authored under two annotations"
|
||||
;; =========================================================================
|
||||
;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched
|
||||
;; =========================================================================
|
||||
|
||||
(deftest reparent-move-then-link
|
||||
(rf-test/run-test-sync
|
||||
(setup! (seed) [:root])
|
||||
(rf/dispatch-sync [::ev/expand :annB])
|
||||
(rf/dispatch-sync [::ev/open-draft])
|
||||
(rf/dispatch-sync [::ev/draft-select-range 50 150])
|
||||
(let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))]
|
||||
(rf/dispatch-sync [::ev/associate-marks draft-gid :annC]))
|
||||
(rf/dispatch-sync [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil])
|
||||
(rf/dispatch-sync [::ev/finish-edit])
|
||||
(is (= #{:annA :annB} (s/mark-homes (scene*) :annC)))
|
||||
(let [original-b-mark (second (get-in (scene*) [:groups :annC :marks]))]
|
||||
(rf/dispatch-sync [::ev/reparent :annC :root])
|
||||
(is (= :root (get-in (scene*) [:groups :annC :parent])))
|
||||
(is (nil? (get-in (scene*) [:groups :annC :home])))
|
||||
(is (= #{:annA :root} (s/mark-homes (scene*) :annC)))
|
||||
(is (= [:annA :root]
|
||||
(mapv #(s/mark-home (scene*) %)
|
||||
(get-in (scene*) [:groups :annC :marks]))))
|
||||
(is (s/child-of? (scene*) :root :annC))
|
||||
(is (s/child-of? (scene*) :annA :annC))
|
||||
(is (not (s/child-of? (scene*) :annB :annC)))
|
||||
(rf/dispatch-sync [::ev/collapse])
|
||||
(let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))]
|
||||
(is (contains? ids :annC)))
|
||||
(rf/dispatch-sync [::ev/reparent :annC :annB])
|
||||
(let [restored-b-mark (second (get-in (scene*) [:groups :annC :marks]))]
|
||||
(is (= #{:annA :annB} (s/mark-homes (scene*) :annC)))
|
||||
(is (= original-b-mark (dissoc restored-b-mark :home-marks)))
|
||||
(is (contains? (:home-marks restored-b-mark) :root))
|
||||
(is (not (s/child-of? (scene*) :root :annC)))
|
||||
(is (s/child-of? (scene*) :annB :annC))))))
|
||||
(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])))))))
|
||||
|
||||
(deftest tie-marks-to-annotation-in-another-context-then-drag
|
||||
(testing "author a range while drilled into annB, tie it to annC (parented under
|
||||
annA), then drag its handle — it must stay one proxy, stay visible in
|
||||
annB, and NOT vanish when rerolled."
|
||||
(deftest reparent-refuses-cycles-and-noops
|
||||
(rf-test/run-test-sync
|
||||
(setup! (seed) [:root])
|
||||
;; drill into annB (real stack-nav event)
|
||||
(rf/dispatch-sync [::ev/expand :annB])
|
||||
(is (= [:root :annB] (get-in @rdb/app-db [:view :stack])))
|
||||
;; new draft + select a range 50..150 (C-tail + D-head), exactly as a lane drag
|
||||
(rf/dispatch-sync [::ev/open-draft])
|
||||
(rf/dispatch-sync [::ev/draft-select-range 50 150])
|
||||
(let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))]
|
||||
(is draft-gid "a draft should exist after open-draft")
|
||||
(is (= 1 (count (get-in (scene*) [:groups draft-gid :marks]))) "one proxy mark, not per-clip")
|
||||
;; tie the draft's marks to the existing annC (transclusion)
|
||||
(rf/dispatch-sync [::ev/associate-marks draft-gid :annC])
|
||||
(let [annC (get-in (scene*) [:groups :annC])
|
||||
bmk (last (:marks annC))
|
||||
bid (:id bmk)]
|
||||
(is (nil? (get-in (scene*) [:groups draft-gid])) "draft is consumed")
|
||||
(is (= 2 (count (:marks annC))) "annC now has its A-mark + the new B-mark")
|
||||
(is (= :proxy (:type (get-in (scene*) [:groups (get-in bmk [:start :ref])])))
|
||||
"the tied mark is a single proxy-ref, not expanded into per-clip marks")
|
||||
(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))))))
|
||||
|
||||
;; BUG 1 — labels. Viewed from annB: the new B-mark's endpoint is one of
|
||||
;; annB's own content units (labels via the context), while annC's A-mark is
|
||||
;; foreign here. Its fallback must be the TRACK ("A-roll"), never the shared
|
||||
;; source-file name "Challengers.mov".
|
||||
(let [ctx-ids (into #{} (map :mark) (s/content-segments (scene*) :annB))
|
||||
row-seg (fn [gid-mark] (get-in (s/mark-row (scene*) gid-mark) [:s :seg]))
|
||||
amk (first (:marks annC))] ; the A-mark
|
||||
(is (contains? ctx-ids (row-seg bmk)) "B-mark endpoint is one of annB's units → context-labelled")
|
||||
(is (not (contains? ctx-ids (row-seg amk))) "A-mark is foreign in annB")
|
||||
(is (= "A-roll" (s/ref-track-name (scene*) (row-seg amk))) "foreign label is the track, not Challengers.mov")
|
||||
(is (not= "Challengers.mov" (s/ref-track-name (scene*) (row-seg amk)))))
|
||||
;; =========================================================================
|
||||
;; unfile — remove one edge; never the primary home, never the last
|
||||
;; =========================================================================
|
||||
|
||||
;; REFERENCE PARENTS — annC is a child of A (its A-mark) and B (its B-mark),
|
||||
;; and NOT of root (it's a grandchild there: one hop, not transitive to clips)
|
||||
(is (= #{:annA :annB} (s/mark-homes (scene*) :annC)))
|
||||
(is (s/child-of? (scene*) :annB :annC))
|
||||
(is (not (s/child-of? (scene*) :root :annC)))
|
||||
(deftest 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])))))))
|
||||
|
||||
;; LANE in annB: exactly one bar for annC's B-mark
|
||||
(is (= 1 (count (bars-in :annB :annC))) "annC shows exactly one bar in annB")
|
||||
(is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2)))
|
||||
;; =========================================================================
|
||||
;; adding marks from another context (associate-marks) does NOT move placement
|
||||
;; =========================================================================
|
||||
|
||||
;; ISSUE 1 — the PANE LIST (::all-annotations, grouped by :parents) must
|
||||
;; include annC under annB, and must not pull in non-children.
|
||||
(let [anns @(rf/subscribe [::subs/all-annotations])
|
||||
c (some #(when (= :annC (:id %)) %) anns)
|
||||
under (fn [p] (->> anns (filter #(contains? (:parents %) p)) (map :id) set))]
|
||||
(is c "annC is present in ::all-annotations while viewing annB")
|
||||
(is (contains? (:parents c) :annB) "annC's reference parents include annB")
|
||||
(is (false? (:oor c)) "transclusion is not out-of-range just because its structural parent is elsewhere")
|
||||
(is (false? (:broken c)) "transclusion does not render as a broken warning")
|
||||
(is (contains? (under :annB) :annC) "the pane lists annC under annB")
|
||||
(is (not (contains? (under :annB) :annA)) "annA is root's child, not annB's"))
|
||||
(deftest associate-marks-adds-marks-not-membership
|
||||
(rf-test/run-test-sync
|
||||
(setup! (seed) [:root])
|
||||
;; drill into annB, author a range on ITS content, tie it to annC
|
||||
(rf/dispatch [::ev/expand :annB])
|
||||
(rf/dispatch [::ev/open-draft])
|
||||
(rf/dispatch [::ev/draft-select-range 50 150])
|
||||
(let [d (draft-gid)]
|
||||
(is d "a draft exists after open-draft")
|
||||
(is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB")
|
||||
(rf/dispatch [::ev/associate-marks d :annC]))
|
||||
(testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)"
|
||||
(is (= 2 (count (get-in (scene*) [:groups :annC :marks]))))
|
||||
(is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks"))
|
||||
;; associate opened annC in :edit; save it (drops :draft) and leave the form
|
||||
(rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil])
|
||||
(rf/dispatch [::ev/finish-edit])
|
||||
(testing "so annC does NOT list under annB — even though its footage resolves there"
|
||||
(is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB")
|
||||
(is (= 1 (count (bars-in :annB :annC))) "but its B-mark DOES draw a bar in annB (resolution ≠ membership)")
|
||||
(is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2))))
|
||||
(testing "filing it in explicitly is what makes it list under annB"
|
||||
(rf/dispatch [::ev/file-into :annC :annB])
|
||||
(is (contains? (pane-ids) :annC))
|
||||
(is (= #{:annA :annB} (s/membership (scene*) :annC))))))
|
||||
|
||||
;; ISSUE 3 at ROOT — collapse; annC must NOT leak into the root list (it's a
|
||||
;; grandchild). ISSUE 2 — revealing annA must then surface annC as its child.
|
||||
(rf/dispatch-sync [::ev/collapse])
|
||||
(is (= [:root] (get-in @rdb/app-db [:view :stack])))
|
||||
(let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))]
|
||||
(is (contains? ids :annA) "annA (a root child) shows at root")
|
||||
(is (not (contains? ids :annC)) "annC does NOT leak into root (grandchild)"))
|
||||
(rf/dispatch-sync [::ev/toggle-children :annA])
|
||||
(let [anns @(rf/subscribe [::subs/all-annotations])
|
||||
c (some #(when (= :annC (:id %)) %) anns)
|
||||
by-parent (subs/annotations-by-parent anns)
|
||||
revealed (get-in @rdb/app-db [:view :revealed])]
|
||||
(is c "revealing annA surfaces annC as its child in the toggle")
|
||||
(is (contains? (:parents c) :annA))
|
||||
(is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annA #{})))
|
||||
"annA's open panel renders annC")
|
||||
(is (nil? (subs/visible-child-annotations by-parent revealed :annB #{}))
|
||||
"annB's closed panel does not render the same transcluded child"))
|
||||
(rf/dispatch-sync [::ev/toggle-children :annB])
|
||||
(let [anns @(rf/subscribe [::subs/all-annotations])
|
||||
by-parent (subs/annotations-by-parent anns)
|
||||
revealed (get-in @rdb/app-db [:view :revealed])]
|
||||
(is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annB #{})))
|
||||
"annB renders annC only after its own panel opens"))
|
||||
(rf/dispatch-sync [::ev/toggle-children :annB])
|
||||
(let [anns @(rf/subscribe [::subs/all-annotations])
|
||||
by-parent (subs/annotations-by-parent anns)
|
||||
revealed (get-in @rdb/app-db [:view :revealed])]
|
||||
(is (nil? (subs/visible-child-annotations by-parent revealed :annB #{}))
|
||||
"hiding annB's panel removes annC from that panel even though annA still reveals it"))
|
||||
;; =========================================================================
|
||||
;; stack push / pop and reveal-children through the real events
|
||||
;; =========================================================================
|
||||
|
||||
;; BUG 2 — back in annB, dragging the handle must not delete the mark
|
||||
;; (::reroll-proxy must roll against the VIEWED context, not annC's :parent).
|
||||
(rf/dispatch-sync [::ev/expand :annB])
|
||||
(rf/dispatch-sync [::ev/reroll-proxy :annC bid 50 140])
|
||||
(let [bars (bars-in :annB :annC)]
|
||||
(is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)")
|
||||
(is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140"))))))
|
||||
(deftest stack-navigation-and-reveal
|
||||
(rf-test/run-test-sync
|
||||
(setup! (seed) [:root])
|
||||
(testing "expand pushes, pop-to truncates, collapse pops"
|
||||
(rf/dispatch [::ev/expand :annA])
|
||||
(is (= [:root :annA] (:stack (:view @rdb/app-db))))
|
||||
(rf/dispatch [::ev/collapse])
|
||||
(is (= [:root] (:stack (:view @rdb/app-db))))
|
||||
(rf/dispatch [::ev/expand :annA])
|
||||
(rf/dispatch [::ev/pop-to :root])
|
||||
(is (= [:root] (:stack (:view @rdb/app-db)))))
|
||||
(testing "at root, revealing annA surfaces its child annC in the SAME pane list"
|
||||
(is (not (contains? (pane-ids) :annC)) "hidden until annA is revealed")
|
||||
(is (pos? (:nested (card :annA))) "annA advertises a nested child")
|
||||
(rf/dispatch [::ev/toggle-children :annA])
|
||||
(is (contains? (pane-ids) :annC) "revealed → annC shows as annA's child at root"))))
|
||||
|
||||
(deftest draft-range-events-keep-integer-frames
|
||||
(testing "basic drag selection through the real event path stores only integer frames"
|
||||
(setup! clips-scene [:root])
|
||||
(rf/dispatch-sync [::ev/open-draft])
|
||||
(rf/dispatch-sync [::ev/draft-select-range 25 175])
|
||||
(let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*)))
|
||||
mark (first (:marks g))
|
||||
pid (get-in mark [:start :ref])
|
||||
proxy (get-in (scene*) [:groups pid])
|
||||
ats (mapcat (fn [m] [(get-in m [:start :at]) (get-in m [:end :at])]) (:marks proxy))]
|
||||
(is gid "draft exists")
|
||||
(is (= :proxy (:type proxy)))
|
||||
(is (every? integer? ats))
|
||||
(is (= [[25 175 (:id mark)]] (bars-in :root gid)))))
|
||||
(testing "fractional drag selection fails instead of being changed into nearby frames"
|
||||
(setup! clips-scene [:root])
|
||||
(rf/dispatch-sync [::ev/open-draft])
|
||||
(is (thrown-with-msg? js/Error #"integer frame"
|
||||
(rf/dispatch-sync [::ev/draft-select-range 25.5 175])))))
|
||||
;; =========================================================================
|
||||
;; JSON wire round-trip of :in (vector, keyworded) via restore-annotations
|
||||
;; =========================================================================
|
||||
|
||||
(deftest reroll-proxy-rejects-fractional-frames
|
||||
(testing "live proxy reroll accepts integer handle positions and rejects fractional ones"
|
||||
(setup! clips-scene [:root])
|
||||
(rf/dispatch-sync [::ev/open-draft])
|
||||
(rf/dispatch-sync [::ev/draft-select-range 25 175])
|
||||
(let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*)))
|
||||
mark-id (:id (first (:marks g)))]
|
||||
(rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30 170])
|
||||
(is (= [[30 170 mark-id]] (bars-in :root gid)))
|
||||
(is (thrown-with-msg? js/Error #"integer frame"
|
||||
(rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30.25 170]))))))
|
||||
(deftest membership-survives-the-json-wire
|
||||
(rf-test/run-test-sync
|
||||
(setup! (seed) [:root])
|
||||
(rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root]
|
||||
(let [g (get-in (scene*) [:groups :annC])
|
||||
;; exactly what api/put-scene serializes then reads back
|
||||
wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true)
|
||||
back (:annC (s/restore-annotations {:annC wire}))]
|
||||
(is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)")
|
||||
(is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved")
|
||||
(is (= :annA (s/home {:groups {:annC back}} :annC))))))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips.
|
||||
(def inter-x
|
||||
(with-group base :ann-x
|
||||
{:type :annotation :parent :root
|
||||
{:type :annotation :in [:root]
|
||||
:marks [{:id :m/s0 :start {:ref :clip-b :at 50} :end {:ref :clip-b :at -1}} ; src [150,200)
|
||||
{:id :m/s1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at 50}} ; src [0,50)
|
||||
{:id :m/s2 :start {:ref :clip-b :at 0} :end {:ref :clip-b :at 50}} ; src [100,150)
|
||||
|
|
@ -32,7 +32,7 @@
|
|||
;; Y inside X, referencing two of X's subclips (parent = :ann-x)
|
||||
(def x+y
|
||||
(with-group inter-x :ann-y
|
||||
{:type :annotation :parent :ann-x
|
||||
{:type :annotation :in [:ann-x]
|
||||
:marks [{:id :m/y0 :start {:ref :m/s0 :at 10} :end {:ref :m/s0 :at 20}} ; s0 10..20 -> src [160,170)
|
||||
{:id :m/y1 :start {:ref :m/s1 :at 0} :end {:ref :m/s1 :at 5}}]})) ; s1 0..5 -> src [0,5)
|
||||
|
||||
|
|
@ -50,7 +50,7 @@
|
|||
(deftest rearrange-and-gap-removal
|
||||
(testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track"
|
||||
(let [scene (with-group base :ann
|
||||
{:type :annotation :parent :root
|
||||
{:type :annotation :in [:root]
|
||||
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})
|
||||
segs (s/resolve scene :ann)]
|
||||
(is (= 200 (s/length segs)))
|
||||
|
|
@ -75,10 +75,10 @@
|
|||
(testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame"
|
||||
;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100
|
||||
(let [scene (-> base
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [{:id :m/s :start {:ref :clip-a :at 20}
|
||||
:end {:ref :clip-a :at 80}}]})
|
||||
(with-group :ann-y {:type :annotation :parent :ann
|
||||
(with-group :ann-y {:type :annotation :in [:ann]
|
||||
:marks [{:id :m/y :start {:ref :m/s :at 0}
|
||||
:end {:ref :m/s :at -1}}]}))
|
||||
seg (first (s/resolve scene :ann-y))]
|
||||
|
|
@ -88,14 +88,14 @@
|
|||
(deftest tracks-by-membership
|
||||
(testing "zoom includes exactly the tracks the marks touch"
|
||||
(let [scene (with-group base :ann
|
||||
{:type :annotation :parent :root
|
||||
{:type :annotation :in [:root]
|
||||
:marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})]
|
||||
(is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann)))))))
|
||||
|
||||
(deftest repeat-yields-two-pieces
|
||||
(testing "a clip referenced twice renders at two local positions"
|
||||
(let [scene (with-group base :ann
|
||||
{:type :annotation :parent :root
|
||||
{:type :annotation :in [:root]
|
||||
:marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100)
|
||||
(refm :m/r1 :clip-b 0 -1) ; B local [100,200)
|
||||
(refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300)
|
||||
|
|
@ -162,7 +162,7 @@
|
|||
(let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210)
|
||||
scene (-> base
|
||||
(with-group :prox p)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/px :prox)]}))
|
||||
segs (s/resolve scene :ann)]
|
||||
(is (= 170 (s/length segs))) ; 60 + 100 + 10
|
||||
|
|
@ -176,7 +176,7 @@
|
|||
(testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip"
|
||||
(let [p (s/make-proxy base :root 10 60) ; inside A only
|
||||
scene (-> base (with-group :prox p)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/px :prox)]}))
|
||||
segs (s/resolve scene :ann)]
|
||||
(is (= 1 (count (:marks p))))
|
||||
|
|
@ -220,7 +220,7 @@
|
|||
(let [p1 (s/make-proxy base :root 0 200) ; A+B
|
||||
p2 (s/make-proxy base :root 200 300) ; C (abuts B)
|
||||
scene (-> base (with-group :p1 p1) (with-group :p2 p2)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/1 :p1)
|
||||
(s/proxy-ref :m/2 :p2)]}))
|
||||
segs (s/content-segments scene :root)
|
||||
|
|
@ -229,7 +229,7 @@
|
|||
(is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi]
|
||||
;; and a single cross-clip proxy on its own is one contiguous bar
|
||||
(let [one (-> base (with-group :p1 p1)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/1 :p1)]}))]
|
||||
(is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root))))))))
|
||||
|
||||
|
|
@ -242,7 +242,7 @@
|
|||
{:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}}
|
||||
back (:prox (s/restore-annotations json-like))
|
||||
scene (-> base (with-group :prox back)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/px :prox)]}))]
|
||||
(is (= :proxy (:type back)))
|
||||
(is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded
|
||||
|
|
@ -257,7 +257,7 @@
|
|||
(let [p (s/make-proxy base :root 40 210) ; A-tail=60, B=100, C-head=10
|
||||
scene (-> base
|
||||
(with-group :prox p)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/px :prox)]}))
|
||||
segs (s/content-segments scene :ann)
|
||||
ids (mapv :mark segs)]
|
||||
|
|
@ -275,7 +275,7 @@
|
|||
one mark id — one bar per mark — so the two views stay distinct"
|
||||
(let [p (s/make-proxy base :root 40 210)
|
||||
scene (-> base (with-group :prox p)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :m/px :prox)]}))]
|
||||
(is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann))))))))
|
||||
|
||||
|
|
@ -293,7 +293,7 @@
|
|||
:marks [{:id :sub-c :start {:ref aid :at 0} :end {:ref aid :at -1}}]}
|
||||
scene (-> named
|
||||
(with-group :pA pA)
|
||||
(with-group :annA {:type :annotation :parent :root :marks [(s/proxy-ref :mA :pA)]})
|
||||
(with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
|
||||
(with-group :pin pin))]
|
||||
;; the ref chain :sub-c → aid → clip-a bottoms out at a clip from anywhere
|
||||
(is (= 100 (s/ref-length scene :sub-c))) ; clip-a's length, no context
|
||||
|
|
@ -302,12 +302,12 @@
|
|||
(is (= "A-roll" (s/ref-track-name scene :pin)))
|
||||
(is (nil? (s/ref-track-name scene :nope)))))) ; a dangling ref → nil, not a throw
|
||||
|
||||
(deftest transclusion-visibility-is-scoped-by-reference-not-clip-overlap
|
||||
(testing "an annotation shows in a timeline when a mark is BUILT ON that timeline's
|
||||
content (references its units), not merely when its clips overlap. So a
|
||||
mark authored in B shows in B though its annotation is parented under A
|
||||
(transclusion), a mark authored in A shows in A — and a sibling root
|
||||
annotation that just covers the same clips does NOT leak into B."
|
||||
(deftest placement-is-membership-listing-is-decoupled-from-where-bars-draw
|
||||
(testing "an annotation LISTS under the mark-groups in its :in (asserted), while
|
||||
its bars DRAW wherever its marks resolve (footage ∩ ctx). The two are
|
||||
independent: a mark authored on annB's content still draws in annB even
|
||||
when the annotation is only filed under annA — and it does NOT list in
|
||||
annB until it's filed there."
|
||||
(let [four (assoc-in base [:groups :clip-d]
|
||||
{:type :clip :parent nil :name "D" :start 300
|
||||
:marks [{:id :m/d :start 300 :end 400 :track :t0}]})
|
||||
|
|
@ -315,35 +315,31 @@
|
|||
pA (s/make-proxy four :root 0 200) ; annA over clips A,B
|
||||
pB (s/make-proxy four :root 200 400) ; annB over clips C,D
|
||||
scene (-> four (with-group :pA pA) (with-group :pB pB)
|
||||
(with-group :annA {:type :annotation :parent :root :marks [(s/proxy-ref :mA :pA)]})
|
||||
(with-group :annB {:type :annotation :parent :root :marks [(s/proxy-ref :mB :pB)]}))
|
||||
;; annC (parented under A) has a mark authored in A AND a mark authored in B
|
||||
pInA (s/make-proxy scene :annA 10 60) ; a range inside annA (clip A)
|
||||
pInB (s/make-proxy scene :annB 50 150) ; a range inside annB (C-tail + D-head)
|
||||
;; annD is a SIBLING root annotation that merely covers clip C
|
||||
pDup (s/make-proxy scene :root 200 280) ; clip C, referenced from root directly
|
||||
scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB) (with-group :pDup pDup)
|
||||
(with-group :annC {:type :annotation :parent :annA
|
||||
:marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]})
|
||||
(with-group :annD {:type :annotation :parent :root
|
||||
:marks [(s/proxy-ref "d1" :pDup)]}))]
|
||||
;; annC has exactly 2 marks (one per authored range); the B one is a single
|
||||
;; proxy whose run spans C-tail + D-head — not expanded into per-clip marks
|
||||
(is (= 2 (count (:marks (get-in scene [:groups :annC])))))
|
||||
(is (= 2 (count (:marks pInB)))) ; run held inside the ONE proxy
|
||||
;; annC's marks are homed in A and B → it is a child of BOTH, and NOT of root
|
||||
;; (it's a grandchild there — one-hop reference, not transitive to clips)
|
||||
(is (= #{:annA :annB} (s/mark-homes scene :annC)))
|
||||
(with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]})
|
||||
(with-group :annB {:type :annotation :in [:root] :marks [(s/proxy-ref :mB :pB)]}))
|
||||
;; annC is FILED under annA only, but holds a mark authored on annA's
|
||||
;; content AND a mark authored on annB's content (C-tail + D-head)
|
||||
pInA (s/make-proxy scene :annA 10 60)
|
||||
pInB (s/make-proxy scene :annB 50 150)
|
||||
scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB)
|
||||
(with-group :annC {:type :annotation :in [:annA]
|
||||
:marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}))]
|
||||
;; MEMBERSHIP (listing) is exactly :in — asserted, single here
|
||||
(is (= #{:annA} (s/membership scene :annC)))
|
||||
(is (= :annA (s/home scene :annC))) ; primary = first :in
|
||||
(is (s/child-of? scene :annA :annC))
|
||||
(is (s/child-of? scene :annB :annC))
|
||||
(is (not (s/child-of? scene :root :annC))) ; grandchild does NOT leak to root
|
||||
;; annD only covers clip C from root — homed at root, NOT a child of annB
|
||||
(is (= #{:root} (s/mark-homes scene :annD)))
|
||||
(is (not (s/child-of? scene :annB :annD))) ; the over-show bug
|
||||
(is (s/child-of? scene :root :annD))
|
||||
;; lane bars follow: annC's B-mark renders in B, its A-mark in A, none of annD in B
|
||||
(is (not (s/child-of? scene :annB :annC))) ; NOT filed under B → not listed there
|
||||
(is (not (s/child-of? scene :root :annC)))
|
||||
;; RESOLUTION (bars) is independent of membership: the cb mark still draws in
|
||||
;; annB's lane because its FOOTAGE lands there, even though annC isn't filed in B
|
||||
(is (= [[50 150 "cb"]] (s/lane-bars scene :annC (s/content-segments scene :annB))))
|
||||
(is (seq (s/lane-bars scene :annC (s/content-segments scene :annA)))))))
|
||||
(is (seq (s/lane-bars scene :annC (s/content-segments scene :annA))))
|
||||
;; filing annC into annB (an assertion) makes it LIST there too; bars unchanged
|
||||
(let [scene2 (assoc-in scene [:groups :annC :in] [:annA :annB])]
|
||||
(is (s/child-of? scene2 :annB :annC))
|
||||
(is (= #{:annA :annB} (s/membership scene2 :annC)))
|
||||
(is (= :annA (s/home scene2 :annC))) ; primary still first
|
||||
(is (= [[50 150 "cb"]] (s/lane-bars scene2 :annC (s/content-segments scene2 :annB))))))))
|
||||
|
||||
(deftest jump-targets-label-from-the-clip-not-the-proxy
|
||||
(testing "a discontinuous annotation's jump popover labels each target from the
|
||||
|
|
@ -352,7 +348,7 @@
|
|||
(let [pa (s/make-proxy base :root 0 50) ; within clip A
|
||||
pc (s/make-proxy base :root 250 300) ; within clip C (non-adjacent → 2 runs)
|
||||
scene (-> base (with-group :pa pa) (with-group :pc pc)
|
||||
(with-group :ann {:type :annotation :parent :root
|
||||
(with-group :ann {:type :annotation :in [:root]
|
||||
:marks [(s/proxy-ref :ma :pa) (s/proxy-ref :mc :pc)]}))
|
||||
segs (s/content-segments scene :root)
|
||||
jumps (s/jump-targets scene :root :ann)]
|
||||
|
|
@ -481,7 +477,7 @@
|
|||
(deftest frames-are-mark-time-under-parent-trim
|
||||
(testing "frames are 0-based within the TRIMMED segment, not raw clip time"
|
||||
(let [scene (with-group base :p
|
||||
{:type :annotation :parent :root
|
||||
{:type :annotation :in [:root]
|
||||
:marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]})
|
||||
segs (s/content-segments scene :p)]
|
||||
(is (= 60 (s/seg-length segs :m/s))) ; trimmed length, not 100
|
||||
|
|
@ -508,7 +504,8 @@
|
|||
:end {:ref "clip-a" :at -1}}]}}
|
||||
g (:ann-1 (s/restore-annotations json-like))]
|
||||
(is (= :annotation (:type g)))
|
||||
(is (= :root (:parent g)))
|
||||
(is (= [:root] (:in g))) ; legacy :parent migrated to an :in edge
|
||||
(is (nil? (:parent g))) ; and the old field is dropped
|
||||
(is (= :clip-a (get-in g [:marks 0 :start :ref])))
|
||||
(let [scene (assoc-in base [:groups :ann-1] g)]
|
||||
(is (= [0 100] (:src (first (s/resolve scene :ann-1)))))))))
|
||||
|
|
@ -519,9 +516,9 @@
|
|||
(deftest annotations-survive-json-roundtrip
|
||||
(testing "restore-annotations is the exact inverse of the JSON wire trip — guards
|
||||
against any keyword-valued field (id/ref/type/parent/track) being missed"
|
||||
(let [anns {:ann-p {:v s/schema-version :type :annotation :parent :root :name "p" :color "#abc" :content "hi"
|
||||
(let [anns {:ann-p {:v s/schema-version :type :annotation :in [:root] :name "p" :color "#abc" :content "hi"
|
||||
:marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]}
|
||||
:ann-c {:v s/schema-version :type :annotation :parent :ann-p :name "c"
|
||||
:ann-c {:v s/schema-version :type :annotation :in [:ann-p] :name "c"
|
||||
:marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}]
|
||||
(is (= anns (s/restore-annotations (json-roundtrip anns)))))))
|
||||
|
||||
|
|
@ -578,7 +575,7 @@
|
|||
(deftest repeats-are-unambiguous
|
||||
(testing "two instances of A share a source frame but distinct locals (local is master)"
|
||||
(let [scene (with-group base :ann
|
||||
{:type :annotation :parent :root
|
||||
{:type :annotation :in [:root]
|
||||
:marks [(refm :m/r0 :clip-a 0 -1) (refm :m/r1 :clip-b 0 -1) (refm :m/r2 :clip-a 0 -1)]})
|
||||
segs (s/resolve scene :ann)]
|
||||
(is (= 5 (s/local->source segs 5))) ; first A
|
||||
|
|
@ -610,9 +607,9 @@
|
|||
|
||||
(deftest path-to-builds-stack-and-drops-orphans
|
||||
(let [scene {:groups {:root {:type :timeline :parent nil}
|
||||
:a {:type :annotation :parent :root}
|
||||
:b {:type :annotation :parent :a}
|
||||
:orphan {:type :annotation :parent :gone}}}]
|
||||
:a {:type :annotation :in [:root]}
|
||||
:b {:type :annotation :in [:a]}
|
||||
:orphan {:type :annotation :in [:gone]}}}]
|
||||
(testing "path is root → … → target"
|
||||
(is (= [:root] (s/path-to scene :root)))
|
||||
(is (= [:root :a] (s/path-to scene :a)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue