noe/arthur
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add project palette assets and overrides

Browse source
This commit is contained in:
Your Name 2026-10-02 09:08:53 -04:00
parent 8f09b7b47f
commit b41180db08
17 changed files with 470 additions and 87 deletions
Download patch file Download diff file Expand all files Collapse all files

13
clips/tests/test_api.py
View file

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

17
clips/views.py
View file

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

5
frontend/src/arthur/db.cljs
View file

@ -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 []

50
frontend/src/arthur/domain/clip.cljs
View file

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

10
frontend/src/arthur/domain/leaf.cljs
View file

@ -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))
4 (#{"subject" "feature" "group"} (nth p 2))
3 (#{"name" "timing" "stage" "source" "palette-default"} (nth p 2))
4 (#{"subject" "feature" "group" "palette"} (nth p 2))
false))))]
(vec
(concat

80
frontend/src/arthur/domain/palette.cljs
View file

@ -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
INDEX, never a sampled RGB value. Sampling colour off the footage produces a
pixel-art filter, and it does so irrecoverably — once a shape holds a measured
colour there is no way back to an authored one, because the information that it
was ever a choice is gone. Every `[:style :color]` channel holds one of the
keywords below.
Drawing data stores a dumb LOCAL SLOT NUMBER. A symbol or instance supplies
the palette context. `compile` gives project palettes disjoint ranges in the
raster index space, so differently-paletted subtrees can coexist. The ranges
are derived, never persisted: adding a palette never rewrites drawing data.")
Entries are ordered, and the order IS the index the raster writes. Inserting in
the middle renumbers every stored index, so new tones append.")
(def default-id :arthur/default)
(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)))

1
frontend/src/arthur/domain/symbol.cljs
View file

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

5
frontend/src/arthur/events/export.cljs
View file

@ -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 db) pal/index-of)
:ramp (get {:arthur/default pal/rgb} (:palette db) pal/rgb)
:palette (pal/compile (:clip entry))
:ramp (:ramp (pal/compile (:clip entry)))
:zoom zoom
:audio-url (:audio entry)
:name (stem (:label entry)

103
frontend/src/arthur/events/project.cljs
View file

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

19
frontend/src/arthur/flow/freeze.cljs
View file

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

16
frontend/src/arthur/subs/render.cljs
View file

@ -118,21 +118,13 @@
(rf/reg-sub
::palette
(fn [db _]
;; A NAME resolves to a ramp. One today; when timelines carry a `:palette`
;; 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)))
:<- [::clip]
(fn [clip _] (when clip (pal/compile clip))))
(rf/reg-sub
::ramp
(fn [db _]
;; index -> [r g b]. The other half of the palette: `::palette` says which
;; 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)))
:<- [::palette]
(fn [compiled _] (:ramp compiled)))
(rf/reg-sub
::store

28
frontend/src/arthur/subs/ui.cljs
View file

@ -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]

81
frontend/src/arthur/ui/palette.cljs
View file

@ -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
and not the data's — an indexed 320x200 picture in the Animator Pro idiom this
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.
Shapes store only the selected local slot number. Palette identity is supplied
by the symbol tree, and the colour input edits the project palette asset.
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]
(let [{slot-tone :name :keys [hex]} (get pal/entries i)
bg? (zero? i)
pick (and slot-tone (not bg?))]
[:button
{:key i
:class (str "swatch"
(when-not slot-tone " empty")
(when bg? " bg")
(when (and pick (= slot-tone tone)) " on"))
:style (when hex {:background hex})
:title (if slot-tone (str i " · " (name slot-tone) " " hex) (str i " · empty"))
:disabled (not pick)
:on-click #(rf/dispatch [::ui/set-tone slot-tone])}]))
(defn- swatch [pid i {:keys [name hex]} tone placements]
(let [picker-id (str "palette-picker-" pid "-" i)]
[:div {:key i :class "palette-slot"}
[:button {:class (str "swatch" (when (= i tone) " on"))
:style {:background hex}
:title (str i (when name (str " · " (clojure.core/name name)))
" · " hex " · double-click to edit")
:on-click #(do (rf/dispatch [::ui/set-tone i])
(let [edits (into [] (keep (fn [{:keys [sid id node frame]}]
(when (contains? (get node/valid-paths (:kind node))
[:style :color])
{:sid sid :id id :path [:style :color]
:frame frame :value i})))
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)))]
[:span.dim (name tone)]
[:select {:value (str pid)
: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)))

38
frontend/src/arthur/ui/params.cljs
View file

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

58
frontend/src/arthur/ui/pool.cljs
View file

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

30
frontend/test/arthur/domain/instance_test.cljs
View file

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

3
static/arthur/app.css
View file

@ -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". */