Unify lane symbol creation and palette automation

frontend/src/arthur/domain/channel.cljs

@@ -364,7 +364,11 @@
           ;; Palette-choice channels interpolate identities into a blend
           ;; descriptor. The renderer keeps indexed geometry in the left
           ;; palette's bank and blends that bank's ramp toward the right one.
-          (and (= :palette (:semantic ch)) (keyword? a) (keyword? b))
+          ;; Palette ids are opaque identities. Built-ins happen to use
+          ;; keywords, while palettes made in the editor use UUIDs; treating
+          ;; the latter as numbers produces NaN and therefore the renderer's
+          ;; pink bad-data sentinel.
+          (and (= :palette (:semantic ch)) (some? a) (some? b))
           {:from a :to b :t t}
           (vector? a)
           (mapv (fn [x y] (+ x (* t (- y x)))) a b)
@@ -520,7 +524,7 @@
   (let [values (when (map? (:keys ch)) (vals (:keys ch)))
         first-value (first values)
         linear-values? (or (every? number? values)
-                           (and (= :palette (:semantic ch)) (every? keyword? values))
+                           (and (= :palette (:semantic ch)) (every? some? values))
                            (and (vector? first-value)
                                 (pos? (count first-value))
                                 (every? (fn [v] (and (vector? v)

frontend/src/arthur/domain/clip.cljs

@@ -264,7 +264,16 @@
               ;; A palette track has meaningful uncovered time. Ordinary held
               ;; channels clamp to their first key before it, but doing that
               ;; here would erase the gap before the first palette segment.
-              (let [track (:palette-channel owner)
+              (let [fallback (or (channel-value (:palette owner) frame)
+                                 inherited (:default palette))
+                    materialize (fn [choice]
+                                  (cond
+                                    (= pal/inherit choice) fallback
+                                    (map? choice) (-> choice
+                                                      (update :from #(if (= pal/inherit %) fallback %))
+                                                      (update :to #(if (= pal/inherit %) fallback %)))
+                                    :else choice))
+                    track (:palette-channel owner)
                     track-value (if-let [ks (:keys track)]
                                   (some->> (keys ks)
                                            (filter #(<= % frame))
@@ -286,12 +295,10 @@
                             choice (get-in palette-clip [:channels [:palette]])
                             start (some-> palette-clip node/placed-span first)]
                         (or (when (and choice start)
-                              (channel-value choice (- frame start)))
+                              (materialize (channel-value choice (- frame start))))
                             fallback)))
                     track-value
-                  (channel-value (:palette owner) frame)
+                  fallback)))
-                  inherited
-                  (:default palette))))
             (selection-at [owner frame inherited]
               (let [selection (:palette owner)
                     chosen (cond

frontend/src/arthur/domain/palette.cljs

@@ -7,6 +7,7 @@
   are derived, never persisted: adding a palette never rewrites drawing data.")
 
 (def default-id :arthur/default)
+(def inherit :arthur.palette/inherit)
 
 (def entries
   [{:name :bg         :hex "#12141c"}

frontend/src/arthur/domain/symbol.cljs

@@ -730,9 +730,7 @@
       (-> []
           (cond->
             (and (= :palette (:type sym)) (seq nodes))
-            (conj "a palette symbol cannot contain nodes")
+            (conj "a palette symbol cannot contain nodes"))
-            (and (= :palette (:type sym)) (nil? (:palette-ref sym)))
-            (conj "a palette symbol must point at a palette"))
           (into (for [[id n] nodes
                       :when  (not= id (:id n))]
                   (str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))

frontend/src/arthur/events/project.cljs

@@ -729,50 +729,6 @@
                     (assoc-in % [:symbols sid :palette] id)
                     (update-in % [:symbols sid] dissoc :palette)))))
 
-(rf/reg-event-db
- ::drop-palette
- (fn [db [_ root-sid frame palette-id]]
-   (let [{document :clip st :store} (store/entry (:clip/current db))
-         root (clip/symbol document root-sid)
-         old-track (:palette-track root)
-         track-id (if (= :palette-track (get-in document [:symbols old-track :type]))
-                    old-track (clip/fresh-id document))
-         palette-sid (or (some (fn [[sid sym]]
-                                 (when (and (= :palette (:type sym))
-                                            (= palette-id (:palette-ref sym))) sid))
-                               (:symbols document))
-                         (clip/fresh-id (cond-> document
-                                          (not= track-id old-track)
-                                          (assoc-in [:symbols track-id] {}))))
-         document (cond-> (if (= track-id old-track)
-                            document
-                            (-> document
-                                (assoc-in [:symbols root-sid :palette-track] track-id)
-                                (assoc-in [:symbols track-id]
-                                          {:id track-id :name "palette" :type :palette-track
-                                           :display :lane :frames (:frames root)
-                                           :fps (clip/fps document root-sid) :nodes {}})))
-                    (nil? (clip/symbol document palette-sid))
-                    (assoc-in [:symbols palette-sid]
-                              {:id palette-sid
-                               :name (or (get-in document [:palettes palette-id :name])
-                                         (name palette-id))
-                               :type :palette :palette-ref palette-id
-                               :frames 1 :fps (clip/fps document root-sid) :nodes {}}))
-         id (random-uuid)
-         result (span/place-symbol document st track-id id palette-sid frame
-                                   {:extent :grow-symbol :remainder-id (random-uuid)})
-         result (if-let [placed (:clip result)]
-                  (assoc result :clip
-                         (assoc-in placed [:symbols track-id :nodes id :channels [:palette]]
-                                   (assoc (ch/framed palette-id) :semantic :palette)))
-                  result)]
-     (if-let [why (:refused result)]
-       (update db :project merge {:status why})
-       (-> db
-           (edit/edit (constantly (:clip result)))
-           (assoc-in [:ui :selection] [:node track-id id [id]]))))))
-
 (rf/reg-event-db
  ::set-channel
  ;; `frame` is the node's own, as for a drawing key.
@@ -784,7 +740,7 @@
   (if (get-in document [:symbols sid :nodes id :channels [:palette]])
     document
     (let [source (get-in document [:symbols sid :nodes id :source :symbol])
-          palette-id (get-in document [:symbols source :palette-ref])]
+          palette-id (or (get-in document [:symbols source :palette-ref]) pal/inherit)]
       (assoc-in document [:symbols sid :nodes id :channels [:palette]]
                 (assoc (ch/framed palette-id) :semantic :palette)))))
 

frontend/src/arthur/events/ui.cljs

@@ -17,12 +17,14 @@
   app to change and the most expensive to have two copies of."
   (:require [clojure.string :as str]
             [arthur.domain.clip :as clip]
+            [arthur.domain.channel :as ch]
             [arthur.domain.clipboard :as clipboard]
             [arthur.domain.correction :as correction]
             [arthur.domain.creation :as creation]
             [arthur.domain.gesture :as gesture]
             [arthur.domain.nest :as nest]
             [arthur.domain.node :as node]
+            [arthur.domain.palette :as pal]
             [arthur.domain.span :as span]
             [arthur.events.edit :as edit]
             [arthur.domain.paint :as paint]
@@ -793,6 +795,52 @@
         (edit/transaction (constantly (:clip result)))
         (selected [:node sid uuid (conj (vec path) uuid)]))))
 
+(rf/reg-event-db
+ ::new-symbol-at
+ ;; One gesture and one creation path for every lane. The destination decides
+ ;; the kind: an ordinary lane gets a blank symbol; the synthetic palette row
+ ;; gets a blank palette symbol whose placement starts by inheriting.
+ (fn [db [_ frame target]]
+   (let [{document :clip st :store} (store/entry (:clip/current db))
+         palette? (= :arthur.ui.timeline/palette-track (first target))
+         root-sid (second target)
+         root (when palette? (clip/symbol document root-sid))
+         old-track (:palette-track root)
+         track-id (when palette?
+                    (if (= :palette-track (get-in document [:symbols old-track :type]))
+                      old-track (clip/fresh-id document)))
+         document (if (and palette? (not= track-id old-track))
+                    (-> document
+                        (assoc-in [:symbols root-sid :palette-track] track-id)
+                        (assoc-in [:symbols track-id]
+                                  {:id track-id :name "palette" :type :palette-track
+                                   :display :lane :frames (:frames root)
+                                   :fps (clip/fps document root-sid) :nodes {}}))
+                    document)
+         where (if palette?
+                 {:clip document :sid track-id :at frame :path []}
+                 (drop-destination db document st frame target))
+         sid (clip/fresh-id document)
+         uuid (random-uuid)]
+     (if (:refused where)
+       (update db :project merge {:status (:refused where)})
+       (let [seeded (assoc-in document [:symbols sid]
+                              (cond-> {:id sid
+                                       :name (if palette? "palette transition" (name sid))
+                                       :fps (clip/fps document (:sid where))
+                                       :frames 1 :nodes {}}
+                                palette? (assoc :type :palette)))
+             result (span/place-symbol seeded st (:sid where) uuid sid (:at where)
+                                       {:extent :grow-symbol
+                                        :remainder-id (random-uuid)})
+             result (if-let [placed (and palette? (:clip result))]
+                      (assoc result :clip
+                             (assoc-in placed [:symbols (:sid where) :nodes uuid
+                                               :channels [:palette]]
+                                       (assoc (ch/framed pal/inherit) :semantic :palette)))
+                      result)]
+         (landed db where uuid result))))))
+
 (rf/reg-event-db
  ::drop-symbol
  ;; A symbol dropped on a row becomes a naturally playing clip in the symbol that

frontend/src/arthur/ui/drag.cljs

@@ -47,13 +47,6 @@
                              :center (clip/center document st sid)
                              :shapes (outline document st sid)}))))
 
-(defn palette!
-  "Start carrying a project palette toward the open symbol's palette track."
-  [id label]
-  (reset! carrying {:kind :palette :palette id :label label :frames 1}))
-
-(defn palette? [] (= :palette (:kind @carrying)))
-
 (defn accepts?
   "Whether the stage or the tracks should accept what is being carried: things
   out of the pool, and not one that would make a cycle."
@@ -127,10 +120,3 @@
       :sound   (rf/dispatch [::ui/drop-sound c frame target])
       nil))
   (done!)))
-
-(defn land-palette!
-  "Put the carried palette on `sid`'s palette track at `frame`."
-  [sid frame]
-  (when-let [{:keys [palette]} (when (palette?) @carrying)]
-    (rf/dispatch [::project/drop-palette sid frame palette]))
-  (done!))

frontend/src/arthur/ui/params.cljs

@@ -268,12 +268,15 @@
                       :title (if (:keys ch) (str (count (:keys ch)) " keys") "key this here")
                       :on-click #(rf/dispatch [::project/toggle-palette-key sid id frame])}
          "◆"]
-        [:select {:value (str chosen)
+        [:select {:value (if (= pal/inherit chosen) "" (str chosen))
                   :on-change
                   (fn [e]
                     (let [v (.. e -target -value)
-                          palette-id (first (filter #(= v (str %)) (keys (pal/palettes clip))))]
+                          palette-id (or (first (filter #(= v (str %))
+                                                       (keys (pal/palettes clip))))
+                                         pal/inherit)]
                       (rf/dispatch [::project/set-palette-choice sid id frame palette-id])))}
+         [:option {:value ""} "inherit"]
          (for [[palette-id p] palettes]
            ^{:key (str palette-id)}
            [:option {:value (str palette-id)} (:name p)])]]]
@@ -735,7 +738,8 @@
         ;; showing now would move the section under the playhead.
         placed    (node/source (peek node))
         palette-placement? (and node
-                                (= :palette (get-in clip [:symbols placed :type])))
+                                (= :palette-track
+                                   (get-in clip [:symbols (first node) :type])))
         palette-symbol? (and (= :symbol (first selection))
                              (= :palette (get-in clip [:symbols (second selection) :type])))
         face      (or placed (when (trace/traceable? clip open) open))

frontend/src/arthur/ui/pool.cljs

@@ -271,25 +271,6 @@
                 (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 (merge {:label (:name p)
-        :sub (str (count (:slots p)) " colors")
-        :title (str (:name p) " · " (count (:slots p))
-                    " indexed colors — drag onto the palette track")
-        :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])}
-       (carrying (str "palette:" id) #(drag/palette! id (:name p))))])
-
 (defn- palette-transition-row [document sid selection rename]
   (let [sym (clip/symbol document sid)
         p (get (pal/palettes document) (:palette-ref sym))]
@@ -423,7 +404,12 @@
   (let [named? #(hit? query (clip/symbol-name document %))
         top    (when (and main (named? main)) main)
         symbol-ids (sort-by str (keys (:symbols document)))
-        transition? #(= :palette (:type (clip/symbol document %)))
+        transition-ids (into #{} (mapcat (fn [sym]
+                                           (when (= :palette-track (:type sym))
+                                             (keep (comp :symbol :source val) (:nodes sym)))))
+                             (vals (:symbols document)))
+        transition? #(or (= :palette (:type (clip/symbol document %)))
+                         (contains? transition-ids %))
         transitions (filterv #(and (named? %) (transition? %)) symbol-ids)
         rest   (filterv #(and (named? %) (not= main %)
                               (not (#{:palette :palette-track}
@@ -431,11 +417,10 @@
                         symbol-ids)
         media  (filterv #(hit? query (:label %)) media)
         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 transitions)
-        (count media) (count sounds) (count palettes))
+        (count media) (count sounds))
      [{:title "project" :searching? searching?
        :blank "nothing to open yet"
        :rows (when top [(symbol-row document top ctx)])}
@@ -445,11 +430,6 @@
       {:title "palette transitions" :searching? searching?
        :blank "no palette transitions"
        :rows (mapv #(palette-transition-row document % selection rename) transitions)}
-      {: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)}

frontend/src/arthur/ui/timeline.cljs

@@ -887,30 +887,25 @@
       ;; one, else this row's own instance. It opens as a tab, which is what
       ;; double-clicking the same symbol in the pool does.
       :on-double-click (fn [^js e]
-                         (when-let [source (and (not= :palette kind)
+                         (let [under (clip-under e)]
-                                               (or (:source (clip-under e)) of))]
+                           (cond
-                           (.stopPropagation e)
+                             (and lane? (nil? under))
-                           (rf/dispatch [::pb/open-symbol source])))
+                             (do (.stopPropagation e)
+                                 (rf/dispatch [::ui/new-symbol-at
+                                               (frame-at e frames) select]))
+
+                             :else
+                             (when-let [source (or (:source under) of)]
+                               (.stopPropagation e)
+                               (rf/dispatch [::pb/open-symbol source])))))
       :ref (when lane? (fn [el] (when el (aset el "arthurLane" select))))
       :on-drag-enter (fn [^js e]
-                       ;; A palette hover belongs only to the palette row. If
-                       ;; the pointer leaves it for an ordinary row, clear its
-                       ;; last accepted preview even though this row correctly
-                       ;; declines the native drop.
-                       (when (and (drag/palette?) (not= :palette kind))
-                         (rf/dispatch [::ui/drop-clear]))
                        (cond
-                         (and (= :palette kind) (drag/palette?))
-                         (do (.preventDefault e) (.stopPropagation e))
                          (and (not= :palette kind) lane?
                               (or (drag/accepts?) (drag/row)))
                          (do (.preventDefault e) (.stopPropagation e))))
       :on-drag-over (fn [^js e]
                       (cond
-                        (and (= :palette kind) (drag/palette?))
-                        (do (.preventDefault e) (.stopPropagation e)
-                            (set! (.. e -dataTransfer -dropEffect) "copy")
-                            (drag/hover! :timeline (frame-at e frames) nil select))
                         (and (not= :palette kind) lane?
                              (or (drag/accepts?) (drag/row)))
                         (do (.preventDefault e) (.stopPropagation e)
@@ -920,10 +915,6 @@
                               (drag/hover! :timeline (frame-at e frames) nil select)))))
       :on-drop (fn [^js e]
                  (cond
-                   (and (= :palette kind) (drag/palette?))
-                   (let [at (frame-at e frames)]
-                     (.preventDefault e) (.stopPropagation e)
-                     (drag/land-palette! open at))
                    (and (not= :palette kind) lane?
                         (or (drag/accepts?) (drag/row)))
                    (do (.preventDefault e)

frontend/test/arthur/domain/channel_test.cljs

@@ -4,7 +4,8 @@
   in the renderer reads. These assert the parts of that claim that could silently
   stop being true."
   (:require [cljs.test :refer [deftest is testing]]
-            [arthur.domain.channel :as ch]))
+            [arthur.domain.channel :as ch]
+            [arthur.domain.palette :as pal]))
 
 ;; ---- the three shapes read the same way ----
 
@@ -392,6 +393,21 @@
     (is (= {:from :day :to :night :t 0.5}
            (ch/value-at blend 5 nil)))))
 
+(deftest palette-choice-channels-blend-editor-uuid-identities
+  (let [day (random-uuid)
+        night (random-uuid)
+        blend (assoc (ch/keyed {0 day 10 night} :linear) :semantic :palette)]
+    (is (empty? (ch/problems blend)))
+    (is (= {:from day :to night :t 0.5}
+           (ch/value-at blend 5 nil)))))
+
+(deftest palette-choice-channels-can-blend-from-inherit
+  (let [night (random-uuid)
+        blend (assoc (ch/keyed {0 pal/inherit 10 night} :linear) :semantic :palette)]
+    (is (empty? (ch/problems blend)))
+    (is (= {:from pal/inherit :to night :t 0.5}
+           (ch/value-at blend 5 nil)))))
+
 (deftest numeric-channels-can-ramp-between-keys
   (let [c (ch/keyed {0 0.0, 10 1.0} :linear)
         cursor (ch/cursor c nil)]

frontend/test/arthur/domain/instance_test.cljs

@@ -406,3 +406,32 @@
     (is (nil? (:refused extended)) (:refused extended))
     (is (= [0 6] (node/placed-span
                   (get-in extended [:clip :symbols :palettes :nodes :change]))))))
+
+(deftest a-blank-palette-symbol-can-tween-from-inherit-to-an-editor-palette
+  (let [day (random-uuid)
+        night (random-uuid)
+        palette (fn [id color]
+                  {:id id :name (str id) :slots [{:hex color} {:hex color}]})
+        choice (assoc (ch/keyed {0 pal/inherit 4 night} :linear) :semantic :palette)
+        document {:fps 30 :width 20 :height 20
+                  :palettes {day (palette day "#000000")
+                             night (palette night "#ffffff")}
+                  :default-palette day
+                  :symbols
+                  {:main {:id :main :frames 5 :palette day :palette-track :palettes
+                          :nodes {}}
+                   :palettes {:id :palettes :type :palette-track :display :lane :frames 5
+                              :nodes {:change {:id :change :kind :instance :z "a1"
+                                               :source {:symbol :transition}
+                                               :span [0 5] :time {:at 0}
+                                               :channels {[:palette] choice}}}}
+                   :transition {:id :transition :name "palette transition"
+                                :type :palette :frames 1 :nodes {}}}}
+        context (pal/compile document)
+        resolve (clip/resolver document :main nil context nil)]
+    (is (empty? (clip/problems document)))
+    (resolve 2)
+    (is (= {:from day :to night :t 0.5} (clip/active-palette resolve)))
+    (is (= [128 128 128]
+           (nth (pal/effective-ramp context (clip/active-palette resolve))
+                (pal/render-index context day 1))))))

frontend/test/arthur/events/lane_test.cljs

@@ -5,6 +5,7 @@
             [arthur.domain.history :as history]
             [arthur.domain.leaf :as leaf]
             [arthur.domain.node :as node]
+            [arthur.domain.palette :as pal]
             [arthur.domain.sequence-test :as fixture]
             [arthur.domain.span :as span]
             [arthur.events.ui :as ui]
@@ -71,6 +72,40 @@
                           (vals (get-in saved [:symbols :main :nodes]))))
           "claiming the frame leaves no overlapping cel"))))
 
+(deftest double-click-creation-uses-the-lane-and-pointer-frame
+  (let [doc (fixture/document)
+        id (store/install! {:clip doc :store {}} "double-click-new-symbol")]
+    (reset! rf-db/app-db {:clip/current id :paint/revision 0
+                          :ui {:open :main} :playback {:frame 0}})
+    (rf/dispatch-sync [::ui/new-symbol-at 5 [:node :main nil []]])
+    (let [saved (:clip (store/entry id))
+          [_ sid instance-id] (get-in @rf-db/app-db [:ui :selection])
+          instance (get-in saved [:symbols sid :nodes instance-id])]
+      (is (= :main sid))
+      (is (= [5 6] (node/placed-span instance)))
+      (is (= 1 (clip/frames saved (node/source instance))))
+      (is (zero? (get-in @rf-db/app-db [:playback :frame]))
+          "the pointer frame, not the playhead, chooses the new cel's time"))))
+
+(deftest the-same-double-click-command-creates-a-palette-symbol-on-the-palette-row
+  (let [doc (clip/blank)
+        id (store/install! {:clip doc :store {}} "double-click-palette-symbol")]
+    (reset! rf-db/app-db {:clip/current id :paint/revision 0
+                          :ui {:open :main} :playback {:frame 0}})
+    (rf/dispatch-sync [::ui/new-symbol-at 5
+                       [:arthur.ui.timeline/palette-track :main]])
+    (let [saved (:clip (store/entry id))
+          track-id (get-in saved [:symbols :main :palette-track])
+          [_ sid instance-id] (get-in @rf-db/app-db [:ui :selection])
+          instance (get-in saved [:symbols sid :nodes instance-id])
+          source (node/source instance)]
+      (is (= track-id sid))
+      (is (= :palette-track (get-in saved [:symbols track-id :type])))
+      (is (= :palette (get-in saved [:symbols source :type])))
+      (is (= [5 6] (node/placed-span instance)))
+      (is (= pal/inherit
+             (get-in instance [:channels [:palette] :value]))))))
+
 (deftest a-new-lane-uses-the-symbol-selected-at-the-playhead
   (let [doc (clip/blank)
         id (store/install! {:clip doc :store {}} "nested-new-lane")]