Scope inspector controls and key shape colors

frontend/src/arthur/domain/node.cljs

@@ -99,15 +99,30 @@
                     (or (:dense c) (:generated c)))
                  [:pos :rot :scale])))
 
+(defn hold-only?
+  "Channels whose values are choices, not quantities.  Their keys may change at
+  a frame boundary but there is no meaningful value between two keys."
+  [path value]
+  (or (= path [:style :color])
+      (boolean? value)
+      (and (keyword? value) (not= path [:palette]))))
+
+(defn- enforce-hold [path c]
+  (if (and (= path [:style :color]) (:keys c))
+    (-> c (assoc :interp :hold) (dissoc :segments))
+    c))
+
 (defn set-channel
   "Write `v` into channel `path`: a key on the node's own frame `f` when the
   channel is keyed, its one value when it is not."
   [n path f v]
   (let [c (get (channels n) path)]
     (assoc-in n [:channels path]
-              (if (:keys c)
+              (enforce-hold
-                (assoc-in c [:keys f] v)
+               path
-                (merge (select-keys c [:semantic]) (ch/framed v))))))
+               (if (:keys c)
+                 (assoc-in c [:keys f] v)
+                 (merge (select-keys c [:semantic]) (ch/framed v)))))))
 
 (defn set-keyed-channel
   "Write `v` as a key at `f`, starting an animated channel when needed. This is
@@ -116,10 +131,12 @@
   [n path f v]
   (let [c (get (channels n) path)]
     (assoc-in n [:channels path]
-              (if (:keys c)
+              (enforce-hold
-                (assoc-in c [:keys f] v)
+               path
-                (merge (select-keys c [:semantic])
+               (if (:keys c)
-                       (ch/keyed {f v} (if (or (boolean? v) (keyword? v)) :hold :linear)))))))
+                 (assoc-in c [:keys f] v)
+                 (merge (select-keys c [:semantic])
+                        (ch/keyed {f v} (if (hold-only? path v) :hold :linear))))))))
 
 (defn toggle-key
   "Key channel `path` on the node's own frame `f` with the value it has there, or
@@ -127,19 +144,22 @@
   the last one off leaves it that one value. A boolean holds; anything else tweens.
 
   `store` because the value it keys is read out of the channel, and a measured
-  channel's values live in tier 2."
+  channel's values live in tier 2.  Colour is always held even though current
+  documents store palette choices as numeric slot indices."
   [n path f store]
   (let [c  (get (channels n) path)
         v  (ch/value-at c f store)
         ks (dissoc (:keys c) f)]
     (assoc-in n [:channels path]
-              (cond
+              (enforce-hold
-                (not (:keys c))               (merge (select-keys c [:semantic])
+               path
-                                                      (ch/keyed {f v} (if (or (boolean? v) (keyword? v)) :hold :linear)))
+               (cond
-                (not (contains? (:keys c) f)) (assoc-in c [:keys f] v)
+                 (not (:keys c))               (merge (select-keys c [:semantic])
-                (seq ks)                      (cond-> (assoc c :keys ks)
+                                                       (ch/keyed {f v} (if (hold-only? path v) :hold :linear)))
-                                                (:segments c) (update :segments dissoc f))
+                 (not (contains? (:keys c) f)) (assoc-in c [:keys f] v)
-                :else                         (ch/framed v)))))
+                 (seq ks)                      (cond-> (assoc c :keys ks)
+                                                 (:segments c) (update :segments dissoc f))
+                 :else                         (ch/framed v))))))
 
 (defn set-segment-interp
   "Choose how channel `path`'s key at `left` leads to the next one: `:hold` cuts
@@ -147,7 +167,9 @@
   only a gap that exists, between a key and a later one, can be chosen."
   [n path left interp]
   (let [ks (:keys (get (channels n) path))]
-    (if (and (contains? ks left) (some #(< left %) (keys ks)) (#{:hold :linear} interp))
+    (if (and (contains? ks left) (some #(< left %) (keys ks))
+             (#{:hold :linear} interp)
+             (or (= :hold interp) (not (hold-only? path nil))))
       (assoc-in n [:channels path :segments left] interp)
       n)))
 

frontend/src/arthur/events/footage.cljs

@@ -395,7 +395,10 @@
 
 (rf/reg-event-db
  ::choose
- (fn [db [_ id]] (assoc-in db [:footage :chosen] id)))
+ (fn [db [_ id]]
+   (-> db
+       (assoc-in [:footage :chosen] id)
+       (ui/selected [:footage id]))))
 
 ;; ---------------------------------------------------------------------------
 ;; renaming an asset

frontend/src/arthur/ui/params.cljs

@@ -2,10 +2,9 @@
   "The right pane: what the selection is, and what can be changed about it.
 
   Sections rather than a mode switch. The clip's facts are always true, so the
-  clip section is always there; the node and symbol sections appear when
+  clip section is always there; node, footage, face and tracking sections follow
-  something of that kind is selected; the tracking section appears when the clip
+  the thing actually selected. Nothing here computes — every control dispatches
-  has analysis in it. Nothing here computes — every control dispatches an intent
+  an intent and every readout comes off a subscription."
-  and every readout comes off a subscription."
   (:require [clojure.string :as str]
             [arthur.domain.clip :as clip-domain]
             [arthur.domain.channel :as channel]
@@ -208,12 +207,42 @@
                                         v)))
      (when gap? [segment-select sid id path ch left])]))
 
+(defn- color-control [sid id ch frame auto-key? palette]
+  (let [keyed? (some? (:keys ch))
+        value  (channel/value-at ch (or frame 0) nil)
+        value  (if (integer? value)
+                 value
+                 (or (first (keep-indexed #(when (= value (:name %2)) %1)
+                                           (:slots palette))) 0))
+        off?   (and keyed? (nil? frame))]
+    [:dd.channel {:class (when auto-key? "live")}
+     [:button.key {:class (cond (contains? (:keys ch) frame) "on" keyed? "keyed")
+                   :disabled (nil? frame)
+                   :title (if keyed? (str (count (:keys ch)) " held keys") "key color here")
+                   :on-click #(rf/dispatch [::project/toggle-key sid id [:style :color] frame])}
+      "◆"]
+     [:div.channel-swatches
+      (doall
+       (for [[i {:keys [name hex]}] (map-indexed vector (:slots palette))]
+         ^{:key i}
+         [:button.swatch
+          {:class (when (= i value) "on")
+           :style {:background hex}
+           :disabled off?
+           :aria-label (str "color " i (when name (str " " (clojure.core/name name))))
+           :aria-pressed (= i value)
+           :title (str i (when name (str " · " (clojure.core/name name))) " · " hex)
+           :on-click #(rf/dispatch [::project/set-channel sid id [:style :color] frame i])}]))]
+     (when keyed? [:span.dim "hold"])]))
+
 (defn- node-section [[sid id n]]
   (let [[start end] (:span n)
         auto-key? @(rf/subscribe [::sub/auto-key?])
         clip @(rf/subscribe [::render/clip])
         local @(rf/subscribe [::sub/selected-local])
-        frame (:frame local)]
+        frame (:frame local)
+        palette-id (or (get-in clip [:symbols sid :palette]) (pal/default-palette-id clip))
+        palette (get (pal/palettes clip) palette-id)]
     [section (str (name (:kind n)) " · in " (name sid))
      [facts
       "id"   (brief id)
@@ -232,13 +261,24 @@
      (let [{:keys [frame]} local]
        [:dl.facts
         (doall
-         (for [[path ch] (sort-by (comp str key) (node/channels n))]
+         (for [[path ch] (sort-by (fn [[path]]
+                                    [(cond
+                                       (= :xform (first path)) 0
+                                       (= path [:style :color]) 1
+                                       :else 2)
+                                     (str path)])
+                                  (node/channels n))]
            ^{:key (str path)}
            [:<>
             [:dt (str/join " " (map name path))]
-            (if (and (contains? (node/defaults-of n) path) (not (:dense ch)))
+            (cond
+              (and (= path [:style :color]) (not (:dense ch)))
+              [color-control sid id ch frame auto-key? palette]
+
+              (and (contains? (node/defaults-of n) path) (not (:dense ch)))
               [channel-control sid id path ch frame auto-key?]
-              [:dd (channel-state ch)])]))])]))
+
+              :else [:dd (channel-state ch)])]))])]))
 
 (defn- palette-placement-section [[sid id n]]
   (let [clip @(rf/subscribe [::render/clip])
@@ -431,19 +471,16 @@
 ;; the footage showing under the picture
 
 (defn- footage-section
-  "The footage under the faces the open symbol has, on or off and how strongly.
+  "The footage under the explicitly selected face or footage asset, on or off
-  `here` is those faces.
+  and how strongly. `here` is exactly those faces.
 
   ONE SWITCH FOR THE FACES THAT ARE HERE. A face's footage is the face's, not a
   placement's, so there is nothing to inherit and nothing to set twice; with
   several faces in a take the box says how many are showing and switches the rest
   on, and one face alone is switched from its own timeline row.
 
-  THE OPEN SYMBOL'S FACES AND NOT THE SELECTION'S, which is what lets this live in
+  This is editor state, but the inspector still obeys selection scope: selecting
-  the inspector at all: a viewing aid that appeared only once the right row had
+  an unrelated shape must neither expose nor mutate a face's viewing aid."
-  been found would make the way to see the footage you are tracing depend on what
-  you had clicked. So the section is there whenever the picture on the stage has
-  any footage behind it, wherever the selection happens to be."
   [here]
   (let [{:keys [faces opacity]} @(rf/subscribe [::render/tracing])
         on (filterv (set faces) here)]
@@ -657,13 +694,45 @@
              (max 1 (* 2 default)))
    :step (cond even? 2 (= type :integer) 1 :else 0.01)})
 
-(defn- tracking-section []
+(defn- subject-of-owner [clip [scope id]]
+  (case scope
+    :subject id
+    :feature (get-in clip [:features id :subject])
+    :group   (get-in clip [:groups id :subject])
+    nil))
+
+(defn- face-selection
+  "The one face explicitly named by a face symbol, its placement, or a tracking
+  owner.  A shape merely living inside an open face is deliberately not one."
+  [clip selection selected-node]
+  (let [[kind id] selection
+        placed (node/source (peek selected-node))
+        candidate (cond
+                    (= :symbol kind) id
+                    (#{:subject :feature :group} kind) (subject-of-owner clip selection)
+                    (= :node kind) placed)]
+    (when (and candidate (trace/traceable? clip candidate)) candidate)))
+
+(defn- footage-faces [clip selection selected-node]
+  (if (= :footage (first selection))
+    (let [footage-id (second selection)]
+      (into [] (comp (filter #(= footage-id (:footage (val %)))) (map key))
+            (:subjects clip)))
+    (some-> (face-selection clip selection selected-node) vector)))
+
+(defn- tracking-owners [clip selection selected-node]
+  (let [faces (if (= :footage (first selection))
+                (set (footage-faces clip selection selected-node))
+                (some-> (face-selection clip selection selected-node) hash-set))]
+    (when (seq faces)
+      (filterv #(contains? faces (subject-of-owner clip %)) (owners clip)))))
+
+(defn- tracking-section [all]
   (let [clip      @(rf/subscribe [::render/clip])
         selection @(rf/subscribe [::sub/selection])
         knobs     @(rf/subscribe [::sub/knobs])
         busy?     (:busy? @(rf/subscribe [::playback/project]))
         report    @(rf/subscribe [::project/regeneration])
-        all       (owners clip)
         [scope id :as owner] (if (some #{selection} all) selection (first all))
         area (case scope
                :subject :subject
@@ -727,7 +796,6 @@
         open      @(rf/subscribe [::render/open])
         selection @(rf/subscribe [::sub/selection])
         node      @(rf/subscribe [::sub/selected-node])
-        tracked?  (seq (owners clip))
         ;; The face the tracing section is about: the SELECTED PLACEMENT's symbol,
         ;; or, when the selection is not an instance or there is none, the OPEN
         ;; symbol — which is the face itself when a face is open to be drawn over.
@@ -737,6 +805,8 @@
         ;; lane traces is not a question with one answer, and naming the drawing
         ;; showing now would move the section under the playhead.
         placed    (node/source (peek node))
+        footage-faces (footage-faces clip selection node)
+        tracking-owners (tracking-owners clip selection node)
         palette-placement? (and node
                                 (= :palette-track
                                    (get-in clip [:symbols (first node) :type])))
@@ -744,10 +814,6 @@
                              (= :palette (get-in clip [:symbols (second selection) :type])))
         face      (or placed (when (trace/traceable? clip open) open))
         faces     (when face (trace/faces clip face))
-        ;; Every face the open symbol has, which is what the footage switch is
-        ;; about: the stage either has footage behind it or it has none, and that
-        ;; does not depend on what is selected.
-        here      (trace/traceable-faces clip open)
         ;; Where that face sits, as a row path from the open symbol, so the faces
         ;; inside it can be selected by their own rows. A selection made on the
         ;; stage has no path and names a node directly in the open symbol; the
@@ -763,12 +829,13 @@
       (when (and placed (not palette-placement?)) [symbol-section placed "source symbol"])
       (when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))}
         [correction-section node])
-      (when (and (not palette-placement?) (seq here)) [footage-section here])
+      (when (and (not palette-placement?) (seq footage-faces))
+        [footage-section footage-faces])
       (when (and face (or (trace/traceable? clip face) (seq faces)))
         [tracing-section face faces path])
       (when face ^{:key (str "perf/" face)} [performance-section face])
       (when palette-symbol? [palette-symbol-section (second selection)])
       (when (and (= :symbol (first selection)) (not palette-symbol?))
         [symbol-section (second selection)])
-      (when (and tracked? (not palette-placement?) (not palette-symbol?))
+      (when (and (seq tracking-owners) (not palette-placement?) (not palette-symbol?))
-        [tracking-section])]]))
+        [tracking-section tracking-owners])]]))

frontend/test/arthur/domain/node_test.cljs

@@ -226,3 +226,20 @@
     (is (= :linear (get-in moved [:channels [:xform :rot] :interp])))
     (is (= :hold (get-in visible [:channels [:vis] :interp]))
         "boolean parameters do not tween")))
+
+(deftest colour-keys-are-discrete
+  (let [n {:id :x :kind :poly
+           :channels {[:style :color] (ch/framed 2)}}
+        keyed (node/set-keyed-channel n [:style :color] 3 4)
+        two (node/set-keyed-channel keyed [:style :color] 8 7)]
+    (is (= :hold (get-in two [:channels [:style :color] :interp]))
+        "numeric palette slots still hold")
+    (is (= two (node/set-segment-interp two [:style :color] 3 :linear))
+        "a caller cannot introduce a colour tween")
+    (is (= :hold (get-in (node/set-channel
+                           (assoc-in two [:channels [:style :color] :interp] :linear)
+                           [:style :color] 8 6)
+                         [:channels [:style :color] :interp]))
+        "editing repairs an older tweened colour channel")
+    (is (= :hold (get-in (node/toggle-key n [:style :color] 3 nil)
+                         [:channels [:style :color] :interp])))))

static/arthur/app.css

@@ -1384,6 +1384,14 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 .facts dd.channel .key { padding: 0 3px; color: var(--dim); }
 .facts dd.channel .key.keyed { color: var(--fg); }
 .facts dd.channel .key.on { color: var(--sel); }
+.facts dd.channel .channel-swatches {
+  display: flex;
+  flex: 1;
+  flex-wrap: wrap;
+  gap: 3px;
+  min-width: 0;
+}
+.facts dd.channel .channel-swatches .swatch { flex: 0 0 15px; }
 .facts dd.channel.live {
   margin: -2px;
   padding: 2px;