From 65acfbc886cbaa6a1baba4e289ec43355fb01051 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 2 Jul 2026 20:17:03 -0400 Subject: [PATCH] feat: reveal child annotations in-place + lane packing + range warnings MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Greedy annotation lane collapse: non-overlapping annotations share a lane (packed by earliest start, then longest span); each annotation keeps all its segments in one lane. - Clicking a lane bar jumps the playhead to that mark and scrolls its card into view instead of drilling into the annotation timeline. - "Show N annotations" toggle nests an annotation's children (recursively) in the commentary pane and surfaces them in the lane; children reparent-drag correctly (stopPropagation so the child, not the parent, is moved). - Out-of-range warning (⚠) on cards and the content display when an annotation references frames its parent timeline trims; the lane shows the best-effort in-range portion (scene/nested-src + scene/clip-loss?). - Annotation-card markdown: 12px body, larger heading ramp. Co-Authored-By: Claude Opus 4.8 --- tl/resources/public/css/app.css | 22 ++++++-- tl/src/tl/events.cljs | 6 +++ tl/src/tl/scene.cljs | 32 +++++++++++ tl/src/tl/subs.cljs | 24 ++++++--- tl/src/tl/views.cljs | 95 +++++++++++++++++++++++++++------ 5 files changed, 151 insertions(+), 28 deletions(-) diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index 71eac38..47e3f41 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -316,6 +316,19 @@ 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; } +/* 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; + color: var(--ink); background: var(--shade); cursor: pointer; + border: 1px solid var(--ink); border-radius: 0; } +.show-children:hover { background: var(--ink); color: var(--paper); } +.ann-children { margin: 8px 0 0 10px; padding-left: 8px; + border-left: 2px solid var(--ann-color, var(--ink)); } +.ann-children .ann { margin-bottom: 6px; } +.ann-children .ann:last-child { margin-bottom: 0; } +/* out-of-range warning: annotation references frames its parent timeline trims */ +.ann-warn { cursor: help; font-style: normal; } + /* --- timeline tag filter ------------------------------------------------ */ .tag-filter { position: relative; display: inline-flex; } .filter-btn { @@ -348,11 +361,12 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .save:active { box-shadow: 0 0 0 1px var(--paper), 0 0 0 3px var(--ink); } /* --- markdown (tl.md output is wrapped in .md) -------------------------- */ +.md { font-size: 12px; line-height: 1.45; } .md h1, .md h2, .md h3, .md h4, .md h5, .md h6 { font-family: var(--chicago); } -.md h1 { font-size: 16px; margin: 0 0 6px; line-height: 1.25; } -.md h2 { font-size: 14px; margin: 0 0 6px; line-height: 1.25; } -.md h3 { font-size: 13px; margin: 0 0 6px; line-height: 1.25; } -.md h4, .md h5, .md h6 { font-size: 12px; margin: 0 0 6px; } +.md h1 { font-size: 22px; margin: 0 0 6px; line-height: 1.2; } +.md h2 { font-size: 17px; margin: 0 0 6px; line-height: 1.22; } +.md h3 { font-size: 15px; margin: 0 0 6px; line-height: 1.25; } +.md h4, .md h5, .md h6 { font-size: 13px; margin: 0 0 6px; } .md p { margin: 0 0 8px; } .md ul { margin: 0 0 8px 18px; padding: 0; } .md code { font-family: var(--mono); background: var(--shade); padding: 0 3px; diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 01e2151..31d5729 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -529,6 +529,12 @@ (let [next-db (assoc-in db [:view :playheads ctx] lf)] (sync-route {:db next-db} next-db)))) (rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p))) +;; reveal an annotation's immediate children into the current timeline lane +(rf/reg-event-db ::toggle-children + (fn [db [_ gid]] + (update-in db [:view :revealed] + (fn [s] (let [s (or s #{})] + (if (s gid) (disj s gid) (conj s gid))))))) (rf/reg-event-db ::set-zoom (fn [db [_ z]] (assoc-in db [:view :zoom] z))) (rf/reg-event-db ::set-row-h (fn [db [_ h]] (assoc-in db [:view :row-h] h))) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index bc47af9..95b1c84 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -203,6 +203,38 @@ vec) (resolve scene ctx))) +(defn- src-intersect + "Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))." + [rs cover] + (vec (for [[a b] rs [c d] cover + :let [lo (max a c) hi (min b d)] + :when (< lo hi)] + [lo hi]))) + +(defn nested-src + "Source ranges of annotation `gid` clipped to every ancestor annotation between + it and `ctx` — what's still visible once the reveal chain trims it, i.e. the + same content you'd see if you expanded into its parent. A direct child of `ctx` + is just its own resolved source (the timeline itself does the clipping later). + Empty ⇒ the annotation is out of range in this reveal chain." + [scene ctx gid] + (loop [p (:parent (grp scene gid)), rs (mapv :src (resolve scene gid))] + (if (or (nil? p) (= p ctx)) + rs + (recur (:parent (grp scene p)) + (src-intersect rs (mapv :src (resolve scene p))))))) + +(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." + [scene gid] + (let [p (:parent (grp 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)))))) + ;; --- editing: split a local selection into a run of single-clip marks ----- (defn selection->marks diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 315c71b..8dd535c 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -39,6 +39,7 @@ (rf/reg-sub ::zoom (fn [db] (get-in db [:view :zoom]))) (rf/reg-sub ::row-h (fn [db] (get-in db [:view :row-h]))) (rf/reg-sub ::stack (fn [db] (get-in db [:view :stack]))) +(rf/reg-sub ::revealed (fn [db] (get-in db [:view :revealed] #{}))) (rf/reg-sub ::context :<- [::stack] (fn [stack _] (peek stack))) @@ -90,24 +91,31 @@ ;; child annotations of the current context, with their bars in local coords (rf/reg-sub ::annotations - :<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] - (fn [[scene ctx segs hidden-tags] _] + :<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed] + (fn [[scene ctx segs hidden-tags revealed] _] (let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g))) - (:groups scene)))] + (:groups scene))) + ;; shown when every ancestor up to ctx is revealed: a direct child of ctx + ;; always shows; a deeper annotation shows only if its parent is revealed + ;; AND that parent is itself shown. + shown? (fn shown? [p] (or (= ctx p) + (and (revealed p) (shown? (get-in scene [:groups p :parent])))))] (->> (:groups scene) (keep (fn [[gid g]] - (when (and (= :annotation (:type g)) (= ctx (:parent g)) + (when (and (= :annotation (:type g)) (shown? (:parent g)) ;; a hidden tag hides every annotation carrying it; the ;; :untagged sentinel hides annotations with no tags (let [tags (get-in g [:meta :tags])] (not (or (some hidden-tags tags) (and (empty? tags) (contains? hidden-tags :untagged)))))) - (let [src-segs (scene/resolve scene gid) + (let [src-ranges (scene/nested-src scene ctx gid) ; best effort here bars (scene/merge-bars - (mapcat (fn [{[a b] :src}] (scene/pieces segs a b)) src-segs)) + (mapcat (fn [[a b]] (scene/pieces segs a b)) src-ranges)) reason (scene/broken-reason scene gid) + oor (boolean (scene/clip-loss? scene gid)) hidden (get-in g [:meta :hidden])] - {:id gid :name (:name g) :color (or (:color g) "#4e8fc2") + {:id gid :parent (:parent g) + :name (:name g) :color (or (:color g) "#4e8fc2") :content (:content g) :children (count (:marks g)) :nested (get nested gid 0) :draft (boolean (:draft g)) @@ -116,7 +124,7 @@ :notes (->> (concat (:notes g) (mapcat :notes (:marks g))) distinct (filterv #(= :script-note (get-in scene [:groups % :type])))) - :broken (boolean reason) :reason reason + :broken (boolean reason) :reason reason :oor oor :hidden (boolean hidden) :tags (vec (get-in g [:meta :tags])) ;; jump targets labelled from the marks' clip refs (same as diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 05832e9..93d5604 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -490,6 +490,40 @@ (r/after-render #(position-playhead! fps zoom playhead)) nil)) +(defn- bars-overlap? + "Any bar in `as` overlapping any bar in `bs`? Bars are half-open [lo hi), so + touching (hi == lo) counts as side-by-side, not overlap." + [as bs] + (boolean (some (fn [[lo hi]] + (some (fn [[lo2 hi2]] (and (< lo hi2) (< lo2 hi))) bs)) + as))) + +(defn- ann-lanes + "Greedy vertical lane packing for annotation bars. An annotation keeps ALL its + segments in one lane, and drops to a lower lane if ANY of its bars overlaps ANY + bar already placed in that lane. Priority for the top lanes: earliest start, + then (same start) longest span. Returns {ann-id -> lane-index}." + [anns] + (let [prep (->> anns + (keep (fn [a] + (when-let [bars (seq (:bars a))] + (let [lo (reduce min (map first bars)) + hi (reduce max (map second bars))] + {:id (:id a) :bars bars :start lo :len (- hi lo)})))) + (sort-by (juxt :start (comp - :len))))] + (loop [[a & more] prep, lanes [], out {}] + (if (nil? a) + out + (let [i (or (first (keep-indexed + (fn [idx lane-bars] + (when-not (bars-overlap? (:bars a) lane-bars) idx)) + lanes)) + (count lanes)) + lanes (if (< i (count lanes)) + (update lanes i into (:bars a)) + (conj lanes (:bars a)))] + (recur more lanes (assoc out (:id a) i))))))) + (defn timeline [] (let [content (atom nil) lanes-scroll (atom nil) @@ -507,7 +541,12 @@ linking @(rf/subscribe [::subs/linking]) len @(rf/subscribe [::subs/length]) width (px len fps zoom) - lane-h (max 18 (* 18 (count anns))) + hidden? (fn [a] (get-in scene [:groups (:id a) :meta :hidden])) + visible (remove hidden? anns) + hidden (filter hidden? anns) + lane-of (ann-lanes visible) ; {ann-id -> lane} + n-lanes (if (empty? lane-of) 0 (inc (reduce max (vals lane-of)))) + lane-h (max 18 (* 18 (max n-lanes (count hidden)))) tracks-h (* row-h (count tracks)) track-y (into {} (map-indexed (fn [i t] [(:id t) i]) tracks))] [:div.timeline {:class (when-not @tracks-open? "tracks-collapsed")} @@ -532,8 +571,8 @@ [:div.ann-lanes {:style {:height lane-h :width width} :on-mouse-down #(scrub! @content fps zoom %)} ;; annotation bars — solid for saved, dashed for the in-progress draft - ;; visible annotations: full bars with labels - (for [[i a] (map-indexed vector (filter (fn [a] (not (get-in (get-in scene [:groups (:id a)]) [:meta :hidden]))) anns)) + ;; visible annotations: full bars with labels, greedily packed into lanes + (for [a visible [j [lo hi]] (map-indexed vector (:bars a))] ^{:key (str (:id a) "-" j)} [:div.ann-bar {:title (:name a) @@ -542,20 +581,25 @@ (if linking (do (.preventDefault e) ; pick: link to this timeline (commit-link! {:kind :timeline :ref (:id a)} (:name a))) - (rf/dispatch [::events/expand (:id a)])))) - :style {:top (+ 2 (* i 18)) :height 14 + ;; jump the playhead to this mark and scroll its + ;; card into view (don't drill into the timeline) + (do (goto! lo true) + (when-let [node (js/document.getElementById + (str "ann-" (name (:id a))))] + (.scrollIntoView node #js {:block "center" :behavior "smooth"})))))) + :style {:top (+ 2 (* (lane-of (:id a)) 18)) :height 14 :left (px lo fps zoom) :width (max 4 (px (- hi lo) fps zoom)) :background (str (:color a) (if (:draft a) "44" "cc")) :cursor (if (:draft a) "default" "pointer") :border-radius 2 :border (str (if (:draft a) "1px dashed " "1px solid ") (:color a))}}]) ;; visible annotation labels - (for [[i a] (map-indexed vector (filter (fn [a] (not (get-in (get-in scene [:groups (:id a)]) [:meta :hidden]))) anns)) :let [[lo _] (first (:bars a))] :when lo] + (for [a visible :let [[lo _] (first (:bars a))] :when lo] ^{:key (str "lbl-" (:id a))} - [:div.ann-bar-label {:style {:top (* i 18) + [:div.ann-bar-label {:style {:top (* (lane-of (:id a)) 18) :left (+ 4 (px lo fps zoom))}} (:name a)]) ;; hidden annotations: tiny colored dots with dither pattern — click to unhide - (for [[i a] (map-indexed vector (filter (fn [a] (get-in (get-in scene [:groups (:id a)]) [:meta :hidden])) anns)) :let [[lo _] (first (:bars a))] :when lo] + (for [[i a] (map-indexed vector hidden) :let [[lo _] (first (:bars a))] :when lo] ^{:key (str "hidden-" (:id a))} [:div.ann-hidden {:title (str (:name a) " (click to unhide)") :on-click #(do (.stopPropagation %) @@ -968,22 +1012,26 @@ (defn- ann-drag-props [a authed? over?] (when authed? {:draggable true + ;; cards nest, so stop each drag event at the card it fires on — otherwise it + ;; bubbles to the ancestor card and the parent's handler wins (dragging a + ;; child ends up moving the parent). :on-drag-start (fn [e] + (.stopPropagation e) (.. e -dataTransfer (setData "text/ann" (name (:id a)))) (set! (.. e -dataTransfer -effectAllowed) "move") (rf/dispatch [::events/ann-drag-start (:id a)])) :on-drag-end (fn [_] (reset! over? false) (rf/dispatch [::events/ann-drag-end])) :on-drag-over (fn [e] (when (has-type? e "text/ann") - (.preventDefault e) (reset! over? true))) + (.stopPropagation e) (.preventDefault e) (reset! over? true))) :on-drag-leave (fn [_] (reset! over? false)) :on-drop (fn [e] (let [src (.. e -dataTransfer (getData "text/ann"))] (when (seq src) - (.preventDefault e) (reset! over? false) + (.stopPropagation e) (.preventDefault e) (reset! over? false) (rf/dispatch [::events/reparent (keyword src) (:id a)]))))})) -(defn- annotation-card [a scene ctx segs nmap authed? open] +(defn- annotation-card [a scene ctx segs nmap authed? open by-parent] (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]) @@ -1013,7 +1061,9 @@ [:div.ann-head [:div.ann-title [:span.ann-swatch {:style {:background (:color a)}}] - (when (:broken a) [:span {:title (:reason a)} "△ "]) (:name a)] + (when (:broken a) [:span.ann-warn {:title (:reason a)} "△ "]) + (when (:oor a) [:span.ann-warn {:title "Out of range — trimmed by the parent timeline"} "⚠ "]) + (:name a)] [:div.ann-actions [jump-control open a scene segs] [:button.expand-btn {:title "Expand" :on-click #(rf/dispatch [::events/expand (:id a)])} @@ -1031,7 +1081,16 @@ ^{:key (name ng)} [note-live-chip ng n])]) (when (seq (:tags a)) (into [:div.ann-tags] - (for [t (:tags a)] ^{:key t} [tag-chip t])))])))) + (for [t (:tags a)] ^{:key t} [tag-chip t]))) + (when (pos? (:nested a)) + (let [shown? (contains? @(rf/subscribe [::subs/revealed]) (:id a))] + [:button.show-children {:on-click #(rf/dispatch [::events/toggle-children (:id a)])} + (str (if shown? "▾ Hide " "▸ Show ") (:nested a) + (if (= 1 (:nested a)) " annotation" " annotations"))])) + (when-let [kids (seq (get by-parent (:id a)))] + (into [:div.ann-children] + (for [k kids] + ^{:key (:id k)} [annotation-card k scene ctx segs nmap authed? open by-parent])))])))) ;; Renders nothing: owns the active-annotation subscription and scrolls the active ;; card into view, so `commentary` itself no longer re-renders on every crossing. @@ -1058,15 +1117,19 @@ ;; edit button — Edit drops into the parent timeline so marks are editable. (let [cg (get-in scene [:groups ctx])] [:div.ctx-content + (when (scene/clip-loss? scene ctx) + [:span.ann-warn {:title "Out of range — this annotation references frames its parent timeline trims"} "⚠ "]) (if (seq (:content cg)) [content-display scene (or (:parent cg) ctx) (:content cg)] [:div.muted "No description yet."]) (when authed? [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])]) (if (seq anns) - (doall - (for [a anns] - ^{:key (:id a)} [annotation-card a scene ctx segs nmap authed? open])) + (let [by-parent (group-by :parent anns)] ; nest revealed children under their parent + (doall + (for [a (get by-parent ctx)] + ^{:key (:id a)} + [annotation-card a scene ctx segs nmap authed? open by-parent]))) [:div.ann-empty "No annotations here."])])))) (defn- to-frame [v len]