diff --git a/frontend/src/arthur/domain/channel.cljs b/frontend/src/arthur/domain/channel.cljs index 9864b41..6ce70f8 100644 --- a/frontend/src/arthur/domain/channel.cljs +++ b/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) diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index 1bc6b18..39d15a2 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/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) - inherited - (:default palette)))) + fallback))) (selection-at [owner frame inherited] (let [selection (:palette owner) chosen (cond diff --git a/frontend/src/arthur/domain/palette.cljs b/frontend/src/arthur/domain/palette.cljs index 2669fdb..ca9e6b8 100644 --- a/frontend/src/arthur/domain/palette.cljs +++ b/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"} diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 0ba6622..c407451 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -730,9 +730,7 @@ (-> [] (cond-> (and (= :palette (:type sym)) (seq 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")) + (conj "a palette symbol cannot contain nodes")) (into (for [[id n] nodes :when (not= id (:id n))] (str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index ffd743b..6838371 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/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))))) diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 724c56b..a48b1fe 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/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 diff --git a/frontend/src/arthur/ui/drag.cljs b/frontend/src/arthur/ui/drag.cljs index 530c4eb..1b50f0f 100644 --- a/frontend/src/arthur/ui/drag.cljs +++ b/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!)) diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index a1770d7..484bce7 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/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)) diff --git a/frontend/src/arthur/ui/pool.cljs b/frontend/src/arthur/ui/pool.cljs index 16b047e..5c93ba0 100644 --- a/frontend/src/arthur/ui/pool.cljs +++ b/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)} diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 5a4a22d..8c1a730 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/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) - (or (:source (clip-under e)) of))] - (.stopPropagation e) - (rf/dispatch [::pb/open-symbol source]))) + (let [under (clip-under e)] + (cond + (and lane? (nil? under)) + (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) diff --git a/frontend/test/arthur/domain/channel_test.cljs b/frontend/test/arthur/domain/channel_test.cljs index be640bb..fd3fc9d 100644 --- a/frontend/test/arthur/domain/channel_test.cljs +++ b/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)] diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index aec3c64..7323f9e 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/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)))))) diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index 42b576d..2830ee4 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/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")]