From 649e36c14c8315b69a12d9f207c68c31db0ec2d8 Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 5 Jul 2026 18:17:09 -0400 Subject: [PATCH] feat: add annotation search filters --- tl/resources/public/css/app.css | 11 +++++ tl/src/tl/events.cljs | 19 ++++++--- tl/src/tl/filter.cljs | 54 +++++++++++++++++++++++++ tl/src/tl/scene.cljs | 3 +- tl/src/tl/subs.cljs | 71 +++++++++++++++++++++++---------- tl/src/tl/views.cljs | 50 +++++++++++++++-------- tl/test/tl/filter_test.cljs | 55 +++++++++++++++++++++++++ tl/test/tl/scene_test.cljs | 4 +- 8 files changed, 222 insertions(+), 45 deletions(-) create mode 100644 tl/src/tl/filter.cljs create mode 100644 tl/test/tl/filter_test.cljs diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index c9334ee..3c1a902 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -365,6 +365,17 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .ac .pt-dropdown li { display: flex; align-items: center; justify-content: space-between; gap: 6px; } .tag-eye { font-size: 12px; flex: none; } .pt-x:hover { text-decoration: underline; } +.annotation-filter { + display: flex; align-items: center; gap: 6px; flex-wrap: wrap; + padding: 6px 8px; border-bottom: 1px solid var(--ink); background: var(--paper); +} +.annotation-search { + flex: 1 1 220px; min-width: 0; box-sizing: border-box; + background: var(--paper); color: var(--ink); border: 1px solid var(--ink); + border-radius: 0; padding: 5px 7px; font-family: var(--geneva); font-size: 12px; +} +.annotation-filter .filter-btn { border-radius: 0; } +.annotation-filter .filter-btn.clear { margin-left: auto; } .form-hint { font-size: 11px; color: var(--mute); } .form-check { display: flex; align-items: center; gap: 6px; font-family: var(--chicago); diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 7a0c9ac..e1afab9 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -332,12 +332,21 @@ (let [s (get-in db [:view :hidden-notes] #{})] (assoc-in db [:view :hidden-notes] (if (contains? s gid) (disj s gid) (conj s gid)))))) -;; per-tag annotation visibility (view-only, ephemeral): eye toggles in the tag -;; filter. A tag in :hidden-tags hides every annotation carrying it. -(rf/reg-event-db ::toggle-tag-filter +;; annotation-pane filters are inclusive: selected tags narrow the list to +;; matching annotations; active-only narrows to annotations under the playhead. +(rf/reg-event-db ::set-annotation-search + (fn [db [_ q]] (assoc-in db [:view :annotation-filter :query] q))) +(rf/reg-event-db ::toggle-annotation-tag-filter (fn [db [_ tag]] - (let [s (get-in db [:view :hidden-tags] #{})] - (assoc-in db [:view :hidden-tags] (if (contains? s tag) (disj s tag) (conj s tag)))))) + (let [s (get-in db [:view :annotation-filter :tags] #{})] + (assoc-in db [:view :annotation-filter :tags] + (if (contains? s tag) (disj s tag) (conj s tag)))))) +(rf/reg-event-db ::toggle-active-annotations-filter + (fn [db _] + (update-in db [:view :annotation-filter :active-only?] not))) +(rf/reg-event-db ::clear-annotation-filter + (fn [db _] (assoc-in db [:view :annotation-filter] + {:query "" :tags #{} :active-only? false}))) ;; click a highlight on the page → activate its note and focus that region's row ;; in the right pane diff --git a/tl/src/tl/filter.cljs b/tl/src/tl/filter.cljs new file mode 100644 index 0000000..8733921 --- /dev/null +++ b/tl/src/tl/filter.cljs @@ -0,0 +1,54 @@ +(ns tl.filter + (:require [clojure.string :as str])) + +(def ^:private prefix-aliases + {"timeline" :timeline + "annotation" :timeline + "title" :timeline + "script" :script + "note" :script + "notes" :script + "clip" :clip + "clips" :clip + "tag" :tag + "tags" :tag}) + +(defn parse-query [q] + (let [s (str/trim (or q ""))] + (if-let [[_ prefix body] (re-matches #"(?i)^([a-z]+)\s*:\s*(.*)$" s)] + (if-let [scope (prefix-aliases (str/lower-case prefix))] + {:scope scope :term (str/lower-case (str/trim body))} + {:scope :all :term (str/lower-case s)}) + {:scope :all :term (str/lower-case s)}))) + +(defn- includes-term? [xs term] + (or (str/blank? term) + (some #(str/includes? (str/lower-case (str %)) term) xs))) + +(defn- tag-match? [selected tags] + (or (empty? selected) + (let [tags (set tags)] + (or (some tags selected) + (and (contains? selected :untagged) (empty? tags)))))) + +(defn annotation-matches? + [{:keys [query tags active-only? active-ids]} ann] + (let [{:keys [scope term]} (parse-query query) + selected-tags (set tags) + active-ids (set active-ids) + fields {:timeline [(:name ann) (:content ann)] + :script (:script ann) + :clip (:clips ann) + :tag (:tags ann)} + haystack (case scope + :timeline (:timeline fields) + :script (:script fields) + :clip (:clip fields) + :tag (:tag fields) + (mapcat fields [:timeline :script :clip :tag]))] + (and (tag-match? selected-tags (:tags ann)) + (or (not active-only?) (contains? active-ids (:id ann))) + (includes-term? haystack term)))) + +(defn filter-annotations [anns filters] + (filterv #(annotation-matches? filters %) anns)) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 2f7c64c..07ade0e 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -455,7 +455,8 @@ :drawing g ; pure strokes + seed, JSON round-trips as-is (-> g (update :marks #(mapv restore-mark (or % []))) - (update :notes #(when % (mapv keyword %))) ; annotation-level bindings + (cond-> (:notes g) + (update :notes #(mapv keyword %))) ; annotation-level bindings migrate))]))) anns)) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 4e798e2..c22ffe1 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -1,6 +1,7 @@ (ns tl.subs (:require [clojure.string :as str] [re-frame.core :as rf] + [tl.filter :as filter] [tl.scene :as scene])) (rf/reg-sub ::status (fn [db] (get-in db [:load :status]))) @@ -24,7 +25,9 @@ (rf/reg-sub ::script-jump (fn [db] (get-in db [:view :script-jump]))) (rf/reg-sub ::note-target (fn [db] (get-in db [:view :note-target]))) (rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{}))) -(rf/reg-sub ::hidden-tags (fn [db] (get-in db [:view :hidden-tags] #{}))) +(rf/reg-sub ::annotation-filter + (fn [db] (merge {:query "" :tags #{} :active-only? false} + (get-in db [:view :annotation-filter])))) (rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus]))) (rf/reg-sub ::linking (fn [db] (get-in db [:view :linking]))) (rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann]))) @@ -105,11 +108,16 @@ (fn [[scene stack] _] (mapv (fn [gid] {:id gid :name (or (get-in scene [:groups gid :name]) (name gid))}) stack))) +;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the +;; next bar only (no double-highlight, no drawing bleeding onto the next clip). +(defn- in-bars? [bars ph] + (some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars)) + ;; child annotations of the current context, with their bars in local coords (rf/reg-sub - ::annotations - :<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed] - (fn [[scene ctx segs hidden-tags revealed] _] + ::all-annotations + :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] + (fn [[scene ctx segs revealed] _] (let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g))) (:groups scene))) ;; shown when every ancestor up to ctx is revealed: a direct child of ctx @@ -119,16 +127,30 @@ (and (revealed p) (shown? (get-in scene [:groups p :parent])))))] (->> (:groups scene) (keep (fn [[gid 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)))))) + (when (and (= :annotation (:type g)) (shown? (:parent g))) (let [bars (scene/lane-bars scene ctx gid segs) ; one bar per mark; distinct marks never fuse reason (scene/broken-reason scene gid) oor (boolean (scene/clip-loss? scene gid)) - hidden (get-in g [:meta :hidden])] + hidden (get-in g [:meta :hidden]) + note-ids (->> (concat (:notes g) (mapcat :notes (:marks g))) + distinct + (filterv #(= :script-note (get-in scene [:groups % :type])))) + note-text (mapcat (fn [ng] + (let [n (get-in scene [:groups ng])] + (cons (:name n) + (mapcat (juxt :text :content) (:regions n))))) + note-ids) + jumps (scene/jump-targets scene ctx gid) + clips (->> (:marks g) + (mapcat (fn [m] [(get-in m [:start :ref]) + (get-in m [:end :ref])])) + (concat (map :seg jumps)) + (keep (fn [ref] + (let [cg (get-in scene [:groups ref])] + (or (:name cg) + (get-in cg [:media :name]) + (some-> ref name))))) + distinct)] {:id gid :parent (:parent g) :name (:name g) :color (or (:color g) "#4e8fc2") :content (:content g) :children (count (:marks g)) @@ -136,19 +158,33 @@ :draft (boolean (:draft g)) ;; every script-note bound anywhere in this annotation ;; (annotation-level + per-mark), deduped, still-existing only - :notes (->> (concat (:notes g) (mapcat :notes (:marks g))) - distinct - (filterv #(= :script-note (get-in scene [:groups % :type])))) + :notes note-ids + :script (vec (remove nil? note-text)) + :clips (vec clips) :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 ;; the editor) — not re-derived from a floored bar frame - :jumps (scene/jump-targets scene ctx gid) + :jumps jumps :start (or (ffirst bars) 0) :bars bars})))) (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom vec)))) +(rf/reg-sub + ::active-annotations-unfiltered + :<- [::all-annotations] :<- [::playhead] + (fn [[anns ph] _] + (into #{} (keep (fn [a] (when (in-bars? (:bars a) ph) + (:id a))) + anns)))) + +(rf/reg-sub + ::annotations + :<- [::all-annotations] :<- [::annotation-filter] :<- [::active-annotations-unfiltered] + (fn [[anns filters active] _] + (filter/filter-annotations anns (assoc filters :active-ids active)))) + ;; every distinct tag used by any annotation in the project — feeds both the tag ;; adder's autocomplete and the timeline tag filter. (rf/reg-sub @@ -161,11 +197,6 @@ (sort-by str/lower-case) vec))) -;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the -;; next bar only (no double-highlight, no drawing bleeding onto the next clip). -(defn- in-bars? [bars ph] - (some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars)) - ;; the annotation the playhead is currently inside (or the latest one passed) — ;; drives the rolling highlight/scroll in the commentary (rf/reg-sub diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 2cad17e..871d8b7 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -1679,24 +1679,40 @@ ;; "Untagged" is just another item that maps to the :untagged sentinel. (def ^:private untagged-label "Untagged") -(defn- tag-filter [] +(defn- annotation-filter [] (r/with-let [open? (r/atom false)] - (let [tags @(rf/subscribe [::subs/project-tags]) - hidden @(rf/subscribe [::subs/hidden-tags]) + (let [project-tags @(rf/subscribe [::subs/project-tags]) + {:keys [query tags active-only?]} @(rf/subscribe [::subs/annotation-filter]) + chosen (set tags) key-of #(if (= % untagged-label) :untagged %)] - (when (seq tags) - [:span.tag-filter - [:button.filter-btn {:class (when (seq hidden) "active") :title "Show / hide annotations by tag" - :on-click #(swap! open? not)} - "▽ Tags" (when (seq hidden) (str " (" (count hidden) ")"))] - (when @open? - [:<> - [:div.menu-backdrop {:on-click #(reset! open? false)}] - [:div.filter-pop - [autocomplete {:items (into [untagged-label] tags) - :placeholder "filter tags…" :clear-on-choose? false :auto-focus? true - :on-choose #(rf/dispatch [::events/toggle-tag-filter (key-of %)]) - :item-suffix (fn [t] [:span.tag-eye (if (contains? hidden (key-of t)) "🙈" "👁")])}]]])])))) + [:div.annotation-filter + [:input.annotation-search {:type "search" + :placeholder "Search all, or prefix timeline:, script:, clip:, tag:" + :value query + :on-change #(rf/dispatch [::events/set-annotation-search + (.. % -target -value)])}] + [:button.filter-btn {:class (when active-only? "active") + :title "Only show annotations active at the playhead" + :on-click #(rf/dispatch [::events/toggle-active-annotations-filter])} + "Active"] + (when (seq project-tags) + [:span.tag-filter + [:button.filter-btn {:class (when (seq chosen) "active") + :title "Filter annotations by tag" + :on-click #(swap! open? not)} + "Tags" (when (seq chosen) (str " (" (count chosen) ")"))] + (when @open? + [:<> + [:div.menu-backdrop {:on-click #(reset! open? false)}] + [:div.filter-pop + [autocomplete {:items (into [untagged-label] project-tags) + :placeholder "include tags…" :clear-on-choose? false :auto-focus? true + :on-choose #(rf/dispatch [::events/toggle-annotation-tag-filter (key-of %)]) + :item-suffix (fn [t] [:span.tag-eye (if (contains? chosen (key-of t)) "✓" "")])}]]])]) + (when (or (seq query) (seq chosen) active-only?) + [:button.filter-btn.clear {:title "Clear filters" + :on-click #(rf/dispatch [::events/clear-annotation-filter])} + "Clear"])]))) (defn toolbar [] ;; NB: subscribe the coarse ::at-start?/::at-end? edges, not the raw playhead — @@ -1727,7 +1743,6 @@ [:label.slider {:title "Vertical zoom"} "↕" [:input {:type "range" :min 8 :max 120 :value row-h :on-change #(rf/dispatch [::events/set-row-h (js/parseFloat (.. % -target -value))])}]] - [tag-filter] [dark-toggle]])) (defn- drag-top! @@ -2071,6 +2086,7 @@ ::events/set-pane) :annotations])} "Annotations"] [:button {:class (when (= pane :script) "active") :on-click #(rf/dispatch [::events/set-pane :script])} "Script"]] + (when (= pane :annotations) [annotation-filter]) [:div.pane-body (if (= pane :script) [script-pane] diff --git a/tl/test/tl/filter_test.cljs b/tl/test/tl/filter_test.cljs new file mode 100644 index 0000000..ce81837 --- /dev/null +++ b/tl/test/tl/filter_test.cljs @@ -0,0 +1,55 @@ +(ns tl.filter-test + (:require [cljs.test :refer-macros [deftest is testing]] + [tl.filter :as f])) + +(def anns + [{:id :a + :name "Kitchen argument" + :content "A tense exchange at breakfast" + :tags ["beat" "performance"] + :script ["INT. KITCHEN - MORNING" "I can't keep doing this."] + :clips ["kitchen_wide.mov" "closeup_alex.mov"]} + {:id :b + :name "Street pickup" + :content "Car arrives outside" + :tags ["blocking"] + :script ["EXT. STREET - NIGHT"] + :clips ["street_driving.mov"]} + {:id :c + :name "Untitled reaction" + :content "Silent look" + :tags [] + :script [] + :clips ["reaction_insert.mov"]}]) + +(deftest tag-filters-include-matches + (testing "no tag selection leaves the list unconstrained" + (is (= [:a :b :c] (mapv :id (f/filter-annotations anns {:tags #{}}))))) + (testing "selecting a tag includes matching annotations instead of hiding them" + (is (= [:a] (mapv :id (f/filter-annotations anns {:tags #{"beat"}}))))) + (testing "multiple selected tags are an OR" + (is (= [:a :b] (mapv :id (f/filter-annotations anns {:tags #{"beat" "blocking"}}))))) + (testing "untagged is an explicit include bucket" + (is (= [:c] (mapv :id (f/filter-annotations anns {:tags #{:untagged}})))))) + +(deftest active-only-intersects-other-filters + (testing "active-only shows only currently active annotations" + (is (= [:b] (mapv :id (f/filter-annotations anns {:active-only? true + :active-ids #{:b :z}}))))) + (testing "active-only intersects with selected tags" + (is (= [] (mapv :id (f/filter-annotations anns {:tags #{"beat"} + :active-only? true + :active-ids #{:b}})))))) + +(deftest search-scopes + (testing "plain text searches title/content/tags/script/clips" + (is (= [:a] (mapv :id (f/filter-annotations anns {:query "breakfast"})))) + (is (= [:b] (mapv :id (f/filter-annotations anns {:query "street_driving"})))) + (is (= [:a] (mapv :id (f/filter-annotations anns {:query "can't keep"}))))) + (testing "prefixes are case-insensitive and restrict the search field" + (is (= [:a] (mapv :id (f/filter-annotations anns {:query "Timeline: kitchen"})))) + (is (= [:a] (mapv :id (f/filter-annotations anns {:query "script: kitchen"})))) + (is (= [:a] (mapv :id (f/filter-annotations anns {:query "clip: kitchen"})))) + (is (= [] (mapv :id (f/filter-annotations anns {:query "script: closeup"})))) + (is (= [:a] (mapv :id (f/filter-annotations anns {:query "clip: closeup"})))) + (is (= [:b] (mapv :id (f/filter-annotations anns {:query "tag: block"})))))) diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index ccde702..36c2359 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -373,9 +373,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 1 :type :annotation :parent :root :name "p" :color "#abc" :content "hi" + (let [anns {:ann-p {:v s/schema-version :type :annotation :parent :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 1 :type :annotation :parent :ann-p :name "c" + :ann-c {:v s/schema-version :type :annotation :parent :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)))))))