From 24558b1cae4c4e8cca16cbfd752823b5a2e117a7 Mon Sep 17 00:00:00 2001 From: Your Name Date: Sat, 27 Jun 2026 17:05:05 -0400 Subject: [PATCH] feat: pack annotation lanes into shared rows The annotation lane above the tracks now collapses non-overlapping annotations onto a single row. Each annotation is assigned a lane by greedy first-fit in definition order (:created): it takes the topmost lane it doesn't time-overlap, so overlapping annotations stack with the earlier-defined one on top and the newer beneath. - annotations carry :created (new ones stamp Date.now; seed has explicit values; old saved data defaults to 0 = oldest) - pane order: by start, then longest-first so a section leads a tie - seed data reworked to overlap (Act I / rally / baseline / glance / net, plus an overlapping nested child) so the packing is visible; one-time localStorage reset bumped so it lands Co-Authored-By: Claude Opus 4.8 --- tl/src/tl/core.cljs | 4 +-- tl/src/tl/db.cljs | 35 ++++++++++++++---- tl/src/tl/events.cljs | 3 +- tl/src/tl/subs.cljs | 5 ++- tl/src/tl/views.cljs | 82 ++++++++++++++++++++++++++++++------------- 5 files changed, 94 insertions(+), 35 deletions(-) diff --git a/tl/src/tl/core.cljs b/tl/src/tl/core.cljs index 2576a09..66fbb4d 100644 --- a/tl/src/tl/core.cljs +++ b/tl/src/tl/core.cljs @@ -22,9 +22,9 @@ ;; one-time dev reset: wipe saved marks once so the nested-timeline seed data ;; shows, then flag it so persistence resumes normally. Safe to delete later. (defn- reset-marks-once! [] - (when-not (.getItem js/localStorage "tl/seed-reset-1") + (when-not (.getItem js/localStorage "tl/seed-reset-2") (.removeItem js/localStorage "tl/marks") - (.setItem js/localStorage "tl/seed-reset-1" "1"))) + (.setItem js/localStorage "tl/seed-reset-2" "1"))) (defn init [] (reset-marks-once!) diff --git a/tl/src/tl/db.cljs b/tl/src/tl/db.cljs index 5b11ac9..d7c5745 100644 --- a/tl/src/tl/db.cljs +++ b/tl/src/tl/db.cljs @@ -21,25 +21,48 @@ ;; ;; The annotations below are seed data (shown on a fresh localStorage) so the ;; expand/nest flow is testable: "Opening rally" has two children. + ;; The seed is laid out to exercise lane packing. Root level (by frame): + ;; Act I 0–414 (section) created 1 -> lane 0 (earliest, top) + ;; Opening rally 129–385 created 2 -> lane 1 (overlaps Act I) + ;; Baseline 64–128 created 3 -> lane 1 (fits before rally) + ;; Tashi glance 150–175 created 4 -> lane 2 (overlaps both) + ;; Net-cam beat 542–609 created 5 -> lane 0 (collapses after Act I) :marks {:timeline-stack [:root] :groups {:root {:type :timeline :name "Sequence"} + :ann-act1 + {:type :annotation :parent :root :name "Act I — the warmup" :color "#8a8f3a" + :created 1 :content "The whole opening movement." + :marks [[0 414]]} :ann-rally {:type :annotation :parent :root :name "Opening rally" :color "#4e8fc2" + :created 2 :content "The first volley — CU coverage across the three principals." :marks [:t2-c0 :t3-c0 :t4-c0]} + :ann-baseline + {:type :annotation :parent :root :name "Baseline establishing" :color "#c28f4e" + :created 3 :marks [:t1-c0]} + :ann-glance + {:type :annotation :parent :root :name "Tashi glance" :color "#c24e9a" + :created 4 :marks [[150 175]]} + :ann-net + {:type :annotation :parent :root :name "Net-cam beat" :color "#9a7ac2" + :created 5 :marks [:t6-c0]} + + ;; children of "Opening rally" (visible only when expanded into it): + ;; Tashi's read 129–190 / Art reacts 192–266 -> share lane 0 + ;; the spin 140–205 -> lane 1 (overlaps both) :ann-tashi-read {:type :annotation :parent :ann-rally :name "Tashi's read" :color "#c2624e" - :content "She clocks the spin early." + :created 6 :content "She clocks the spin early." :marks [[[:at :t2-c0 0] [:at :t2-c0 -1]]]} :ann-art-react {:type :annotation :parent :ann-rally :name "Art reacts" :color "#5ab07a" - :marks [:t3-c0]} - - :ann-net - {:type :annotation :parent :root :name "Net-cam beat" :color "#9a7ac2" - :marks [:t6-c0]}}} + :created 7 :marks [:t3-c0]} + :ann-spin + {:type :annotation :parent :ann-rally :name "the spin" :color "#4ec2b0" + :created 8 :marks [[140 205]]}}} ;; transient view state (mutates while scrubbing/zooming) :view {:zoom 50 ; X zoom: pixels per SECOND (px/frame = zoom/fps) diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index cd83575..8d10caf 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -115,7 +115,8 @@ ;; new annotations are children of whatever context we're currently in (let [id (keyword (str "ann-" (random-uuid))) parent (last (get-in db [:marks :timeline-stack])) - group (cond-> {:type :annotation :parent parent :name name :color color :marks marks} + group (cond-> {:type :annotation :parent parent :name name :color color + :marks marks :created (.now js/Date)} ; defines stacking order (seq content) (assoc :content content)) db' (assoc-in db [:marks :groups id] group)] {:db db' :tl/save (:marks db')}))) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 4a8faa0..469a142 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -59,9 +59,12 @@ (let [spans (marks/resolve-group idx groups gid)] {:id gid :name (:name g) :content (:content g) :color (:color g) :marks (:marks g) :children (get child-count gid 0) + :created (:created g 0) ; definition order :spans spans :anchor (marks/anchor spans) + :end (when (seq spans) (reduce max (map :end spans))) :instant? (every? :instant? spans)}))) - (sort-by :anchor) + ;; pane order: by start, then longest first (sections lead a tie) + (sort-by (juxt #(or (:anchor %) 0) #(- (or (:end %) 0)))) vec))))) ;; Breadcrumb trail for the stack: root + each expanded annotation's name. diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index fedc7ae..2aaf21f 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -260,30 +260,58 @@ ;; --- timeline ------------------------------------------------------------- +(defn- ann-extent + "[earliest-start, latest-end] across an annotation's spans (its footprint)." + [spans] [(reduce min (map :start spans)) (reduce max (map :end spans))]) + +(defn- assign-lanes + "Pack annotations into as few rows as possible. Processed in definition order + (earliest :created first), each takes the topmost lane it doesn't time-overlap + — so non-overlapping annotations collapse onto one row, and when they do + overlap the earlier-defined one sits above. Returns each with a :lane index." + [anns] + (let [ordered (sort-by (juxt #(:created % 0) #(first (ann-extent (:spans %)))) anns)] + (loop [[a & more] ordered, lanes [], out []] + (if (nil? a) + out + (let [[s e] (ann-extent (:spans a)) + fits? (fn [ivs] (every? (fn [[s2 e2]] (or (<= e s2) (>= s e2))) ivs)) + li (or (first (keep-indexed (fn [i ivs] (when (fits? ivs) i)) lanes)) + (count lanes)) + lanes (update (if (< li (count lanes)) lanes (conj lanes [])) li conj [s e])] + (recur more lanes (conj out (assoc a :lane li)))))))) + +(defn- lane-count [placed] + (if (seq placed) (inc (reduce max (map :lane placed))) 0)) + (defn annotation-lane - "One labeled row per annotation, above the tracks. Bars are positioned in - display frames (same coordinate as clips), so they align with the timeline. - `off` is the crop offset (frames): positions are drawn relative to it." - [fps zoom off annotations active] + "The annotation rows above the tracks. Annotations are packed into shared rows + (see assign-lanes); each row holds every annotation assigned to that lane. + Bars are positioned in display frames relative to the crop offset `off`." + [fps zoom off placed active] [:div (doall - (for [{:keys [id name spans preview?] c :color} annotations] - (let [color (or c "#4e8fc2") - on? (= id active)] - ^{:key id} - [:div.ann-lane-row - (doall - (for [[j s] (map-indexed vector spans)] - (let [left (* (secs (- (:start s) off) fps) zoom) - w (* (secs (- (:end s) (:start s)) fps) zoom)] - ^{:key j} - [:div.ann-bar - {:title name - :style {:left left :width (max 3 w) - :background (cond preview? (str color "44") on? color :else (str color "80")) - :border (str (if preview? "1px dashed " "1px solid ") color)}}]))) - (when-let [a (some-> spans first :start)] - [:div.ann-bar-label {:style {:left (+ 4 (* (secs (- a off) fps) zoom))}} name])])))]) + (for [[li items] (->> placed (group-by :lane) (into (sorted-map)))] + ^{:key li} + [:div.ann-lane-row + (doall + (for [{:keys [id name spans preview?] c :color} items] + (let [color (or c "#4e8fc2") + on? (= id active)] + ^{:key id} + [:<> + (doall + (for [[j s] (map-indexed vector spans)] + (let [left (* (secs (- (:start s) off) fps) zoom) + w (* (secs (- (:end s) (:start s)) fps) zoom)] + ^{:key j} + [:div.ann-bar + {:title name + :style {:left left :width (max 3 w) + :background (cond preview? (str color "44") on? color :else (str color "80")) + :border (str (if preview? "1px dashed " "1px solid ") color)}}]))) + (when-let [a (some-> spans first :start)] + [:div.ann-bar-label {:style {:left (+ 4 (* (secs (- a off) fps) zoom))}} name])])))]))]) (defn clip-block [fps zoom off row-h authoring? {:keys [id name media-in duration] :as _clip}] (let [left (* (secs (- media-in off) fps) zoom) @@ -361,12 +389,16 @@ (try (marks/resolve-marks cidx groups #{} marks) (catch :default _ nil)))] (when (seq spans) - {:id ::draft :preview? true :color (:color d) + ;; newest :created so the in-progress draft sinks below + ;; existing annotations when they overlap + {:id ::draft :preview? true :color (:color d) :created js/Infinity :name (or (not-empty (str/trim (str (:name d)))) "(new)") :spans spans}))) lane-anns (let [base (if (:id d) (remove #(= (:id %) (:id d)) anns) anns)] - (cond-> (vec base) preview (conj preview))) - lane-h (* 18 (count lane-anns)) + (->> (cond-> (vec base) preview (conj preview)) + (filterv (comp seq :spans)))) ; need a footprint to pack + placed (assign-lanes lane-anns) + lane-h (* 18 (lane-count placed)) end (+ off vframes) width (* (secs vframes fps) zoom)] (when (and playing? @following?) @@ -391,7 +423,7 @@ (let [x (* (secs (- playhead off) fps) zoom)] [:div.playhead {:style {:left x}} [:div.playhead-handle]]) - [annotation-lane fps zoom off lane-anns active] + [annotation-lane fps zoom off placed active] (for [t vtracks] ^{:key (:id t)} [track-row fps zoom off row-h (some? d) t])]]]))))