Add project palette assets and overrides

clips/tests/test_api.py

@@ -416,6 +416,19 @@ class DocumentTests(TestCase):
         self.assertEqual({str(self.project.id)}, {r["project"] for r in rows})
         self.assertEqual({"c1"}, {r["cid"] for r in rows})
 
+    def test_saved_palettes_are_listed_as_assets(self):
+        leaves = self.leaves()
+        leaves["clip/c1/palette/night"] = [
+            "^ ", "~:id", "~:night", "~:name", "Moonlit",
+            "~:slots", ["~#list", [["^ ", "~:hex", "#001122"]]],
+        ]
+        self.assertEqual(200, self.save(leaves).status_code)
+        rows = self.client.get("/api/symbols").json()["palettes"]
+        self.assertEqual(
+            [("Moonlit", "night", "c1")],
+            [(r["name"], r["palette"], r["cid"]) for r in rows],
+        )
+
     def test_a_document_comes_back_exactly(self):
         response = self.save()
         self.assertEqual(200, response.status_code, response.content)

clips/views.py

@@ -357,6 +357,7 @@ def footage_list(request):
 
 
 _SYMBOL_LEAF = re.compile(r"^clip/([^/]+)/symbol/([^/]+)$")
+_PALETTE_LEAF = re.compile(r"^clip/([^/]+)/palette/([^/]+)$")
 
 
 def _transit_fields(value, *keys):
@@ -391,7 +392,21 @@ def symbols(request):
             "frames": fields.get("frames"),
         })
     rows.sort(key=lambda r: (r["project_name"], r["project"], r["name"]))
-    return JsonResponse({"symbols": rows})
+    palettes = []
+    for leaf in Leaf.objects.filter(path__contains="/palette/").select_related("project"):
+        m = _PALETTE_LEAF.match(leaf.path)
+        if not m:
+            continue
+        fields = _transit_fields(leaf.value, "name")
+        palettes.append({
+            "project": str(leaf.project_id),
+            "project_name": leaf.project.name,
+            "cid": m.group(1),
+            "palette": m.group(2),
+            "name": fields.get("name") or m.group(2).replace("~", "/"),
+        })
+    palettes.sort(key=lambda r: (r["project_name"], r["project"], r["name"]))
+    return JsonResponse({"symbols": rows, "palettes": palettes})
 
 
 @require_http_methods(["GET", "PATCH"])

frontend/src/arthur/db.cljs

@@ -82,7 +82,7 @@
    ;; Every symbol in every saved project, for the pool's all-assets folder. Rows
    ;; from `/api/symbols`, nothing loaded: a symbol from elsewhere is fetched when
    ;; it is dropped.
-   :assets {:symbols [] :loading? false}
+   :assets {:symbols [] :palettes [] :loading? false}
 
    ;; The document's own identity on the server. `:seq` is the monotonic project
    ;; version: a client that sees a delta with `seq > local + 1` refetches, which
@@ -159,7 +159,8 @@
    :ui {:open      nil
         :tabs      []
         :selection nil
-        :tone      :skin-base
+        :selections []
+        :tone      1
         :tool      nil
         :auto-key? false
         :draft     []

frontend/src/arthur/domain/clip.cljs

@@ -51,7 +51,8 @@
   that loses something on every round trip, which is the one bug a persistence
   layer must not be able to have. Add the field here and to `leaf/leaves` and
   `leaf/clip` in the same commit."
-  #{:name :fps :analysis :subjects :features :groups :width :height :symbols})
+  #{:name :fps :analysis :subjects :features :groups :width :height :symbols
+    :palettes :default-palette})
 
 (defn symbol
   "One of the clip's symbols, by id."
@@ -213,6 +214,8 @@
   {:name "untitled"
    :fps 30
    :width 320 :height 200
+   :palettes {pal/default-id pal/default-palette}
+   :default-palette pal/default-id
    ;; No native fps yet: an untouched canvas follows the project grid. Imported
    ;; and generated symbols carry their own rate explicitly.
    :symbols {:main {:id :main :frames blank-frames :nodes {}}}})
@@ -245,15 +248,27 @@
   Every instance owns its cursors and buffers. The IResolver queries return
   native node frames and world matrices for the last rendered output frame."
   [clip sid store palette opts]
-   (letfn [(build [sid chain pose-tracks]
+   (let [context? (and (map? palette) (:palettes palette) (:offsets palette))]
+    (letfn [(selection-at [owner frame inherited]
+              (let [selection (:palette owner)
+                    chosen (cond
+                             (nil? selection) nil
+                             (and (map? selection) (contains? selection :animated?))
+                             (ch/value-at selection frame store)
+                             :else selection)]
+                (or chosen inherited (:default palette))))
+            (build [sid chain pose-tracks]
              (when (some #{sid} chain)
                (throw (ex-info "symbol cycle" {:chain (conj chain sid)})))
              (let [sym (or (symbol clip sid)
                            (throw (ex-info "an instance names a missing symbol" {:symbol sid})))
+                   active (volatile! (when context? (:default palette)))
                    nodes (:nodes sym)
                    rank (symbol/draw-rank nodes (symbol/order nodes))
                    ids (sort-by rank (keys nodes))
-                   own (symbol/resolver sym store palette
+                   own (symbol/resolver sym store (if context?
+                                                    #(pal/render-index palette @active %)
+                                                    palette)
                                         (assoc opts :pose-tracks pose-tracks))
                    ;; Each cel owns its source resolver and mutable buffers.
                    children (into {}
@@ -268,7 +283,10 @@
                    ;; there used to be. Their resolvers still hold the frame
                    ;; before whenever they were not on.
                    entered (volatile! {})
-                   step (fn [f pre]
+                   step (fn [f pre inherited forced]
+                          (when context?
+                            (vreset! active (or forced
+                                                (selection-at sym (js/Math.floor f) inherited))))
                           (vreset! entered {})
                           (let [by-id (into {} (map (juxt :node identity))
                                             (own (js/Math.floor f) (js/Math.floor pre)))]
@@ -301,14 +319,18 @@
                                                        ;; previous frame, and so no gap.
                                                        (or (:frame (when (number? prior)
                                                                      (placed-frame clip sid n prior)))
-                                                           (dec frame)))))
+                                                           (dec frame))
+                                                       @active
+                                                       (when (and context? (:palette n))
+                                                         (selection-at n frame nil)))))
                                              []))
                                          (when-let [op (get by-id id)] [op]))))
                                    ids))))]
                (reify
                  IFn
-                 (-invoke [_ f] (step f (dec f)))
+                 (-invoke [_ f] (step f (dec f) nil nil))
-                 (-invoke [_ f pre] (step f pre))
+                 (-invoke [_ f pre] (step f pre nil nil))
+                 (-invoke [_ f pre inherited forced] (step f pre inherited forced))
                  symbol/IResolver
                  (world-of [_ [id & more]]
                    (if more
@@ -345,11 +367,13 @@
               ;; the WHOLE PICTURE reading 13 instead of 15 — a head going two frames
               ;; stale, a 67ms hitch at 12fps, to fix one group's mouth. It is per
               ;; group, so it is seated where groups exist.
-              (if (pos? f) (cadence/frame (dec f) grid native) -1)))
+              (if (pos? f) (cadence/frame (dec f) grid native) -1)
+              (when context? (:default palette))
+              nil))
          symbol/IResolver
          (world-of [_ path] (symbol/world-of r path))
          (frame-of [_ path] (symbol/frame-of r path))
-         (pre-frame-of [_ path] (symbol/pre-frame-of r path))))))
+         (pre-frame-of [_ path] (symbol/pre-frame-of r path)))))))
 
 (defn center
   "The middle of everything symbol `sid` draws, over all its frames, in its own
@@ -499,6 +523,14 @@
       (str "clip has a field with no leaf to save it in: " (pr-str k)))
     (when-not (map? (:symbols clip))
       [":symbols must be a map of id -> symbol"])
+    (when (and (contains? clip :palettes) (not (map? (:palettes clip))))
+      [":palettes must be a map of id -> palette"])
+    (when (and (contains? clip :default-palette) (map? (:palettes clip))
+               (not (contains? (:palettes clip) (:default-palette clip))))
+      [":default-palette must name a project palette"])
+    (for [[id p] (:palettes clip)
+          :when (or (not= id (:id p)) (not (pal/valid-palette? p)))]
+      (str "palette " (pr-str id) " is invalid or has a different :id"))
     (when-not (or (nil? (:fps clip)) (and (number? (:fps clip)) (pos? (:fps clip))))
       [(str ":fps is " (pr-str (:fps clip)) " — a rate is a positive number")])
     (for [[id sym] (:symbols clip)

frontend/src/arthur/domain/leaf.cljs

@@ -10,6 +10,8 @@
       clip/<cid>/name                     a label
       clip/<cid>/timing                   fps
       clip/<cid>/stage                    width, height
+      clip/<cid>/palette/<pid>            a named indexed palette asset
+      clip/<cid>/palette-default          the project fallback palette id
       clip/<cid>/source                   the analysis record this came out of
       clip/<cid>/subject/<subj>           a tracked subject and its params
       clip/<cid>/feature/<fid>            one feature: area, nodes, params
@@ -134,11 +136,13 @@
            (some-leaf (at "name")   (select-keys clip [:name]))
            (some-leaf (at "timing") (select-keys clip [:fps]))
            (some-leaf (at "stage")  (select-keys clip [:width :height]))
+           (some-leaf (at "palette-default") (select-keys clip [:default-palette]))
            (some-leaf (at "source") (:analysis clip))
            (concat
             (for [[id v] (:subjects clip)] {(at "subject" (segment id)) v})
             (for [[id v] (:features clip)] {(at "feature" (segment id)) v})
             (for [[id v] (:groups clip)]   {(at "group" (segment id)) v})
+            (for [[id v] (:palettes clip)] {(at "palette" (segment id)) v})
             ;; The symbol's own facts. `:id` is the path segment, so writing it
             ;; into the value as well would be the one field a rename could
             ;; disagree with itself about; `clip` puts it back.
@@ -190,6 +194,8 @@
                "timing"   (merge acc v)
                "stage"    (merge acc v)
                "source"   (assoc acc :analysis v)
+               "palette-default" (merge acc v)
+               "palette"  (assoc-in acc [:palettes (unsegment a)] v)
                "subject"  (assoc-in acc [:subjects (unsegment a)] v)
                "feature"  (assoc-in acc [:features (unsegment a)] v)
                "group"    (assoc-in acc [:groups (unsegment a)] v)
@@ -230,8 +236,8 @@
                           false)
                         (case (count p)
                           ;; The clip's own facts carry no id.
-                          3 (#{"name" "timing" "stage" "source"} (nth p 2))
+                          3 (#{"name" "timing" "stage" "source" "palette-default"} (nth p 2))
-                          4 (#{"subject" "feature" "group"} (nth p 2))
+                          4 (#{"subject" "feature" "group" "palette"} (nth p 2))
                           false))))]
     (vec
      (concat

frontend/src/arthur/domain/palette.cljs

@@ -1,15 +1,12 @@
 (ns arthur.domain.palette
-  "The indexed palette.
+  "Project palette assets and their render-time index banks.
 
-  THE RULE, and it is a rule rather than a default: a part carries a palette
+  Drawing data stores a dumb LOCAL SLOT NUMBER. A symbol or instance supplies
-  INDEX, never a sampled RGB value. Sampling colour off the footage produces a
+  the palette context. `compile` gives project palettes disjoint ranges in the
-  pixel-art filter, and it does so irrecoverably — once a shape holds a measured
+  raster index space, so differently-paletted subtrees can coexist. The ranges
-  colour there is no way back to an authored one, because the information that it
+  are derived, never persisted: adding a palette never rewrites drawing data.")
-  was ever a choice is gone. Every `[:style :color]` channel holds one of the
-  keywords below.
 
-  Entries are ordered, and the order IS the index the raster writes. Inserting in
+(def default-id :arthur/default)
-  the middle renumbers every stored index, so new tones append.")
 
 (def entries
   [{:name :bg         :hex "#12141c"}
@@ -48,3 +45,68 @@
 (def rgb
   "Index -> [r g b], precomputed."
   (mapv hex->rgb hexes))
+
+(def default-palette
+  {:id default-id :name "Arthur"
+   :slots (into entries (repeat 7 {:hex "#000000"}))})
+
+(defn palettes [clip]
+  (if (seq (:palettes clip)) (:palettes clip) {default-id default-palette}))
+
+(defn default-palette-id [clip]
+  (let [ps (palettes clip)]
+    (or (:default-palette clip)
+        (when (contains? ps default-id) default-id)
+        (first (sort-by str (keys ps))))))
+
+(defn- slot-index [p value]
+  (cond
+    (and (integer? value) (<= 0 value) (< value (count (:slots p)))) value
+    ;; Compatibility for existing documents. New drawing data is numeric.
+    (keyword? value) (first (keep-indexed #(when (= value (:name %2)) %1) (:slots p)))
+    :else nil))
+
+(defn compile
+  "Compile the project's palette assets into the one ramp used by the raster.
+  Index 255 remains the conspicuous bad-data sentinel."
+  [clip]
+  (let [selection-values (fn [x]
+                           (cond
+                             (nil? x) []
+                             (and (map? x) (:keys x)) (vals (:keys x))
+                             (and (map? x) (contains? x :value)) [(:value x)]
+                             :else [x]))
+        used    (into #{(default-palette-id clip)}
+                      (mapcat selection-values)
+                      (concat (map :palette (vals (:symbols clip)))
+                              (for [sym (vals (:symbols clip))
+                                    n (vals (:nodes sym))]
+                                (:palette n))))
+        ps      (select-keys (palettes clip) used)
+        ordered (sort-by (comp str key) ps)
+        offsets (loop [xs ordered at 0 out {}]
+                  (if-let [[id p] (first xs)]
+                    (recur (next xs) (+ at (count (:slots p))) (assoc out id at))
+                    out))
+        total   (reduce + (map #(count (:slots (val %))) ordered))]
+    (when (> total 255)
+      (throw (ex-info "palettes visible in one render use more than 255 slots"
+                      {:slots total :palettes (count ps)})))
+    {:palettes ps
+     :default (default-palette-id clip)
+     :offsets offsets
+     :ramp (vec (mapcat (fn [[_ p]] (map #(hex->rgb (:hex %)) (:slots p))) ordered))
+     :bg (get offsets (default-palette-id clip) 0)}))
+
+(defn render-index
+  "A local slot (or a legacy tone keyword) in palette `id` -> raster index."
+  [{:keys [palettes offsets]} id value]
+  (let [p (get palettes id)
+        i (and p (slot-index p value))]
+    (if (some? i) (+ (get offsets id 0) i) 255)))
+
+(defn valid-palette? [{:keys [id name slots]}]
+  (and id (string? name) (seq name) (vector? slots) (pos? (count slots))
+       (<= (count slots) 255)
+       (every? #(and (string? (:hex %))
+                     (boolean (re-matches #"#[0-9a-fA-F]{6}" (:hex %)))) slots)))

frontend/src/arthur/domain/symbol.cljs

@@ -275,6 +275,7 @@
   be impossible to miss and should not take the frame down."
   [palette k]
   (cond
+    (fn? palette) (palette k)
     (number? k)  k
     (nil? k)     255
     :else        (get palette k 255)))

frontend/src/arthur/events/export.cljs

@@ -153,9 +153,8 @@
                 ;; The same palette and ramp the preview resolves and blits
                 ;; through. Read here rather than in the fx so that the effect
                 ;; takes data and nothing else.
-                :palette     (get {:arthur/default pal/index-of}
+                :palette     (pal/compile (:clip entry))
-                                  (:palette db) pal/index-of)
+                :ramp        (:ramp (pal/compile (:clip entry)))
-                :ramp        (get {:arthur/default pal/rgb} (:palette db) pal/rgb)
                 :zoom        zoom
                 :audio-url   (:audio entry)
                 :name        (stem (:label entry)

frontend/src/arthur/events/project.cljs

@@ -23,10 +23,12 @@
   fx, which is the only thing in this namespace that is not pure."
   (:require [arthur.db :as db]
             [arthur.domain.bring :as bring]
+            [arthur.domain.channel :as ch]
             [arthur.domain.clip :as clip]
             [arthur.domain.span :as span]
             [arthur.domain.leaf :as leaf]
             [arthur.domain.node :as node]
+            [arthur.domain.palette :as pal]
             [arthur.events.edit :as edit]
             [arthur.audio.mix :as mix]
             [arthur.demo.stage :as stage]
@@ -165,6 +167,34 @@
                      :host (get-in db [:ui :open]) :frame frame :point point
                      :target target)}))
 
+(rf/reg-event-fx
+ ::import-palette
+ (fn [{:keys [db]} [_ {:keys [project cid palette name]}]]
+   {:db (update db :project merge {:status (str "fetching " name "…")})
+    ::import-palette! {:project project :cid cid :palette palette}}))
+
+(rf/reg-fx
+ ::import-palette!
+ (fn [{:keys [project cid palette]}]
+   (-> (saved-clip! project cid)
+       (.then (fn [{other :clip}]
+                (let [source (leaf/unsegment palette)
+                      p (get-in other [:palettes source])]
+                  (if p
+                    (rf/dispatch [::palette-imported p])
+                    (rf/dispatch [::failed "that palette no longer exists"])))))
+       (.catch (fn [error]
+                 (rf/dispatch [::failed (or (ex-message error) (str error))]))))))
+
+(rf/reg-event-db
+ ::palette-imported
+ (fn [db [_ palette]]
+   (let [id (random-uuid)]
+     (-> (edit/edit db #(assoc-in % [:palettes id]
+                                  (assoc palette :id id :name (str (:name palette) " copy"))))
+         (assoc-in [:ui :palette] id)
+         (assoc-in [:project :status] (str "imported " (:name palette)))))))
+
 (rf/reg-event-fx
  ::imported
  ;; As drawing: its tracking stays with the analysis that measured it. See
@@ -296,7 +326,11 @@
                                       {:project (.-project r) :project-name (.-project_name r)
                                        :cid (.-cid r) :symbol (.-symbol r)
                                        :name (.-name r) :frames (.-frames r)})
-                                    (array-seq (.-symbols listed)))])))
+                                    (array-seq (.-symbols listed)))
+                              (mapv (fn [^js r]
+                                      {:project (.-project r) :project-name (.-project_name r)
+                                       :cid (.-cid r) :palette (.-palette r) :name (.-name r)})
+                                    (array-seq (.-palettes listed)))])))
        (.catch (fn [error]
                  (rf/dispatch [::failed (or (ex-message error) (str error))]))))))
 
@@ -308,7 +342,8 @@
 
 (rf/reg-event-db
  ::symbols-listed
- (fn [db [_ rows]] (assoc db :assets {:symbols rows :loading? false})))
+ (fn [db [_ rows palettes]]
+   (assoc db :assets {:symbols rows :palettes palettes :loading? false})))
 
 (rf/reg-sub ::assets (fn [db _] (:assets db)))
 
@@ -649,6 +684,70 @@
                     (update-in c [:symbols sid] dissoc key)
                     (assoc-in c [:symbols sid key] value)))))))
 
+(rf/reg-event-db
+ ::new-palette
+ (fn [db _]
+   (let [id (random-uuid)
+         p  {:id id :name "Untitled palette"
+             :slots (mapv #(select-keys % [:name :hex]) (:slots pal/default-palette))}]
+     (-> (edit/edit db #(assoc-in % [:palettes id] p))
+         (assoc-in [:ui :palette] id)))))
+
+(rf/reg-event-db
+ ::palette-name
+ (fn [db [_ id value]]
+   (let [value (str/trim (str value))]
+     (if (str/blank? value) db
+         (edit/edit db #(assoc-in % [:palettes id :name] value))))))
+
+(rf/reg-event-db
+ ::palette-color
+ (fn [db [_ id slot hex]]
+   (if-not (re-matches #"#[0-9a-fA-F]{6}" (str hex))
+     db
+     (edit/edit db #(assoc-in % [:palettes id :slots slot :hex] (str/lower-case hex))))))
+
+(rf/reg-event-db
+ ::default-palette
+ (fn [db [_ id]]
+   (edit/edit db #(if (get-in % [:palettes id]) (assoc % :default-palette id) %))))
+
+(rf/reg-event-db
+ ::symbol-palette
+ (fn [db [_ sid id frame]]
+   (edit/edit db #(if id
+                    (let [old (get-in % [:symbols sid :palette])]
+                      (assoc-in % [:symbols sid :palette]
+                                (if (:keys old)
+                                  (assoc-in old [:keys frame] id)
+                                  (ch/framed id))))
+                    (update-in % [:symbols sid] dissoc :palette)))))
+
+(rf/reg-event-db
+ ::key-symbol-palette
+ (fn [db [_ sid frame id]]
+   (edit/edit db
+              (fn [c]
+                (let [old (get-in c [:symbols sid :palette])
+                      base (or (when old (ch/value-at old frame nil))
+                               (pal/default-palette-id c))
+                      keyed (if (:keys old) old (ch/keyed {0 base} :hold))]
+                  (assoc-in c [:symbols sid :palette]
+                            (assoc-in keyed [:keys frame] id)))))))
+
+(rf/reg-event-db
+ ::instance-palette
+ (fn [db [_ sid node-id frame id]]
+   (edit/edit db
+              (fn [c]
+                (if-not id
+                  (update-in c [:symbols sid :nodes node-id] dissoc :palette)
+                  (let [old (get-in c [:symbols sid :nodes node-id :palette])]
+                    (assoc-in c [:symbols sid :nodes node-id :palette]
+                              (if (:keys old)
+                                (assoc-in old [:keys frame] id)
+                                (ch/framed id)))))))))
+
 (rf/reg-event-db
  ::set-channel
  ;; `frame` is the node's own, as for a drawing key.

frontend/src/arthur/flow/freeze.cljs

@@ -38,6 +38,7 @@
             [arthur.domain.geom :as geom]
             [arthur.domain.node :as node]
             [arthur.domain.pick :as pick]
+            [arthur.domain.palette :as pal]
             [arthur.domain.ring :as ring]
             [arthur.domain.trace :as trace]
             [arthur.flow.address :as address]))
@@ -464,12 +465,12 @@
     {:nodes {:mouth
              {:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"
               :channels {[:geom :pts] (dense rings 0 (prov :roto/lips-outer))
-                         [:style :color] (ch/framed :skin-dark)}}
+                         [:style :color] (ch/framed 2)}}
              :mouth-in
              {:id :mouth-in :name "mouth interior" :kind :poly
               :parent :mouth :z "a2"
               :channels {[:geom :pts] (dense rings 1 (prov :roto/lips-inner))
-                         [:style :color] (ch/framed :mouth-dark)
+                         [:style :color] (ch/framed 3)
                          [:vis] (visibility params inputs
                                             {:by :roto/mouth-aperture
                                              :analysis (:id analysis)
@@ -523,13 +524,13 @@
                    {:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
                     :channels {[:geom :pts] (dense eye-block track
                                                   (provenance :roto/eyelid {:verts eye-verts}))
-                               [:style :color] (ch/framed :skin-dark)}})
+                               [:style :color] (ch/framed 2)}})
         inner-node (fn [id parent z track shut]
                      {:id id :name (clojure.core/name id) :kind :poly :parent parent :z z
                       :channels {[:geom :pts] (dense eye-block track
                                                     (provenance :roto/eye-opening
                                                                 {:verts eye-verts}))
-                                 [:style :color] (ch/framed :eye-white)
+                                 [:style :color] (ch/framed 5)
                                  [:vis] (keyed-visibility (mapv not shut)
                                                           (provenance :roto/blink nil))}})
         iris-node (fn [id parent track radius]
@@ -541,7 +542,7 @@
                                                       :generated
                                                       (provenance :roto/iris-size
                                                                   {:iris-size (:iris-size params)}))
-                                [:style :color] (ch/framed :iris)}})
+                                [:style :color] (ch/framed 6)}})
         pupil-node (fn [id parent]
                      {:id id :name (clojure.core/name id) :kind :rect :parent parent :z "a1"
                       :stencil parent
@@ -549,14 +550,14 @@
                                                     :generated
                                                     (provenance :roto/pupil-size
                                                                 {:pupil-size (:pupil-size params)}))
-                                 [:style :color] (ch/framed :pupil)}})
+                                 [:style :color] (ch/framed 7)}})
         brow-node (fn [id z track]
                     {:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
                      :channels {[:geom :pts] (dense brow-block track
                                                    (provenance :roto/brow {:verts brow-verts}))
                                 [:xform :pos] (dense brow-pos-block track
                                                       (provenance :roto/brow-raise nil))
-                                [:style :color] (ch/framed :brow)}})]
+                                [:style :color] (ch/framed 8)}})]
     {:nodes (merge
              (when eyes
                {:eye-r    (eye-node :eye-r "a2" 0)
@@ -604,7 +605,7 @@
               :parent :mouth-in :z "a1"
               :stencil :mouth-in
               :channels {[:geom :pts] (dense blk 0 generated)
-                         [:style :color] (ch/framed :teeth)
+                         [:style :color] (ch/framed 4)
                          [:vis] (keyed-visibility shown generated)}}}
      :store (stored blk)}))
 
@@ -763,6 +764,8 @@
         merged (fn [k] (into {} (mapcat (comp k second)) parts))
         built {:name name :fps fps :analysis (:analysis params)
                :width (first stage) :height (second stage)
+               :palettes {pal/default-id pal/default-palette}
+               :default-palette pal/default-id
                :subjects (into {} (map (fn [[id _]] [id {:id id :params {}}])) ordered)
                :features (merged :features) :groups (merged :groups)
                :symbols

frontend/src/arthur/subs/render.cljs

@@ -118,21 +118,13 @@
 
 (rf/reg-sub
  ::palette
- (fn [db _]
+ :<- [::clip]
-   ;; A NAME resolves to a ramp. One today; when timelines carry a `:palette`
+ (fn [clip _] (when clip (pal/compile clip))))
-   ;; channel this becomes the project's table and the walk carries the ramp in
-   ;; scope, which is why domain/symbol takes the palette as a parameter rather
-   ;; than reaching for a global.
-   (get {:arthur/default pal/index-of} (:palette db) pal/index-of)))
 
 (rf/reg-sub
  ::ramp
- (fn [db _]
+ :<- [::palette]
-   ;; index -> [r g b]. The other half of the palette: `::palette` says which
+ (fn [compiled _] (:ramp compiled)))
-   ;; INDEX a tone resolves to, this says what that index LOOKS LIKE. Two subs
-   ;; because two different consumers — evaluation needs the first, the blit
-   ;; needs the second, and neither wants the other's map.
-   (get {:arthur/default pal/rgb} (:palette db) pal/rgb)))
 
 (rf/reg-sub
  ::store

frontend/src/arthur/subs/ui.cljs

@@ -12,6 +12,17 @@
             [re-frame.core :as rf]))
 
 (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection])))
+(rf/reg-sub
+ ::selections
+ (fn [db _]
+   (let [primary (get-in db [:ui :selection])
+         many    (vec (get-in db [:ui :selections]))]
+     ;; Older structural commands replace `:selection` directly. Treat that as
+     ;; an intentional single selection unless it is still the primary member
+     ;; of the multi-selection.
+     (cond (nil? primary) []
+           (some #{primary} many) many
+           :else [primary]))))
 (rf/reg-sub ::target    (fn [db _] (get-in db [:ui :target])))
 (rf/reg-sub ::retry (fn [db _] (get-in db [:ui :retry])))
 (rf/reg-sub ::tone      (fn [db _] (get-in db [:ui :tone])))
@@ -100,6 +111,23 @@
        (when-let [pl (nest/placement clip st open (or path [id]) f)]
          (assoc pl :node n :bounds ((pick/bounds-of clip st (:sid pl) n) (:frame pl))))))))
 
+(rf/reg-sub
+ ::selected-placements
+ :<- [::selections]
+ :<- [::render/clip]
+ :<- [::render/clip-id]
+ :<- [::render/open]
+ :<- [::render/open-frame]
+ (fn [[selections clip clip-id open f] _]
+   (let [st (:store (store/entry clip-id))]
+     (into [] (keep (fn [[_ _ _ path :as selection]]
+              (when (and clip (= :node (first selection)) (seq path))
+                (when-let [{:keys [sid id] :as pl} (nest/placement clip st open path f)]
+                  (when-let [n (get-in clip [:symbols sid :nodes id])]
+                    (assoc pl :selection selection :path path :node n
+                           :bounds ((pick/bounds-of clip st sid n) (:frame pl))))))))
+           selections))))
+
 (rf/reg-sub
  ::settled-clip
  :<- [::render/clip-id]

frontend/src/arthur/ui/palette.cljs

@@ -2,52 +2,73 @@
   "The bar above the stage: the tone a new shape gets, and the tool that makes
   one.
 
-  SIXTEEN SLOTS, and the palette supplies nine of them. The count is the format's
+  Shapes store only the selected local slot number. Palette identity is supplied
-  and not the data's — an indexed 320x200 picture in the Animator Pro idiom this
+  by the symbol tree, and the colour input edits the project palette asset.
-  tool inherits has a fixed-size table, and a strip that grew and shrank as tones
-  were added would make the palette look like a list of colours rather than like
-  a table with room in it. So the empty slots are drawn, hatched, and refuse the
-  click.
-
-  Slot 0 is the background, which is why it is shown and not selectable: a
-  polygon filled with index 0 is invisible against a stage cleared to index 0, so
-  offering it as a fill is offering a shape that vanishes on creation.
 
   The footage switch is NOT here. It is a viewing aid rather than something you
   set before you draw, so it is a section of the inspector — one that is there
   for whatever the open symbol has faces of, so it still does not come and go
   with the selection. See `ui/params`."
   (:require [arthur.domain.palette :as pal]
+            [arthur.domain.node :as node]
             [arthur.events.ui :as ui]
+            [arthur.events.project :as project]
+            [arthur.subs.render :as render]
             [arthur.subs.ui :as sub]
             [arthur.ui.layout :as layout]
             [re-frame.core :as rf]))
 
-(def ^:const slots 16)
+(rf/reg-sub ::chosen (fn [db _] (get-in db [:ui :palette])))
 
-(defn- swatch [i tone]
+(defn- swatch [pid i {:keys [name hex]} tone placements]
-  (let [{slot-tone :name :keys [hex]} (get pal/entries i)
+  (let [picker-id (str "palette-picker-" pid "-" i)]
-        bg?  (zero? i)
+    [:div {:key i :class "palette-slot"}
-        pick (and slot-tone (not bg?))]
+     [:button {:class (str "swatch" (when (= i tone) " on"))
-    [:button
+               :style {:background hex}
-     {:key   i
+               :title (str i (when name (str " · " (clojure.core/name name)))
-      :class (str "swatch"
+                           " · " hex " · double-click to edit")
-                  (when-not slot-tone " empty")
+               :on-click #(do (rf/dispatch [::ui/set-tone i])
-                  (when bg? " bg")
+                              (let [edits (into [] (keep (fn [{:keys [sid id node frame]}]
-                  (when (and pick (= slot-tone tone)) " on"))
+                                                   (when (contains? (get node/valid-paths (:kind node))
-      :style (when hex {:background hex})
+                                                                    [:style :color])
-      :title (if slot-tone (str i " · " (name slot-tone) " " hex) (str i " · empty"))
+                                                     {:sid sid :id id :path [:style :color]
-      :disabled (not pick)
+                                                      :frame frame :value i})))
-      :on-click #(rf/dispatch [::ui/set-tone slot-tone])}]))
+                                                placements)]
+                                (when (seq edits)
+                                  (rf/dispatch [::project/set-channels edits]))))
+               :on-double-click (fn [e]
+                                  (.preventDefault e)
+                                  (some-> (js/document.getElementById picker-id) (.click)))}]
+     [:input {:id picker-id :class "palette-picker" :type "color" :value hex
+              :aria-label (str "edit palette slot " i)
+              :on-change #(rf/dispatch [::project/palette-color pid i (.. % -target -value)])}]]))
 
 (defn bar []
   (let [tone  @(rf/subscribe [::sub/tone])
+        clip  @(rf/subscribe [::render/clip])
+        chosen @(rf/subscribe [::chosen])
+        pid   (if (contains? (:palettes clip) chosen) chosen (pal/default-palette-id clip))
+        palette (get (pal/palettes clip) pid)
+        placements @(rf/subscribe [::sub/selected-placements])
+        selections @(rf/subscribe [::sub/selections])
         tool  @(rf/subscribe [::sub/tool])
         auto? @(rf/subscribe [::sub/auto-key?])
         draft @(rf/subscribe [::sub/draft])]
     [:div.palette-bar
-     [:div.swatches (doall (map #(swatch % tone) (range slots)))]
+     [:select {:value (str pid)
-     [:span.dim (name tone)]
+               :title "palette asset"
+               :on-change (fn [e]
+                            (let [v (.. e -target -value)
+                                  id (first (filter #(= v (str %)) (keys (pal/palettes clip))))]
+                              (rf/dispatch [::ui/set-tone 0])
+                              (rf/dispatch [:arthur.ui.palette/select id])))}
+      (for [[id p] (sort-by (comp str :name val) (pal/palettes clip))]
+        ^{:key (str id)} [:option {:value (str id)} (:name p)])]
+     [:button {:title "new 16-slot palette" :on-click #(rf/dispatch [::project/new-palette])} "+"]
+     [:div.swatches (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette)))]
+     [:span.dim (str tone)]
+     (when (> (count selections) 1)
+       [:span.dim (str (count selections) " selected")])
      [:span {:style {:flex 1}}]
      [:button.auto-key {:class (when auto? "on")
                         :aria-pressed auto?
@@ -62,8 +83,12 @@
         [:button {:disabled (< (count draft) 6)
                   :on-click #(rf/dispatch [::ui/finish-polygon])} "finish"]
         [:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "cancel"]]
-       [:button {:on-click #(rf/dispatch [::ui/begin-polygon])} "polygon"])
+       [:button {:title "pen tool — click points on the stage"
+                 :on-click #(rf/dispatch [::ui/begin-polygon])} "pen"])
      ;; The stage's zoom, at the right end of the bar above the stage: it is a
      ;; property of the view and not of the document, so it sits in the view's
      ;; own chrome rather than in the inspector.
      [layout/zoomer :stage "the stage"]]))
+
+(rf/reg-event-db :arthur.ui.palette/select
+ (fn [db [_ id]] (assoc-in db [:ui :palette] id)))

frontend/src/arthur/ui/params.cljs

@@ -11,6 +11,7 @@
             [arthur.domain.channel :as channel]
             [arthur.domain.feature :as feature]
             [arthur.domain.node :as node]
+            [arthur.domain.palette :as pal]
             [arthur.domain.paint :as paint]
             [arthur.domain.params :as params]
             [arthur.domain.pose :as pose]
@@ -201,7 +202,10 @@
 
 (defn- node-section [[sid id n]]
   (let [[start end] (:span n)
-        auto-key? @(rf/subscribe [::sub/auto-key?])]
+        auto-key? @(rf/subscribe [::sub/auto-key?])
+        clip @(rf/subscribe [::render/clip])
+        local @(rf/subscribe [::sub/selected-local])
+        frame (:frame local)]
     [section (str (name (:kind n)) " · in " (name sid))
      [facts
       "name" (or (:name n) (brief id))
@@ -214,8 +218,18 @@
       "span" (when start (str start " … " end))
       "at"   (when (node/mapped-time? n) (str (get-in n [:time :at] 0)))]
      (when (:paint? n) [drawing-keys sid id n @(rf/subscribe [::sub/selected-local])])
+     (when (= :instance (:kind n))
+       [:label.inspector-field "palette override"
+        [:select {:value (str (or (some-> (:palette n) (channel/value-at frame nil)) ""))
+                  :on-change (fn [e]
+                               (let [v (.. e -target -value)
+                                     pid (first (filter #(= v (str %)) (keys (pal/palettes clip))))]
+                                 (rf/dispatch [::project/instance-palette sid id frame pid])))}
+         [:option {:value ""} "inherit"]
+         (for [[pid p] (sort-by (comp str :name val) (pal/palettes clip))]
+           ^{:key (str pid)} [:option {:value (str pid)} (:name p)])]])
      [:div.row {:style {:margin-top "6px"}} [:span.dim "channels"]]
-     (let [{:keys [frame]} @(rf/subscribe [::sub/selected-local])]
+     (let [{:keys [frame]} local]
        [:dl.facts
         (doall
          (for [[path ch] (sort-by (comp str key) (node/channels n))]
@@ -527,6 +541,9 @@
 (defn- symbol-section [sid]
   (let [clip @(rf/subscribe [::render/clip])
         sym (get-in clip [:symbols sid])
+        frame @(rf/subscribe [::render/open-frame])
+        palette-value (or (some-> (:palette sym) (channel/value-at frame nil))
+                          (pal/default-palette-id clip))
         busy? (:busy? @(rf/subscribe [::playback/project]))]
     [section "symbol"
      [facts
@@ -546,6 +563,23 @@
        #(rf/dispatch [::project/symbol-setting sid :width %]) "project default" busy?]
       [number-field "height" (:height sym)
        #(rf/dispatch [::project/symbol-setting sid :height %]) "project default" busy?]
+      [:label.inspector-field "palette"
+       [:select {:value (str palette-value) :disabled busy?
+                 :on-change (fn [e]
+                              (let [v (.. e -target -value)
+                                    id (first (filter #(= v (str %)) (keys (pal/palettes clip))))]
+                                (rf/dispatch [::project/symbol-palette sid id frame])))}
+        [:option {:value ""} "inherit"]
+        (for [[id p] (sort-by (comp str :name val) (pal/palettes clip))]
+          ^{:key (str id)} [:option {:value (str id)} (:name p)])]]
+      [:div.row
+       [:button {:disabled busy?
+                 :title "hold this palette from this frame"
+                 :on-click #(rf/dispatch [::project/key-symbol-palette sid frame palette-value])}
+        "◆ key palette"]
+       [:button {:disabled (or busy? (nil? (:palette sym)))
+                 :on-click #(rf/dispatch [::project/symbol-palette sid nil])}
+        "inherit"]]
       (when (or (:width sym) (:height sym))
         [:div.row
          [:button {:disabled busy? :on-click #(do

frontend/src/arthur/ui/pool.cljs

@@ -45,6 +45,7 @@
   footage stay separate records on the server, so dropping the same file twice
   does not decode it twice."
   (:require [arthur.domain.clip :as clip]
+            [arthur.domain.palette :as pal]
             [arthur.domain.raster :as raster]
             [arthur.events.footage :as footage]
             [arthur.events.playback :as pb]
@@ -269,6 +270,23 @@
                 (carrying (str "symbol:" (subs (str sid) 1))
                           #(drag/symbol! clip-id sid open)))]))
 
+(defn- palette-row [id p default-id chosen rename]
+  ^{:key (str id)}
+  [row {:label (:name p)
+        :sub (str (count (:slots p)) " colors")
+        :title (str (:name p) " · " (count (:slots p)) " indexed colors")
+        :thumb [:span.thumb {:style {:display "grid"
+                                     :grid-template-columns "repeat(4,1fr)"}}
+                (for [[i s] (map-indexed vector (take 16 (:slots p)))]
+                  ^{:key i} [:i {:style {:background (:hex s)}}])]
+        :on? (= id chosen)
+        :rename (assoc rename :key [:palette id] :value (:name p)
+                       :commit! (fn [value]
+                                  ((:begin! rename) nil)
+                                  (rf/dispatch [::project/palette-name id value])))
+        :on-click #(rf/dispatch [:arthur.ui.palette/select id])
+        :on-double-click #(rf/dispatch [::project/default-palette id])}])
+
 (defn- footage-row [{:keys [id label frames fps video] :as f} chosen rename]
   ^{:key id}
   [row (merge {:label label
@@ -327,6 +345,13 @@
                         #(drag/other! {:kind :import :label name :frames frames
                                        :project pid :cid cid :symbol symbol})))])
 
+(defn- import-palette-row [{:keys [project palette name] :as asset}]
+  ^{:key (str project palette)}
+  [row {:label name :sub "palette"
+        :title (str name " — click to copy this palette into the project")
+        :thumb [picture nil]
+        :on-click #(rf/dispatch [::project/import-palette asset])}])
+
 ;; ---------------------------------------------------------------------------
 ;; sections
 
@@ -375,21 +400,28 @@
 
   Still not `:main` being special. The document says which symbol that is by its
   structure; rename it, place it inside something else, and the pool follows."
-  [{:keys [document query searching? media sounds chosen rename main] :as ctx}]
+  [{:keys [document query searching? media sounds chosen rename main palette-choice] :as ctx}]
   (let [named? #(hit? query (clip/symbol-name document %))
         top    (when (and main (named? main)) main)
         rest   (filterv #(and (named? %) (not= main %))
                         (sort-by str (keys (:symbols document))))
         media  (filterv #(hit? query (:label %)) media)
-        sounds (filterv #(hit? query (:label %)) sounds)]
+        sounds (filterv #(hit? query (:label %)) sounds)
+        palettes (filterv #(hit? query (:name (val %)))
+                          (sort-by (comp str :name val) (pal/palettes document)))]
     [sections searching?
-     (+ (if top 1 0) (count rest) (count media) (count sounds))
+     (+ (if top 1 0) (count rest) (count media) (count sounds) (count palettes))
      [{:title "project" :searching? searching?
        :blank "nothing to open yet"
        :rows (when top [(symbol-row document top ctx)])}
       {:title "symbols" :searching? searching?
        :blank "nothing else in the library"
        :rows (mapv #(symbol-row document % ctx) rest)}
+      {:title "palettes" :searching? searching?
+       :blank "no palettes"
+       :rows (mapv (fn [[id p]] (palette-row id p (:default-palette document)
+                                             (or palette-choice (pal/default-palette-id document))
+                                             rename)) palettes)}
       {:title "media" :searching? searching?
        :blank "drop a video here"
        :rows (mapv #(footage-row % chosen rename) media)}
@@ -401,21 +433,25 @@
   "Everything the server holds. Other projects' symbols stay grouped by project
   and closed: a server holds many, and a wall of every symbol in every one buries
   the one you want."
-  [{:keys [document query searching? rename chosen available all-sounds symbols
+  [{:keys [document query searching? rename chosen available all-sounds symbols palettes
            project-id]}]
   (let [media   (filterv #(hit? query (:label %)) available)
         sounds  (filterv #(hit? query (:label %)) all-sounds)
         others  (filterv #(and (not= project-id (:project %)) (hit? query (:name %)))
                          symbols)
-        grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others))]
+        grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others))
+        palettes (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) palettes)]
     [sections searching?
-     (+ (count media) (count sounds) (count others))
+     (+ (count media) (count sounds) (count others) (count palettes))
      [{:title "media" :searching? searching?
        :blank "nothing uploaded yet"
        :rows (mapv #(footage-row % chosen rename) media)}
       {:title "sounds" :searching? searching?
        :blank "no sounds uploaded yet"
        :rows (mapv #(sound-row % (:fps document) rename) sounds)}
+      {:title "palettes" :searching? searching?
+       :blank "no palettes in other saved projects"
+       :rows (mapv import-palette-row palettes)}
       {:title "symbols" :searching? searching?
        :blank "no other saved projects"
        :rows (for [[[pid pname] rows] grouped]
@@ -437,13 +473,15 @@
   one cost of collapsing two folders into two tabs — that a hit could be behind
   the tab you did not pick — is paid off by a number, counted over the same
   labels the rows are filtered by."
-  [{:keys [document query media sounds available all-sounds symbols project-id]}]
+  [{:keys [document query media sounds available all-sounds symbols palettes project-id]}]
   (let [n (fn [labels] (count (filter #(hit? query %) labels)))]
     {:project (+ (n (map #(clip/symbol-name document %) (keys (:symbols document))))
+                 (n (map :name (vals (pal/palettes document))))
                  (n (map :label media))
                  (n (map :label sounds)))
      :assets (+ (n (map :label available))
                 (n (map :label all-sounds))
+                (n (map :name (remove #(= project-id (:project %)) palettes)))
                 (n (map :name (remove #(= project-id (:project %)) symbols))))}))
 
 (defn view []
@@ -465,9 +503,10 @@
           palette   @(rf/subscribe [::render/palette])
           ramp      @(rf/subscribe [::render/ramp])
           selection @(rf/subscribe [::sub/selection])
+          palette-choice @(rf/subscribe [:arthur.ui.palette/chosen])
           open      @(rf/subscribe [::render/open])
           media     @(rf/subscribe [::sub/project-footage])
-          {:keys [symbols]} @(rf/subscribe [::project/assets])
+          {:keys [symbols palettes]} @(rf/subscribe [::project/assets])
           {project-id :id} @(rf/subscribe [::playback/project])
           ;; The project's videos' sounds first, then its uploaded ones.
           own-sounds (into (mapv (fn [{:keys [id label frames fps]}]
@@ -481,7 +520,8 @@
                :ramp ramp :selection selection :open open
                :media media :sounds own-sounds :chosen chosen
                :available (vec available) :all-sounds (vec sounds)
-               :symbols symbols :project-id project-id
+               :symbols symbols :palettes palettes :project-id project-id
+               :palette-choice palette-choice
                :query needle :searching? searching?
                ;; `clip/opens-on` and not `:main`: the longest symbol nothing
                ;; else places is the timeline the work happens in, and it is the

frontend/test/arthur/domain/instance_test.cljs

@@ -288,3 +288,33 @@
         (is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved")
         (is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value]))
             "the instance's did not")))))
+
+(deftest palette-context-is-inherited-keyed-and-overridable
+  (let [palette (fn [id name a b]
+                  {:id id :name name :slots [{:hex a} {:hex b}]})
+        mark {:id :mark :kind :rect :z "a1"
+              :channels {[:geom :size] (ch/framed 2)
+                         [:style :color] (ch/framed 1)}}
+        instance (fn [id child z]
+                   {:id id :kind :instance :z z :source {:symbol child}})
+        document {:fps 30 :width 20 :height 20
+                  :palettes {:day (palette :day "Day" "#000000" "#112233")
+                             :flash (palette :flash "Flash" "#ffffff" "#aabbcc")}
+                  :default-palette :day
+                  :symbols
+                  {:main {:id :main :frames 4
+                          :palette (ch/keyed {0 :day 2 :flash} :hold)
+                          :nodes {:inherited (instance :inherited :drawing "a1")
+                                  :fixed (assoc (instance :fixed :fixed "a2")
+                                                :palette (ch/framed :day))}}
+                   :drawing {:id :drawing :frames 4 :nodes {:mark mark}}
+                   :fixed {:id :fixed :frames 4 :palette (ch/framed :flash)
+                           :nodes {:mark mark}}}}
+        context (pal/compile document)
+        resolve (clip/resolver document :main nil context nil)
+        colors #(mapv :color (resolve %))]
+    (is (= [1 1] (colors 0)) "both children start in the day bank")
+    (is (= [3 1] (colors 2))
+        "the inheriting child follows the lightning cut; an instance override wins")
+    (is (= [17 34 51] (nth (:ramp context) 1)))
+    (is (= [170 187 204] (nth (:ramp context) 3)))))

static/arthur/app.css

@@ -800,6 +800,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 }
 
 .swatches { display: flex; gap: 3px; }
+.palette-slot { display: flex; align-items: center; }
+.palette-picker { display: none; }
+.thumb i { display: block; min-width: 1px; min-height: 1px; }
 
 /* Circles. A palette entry is one indivisible tone, not an area of coverage, and
    a row of dots says that where a row of tiles says "swatch book". */