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:
parent
30cfbf3a1f
commit
24558b1cae
5 changed files with 94 additions and 35 deletions
|
|
@ -22,9 +22,9 @@
|
||||||
;; one-time dev reset: wipe saved marks once so the nested-timeline seed data
|
;; 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.
|
;; shows, then flag it so persistence resumes normally. Safe to delete later.
|
||||||
(defn- reset-marks-once! []
|
(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")
|
(.removeItem js/localStorage "tl/marks")
|
||||||
(.setItem js/localStorage "tl/seed-reset-1" "1")))
|
(.setItem js/localStorage "tl/seed-reset-2" "1")))
|
||||||
|
|
||||||
(defn init []
|
(defn init []
|
||||||
(reset-marks-once!)
|
(reset-marks-once!)
|
||||||
|
|
|
||||||
|
|
@ -21,25 +21,48 @@
|
||||||
;;
|
;;
|
||||||
;; The annotations below are seed data (shown on a fresh localStorage) so the
|
;; The annotations below are seed data (shown on a fresh localStorage) so the
|
||||||
;; expand/nest flow is testable: "Opening rally" has two children.
|
;; 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
|
:marks
|
||||||
{:timeline-stack [:root]
|
{:timeline-stack [:root]
|
||||||
:groups {:root {:type :timeline :name "Sequence"}
|
: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
|
:ann-rally
|
||||||
{:type :annotation :parent :root :name "Opening rally" :color "#4e8fc2"
|
{:type :annotation :parent :root :name "Opening rally" :color "#4e8fc2"
|
||||||
|
:created 2
|
||||||
:content "The first volley — CU coverage across the three principals."
|
:content "The first volley — CU coverage across the three principals."
|
||||||
:marks [:t2-c0 :t3-c0 :t4-c0]}
|
: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
|
:ann-tashi-read
|
||||||
{:type :annotation :parent :ann-rally :name "Tashi's read" :color "#c2624e"
|
{: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]]]}
|
:marks [[[:at :t2-c0 0] [:at :t2-c0 -1]]]}
|
||||||
:ann-art-react
|
:ann-art-react
|
||||||
{:type :annotation :parent :ann-rally :name "Art reacts" :color "#5ab07a"
|
{:type :annotation :parent :ann-rally :name "Art reacts" :color "#5ab07a"
|
||||||
:marks [:t3-c0]}
|
:created 7 :marks [:t3-c0]}
|
||||||
|
:ann-spin
|
||||||
:ann-net
|
{:type :annotation :parent :ann-rally :name "the spin" :color "#4ec2b0"
|
||||||
{:type :annotation :parent :root :name "Net-cam beat" :color "#9a7ac2"
|
:created 8 :marks [[140 205]]}}}
|
||||||
:marks [:t6-c0]}}}
|
|
||||||
|
|
||||||
;; transient view state (mutates while scrubbing/zooming)
|
;; transient view state (mutates while scrubbing/zooming)
|
||||||
:view {:zoom 50 ; X zoom: pixels per SECOND (px/frame = zoom/fps)
|
:view {:zoom 50 ; X zoom: pixels per SECOND (px/frame = zoom/fps)
|
||||||
|
|
|
||||||
|
|
@ -115,7 +115,8 @@
|
||||||
;; new annotations are children of whatever context we're currently in
|
;; new annotations are children of whatever context we're currently in
|
||||||
(let [id (keyword (str "ann-" (random-uuid)))
|
(let [id (keyword (str "ann-" (random-uuid)))
|
||||||
parent (last (get-in db [:marks :timeline-stack]))
|
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))
|
(seq content) (assoc :content content))
|
||||||
db' (assoc-in db [:marks :groups id] group)]
|
db' (assoc-in db [:marks :groups id] group)]
|
||||||
{:db db' :tl/save (:marks db')})))
|
{:db db' :tl/save (:marks db')})))
|
||||||
|
|
|
||||||
|
|
@ -59,9 +59,12 @@
|
||||||
(let [spans (marks/resolve-group idx groups gid)]
|
(let [spans (marks/resolve-group idx groups gid)]
|
||||||
{:id gid :name (:name g) :content (:content g) :color (:color g)
|
{:id gid :name (:name g) :content (:content g) :color (:color g)
|
||||||
:marks (:marks g) :children (get child-count gid 0)
|
:marks (:marks g) :children (get child-count gid 0)
|
||||||
|
:created (:created g 0) ; definition order
|
||||||
:spans spans :anchor (marks/anchor spans)
|
:spans spans :anchor (marks/anchor spans)
|
||||||
|
:end (when (seq spans) (reduce max (map :end spans)))
|
||||||
:instant? (every? :instant? 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)))))
|
vec)))))
|
||||||
|
|
||||||
;; Breadcrumb trail for the stack: root + each expanded annotation's name.
|
;; Breadcrumb trail for the stack: root + each expanded annotation's name.
|
||||||
|
|
|
||||||
|
|
@ -260,18 +260,46 @@
|
||||||
|
|
||||||
;; --- timeline -------------------------------------------------------------
|
;; --- 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
|
(defn annotation-lane
|
||||||
"One labeled row per annotation, above the tracks. Bars are positioned in
|
"The annotation rows above the tracks. Annotations are packed into shared rows
|
||||||
display frames (same coordinate as clips), so they align with the timeline.
|
(see assign-lanes); each row holds every annotation assigned to that lane.
|
||||||
`off` is the crop offset (frames): positions are drawn relative to it."
|
Bars are positioned in display frames relative to the crop offset `off`."
|
||||||
[fps zoom off annotations active]
|
[fps zoom off placed active]
|
||||||
[:div
|
[:div
|
||||||
(doall
|
(doall
|
||||||
(for [{:keys [id name spans preview?] c :color} annotations]
|
(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")
|
(let [color (or c "#4e8fc2")
|
||||||
on? (= id active)]
|
on? (= id active)]
|
||||||
^{:key id}
|
^{:key id}
|
||||||
[:div.ann-lane-row
|
[:<>
|
||||||
(doall
|
(doall
|
||||||
(for [[j s] (map-indexed vector spans)]
|
(for [[j s] (map-indexed vector spans)]
|
||||||
(let [left (* (secs (- (:start s) off) fps) zoom)
|
(let [left (* (secs (- (:start s) off) fps) zoom)
|
||||||
|
|
@ -283,7 +311,7 @@
|
||||||
:background (cond preview? (str color "44") on? color :else (str color "80"))
|
:background (cond preview? (str color "44") on? color :else (str color "80"))
|
||||||
:border (str (if preview? "1px dashed " "1px solid ") color)}}])))
|
:border (str (if preview? "1px dashed " "1px solid ") color)}}])))
|
||||||
(when-let [a (some-> spans first :start)]
|
(when-let [a (some-> spans first :start)]
|
||||||
[:div.ann-bar-label {:style {:left (+ 4 (* (secs (- a off) fps) zoom))}} name])])))])
|
[: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}]
|
(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)
|
(let [left (* (secs (- media-in off) fps) zoom)
|
||||||
|
|
@ -361,12 +389,16 @@
|
||||||
(try (marks/resolve-marks cidx groups #{} marks)
|
(try (marks/resolve-marks cidx groups #{} marks)
|
||||||
(catch :default _ nil)))]
|
(catch :default _ nil)))]
|
||||||
(when (seq spans)
|
(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)")
|
:name (or (not-empty (str/trim (str (:name d)))) "(new)")
|
||||||
:spans spans})))
|
:spans spans})))
|
||||||
lane-anns (let [base (if (:id d) (remove #(= (:id %) (:id d)) anns) anns)]
|
lane-anns (let [base (if (:id d) (remove #(= (:id %) (:id d)) anns) anns)]
|
||||||
(cond-> (vec base) preview (conj preview)))
|
(->> (cond-> (vec base) preview (conj preview))
|
||||||
lane-h (* 18 (count lane-anns))
|
(filterv (comp seq :spans)))) ; need a footprint to pack
|
||||||
|
placed (assign-lanes lane-anns)
|
||||||
|
lane-h (* 18 (lane-count placed))
|
||||||
end (+ off vframes)
|
end (+ off vframes)
|
||||||
width (* (secs vframes fps) zoom)]
|
width (* (secs vframes fps) zoom)]
|
||||||
(when (and playing? @following?)
|
(when (and playing? @following?)
|
||||||
|
|
@ -391,7 +423,7 @@
|
||||||
(let [x (* (secs (- playhead off) fps) zoom)]
|
(let [x (* (secs (- playhead off) fps) zoom)]
|
||||||
[:div.playhead {:style {:left x}}
|
[:div.playhead {:style {:left x}}
|
||||||
[:div.playhead-handle]])
|
[:div.playhead-handle]])
|
||||||
[annotation-lane fps zoom off lane-anns active]
|
[annotation-lane fps zoom off placed active]
|
||||||
(for [t vtracks]
|
(for [t vtracks]
|
||||||
^{:key (:id t)} [track-row fps zoom off row-h (some? d) t])]]]))))
|
^{:key (:id t)} [track-row fps zoom off row-h (some? d) t])]]]))))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue