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 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-06-27 17:05:05 -04:00
parent 30cfbf3a1f
commit 24558b1cae
5 changed files with 94 additions and 35 deletions

View file

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

View file

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

View file

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

View file

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

View file

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