Add multi-object stage selection and transforms

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"])

docs/time.md

@@ -4,6 +4,10 @@ Project `:fps` is the playback and export grid. Each symbol has its own native
 `:fps` and `:frames`; keys, spans, trace choices and corrections stay in that
 native space. A symbol without an explicit rate inherits the document rate;
 changing project fps first records that rate so its existing timing stays put.
+The untouched symbol in a new document is deliberately different: it has no
+authored timing to preserve, so it stays on the project grid and its empty frame
+extent is rescaled to keep the same duration. This makes changing fps before
+authoring establish the editor's grid instead of preserving the 30fps default.
 
 An output frame selects the latest native frame at or before its time:
 `floor(output-frame * native-fps / output-fps)`. Thus 30fps content in a 12fps

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."
@@ -71,12 +72,25 @@
 (defn fps [clip sid] (or (:fps (symbol clip sid)) (:fps clip)))
 
 (defn set-fps
-  "Change the output grid without rewriting any content's frames."
+  "Change the output grid without rewriting authored content's frames.
+
+  A new document's empty symbol is the one exception: it has no native rate yet,
+  so it follows the project grid and its empty extent is rescaled to preserve its
+  duration.  Once a symbol contains anything, changing the project rate records
+  the old effective rate on it before changing the output grid."
   [clip rate]
-  (-> clip
+  (let [old (:fps clip)]
-      (update :symbols #(into {} (map (fn [[sid sym]]
+    (-> clip
-                                       [sid (assoc sym :fps (fps clip sid))])) %))
+        (update :symbols
-      (assoc :fps rate)))
+                #(into {}
+                       (map (fn [[sid sym]]
+                              [sid (cond
+                                     (:fps sym) sym
+                                     (empty? (:nodes sym))
+                                     (update sym :frames cadence/frames rate old)
+                                     :else (assoc sym :fps old))]))
+                       %))
+        (assoc :fps rate))))
 
 (defn output-frames [clip sid]
   (cadence/frames (frames clip sid) (:fps clip) (fps clip sid)))
@@ -165,6 +179,18 @@
   (first (sort-by (fn [sid] [(- (or (frames clip sid) 0)) (str sid)])
                   (unplaced clip))))
 
+(defn set-root-fps
+  "Set the document/output rate and the root symbol's editing rate together.
+
+  Project FPS is the root timeline's clock. Nested symbols keep their own native
+  rates and are sampled when placed across that boundary; only the root changes
+  here. Frame numbers are authored positions, so changing the rate does not
+  rewrite them or silently move cuts and keys."
+  [clip rate]
+  (let [root (opens-on clip)]
+    (cond-> (assoc clip :fps rate)
+      root (assoc-in [:symbols root :fps] rate))))
+
 (def ^:const blank-frames
   "How long a new document is before anything says otherwise. Four seconds at 30,
   which is long enough to key something into and short enough to scrub by hand."
@@ -188,7 +214,11 @@
   {:name "untitled"
    :fps 30
    :width 320 :height 200
-   :symbols {:main {:id :main :fps 30 :frames blank-frames :nodes {}}}})
+   :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 {}}}})
 
 (defn- transform-op
   "Put a symbol's already resolved mark into its instance's parent space. Its
@@ -218,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 {}
@@ -241,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)))]
@@ -274,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
@@ -318,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
@@ -472,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/gesture.cljs

@@ -29,14 +29,19 @@
         xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
     {:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
 
+(defn- measured-channel? [n path]
+  (let [c (get-in n [:channels path])]
+    (boolean (or (:dense c) (:generated c)))))
+
 (defn refusal
-  "Why node `n`'s transform cannot be set by hand, or nil when it can. A
+  "Why `kind` cannot transform node `n`, or nil. Measured position and rotation
-  measured transform is regenerated from the footage, and writing a value over
+  accept authored correction layers; measured scale cannot yet be decomposed
-  it would throw the measurement away."
+  safely. The one-argument form asks whether any stage gesture is possible."
-  [n]
+  ([n] (when (node/measured? n)
-  (cond
+         "its transform is measured — use a correction or place the instance it is in"))
-    (node/measured? n)
+  ([n kind]
-    "its transform is measured — place the instance it is in"))
+   (when (and (= :scale kind) (measured-channel? n [:xform :scale]))
+     "its scale is measured — place the instance it is in")))
 
 (defn- through [m [x y]]
   (let [out (js/Float64Array. 2)]
@@ -76,24 +81,57 @@
               nil)]
       {[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))})))
 
+(def ^:private manual-layer ::manual-transform)
+
+(defn- plus [a b]
+  (if (number? a) (+ a b) (mapv + (vec a) (vec b))))
+
+(defn- minus [a b]
+  (if (number? a) (- a b) (mapv - (vec a) (vec b))))
+
+(defn- corrected-channel
+  "Set the effective value of a measured channel without replacing its base."
+  [channel f target store extent auto-key?]
+  (let [current (ch/value-at channel f store)
+        layers  (vec (:over channel))
+        i       (first (keep-indexed #(when (= manual-layer (:id %2)) %1) layers))
+        old     (when i (ch/value-at (get-in layers [i :values]) f store))
+        zero    (if (number? target) 0 (vec (repeat (count target) 0)))
+        value   (plus (or old zero) (minus target current))
+        values  (or (when i (get-in layers [i :values])) (ch/framed zero))
+        values  ((if auto-key? node/set-keyed-channel node/set-channel)
+                 {:kind :group :channels {[:xform :pos] values}}
+                 [:xform :pos] f value)
+        values  (get-in values [:channels [:xform :pos]])
+        layer   (ch/layer manual-layer [0 extent] :offset values)]
+    (assoc channel :over (if i (assoc layers i layer) (conj layers layer)))))
+
 (defn apply-values
   "Clip with channel values `vs`, `{path value}`, written into node `id` of
   symbol `sid` on the node's own frame `f`, by the keying rule above. The sixth
   argument arms auto-key; the five-argument form retains the normal rule."
-  ([clip sid id f vs] (apply-values clip sid id f vs false))
+  ([clip sid id f vs] (apply-values clip sid id f vs false nil))
-  ([clip sid id f vs auto-key?]
+  ([clip sid id f vs auto-key?] (apply-values clip sid id f vs auto-key? nil))
+  ([clip sid id f vs auto-key? store]
    (let [put (if auto-key? node/set-keyed-channel node/set-channel)]
      (update-in clip [:symbols sid :nodes id]
-                #(reduce-kv (fn [n path v] (put n path f v)) % vs)))))
+                #(reduce-kv
+                  (fn [n path v]
+                    (if (measured-channel? n path)
+                      (update-in n [:channels path] corrected-channel f v store
+                                 (get-in clip [:symbols sid :frames]) auto-key?)
+                      (put n path f v)))
+                  % vs)))))
 
 (defn apply-take
   "Apply a buffered performance take. `take` is keyed by `[symbol node]`, then
   local frame, then channel path. It becomes ordinary authored keys in one
   document edit rather than making the edit pipeline run for every sample."
-  [clip take]
+  ([clip take] (apply-take clip take nil))
-  (reduce-kv
+  ([clip take store]
-   (fn [c [sid id] frames]
+   (reduce-kv
-     (reduce-kv (fn [c f values]
+    (fn [c [sid id] frames]
-                  (apply-values c sid id f values true))
+      (reduce-kv (fn [c f values]
-                c frames))
+                   (apply-values c sid id f values true store))
-   clip take))
+                 c frames))
+    clip take)))

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/nest.cljs

@@ -454,7 +454,7 @@
         ;; a boundary can be rolled depend on which of them `some` reaches
         ;; first. `finish` does the same `problems` check and the overlap one
         ;; too, so this is less code and one fewer invariant to remember.
-        (span/finish clip (:sid here) moved id :grow-symbol)))))
+        (span/claim clip (:sid here) moved id :grow-symbol (random-uuid))))))
 
 (defn resize-out
   "Move the right edge of the node at `path` by `df` frames of `open`.

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/pick.cljs

@@ -55,6 +55,31 @@
   [ops [x y]]
   (some #(when (on? % x y) (path-of %)) (rseq (vec ops))))
 
+(defn- op-bounds [{:keys [kind pts n cx cy r size]}]
+  (case kind
+    :poly (reduce (fn [b i]
+                    (let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))]
+                      (if b (let [[x0 y0 x1 y1] b]
+                              [(min x0 x) (min y0 y) (max x1 x) (max y1 y)])
+                          [x y x y]))) nil (range n))
+    :disc [(- cx r) (- cy r) (+ cx r) (+ cy r)]
+    :rect (let [h (/ size 2)] [(- cx h) (- cy h) (+ cx h) (+ cy h)])
+    nil))
+
+(defn in-rect
+  "Distinct row paths whose drawn bounds intersect `[x0 y0 x1 y1]`. `depth`
+  chooses objects at one hierarchy level, just as an ordinary stage click does."
+  [ops [ax ay bx by] depth]
+  (let [[rx0 rx1] [(min ax bx) (max ax bx)]
+        [ry0 ry1] [(min ay by) (max ay by)]]
+    (->> ops
+         (keep (fn [op]
+                 (when-let [[x0 y0 x1 y1] (op-bounds op)]
+                   (when (and (<= x0 rx1) (<= rx0 x1) (<= y0 ry1) (<= ry0 y1))
+                     (let [path (path-of op)]
+                       (subvec path 0 (min (count path) (max 1 depth))))))))
+         distinct vec)))
+
 (defn- prefix? [a b]
   (and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
 

frontend/src/arthur/domain/span.cljs

@@ -49,6 +49,28 @@
             [arthur.domain.node :as node]
             [arthur.domain.symbol :as symbol]))
 
+(defn- fit-lanes
+  "Make direct lane children cover `sid`'s authored window.
+
+  A lane has no independently authored extent: it is a view of its parent
+  symbol's timeline. Keep that invariant at the one commit point that can grow
+  a symbol, so neither the wrapper nor the lane symbol retains an old parent
+  length."
+  [clip sid]
+  (let [frames (clip/frames clip sid)]
+    (reduce
+     (fn [c [id n]]
+       (let [source (node/source n)]
+         (if (and (nil? (:parent n))
+                  (symbol/lane? (clip/symbol c source)))
+           (-> c
+               (assoc-in [:symbols sid :nodes id :span] [0 frames])
+               (assoc-in [:symbols sid :nodes id :time :at] 0)
+               (assoc-in [:symbols source :frames] frames))
+           c)))
+     clip
+     (get-in clip [:symbols sid :nodes]))))
+
 (defn finish
   "Commit `nodes` as symbol `sid`'s, or refuse.
 
@@ -94,9 +116,11 @@
       (and (> needed (:frames sym)) (= :keep extent))
       {:refused (str "the edit needs " needed " frames; extend the shot to continue")
        :required-frames needed}
-      :else {:clip (cond-> (assoc-in clip [:symbols sid :nodes] nodes)
+      :else {:clip (fit-lanes
-                     (> needed (:frames sym))
+                    (cond-> (assoc-in clip [:symbols sid :nodes] nodes)
-                     (assoc-in [:symbols sid :frames] needed))
+                      (> needed (:frames sym))
+                      (assoc-in [:symbols sid :frames] needed))
+                    sid)
              :selection selection})))
 
 ;; ---------------------------------------------------------------------------
@@ -120,6 +144,47 @@
   [n which f]
   (assoc-in n [:span (case which :in 0 :out 1)] (local n f)))
 
+(defn claim
+  "Commit proposed `nodes`, with `id` claiming its interval in lane mode.
+
+  This is the one difference between editing a lane and a composition.  In a
+  composition it is exactly `finish`.  In a lane, immediately before that same
+  commit, clips covered by the edited one are removed and clips crossing either
+  edge are trimmed.  A clip crossing both edges is split and therefore needs a
+  caller-supplied `remainder-id`."
+  [clip sid nodes id extent remainder-id]
+  (let [n (get nodes id)
+        lane-child? (and (symbol/lane? (clip/symbol clip sid))
+                         n (nil? (:parent n)) (node/placed-span n))]
+    (if-not lane-child?
+      (finish clip sid nodes id extent)
+      (let [[a b] (node/placed-span n)
+            others (remove #(= id (:id %)) (symbol/children nodes))
+            spanning (first (filter #(let [[lo hi] (node/placed-span %)]
+                                       (and (< lo a) (> hi b)))
+                                    others))]
+        (if (and spanning (or (nil? remainder-id) (contains? nodes remainder-id)))
+          {:refused "claiming time inside one clip needs a free ID for its remainder"}
+          (finish
+           clip sid
+           (reduce
+            (fn [ns other]
+              (let [oid (:id other)
+                    [lo hi] (node/placed-span other)]
+                (cond
+                  (or (<= hi a) (>= lo b)) ns
+                  (and (< lo a) (> hi b))
+                  (-> ns
+                      (assoc oid (edged other :out a))
+                      (assoc remainder-id
+                             (assoc (edged other :in b) :id remainder-id
+                                    :z (str "a-" remainder-id))))
+                  (and (>= lo a) (<= hi b)) (dissoc ns oid)
+                  (< lo a) (assoc ns oid (edged other :out a))
+                  :else (assoc ns oid (edged other :in b)))))
+            nodes others)
+           id extent))))))
+
 (defn host-frame
   "Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its
   parent's — which is the frame space every command here takes its coordinate
@@ -311,7 +376,7 @@
   (let [nodes (get-in clip [:symbols sid :nodes])
         {:keys [node refused]} (subject nodes id)
         [lo old-out] (when node (node/placed-span node))
-        later (when node
+        later (when (and node ripple?)
                 (filter #(>= (first (node/placed-span %)) old-out)
                         (siblings clip sid nodes id)))]
     (cond
@@ -322,22 +387,10 @@
       :else
       (let [delta (- to old-out)
             resized (assoc nodes id (edged node :out to))
-            changed
+            changed (reduce (fn [ns sibling]
-            (if ripple?
+                              (update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
-              (reduce (fn [ns sibling]
+                            resized later)]
-                        (update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
+        (claim clip sid changed id extent nil)))))
-                      resized later)
-              (if (pos? delta)
-                (reduce
-                 (fn [ns sibling]
-                   (let [[s e] (node/placed-span sibling)]
-                     (cond
-                       (>= s to) ns
-                       (<= e to) (dissoc ns (:id sibling))
-                       :else (assoc ns (:id sibling) (edged sibling :in to)))))
-                 resized later)
-                resized))]
-        (finish clip sid changed id extent)))))
 
 (defn resize-in
   "Put clip `id`'s left edge at parent frame `to`. Shrinking leaves a gap;
@@ -345,29 +398,14 @@
   [clip sid id to]
   (let [nodes (get-in clip [:symbols sid :nodes])
         {:keys [node refused]} (subject nodes id)
-        [old-in hi] (when node (node/placed-span node))
+        [old-in hi] (when node (node/placed-span node))]
-        earlier (when node
-                  (filter #(<= (second (node/placed-span %)) old-in)
-                          (siblings clip sid nodes id)))]
     (cond
       refused {:refused refused}
       (not (integer? to)) {:refused "an edge goes to a whole frame"}
       (not (< to hi)) {:refused "a clip must keep at least one frame"}
       (neg? to) {:refused "a clip cannot begin before the shot"}
       (= to old-in) {:clip clip :selection id}
-      :else
+      :else (claim clip sid (assoc nodes id (edged node :in to)) id :keep nil))))
-      (let [resized (assoc nodes id (edged node :in to))
-            changed (if (< to old-in)
-                      (reduce
-                       (fn [ns sibling]
-                         (let [[s e] (node/placed-span sibling)]
-                           (cond
-                             (<= e to) ns
-                             (>= s to) (dissoc ns (:id sibling))
-                             :else (assoc ns (:id sibling) (edged sibling :out to)))))
-                       resized earlier)
-                      resized)]
-        (finish clip sid changed id :keep)))))
 
 (defn roll
   "Move the shared boundary between adjacent clips `left-id` and `right-id`.
@@ -436,17 +474,6 @@
         ;; selected rather than being handed a clip it did not ask for.
         (finish clip sid nodes (when spanning id) :keep)))))
 
-(defn- cleared
-  "`clip` with frames `[at (+ at duration))` of `sid` emptied where `sid` is drawn
-  as a lane, and untouched where it is not: outside lane mode a placement does not
-  claim time, because being on screen together is what compositing IS.
-
-  `{:clip c}` or `{:refused why}`, so one `if-let` covers both."
-  [clip sid at duration remainder-id]
-  (if-not (symbol/lane? (clip/symbol clip sid))
-    {:clip clip}
-    (blank clip sid [at (+ at duration)] {:id remainder-id})))
-
 (defn extend-hold
   "Change one held clip's duration by `delta` frames and ripple its later
   siblings. Keys, source clocks and the clips' own channels stay put.
@@ -504,12 +531,8 @@
       (and remainder-id (contains? nodes remainder-id))
       {:refused "the remainder clip needs a free ID"}
       :else
-      (let [room (cleared clip sid at duration remainder-id)]
+      (let [placed (update-in n [:time :at] (fnil + 0) (- at lo))]
-        (if (:refused room)
+        (claim clip sid (assoc nodes id placed) id extent remainder-id)))))
-          room
-          (let [placed (update-in n [:time :at] (fnil + 0) (- at lo))
-                nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id placed)]
-            (finish (:clip room) sid nodes id extent)))))))
 
 (defn place-symbol
   "Materialize an instance of `source-id`, then place it into `sid` at `at`.
@@ -722,12 +745,11 @@
                    "the remainder clip needs a free ID different from the new clip"
                    (clip/symbol clip drawing-id) "the new drawing ID is already used")]
       {:refused why}
-      (let [room (cleared clip sid at 1 remainder-id)]
+      (let [c (assoc-in clip [:symbols drawing-id]
-        (if (:refused room)
+                        {:id drawing-id :name (name drawing-id)
-          room
+                         :fps (clip/fps clip sid) :frames 1 :nodes {}})
-          (place (assoc-in (:clip room) [:symbols drawing-id]
+            nodes (assoc nodes id (held id drawing-id at))]
-                           {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}})
+        (claim c sid nodes id extent remainder-id)))))
-                 sid id drawing-id at extent false))))))
 
 (defn make-unique
   "Point clip `id` at a private copy of its content, leaving every other

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]
@@ -113,7 +115,11 @@
                        loaded (project/load
                                cid #js {:leaves (.-leaves clip-json)
                                         :blocks blocks})
-                       built (:clip loaded)]
+                       ;; Project FPS and the root timeline are one clock. This
+                       ;; also normalizes documents saved by the earlier model,
+                       ;; where changing project FPS left the root on its old
+                       ;; editing grid.
+                       built (clip/set-root-fps (:clip loaded) (:fps (:clip loaded)))]
                    (let [entry (merge (select-keys built [:fps :width :height])
                                       {:label (str (or (.-name clip-json) cid) " (saved)")
                                        :cid cid
@@ -161,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
@@ -292,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))]))))))
 
@@ -304,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)))
 
@@ -606,7 +645,7 @@
    (if (or (not (#{:fps :width :height} key))
            (not (and (integer? value) (pos? value))))
      {}
-     (let [db' (edit/edit db #(if (= key :fps) (clip/set-fps % value) (assoc % key value)))
+     (let [db' (edit/edit db #(if (= key :fps) (clip/set-root-fps % value) (assoc % key value)))
            db' (assoc-in db' [:clip key] value)
            frame (min (dec (pb/frames db'))
                       (js/Math.floor (* (get-in db [:playback :frame])
@@ -636,7 +675,7 @@
 (rf/reg-event-db
  ::symbol-setting
  (fn [db [_ sid key value]]
-   (if-not (and (#{:frames :width :height} key)
+   (if-not (and (#{:frames :fps :width :height} key)
                 (or (nil? value) (and (integer? value) (pos? value))))
      db
      (edit/edit db
@@ -645,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.
@@ -652,6 +755,16 @@
    (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)]
      (edit/edit db #(update-in % [:symbols sid :nodes id] put path frame value)))))
 
+(rf/reg-event-db
+ ::set-channels
+ ;; One property assignment over a stage selection is one document edit.
+ (fn [db [_ edits]]
+   (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)]
+     (edit/edit db
+                #(reduce (fn [c {:keys [sid id path frame value]}]
+                           (update-in c [:symbols sid :nodes id] put path frame value))
+                         % edits)))))
+
 (rf/reg-event-db
  ::toggle-key
  (fn [db [_ sid id path frame]]

frontend/src/arthur/events/ui.cljs

@@ -78,6 +78,7 @@
                                  [:clip :symbols sid :nodes id :kind]))]
     (cond-> (-> db
                 (assoc-in [:ui :selection] selection)
+                (assoc-in [:ui :selections] (if selection [selection] []))
                 (update :ui dissoc :points :retry))
       (and (= :node kind) (seq path) (not sound?))
       (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path)))))))
@@ -103,6 +104,29 @@
 
 (rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection)))
 
+(rf/reg-event-db
+ ::select-many
+ ;; `:selection` remains the primary address used by the inspector and timeline;
+ ;; `:selections` is the ordered set used by the stage and batch commands.
+ (fn [db [_ selections]]
+   (let [xs (vec (distinct (keep identity selections)))]
+     (if-let [primary (peek xs)]
+       (-> (selected db primary) (assoc-in [:ui :selections] xs))
+       (selected db nil)))))
+
+(rf/reg-event-db
+ ::toggle-selection
+ (fn [db [_ selection]]
+   (let [primary (get-in db [:ui :selection])
+         many (vec (get-in db [:ui :selections]))
+         old (if (some #{primary} many) many (if primary [primary] []))
+         xs  (if (some #{selection} old)
+               (vec (remove #{selection} old))
+               (conj old selection))]
+     (if-let [primary (peek xs)]
+       (-> (selected db primary) (assoc-in [:ui :selections] xs))
+       (selected db nil)))))
+
 (rf/reg-event-db
  ::aim
  ;; The gestures that name a PLACE in the document rather than a thing on
@@ -624,6 +648,12 @@
   (let [{document :clip st :store} (store/entry (:clip/current db))
         open (get-in db [:ui :open])
         frame (editing-frame db document)
+        ;; A lane is the open symbol's timeline, not an insert that happens to
+        ;; begin where the playhead was when it was made. Giving that wrapper
+        ;; the whole open-symbol window makes the row's promise true: it is a
+        ;; destination at every frame. Ordinary symbols remain clips created at
+        ;; the playhead.
+        frame (if lane? 0 frame)
         into (if (= :top where)
                (assoc (nest/inside document st open [] frame) :path [])
                (aimed-symbol document st db frame))
@@ -665,8 +695,10 @@
 (rf/reg-event-db
  ::new-lane
  (fn [db _]
-   ;; A lane is an explicit top-level track of the open symbol. It must not
+   ;; A lane is an explicit, persistent top-level track of the open symbol. It
-   ;; become nested merely because the previously created lane is still aimed.
+   ;; must not become nested merely because the previously created lane is
+   ;; still aimed, and it spans the open symbol rather than starting at the
+   ;; current playhead.
    (create-container db :top true)))
 
 ;; ---------------------------------------------------------------------------
@@ -688,9 +720,9 @@
  ::drop-clear
  (fn [db _] (update db :ui dissoc :drop)))
 
-(defn drop-destination
+(defn drop-destination-at
-  "Which symbol a drop lands in and on which of its frames: `{:clip :sid :at
+  "Which symbol a drop on `target` lands in and on which of its frames:
-  :path}`, or `{:refused why}`.
+  `{:clip :sid :at :path}`, or `{:refused why}`.
 
   ONE RULE AND EVERY DROP ASKS IT — a symbol from the pool, a sound, and a video
   brought in as a take alike. The pointer names a ROW, `target`, and a row leads
@@ -706,12 +738,11 @@
   `:clip` is handed back unchanged and is in the result only so the callers that
   used to be given a document with a freshly made lane in it go on reading one
   thing."
-  [db document st frame target]
+  [document st open frame target]
   (let [target (if (vector? target)
                  (let [[_ sid id path] target]
                    {:sid sid :id id :path path})
                  target)
-        open (get-in db [:ui :open])
         path (cond
                (nil? target) []
                (= :instance (get-in document [:symbols (:sid target)
@@ -724,6 +755,11 @@
       (not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
       :else {:clip document :sid sid :at at :path path})))
 
+(defn drop-destination
+  "`drop-destination-at` from the symbol currently open in `db`."
+  [db document st frame target]
+  (drop-destination-at document st (get-in db [:ui :open]) frame target))
+
 (defn landed
   "`db` after a drop that produced `result`, with `uuid` selected."
   [db {:keys [sid path]} uuid result]
@@ -903,26 +939,44 @@
  ::transform
  ;; The drag let go: one edit, so one undo step and one write to collaborators.
  (fn [db [_ g]]
-   (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))]
+   (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))
+         st (:store (store/entry (:clip/current db)))]
      (if auto?
        (let [db   (-> db
                       (update-in [:ui :gesture] merge g)
                       (record-auto-frame (get-in db [:playback :frame])))
              take (get-in db [:ui :gesture :take])]
          (cond-> (update db :ui dissoc :gesture)
-           (seq take) (edit/edit #(gesture/apply-take % take))))
+           (seq take) (edit/edit #(gesture/apply-take % take st))))
        (let [{:keys [sid id frame values]} g]
          (cond-> (update db :ui dissoc :gesture)
-           (seq values) (edit/edit #(gesture/apply-values % sid id frame values false))))))))
+           (seq values) (edit/edit #(gesture/apply-values % sid id frame values false st))))))))
+
+(rf/reg-event-db
+ ::transform-many
+ ;; Every visible member of a stage selection is one edit and therefore one
+ ;; undo step. Members absent at this playhead are intentionally not in `edits`.
+ (fn [db [_ edits]]
+   (let [st (:store (store/entry (:clip/current db)))]
+     (cond-> (update db :ui dissoc :gesture)
+       (seq edits)
+       (edit/edit #(reduce (fn [c {:keys [sid id frame values]}]
+                             (gesture/apply-values c sid id frame values
+                                                   (boolean (get-in db [:ui :auto-key?])) st))
+                           % edits))))))
 
 (rf/reg-event-db
  ::delete-selected
  (fn [db _]
-   (let [[kind sid id] (get-in db [:ui :selection])]
+   (let [primary (get-in db [:ui :selection])
-     (if (= :node kind)
+         many (vec (get-in db [:ui :selections]))
+         selections (if (some #{primary} many) many (if primary [primary] []))
+         nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))]
+     (if (seq nodes)
        (-> db
-           (edit/edit #(nest/delete-node % sid id))
+           (edit/edit #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes))
-           (assoc-in [:ui :selection] nil))
+           (assoc-in [:ui :selection] nil)
+           (assoc-in [:ui :selections] []))
        db))))
 
 (rf/reg-event-db

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

@@ -43,20 +43,24 @@
    ;; With a timeline bar being slid, the document as it will be when the drag
    ;; lets go, so the stage and the rows follow the pointer. Nothing is written
    ;; until then: one drag is one undo step and one write to collaborators.
-   (let [c (:clip (footage/entry id))]
+   (let [{c :clip st :store} (footage/entry id)]
      (or (when-let [{:keys [path df kind ripple? other]} sliding]
            (:clip (case kind
                     :out (nest/resize-out c open path df ripple?)
                     :in (nest/resize-in c open path df)
                     :roll (nest/roll c open other path df)
                     (nest/slide c open path df))))
-         (when-let [{:keys [sid id frame values]} gesture]
+         (when-let [{:keys [sid id frame values edits]} gesture]
            ;; A held stage control owns the touched parameters completely. Make
            ;; them temporary static channels for the preview, so their existing
            ;; automation cannot pull against the pointer while the performance
            ;; recorder samples the live value in the background. Pointer-up
            ;; removes this preview and commits the buffered take as real keys.
-           (when c (gesture/apply-values c sid id frame values false)))
+           (when c
+             (if (seq edits)
+               (reduce (fn [out {:keys [sid id frame values]}]
+                         (gesture/apply-values out sid id frame values false st)) c edits)
+               (gesture/apply-values c sid id frame values false st))))
          c))))
 
 (rf/reg-sub
@@ -118,21 +122,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
@@ -537,10 +554,32 @@
      [:div.inspector-form
       [number-field "length (frames)" (:frames sym)
        #(rf/dispatch [::project/symbol-setting sid :frames %]) nil busy?]
+      [number-field "fps" (clip-domain/fps clip sid)
+       #(rf/dispatch (if (= sid (clip-domain/opens-on clip))
+                       [::project/project-setting :fps %]
+                       [::project/symbol-setting sid :fps %]))
+       nil busy?]
       [number-field "width" (:width sym)
        #(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/player.cljs

@@ -152,6 +152,9 @@
   [point]
   (pick/hit (:ops @state) point))
 
+(defn in-rect [rect depth]
+  (pick/in-rect (:ops @state) rect depth))
+
 (defn paint!
   "Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
   the resolver reuses its point buffers between frames, so they have to be

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/src/arthur/ui/stage.cljs

@@ -25,7 +25,8 @@
             [arthur.ui.layout :as layout]
             [arthur.ui.player :as player]
             [arthur.ui.underlay :as underlay]
-            [re-frame.core :as rf]))
+            [re-frame.core :as rf]
+            [reagent.core :as r]))
 
 ;; THE ZOOM IS NOT A CONSTANT ANY MORE — it is `ui/layout`'s, an integer in
 ;; [1 8], 2 to begin with. It scales the canvas with CSS and never its backing
@@ -118,6 +119,7 @@
 ;; placement and transform it started from, and where. What it makes of the
 ;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`.
 (defonce ^:private gesture (atom nil))
+(defonce ^:private marquee (r/atom nil))
 
 (defn- loaded
   "The document and its tier-2 store, read WHEN THE POINTER GOES DOWN.
@@ -137,12 +139,15 @@
 (defn- select!
   "Select the node at row path `path` of the open symbol — the selection a
   timeline row makes, so the row, the inspector and the stage all show it — or
-  nothing."
+  the open symbol itself when `path` is empty. Blank stage is an explicit place,
+  not merely an absence of a picked shape, so it clears a stale drawing target
+  as well as the inspector selection."
   [{:keys [open f] :as ctx} path]
   (let [{document :clip st :store} (loaded ctx)]
-    (rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path)
+    (if-let [{:keys [sid id]} (when (seq path)
-                                                            (nest/placement document st open path f))]
+                                (nest/placement document st open path f))]
-                                [:node sid id path])])))
+      (rf/dispatch [::ui/select [:node sid id path]])
+      (rf/dispatch [::ui/aim nil]))))
 
 (defn- begin!
   "Start dragging `kind` of the node at `path` from stage point `p`."
@@ -154,12 +159,62 @@
         (reset! gesture {:kind kind :pl pl :path path :open open :v0 v0 :p0 p :n n
                          :a (gesture/angle pl v0 p) :turned 0})))))
 
+(defn- stage-bounds [{:keys [world bounds]}]
+  (when (and world bounds)
+    (let [[x0 y0 x1 y1] bounds
+          ps (pairs (through world [x0 y0 x1 y0 x1 y1 x0 y1]))]
+      [(apply min (map first ps)) (apply min (map second ps))
+       (apply max (map first ps)) (apply max (map second ps))])))
+
+(defn- begin-many! [ctx kind placements p]
+  (let [{document :clip st :store} (loaded ctx)
+        members (into [] (keep (fn [{:keys [path]}]
+                                 (when-let [{:keys [sid id frame] :as pl}
+                                            (nest/placement document st (:open ctx) path (:f ctx))]
+                                   (let [n (get-in document [:symbols sid :nodes id])]
+                                     {:pl pl :path path :node n
+                                      :v0 (gesture/values n frame st)}))))
+                      placements)
+        why (some #(gesture/refusal (:node %) kind) members)
+        boxes (keep stage-bounds placements)
+        box   (when (seq boxes)
+                (reduce (fn [[ax ay bx by] [cx cy dx dy]]
+                          [(min ax cx) (min ay cy) (max bx dx) (max by dy)]) boxes))]
+    (cond
+      why (rf/dispatch [::ui/refuse (str "the selection cannot move together: " why)])
+      (and (seq members) box)
+      (reset! gesture {:kind kind :members members :p0 p :box box}))))
+
+(defn- multi-values [kind {:keys [pl v0]} [cx cy] p0 p]
+  (case kind
+    :move (gesture/move pl v0 p0 p)
+    :scale
+    (let [d0 (max 1e-6 (js/Math.hypot (- (first p0) cx) (- (second p0) cy)))
+          k  (/ (js/Math.hypot (- (first p) cx) (- (second p) cy)) d0)
+          [px py] (through (:world pl) (:anchor v0))
+          target [(+ cx (* k (- px cx))) (+ cy (* k (- py cy)))]
+          inv (node/invert (:parent pl))]
+      (when inv
+        (let [[a b] (through inv [px py]) [c d] (through inv target)]
+          {[:xform :pos] (mapv + (:pos v0) [(- c a) (- d b)])
+           [:xform :scale] (mapv #(* k %) (:scale v0))})))
+    nil))
+
 (defn- drag! [p ^js event]
   (let [{:keys [kind pl path open v0 p0 n a turned values]} @gesture
         shift? (.-shiftKey event)
         moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))]
     (when moved?
-      (if-let [why (gesture/refusal n)]
+      (if-let [members (:members @gesture)]
+        (let [[x0 y0 x1 y1] (:box @gesture)
+              center [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]
+              edits (into [] (keep (fn [{:keys [pl path] :as member}]
+                             (when-let [vs (multi-values kind member center p0 p)]
+                               (assoc (select-keys pl [:sid :id :frame])
+                                      :path path :values vs)))) members)]
+          (swap! gesture assoc :values edits)
+          (rf/dispatch [::ui/gesture {:edits edits}]))
+        (if-let [why (gesture/refusal n kind)]
         (do (reset! gesture nil) (rf/dispatch [::ui/refuse why]))
         (let [vs (case kind
                    :move  (gesture/move pl v0 p0 p)
@@ -177,16 +232,17 @@
             (swap! gesture assoc :values vs)
             (rf/dispatch [::ui/gesture
                           (assoc (select-keys pl [:sid :id :frame])
-                                 :path path :open open :values vs)])))))))
+                                 :path path :open open :values vs)]))))))))
 
 (defn- let-go! [commit?]
-  (when-let [{:keys [pl path open values]} @gesture]
+  (when-let [{:keys [pl path open values members]} @gesture]
     (reset! gesture nil)
     (when values
-      (rf/dispatch (if commit?
+      (rf/dispatch (cond
-                     [::ui/transform (assoc (select-keys pl [:sid :id :frame])
+                     (not commit?) [::ui/gesture nil]
-                                            :path path :open open :values values)]
+                     members [::ui/transform-many values]
-                     [::ui/gesture nil])))))
+                     :else [::ui/transform (assoc (select-keys pl [:sid :id :frame])
+                                                  :path path :open open :values values)])))))
 
 (defn- handles
   "The selected node's box, drawn through its own transform so it turns with
@@ -224,6 +280,30 @@
        [:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3)
                              " M " px " " (- py 3) " V " (+ py 3))}]])))
 
+(defn- group-handles [ctx placements]
+  (let [boxes (keep stage-bounds placements)]
+    (when (seq boxes)
+      (let [[x0 y0 x1 y1] (reduce (fn [[ax ay bx by] [cx cy dx dy]]
+                                     [(min ax cx) (min ay cy) (max bx dx) (max by dy)]) boxes)
+            grab (fn [kind]
+                   (fn [^js event]
+                     (.stopPropagation event)
+                     (.preventDefault event)
+                     (let [svg (.-ownerSVGElement (.-currentTarget event))]
+                       (.setPointerCapture svg (.-pointerId event))
+                       (begin-many! ctx kind placements (xy svg event (:w ctx) (:h ctx))))))]
+        [:g.handles.multi
+         [:rect.box {:x x0 :y y0 :width (- x1 x0) :height (- y1 y0)}]
+         (doall (for [[i [x y]] (map-indexed vector [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])]
+                  ^{:key i} [:rect.corner {:x (- x 1.8) :y (- y 1.8)
+                                           :width 3.6 :height 3.6
+                                           :on-pointer-down (grab :scale)}]))]))))
+
+(defn- address-for [{:keys [open f] :as ctx} path]
+  (let [{document :clip st :store} (loaded ctx)]
+    (when-let [{:keys [sid id]} (and (seq path) (nest/placement document st open path f))]
+      [:node sid id path])))
+
 (defn- aim-box
   "The TARGET's outline: where a new polygon or symbol would be parented, drawn
   around the thing that would be its parent.
@@ -268,6 +348,9 @@
         draft @(rf/subscribe [::sub/draft])
         drawing? (= :polygon tool)
         [_ _ _ selected] @(rf/subscribe [::sub/selection])
+        selections @(rf/subscribe [::sub/selections])
+        placements @(rf/subscribe [::sub/selected-placements])
+        selected-paths (set (keep #(nth % 3 nil) selections))
         clip-id @(rf/subscribe [::render/clip-id])
         ctx {:clip-id clip-id
              ;; The open symbol's OWN frame, which is what `nest/placement`
@@ -278,7 +361,8 @@
         points? @(rf/subscribe [::sub/points])
         [sid id geom active editable? frame matrix] (when points? (editing))
         pts (when geom (through matrix (channel/value-at geom frame
-                                                          (:store (store/entry clip-id)))))]
+                                                          (:store (store/entry clip-id)))))
+        mark @marquee]
     [:svg {:class (str "paint-overlay" (when drawing? " drawing"))
            :width (* zoom w) :height (* zoom h)
            :view-box (str "0 0 " w " " h)
@@ -292,10 +376,22 @@
                                       path (pick/choose selected (player/at p)
                                                         (or (.-metaKey event) (.-ctrlKey event)))]
                                   (.focus svg)
-                                  (when (not= path selected) (select! ctx path))
+                                  (cond
-                                  (when path
+                                    (and (.-shiftKey event) path)
+                                    (when-let [address (address-for ctx path)]
+                                      (rf/dispatch [::ui/toggle-selection address]))
+
+                                    path
+                                    (when-not (contains? selected-paths path) (select! ctx path))
+
+                                    :else
+                                    (do (.setPointerCapture svg (.-pointerId event))
+                                        (reset! marquee {:p0 p :p p :more? (.-shiftKey event)})))
+                                  (when (and path (not (.-shiftKey event)))
                                     (.setPointerCapture svg (.-pointerId event))
-                                    (begin! ctx :move path p)))))
+                                    (if (and (> (count placements) 1) (contains? selected-paths path))
+                                      (begin-many! ctx :move placements p)
+                                      (begin! ctx :move path p))))))
            :on-double-click (fn [^js event]
                               (when-not drawing?
                                 (let [p (xy (.-currentTarget event) event w h)
@@ -318,19 +414,38 @@
                                 (rf/dispatch [::paint-events/set-vertex
                                               sid node key-frame vertex
                                               (through inv (stage-point event w h))])
-                                (when @gesture
+                                (let [p (xy (.-currentTarget event) event w h)]
-                                  (drag! (xy (.-currentTarget event) event w h) event))))
+                                  (if @marquee
-           :on-pointer-up     (fn [_] (reset! dragging nil) (let-go! true))
+                                    (swap! marquee assoc :p p)
-           :on-pointer-cancel (fn [_] (reset! dragging nil) (let-go! false))}
+                                    (when @gesture (drag! p event))))))
+           :on-pointer-up     (fn [_]
+                                (reset! dragging nil)
+                                (if-let [{:keys [p0 p more?]} @marquee]
+                                  (let [depth (or (some-> selected count) 1)
+                                        paths (player/in-rect [(first p0) (second p0)
+                                                               (first p) (second p)] depth)
+                                        addresses (into [] (keep #(address-for ctx %)) paths)
+                                        old (if more? selections [])]
+                                    (reset! marquee nil)
+                                    (rf/dispatch [::ui/select-many (into old addresses)]))
+                                  (let-go! true)))
+           :on-pointer-cancel (fn [_]
+                                (reset! dragging nil) (reset! marquee nil) (let-go! false))}
      [ghost]
      (when (seq draft)
        [:polyline {:points (points-text draft) :fill "none"
                    :stroke "#d0ba86" :stroke-width 1}])
+     (when mark
+       (let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]]
+         [:rect.marquee {:x (min x0 x1) :y (min y0 y1)
+                         :width (js/Math.abs (- x1 x0))
+                         :height (js/Math.abs (- y1 y0))}]))
      ;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land"
      ;; is the question the outline exists to answer, and the moment it is being
      ;; asked is mid-draft.
      (when-not points? [aim-box])
-     (when-not (or drawing? points?) [handles ctx])
+     (when-not (or drawing? points?)
+       (if (> (count placements) 1) [group-handles ctx placements] [handles ctx]))
      (when (and id pts (not drawing?) (not (channel/nothing? pts)))
        [:g
         [:polygon {:points (points-text pts) :fill "none"

frontend/src/arthur/ui/timeline.cljs

@@ -43,9 +43,16 @@
 ;; ---------------------------------------------------------------------------
 ;; the rows
 
+(defn- time->parent
+  "The inverse of a time map: where one of its output frames sits in its input."
+  [{:keys [at rate]}]
+  (if (and (zero? at) (= 1 rate))
+    identity
+    (fn [f] (+ at (/ f rate)))))
+
 (defn- local->parent
-  "The inverse of a node's time map: where a frame of its OWN time sits in the
+  "Where a frame of a node's OWN time sits in the symbol it lives in.
-  symbol it lives in. See `node/time-of`.
+  See `node/time-of`.
 
   Two frame spaces meet at every node and mixing them up is the bug this exists
   to prevent: a placement `:at 48` whose scale is keyed at 0 has that key on
@@ -56,10 +63,7 @@
   frame the exposure grid never samples is still authored on that frame, and that
   is where the row should show it."
   [n]
-  (let [{:keys [at rate]} (node/time-of n)]
+  (time->parent (node/time-of n)))
-    (if (and (zero? at) (= 1 rate))
-      identity
-      (fn [f] (+ at (/ f rate))))))
 
 (defn- keyed-frames [ch] (some-> (:keys ch) keys sort))
 
@@ -131,8 +135,8 @@
             ;; the key positions, and the bars that would imply them. Refuse
             ;; rather than guess, without refusing the whole subtree.
             (when-let [source (and (= :instance (:kind n)) (node/source n))]
-              (if-let [{:keys [at rate]} (clip/source-time clip sid n)]
+              (if-let [source-time (clip/source-time clip sid n)]
-                (walk source path depth (comp self #(+ at (/ % rate))))
+                (walk source path depth (comp self (time->parent source-time)))
                 (mapv (fn [row]
                         (-> row
                             (assoc :keys [] :unmapped? true)
@@ -244,6 +248,13 @@
                              self     (comp parent-map (local->parent n))
                              source-sym (when (= :instance (:kind n))
                                           (clip/symbol clip (node/source n)))
+                             ;; `self` maps the instance's local clock. Rows of
+                             ;; the symbol it places use its source clock too,
+                             ;; including the native-FPS ratio.
+                             source-self (if-let [t (and source-sym
+                                                         (clip/source-time clip sid n))]
+                                           (comp self (time->parent t))
+                                           self)
                              lane?    (symbol/lane? source-sym)
                              clips    (when lane? (symbol/children (:nodes source-sym)))
                              span     (mapv parent-map
@@ -283,13 +294,13 @@
                                                        :label (or (get-in clip [:symbols (node/source child) :name])
                                                                   (some-> (node/source child) name))
                                                        :source (node/source child)
-                                                       :span (mapv self (node/placed-span child))
+                                                       :span (mapv source-self (node/placed-span child))
                                                        ;; The clip's own keys, on the
                                                        ;; block, so a collapsed lane
                                                        ;; still says where it changes.
                                                        :keys (into []
                                                                    (comp (mapcat keyed-frames)
-                                                                         (map (comp self (local->parent child)))
+                                                                         (map (comp source-self (local->parent child)))
                                                                          (distinct))
                                                                    (vals (node/channels child)))
                                                        :select [:node (node/source n) (:id child)
@@ -302,7 +313,7 @@
                                             ;; The one clip an expanded lane opens.
                                             (into (when lane?
                                                     (if-let [child (first (filter #(under? (conj rpath (:id %))) clips))]
-                                                      (portal (node/source n) rpath (inc depth) self child)
+                                                      (portal (node/source n) rpath (inc depth) source-self child)
                                                       [{:path (conj rpath ::portal)
                                                         :depth (inc depth)
                                                         :kind :hint
@@ -587,7 +598,6 @@
                                    (if (= :instance node-kind) " drop-into" " drop-group"))))
                    :style {:padding-left (str (+ 4 (* 11 depth)) "px")}
                    :title label
-                   :tab-index (when lane? 0)
                    :ref (when (and select (= select selection)) (reveal selection))
                    ;; A LABEL AIMS. Clicking a row's name says "I am working
                    ;; here", which is a statement about a place in the document;
@@ -597,13 +607,8 @@
                    :on-click #(when select (rf/dispatch [::ui/aim select]))
                    ;; An instance's row opens the symbol it places, as a tab.
                    :on-double-click (fn [^js e]
-                                      (cond lane? (do (.stopPropagation e) (begin-rename!))
+                                      (when of
-                                            of (rf/dispatch [::pb/open-symbol of])))
+                                        (rf/dispatch [::pb/open-symbol of])))}
-                   :on-key-down (when lane?
-                                  (fn [^js e]
-                                    (when (= "F2" (.-key e))
-                                      (.preventDefault e)
-                                      (begin-rename!))))}
             ;; A node's row can be dragged onto another: onto an instance's, to
             ;; go inside the symbol it places; onto any other node's, to be
             ;; grouped with it into a new one; onto an edge of either, to be
@@ -667,7 +672,7 @@
        node?  [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))])
      (when lane?
        [:button.tl-rename
-        {:title "rename lane (F2)"
+        {:title "rename lane"
          :on-click (fn [^js e] (.stopPropagation e) (begin-rename!))}
         "✎"])
      ;; A face's row is where its own footage is switched on, next to solo
@@ -734,10 +739,22 @@
                                              (not= (:select under) (:selection drag)))
                                     under)
                             [target-el target] (when (and drag (not shift?)) (lane-under e))
-                            landing? (some? target)
+                            target-at (when target
+                                        (frame-under e frames target-el))
+                            ;; A cel moved on its OWN lane is a normal slide.
+                            ;; Resolve the row under the pointer before calling
+                            ;; it a transfer: comparing the displayed rows is
+                            ;; not enough when the lane is reached through an
+                            ;; instance.  This leaves one slide gesture and one
+                            ;; coordinate conversion; lane overlap trimming is
+                            ;; the domain command's only additional policy.
+                            target-sid (when target
+                                         (:sid (ui/drop-destination-at
+                                                clip store open target-at target)))
+                            landing? (and target-sid
+                                          (not= target-sid (nth (:selection drag) 1)))
                             target-frame (when landing?
-                                           (max 0 (- (frame-under e frames target-el)
+                                           (max 0 (- target-at (:grab drag))))]
-                                                     (:grab drag))))]
                         (when (and drag hint)
                           (reset! hint
                                   {:x (.-clientX e) :y (.-clientY e)
@@ -1051,8 +1068,11 @@
           visible   (cond-> (vec picture)
                       (seq sounds) (-> (conj {:path [::sounds] :kind :section :label "audio"})
                                        (into sounds)))
-          ;; Roughly ten labels, on a round number of frames.
+          ;; Major marks are whole seconds in the OPEN symbol's clock. On long
-          step      (* 10 (js/Math.ceil (/ frames 100)))
+          ;; timelines use a whole-number multiple of a second to keep roughly
+          ;; ten labels; never invent an FPS-blind 20/40/60 ruler.
+          fps       (max 1 (or (clip/fps clip open) 1))
+          step      (* fps (max 1 (js/Math.ceil (/ frames (* fps 10)))))
           ;; THE OTHER DIRECTION, AND THE ONLY PLACE THIS PANE GOES THERE. The
           ;; ruler is in the open symbol's frames and the transport counts output
           ;; frames, so scrubbing names a mark and seeks to the output frame that
@@ -1063,9 +1083,19 @@
       [:section.pane.time
        [transport]
        [:div.tl-body
+        ;; Blank timeline space means the open symbol. Use the same `aim`
+        ;; gesture as its breadcrumb so both the visible selection and the
+        ;; drawing destination return to the root. Child controls stop their
+        ;; own events; the target check keeps ordinary row/bar clicks local.
+        {:on-click (fn [^js e]
+                     (when (= (.-target e) (.-currentTarget e))
+                       (rf/dispatch [::ui/aim nil])))}
         [:div.tl-labels
          ;; Empty label space takes a row back out to the top of the open symbol.
-         {:on-drag-over (fn [^js e]
+         {:on-click (fn [^js e]
+                      (when (= (.-target e) (.-currentTarget e))
+                        (rf/dispatch [::ui/aim nil])))
+          :on-drag-over (fn [^js e]
                           (when (drag/row)
                             (.preventDefault e)
                             (set! (.. e -dataTransfer -dropEffect) "move")))
@@ -1083,7 +1113,10 @@
                                [label-cell row selection target over solo tracing renaming draft])
                     {:key (str (:path row))})))]
         [:div.tl-tracks
-         {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
+         {:on-click (fn [^js e]
+                      (when (= (.-target e) (.-currentTarget e))
+                        (rf/dispatch [::ui/aim nil])))
+          :on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
           :on-drag-over (fn [^js e]
                           (when (drag/accepts?)
                             (.preventDefault e)
@@ -1105,10 +1138,10 @@
           :on-drop (fn [^js e]
                      (.preventDefault e)
                      (drag/land! (frame-at e frames) nil))
-          ;; Five frames as a percentage of the whole span, handed to the
+          ;; The rows and ruler share this exact major interval. Keeping a
-          ;; stylesheet so the frame grid can be a repeating background instead
+          ;; second, hard-coded five-frame grid here made its lines disagree
-          ;; of a div per frame. A 900-frame take is 900 elements nobody needs.
+          ;; with the numbered marks whenever the symbol's FPS changed.
-          :style {"--tick" (str (* 100 (/ 5 frames)) "%")}}
+          :style {"--tick" (str (* 100 (/ step frames)) "%")}}
          [:div.tl-ruler
           {:on-pointer-down (fn [^js e]
                               (rf/dispatch [::pb/seek (seek-to e frames)])

frontend/test/arthur/domain/cadence_test.cljs

@@ -45,6 +45,36 @@
     (is (= 3 (clip/first-output-frame doc :main 7)))
     (is (= [0 60] (:span (first (timeline/rows doc :main #{})))))))
 
+(deftest changing-fps-before-authoring-moves-the-empty-canvas-to-that-grid
+  (let [doc (clip/set-fps (clip/blank) 12)]
+    (is (= 12 (:fps doc)))
+    (is (nil? (get-in doc [:symbols :main :fps])))
+    (is (= 48 (clip/frames doc :main)))
+    (is (= 48 (clip/output-frames doc :main)))
+    (is (= 8 (clip/shown-frame doc :main 8)))
+    (is (= 8 (clip/first-output-frame doc :main 8)))))
+
+(deftest changing-fps-after-authoring-preserves-the-symbols-native-grid
+  (let [started (assoc-in (clip/blank) [:symbols :main :nodes :mark]
+                          {:id :mark :kind :rect :z "a"})
+        doc (clip/set-fps started 12)]
+    (is (= 30 (get-in doc [:symbols :main :fps])))
+    (is (= 120 (clip/frames doc :main)))
+    (is (= 48 (clip/output-frames doc :main)))))
+
+(deftest project-fps-is-the-root-symbols-editing-grid
+  (let [doc (-> (clip/blank)
+                (assoc-in [:symbols :main :nodes :child]
+                          {:id :child :kind :instance :z "a"
+                           :source {:symbol :nested}})
+                (assoc-in [:symbols :nested]
+                          {:id :nested :fps 30 :frames 90 :nodes {}})
+                (clip/set-root-fps 12))]
+    (is (= 12 (:fps doc)) "the output grid")
+    (is (= 12 (clip/fps doc :main)) "is also the root editing grid")
+    (is (= 30 (clip/fps doc :nested)) "while a nested symbol keeps its own grid")
+    (is (= 120 (clip/frames doc :main)) "frame positions are not rewritten")))
+
 (deftest crossing-to-the-output-grid-and-back-lands-on-the-frame-it-names
   ;; `first-output-frame` is the inverse of `shown-frame` as far as a floor has
   ;; one: seeking to the output frame it names puts the playhead on a frame at or

frontend/test/arthur/domain/gesture_test.cljs

@@ -274,6 +274,22 @@
   (is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
   (is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]} :hold)}}))))
 
+(deftest moving-a-measured-part-adds-an-authored-offset
+  (let [key "measured-position"
+        st {key {:data (js/Float32Array. #js [1 2 2 3])}}
+        measured {:animated? true :dense {:store key :offset 0 :stride 2 :frames 2}}
+        c (-> (clip/blank)
+              (paint/new-shape :main :brow 0 [0 0 10 0 5 3] :brow)
+              (assoc-in [:symbols :main :nodes :brow :channels [:xform :pos]] measured))
+        once (gesture/apply-values c :main :brow 0 {[:xform :pos] [4 6]} false st)
+        twice (gesture/apply-values once :main :brow 0 {[:xform :pos] [5 8]} false st)
+        pos #(get-in % [:symbols :main :nodes :brow :channels [:xform :pos]])]
+    (is (= (:dense measured) (:dense (pos twice))) "the measured base survives")
+    (is (= [5 8] (ch/value-at (pos twice) 0 st)) "the brow lands under the pointer")
+    (is (= [6 9] (ch/value-at (pos twice) 1 st))
+        "its measured motion continues underneath the authored offset")
+    (is (= 1 (count (:over (pos twice)))) "repeated drags update one correction layer")))
+
 (deftest a-click-selects-the-level-figma-would
   (let [hit [:a :b :c :shape]]
     (testing "choose"
@@ -297,6 +313,18 @@
     (is (= [:dot] (pick/hit ops [52.5 50])) "a few-pixel shape can be missed by a little")
     (is (nil? (pick/hit ops [30 30])))))
 
+(deftest a-marquee-selects-visible-objects-at-one-depth
+  (let [sq  (fn [path x0] {:kind :poly :node path :n 4
+                            :pts (js/Float64Array.
+                                  #js [x0 0 (+ x0 10) 0 (+ x0 10) 10 x0 10])})
+        ops [(sq [:left :inside] 0) (sq [:right :inside] 20) (sq [:away] 80)]]
+    (is (= [[:left] [:right]] (pick/in-rect ops [-2 -2 35 12] 1))
+        "a fresh marquee chooses objects in the open symbol")
+    (is (= [[:left :inside] [:right :inside]] (pick/in-rect ops [-2 -2 35 12] 2))
+        "an existing deep selection keeps the marquee at that depth")
+    (is (= [[:left]] (pick/in-rect ops [5 5 6 6] 1))
+        "intersection, rather than full containment, makes small objects selectable")))
+
 (deftest an-instances-box-is-what-its-symbol-draws
   (let [c (two-down)
         {:keys [frame]} (nest/placement c nil :main [u v] 16)]

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)))))

frontend/test/arthur/domain/nest_test.cljs

@@ -356,3 +356,15 @@
     (is (= [22 23] (node/placed-span (get-in slid [:symbols :lane :nodes :b]))))
     (is (= 1 (:rate (get-in slid [:symbols :lane :nodes :b :time])))
         "and the rest of its map is still there")))
+
+(deftest sliding-in-a-lane-claims-overlapped-time
+  ;; The gesture is `nest/slide` in both display modes.  Lane mode contributes
+  ;; only the placement rule at commit: the moved cel replaces what it covers.
+  (let [c (on-twos)
+        r (nest/slide c :lane [:b] -14)
+        slid (:clip r)]
+    (is (nil? (:refused r)) (:refused r))
+    (is (= [5 6] (node/placed-span (get-in slid [:symbols :lane :nodes :b]))))
+    (is (nil? (get-in slid [:symbols :lane :nodes :a]))
+        "a fully covered neighbor is removed")
+    (is (empty? (clip/problems slid)))))

frontend/test/arthur/events/lane_test.cljs

@@ -3,6 +3,7 @@
             [arthur.domain.clip :as clip]
             [arthur.domain.history :as history]
             [arthur.domain.leaf :as leaf]
+            [arthur.domain.node :as node]
             [arthur.domain.sequence-test :as fixture]
             [arthur.domain.span :as span]
             [arthur.events.ui :as ui]
@@ -16,20 +17,41 @@
             (let [doc (clip/blank)
                   id (store/install! {:clip doc :store {}} key)]
               (reset! rf-db/app-db {:clip/current id :paint/revision 0
-                                    :ui {:open :main} :playback {:frame 0}})
+                                    :ui {:open :main} :playback {:frame 6}})
               (rf/dispatch-sync event)
               (let [db @rf-db/app-db
                     saved (:clip (store/entry id))
                     [_ _ instance-id] (get-in db [:ui :selection])
                     sid (get-in saved [:symbols :main :nodes instance-id :source :symbol])]
-                {:db db :symbol (clip/symbol saved sid)})))]
+                {:db db :document saved :instance-id instance-id
+                 :symbol (clip/symbol saved sid)})))]
     (let [{ordinary :symbol} (run [::ui/new-symbol :inside] "explicit-symbol")
-          {lane :symbol lane-db :db} (run [::ui/new-lane] "explicit-lane")]
+          {lane :symbol lane-db :db document :document instance-id :instance-id}
+          (run [::ui/new-lane] "explicit-lane")]
       (is (nil? (:display ordinary)) "new symbol means ordinary symbol")
       (is (= :lane (:display lane)) "only the lane command creates a lane")
+      (is (= [0 (clip/frames document :main)]
+             (node/placed-span (get-in document [:symbols :main :nodes instance-id])))
+          "a lane exists across the open symbol, independent of the playhead")
+      (let [longer (assoc-in document [:symbols :main :frames] 300)
+            fitted (:clip (span/finish longer :main
+                                       (get-in longer [:symbols :main :nodes])
+                                       nil :keep))
+            lane-id (node/source (get-in fitted [:symbols :main :nodes instance-id]))]
+        (is (= [0 300]
+               (node/placed-span (get-in fitted [:symbols :main :nodes instance-id])))
+            "the lane follows a later change to its parent's extent")
+        (is (= 300 (clip/frames fitted lane-id))))
       (is (some? (get-in lane-db [:ui :target]))
           "the new lane is aimed so drawing and pool drops can go into it"))))
 
+(deftest aiming-the-root-clears-selection-and-drawing-target
+  (let [db {:ui {:selection [:node :main :shape [:lane :shape]]
+                 :target {:sid :main :id :lane :path [:lane]}}}
+        after (ui/aimed db nil)]
+    (is (nil? (get-in after [:ui :selection])))
+    (is (nil? (get-in after [:ui :target])))))
+
 (deftest an-explicit-lane-is-one-row-of-clips
   (let [doc (fixture/document)
         rows (timeline/rows doc :main #{})
@@ -41,6 +63,29 @@
             [:node :main :insert [:insert]]]
            (mapv :select (:cels lane))))))
 
+(deftest a-nested-lane-is-drawn-in-the-open-symbols-frame-rate
+  (let [child {:id :cel :kind :instance :z "a" :span [0 2]
+               :time {:at 4 :rate 1}
+               :source {:symbol :drawing}
+               :playback {:in 0 :speed 0 :end :stop}}
+        placed {:id :take :kind :instance :z "a" :span [0 12]
+                :time {:at 0 :rate 1}
+                :source {:symbol :lane}
+                :playback {:in 0 :speed 1 :end :stop}}
+        doc (-> (clip/blank)
+                (assoc :fps 12)
+                (assoc-in [:symbols :main :fps] 12)
+                (assoc-in [:symbols :main :frames] 12)
+                (assoc-in [:symbols :main :nodes] {:take placed})
+                (assoc-in [:symbols :lane]
+                          {:id :lane :fps 24 :frames 24 :display :lane
+                           :nodes {:cel child}})
+                (assoc-in [:symbols :drawing]
+                          {:id :drawing :fps 24 :frames 1 :nodes {}}))
+        lane (first (filter :lane? (timeline/rows doc :main #{})))]
+    (is (= [[2 3]] (mapv :span (:cels lane)))
+        "native frames 4–6 occupy ruler frames 2–3 at twice the frame rate")))
+
 (deftest an-ordinary-symbol-keeps-a-row-per-node
   (let [doc (update-in (fixture/document) [:symbols :main] dissoc :display)
         rows (timeline/rows doc :main #{})]
@@ -137,6 +182,14 @@
     (is (empty? (get-in after [:ui :expanded]))
         "and there are no rows above the top to open")))
 
+(deftest a-primary-selection-also-starts-the-stage-selection-set
+  (let [doc (fixture/document)
+        id (store/install! {:clip doc :store {}} "primary-stage-selection")
+        address [:node :main :insert [:insert]]
+        after (ui/selected {:clip/current id :ui {}} address)]
+    (is (= address (get-in after [:ui :selection])))
+    (is (= [address] (get-in after [:ui :selections])))))
+
 (deftest finishing-a-polygon-opens-no-rows
   ;; Expansion is the twist triangle's business. Finishing a shape used to open
   ;; every row down to it, which inside a lane meant tearing its one row into a

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". */
@@ -1026,10 +1029,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
   min-width: max(340px, calc((100% - var(--label)) * var(--tl-zoom, 1)));
   position: relative;
   background: #fff;
-  /* The frame grid, five frames to a division, as a background rather than as
+  /* The major frame grid, using the same whole-second interval as the numbered
-     an element per frame: a 900-frame take is 900 divs nobody needs in the DOM.
+     ruler. It is a background rather than an element per mark; `--tick` is set
-     `--tick` is five frames as a percentage of the span, set from the component
+     by the component because only it knows the open symbol's length and FPS. */
-     because only it knows how long the clip is. */
   background-image:
     repeating-linear-gradient(90deg,
       var(--grid-5) 0 1px, transparent 1px var(--tick, 10%));
@@ -1378,6 +1380,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 .paint-overlay .handles .knob { fill: #161820; stroke: #fff1be; stroke-width: 0.6; cursor: grab; }
 .paint-overlay .handles .corner { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: nwse-resize; }
 .paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; }
+.paint-overlay .marquee { fill: rgba(230, 202, 139, 0.12); stroke: #e6ca8b; stroke-width: 0.6; stroke-dasharray: 2 1; pointer-events: none; }
 
 /* The aim outline and its name tag. Solid, no handles, and a tag pinned just
    outside the bottom-right corner — see `ui/stage/aim-box` for why the box