Compare commits

...

4 commits

Author SHA1 Message Date
Your Name
a90e0cfb61 fixed creating in 2026-10-03 02:15:27 -04:00
Your Name
2697401aad Scope inspector controls and key shape colors 2026-10-03 01:48:26 -04:00
Your Name
a834ccb1e2 Unify lane symbol creation and palette automation 2026-10-03 01:35:33 -04:00
Your Name
15deaea19e Support multiple regeneratable footage analyses 2026-10-03 01:24:45 -04:00
36 changed files with 761 additions and 342 deletions

View file

@ -18,7 +18,7 @@ class ProjectAdmin(admin.ModelAdmin):
@admin.register(Clip) @admin.register(Clip)
class ClipAdmin(admin.ModelAdmin): class ClipAdmin(admin.ModelAdmin):
list_display = ("cid", "project", "name", "footage", "analysis") list_display = ("cid", "project", "name")
list_filter = ("project",) list_filter = ("project",)

View file

@ -0,0 +1,15 @@
from django.db import migrations, models
class Migration(migrations.Migration):
dependencies = [("clips", "0013_palette_track")]
operations = [
migrations.RemoveField(model_name="clip", name="analysis"),
migrations.RemoveField(model_name="clip", name="footage"),
migrations.AlterField(
model_name="project",
name="schema_version",
field=models.PositiveIntegerField(default=5),
),
]

View file

@ -235,7 +235,7 @@ class Project(models.Model):
settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects", settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects",
) )
name = models.CharField(max_length=200, default="untitled") name = models.CharField(max_length=200, default="untitled")
schema_version = models.PositiveIntegerField(default=4) schema_version = models.PositiveIntegerField(default=5)
seq = models.PositiveBigIntegerField(default=0) seq = models.PositiveBigIntegerField(default=0)
palette = models.CharField(max_length=64, default="arthur/default") palette = models.CharField(max_length=64, default="arthur/default")
created = models.DateTimeField(auto_now_add=True) created = models.DateTimeField(auto_now_add=True)
@ -273,12 +273,6 @@ class Clip(models.Model):
cid = models.SlugField(max_length=64) cid = models.SlugField(max_length=64)
name = models.CharField(max_length=200, blank=True) name = models.CharField(max_length=200, blank=True)
order = models.IntegerField(default=0) order = models.IntegerField(default=0)
footage = models.ForeignKey(
Footage, null=True, blank=True, on_delete=models.SET_NULL, related_name="clips"
)
analysis = models.ForeignKey(
Analysis, null=True, blank=True, on_delete=models.SET_NULL, related_name="clips"
)
blocks = models.ManyToManyField( blocks = models.ManyToManyField(
Block, blank=True, related_name="clips", Block, blank=True, related_name="clips",
help_text="the tier-2 blocks this clip's channels name", help_text="the tier-2 blocks this clip's channels name",

View file

@ -396,14 +396,25 @@ class DocumentTests(TestCase):
], ],
} }
def save(self, leaves=None, blocks=None): def save(self, leaves=None, blocks=None, analyses=None):
return self.put(f"/api/projects/{self.project.id}", { return self.put(f"/api/projects/{self.project.id}", {
"name": "a project", "name": "a project",
"clips": [{"cid": "c1", "name": "take", "analysis": self.analysis, "clips": [{"cid": "c1", "name": "take",
"analyses": [self.analysis] if analyses is None else analyses,
"leaves": leaves if leaves is not None else self.leaves(), "leaves": leaves if leaves is not None else self.leaves(),
"blocks": blocks if blocks is not None else [self.block]}], "blocks": blocks if blocks is not None else [self.block]}],
}) })
def test_a_clip_declares_the_registered_analyses_its_blocks_name(self):
undeclared = self.save(analyses=[])
self.assertEqual(409, undeclared.status_code)
self.assertIn("every block", undeclared.json()["error"])
unknown = "sha256:" + "f" * 64
missing = self.save(analyses=[self.analysis, unknown])
self.assertEqual(409, missing.status_code)
self.assertEqual([unknown], missing.json()["missing"])
def test_every_saved_symbol_is_listed_across_projects(self): def test_every_saved_symbol_is_listed_across_projects(self):
leaves = self.leaves() leaves = self.leaves()
leaves["clip/c1/symbol/sym~face"] = ["^ ", "~:name", "face", "~:frames", 12] leaves["clip/c1/symbol/sym~face"] = ["^ ", "~:name", "face", "~:frames", 12]
@ -435,12 +446,12 @@ class DocumentTests(TestCase):
self.assertEqual(5, len(response.json()["written"])) self.assertEqual(5, len(response.json()["written"]))
loaded = self.client.get(f"/api/projects/{self.project.id}").json() loaded = self.client.get(f"/api/projects/{self.project.id}").json()
self.assertEqual(4, loaded["schema_version"]) self.assertEqual(5, loaded["schema_version"])
self.assertEqual(1, len(loaded["clips"])) self.assertEqual(1, len(loaded["clips"]))
clip = loaded["clips"][0] clip = loaded["clips"][0]
self.assertEqual("c1", clip["cid"]) self.assertEqual("c1", clip["cid"])
self.assertEqual([self.block], clip["blocks"]) self.assertEqual([self.block], clip["blocks"])
self.assertEqual(self.analysis, clip["analysis"]) self.assertNotIn("analysis", clip)
# The whole point: byte-identical values, including the integer frame keys # The whole point: byte-identical values, including the integer frame keys
# transit writes as "~i0". A JSON round trip that stringified them would # transit writes as "~i0". A JSON round trip that stringified them would
# come back "0" and the part would hold its first pose forever. # come back "0" and the part would hold its first pose forever.
@ -542,7 +553,7 @@ class DocumentTests(TestCase):
def patch(self, base, leaves, removed=()): def patch(self, base, leaves, removed=()):
return self.put(f"/api/projects/{self.project.id}", { return self.put(f"/api/projects/{self.project.id}", {
"base": base, "base": base,
"clips": [{"cid": "c1", "analysis": self.analysis, "leaves": leaves, "clips": [{"cid": "c1", "analyses": [self.analysis], "leaves": leaves,
"removed": list(removed), "blocks": [self.block]}], "removed": list(removed), "blocks": [self.block]}],
}) })

View file

@ -718,8 +718,6 @@ def _project_json(project: Project, user):
{ {
"cid": clip.cid, "cid": clip.cid,
"name": clip.name, "name": clip.name,
"footage": str(clip.footage_id) if clip.footage_id else None,
"analysis": clip.analysis_id,
"blocks": sorted(clip.blocks.values_list("key", flat=True)), "blocks": sorted(clip.blocks.values_list("key", flat=True)),
"leaves": {leaf.path: leaf.value for leaf in leaves if leaf.path.startswith(prefix)}, "leaves": {leaf.path: leaf.value for leaf in leaves if leaf.path.startswith(prefix)},
} }
@ -909,7 +907,19 @@ def _save(project: Project, data, user):
) )
keys = spec.get("blocks") or [] keys = spec.get("blocks") or []
have = set(Block.objects.filter(key__in=keys).values_list("key", flat=True)) analyses = spec.get("analyses") or []
if (not isinstance(analyses, list)
or not all(isinstance(key, str) for key in analyses)
or len(analyses) != len(set(analyses))):
raise Bad("a clip's analyses must be a list of distinct analysis ids")
registered = set(Analysis.objects.filter(key__in=analyses)
.values_list("key", flat=True))
if unknown := [key for key in analyses if key not in registered]:
raise Bad("this clip names analyses the server does not know; register them first",
status=409, missing=unknown)
block_rows = list(Block.objects.filter(key__in=keys))
have = {block.key for block in block_rows}
if missing := [k for k in keys if k not in have]: if missing := [k for k in keys if k not in have]:
# Referential integrity across the tiers, enforced where it can be: # Referential integrity across the tiers, enforced where it can be:
# a document that names blocks the server does not hold would load # a document that names blocks the server does not hold would load
@ -919,6 +929,9 @@ def _save(project: Project, data, user):
"before saving the document that points at them", "before saving the document that points at them",
status=409, missing=missing, status=409, missing=missing,
) )
if undeclared := sorted({block.analysis_id for block in block_rows} - registered):
raise Bad("every block in a clip must name one of that clip's analyses",
status=409, missing=undeclared)
existing = {leaf.path: leaf for leaf in project.leaves.filter(path__startswith=prefix)} existing = {leaf.path: leaf for leaf in project.leaves.filter(path__startswith=prefix)}
if base is not None: if base is not None:
@ -930,16 +943,12 @@ def _save(project: Project, data, user):
if conflicts: if conflicts:
continue continue
analysis = Analysis.objects.filter(key=spec.get("analysis")).first()
footage = None
if spec.get("footage"):
footage = Footage.objects.filter(id=spec["footage"]).first()
clip, _ = Clip.objects.update_or_create( clip, _ = Clip.objects.update_or_create(
project=project, project=project,
cid=cid, cid=cid,
defaults={"name": spec.get("name") or "", "analysis": analysis, "footage": footage}, defaults={"name": spec.get("name") or ""},
) )
blocks = Block.objects.filter(key__in=keys) blocks = block_rows
if base is None: if base is None:
clip.blocks.set(blocks) clip.blocks.set(blocks)
gone = [path for path in existing if path not in leaves] gone = [path for path in existing if path not in leaves]

View file

@ -72,6 +72,12 @@ Once resolved, every creation command follows the destination kind.
- Selecting an existing cel changes the destination from the lane to the symbol - Selecting an existing cel changes the destination from the lane to the symbol
placed by that cel; subsequent symbols and shapes become children there. placed by that cel; subsequent symbols and shapes become children there.
Double-clicking a lane creates an empty cel at the playhead; beginning a drawing
creates a drawing cel there. These are the same lane-creation operation with
different payloads. The pointer chooses the lane, never a second creation time.
The resulting cel is selected, so it immediately becomes the preferred target:
drawing again enters that cel's symbol instead of replacing it.
Thus no separate "new cel" versus "add inside" mode is needed. Selecting the Thus no separate "new cel" versus "add inside" mode is needed. Selecting the
lane header says new cel; selecting a cel says add inside. lane header says new cel; selecting a cel says add inside.

View file

@ -11,6 +11,7 @@
so the events that fetch them are only fetching." so the events that fetch them are only fetching."
(:refer-clojure :exclude [take]) (:refer-clojure :exclude [take])
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[arthur.domain.feature :as feature]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[clojure.string :as string])) [clojure.string :as string]))
@ -59,8 +60,8 @@
(keyword (if (seq slug) slug "symbol")))) (keyword (if (seq slug) slug "symbol"))))
(defn take (defn take
"Put `frozen`, a take, into `clip` as ONE symbol called `label`. Returns "Put `frozen`, a take, into `clip` as ONE symbol called `label`. Returns the
`{:clip :sid :tracked?}`. changed clip, the imported symbol id and the old-to-scoped subject ids.
`frozen` is what `flow/freeze/clip` makes: a `:main` that places one symbol per `frozen` is what `flow/freeze/clip` makes: a `:main` that places one symbol per
tracked face. `:main` becomes the named symbol — it is what holds the faces in tracked face. `:main` becomes the named symbol — it is what holds the faces in
@ -75,18 +76,22 @@
symbols. `nest/audio-tracks` collapses simultaneous copies carrying the same symbols. `nest/audio-tracks` collapses simultaneous copies carrying the same
`:media-link`; placing those faces at different times still schedules each one. `:media-link`; placing those faces at different times still schedules each one.
The tracking identities, and the analysis they were measured by, come along The unique imported symbol id scopes every subject id. Thus two takes may both
only when `clip` has no analysis of its own and no face had to be renamed. A arrive with detector subject `:face-1` without colliding in the document."
document holds one analysis, and regeneration finds a face's symbol by its
subject id, so either condition failing means the take comes in as drawings
that play but cannot be re-tuned — `:tracked? false` says so."
[clip frozen label footage-id range] [clip frozen label footage-id range]
(let [{c :clip ids :ids} (symbols clip frozen [:main] {:main (symbol-id label)}) (let [scope (fn [root subject] (keyword (str (name root) "." (name subject))))
root (clip/free-id
(fn [candidate]
(or (contains? (:symbols clip) candidate)
(some #(contains? (:symbols clip) (scope candidate %))
(keys (:subjects frozen)))))
(symbol-id label))
scoped (partial scope root)
wanted (into {:main root} (map (fn [subject] [subject (scoped subject)]))
(keys (:subjects frozen)))
{c :clip ids :ids} (symbols clip frozen [:main] wanted)
sid (ids :main) sid (ids :main)
faces (mapv ids (sort-by str (keys (:subjects frozen)))) faces (mapv ids (sort-by str (keys (:subjects frozen))))
;; Older/plain imported clips have no subject table. They are still a
;; take, so their wrapper remains the only honest owner of the sound.
sound-hosts (if (seq faces) faces [sid])
sound {:id :sound :name "sound" :kind :audio :parent nil sound {:id :sound :name "sound" :kind :audio :parent nil
:z "z-sound" :source {:footage footage-id} :z "z-sound" :source {:footage footage-id}
;; All automatic copies name one recording. The audio walk ;; All automatic copies name one recording. The audio walk
@ -96,18 +101,42 @@
;; Source frame `start` plays on the symbol's 0. ;; Source frame `start` plays on the symbol's 0.
:span range :span range
:time {:mode :map :at (- (first range)) :rate 1}} :time {:mode :map :at (- (first range)) :rate 1}}
tracked? (and (nil? (:analysis clip)) feature-ids (into {}
(every? #(= % (ids %)) (keys (:subjects frozen))))] (map (fn [[id f]]
[id (feature/owned (ids (:subject f)) (keyword (name id)))]))
(:features frozen))
subjects (into {}
(map (fn [[id subject]]
(let [new-id (ids id)]
[new-id (assoc subject :id new-id
:footage footage-id)])))
(:subjects frozen))
features (into {}
(map (fn [[id f]]
(let [new-id (feature-ids id)]
[new-id (-> f
(assoc :id new-id
:subject (ids (:subject f))
:symbol (ids (:symbol f))))])))
(:features frozen))
groups (into {}
(map (fn [[id g]]
(let [new-subject (ids (:subject g))
new-id (feature/owned new-subject (keyword (name id)))]
[new-id (-> g
(assoc :id new-id :subject new-subject)
(update :members #(mapv feature-ids %)))])))
(:groups frozen))]
{:sid sid {:sid sid
:tracked? tracked? :subject-ids (select-keys ids (keys (:subjects frozen)))
:clip (cond-> (-> (reduce (fn [document face] :clip (-> (reduce (fn [document face]
(assoc-in document [:symbols face :nodes :sound] sound)) (assoc-in document [:symbols face :nodes :sound] sound))
c sound-hosts) c faces)
(assoc-in [:symbols sid :name] (str label))) (assoc-in [:symbols sid :name] (str label))
tracked? (-> (assoc :analysis (:analysis frozen)) (update :analyses merge (:analyses frozen))
(update :subjects merge (:subjects frozen)) (update :subjects merge subjects)
(update :features merge (:features frozen)) (update :features merge features)
(update :groups merge (:groups frozen))))})) (update :groups merge groups))}))
(defn placed (defn placed

View file

@ -364,7 +364,11 @@
;; Palette-choice channels interpolate identities into a blend ;; Palette-choice channels interpolate identities into a blend
;; descriptor. The renderer keeps indexed geometry in the left ;; descriptor. The renderer keeps indexed geometry in the left
;; palette's bank and blends that bank's ramp toward the right one. ;; 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} {:from a :to b :t t}
(vector? a) (vector? a)
(mapv (fn [x y] (+ x (* t (- y x)))) a b) (mapv (fn [x y] (+ x (* t (- y x)))) a b)
@ -520,7 +524,7 @@
(let [values (when (map? (:keys ch)) (vals (:keys ch))) (let [values (when (map? (:keys ch)) (vals (:keys ch)))
first-value (first values) first-value (first values)
linear-values? (or (every? number? 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) (and (vector? first-value)
(pos? (count first-value)) (pos? (count first-value))
(every? (fn [v] (and (vector? v) (every? (fn [v] (and (vector? v)

View file

@ -4,7 +4,7 @@
{:name \"take\" {:name \"take\"
:fps 30 :fps 30
:width 320 :height 200 :width 320 :height 200
:analysis {...} :analyses {analysis-id {...}}
:subjects {...} :features {...} :groups {...} :subjects {...} :features {...} :groups {...}
:symbols {:main {:id :main :frames 229 :nodes {...}}}} :symbols {:main {:id :main :frames 229 :nodes {...}}}}
@ -51,7 +51,7 @@
that loses something on every round trip, which is the one bug a persistence 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 layer must not be able to have. Add the field here and to `leaf/leaves` and
`leaf/clip` in the same commit." `leaf/clip` in the same commit."
#{:name :fps :analysis :subjects :features :groups :width :height :symbols #{:name :fps :analyses :subjects :features :groups :width :height :symbols
:palettes :default-palette}) :palettes :default-palette})
(defn symbol (defn symbol
@ -264,7 +264,16 @@
;; A palette track has meaningful uncovered time. Ordinary held ;; A palette track has meaningful uncovered time. Ordinary held
;; channels clamp to their first key before it, but doing that ;; channels clamp to their first key before it, but doing that
;; here would erase the gap before the first palette segment. ;; 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)] track-value (if-let [ks (:keys track)]
(some->> (keys ks) (some->> (keys ks)
(filter #(<= % frame)) (filter #(<= % frame))
@ -286,12 +295,10 @@
choice (get-in palette-clip [:channels [:palette]]) choice (get-in palette-clip [:channels [:palette]])
start (some-> palette-clip node/placed-span first)] start (some-> palette-clip node/placed-span first)]
(or (when (and choice start) (or (when (and choice start)
(channel-value choice (- frame start))) (materialize (channel-value choice (- frame start))))
fallback))) fallback)))
track-value track-value
(channel-value (:palette owner) frame) fallback)))
inherited
(:default palette))))
(selection-at [owner frame inherited] (selection-at [owner frame inherited]
(let [selection (:palette owner) (let [selection (:palette owner)
chosen (cond chosen (cond
@ -574,6 +581,18 @@
(str "clip has a field with no leaf to save it in: " (pr-str k))) (str "clip has a field with no leaf to save it in: " (pr-str k)))
(when-not (map? (:symbols clip)) (when-not (map? (:symbols clip))
[":symbols must be a map of id -> symbol"]) [":symbols must be a map of id -> symbol"])
(when (and (contains? clip :analyses) (not (map? (:analyses clip))))
[":analyses must be a map of analysis id -> analysis"])
(for [[id analysis] (:analyses clip)
:when (not= id (:id analysis))]
(str "analysis under key " (pr-str id) " has :id " (pr-str (:id analysis))))
(for [[id subject] (:subjects clip)
:when (not (contains? (:analyses clip) (:analysis subject)))]
(str "subject " (pr-str id) " names missing analysis "
(pr-str (:analysis subject))))
(for [[id subject] (:subjects clip)
:when (not (keyword? (:source-subject subject)))]
(str "subject " (pr-str id) " has no source subject"))
(when (and (contains? clip :palettes) (not (map? (:palettes clip)))) (when (and (contains? clip :palettes) (not (map? (:palettes clip))))
[":palettes must be a map of id -> palette"]) [":palettes must be a map of id -> palette"])
(when (and (contains? clip :default-palette) (map? (:palettes clip)) (when (and (contains? clip :default-palette) (map? (:palettes clip))

View file

@ -6,20 +6,39 @@
is actually available. See `docs/creating-in.md`." is actually available. See `docs/creating-in.md`."
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
(defn- path-node
"The node at the end of an occurrence `path`, walked from `open`.
Selection also carries an owner sid and node id for commands that edit the
node directly. Those are deliberately not used here: the path is the address
of the row as seen from the open symbol, and is the only part that describes
every enclosing occurrence at arbitrary depth."
[document open path]
(loop [sid open [id & more] (seq path) found nil]
(if-not id
found
(when-let [n (get-in document [:symbols sid :nodes id])]
(if (seq more)
(when-let [inner (and (= :instance (:kind n)) (node/source n))]
(recur inner more n))
n)))))
(defn preferred-path (defn preferred-path
"The container path structurally implied by `selection`. "The container path structurally implied by `selection`.
Selecting an instance means inside it. Selecting any other node means its Selecting an instance means inside it. Selecting any other node means its
containing symbol. An empty or non-node selection means the open symbol." containing symbol. An empty or non-node selection means the open symbol."
[document selection] [document open selection]
(let [[kind sid id selected-path] selection (let [[kind _sid id selected-path] selection
path (when (= :node kind) path (when (= :node kind)
(vec (or (seq selected-path) (when id [id]))))] (vec (or (seq selected-path) (when id [id]))))
selected (path-node document open path)]
(cond (cond
(empty? path) [] (empty? path) []
(= :instance (get-in document [:symbols sid :nodes id :kind])) path (= :instance (:kind selected)) path
:else (vec (butlast path))))) :else (vec (butlast path)))))
(defn target (defn target
@ -33,7 +52,7 @@
Returns `{:kind :lane|:symbol :sid :path :frame :matrix :time}`." Returns `{:kind :lane|:symbol :sid :path :frame :matrix :time}`."
[document store open selection frame] [document store open selection frame]
(let [preferred (preferred-path document selection)] (let [preferred (preferred-path document open selection)]
(some (fn [path] (some (fn [path]
(when-let [inside (nest/inside document store open path frame)] (when-let [inside (nest/inside document store open path frame)]
(when-let [sid (:sid inside)] (when-let [sid (:sid inside)]

View file

@ -137,7 +137,7 @@
(some-leaf (at "timing") (select-keys clip [:fps])) (some-leaf (at "timing") (select-keys clip [:fps]))
(some-leaf (at "stage") (select-keys clip [:width :height])) (some-leaf (at "stage") (select-keys clip [:width :height]))
(some-leaf (at "palette-default") (select-keys clip [:default-palette])) (some-leaf (at "palette-default") (select-keys clip [:default-palette]))
(some-leaf (at "source") (:analysis clip)) (some-leaf (at "analyses") (:analyses clip))
(concat (concat
(for [[id v] (:subjects clip)] {(at "subject" (segment id)) v}) (for [[id v] (:subjects clip)] {(at "subject" (segment id)) v})
(for [[id v] (:features clip)] {(at "feature" (segment id)) v}) (for [[id v] (:features clip)] {(at "feature" (segment id)) v})
@ -194,7 +194,7 @@
"name" (merge acc v) "name" (merge acc v)
"timing" (merge acc v) "timing" (merge acc v)
"stage" (merge acc v) "stage" (merge acc v)
"source" (assoc acc :analysis v) "analyses" (assoc acc :analyses v)
"palette-default" (merge acc v) "palette-default" (merge acc v)
"palette" (assoc-in acc [:palettes (unsegment a)] v) "palette" (assoc-in acc [:palettes (unsegment a)] v)
"subject" (assoc-in acc [:subjects (unsegment a)] v) "subject" (assoc-in acc [:subjects (unsegment a)] v)
@ -237,7 +237,7 @@
false) false)
(case (count p) (case (count p)
;; The clip's own facts carry no id. ;; The clip's own facts carry no id.
3 (#{"name" "timing" "stage" "source" "palette-default"} (nth p 2)) 3 (#{"name" "timing" "stage" "analyses" "palette-default"} (nth p 2))
4 (#{"subject" "feature" "group" "palette"} (nth p 2)) 4 (#{"subject" "feature" "group" "palette"} (nth p 2))
false))))] false))))]
(vec (vec

View file

@ -99,15 +99,30 @@
(or (:dense c) (:generated c))) (or (:dense c) (:generated c)))
[:pos :rot :scale]))) [:pos :rot :scale])))
(defn hold-only?
"Channels whose values are choices, not quantities. Their keys may change at
a frame boundary but there is no meaningful value between two keys."
[path value]
(or (= path [:style :color])
(boolean? value)
(and (keyword? value) (not= path [:palette]))))
(defn- enforce-hold [path c]
(if (and (= path [:style :color]) (:keys c))
(-> c (assoc :interp :hold) (dissoc :segments))
c))
(defn set-channel (defn set-channel
"Write `v` into channel `path`: a key on the node's own frame `f` when the "Write `v` into channel `path`: a key on the node's own frame `f` when the
channel is keyed, its one value when it is not." channel is keyed, its one value when it is not."
[n path f v] [n path f v]
(let [c (get (channels n) path)] (let [c (get (channels n) path)]
(assoc-in n [:channels path] (assoc-in n [:channels path]
(enforce-hold
path
(if (:keys c) (if (:keys c)
(assoc-in c [:keys f] v) (assoc-in c [:keys f] v)
(merge (select-keys c [:semantic]) (ch/framed v)))))) (merge (select-keys c [:semantic]) (ch/framed v)))))))
(defn set-keyed-channel (defn set-keyed-channel
"Write `v` as a key at `f`, starting an animated channel when needed. This is "Write `v` as a key at `f`, starting an animated channel when needed. This is
@ -116,10 +131,12 @@
[n path f v] [n path f v]
(let [c (get (channels n) path)] (let [c (get (channels n) path)]
(assoc-in n [:channels path] (assoc-in n [:channels path]
(enforce-hold
path
(if (:keys c) (if (:keys c)
(assoc-in c [:keys f] v) (assoc-in c [:keys f] v)
(merge (select-keys c [:semantic]) (merge (select-keys c [:semantic])
(ch/keyed {f v} (if (or (boolean? v) (keyword? v)) :hold :linear))))))) (ch/keyed {f v} (if (hold-only? path v) :hold :linear))))))))
(defn toggle-key (defn toggle-key
"Key channel `path` on the node's own frame `f` with the value it has there, or "Key channel `path` on the node's own frame `f` with the value it has there, or
@ -127,19 +144,22 @@
the last one off leaves it that one value. A boolean holds; anything else tweens. the last one off leaves it that one value. A boolean holds; anything else tweens.
`store` because the value it keys is read out of the channel, and a measured `store` because the value it keys is read out of the channel, and a measured
channel's values live in tier 2." channel's values live in tier 2. Colour is always held even though current
documents store palette choices as numeric slot indices."
[n path f store] [n path f store]
(let [c (get (channels n) path) (let [c (get (channels n) path)
v (ch/value-at c f store) v (ch/value-at c f store)
ks (dissoc (:keys c) f)] ks (dissoc (:keys c) f)]
(assoc-in n [:channels path] (assoc-in n [:channels path]
(enforce-hold
path
(cond (cond
(not (:keys c)) (merge (select-keys c [:semantic]) (not (:keys c)) (merge (select-keys c [:semantic])
(ch/keyed {f v} (if (or (boolean? v) (keyword? v)) :hold :linear))) (ch/keyed {f v} (if (hold-only? path v) :hold :linear)))
(not (contains? (:keys c) f)) (assoc-in c [:keys f] v) (not (contains? (:keys c) f)) (assoc-in c [:keys f] v)
(seq ks) (cond-> (assoc c :keys ks) (seq ks) (cond-> (assoc c :keys ks)
(:segments c) (update :segments dissoc f)) (:segments c) (update :segments dissoc f))
:else (ch/framed v))))) :else (ch/framed v))))))
(defn set-segment-interp (defn set-segment-interp
"Choose how channel `path`'s key at `left` leads to the next one: `:hold` cuts "Choose how channel `path`'s key at `left` leads to the next one: `:hold` cuts
@ -147,7 +167,9 @@
only a gap that exists, between a key and a later one, can be chosen." only a gap that exists, between a key and a later one, can be chosen."
[n path left interp] [n path left interp]
(let [ks (:keys (get (channels n) path))] (let [ks (:keys (get (channels n) path))]
(if (and (contains? ks left) (some #(< left %) (keys ks)) (#{:hold :linear} interp)) (if (and (contains? ks left) (some #(< left %) (keys ks))
(#{:hold :linear} interp)
(or (= :hold interp) (not (hold-only? path nil))))
(assoc-in n [:channels path :segments left] interp) (assoc-in n [:channels path :segments left] interp)
n))) n)))

View file

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

View file

@ -29,9 +29,7 @@
(:require [arthur.domain.leaf :as leaf] (:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire])) [arthur.domain.wire :as wire]))
(def schema-version (def schema-version 5)
"4 separates a symbol's static authoring palette from its palette track."
4)
(defn block-keys (defn block-keys
"Every tier-2 key a leaf map names, in a stable order." "Every tier-2 key a leaf map names, in a stable order."

View file

@ -730,9 +730,7 @@
(-> [] (-> []
(cond-> (cond->
(and (= :palette (:type sym)) (seq nodes)) (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 (into (for [[id n] nodes
:when (not= id (:id n))] :when (not= id (:id n))]
(str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) (str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))

View file

@ -151,7 +151,8 @@
:detector detector}) :detector detector})
_ (mark! "build-clip: freeze") _ (mark! "build-clip: freeze")
built (:clip frozen) built (:clip frozen)
source-blocks (source/pack-subjects (:id (:analysis built)) subjects) analysis-id (-> built :analyses keys first)
source-blocks (source/pack-subjects analysis-id subjects)
_ (mark! "build-clip: pack source blocks")] _ (mark! "build-clip: pack source blocks")]
(assoc (select-keys built [:fps :width :height]) (assoc (select-keys built [:fps :width :height])
@ -394,7 +395,10 @@
(rf/reg-event-db (rf/reg-event-db
::choose ::choose
(fn [db [_ id]] (assoc-in db [:footage :chosen] id))) (fn [db [_ id]]
(-> db
(assoc-in [:footage :chosen] id)
(ui/selected [:footage id]))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; renaming an asset ;; renaming an asset
@ -504,7 +508,7 @@
(let [entry (store/entry (:clip/current db)) (let [entry (store/entry (:clip/current db))
uuid (random-uuid) uuid (random-uuid)
fps (get-in db [:clip :fps]) fps (get-in db [:clip :fps])
{:keys [clip sid tracked?]} {:keys [clip sid subject-ids]}
(bring/take (:clip entry) (:clip built) name footage-id range) (bring/take (:clip entry) (:clip built) name footage-id range)
st (merge (:store entry) (:store built)) st (merge (:store entry) (:store built))
imported-frames (clip/output-frames clip sid) imported-frames (clip/output-frames clip sid)
@ -525,9 +529,22 @@
(update :footage merge {:loading? false :status why}))} (update :footage merge {:loading? false :status why}))}
(let [db (edit/edit-entry (let [db (edit/edit-entry
db db
#(cond-> (assoc % :clip (:clip result) :store st) #(let [analysis-id (-> built :clip :analyses keys first)
tracked? (merge (select-keys built [:footage-id :source-blocks remap-subjects
:source-inputs]))))] (fn [inputs]
(update inputs :subjects
(fn [subjects]
(into {} (map (fn [[old new]] [new (get subjects old)]))
subject-ids))))]
(-> (assoc % :clip (:clip result) :store st)
(update-in [:sources analysis-id]
(fn [source]
{:footage-id (:footage-id built)
:source-blocks (:source-blocks built)
:source-inputs
(update (remap-subjects (:source-inputs built))
:subjects merge
(get-in source [:source-inputs :subjects]))})))))]
{:db (-> db {:db (-> db
(update :ui dissoc :convert) (update :ui dissoc :convert)
(ui/selected (ui/selected
@ -536,7 +553,5 @@
{:loading? false {:loading? false
:status (str "made " name " · " imported-frames " frames at " fps " fps" :status (str "made " name " · " imported-frames " frames at " fps " fps"
(when (not= fps source-fps) (when (not= fps source-fps)
(str " · sampled from " source-fps " fps")) (str " · sampled from " source-fps " fps")))}))
(when-not tracked?
" · as drawings: this project already tracks other footage"))}))
:dispatch [::pb/refresh-clock]}))))) :dispatch [::pb/refresh-clock]})))))

View file

@ -102,15 +102,10 @@
(.then (fn [^js created] (.-id created)))))) (.then (fn [^js created] (.-id created))))))
(defn- opened-entry! [^js clip-json] (defn- opened-entry! [^js clip-json]
(let [footage-id (.-footage clip-json)]
(-> (js/Promise.all (-> (js/Promise.all
#js [(js/Promise.all
(into-array (map #(http/GET (str "/api/blocks/" %)) (into-array (map #(http/GET (str "/api/blocks/" %))
(array-seq (.-blocks clip-json))))) (array-seq (.-blocks clip-json)))))
(if footage-id (.then (fn [blocks]
(http/GET (str "/api/footage/" footage-id))
(js/Promise.resolve nil))])
(.then (fn [[blocks ^js footage]]
(let [cid (.-cid clip-json) (let [cid (.-cid clip-json)
loaded (project/load loaded (project/load
cid #js {:leaves (.-leaves clip-json) cid #js {:leaves (.-leaves clip-json)
@ -129,11 +124,9 @@
;; write lands on what does not. ;; write lands on what does not.
:synced (project/tier1 (.-leaves clip-json)) :synced (project/tier1 (.-leaves clip-json))
:clip built :store (:store loaded) :clip built :store (:store loaded)
:footage-id footage-id :audio "/static/arthur/audio.wav"})]
:audio (if footage (.-audio footage)
"/static/arthur/audio.wav")})]
(-> (mix/mix! built (clip/opens-on built) (:audio entry) (:store entry)) (-> (mix/mix! built (clip/opens-on built) (:audio entry) (:store entry))
(.then (fn [audio] (assoc entry :audio audio))))))))))) (.then (fn [audio] (assoc entry :audio audio))))))))))
(defn- saved-clip! (defn- saved-clip!
"Promise of clip `cid` of saved project `pid`, as `{:clip :store}`: its "Promise of clip `cid` of saved project `pid`, as `{:clip :store}`: its
@ -240,46 +233,60 @@
:removed (into-array (remove #(contains? local %) (keys synced)))}) :removed (into-array (remove #(contains? local %) (keys synced)))})
#js {:leaves (.-leaves doc)})) #js {:leaves (.-leaves doc)}))
(defonce ^:private on-server (defonce ^:private uploaded-blocks
;; Analyses and block keys this page has already put on the server. Content ;; Block keys this page has already put on the server. Content addressed, so
;; addressed, so once there they are there: a save of a moved vertex asks for ;; once there they are there: a save of a moved vertex asks for none again.
;; none of it again, and is one request.
(atom #{})) (atom #{}))
(defonce ^:private linked-analyses (atom #{}))
(defn- upload-new! [^js doc] (defn- upload-new! [^js doc]
(let [keys (array-seq (block-keys doc))] (let [keys (array-seq (block-keys doc))]
(if (every? @on-server keys) (if (every? @uploaded-blocks keys)
(js/Promise.resolve 0) (js/Promise.resolve 0)
(.then (upload-missing! doc) (fn [n] (swap! on-server into keys) n))))) (.then (upload-missing! doc) (fn [n] (swap! uploaded-blocks into keys) n)))))
(defn- analyses-of [entry]
(vals (get-in entry [:clip :analyses])))
(defn- upload-sources! [sources]
(reduce
(fn [chain [analysis-id {:keys [source-blocks]}]]
(.then chain
(fn [_]
(when (and (seq source-blocks)
(not (@linked-analyses analysis-id)))
(-> (upload-missing! #js {:blocks (source/upload-blocks source-blocks)})
(.then #(http/PUT
(str "/api/analyses/" analysis-id)
#js {:source_blocks
(into-array (source/block-keys source-blocks))}))
(.then (fn [answer]
(swap! linked-analyses conj analysis-id)
answer)))))))
(js/Promise.resolve nil)
sources))
(rf/reg-fx (rf/reg-fx
::save! ::save!
(fn [{:keys [id cid label clip base]}] (fn [{:keys [id cid label clip base]}]
(let [analysis (:analysis (:clip clip)) (let [entry clip
doc (project/save cid clip) analyses (analyses-of entry)
local (leaf/leaves cid (:clip clip)) doc (project/save cid entry)
base (when (and id (:synced clip)) base) local (leaf/leaves cid (:clip entry))
source-blocks (:source-blocks clip)] base (when (and id (:synced entry)) base)
sources (:sources entry)]
(-> (ensure-project! id label) (-> (ensure-project! id label)
(.then (fn [pid] (.then (fn [pid]
(-> (if (and analysis (not (@on-server (:id analysis)))) (-> (reduce (fn [chain one]
(http/POST "/api/analyses" (analysis-payload analysis)) (.then chain
(js/Promise.resolve nil)) #(http/POST "/api/analyses"
(analysis-payload one))))
(js/Promise.resolve nil)
analyses)
(.then (fn [_] (.then (fn [_]
(when (and (seq source-blocks) (not (@on-server (:id analysis)))) (upload-sources! sources)))
(-> (upload-missing!
#js {:blocks (source/upload-blocks source-blocks)})
(.then (fn [_] (.then (fn [_]
(http/PUT
(str "/api/analyses/" (:id analysis))
;; One set per tracked subject, in
;; the order `source/unpack` does
;; not depend on.
#js {:source_blocks
(into-array
(source/block-keys source-blocks))})))))))
(.then (fn [_]
(when analysis (swap! on-server conj (:id analysis)))
(upload-new! doc))) (upload-new! doc)))
(.then (fn [uploaded] (.then (fn [uploaded]
(-> (http/PUT (str "/api/projects/" pid) (-> (http/PUT (str "/api/projects/" pid)
@ -288,11 +295,11 @@
:clips #js [(js/Object.assign :clips #js [(js/Object.assign
#js {:cid cid #js {:cid cid
:name label :name label
:analysis (:id analysis) :analyses (into-array
:footage (:footage-id clip) (keys (get-in entry [:clip :analyses])))
:blocks (block-keys doc)} :blocks (block-keys doc)}
(clip-payload doc base local (clip-payload doc base local
(:synced clip)))]}) (:synced entry)))]})
(.then (fn [^js saved] (.then (fn [^js saved]
(rf/dispatch [::saved pid cid label (rf/dispatch [::saved pid cid label
(.-seq saved) (.-seq saved)
@ -439,39 +446,38 @@
(assoc measured :interior-key block-key)))))))) (assoc measured :interior-key block-key))))))))
(throw error))))))) (throw error)))))))
(defn- source-for! [entry] (defn- source-for! [entry edit]
(if-let [inputs (:source-inputs entry)] (let [subject (:subject (regenerate/plan (:clip entry) edit))
(js/Promise.resolve inputs) subject-record (get-in entry [:clip :subjects subject])
(let [analysis (get-in entry [:clip :analysis])] analysis-id (:analysis subject-record)
(if (= (:id analysis) (:id @retained-source)) analysis (get-in entry [:clip :analyses analysis-id])
source-subject (:source-subject subject-record)
local (get-in entry [:sources analysis-id :source-inputs :subjects subject])]
(if local
(js/Promise.resolve {:subjects {subject local}})
(if (= [analysis-id subject] (:key @retained-source))
(:promise @retained-source) (:promise @retained-source)
(let [promise (let [promise
(if (= "synth" (:detector analysis)) (if (= "synth" (:detector analysis))
;; The synthetic take tracks one face and regenerating it reads
;; that face's landmarks, so it arrives in the same shape real
;; footage does rather than in a flat one only this branch uses.
(js/Promise.resolve (js/Promise.resolve
{:subjects {:subjects
{:face-1 {:dense (synth/synth-dense (:frames analysis) {subject {:dense (synth/synth-dense (:frames analysis)
{:seed (:seed analysis)})}}}) {:seed (:seed analysis)})}}})
(-> (ingest/manifest! (:footage-id entry)) (.then (ingest/manifest! (:footage subject-record))
(.then (fn [manifest] (fn [manifest]
(-> (footage/saved-source! (:id analysis) (.then (footage/saved-source!
[(:width manifest) analysis-id [(:width manifest) (:height manifest)])
(:height manifest)]) (fn [inputs]
(.then (fn [inputs]
(when-not inputs (when-not inputs
(throw (ex-info "saved analysis has no source blocks" {}))) (throw (ex-info "saved analysis has no source blocks" {})))
(update inputs :subjects {:subjects
(fn [subjects] {subject
(into {} (assoc (get-in inputs [:subjects source-subject])
(map (fn [[id one]] :presence
[id (assoc one :presence (footage/presence-for manifest
(footage/presence-for source-subject))}})))))]
manifest id))]))
subjects))))))))))]
(do (do
(reset! retained-source {:id (:id analysis) :promise promise}) (reset! retained-source {:key [analysis-id subject] :promise promise})
promise)))))) promise))))))
(defn- inputs-for-edit! (defn- inputs-for-edit!
@ -484,18 +490,19 @@
one (get-in inputs [:subjects subject])] one (get-in inputs [:subjects subject])]
(if (and teeth (:crops one)) (if (and teeth (:crops one))
(let [settings (merge take/knobs (feature/effective-params clip teeth)) (let [settings (merge take/knobs (feature/effective-params clip teeth))
analysis (get-in clip [:analysis :id]) analysis (get-in clip [:subjects subject :analysis])
source-subject (get-in clip [:subjects subject :source-subject])
frames (count (:crops one)) frames (count (:crops one))
key (source/interior-key analysis subject settings frames) key (source/interior-key analysis source-subject settings frames)
done (fn [measured] (assoc-in inputs [:subjects subject] measured))] done (fn [measured] (assoc-in inputs [:subjects subject] measured))]
(if (and (:interior one) (if (and (:interior one)
(or (= (:interior-key one) key) (or (= (:interior-key one) key)
(and (nil? (:interior-key one)) (and (nil? (:interior-key one))
(= key (source/interior-key analysis subject take/knobs frames))))) (= key (source/interior-key analysis source-subject take/knobs frames)))))
(js/Promise.resolve inputs) (js/Promise.resolve inputs)
(.then (if (= key (:key @retained-interior)) (.then (if (= key (:key @retained-interior))
(:promise @retained-interior) (:promise @retained-interior)
(let [promise (retained-interior! analysis subject settings one)] (let [promise (retained-interior! analysis source-subject settings one)]
(reset! retained-interior {:key key :promise promise}) (reset! retained-interior {:key key :promise promise})
promise)) promise))
done))) done)))
@ -504,7 +511,7 @@
(rf/reg-fx (rf/reg-fx
::preview-settings! ::preview-settings!
(fn [{:keys [id entry edit request]}] (fn [{:keys [id entry edit request]}]
(-> (source-for! entry) (-> (source-for! entry edit)
(.then (fn [inputs] (inputs-for-edit! entry edit inputs))) (.then (fn [inputs] (inputs-for-edit! entry edit inputs)))
(.then (fn [inputs] (.then (fn [inputs]
(regenerate/change (assoc entry :source-inputs inputs) edit))) (regenerate/change (assoc entry :source-inputs inputs) edit)))
@ -519,7 +526,7 @@
(fn [{:keys [db]} [_ edit]] (fn [{:keys [db]} [_ edit]]
(let [id (:clip/current db) (let [id (:clip/current db)
entry (store/entry id)] entry (store/entry id)]
(if (or (get-in db [:project :busy?]) (nil? (:analysis (:clip entry)))) (if (or (get-in db [:project :busy?]) (empty? (:analyses (:clip entry))))
{} {}
(let [plan (regenerate/plan (:clip entry) edit) (let [plan (regenerate/plan (:clip entry) edit)
report (select-keys plan [:features :roles]) report (select-keys plan [:features :roles])
@ -722,50 +729,6 @@
(assoc-in % [:symbols sid :palette] id) (assoc-in % [:symbols sid :palette] id)
(update-in % [:symbols sid] dissoc :palette))))) (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 (rf/reg-event-db
::set-channel ::set-channel
;; `frame` is the node's own, as for a drawing key. ;; `frame` is the node's own, as for a drawing key.
@ -777,7 +740,7 @@
(if (get-in document [:symbols sid :nodes id :channels [:palette]]) (if (get-in document [:symbols sid :nodes id :channels [:palette]])
document document
(let [source (get-in document [:symbols sid :nodes id :source :symbol]) (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-in document [:symbols sid :nodes id :channels [:palette]]
(assoc (ch/framed palette-id) :semantic :palette))))) (assoc (ch/framed palette-id) :semantic :palette)))))

View file

@ -17,12 +17,14 @@
app to change and the most expensive to have two copies of." app to change and the most expensive to have two copies of."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.channel :as ch]
[arthur.domain.clipboard :as clipboard] [arthur.domain.clipboard :as clipboard]
[arthur.domain.correction :as correction] [arthur.domain.correction :as correction]
[arthur.domain.creation :as creation] [arthur.domain.creation :as creation]
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.span :as span] [arthur.domain.span :as span]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
@ -343,9 +345,16 @@
(rf/reg-event-db (rf/reg-event-db
::toggle-row ::set-row-expanded
(fn [db [_ path]] (fn [db [_ path expanded?]]
(update-in db [:ui :expanded] #(if (contains? % path) (disj % path) (conj % path))))) ;; The disclosure control says what the next state is instead of asking us
;; to invert whatever happens to be in app-db by the time its event runs.
;; A structural drop may reveal this path between pointer-down and click;
;; blindly toggling then immediately closed the row whose triangle was still
;; painted as closed.
(update-in db [:ui :expanded]
(fn [paths]
((if expanded? conj disj) (set paths) path)))))
(rf/reg-event-db (rf/reg-event-db
::solo ::solo
@ -793,6 +802,55 @@
(edit/transaction (constantly (:clip result))) (edit/transaction (constantly (:clip result)))
(selected [:node sid uuid (conj (vec path) uuid)])))) (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 [_ _pointer-frame target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
;; Creation always happens at the playhead. The double-click only
;; names the lane; it is not a second, pointer-based time cursor.
frame (editing-frame db document)
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 (rf/reg-event-db
::drop-symbol ::drop-symbol
;; A symbol dropped on a row becomes a naturally playing clip in the symbol that ;; A symbol dropped on a row becomes a naturally playing clip in the symbol that

View file

@ -762,11 +762,15 @@
{:frames (vec lengths)}))) {:frames (vec lengths)})))
nf (first lengths) nf (first lengths)
merged (fn [k] (into {} (mapcat (comp k second)) parts)) merged (fn [k] (into {} (mapcat (comp k second)) parts))
built {:name name :fps fps :analysis (:analysis params) analysis (:analysis params)
built {:name name :fps fps :analyses {(:id analysis) analysis}
:width (first stage) :height (second stage) :width (first stage) :height (second stage)
:palettes {pal/default-id pal/default-palette} :palettes {pal/default-id pal/default-palette}
:default-palette pal/default-id :default-palette pal/default-id
:subjects (into {} (map (fn [[id _]] [id {:id id :params {}}])) ordered) :subjects (into {} (map (fn [[id _]]
[id {:id id :params {}
:analysis (:id analysis)
:source-subject id}])) ordered)
:features (merged :features) :groups (merged :groups) :features (merged :features) :groups (merged :groups)
:symbols :symbols
(into {:main (into {:main

View file

@ -142,6 +142,11 @@
teeth are dirty, retained pixel measurements. No IO or app-db here." teeth are dirty, retained pixel measurements. No IO or app-db here."
[{:keys [clip source-inputs] :as entry} edit] [{:keys [clip source-inputs] :as entry} edit]
(let [{:keys [changed subject features]} (plan clip edit) (let [{:keys [changed subject features]} (plan clip edit)
analysis-id (get-in changed [:subjects subject :analysis])
analysis (get-in changed [:analyses analysis-id])
_ (when-not analysis
(throw (ex-info "subject names a missing analysis"
{:subject subject :analysis analysis-id})))
;; THE EDITED SUBJECT'S OWN LANDMARKS. Retained source is per subject — ;; THE EDITED SUBJECT'S OWN LANDMARKS. Retained source is per subject —
;; one video, one dense track per tracked face — so re-measuring the ;; one video, one dense track per tracked face — so re-measuring the
;; second face through the first one's anchor is the mistake this lookup ;; second face through the first one's anchor is the mistake this lookup
@ -152,8 +157,8 @@
{:subject subject}))) {:subject subject})))
base-params (merge take/knobs base-params (merge take/knobs
{:fps (or (get-in changed [:symbols subject :fps]) (:fps changed)) {:fps (or (get-in changed [:symbols subject :fps]) (:fps changed))
:aspect (get-in changed [:analysis :aspect]) :aspect (:aspect analysis)
:analysis (:analysis changed)}) :analysis analysis})
;; One conditioned anchor for the whole edit, and it is the SUBJECT's. ;; One conditioned anchor for the whole edit, and it is the SUBJECT's.
;; `:anchor-avg` is a subject setting, so the shared upstream measurement ;; `:anchor-avg` is a subject setting, so the shared upstream measurement
;; is not read off whichever dirty feature happened to sort first — and ;; is not read off whichever dirty feature happened to sort first — and

View file

@ -212,7 +212,6 @@
;; row is not on stage, so neither is its footage. ;; row is not on stage, so neither is its footage.
(let [solo (filter #(placed? document open %) solo)] (let [solo (filter #(placed? document open %) solo)]
{:document document :store store {:document document :store store
:footage-id (:footage-id (footage/entry id))
:opacity (or opacity trace/opacity-default) :opacity (or opacity trace/opacity-default)
:traces (cond->> (when document (trace/shown document open faces)) :traces (cond->> (when document (trace/shown document open faces))
(seq solo) (filterv (fn [{:keys [path]}] (seq solo) (filterv (fn [{:keys [path]}]

View file

@ -156,7 +156,8 @@
;; than kept beside it, so a sound placed from footage makes that footage the ;; than kept beside it, so a sound placed from footage makes that footage the
;; project's without anything else being told. ;; project's without anything else being told.
(let [entry (store/entry id) (let [entry (store/entry id)
used (into (set (keep identity [(:footage-id entry)])) uploaded) used (into (set uploaded)
(keep :footage (vals (get-in entry [:clip :subjects]))))
used (into used (for [[_ sym] (get-in entry [:clip :symbols]) used (into used (for [[_ sym] (get-in entry [:clip :symbols])
[_ n] (:nodes sym) [_ n] (:nodes sym)
:let [f (get-in n [:source :footage])] :let [f (get-in n [:source :footage])]

View file

@ -47,13 +47,6 @@
:center (clip/center document st sid) :center (clip/center document st sid)
:shapes (outline 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? (defn accepts?
"Whether the stage or the tracks should accept what is being carried: things "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." 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]) :sound (rf/dispatch [::ui/drop-sound c frame target])
nil)) nil))
(done!))) (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!))

View file

@ -2,10 +2,9 @@
"The right pane: what the selection is, and what can be changed about it. "The right pane: what the selection is, and what can be changed about it.
Sections rather than a mode switch. The clip's facts are always true, so the Sections rather than a mode switch. The clip's facts are always true, so the
clip section is always there; the node and symbol sections appear when clip section is always there; node, footage, face and tracking sections follow
something of that kind is selected; the tracking section appears when the clip the thing actually selected. Nothing here computes — every control dispatches
has analysis in it. Nothing here computes — every control dispatches an intent an intent and every readout comes off a subscription."
and every readout comes off a subscription."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.clip :as clip-domain] [arthur.domain.clip :as clip-domain]
[arthur.domain.channel :as channel] [arthur.domain.channel :as channel]
@ -208,12 +207,42 @@
v))) v)))
(when gap? [segment-select sid id path ch left])])) (when gap? [segment-select sid id path ch left])]))
(defn- color-control [sid id ch frame auto-key? palette]
(let [keyed? (some? (:keys ch))
value (channel/value-at ch (or frame 0) nil)
value (if (integer? value)
value
(or (first (keep-indexed #(when (= value (:name %2)) %1)
(:slots palette))) 0))
off? (and keyed? (nil? frame))]
[:dd.channel {:class (when auto-key? "live")}
[:button.key {:class (cond (contains? (:keys ch) frame) "on" keyed? "keyed")
:disabled (nil? frame)
:title (if keyed? (str (count (:keys ch)) " held keys") "key color here")
:on-click #(rf/dispatch [::project/toggle-key sid id [:style :color] frame])}
"◆"]
[:div.channel-swatches
(doall
(for [[i {:keys [name hex]}] (map-indexed vector (:slots palette))]
^{:key i}
[:button.swatch
{:class (when (= i value) "on")
:style {:background hex}
:disabled off?
:aria-label (str "color " i (when name (str " " (clojure.core/name name))))
:aria-pressed (= i value)
:title (str i (when name (str " · " (clojure.core/name name))) " · " hex)
:on-click #(rf/dispatch [::project/set-channel sid id [:style :color] frame i])}]))]
(when keyed? [:span.dim "hold"])]))
(defn- node-section [[sid id n]] (defn- node-section [[sid id n]]
(let [[start end] (:span 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]) clip @(rf/subscribe [::render/clip])
local @(rf/subscribe [::sub/selected-local]) local @(rf/subscribe [::sub/selected-local])
frame (:frame local)] frame (:frame local)
palette-id (or (get-in clip [:symbols sid :palette]) (pal/default-palette-id clip))
palette (get (pal/palettes clip) palette-id)]
[section (str (name (:kind n)) " · in " (name sid)) [section (str (name (:kind n)) " · in " (name sid))
[facts [facts
"id" (brief id) "id" (brief id)
@ -232,13 +261,24 @@
(let [{:keys [frame]} local] (let [{:keys [frame]} local]
[:dl.facts [:dl.facts
(doall (doall
(for [[path ch] (sort-by (comp str key) (node/channels n))] (for [[path ch] (sort-by (fn [[path]]
[(cond
(= :xform (first path)) 0
(= path [:style :color]) 1
:else 2)
(str path)])
(node/channels n))]
^{:key (str path)} ^{:key (str path)}
[:<> [:<>
[:dt (str/join " " (map name path))] [:dt (str/join " " (map name path))]
(if (and (contains? (node/defaults-of n) path) (not (:dense ch))) (cond
(and (= path [:style :color]) (not (:dense ch)))
[color-control sid id ch frame auto-key? palette]
(and (contains? (node/defaults-of n) path) (not (:dense ch)))
[channel-control sid id path ch frame auto-key?] [channel-control sid id path ch frame auto-key?]
[:dd (channel-state ch)])]))])]))
:else [:dd (channel-state ch)])]))])]))
(defn- palette-placement-section [[sid id n]] (defn- palette-placement-section [[sid id n]]
(let [clip @(rf/subscribe [::render/clip]) (let [clip @(rf/subscribe [::render/clip])
@ -268,12 +308,15 @@
:title (if (:keys ch) (str (count (:keys ch)) " keys") "key this here") :title (if (:keys ch) (str (count (:keys ch)) " keys") "key this here")
:on-click #(rf/dispatch [::project/toggle-palette-key sid id frame])} :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 :on-change
(fn [e] (fn [e]
(let [v (.. e -target -value) (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])))} (rf/dispatch [::project/set-palette-choice sid id frame palette-id])))}
[:option {:value ""} "inherit"]
(for [[palette-id p] palettes] (for [[palette-id p] palettes]
^{:key (str palette-id)} ^{:key (str palette-id)}
[:option {:value (str palette-id)} (:name p)])]]] [:option {:value (str palette-id)} (:name p)])]]]
@ -428,19 +471,16 @@
;; the footage showing under the picture ;; the footage showing under the picture
(defn- footage-section (defn- footage-section
"The footage under the faces the open symbol has, on or off and how strongly. "The footage under the explicitly selected face or footage asset, on or off
`here` is those faces. and how strongly. `here` is exactly those faces.
ONE SWITCH FOR THE FACES THAT ARE HERE. A face's footage is the face's, not a ONE SWITCH FOR THE FACES THAT ARE HERE. A face's footage is the face's, not a
placement's, so there is nothing to inherit and nothing to set twice; with placement's, so there is nothing to inherit and nothing to set twice; with
several faces in a take the box says how many are showing and switches the rest several faces in a take the box says how many are showing and switches the rest
on, and one face alone is switched from its own timeline row. on, and one face alone is switched from its own timeline row.
THE OPEN SYMBOL'S FACES AND NOT THE SELECTION'S, which is what lets this live in This is editor state, but the inspector still obeys selection scope: selecting
the inspector at all: a viewing aid that appeared only once the right row had an unrelated shape must neither expose nor mutate a face's viewing aid."
been found would make the way to see the footage you are tracing depend on what
you had clicked. So the section is there whenever the picture on the stage has
any footage behind it, wherever the selection happens to be."
[here] [here]
(let [{:keys [faces opacity]} @(rf/subscribe [::render/tracing]) (let [{:keys [faces opacity]} @(rf/subscribe [::render/tracing])
on (filterv (set faces) here)] on (filterv (set faces) here)]
@ -654,13 +694,45 @@
(max 1 (* 2 default))) (max 1 (* 2 default)))
:step (cond even? 2 (= type :integer) 1 :else 0.01)}) :step (cond even? 2 (= type :integer) 1 :else 0.01)})
(defn- tracking-section [] (defn- subject-of-owner [clip [scope id]]
(case scope
:subject id
:feature (get-in clip [:features id :subject])
:group (get-in clip [:groups id :subject])
nil))
(defn- face-selection
"The one face explicitly named by a face symbol, its placement, or a tracking
owner. A shape merely living inside an open face is deliberately not one."
[clip selection selected-node]
(let [[kind id] selection
placed (node/source (peek selected-node))
candidate (cond
(= :symbol kind) id
(#{:subject :feature :group} kind) (subject-of-owner clip selection)
(= :node kind) placed)]
(when (and candidate (trace/traceable? clip candidate)) candidate)))
(defn- footage-faces [clip selection selected-node]
(if (= :footage (first selection))
(let [footage-id (second selection)]
(into [] (comp (filter #(= footage-id (:footage (val %)))) (map key))
(:subjects clip)))
(some-> (face-selection clip selection selected-node) vector)))
(defn- tracking-owners [clip selection selected-node]
(let [faces (if (= :footage (first selection))
(set (footage-faces clip selection selected-node))
(some-> (face-selection clip selection selected-node) hash-set))]
(when (seq faces)
(filterv #(contains? faces (subject-of-owner clip %)) (owners clip)))))
(defn- tracking-section [all]
(let [clip @(rf/subscribe [::render/clip]) (let [clip @(rf/subscribe [::render/clip])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
knobs @(rf/subscribe [::sub/knobs]) knobs @(rf/subscribe [::sub/knobs])
busy? (:busy? @(rf/subscribe [::playback/project])) busy? (:busy? @(rf/subscribe [::playback/project]))
report @(rf/subscribe [::project/regeneration]) report @(rf/subscribe [::project/regeneration])
all (owners clip)
[scope id :as owner] (if (some #{selection} all) selection (first all)) [scope id :as owner] (if (some #{selection} all) selection (first all))
area (case scope area (case scope
:subject :subject :subject :subject
@ -724,7 +796,6 @@
open @(rf/subscribe [::render/open]) open @(rf/subscribe [::render/open])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
node @(rf/subscribe [::sub/selected-node]) node @(rf/subscribe [::sub/selected-node])
tracked? (seq (owners clip))
;; The face the tracing section is about: the SELECTED PLACEMENT's symbol, ;; The face the tracing section is about: the SELECTED PLACEMENT's symbol,
;; or, when the selection is not an instance or there is none, the OPEN ;; or, when the selection is not an instance or there is none, the OPEN
;; symbol — which is the face itself when a face is open to be drawn over. ;; symbol — which is the face itself when a face is open to be drawn over.
@ -734,16 +805,15 @@
;; lane traces is not a question with one answer, and naming the drawing ;; lane traces is not a question with one answer, and naming the drawing
;; showing now would move the section under the playhead. ;; showing now would move the section under the playhead.
placed (node/source (peek node)) placed (node/source (peek node))
footage-faces (footage-faces clip selection node)
tracking-owners (tracking-owners clip selection node)
palette-placement? (and 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-symbol? (and (= :symbol (first selection))
(= :palette (get-in clip [:symbols (second selection) :type]))) (= :palette (get-in clip [:symbols (second selection) :type])))
face (or placed (when (trace/traceable? clip open) open)) face (or placed (when (trace/traceable? clip open) open))
faces (when face (trace/faces clip face)) faces (when face (trace/faces clip face))
;; Every face the open symbol has, which is what the footage switch is
;; about: the stage either has footage behind it or it has none, and that
;; does not depend on what is selected.
here (trace/traceable-faces clip open)
;; Where that face sits, as a row path from the open symbol, so the faces ;; Where that face sits, as a row path from the open symbol, so the faces
;; inside it can be selected by their own rows. A selection made on the ;; inside it can be selected by their own rows. A selection made on the
;; stage has no path and names a node directly in the open symbol; the ;; stage has no path and names a node directly in the open symbol; the
@ -759,12 +829,13 @@
(when (and placed (not palette-placement?)) [symbol-section placed "source symbol"]) (when (and placed (not palette-placement?)) [symbol-section placed "source symbol"])
(when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))} (when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))}
[correction-section node]) [correction-section node])
(when (and (not palette-placement?) (seq here)) [footage-section here]) (when (and (not palette-placement?) (seq footage-faces))
[footage-section footage-faces])
(when (and face (or (trace/traceable? clip face) (seq faces))) (when (and face (or (trace/traceable? clip face) (seq faces)))
[tracing-section face faces path]) [tracing-section face faces path])
(when face ^{:key (str "perf/" face)} [performance-section face]) (when face ^{:key (str "perf/" face)} [performance-section face])
(when palette-symbol? [palette-symbol-section (second selection)]) (when palette-symbol? [palette-symbol-section (second selection)])
(when (and (= :symbol (first selection)) (not palette-symbol?)) (when (and (= :symbol (first selection)) (not palette-symbol?))
[symbol-section (second selection)]) [symbol-section (second selection)])
(when (and tracked? (not palette-placement?) (not palette-symbol?)) (when (and (seq tracking-owners) (not palette-placement?) (not palette-symbol?))
[tracking-section])]])) [tracking-section tracking-owners])]]))

View file

@ -271,25 +271,6 @@
(carrying (str "symbol:" (subs (str sid) 1)) (carrying (str "symbol:" (subs (str sid) 1))
#(drag/symbol! clip-id sid open)))])) #(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] (defn- palette-transition-row [document sid selection rename]
(let [sym (clip/symbol document sid) (let [sym (clip/symbol document sid)
p (get (pal/palettes document) (:palette-ref sym))] p (get (pal/palettes document) (:palette-ref sym))]
@ -423,7 +404,12 @@
(let [named? #(hit? query (clip/symbol-name document %)) (let [named? #(hit? query (clip/symbol-name document %))
top (when (and main (named? main)) main) top (when (and main (named? main)) main)
symbol-ids (sort-by str (keys (:symbols document))) 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) transitions (filterv #(and (named? %) (transition? %)) symbol-ids)
rest (filterv #(and (named? %) (not= main %) rest (filterv #(and (named? %) (not= main %)
(not (#{:palette :palette-track} (not (#{:palette :palette-track}
@ -431,11 +417,10 @@
symbol-ids) symbol-ids)
media (filterv #(hit? query (:label %)) media) 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? [sections searching?
(+ (if top 1 0) (count rest) (count transitions) (+ (if top 1 0) (count rest) (count transitions)
(count media) (count sounds) (count palettes)) (count media) (count sounds))
[{:title "project" :searching? searching? [{:title "project" :searching? searching?
:blank "nothing to open yet" :blank "nothing to open yet"
:rows (when top [(symbol-row document top ctx)])} :rows (when top [(symbol-row document top ctx)])}
@ -445,11 +430,6 @@
{:title "palette transitions" :searching? searching? {:title "palette transitions" :searching? searching?
:blank "no palette transitions" :blank "no palette transitions"
:rows (mapv #(palette-transition-row document % selection rename) 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? {:title "media" :searching? searching?
:blank "drop a video here" :blank "drop a video here"
:rows (mapv #(footage-row % chosen rename) media)} :rows (mapv #(footage-row % chosen rename) media)}

View file

@ -656,11 +656,14 @@
:else [::ui/group [from path]])))))})) :else [::ui/group [from path]])))))}))
[:button.tl-twist [:button.tl-twist
{:disabled (not expandable?) {:disabled (not expandable?)
;; This button lives inside a draggable row label. Do not let a tiny
;; pointer movement turn disclosure into a native row drag (whose click
;; is then suppressed by the browser).
:draggable false
:on-pointer-down (fn [^js e] (.stopPropagation e))
:on-click (fn [^js e] :on-click (fn [^js e]
(println "heyyy")
(.stopPropagation e) (.stopPropagation e)
(rf/dispatch [::ui/toggle-row path])) (rf/dispatch [::ui/set-row-expanded path (not expanded?)]))}
:class (println expandable?)}
(when expandable? (if expanded? "▾" "▸"))] (when expandable? (if expanded? "▾" "▸"))]
;; A LANE IS NOT AN INSTANCE WEARING A DIFFERENT HAT, to read. Its one row ;; A LANE IS NOT AN INSTANCE WEARING A DIFFERENT HAT, to read. Its one row
;; holds blocks that follow one another in time, where every other row ;; holds blocks that follow one another in time, where every other row
@ -887,30 +890,25 @@
;; one, else this row's own instance. It opens as a tab, which is what ;; one, else this row's own instance. It opens as a tab, which is what
;; double-clicking the same symbol in the pool does. ;; double-clicking the same symbol in the pool does.
:on-double-click (fn [^js e] :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
(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) (.stopPropagation e)
(rf/dispatch [::pb/open-symbol source]))) (rf/dispatch [::pb/open-symbol source])))))
:ref (when lane? (fn [el] (when el (aset el "arthurLane" select)))) :ref (when lane? (fn [el] (when el (aset el "arthurLane" select))))
:on-drag-enter (fn [^js e] :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 (cond
(and (= :palette kind) (drag/palette?))
(do (.preventDefault e) (.stopPropagation e))
(and (not= :palette kind) lane? (and (not= :palette kind) lane?
(or (drag/accepts?) (drag/row))) (or (drag/accepts?) (drag/row)))
(do (.preventDefault e) (.stopPropagation e)))) (do (.preventDefault e) (.stopPropagation e))))
:on-drag-over (fn [^js e] :on-drag-over (fn [^js e]
(cond (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? (and (not= :palette kind) lane?
(or (drag/accepts?) (drag/row))) (or (drag/accepts?) (drag/row)))
(do (.preventDefault e) (.stopPropagation e) (do (.preventDefault e) (.stopPropagation e)
@ -920,10 +918,6 @@
(drag/hover! :timeline (frame-at e frames) nil select))))) (drag/hover! :timeline (frame-at e frames) nil select)))))
:on-drop (fn [^js e] :on-drop (fn [^js e]
(cond (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? (and (not= :palette kind) lane?
(or (drag/accepts?) (drag/row))) (or (drag/accepts?) (drag/row)))
(do (.preventDefault e) (do (.preventDefault e)

View file

@ -129,7 +129,7 @@
says where each face's head went and which of its frames it was on, so this says where each face's head went and which of its frames it was on, so this
reads the frame rather than resolving it again. `on-ready` is called when a reads the frame rather than resolving it again. `on-ready` is called when a
still or a manifest that was missing arrives, to paint again." still or a manifest that was missing arrives, to paint again."
[{:keys [document store footage-id traces opacity width playing?]} resolver on-ready] [{:keys [document store traces opacity width playing?]} resolver on-ready]
(when-let [^js canvas (:canvas @state)] (when-let [^js canvas (:canvas @state)]
(let [ctx (.getContext canvas "2d") (let [ctx (.getContext canvas "2d")
zoom (/ (.-width canvas) width)] zoom (/ (.-width canvas) width)]
@ -138,17 +138,20 @@
;; What each face is showing, forgotten for the faces switched off. Before ;; What each face is showing, forgotten for the faces switched off. Before
;; the early exits, so switching them all off forgets all of them. ;; the early exits, so switching them all off forgets all of them.
(swap! state update :last select-keys (map :path traces)) (swap! state update :last select-keys (map :path traces))
(when-let [us (and (seq traces) footage-id (urls footage-id on-ready))] (when (seq traces)
(let [start (first (get-in document [:analysis :range] [0])) (let [;; Read once: each face writes only its own entry below, and what it
;; Read once: each face writes only its own entry below, and what it ;; was showing is what it falls back to.
;; was showing is what it falls back to. A face that has been off
;; stage for a few frames still has the still it went away with.
was (:last @state)] was (:last @state)]
;; ONE OPACITY for all of them, set once: how strongly the reference ;; ONE OPACITY for all of them, set once: how strongly the reference
;; draws is a property of looking at the stage, not of a face. ;; draws is a property of looking at the stage, not of a face.
(set! (.-globalAlpha ctx) opacity) (set! (.-globalAlpha ctx) opacity)
(doseq [{:keys [path face]} traces] (doseq [{:keys [path face]} traces
(let [at (conj path :head) :let [subject (get-in document [:subjects face])
analysis (get-in document [:analyses (:analysis subject)])
us (urls (:footage subject) on-ready)]
:when us]
(let [start (first (get analysis :range [0]))
at (conj path :head)
world (symbol/world-of resolver at) world (symbol/world-of resolver at)
frame (symbol/frame-of resolver at)] frame (symbol/frame-of resolver at)]
(when (and world (number? frame)) (when (and world (number? frame))

View file

@ -26,3 +26,34 @@
(vals (get-in clip [:symbols :take :nodes])))))) (vals (get-in clip [:symbols :take :nodes]))))))
"and the copy's instance follows its renamed symbol") "and the copy's instance follows its renamed symbol")
(is (empty? (clip/problems clip))))) (is (empty? (clip/problems clip)))))
(defn- tracked-take [analysis-id]
{:analyses {analysis-id {:id analysis-id :detector "test" :version "1"}}
:subjects {:face-1 {:id :face-1 :analysis analysis-id
:source-subject :face-1 :params {}}}
:features {:face-1/mouth {:id :face-1/mouth :subject :face-1
:symbol :face-1 :area :mouth :nodes [:mouth] :params {}}}
:groups {}
:symbols {:main {:id :main :fps 30 :frames 10
:nodes {:face-1 {:id :face-1 :kind :instance :z "a1"
:source {:symbol :face-1}}}}
:face-1 {:id :face-1 :fps 30 :frames 10
:nodes {:head {:id :head :kind :group :z "a1"
:measured {[:xform :pos]
{:animated? false :value [0 0]}}}
:mouth {:id :mouth :kind :poly :z "a2"}}}}})
(deftest every-import-is-tracked-under-its-unique-symbol-scope
(let [first (bring/take (clip/blank) (tracked-take "analysis-a")
"close up" "footage-a" [0 10])
second (bring/take (:clip first) (tracked-take "analysis-b")
"close up" "footage-b" [0 10])
c (:clip second)]
(is (= #{:close-up.face-1 :close-up-2.face-1} (set (keys (:subjects c)))))
(is (= #{"analysis-a" "analysis-b"} (set (keys (:analyses c)))))
(is (= "analysis-a" (get-in c [:subjects :close-up.face-1 :analysis])))
(is (= "analysis-b" (get-in c [:subjects :close-up-2.face-1 :analysis])))
(is (= :face-1 (get-in c [:subjects :close-up-2.face-1 :source-subject])))
(is (= #{:close-up.face-1/mouth :close-up-2.face-1/mouth}
(set (keys (:features c)))))
(is (empty? (clip/problems c)))))

View file

@ -90,8 +90,17 @@
(is (or (zero? f) (< (clip/shown-frame doc :main (dec f)) n)))))))) (is (or (zero? f) (< (clip/shown-frame doc :main (dec f)) n))))))))
(deftest imported-footage-uses-selection-for-picture-and-real-speed-for-audio (deftest imported-footage-uses-selection-for-picture-and-real-speed-for-audio
(let [{doc :clip sid :sid} (bring/take (clip/set-fps (clip/blank) 12) (let [tracked (-> footage
footage "take" "video" [15 75]) (assoc :analyses {"a" {:id "a"}}
:subjects {:face-1 {:id :face-1 :analysis "a"
:source-subject :face-1}}
:features {} :groups {}
:symbols {:main {:id :main :fps 30 :frames 60
:nodes {:face-1 {:id :face-1 :kind :instance
:z "a" :source {:symbol :face-1}}}}
:face-1 (get-in footage [:symbols :main])}))
{doc :clip sid :sid} (bring/take (clip/set-fps (clip/blank) 12)
tracked "take" "video" [15 75])
;; A host authored at 12, with a 30fps source starting half a second in. ;; A host authored at 12, with a 30fps source starting half a second in.
doc (-> doc (assoc-in [:symbols :main :fps] 12) doc (-> doc (assoc-in [:symbols :main :fps] 12)
(clip/place-symbol store :main sid 6 :insert nil)) (clip/place-symbol store :main sid 6 :insert nil))
@ -99,21 +108,16 @@
draw (clip/resolver doc :main store pal/index-of nil) draw (clip/resolver doc :main store pal/index-of nil)
[sound] (nest/audio-tracks doc :main)] [sound] (nest/audio-tracks doc :main)]
(is (= 60 (clip/frames doc sid))) (is (= 60 (clip/frames doc sid)))
(is (= 1 (get-in doc [:symbols sid :nodes :sound :time :rate]))) (is (= 1 (get-in doc [:symbols :take.face-1 :nodes :sound :time :rate])))
(is (= [0 24] (:span n))) (is (= [0 24] (:span n)))
(is (empty? (draw 5))) (is (empty? (draw 5)))
(is (= 8 (:size (first (draw 9))))) (is (= 8 (:size (first (draw 9)))))
(is (= 7 (:frame (nest/inside doc store :main [:insert :mark] 9)))) (is (= 7 (:frame (nest/inside doc store :main [:insert :face-1 :mark] 9))))
(is (= [-4 -4 4 4] ((pick/bounds-of doc store :main n) 3))) (is (= [-4 -4 4 4] ((pick/bounds-of doc store :main n) 3)))
(is (= [6 30] (node/placed-span sound))) (is (= [6 30] (node/placed-span sound)))
(is (= 15 (node/local-frame sound 6))) (is (= 15 (node/local-frame sound 6)))
(is (= 1 (* (get-in sound [:time :rate]) (/ (:fps doc) (:fps sound))))) (is (= 1 (* (get-in sound [:time :rate]) (/ (:fps doc) (:fps sound)))))
(is (= [6 30] (:span (first (timeline/rows doc :main #{[:insert]}))))) (is (= [6 30] (:span (first (timeline/rows doc :main #{[:insert]})))))
(testing "an off-grid closed mouth can win without modifying the dense source"
(let [pinned (pose/put-cut doc :main :insert :mouth 7 6)
r (clip/resolver pinned :main store pal/index-of nil)]
(is (= 7 (:size (first (r 9)))))
(is (= (get-in doc [:symbols sid]) (get-in pinned [:symbols sid])))))
(testing "a deliberate half speed still retimes audio" (testing "a deliberate half speed still retimes audio"
(let [slow (assoc-in doc [:symbols :main :nodes :insert :playback :speed] 0.5) (let [slow (assoc-in doc [:symbols :main :nodes :insert :playback :speed] 0.5)
[track] (nest/audio-tracks slow :main)] [track] (nest/audio-tracks slow :main)]
@ -121,7 +125,9 @@
(deftest generated-faces-own-their-footage-sound (deftest generated-faces-own-their-footage-sound
(let [face (fn [id] {:id id :fps 30 :frames 20 :nodes {}}) (let [face (fn [id] {:id id :fps 30 :frames 20 :nodes {}})
frozen {:fps 30 :subjects {:face-1 {} :face-2 {}} frozen {:fps 30 :analyses {"a" {:id "a"}}
:subjects {:face-1 {:id :face-1 :analysis "a" :source-subject :face-1}
:face-2 {:id :face-2 :analysis "a" :source-subject :face-2}}
:symbols {:main {:id :main :fps 30 :frames 20 :symbols {:main {:id :main :fps 30 :frames 20
:nodes {:face-1 {:id :face-1 :kind :instance :z "a1" :nodes {:face-1 {:id :face-1 :kind :instance :z "a1"
:source {:symbol :face-1}} :source {:symbol :face-1}}
@ -130,11 +136,11 @@
:face-1 (face :face-1) :face-1 (face :face-1)
:face-2 (face :face-2)}} :face-2 (face :face-2)}}
{doc :clip take :sid} (bring/take (clip/blank) frozen "take" "video" [3 13]) {doc :clip take :sid} (bring/take (clip/blank) frozen "take" "video" [3 13])
alone (clip/place-symbol doc nil :main :face-1 4 :placed-face nil)] alone (clip/place-symbol doc nil :main :take.face-1 4 :placed-face nil)]
(is (nil? (get-in doc [:symbols take :nodes :sound])) (is (nil? (get-in doc [:symbols take :nodes :sound]))
"the wrapper does not own a sound the face would lose") "the wrapper does not own a sound the face would lose")
(is (= {:footage "video"} (is (= {:footage "video"}
(get-in doc [:symbols :face-1 :nodes :sound :source]))) (get-in doc [:symbols :take.face-1 :nodes :sound :source])))
(is (= 1 (count (nest/audio-tracks doc take))) (is (= 1 (count (nest/audio-tracks doc take)))
"the same take recording is not mixed once per detected face") "the same take recording is not mixed once per detected face")
(is (= 1 (count (nest/audio-tracks alone :main))) (is (= 1 (count (nest/audio-tracks alone :main)))

View file

@ -4,7 +4,8 @@
in the renderer reads. These assert the parts of that claim that could silently in the renderer reads. These assert the parts of that claim that could silently
stop being true." stop being true."
(:require [cljs.test :refer [deftest is testing]] (: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 ---- ;; ---- the three shapes read the same way ----
@ -392,6 +393,21 @@
(is (= {:from :day :to :night :t 0.5} (is (= {:from :day :to :night :t 0.5}
(ch/value-at blend 5 nil))))) (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 (deftest numeric-channels-can-ramp-between-keys
(let [c (ch/keyed {0 0.0, 10 1.0} :linear) (let [c (ch/keyed {0 0.0, 10 1.0} :linear)
cursor (ch/cursor c nil)] cursor (ch/cursor c nil)]

View file

@ -406,3 +406,32 @@
(is (nil? (:refused extended)) (:refused extended)) (is (nil? (:refused extended)) (:refused extended))
(is (= [0 6] (node/placed-span (is (= [0 6] (node/placed-span
(get-in extended [:clip :symbols :palettes :nodes :change])))))) (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))))))

View file

@ -45,7 +45,7 @@
(let [ls (leaf/leaves :c7 @take/clip)] (let [ls (leaf/leaves :c7 @take/clip)]
(is (contains? ls "clip/c7/timing")) (is (contains? ls "clip/c7/timing"))
(is (contains? ls "clip/c7/stage")) (is (contains? ls "clip/c7/stage"))
(is (contains? ls "clip/c7/source")) (is (contains? ls "clip/c7/analyses"))
;; A TIMELINE ID IS A SEGMENT, which is what lets a symbol's nodes be ;; A TIMELINE ID IS A SEGMENT, which is what lets a symbol's nodes be
;; addressed by the same path shape as the clip's own. `main` is the root. ;; addressed by the same path shape as the clip's own. `main` is the root.
(is (contains? ls "clip/c7/symbol/main")) (is (contains? ls "clip/c7/symbol/main"))

View file

@ -226,3 +226,20 @@
(is (= :linear (get-in moved [:channels [:xform :rot] :interp]))) (is (= :linear (get-in moved [:channels [:xform :rot] :interp])))
(is (= :hold (get-in visible [:channels [:vis] :interp])) (is (= :hold (get-in visible [:channels [:vis] :interp]))
"boolean parameters do not tween"))) "boolean parameters do not tween")))
(deftest colour-keys-are-discrete
(let [n {:id :x :kind :poly
:channels {[:style :color] (ch/framed 2)}}
keyed (node/set-keyed-channel n [:style :color] 3 4)
two (node/set-keyed-channel keyed [:style :color] 8 7)]
(is (= :hold (get-in two [:channels [:style :color] :interp]))
"numeric palette slots still hold")
(is (= two (node/set-segment-interp two [:style :color] 3 :linear))
"a caller cannot introduce a colour tween")
(is (= :hold (get-in (node/set-channel
(assoc-in two [:channels [:style :color] :interp] :linear)
[:style :color] 8 6)
[:channels [:style :color] :interp]))
"editing repairs an older tweened colour channel")
(is (= :hold (get-in (node/toggle-key n [:style :color] 3 nil)
[:channels [:style :color] :interp])))))

View file

@ -5,6 +5,7 @@
[arthur.domain.history :as history] [arthur.domain.history :as history]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.sequence-test :as fixture] [arthur.domain.sequence-test :as fixture]
[arthur.domain.span :as span] [arthur.domain.span :as span]
[arthur.events.ui :as ui] [arthur.events.ui :as ui]
@ -71,6 +72,44 @@
(vals (get-in saved [:symbols :main :nodes])))) (vals (get-in saved [:symbols :main :nodes]))))
"claiming the frame leaves no overlapping cel")))) "claiming the frame leaves no overlapping cel"))))
(deftest double-click-creation-uses-the-lane-and-playhead
(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 5}})
(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])
selection (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 (= (node/source instance)
(:sid (creation/target saved {} :main selection 5)))
"the new cel can immediately be selected as the creation target")
(is (= 5 (get-in @rf-db/app-db [:playback :frame]))
"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 5}})
(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 (deftest a-new-lane-uses-the-symbol-selected-at-the-playhead
(let [doc (clip/blank) (let [doc (clip/blank)
id (store/install! {:clip doc :store {}} "nested-new-lane")] id (store/install! {:clip doc :store {}} "nested-new-lane")]
@ -178,6 +217,36 @@
(at 25)) (at 25))
"a lane behind an inactive parent occurrence is not valid"))) "a lane behind an inactive parent occurrence is not valid")))
(deftest creation-uses-the-occurrence-path-at-arbitrary-depth
(let [instance (fn [id source span]
{:id id :kind :instance :z "a" :span span
:time {:mode :map :at 0 :rate 1}
:source {:symbol source}
:playback {:in 0 :speed 1 :end :stop}})
doc {:fps 24 :width 20 :height 20
:symbols
{:main {:id :main :frames 20
:nodes {:outer (instance :outer :ordinary [0 20])}}
:ordinary {:id :ordinary :frames 20
:nodes {:lane (instance :lane :symbol-7 [0 20])}}
:symbol-7 {:id :symbol-7 :name "symbol-7" :display :lane :frames 20
:nodes {:cel (instance :cel :symbol-8 [4 10])}}
:symbol-8 {:id :symbol-8 :name "symbol-8" :frames 6 :nodes {}}}}
lane-selection [:node :ordinary :lane [:outer :lane]]
;; The path, rather than these redundant owner fields, is authoritative
;; for creation. A row address may name the occurrence from an outer
;; view; resolution must still enter the terminal cel.
cel-selection [:node :ordinary :lane [:outer :lane :cel]]
pick #(select-keys (creation/target doc nil :main % 5)
[:kind :sid :path :frame])]
(is (= {:kind :lane :sid :symbol-7 :path [:outer :lane] :frame 5}
(pick lane-selection))
"the nested lane header remains the lane insertion surface")
(is (= {:kind :symbol :sid :symbol-8
:path [:outer :lane :cel] :frame 5}
(pick cel-selection))
"the cel enters its symbol no matter how deeply the lane is nested")))
(deftest creation-walks-out-of-an-instance-past-its-window (deftest creation-walks-out-of-an-instance-past-its-window
(let [doc {:fps 24 :width 20 :height 20 (let [doc {:fps 24 :width 20 :height 20
:symbols :symbols
@ -325,6 +394,16 @@
(is (= #{[:already-open]} (get-in after [:ui :expanded])) (is (= #{[:already-open]} (get-in after [:ui :expanded]))
"disclosure is changed only by the twist control"))) "disclosure is changed only by the twist control")))
(deftest disclosure-sets-the-state-painted-by-the-button
;; A move can reveal a destination after the old, closed button has already
;; received pointer-down. Its eventual click must keep the row open instead
;; of toggling the newer state closed again.
(reset! rf-db/app-db {:ui {:expanded #{[:destination]}}})
(rf/dispatch-sync [::ui/set-row-expanded [:destination] true])
(is (= #{[:destination]} (get-in @rf-db/app-db [:ui :expanded])))
(rf/dispatch-sync [::ui/set-row-expanded [:destination] false])
(is (empty? (get-in @rf-db/app-db [:ui :expanded]))))
(deftest finishing-a-polygon-opens-no-rows (deftest finishing-a-polygon-opens-no-rows
;; Expansion is the twist triangle's business. Finishing a shape used to open ;; 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 ;; every row down to it, which inside a lane meant tearing its one row into a

View file

@ -2,6 +2,7 @@
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[clojure.walk :as walk] [clojure.walk :as walk]
[arthur.demo.stage :as stage] [arthur.demo.stage :as stage]
[arthur.domain.bring :as bring]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.params :as params] [arthur.domain.params :as params]
@ -29,13 +30,41 @@
(merge take/knobs (merge take/knobs
{:name "regen" :fps 30 :aspect 1 :stage [320 200] {:name "regen" :fps 30 :aspect 1 :stage [320 200]
:expose 1 :head :free :expose 1 :head :free
:analysis (get-in @initial [:clip :analysis])} :analysis (-> @initial :clip :analyses vals first)}
change) change)
{:face-1 @inputs})) {:face-1 @inputs}))
(defn- channel [entry node path] (defn- channel [entry node path]
(get-in entry [:clip :symbols :face-1 :nodes node :channels path])) (get-in entry [:clip :symbols :face-1 :nodes node :channels path]))
(deftest a-second-import-regenerates-through-its-own-analysis
(let [built (fn [seed]
(let [input {:dense (synth/synth-dense frames {:seed seed})}
analysis (address/analysis
{:detector "synth" :version "mulberry32"
:seed seed :frames frames :fps 30 :aspect 1})]
[(take/build (merge take/knobs
{:name "take" :fps 30 :aspect 1 :stage [320 200]
:expose 1 :head :free :analysis analysis})
{:face-1 input})
input]))
[a input-a] (built 3)
[b input-b] (built 7)
first (bring/take (clip/blank) (:clip a) "shot" "footage-a" [0 frames])
second (bring/take (:clip first) (:clip b) "shot" "footage-b" [0 frames])
entry {:clip (:clip second) :store (merge (:store a) (:store b))
:source-inputs {:subjects {:shot.face-1 input-a
:shot-2.face-1 input-b}}}
fid :shot-2.face-1/mouth
changed (regenerate/change entry
{:scope :feature :id fid :knob :verts :value 10})
analysis-id (get-in changed [:clip :subjects :shot-2.face-1 :analysis])
generated (get-in changed [:clip :symbols :shot-2.face-1 :nodes :mouth
:channels [:geom :pts] :generated])]
(is (= (get-in b [:clip :subjects :face-1 :analysis]) analysis-id))
(is (= analysis-id (:analysis generated)))
(is (= 10 (get-in generated [:params :verts])))))
(deftest eye-rebuild-is-confined-to-the-edited-feature (deftest eye-rebuild-is-confined-to-the-edited-feature
(let [before @initial (let [before @initial
after (regenerate/change before after (regenerate/change before
@ -170,7 +199,7 @@
(defn- part-at [area overrides] (defn- part-at [area overrides]
(let [p (merge take/knobs (let [p (merge take/knobs
{:fps 30 :aspect 1 :analysis (get-in @initial [:clip :analysis])} {:fps 30 :aspect 1 :analysis (-> @initial :clip :analyses vals first)}
overrides) overrides)
inputs (assoc @inputs :interior @interior-track)] inputs (assoc @inputs :interior @interior-track)]
(freeze/part :face-1 area p (take/measure-part area p inputs (take/anchor-base p inputs))))) (freeze/part :face-1 area p (take/measure-part area p inputs (take/anchor-base p inputs)))))
@ -212,8 +241,8 @@
;; document that cannot be previewed fails in the suite rather than as a slider ;; document that cannot be previewed fails in the suite rather than as a slider
;; that silently does nothing in the browser. ;; that silently does nothing in the browser.
(let [entry (staged)] (let [entry (staged)]
(is (some? (:analysis (:clip entry))) (is (seq (:analyses (:clip entry)))
"the composed stage keeps the analysis the edit needs") "the composed stage keeps the analyses its edits need")
(is (some? (:source-inputs entry))) (is (some? (:source-inputs entry)))
(testing "and the features still say which timeline they live in" (testing "and the features still say which timeline they live in"
(is (every? #(= :face-1 (:symbol %)) (is (every? #(= :face-1 (:symbol %))

View file

@ -1384,6 +1384,14 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.facts dd.channel .key { padding: 0 3px; color: var(--dim); } .facts dd.channel .key { padding: 0 3px; color: var(--dim); }
.facts dd.channel .key.keyed { color: var(--fg); } .facts dd.channel .key.keyed { color: var(--fg); }
.facts dd.channel .key.on { color: var(--sel); } .facts dd.channel .key.on { color: var(--sel); }
.facts dd.channel .channel-swatches {
display: flex;
flex: 1;
flex-wrap: wrap;
gap: 3px;
min-width: 0;
}
.facts dd.channel .channel-swatches .swatch { flex: 0 0 15px; }
.facts dd.channel.live { .facts dd.channel.live {
margin: -2px; margin: -2px;
padding: 2px; padding: 2px;