Compare commits

..

2 commits

Author SHA1 Message Date
Your Name
7e34d0c704 Make the media pool a list you can actually read
Every row is one line now — a thumbnail at the stage's own 16:10, the name,
and the one number you need before dragging it somewhere — at the timeline's
own row height. Two always-open folders cost eight headings before the first
row in a pane 210px wide; they are two tabs, and a search counts its hits in
the scope you are not looking at so nothing can hide behind the one you did
not pick.

Symbols draw their own first frame, through the resolver and rasteriser the
stage uses. A PLACED symbol is drawn where it is placed, with the rest of its
host isolated away: rooting at a symbol renders its DRAWING, and a rotoscoped
face is head-local in units of one image height, so the source-to-stage scale
that makes it pixels lives on the :face group of whatever places it. Rendered
rooted at itself a face is correct and under a pixel across. Thumbnails are
smoothly downscaled for the same kind of reason the preview is not: at a tenth
of the stage's size nearest neighbour samples one pixel in a hundred, and the
silhouette is the whole of what makes a thumbnail recognisable.

Names are editable, and that is two operations behind one pencil. A symbol's
name is a field of this document, so it is an undoable edit and blank gives it
back its id. Footage and sounds live beside projects rather than inside one,
so theirs is a server write shared by every project using the row — PATCH on
the existing Footage.label, and a new Sound.label kept separate from the
filename, which is a fact about the upload and not somebody's name for it.

No TIMELINES section beside a SYMBOLS one: every symbol here IS a timeline, so
that pair named one thing twice. What is true is that exactly one of them is
where the work happens, and clip/opens-on already answers which — it leads the
pane as PROJECT, drawn at a size you can read a pose off, with the library
under it. Still not :main being special; rename it or place it inside
something else and the pool follows.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-10-01 00:56:39 -04:00
Your Name
815ce449ea Author corrections without baking them into motion
Constant, ramp, and return offsets now append ordinary channel layers to a lane or cel in explicit owner frames. The inspector exposes the commands as one undoable transaction, shows conflicts, and offers removal or retry while preserving generated bases through regeneration.

Ordered-stack compatibility is shared by validation, conflict reporting, and regeneration, including adjacent replacement coverage. Cel-sheet gaps and headers select their lane, so commands cannot fall through to another column's stale selection.

437 tests, 5,804 assertions; both browser flows; 56 Django tests; optimized frontend build.
2026-10-01 00:29:59 -04:00
24 changed files with 1730 additions and 220 deletions

View file

@ -0,0 +1,18 @@
# Generated by Django 5.2.17 on 2026-10-01 04:38
from django.db import migrations, models
class Migration(migrations.Migration):
dependencies = [
('clips', '0011_occurrence_schema'),
]
operations = [
migrations.AddField(
model_name='sound',
name='label',
field=models.CharField(blank=True, help_text='what a person called it; the filename when empty. Separate from `filename` because the name on disk is a fact about the upload and renaming must not rewrite it', max_length=200),
),
]

View file

@ -60,6 +60,12 @@ class Sound(models.Model):
id = models.UUIDField(primary_key=True, default=uuid.uuid4, editable=False)
blob = models.ForeignKey(Blob, on_delete=models.PROTECT, related_name="sound_for")
filename = models.CharField(max_length=255)
label = models.CharField(
max_length=200, blank=True,
help_text="what a person called it; the filename when empty. Separate "
"from `filename` because the name on disk is a fact about the "
"upload and renaming must not rewrite it",
)
duration = models.FloatField(help_text="seconds, as ffprobe reports it")
created = models.DateTimeField(auto_now_add=True)

View file

@ -657,6 +657,64 @@ class FootageTests(TestCase):
with self.assertRaisesMessage(CommandError, "refusing an inaccurate footage"):
call_command("ingest_bundle", str(root), stdout=StringIO())
def test_footage_can_be_renamed_and_falls_back_when_cleared(self):
"""A LABEL IS THE ONE FIELD A CLIENT MAY WRITE ON FOOTAGE. The rest is a
description of bytes that are content-addressed and immutable, so a
rename that could reach `frames` or `digest` would let the pool's name
for a clip contradict the clip."""
footage = self.ingest(self.bundle())
self.assertEqual("IMG_8608.MOV", self.client.get(
f"/api/footage/{footage.id}").json()["label"])
renamed = self.client.patch(f"/api/footage/{footage.id}",
json.dumps({"label": " the long take "}),
content_type="application/json")
self.assertEqual(200, renamed.status_code, renamed.content)
self.assertEqual("the long take", renamed.json()["label"])
# On the row, so every project listing this footage sees the new name.
footage.refresh_from_db()
self.assertEqual("the long take", footage.label)
self.assertEqual("the long take",
self.client.get("/api/footage").json()["footage"][0]["label"])
# Cleared gives back the name it was ingested under rather than nothing.
cleared = self.client.patch(f"/api/footage/{footage.id}",
json.dumps({"label": ""}),
content_type="application/json")
self.assertEqual("IMG_8608.MOV", cleared.json()["label"])
self.assertEqual(3, Footage.objects.get().frames)
def test_a_rename_that_names_no_label_is_refused(self):
footage = self.ingest(self.bundle())
refused = self.client.patch(f"/api/footage/{footage.id}",
json.dumps({"frames": 900}),
content_type="application/json")
self.assertEqual(400, refused.status_code)
self.assertEqual("a rename needs a label", refused.json()["error"])
self.assertEqual(3, Footage.objects.get().frames)
def test_a_sound_is_renamed_without_losing_the_name_it_arrived_as(self):
"""`filename` is a fact about the upload and `label` is what a person
called it, which is why renaming does not write over the first one."""
digest, size = blobs.write_stream([b"RIFF....WAVEfmt "])
blob = Blob.objects.create(digest=digest, size=size, media_type="audio/wav")
sound = Sound.objects.create(blob=blob, filename="rec0012.wav", duration=2.5)
renamed = self.client.patch(f"/api/sounds/{sound.id}",
json.dumps({"label": "arthur, line 4"}),
content_type="application/json")
self.assertEqual(200, renamed.status_code, renamed.content)
self.assertEqual("arthur, line 4", renamed.json()["label"])
self.assertEqual("rec0012.wav", renamed.json()["filename"])
sound.refresh_from_db()
self.assertEqual("rec0012.wav", sound.filename)
self.assertEqual("arthur, line 4", sound.label)
self.client.patch(f"/api/sounds/{sound.id}", json.dumps({"label": " "}),
content_type="application/json")
self.assertEqual("rec0012.wav",
self.client.get(f"/api/sounds/{sound.id}").json()["label"])
def test_the_footage_list_does_not_carry_every_url(self):
# A list of takes should not be a list of six hundred URLs each.
self.ingest(self.bundle())

View file

@ -226,10 +226,31 @@ def sources(request):
def _sound_json(row):
return {"id": str(row.id), "label": row.filename, "duration": row.duration,
return {"id": str(row.id), "label": row.label or row.filename,
"filename": row.filename, "duration": row.duration,
"audio": f"/blob/{row.blob_id}"}
def _relabel(request, row):
"""PATCH one asset's display name.
A LABEL IS THE ONLY FIELD EITHER ROW LETS A CLIENT WRITE, and the body is
read for that key alone. Footage is content-addressed and its frame count,
rate and digest are facts about the bytes; an endpoint that merged whatever
it was sent would let a rename quietly contradict them. Blank clears it,
which puts the row back to the name it was uploaded under rather than
leaving it nameless.
"""
data = _body(request)
if "label" not in data:
raise Bad("a rename needs a label")
label = str(data["label"] or "").strip()[:200]
if label != row.label:
row.label = label
row.save(update_fields=["label"])
return row
@require_http_methods(["GET", "POST"])
def sounds(request):
if request.method == "GET":
@ -252,12 +273,18 @@ def sounds(request):
return JsonResponse({"error": str(exc)}, status=400)
@require_http_methods(["GET"])
@require_http_methods(["GET", "PATCH"])
def sound_detail(request, sound_id):
try:
return JsonResponse(_sound_json(Sound.objects.get(id=sound_id)))
row = Sound.objects.get(id=sound_id)
except Sound.DoesNotExist:
return JsonResponse({"error": "no such sound"}, status=404)
try:
if request.method == "PATCH":
row = _relabel(request, row)
except Bad as exc:
return _error(exc)
return JsonResponse(_sound_json(row))
def _extraction_json(row):
@ -367,12 +394,17 @@ def symbols(request):
return JsonResponse({"symbols": rows})
@require_http_methods(["GET"])
@require_http_methods(["GET", "PATCH"])
def footage_detail(request, footage_id):
try:
footage = Footage.objects.select_related("audio", "video", "stream").get(id=footage_id)
except Footage.DoesNotExist:
return JsonResponse({"error": "no such footage"}, status=404)
try:
if request.method == "PATCH":
footage = _relabel(request, footage)
except Bad as exc:
return _error(exc)
return JsonResponse(_footage_json(footage))

View file

@ -0,0 +1,232 @@
# Correction authoring implementation plan
Written against `2f1c9b9` (2026-09-30), following the lane handoff in
`7a54bfc`. Implemented on `codex/correction-authoring`; this now records the
scope and acceptance criteria of that implementation.
Read [lane-handoff.md](lane-handoff.md) and the correction section of
[lane-model.md](lane-model.md) first. Their ownership and document rules remain
the foundation. The choices below settle the first implementation's scope.
## Outcome
A person can select a lane or cel, specify a range, and apply Constant
adjustment, Ramp, or Return motion to rotation or position. The result is one
correction layer and one undo step. It works from either timing view. A lane
correction crosses drawing boundaries; a cel correction travels with its cel.
Regeneration preserves the hand work and presents incompatible layers for an
explicit decision. Frames outside the support evaluate exactly as before.
Finish this vertical slice before adding more property types or gestures.
Numeric range fields and an Apply button are sufficient for this pass. Dragging
a range or manipulating a peak on the stage can later issue the same command.
## 1. Fix sheet targeting first
In `ui/timeline.cljs`, `cel-sheet` currently drops each lane row's `:select`.
An occupied cell selects its cel; a gap only seeks, leaving the previous target
selected. Thus clicking lane B's gap after selecting lane A can send an insert
or overwrite to A.
Carry the row's complete selection address into its column and gap cells.
An occupied cell selects its cel; a gap selects its lane. Make the column header
select the lane too: this is the explicit way to author across drawings.
Preserve full paths, not just `(peek path)`, as view identity. Keep seek and
selection dispatch order deterministic.
Add a two-lane browser case: select A, click a gap in B, overwrite, assert that
only B changes, and undo once. Add a header-selection assertion. Retain the
existing occupied-cell hold test. Do not redesign sheet rendering in this step.
## 2. Make stack compatibility consistent
There is a concrete discrepancy at this HEAD:
- `channel/problems` uses `stack-conflict`, accounting for prior replacements.
- `channel/conflicts` and `flow/regenerate.cljs`'s `rebased` use
`conflict-with`, comparing an offset directly with the base.
A two-component base, a covering three-component replacement, then a
three-component offset is valid and evaluates correctly, but the latter paths
can report or mark that offset incompatible. Conversely a replacement can make
an offset incompatible even when it fits the original base.
Extract one ordered-stack compatibility operation and use it for validation,
conflict discovery, regeneration, and resolution. Keep `conflict-with` if useful
for the narrower question its name/docstring describe. Do not use it alone to
decide whether a stacked layer is applicable.
Compute compatibility against the values that can actually reach a layer over
its support. Partition at overlapping support boundaries if needed: two adjacent
replacements can jointly cover an offset even though neither covers it alone.
An empty replacement channel does not supply a value and must not erase the
possible input shape. Preserve the evaluator's absence behavior. Explicitly
marked conflicts are skipped, so later layers must be checked against the stack
that actually runs. During regeneration, recompute compatibility in order, using
each preceding layer's resulting active/conflicted state. Preserve IDs, values,
support, and order; update compatibility reasons without dropping hand work.
Use structural shape reasoning for dense data rather than requiring every block
to be sampled. If unknown shape or missing samples limit what can be proven,
retain the current absence contract and document that limit; do not claim an
unconditional proof of runtime safety from incomplete metadata.
Tests: covering replacement of a different shape; partial coverage; adjacent
covering replacements; empty replacement; inactive conflicted replacement;
regeneration changing base shape; and the same cases through cursor evaluation.
Assert that an accepted compatible stack is not listed as a conflict, and that
an incompatible regenerated layer remains persisted but is skipped.
## 3. Pure correction commands
Add `frontend/src/arthur/domain/correction.cljs`. It owns authoring and resolving
corrections; `channel.cljs` continues to own evaluation and compatibility.
Suggested API (names may follow repository conventions):
```clojure
(add clip sid node-id channel-path
{:id layer-id :support [a b] :motion :return
:start 0 :peak angle :peak-frame p})
(remove-layer clip sid node-id channel-path layer-id)
(retry-layer clip sid node-id channel-path layer-id)
```
Return `{:clip updated :selection node-id}` or `{:refused reason}`. IDs come
from the event caller (`random-uuid`), never from the pure command. Reject a nil
ID or one already used within that channel stack. Address layers by the full
symbol/node/channel/layer tuple; no global layer registry is needed.
Resolve the base via `node/channels`, which supplies defaults. A lane with no
explicit rotation channel already has a zero rotation; materialize that channel
with its new `:over`. Preserve every existing base field, generated provenance,
and previous layer. Never route this through a setter that bakes the correction
into base keys. Append to the ordered stack and validate the resulting document.
Do not run correction edits through `lane/finish`, whose extent policy belongs
to cel arrangement. Use `clip/problems` for the candidate document instead.
First authoring properties: `[:xform :rot]` (scalar radians) and `[:xform :pos]`
(two numeric components). First blend operation: `:offset`. UI labels must say
offset/delta, since a target offset of 20 degrees does not mean an absolute
rotation of 20 degrees. Keep existing `:replace` evaluation and loaded stacks;
there is no new replacement-authoring UI in this slice.
All command support endpoints are finite integer OWNER frames, `[a b)`, with
`a < b`. Do not ban negative owner frames merely because displayed shot frames
start at zero. Validate all supplied values for finite numbers and exact shape.
Refuse unknown targets, unsupported properties/motions, malformed ranges, and
incompatible stacks with useful messages. Refusal must not mutate store/history.
Motion construction uses existing channels only:
| Command | Values | Minimum samples |
| --- | --- | --- |
| Constant adjustment | `(ch/framed delta)` | 1 |
| Ramp | `(ch/keyed {a start, (dec b) end} :linear)` | 2 |
| Return motion | `(ch/keyed {a start, p peak, (dec b) start} :linear)` | 3 |
For Return, require integer `a < p < b-1`. Default the UI peak to
`a + floor((b-a-1)/2)`; on an even-length range the earlier middle sample wins.
Expose the peak frame so this is visible and adjustable. Never place an endpoint
at `b`: it is outside the selected samples. `[10 13)` with start 0 and peak 0.5
must yield offsets `0, 0.5, 0` at 10, 11, 12. Support controls the boundary;
there is no need to insert zero keys into the base before/after it.
## 4. Owner and range UI
Add a Corrections section to the right pane (`ui/params.cljs`), extracting a
`ui/corrections.cljs` component if that keeps the pane readable. Provide an
explicit target readout (symbol, lane or cel), Rotation/Position, motion choice,
From/Through fields, relevant value fields, peak frame for Return, and Apply.
Offer a selected cel's owning lane as an explicit target choice. Do not silently
promote a cel edit to a lane edit. Shared drawing content is outside this first
UI; it has different sharing consequences.
For this first pass the range fields explicitly read **owner frames**, with
inclusive From/Through converted to `[from, through+1)`. This is a deliberate
UI scope choice, not a claim that a displayed shot range and owner range are
interchangeable. It lets nested and retimed owners be addressed without an
unproven range conversion. Match the existing zero-based numbering and show the
owner beside the range. The handoff must record that displayed-range dragging
is still outstanding.
Use an explicit three-sample initial draft in owner coordinates; for a cel,
prefer its span start where it is integral. Show the range, allow adjustment,
and do not extend a cel or shot to make the correction visible. Reset the draft
when the target changes. Rotation is shown in degrees and converted to radians
at the event boundary, following the existing inspector convention. Position
uses x/y inputs in the owner's transform coordinates.
Draft inputs must not write document state, start history groups, or invoke the
existing inspector `number-input`'s hold/settle behavior. Apply dispatches one
event; success uses `edit/transaction` once and preserves the selected node's
full address. Do not use a layer ID as node selection. Validate again at Apply,
since the target/document may have changed since the draft was opened.
If adding a “use playhead” convenience, prove its mapping separately. The clock
of a cel's transform is its own node clock, not the drawing source clock selected
by `:playback`. `nest/inside` on the complete cel path enters the source and is
therefore the wrong shortcut. The existing `selection-frame` resolves only the
owning symbol; node/ancestor time conversion remains necessary. Floors, loops,
and nonintegral mappings must never silently snap an authored range. Omit this
convenience rather than expanding the first pass into a new timing system.
## 5. Conflict actions and regeneration proof
Show a document-wide list from `clip/conflicts` in the pane, including symbol,
node, property, layer ID, and reason. Keep it accessible even when a different
node is selected. Also list the selected target's layers in stack order with
support, motion values, and status; do not require a new persisted motion label.
Provide Remove correction and Retry compatibility. Remove is explicit and
undoable; Retry rechecks the complete candidate stack and clears a conflict only
when it is valid. If retry would invalidate a downstream offset, refuse and say
why. Similarly, removing a replacement that makes a later offset invalid must
refuse, rather than commit an invalid document or silently remove more layers.
A retry that changes nothing must not manufacture an undo step.
These are minimal resolution actions, not topology remapping. Automatic geometry
remapping, reordering layers, editing arbitrary stored vector values, and resolving
removed targets are separate work. Preserve all existing generated-data behavior.
Exercise the actual `flow/regenerate.cljs` entry points in integration tests:
author a correction, regenerate compatible base data, and confirm the correction
survives with its ID/support/values intact and affects the new base. Then change
topology on a geometry fixture and assert persisted actionable conflicts. The
geometry fixture can use an existing layer directly; geometry authoring is not
required to expose and resolve a conflict already present in a document.
## 6. Verification and completion
Use focused tests that establish observable promises:
- Domain: each motion's sample values; refusal on short ranges/nonfinite values;
default channel materialization; unchanged base and prior layers; duplicate ID.
- Evaluation: compare before/after on every frame outside support, including
neighboring interpolated frames. Cursor/spec agreement in nonmonotonic order.
- Ownership: a lane Return crosses a drawing boundary; a cel correction moves
with the cel and survives split/trim. Neither alters another use of its drawing.
- Sampling: picture-rate/pose selection changes the generated base frame while
the authored correction still reads owner time. Keep HEAD's regression tests.
- Events: one Apply is one undo step; undo/redo restores complete layer data;
refusal leaves clip/history unchanged; stale target refuses; selection survives.
- Persistence: leaf and Transit round trips retain layers, order, IDs, conflicts.
- Browser: both views can select a target and apply the same correction using
actual controls. Assert evaluated results and history, not only a layer count.
Include the two-lane gap-targeting case from step 1.
- Regeneration and conflict actions: use the real flow and test undoable removal,
valid retry, invalid retry, and removal that would break a downstream layer.
Run the suites documented in `lane-handoff.md`: CLJS tests, lane and take browser
flows, Django tests, and optimized frontend build. Restore the dev app bundle
after the release build. Note that `take.mjs` writes a local project. Report
actual results and any unrun checks; do not copy previous test counts as evidence.
Suggested commit sequence: sheet targeting; consistent stack compatibility;
pure correction commands; pane/events plus browser proof; updated handoff.
Keep each commit coherent and tested. No schema version bump should be needed:
the layers already have a persisted representation.
Update `lane-handoff.md` and `lane-model.md` with what shipped, the owner-frame
range UI limitation, conflict actions available, and verified test counts. Done
means a person can author and undo the correction, regenerate its base, and see
either their preserved edit or a useful conflict. A constructor without reachable
controls, or controls without that regeneration proof, does not finish this work.

View file

@ -1,10 +1,11 @@
# Lane and cel handoff
Status (2026-09-30): the lane model is implemented through its commands and its
first two views. Cels are ordinary nodes with their own playback clock, the
timeline draws them as one row, the cel sheet draws frames down and lanes across,
and both views issue the same commands. Correction layers evaluate and survive
regeneration. What is missing is the commands that make a correction.
Status (2026-09-30): the lane model is implemented through its commands, its
first two views, and correction authoring. Cels are ordinary nodes with their
own playback clock; the timeline draws them as one row and the cel sheet draws
frames down and lanes across. Both views issue the same commands. Rotation and
position corrections can be authored as Constant, Ramp, or Return motion on a
lane or cel, survive regeneration, and expose conflicts for removal or retry.
The commits beginning at `3d3c1bb` are the argument for the model and are worth
reading before touching what they did — they are the design record, more than
@ -87,18 +88,18 @@ decision, not a cleanup.
## Next steps, in order
1. **The commands that make a correction** — Constant adjustment, Ramp, Return
motion over a selected range, per `lane-model.md`. The evaluator is done and
has no opinion about how a range or a motion shape is chosen, which is now a
view question. A panel also needs to offer `clip/conflicts` for resolution.
Note the one open question: a correction needs a stable `:id` from somewhere,
and cel ids come from the caller because this namespace is pure.
2. **Slip source and retime.** Both have real design questions open and the doc
The implemented correction slice and its remaining UI limits are recorded in
[Correction authoring](correction-authoring-plan.md).
1. **Slip source and retime.** Both have real design questions open and the doc
says to refuse rather than approximate: retime needs a defined warp and
interpolation behaviour, and is not moving keys whose numbers happen to fall
inside a selection.
3. **Deleting reused content.** Reference discovery exists (`node/sources`,
2. **Deleting reused content.** Reference discovery exists (`node/sources`,
`clip/places`, `clip/contains-symbol?`); the policy does not.
3. **Displayed-range correction gestures.** The first correction panel asks for
explicit owner frames. Dragging a range in a retimed/nested view still needs
a proved mapping; do not make it snap through floors or loops.
4. **Collaboration.** `lane-model.md` is explicit that one leaf per channel does
NOT solve two people editing different keys of the same channel. No conflict
policy exists for that.
@ -126,6 +127,12 @@ decision, not a cleanup.
- **Generated sampling applies to the base, not the hand correction.** Picture
rate and pose selection may choose an earlier generated frame; correction
support and values still read the node's current authored frame.
- **Correction commands live in `domain/correction.cljs`.** IDs come from the
event caller; the pure command materializes default transform channels,
appends one layer, and validates the complete document. The inspector authors
rotation and position offsets in explicit owner frames. One Apply is one undo
step. `channel/reconcile` is the shared ordered-stack compatibility rule used
by validation, conflict reporting, and regeneration.
- **Two test patterns worth copying.** `the-cursor-agrees-with-the-specification-in-any-frame-order`
holds the optimized cursor to `value-at` in forward, backward and random order
— add a case to it for any new channel shape. And `drawn` in `lane_test`
@ -165,7 +172,7 @@ decision, not a cleanup.
From `frontend/`:
npx shadow-cljs compile test && node out/node-tests.js # 429 tests, 5,767 assertions
npx shadow-cljs compile test && node out/node-tests.js # 437 tests, 5,804 assertions
npx shadow-cljs compile app # the bundle Django serves
npx shadow-cljs release app # then `compile app` again — see above

View file

@ -2,8 +2,8 @@
Revised 2026-09-30. Target design. Cel ownership, source playback, the
content and cel commands, placement anywhere in a lane, overwrite, a one-row cel
strip, a frame-down cel sheet and the correction-layer evaluator are implemented;
the commands that produce a correction and the retiming commands are not.
strip, a frame-down cel sheet, correction evaluation, and correction authoring
for rotation and position are implemented. Retiming commands are not.
See the status note under
[Proof obligations](#proof-obligations-and-implementation-order).
@ -536,17 +536,23 @@ retime, and deleting reused content. A lane cannot hold AUDIO cels — `lane-pro
requires visual ones, though this document says a lane may hold either and
should reject only a mixture.
What is NOT implemented is a command that produces a layer — the doc's Constant
adjustment, Ramp and Return motion — and with it the question of how a view
offers those three over a selected range, and how it offers a conflict for
resolution. Slip source and retime are also not implemented; a refusal is the
current behavior where the model demands an explicit choice nobody has made yet.
`domain/correction.cljs` now produces Constant adjustment, Ramp, and Return
motion layers for rotation and position. The inspector exposes them on a selected
lane or cel using an explicit range in that owner's frames; this deliberately
leaves displayed-range dragging through nested or retimed owners for later. One
Apply is one undo step. Conflicted layers are listed, can be removed, and can be
retried when the complete ordered stack is compatible again. Validation,
conflict reporting, and regeneration share that ordered-stack rule, including
coverage by adjacent replacement layers. Slip source and retime are still not
implemented; a refusal is the current behavior where the model demands an
explicit choice nobody has made yet.
The cel sheet is the same projected cels and selection addresses with its axes
turned: frames down and lanes across, so commands selected there and in the
timeline have identical targets. The suite stands at 429 tests and 5,767
timeline have identical targets; a gap selects its column's lane rather than
retaining a stale selection from another column. The suite stands at 437 tests and 5,804
assertions, with `frontend/test/browser/lane.mjs` driving the editor through
create, hold, overflow, undo, reuse, make unique, duplicate, split, insert,
trim, move and blank. Rewrite tests that encode superseded
trim, move, blank, correction authoring, and two-lane sheet targeting. Rewrite tests that encode superseded
behavior rather than preserving behavior to keep them green.
Build small adversarial documents and test their domain operations before

View file

@ -178,27 +178,61 @@
(when (= :offset (:op l))
(shape-conflict (value-shape base) (value-shape (:values l)))))
(defn- stack-conflict
"Why layer `i` can encounter a value of the wrong shape after the layers
before it. A replace covering all of this layer's support becomes the only
possible input; a partly overlapping replace adds another possible input."
[ch i l]
(when (and (= :offset (:op l))
(vector? (:support l)) (= 2 (count (:support l))))
(let [[a b] (:support l)
shapes (reduce
(fn [possible prior]
(let [[c d] (when (and (vector? (:support prior))
(= 2 (count (:support prior))))
(:support prior))]
(if (and c d (not (:conflict prior)) (= :replace (:op prior))
(< a d) (< c b))
(let [s (value-shape (:values prior))]
(if (and (<= c a) (<= b d)) #{s} (conj possible s)))
possible)))
#{(value-shape ch)} (take i (:over ch)))
(defn- support-of [l]
(let [s (:support l)]
(when (and (vector? s) (= 2 (count s))
(every? number? s) (< (first s) (second s)))
s)))
(defn stack-conflict
"Why layer `i` can encounter a value of the wrong shape after the active
layers before it, or nil.
Replacement coverage is considered at every interval boundary. This matters
when adjacent replacements jointly cover an offset: neither covers its whole
support, but the base can never reach it. A conflicted replacement is skipped,
exactly as the evaluator skips it."
[ch i]
(let [l (nth (:over ch) i nil)]
(when (and (= :offset (:op l)) (support-of l))
(let [[a b] (support-of l)
prior (take i (:over ch))
cuts (->> prior
(keep support-of)
(mapcat identity)
(filter #(< a % b))
(into [a b])
distinct sort)
;; Shape at a point is the last active, nonempty replacement's
;; shape, or the base shape when no replacement supplies a value.
at (fn [f]
(or (last (keep (fn [p]
(let [s (support-of p)
v (value-shape (:values p))]
(when (and (= :replace (:op p))
(not (:conflict p)) v s
(covers? s f))
v)))
prior))
(value-shape ch)))
shapes (into #{} (map (fn [[x y]] (at (/ (+ x y) 2))))
(partition 2 1 cuts))
v (value-shape (:values l))]
(some #(shape-conflict % v) shapes))))
(some #(shape-conflict % v) shapes)))))
(defn reconcile
"Recheck an ordered layer stack against this channel's base.
Old conflict marks are findings from an earlier base, so they are cleared and
recomputed in order. A newly conflicted replacement is then invisible to the
layers after it, matching evaluation. Nothing is dropped or reordered."
[ch]
(let [layers (mapv #(dissoc % :conflict) (:over ch))]
(reduce (fn [out l]
(let [candidate (assoc ch :over (conj out l))
why (stack-conflict candidate (count out))]
(conj out (cond-> l why (assoc :conflict why)))))
[] layers)))
(defn conflicts
"Corrections on `ch` that cannot apply to its base, as `[{:id :why}]`.
@ -209,8 +243,8 @@
not load. `flow/regenerate` records one on the layer, a conflicted layer is not
applied, and this is how a view finds them to offer."
[ch]
(vec (for [l (:over ch)
:let [why (or (:conflict l) (conflict-with ch l))]
(vec (for [[i l] (map-indexed vector (:over ch))
:let [why (or (:conflict l) (stack-conflict ch i))]
:when why]
{:id (:id l) :why why})))
@ -558,7 +592,7 @@
(and (map? ch) (vector? (:over ch)))
(into (for [[i l] (map-indexed vector (:over ch))
:when (not (:conflict l))
:let [why (stack-conflict ch i l)]
:let [why (stack-conflict ch i)]
:when why]
(str "correction " (pr-str (:id l)) " " why)))

View file

@ -0,0 +1,114 @@
(ns arthur.domain.correction
"Pure commands that author and resolve correction layers.
Evaluation belongs to `channel`; this namespace only constructs a layer,
places it on its owning node, and refuses a document that would not be valid."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.node :as node]))
(def ^:private supported-paths #{[:xform :rot] [:xform :pos]})
(def ^:private motions #{:constant :ramp :return})
(defn- finite? [x] (and (number? x) (js/Number.isFinite x)))
(defn- numeric-value? [v]
(or (finite? v)
(and (vector? v) (pos? (count v)) (every? finite? v))))
(defn- same-shape? [a b]
(or (and (number? a) (number? b))
(and (vector? a) (vector? b) (= (count a) (count b)))))
(defn- expected-value? [path v]
(case path
[:xform :rot] (finite? v)
[:xform :pos] (and (vector? v) (= 2 (count v)) (every? finite? v))
false))
(defn- values-channel
[{:keys [motion support delta start end peak peak-frame]}]
(let [[a b] support]
(case motion
:constant (ch/framed delta)
:ramp (ch/keyed {a start, (dec b) end} :linear)
:return (ch/keyed {a start, peak-frame peak, (dec b) start} :linear)
nil)))
(defn- invalid
[path {:keys [id support motion delta start end peak peak-frame]} existing]
(let [[a b] (when (and (vector? support) (= 2 (count support))) support)
samples (case motion :constant [delta] :ramp [start end]
:return [start peak] [])]
(cond
(nil? id) "a correction needs an ID"
(some #(= id (:id %)) existing) "the correction ID is already used on this channel"
(not (contains? supported-paths path)) "that property does not support correction authoring"
(not (contains? motions motion)) "choose constant, ramp, or return motion"
(not (and (integer? a) (integer? b) (< a b)))
"support must be an increasing [in out) of whole owner frames"
(not-every? numeric-value? samples) "correction values must be finite numbers"
(not-every? #(expected-value? path %) samples)
"correction values do not have the property's shape"
(and (= :ramp motion) (< (- b a) 2)) "a ramp needs at least two samples"
(and (= :return motion) (< (- b a) 3)) "return motion needs at least three samples"
(and (= :return motion)
(not (and (integer? peak-frame) (< a peak-frame (dec b)))))
"the return peak must be a whole owner frame inside both endpoints"
(and (#{:ramp :return} motion) (not (same-shape? start (if (= :ramp motion) end peak))))
"motion endpoints must have the same shape")))
(defn- finish [candidate selection]
(if-let [why (first (clip/problems candidate))]
{:refused why}
{:clip candidate :selection selection}))
(defn add
"Append one offset correction to a node channel.
Support and value keys are in the selected node's own frames. Defaults are
materialized through `node/channels`, so correcting an unkeyed transform does
not need a special representation."
[document sid node-id path spec]
(let [n (get-in document [:symbols sid :nodes node-id])
base (when n (get (node/channels n) path))
existing (:over base)
why (cond
(nil? (clip/symbol document sid)) "the owning symbol does not exist"
(nil? n) "the correction target does not exist"
(nil? base) "the correction target has no such channel"
:else (invalid path spec existing))]
(if why
{:refused why}
(let [layer (ch/layer (:id spec) (:support spec) :offset (values-channel spec))
corrected (update base :over (fnil conj []) layer)
candidate (assoc-in document [:symbols sid :nodes node-id :channels path] corrected)]
(finish candidate node-id)))))
(defn remove-layer
"Remove one named layer, refusing when a later layer depended on its shape."
[document sid node-id path layer-id]
(let [at [:symbols sid :nodes node-id :channels path]
c (get-in document at)
layers (:over c)]
(cond
(nil? c) {:refused "the correction channel does not exist"}
(not-any? #(= layer-id (:id %)) layers) {:refused "the correction does not exist"}
:else (finish (assoc-in document at
(assoc c :over (vec (remove #(= layer-id (:id %)) layers))))
node-id))))
(defn retry-layer
"Clear one recorded conflict when the complete resulting stack is valid."
[document sid node-id path layer-id]
(let [at [:symbols sid :nodes node-id :channels path]
c (get-in document at)
found (some #(when (= layer-id (:id %)) %) (:over c))]
(cond
(nil? found) {:refused "the correction does not exist"}
(nil? (:conflict found)) {:refused "the correction has no recorded conflict"}
:else
(finish (update-in document (conj at :over)
(fn [layers]
(mapv #(if (= layer-id (:id %)) (dissoc % :conflict) %) layers)))
node-id))))

View file

@ -394,6 +394,57 @@
::choose
(fn [db [_ id]] (assoc-in db [:footage :chosen] id)))
;; ---------------------------------------------------------------------------
;; renaming an asset
;;
;; A SERVER WRITE, NOT A DOCUMENT EDIT, and so not on the undo list. Footage and
;; sounds live beside projects rather than inside one — the pool's ALL ASSETS
;; folder is exactly that — so a label is shared by every project that uses the
;; row, and undoing an edit to this document must not reach out and rename
;; something another one is showing.
;;
;; Written through optimistically. The lists in app-db are what the pool draws
;; from; waiting for the round trip would leave the old name under the cursor for
;; as long as the request takes, and the failure is visible and recoverable —
;; `::failed` says so, and `::refresh` puts back whatever the server actually
;; holds.
(defn- relabelled
"Replace one row's `:label` in a list held by id."
[rows id label]
(mapv #(cond-> % (= id (:id %)) (assoc :label label)) rows))
(rf/reg-fx
::relabel!
(fn [{:keys [url label]}]
(-> (http/PATCH url #js {:label label})
(.then (fn [_]
;; Only a CLEARED label needs the answer. The server's fallback
;; is the name the file was uploaded under, which this client
;; cannot reconstruct — footage falls back to its source and a
;; sound to its filename — so the one case the optimistic write
;; cannot guess is the one case that re-lists.
(when (empty? label) (rf/dispatch [::refresh]))))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))])
(rf/dispatch [::refresh]))))))
(rf/reg-event-fx
::relabel
(fn [{:keys [db]} [_ kind id value]]
;; `kind` is `:footage` or `:sound`: two resources with one field between
;; them, and one event rather than two that differ by a path and a URL.
(let [label (string/trim (str value))
[key url] (case kind
:footage [:available (str "/api/footage/" id)]
:sound [:sounds (str "/api/sounds/" id)]
[nil nil])]
(if (or (nil? id) (nil? key))
{}
{:db (cond-> db
(seq label) (update-in [:footage key] relabelled id label))
::relabel! {:url url :label label}}))))
(rf/reg-event-db
::progress
(fn [db [_ message]] (assoc-in db [:footage :status] message)))

View file

@ -601,6 +601,23 @@
(cond-> {:db db'}
(= key :fps) (assoc ::pb/seek! [value (pb/frames db') frame]))))))
(rf/reg-event-db
::rename-symbol
(fn [db [_ sid value]]
;; A transaction, so one rename is one undo step: `edit/edit` alone would let
;; a rename coalesce with whatever edit happened next.
;;
;; BLANK REMOVES THE NAME rather than storing an empty one. `clip/symbol-name`
;; falls back to the id, so a symbol cleared of its name reads as `main`
;; again instead of as a row with nothing on it — and the document carries no
;; field it did not need.
(let [value (not-empty (str/trim (str value)))]
(if-not (clip/symbol (:clip (store/entry (:clip/current db))) sid)
db
(edit/transaction db #(if value
(assoc-in % [:symbols sid :name] value)
(update-in % [:symbols sid] dissoc :name)))))))
(rf/reg-event-db
::symbol-setting
(fn [db [_ sid key value]]

View file

@ -6,6 +6,7 @@
there should not be one: an editor's own state is the cheapest thing in the
app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip]
[arthur.domain.correction :as correction]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
@ -58,6 +59,37 @@
(assoc-in [:ui :selection] [:node sid (:selection result) (conj prefix (:selection result))])
(update :ui dissoc :lane-retry)))))
(defn apply-correction-command
"Commit one correction command while keeping the complete row address that
selected its owner. A refusal changes only the visible status."
[db result]
(if-let [why (:refused result)]
(assoc-in db [:project :status] why)
(-> db
(edit/transaction (constantly (:clip result)))
(update :project merge {:status "edited · unsaved"}))))
(rf/reg-event-db
::add-correction
(fn [db [_ sid id path spec]]
(let [clip (:clip (store/entry (:clip/current db)))]
(apply-correction-command
db (correction/add clip sid id path (assoc spec :id (random-uuid)))))))
(rf/reg-event-db
::remove-correction
(fn [db [_ sid id path layer-id]]
(let [clip (:clip (store/entry (:clip/current db)))]
(apply-correction-command
db (correction/remove-layer clip sid id path layer-id)))))
(rf/reg-event-db
::retry-correction
(fn [db [_ sid id path layer-id]]
(let [clip (:clip (store/entry (:clip/current db)))]
(apply-correction-command
db (correction/retry-layer clip sid id path layer-id)))))
(rf/reg-event-db
::new-lane
(fn [db _]

View file

@ -45,12 +45,7 @@
topology has resolved it."
[old fresh]
(if-let [over (seq (:over old))]
(assoc fresh :over
(mapv (fn [l]
(if-let [why (ch/conflict-with fresh l)]
(assoc l :conflict why)
(dissoc l :conflict)))
over))
(assoc fresh :over (ch/reconcile (assoc fresh :over (vec over))))
fresh))
(defn- bases

View file

@ -57,3 +57,4 @@
(defn POST [url body] (request! "POST" url body))
(defn POST-form [url body] (request! "POST" url body))
(defn PUT [url body] (request! "PUT" url body))
(defn PATCH [url body] (request! "PATCH" url body))

View file

@ -70,6 +70,22 @@
(when-let [pl (nest/placement clip st open (or path [id]) f)]
(assoc pl :node n :bounds ((pick/bounds-of clip st n) (:frame pl))))))))
(rf/reg-sub
::settled-clip
:<- [::render/clip-id]
:<- [::render/paint-revision]
(fn [[id _] _]
;; The document AS WRITTEN, not as a drag currently has it — the same choice
;; `::render/sounds` makes, for a sharper version of the same reason.
;;
;; `::render/clip` yields a fresh document on every pointer move of a timeline
;; slide so the stage can follow it. The media pool draws its symbols as
;; RASTERISED PICTURES, so subscribing to that would re-resolve and re-encode
;; every thumbnail in the pool thirty times a second, to show a change no
;; thumbnail of a symbol has any way to show. Nothing the pool lists —
;; a symbol's name, its length, what places it — moves during a drag.
(:clip (store/entry id))))
(rf/reg-sub
::project-footage
:<- [::render/clip-id]

View file

@ -43,3 +43,34 @@
img (image-data-for ctx el w h)]
(raster/->rgba r palette-rgb 1 (.-data img))
(.putImageData ctx img 0 0)))))
(defn ->png
"An indexed raster as a PNG data URL, expanded through `palette-rgb`.
For a THUMBNAIL, which is the one picture in this app that is not the preview.
Two consequences, and both are departures from the rule at the top of this
namespace:
An `<img>` rather than the canvas itself, because a pool of them is a list that
rebuilds whenever anything in the document changes, and a data URL is a value
the caller can cache against the document it was drawn from — a canvas is an
element that has to be found and repainted.
And therefore SMOOTHLY downscaled, because `image-rendering: pixelated` is a
rule about canvases. At a tenth of the stage's size nearest neighbour samples
one pixel in a hundred, and a drawing made of flat shapes a few pixels across
reduces to speckle; the silhouette is what makes a thumbnail recognisable, and
smoothing is what keeps it. The pixelated rule is load-bearing for the preview
that JUDGES the output. This is a picture to tell one name from another by."
[{:keys [w h] :as r} palette-rgb]
(let [el (js/document.createElement "canvas")]
(set! (.-width el) w)
(set! (.-height el) h)
;; Deliberately not through `image-data-for`: that cache is keyed by element
;; and this element is thrown away, so every thumbnail would leave a quarter
;; of a megabyte in it that nothing can ever find again.
(let [ctx (.getContext el "2d")
img (.createImageData ctx w h)]
(raster/->rgba r palette-rgb 1 (.-data img))
(.putImageData ctx img 0 0))
(.toDataURL el "image/png")))

View file

@ -235,6 +235,139 @@
[channel-control sid id path ch frame]
[:dd (channel-state ch)])]))])]))
;; ---------------------------------------------------------------------------
;; corrections
(defn- correction-initial [clip sid id]
(let [n (get-in clip [:symbols sid :nodes id])
[a b] (or (:span n) [0 3])
a (if (integer? a) a 0)
through (max a (min (dec (if (integer? b) b 3)) (+ a 2)))]
{:target id :path [:xform :rot] :motion :constant
:from a :through through :peak-frame (min (dec through) (inc a))
:delta 0 :delta-x 0 :delta-y 0
:start 0 :start-x 0 :start-y 0
:end 0 :end-x 0 :end-y 0
:peak 0 :peak-x 0 :peak-y 0}))
(defn- draft-number [draft key label integer?]
[:label.inspector-field label
[:input {:type "number" :step (if integer? 1 "any")
:value (or (get @draft key) "")
:on-change (fn [e]
(let [s (.. e -target -value)
n ((if integer? js/parseInt js/parseFloat) s 10)]
(swap! draft assoc key (when-not (js/isNaN n) n))))}]])
(defn- value-inputs [draft prefix label]
(if (= [:xform :rot] (:path @draft))
[draft-number draft prefix (str label " (degrees)") false]
[:<>
[draft-number draft (keyword (str (name prefix) "-x")) (str label " x") false]
[draft-number draft (keyword (str (name prefix) "-y")) (str label " y") false]]))
(defn- correction-value [d prefix]
(if (= [:xform :rot] (:path d))
(some-> (get d prefix) (* (/ js/Math.PI 180)))
[(get d (keyword (str (name prefix) "-x")))
(get d (keyword (str (name prefix) "-y")))]))
(defn- correction-spec [d]
(let [base {:support [(:from d) (when (number? (:through d)) (inc (:through d)))]
:motion (:motion d)}]
(case (:motion d)
:constant (assoc base :delta (correction-value d :delta))
:ramp (assoc base :start (correction-value d :start)
:end (correction-value d :end))
:return (assoc base :start (correction-value d :start)
:peak (correction-value d :peak)
:peak-frame (:peak-frame d))
base)))
(defn- correction-layers [clip sid id]
(for [[path c] (get-in clip [:symbols sid :nodes id :channels])
l (:over c)]
{:path path :layer l}))
(defn- correction-section [[sid selected-id selected]]
(let [clip @(rf/subscribe [::render/clip])
parent (get-in clip [:symbols sid :nodes (:parent selected)])
targets (cond
(node/lane? selected) [selected-id]
(node/lane? parent) [selected-id (:id parent)]
:else [])]
(when (seq targets)
(r/with-let [draft (r/atom (correction-initial clip sid selected-id))]
(let [target (:target @draft)
motion (:motion @draft)
conflicts (clip-domain/conflicts clip)
layers (correction-layers clip sid target)]
[section "corrections"
[:div.correction-grid
[:label.inspector-field "owner"
[:select {:value (or (first (keep-indexed #(when (= %2 target) %1) targets)) 0)
:on-change (fn [e]
(let [i (js/parseInt (.. e -target -value) 10)
id (nth targets i)]
(reset! draft (correction-initial clip sid id))))}
(doall (for [[i id] (map-indexed vector targets)]
^{:key (str id)}
[:option {:value i}
(str (if (= id selected-id) "selected · " "lane · ") (brief id))]))]]
[:label.inspector-field "property"
[:select {:value (if (= [:xform :rot] (:path @draft)) "rotation" "position")
:on-change #(swap! draft assoc :path
(if (= "rotation" (.. % -target -value))
[:xform :rot] [:xform :pos]))}
[:option {:value "rotation"} "rotation offset"]
[:option {:value "position"} "position offset"]]]
[:label.inspector-field "motion"
[:select {:value (name motion)
:on-change #(swap! draft assoc :motion (keyword (.. % -target -value)))}
[:option {:value "constant"} "constant"]
[:option {:value "ramp"} "ramp"]
[:option {:value "return"} "return"]]]
[:div]
[draft-number draft :from "from owner frame" true]
[draft-number draft :through "through owner frame" true]
(case motion
:constant [value-inputs draft :delta "offset"]
:ramp [:<> [value-inputs draft :start "start offset"]
[value-inputs draft :end "end offset"]]
:return [:<> [value-inputs draft :start "start offset"]
[value-inputs draft :peak "peak offset"]
[draft-number draft :peak-frame "peak owner frame" true]]
nil)]
[:div.row {:style {:margin-top "6px"}}
[:button {:on-click #(rf/dispatch [::ui/add-correction sid target
(:path @draft) (correction-spec @draft)])}
"apply correction"]]
(when (seq layers)
[:div.correction-list
(doall
(for [{:keys [path layer]} layers]
^{:key (str path (:id layer))}
[:div.correction-item
[:span {:title (pr-str (:id layer))}
(str (str/join " " (map name path)) " · "
(pr-str (:support layer))
(when (:conflict layer) " · conflict"))]
(when (:conflict layer)
[:button {:on-click #(rf/dispatch [::ui/retry-correction
sid target path (:id layer)])}
"retry"])
[:button {:on-click #(rf/dispatch [::ui/remove-correction
sid target path (:id layer)])}
"remove"]]))])
(when (seq conflicts)
[:div.correction-conflicts
[:div.dim "document conflicts"]
(doall
(for [{:keys [symbol node channel id why]} conflicts]
^{:key (str symbol node channel id)}
[:div {:title why} (str (brief node) " · "
(str/join " " (map name channel)) " · " why)]))])])))))
;; ---------------------------------------------------------------------------
;; tracing a face
;;
@ -455,6 +588,8 @@
[:div {:style {:min-height 0}}
[clip-section]
(when node [node-section node])
(when node ^{:key (str (first node) "/" (second node))}
[correction-section node])
(when (and face (or (trace/traceable? clip face) (seq faces)))
[tracing-section face faces path])
(when (= :symbol (first selection)) [symbol-section (second selection)])

View file

@ -1,5 +1,5 @@
(ns arthur.ui.pool
"The media pool: what can be put into the open symbol, in two folders.
"The media pool: what can be put into the open symbol, in two scopes.
THIS PROJECT is the open document's own: every symbol in it — the open one
included, because none is special — and the video it uses or was given this
@ -8,6 +8,21 @@
the split is the point: opening a project REPLACES what is on screen, where
everything in here is a thing to put INTO it.
TABS RATHER THAN TWO OPEN FOLDERS. Both scopes expanded cost eight lines of
heading before the first row, in a pane 210px wide; you are either looking at
what the document has or shopping what the server has, and the one case where
that costs you is covered — a search counts its hits in the scope you are not
looking at and puts the number on its tab.
THE MAIN TIMELINE LEADS, and it is `clip/opens-on`'s answer rather than a
name: the longest symbol nothing else places is the one the project plays and
the one the work happens in, so it gets the top of the pane and a row drawn at
a size you can read a pose off. Every other symbol is the list under it. That
is one list and not two — every symbol here IS a timeline, and heading a
section TIMELINES and the next one SYMBOLS would name the same thing twice.
None of it is `:main` being special either: rename it, place it inside
something else, and the pool follows the document.
Every row is a drag source, and what it carries says what it is:
`symbol:<id>` for a symbol of this document, `import:<project>|<cid>|<id>` for
one of another's, and `footage:<id>` for video. The stage and the timeline are
@ -16,6 +31,13 @@
A SOUND — mp3, wav — is `sound:<id>`, and is dropped on the timeline, where it
becomes an audio node in the open symbol from the frame it lands on.
RENAMING IS TWO DIFFERENT OPERATIONS behind one affordance. A symbol's name is
a field of this document: it is an undoable edit, and blank gives it back its
id. Footage and sounds live beside projects rather than inside one, so their
label is a server write shared by every project that uses the row — see
`events.footage/relabel`. A symbol of ANOTHER project is renameable where it
lives and not from here.
THE WHOLE PANE IS THE DROP TARGET for a file. A video dropped anywhere in it
uploads and lands in THIS PROJECT's media, and goes no further: which frames of
it become a symbol, and what that symbol is called, is asked when it is dropped
@ -23,6 +45,9 @@
footage stay separate records on the server, so dropping the same file twice
does not decode it twice."
(:require [arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[arthur.domain.raster :as raster]
[arthur.export :as export]
[arthur.events.footage :as footage]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
@ -30,21 +55,117 @@
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.canvas :as canvas]
[arthur.ui.drag :as drag]
[clojure.string :as str]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- item
"One row. `opts` is merged last so a caller can add its handlers without this
function growing a parameter per affordance."
[{:keys [label sub on? disabled? thumb] :as opts}]
[:button (merge {:class (str "pool-item" (when on? " on") (when thumb " media"))
:disabled (boolean disabled?)
:title label}
(dissoc opts :label :sub :on? :disabled? :thumb))
thumb
[:span.text label (when sub [:span.sub sub])]])
;; ---------------------------------------------------------------------------
;; pictures
(defonce ^:private thumbs
;; `{:clip <the document these were drawn from> :urls {sid url-or-nil}}`,
;; compared by IDENTITY. A document is an immutable value, so the same object
;; means the same pictures and a different one means an edit landed — at which
;; point the whole map goes rather than being diffed, because the cheap test is
;; the wrong one: a symbol unchanged in itself changes picture when any symbol
;; it places changes, and following that is `clip/resolver`'s job, not a
;; cache's.
(atom {:clip nil :urls {}}))
(defn- placed-in
"Where `sid` is placed, as `[host-symbol node-id]`, or nil for one nothing
places. Lowest ids first, so a symbol placed several times gets one picture and
the same one every time."
[document sid]
(first (for [h (sort-by str (keys (:symbols document)))
n (sort-by str (keys (get-in document [:symbols h :nodes])))
:when (contains? (node/sources (get-in document [:symbols h :nodes n])) sid)]
[h n])))
(defn- draw-symbol
"`sid`'s first frame as a PNG data URL, through the resolver and the rasteriser
the stage uses — so the picture in the pool is the picture, not a sketch of it.
THROUGH THE PLACEMENT, WHERE THERE IS ONE, and this is the whole subtlety.
Rooting at a symbol renders its DRAWING, in its own local space; a rotoscoped
face is stored head-local in units of one image height, so its numbers are
around 0..1 and the source-to-stage scale that turns them into stage pixels —
several hundred — lives on the `:face` group of the symbol that PLACES it. See
`freeze/face-placement` and \"What space geometry is in\" in
docs/animation-model.md. Rendered rooted at itself, a face is therefore correct
and under a pixel across, which is a true picture of nothing anybody wants to
look at.
So a placed symbol is drawn where it is placed, with everything else in that
host isolated away — `export/isolate`, whose docstring draws the same
distinction for the same reason. A symbol nothing places has no placement to
borrow and is rendered rooted at itself, which for the main timeline is exactly
right because the stage is its own.
nil rather than a throw when the frame will not resolve — a cycle, a missing
block, an instance naming a symbol that has gone. A pool is a list of names,
and a symbol that cannot be drawn today is still one you want listed, named
and draggable.
THE FIRST FRAME, unlike `video-thumb` below, which seeks past the black leader
most phone footage opens on. A symbol's frame 0 is authored: what is on it is
there because somebody put it there, and the frame a person names a symbol by
is the one it starts on."
[document sid store palette ramp]
(try
(when (clip/symbol document sid)
(let [[host id] (placed-in document sid)
document (cond-> document
host (update-in [:symbols host] export/isolate id))
root (or host sid)
resolve (clip/resolver document root store palette {})
[w h] (clip/stage document root)]
(-> (raster/make w h)
(raster/clear! (get palette :bg 0))
(raster/draw-ops! (resolve 0))
(canvas/->png ramp))))
(catch :default _ nil)))
(defn- symbol-thumb
"`draw-symbol`, once per symbol per version of the document. Rasterising and
PNG-encoding the stage is milliseconds, and the pool redraws on every selection
click."
[document sid store palette ramp]
(when-not (identical? document (:clip @thumbs))
(reset! thumbs {:clip document :urls {}}))
(let [urls (:urls @thumbs)]
(if (contains? urls sid)
(get urls sid)
(let [url (draw-symbol document sid store palette ramp)]
(swap! thumbs assoc-in [:urls sid] url)
url))))
(defn- picture
"A row's leading picture. One box at the stage's own proportions for all three
kinds of row, so the names line up down the list whatever is beside them, and
a row with no picture to show still holds the column open."
[url]
(if url
[:img.thumb {:src url :alt "" :draggable false}]
[:span.thumb]))
(defn- video-thumb
"One frame of a video, from its proxy. `#t=` seeks a paused, muted element to a
frame that is not the black leader most phone footage opens on; nothing is
played and nothing is decoded past it."
[{:keys [video]}]
(if video
;; Sized here as well as in the stylesheet: a video element with no size
;; is as big as its footage, and a portrait phone clip is 1440×1920.
[:video.thumb {:src (str video "#t=0.2") :muted true :preload "metadata"
:plays-inline true :tab-index -1
:style {:width 32 :height 20 :max-width 32 :max-height 20}}]
[:span.thumb]))
;; ---------------------------------------------------------------------------
;; the row
(defn- carrying
"The drag handlers for a row. `text` is what makes it a drag at all and what
@ -58,24 +179,135 @@
(start!))
:on-drag-end (fn [_] (drag/done!))})
(defn- thumbnail
"One frame of a video, from its proxy. `#t=` seeks a paused, muted element to a
frame that is not the black leader most phone footage opens on; nothing is
played and nothing is decoded past it."
[{:keys [video]}]
(if video
;; Sized here as well as in the stylesheet: a video element with no size
;; is as big as its footage, and a portrait phone clip is 1440×1920.
[:video.thumb {:src (str video "#t=0.2") :muted true :preload "metadata"
:plays-inline true :tab-index -1
:style {:width 40 :height 30 :max-width 40 :max-height 30}}]
[:span.thumb]))
(defn- row
"One row of the pool: a picture, a name, and one number.
(defn- footage-row [{:keys [id label frames fps video] :as f} chosen]
[item (merge {:label label
:sub (str frames "f @ " fps)
:thumb [thumbnail f]
ONE LINE, because the pane is 210px wide and the pane under it is the timeline
— vertical space spent here is spent on something. The picture carries what the
row is, the name carries which one, and the single number is the one a person
needs before dragging it somewhere: how long it is. Everything else the row
knows goes in `:title`, where a pointer can ask for it.
THE WHOLE ROW IS THE BUTTON. Clicking selects and double-clicking opens, and
the target for both is the row — not the name, which is a word a few characters
wide that you would have to aim at.
WHICH IS WHY THE PENCIL IS A SPAN. It belongs beside the name, where it reads
as acting on that word rather than on the row; inside the button is the only
place that can be, and a button inside a button is not a thing HTML has. A span
with a click handler is, and it costs one thing: the pencil is not a tab stop.
F2 on the row is the keyboard path, which is the conventional one anyway, and
`aria-keyshortcuts` is what announces it. Stopping propagation is what keeps a
click on the pencil from also selecting the row underneath it.
`opts` beyond the keys destructured here is merged onto that drag surface, so a
caller adds its handlers without this growing a parameter per affordance.
THE MAIN TIMELINE is the one exception, and the only one. Border, fill and size
each say \"separate thing\", so spending them on every row flattens the list
into wallpaper; spent on the one row where the work happens, they say so. It
gets a picture big enough to read a pose off, and both its facts on a line of
its own under the name — `sub2` — rather than one of them out at the edge.
`rename` is `{:key :value :begin! :commit!}` and is what makes a row
renameable at all: a row without one has no pencil and does not answer F2."
[{:keys [label sub sub2 title thumb on? open? main? disabled? rename] :as opts}]
(let [{:keys [key value begin! commit!]} rename
editing? (boolean (and key (= key (:editing rename))))]
[:div.pool-row {:class (str (when main? "main ") (when on? "on ")
(when open? "open ") (when disabled? "disabled ")
(when editing? "editing"))}
(if editing?
;; The input REPLACES the row rather than floating over it, so the list
;; does not change height while you type in it.
[:input.pool-name
{:auto-focus true
:default-value value
:aria-label (str "rename " label)
:on-focus (fn [^js e] (.select (.-target e)))
;; Blur commits, as the project title in `ui/topbar` does: clicking away
;; from a half-finished rename means the name you typed, not nothing.
:on-blur (fn [^js e] (commit! (.. e -target -value)))
:on-key-down (fn [^js e]
(case (.-key e)
"Enter" (do (.preventDefault e) (commit! (.. e -target -value)))
;; Escape has to stop editing WITHOUT the blur that
;; follows it committing the draft.
"Escape" (do (.preventDefault e) (begin! nil) (.blur (.-target e)))
nil))}]
[:<>
[:button.pool-item
(merge {:disabled (boolean disabled?)
:title (or title label)
:aria-keyshortcuts (when begin! "F2")
:on-key-down (when begin!
(fn [^js e]
(when (= "F2" (.-key e))
(.preventDefault e)
(begin! key))))}
(dissoc opts :label :sub :sub2 :title :on? :open? :main?
:disabled? :thumb :rename))
thumb
[:span.text
;; The label is `.text`'s first child and stays that way: it is how
;; the browser test finds a row by the name a person reads.
[:span.name label]
(when (and main? sub2) [:span.detail sub2])]
(when begin!
[:span.pool-rename
{:title (str "rename " label " (F2)")
;; Mouse-only by design — see the docstring. A `tabindex` here would
;; make it interactive content inside a button, which is the thing
;; being avoided, and F2 already reaches it from the keyboard.
:on-click (fn [^js e] (.stopPropagation e) (begin! key))}
"\u270E"])
;; The main row says both its facts under the name instead.
(when (and sub (not main?)) [:span.sub sub])]])]))
;; ---------------------------------------------------------------------------
;; the rows of each kind
(defn- symbol-row [document sid {:keys [clip-id store palette ramp selection open main rename]}]
(let [sym (clip/symbol document sid)
label (clip/symbol-name document sid)
nodes (count (:nodes sym))]
^{:key (str sid)}
[row (merge {:label label
:sub (str (:frames sym) "f")
:title (str label " · " (:frames sym) " frames · " nodes
(if (= 1 nodes) " node" " nodes")
(when (= sid open) " · open")
" — double-click to open, drag to place")
:thumb [picture (symbol-thumb document sid store palette ramp)]
:sub2 (str (:frames sym) "f · " nodes (if (= 1 nodes) " node" " nodes"))
:on? (= selection [:symbol sid])
:open? (= sid open)
:main? (= sid main)
:rename (assoc rename
:key [:symbol sid]
:value label
:commit! (fn [value]
((:begin! rename) nil)
(rf/dispatch [::project/rename-symbol sid value])))
:on-click #(rf/dispatch [::ui/select [:symbol sid]])
:on-double-click #(rf/dispatch [::pb/open-symbol sid])}
(carrying (str "symbol:" (subs (str sid) 1))
#(drag/symbol! clip-id sid open)))]))
(defn- footage-row [{:keys [id label frames fps video] :as f} chosen rename]
^{:key id}
[row (merge {:label label
:sub (str frames "f")
:title (str label " · " frames " frames @ " fps "fps"
" — drag onto the stage to make a symbol of it")
:thumb [video-thumb f]
:on? (= id chosen)
:rename (assoc rename
:key [:footage id]
:value label
:commit! (fn [value]
((:begin! rename) nil)
(rf/dispatch [::footage/relabel :footage id value])))
:on-click #(rf/dispatch [::footage/choose id])}
(carrying (str "footage:" id)
#(drag/other! {:kind :footage :id id :label label
@ -84,104 +316,204 @@
(defn- sound-row
"An uploaded sound, or with `:footage?` a video's own — which is how a take's
sound goes back into its symbol after it was deleted there."
[{:keys [id label duration footage? fps]} project-fps]
[{:keys [id label duration footage? fps]} project-fps rename]
(let [frames (js/Math.ceil (* duration project-fps))
[source length rate] (if footage?
[{:footage id} (js/Math.round (* duration fps)) (/ fps project-fps)]
[{:sound id} frames 1])]
[item (merge {:label label
:sub (str (.toFixed duration 1) "s · " frames "f")
:thumb [:span.thumb.sound "♪"]}
^{:key (str (when footage? "f") id)}
[row (merge {:label label
:sub (str (.toFixed duration 1) "s")
:title (str label " · " (.toFixed duration 1) "s · " frames " frames"
(when footage? " · this video's own sound")
" — drag onto the timeline")
:thumb [:span.thumb.sound "♪"]
;; A video's own sound is named by the video. Renaming it here
;; would rename the footage row two sections up, which is not
;; what the pencil on a sound looks like it does.
:rename (when-not footage?
(assoc rename
:key [:sound id]
:value label
:commit! (fn [value]
((:begin! rename) nil)
(rf/dispatch [::footage/relabel :sound id value]))))}
(carrying (str "sound:" id)
#(drag/other! {:kind :sound :source source :label label
:length length :rate rate :frames frames})))]))
(defn- folder [title & children]
(into [:details.pool-folder {:open true} [:summary title]] children))
(defn- import-row [{:keys [cid symbol name frames]} pid]
^{:key (str cid symbol)}
[row (merge {:label name
:sub (str frames "f")
:title (str name " · " frames " frames — drag to copy it into this project")
:thumb [picture nil]}
(carrying (str "import:" (str/join "|" [pid cid symbol]))
#(drag/other! {:kind :import :label name :frames frames
:project pid :cid cid :symbol symbol})))])
(defn- group [title & children]
(into [:div.pool-group {:class title} [:h2 title]] children))
;; ---------------------------------------------------------------------------
;; sections
(defn- this-project []
(let [document @(rf/subscribe [::render/clip])
clip-id @(rf/subscribe [::render/clip-id])
selection @(rf/subscribe [::sub/selection])
open @(rf/subscribe [::render/open])
media @(rf/subscribe [::sub/project-footage])
;; The project's videos' sounds first, then its uploaded ones.
sounds (into (mapv (fn [{:keys [id label frames fps]}]
{:id id :label label :footage? true :fps fps
:duration (/ frames fps)})
media)
@(rf/subscribe [::sub/project-sounds]))
{:keys [chosen]} @(rf/subscribe [::playback/footage])]
(folder "this project"
(group "symbols"
(doall
(for [sid (sort-by str (keys (:symbols document)))
:let [sym (clip/symbol document sid)]]
^{:key (str sid)}
[item (merge {:label (clip/symbol-name document sid)
:sub (str (:frames sym) "f · " (count (:nodes sym)) " nodes"
(when (= sid open) " · open"))
:on? (= selection [:symbol sid])
:on-click #(rf/dispatch [::ui/select [:symbol sid]])
:on-double-click #(rf/dispatch [::pb/open-symbol sid])}
(carrying (str "symbol:" (subs (str sid) 1))
#(drag/symbol! clip-id sid open)))]))
[:div.dim "double-click to open · drag to place"])
(group "media"
(if (empty? media)
[:div.dim "drop a video here"]
(doall (for [f media] ^{:key (:id f)} [footage-row f chosen]))))
(group "sounds"
(if (empty? sounds)
[:div.dim "drop an mp3 or wav here"]
(doall (for [s sounds] ^{:key (:id s)} [sound-row s (:fps document)])))))))
(defn- hit?
"Is `label` a hit for `query`? A case-folded substring, which is the whole of
what a list of a few dozen names needs."
[query label]
(or (str/blank? query)
(str/includes? (str/lower-case (str label)) query)))
(defn- all-assets []
(let [{:keys [available chosen sounds]} @(rf/subscribe [::playback/footage])
fps (:fps @(rf/subscribe [::render/clip]))
{:keys [symbols]} @(rf/subscribe [::project/assets])
{:keys [id]} @(rf/subscribe [::playback/project])]
(folder "all assets"
(group "media"
(if (empty? available)
[:div.dim "nothing uploaded yet"]
(doall (for [f available] ^{:key (:id f)} [footage-row f chosen]))))
(group "sounds"
(if (empty? sounds)
[:div.dim "no sounds uploaded yet"]
(doall (for [s sounds] ^{:key (:id s)} [sound-row s fps]))))
(group "symbols"
(let [others (remove #(= id (:project %)) symbols)]
(if (empty? others)
[:div.dim "no other saved projects"]
(doall
(for [[[pid pname] rows] (group-by (juxt :project :project-name) others)]
^{:key pid}
;; Closed: a server holds many projects, and a wall of
;; every symbol in every one buries the one you want.
[:details.pool-project
(defn- section
"A heading and its rows.
NOTHING AT ALL while a search is running and this section has no hit. A column
of headings over emptiness is the worst thing a filter can show you: the answer
to \"where is it\" should be the one section still holding rows."
[{:keys [title rows blank searching?]}]
(cond
(seq rows) [:div.pool-section [:h2 title] (into [:div.pool-rows] rows)]
searching? nil
:else [:div.pool-section [:h2 title] [:div.dim blank]]))
(defn- sections
"Draw a scope's sections, or the one line that says a search found nothing in
it. `rows` is the scope's total so the empty answer can be given once rather
than per section."
[searching? rows children]
(if (and searching? (zero? rows))
;; Its own class rather than `.dim`: a `.dim` directly inside `.pane-body`
;; is how the page says what loading, saving and opening are doing — see
;; the status line at the foot of `view` — and a search result is not that.
[:div.pool-empty "no match in this scope"]
(into [:<>] (map section) children)))
(defn- this-project
"The open document's own, with the main timeline at the top and every other
symbol under it.
NOT \"TIMELINES AND SYMBOLS\". Every symbol in this model IS a timeline — it
has frames and nodes and you open it and work in it — so a pair of headings
naming those two things names one thing twice, and invites a reader to go
looking for the difference. There is one list of symbols. What is true is that
exactly one of them is where the work happens: `clip/opens-on`'s answer, the
longest symbol nothing else places. That gets the top of the pane and a row
drawn like the thing it is, and the rest of the library is the list below it.
Still not `:main` being special. The document says which symbol that is by its
structure; rename it, place it inside something else, and the pool follows."
[{:keys [document query searching? media sounds chosen rename main] :as ctx}]
(let [named? #(hit? query (clip/symbol-name document %))
top (when (and main (named? main)) main)
rest (filterv #(and (named? %) (not= main %))
(sort-by str (keys (:symbols document))))
media (filterv #(hit? query (:label %)) media)
sounds (filterv #(hit? query (:label %)) sounds)]
[sections searching?
(+ (if top 1 0) (count rest) (count media) (count sounds))
[{:title "project" :searching? searching?
:blank "nothing to open yet"
:rows (when top [(symbol-row document top ctx)])}
{:title "symbols" :searching? searching?
:blank "nothing else in the library"
:rows (mapv #(symbol-row document % ctx) rest)}
{:title "media" :searching? searching?
:blank "drop a video here"
:rows (mapv #(footage-row % chosen rename) media)}
{:title "sounds" :searching? searching?
:blank "drop an mp3 or wav here"
:rows (mapv #(sound-row % (:fps document) rename) sounds)}]]))
(defn- all-assets
"Everything the server holds. Other projects' symbols stay grouped by project
and closed: a server holds many, and a wall of every symbol in every one buries
the one you want."
[{:keys [document query searching? rename chosen available all-sounds symbols
project-id]}]
(let [media (filterv #(hit? query (:label %)) available)
sounds (filterv #(hit? query (:label %)) all-sounds)
others (filterv #(and (not= project-id (:project %)) (hit? query (:name %)))
symbols)
grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others))]
[sections searching?
(+ (count media) (count sounds) (count others))
[{:title "media" :searching? searching?
:blank "nothing uploaded yet"
:rows (mapv #(footage-row % chosen rename) media)}
{:title "sounds" :searching? searching?
:blank "no sounds uploaded yet"
:rows (mapv #(sound-row % (:fps document) rename) sounds)}
{:title "symbols" :searching? searching?
:blank "no other saved projects"
:rows (for [[[pid pname] rows] grouped]
^{:key (str pid)}
;; Open while a search is running: you asked for these by name,
;; and a hit behind a closed twisty is a hit you cannot see.
[:details.pool-project {:open (boolean searching?)}
[:summary (str pname " · " (count rows)
(if (= 1 (count rows)) " symbol" " symbols"))]
(doall
(for [{:keys [cid symbol name frames]} rows]
^{:key (str cid symbol)}
[item (merge {:label name :sub (str frames "f")}
(carrying (str "import:" (str/join "|" [pid cid symbol]))
#(drag/other! {:kind :import :label name
:frames frames
:project pid :cid cid
:symbol symbol})))]))]))))))))
(into [:div.pool-rows] (map #(import-row % pid)) rows)])}]]))
;; ---------------------------------------------------------------------------
(defn- counts
"How many rows each scope holds for `query`.
This is what keeps the tabs from hiding anything. A tab shows its tally only
while a search is running and only on the scope you are NOT looking at, so the
one cost of collapsing two folders into two tabs — that a hit could be behind
the tab you did not pick — is paid off by a number, counted over the same
labels the rows are filtered by."
[{:keys [document query media sounds available all-sounds symbols project-id]}]
(let [n (fn [labels] (count (filter #(hit? query %) labels)))]
{:project (+ (n (map #(clip/symbol-name document %) (keys (:symbols document))))
(n (map :label media))
(n (map :label sounds)))
:assets (+ (n (map :label available))
(n (map :label all-sounds))
(n (map :name (remove #(= project-id (:project %)) symbols))))}))
(defn view []
(r/with-let [;; Counted, not a boolean. `dragenter`/`dragleave` fire for every
;; child element the pointer crosses, so a flag set on enter and
;; cleared on leave flickers off the moment the drag passes over a
;; row — the depth counter is what makes the outline steady.
depth (r/atom 0)]
(let [{:keys [loading? status]} @(rf/subscribe [::playback/footage])
depth (r/atom 0)
query (r/atom "")
scope (r/atom :project)
;; Which row is being renamed, as `[kind id]`. One atom rather
;; than a flag per row: exactly one name is ever being edited, and
;; opening a second input has to close the first.
editing (r/atom nil)]
(let [{:keys [loading? status available sounds chosen]} @(rf/subscribe [::playback/footage])
document @(rf/subscribe [::sub/settled-clip])
clip-id @(rf/subscribe [::render/clip-id])
store @(rf/subscribe [::render/store])
palette @(rf/subscribe [::render/palette])
ramp @(rf/subscribe [::render/ramp])
selection @(rf/subscribe [::sub/selection])
open @(rf/subscribe [::render/open])
media @(rf/subscribe [::sub/project-footage])
{:keys [symbols]} @(rf/subscribe [::project/assets])
{project-id :id} @(rf/subscribe [::playback/project])
;; The project's videos' sounds first, then its uploaded ones.
own-sounds (into (mapv (fn [{:keys [id label frames fps]}]
{:id id :label label :footage? true :fps fps
:duration (/ frames fps)})
media)
@(rf/subscribe [::sub/project-sounds]))
needle (str/lower-case (str/trim @query))
searching? (boolean (seq needle))
ctx {:document document :clip-id clip-id :store store :palette palette
:ramp ramp :selection selection :open open
:media media :sounds own-sounds :chosen chosen
:available (vec available) :all-sounds (vec sounds)
:symbols symbols :project-id project-id
:query needle :searching? searching?
;; `clip/opens-on` and not `:main`: the longest symbol nothing
;; else places is the timeline the work happens in, and it is the
;; one row in this pane drawn big enough to read a pose off.
:main (clip/opens-on document)
:rename {:editing @editing :begin! #(reset! editing %)}}
tallies (counts ctx)
files? (fn [^js e] (some #{"Files"} (array-seq (.. e -dataTransfer -types))))]
[:section.pane.pool
{:class (when (pos? @depth) "dropping")
@ -208,7 +540,27 @@
(when-let [file (aget (.. event -target -files) 0)]
(rf/dispatch [::footage/upload file])
(set! (.. event -target -value) "")))}]
[:div.pool-find
[:input.pool-search
{:id "pool-search" :type "search" :value @query
:placeholder "search" :aria-label "search the media pool"
:on-change #(reset! query (.. % -target -value))
:on-key-down (fn [^js e] (when (= "Escape" (.-key e)) (reset! query "")))}]
(when searching?
[:button.pool-clear {:title "clear the search" :aria-label "clear the search"
:on-click #(reset! query "")}
"×"])]
[:div.tabs
(doall
(for [[k label] [[:project "this project"] [:assets "all assets"]]]
^{:key (str k)}
[:button.tab {:class (when (= k @scope) "on")
:on-click #(reset! scope k)}
label
;; Only while searching, and only on the tab you are not looking at:
;; it exists to say "the thing you asked for is over here".
(when (and searching? (not= k @scope))
[:span.count (get tallies k)])]))]
[:div.pane-body
[this-project]
[all-assets]
(if (= :project @scope) [this-project ctx] [all-assets ctx])
(when status [:div.dim status])]])))

View file

@ -682,14 +682,16 @@
It reuses `rows`, so its spans and selection addresses are exactly the ones
the timeline presents rather than a second interpretation of the document."
[clip sid frames]
(mapv (fn [{:keys [path label cels]}]
(mapv (fn [{:keys [path label cels select]}]
{:id (peek path)
:path path
:select select
:label label
:cells (mapv (fn [f]
(let [cel (some (fn [{[in out] :span :as cel}]
(when (and (<= in f) (< f out)) cel))
cels)]
{:frame f :lane (peek path) :cel cel}))
{:frame f :lane (peek path) :lane-select select :cel cel}))
(range frames))})
(filter :cels (rows clip sid #{}))))
@ -704,8 +706,11 @@
(str "52px repeat(" (max 1 (count columns)) ", minmax(110px, 1fr))")}]
[:div.cel-sheet {:style style}
[:div.cs-head.cs-frame "frame"]
(doall (for [{:keys [id label]} columns]
^{:key (str "head-" id)} [:div.cs-head label]))
(doall (for [{:keys [path label select]} columns]
^{:key (str "head-" path)}
[:button.cs-head {:class (when (= select selection) "selected")
:on-click #(rf/dispatch [::ui/select select])}
label]))
(doall
(for [f (range frames)
item (cons {:frame-label? true}
@ -714,7 +719,8 @@
^{:key (str "frame-" f)}
[:button.cs-frame {:class (when (= f frame) "on")
:on-click #(rf/dispatch [::pb/seek f])} f]
(let [{:keys [id label select]} (:cel item)]
(let [{:keys [id label select]} (:cel item)
target (or select (:lane-select item))]
^{:key (str f "-" (:lane item) "-" (or id "gap"))}
[:button.cs-cell
{:class (str (when (= f frame) " current")
@ -722,7 +728,7 @@
:title (if id (str label " · frame " f) (str "gap · frame " f))
:on-click (fn []
(rf/dispatch [::pb/seek f])
(when select (rf/dispatch [::ui/select select])))}
(rf/dispatch [::ui/select target]))}
(or label "—")]))))]))
(defn view []

View file

@ -287,6 +287,30 @@
"a covering replacement establishes the shape seen by later layers")
(is (= [2 3 4] (ch/value-at (corrected base put3 add3) 0 nil)))))
(deftest stack-compatibility-follows-adjacent-replacements-and-skips-conflicts
(let [base (ch/framed [0 0])
left (ch/layer :left [0 2] :replace (ch/framed [1 2 3]))
right (ch/layer :right [2 4] :replace (ch/framed [4 5 6]))
add3 (ch/layer :add [0 4] :offset (ch/framed [1 1 1]))
valid (corrected base left right add3)
broken (corrected base (assoc left :conflict "skip it") right add3)]
(is (empty? (ch/problems valid))
"adjacent replacements jointly prevent the base shape reaching the offset")
(is (seq (ch/problems broken))
"a conflicted replacement is absent from the effective stack")
(is (empty? (ch/conflicts valid)))
(is (= [:left :add] (mapv :id (ch/conflicts broken))))))
(deftest reconciliation-recomputes-the-complete-stack-in-order
(let [old (assoc (ch/framed [0 0]) :over
[(assoc (ch/layer :put [0 3] :replace (ch/framed [1 2 3]))
:conflict "old")
(ch/layer :add [0 3] :offset (ch/framed [1 1 1]))])
layers (ch/reconcile old)]
(is (nil? (:conflict (first layers))) "a stale mark is cleared")
(is (nil? (:conflict (second layers))) "the later offset sees that replacement")
(is (= [2 3 4] (ch/value-at (assoc old :over layers) 1 nil)))))
(deftest generated-base-time-and-authored-correction-time-can-differ
(let [c (corrected (ch/keyed {0 0, 2 20} :hold)
(ch/layer :nudge [1 2] :offset (ch/framed 3)))

View file

@ -0,0 +1,86 @@
(ns arthur.domain.correction-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.correction :as correction]
[arthur.domain.leaf :as leaf]
[arthur.domain.lane-test :as fixture]))
(defn- channel [doc id path]
(get-in doc [:symbols :main :nodes id :channels path]))
(deftest authors-the-three-motions-as-ordinary-layer-channels
(let [doc (fixture/document)
constant (correction/add doc :main :girl [:xform :rot]
{:id :flat :support [2 5] :motion :constant :delta 1})
ramp (correction/add (:clip constant) :main :girl [:xform :rot]
{:id :ramp :support [6 9] :motion :ramp :start 0 :end 2})
returned (correction/add (:clip ramp) :main :girl [:xform :rot]
{:id :return :support [9 12] :motion :return
:start 0 :peak 3 :peak-frame 10})
c (channel (:clip returned) :girl [:xform :rot])]
(is (= :girl (:selection returned)))
(is (= [:flat :ramp :return] (mapv :id (:over c))))
(is (= [0 0 1 1 1 0 0 1 2 0 3 0]
(mapv #(ch/value-at c % nil) (range 12))))
(is (empty? (clip/problems (:clip returned))))))
(deftest materializes-defaults-and-refuses-incomplete-intent
(let [doc (fixture/document)
result (correction/add doc :main :a [:xform :rot]
{:id :nudge :support [0 3] :motion :return
:start 0 :peak 0.5 :peak-frame 1})]
(is (= 0.5 (ch/value-at (channel (:clip result) :a [:xform :rot]) 1 nil)))
(is (= (dissoc (get-in doc [:symbols :main :nodes :a]) :channels)
(dissoc (get-in (:clip result) [:symbols :main :nodes :a]) :channels)))
(doseq [spec [{:id :x :support [0 1] :motion :ramp :start 0 :end 1}
{:id :x :support [0 2] :motion :return :start 0 :peak 1 :peak-frame 1}
{:id :x :support [0 3] :motion :constant :delta js/NaN}
{:id :x :support [0 3] :motion :constant :delta [1 2]}]]
(let [r (correction/add doc :main :a [:xform :rot] spec)]
(is (:refused r))
(is (not (contains? r :clip)))))))
(deftest removal-and-retry-never-leave-an-invalid-stack
(let [doc (fixture/document)
base (ch/framed [0 0])
put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3]))
add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1]))
stacked (assoc base :over [put3 add3])
doc (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos]] stacked)]
(is (:refused (correction/remove-layer doc :main :girl [:xform :pos] :put3))
"removing the replacement would expose a wrong-shaped base")
(let [conflicted (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict]
"old topology")
retried (correction/retry-layer conflicted :main :girl [:xform :pos] :add3)]
(is (:clip retried))
(is (nil? (get-in (:clip retried)
[:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict]))))
(let [without-replacement (-> doc
(assoc-in [:symbols :main :nodes :girl :channels [:xform :pos] :over]
[(assoc add3 :conflict "old topology")]))]
(is (:refused (correction/retry-layer without-replacement :main :girl
[:xform :pos] :add3))
"retry refuses when the current effective base still has the wrong shape"))))
(deftest a-cel-correction-travels-with-its-owner
(let [doc (fixture/document)
result (correction/add doc :main :b [:xform :pos]
{:id :nudge :support [1 3] :motion :constant :delta [4 0]})
c (channel (:clip result) :b [:xform :pos])]
(is (= [6 0] (ch/value-at c 1 nil)))
(is (= [0 0] (ch/value-at c 0 nil)))
(is (= [2 0] (ch/value-at c 3 nil)))))
(deftest corrections-round-trip-with-identity-support-and-order
(let [doc (fixture/document)
one (:clip (correction/add doc :main :girl [:xform :rot]
{:id :one :support [0 3] :motion :constant :delta 1}))
two (:clip (correction/add one :main :girl [:xform :rot]
{:id :two :support [3 6] :motion :ramp
:start 0 :end 2}))
back (leaf/clip "u" (leaf/leaves "u" two))]
(is (= two back))
(is (= [:one :two]
(mapv :id (get-in back [:symbols :main :nodes :girl
:channels [:xform :rot] :over]))))))

View file

@ -1,6 +1,7 @@
(ns arthur.events.lane-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.lane-test :as fixture]
[arthur.domain.correction :as correction]
[arthur.domain.lane :as lane]
[arthur.events.ui :as ui]
[arthur.domain.history :as history]
@ -24,6 +25,8 @@
column (first (timeline/cel-sheet doc :main 12))
cells (:cells column)]
(is (= :girl (:id column)))
(is (= [:node :main :girl [:girl]] (:select column)))
(is (every? #(= (:select column) (:lane-select %)) cells))
(is (= [:a :b :insert] (mapv #(get-in cells [% :cel :id]) [0 4 8])))
(is (= [[:node :main :a [:a]]
[:node :main :b [:b]]
@ -65,3 +68,23 @@
(is (= (:clip r1) (leaf/clip "u" (:leaves undo))))
(is (= doc (leaf/clip "u" (:leaves undo2))))
(is (= [:node :main :a [:a]] (get-in db2 [:ui :selection]))))))
(deftest a-correction-is-one-step-and-keeps-the-full-selection-address
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "correction-event-test")
selection [:node :main :a [:outer :a]]
db {:clip/current id :paint/revision 0
:ui {:open :outer :selection selection}}
result (correction/add doc :main :a [:xform :rot]
{:id :nudge :support [0 3] :motion :return
:start 0 :peak 0.5 :peak-frame 1})
after (ui/apply-correction-command db result)
entry (store/entry id)]
(is (= selection (get-in after [:ui :selection])))
(is (= 1 (count (get-in entry [:history :done]))))
(is (= 0.5 (get-in (:clip entry)
[:symbols :main :nodes :a :channels [:xform :rot]
:over 0 :values :keys 1])))
(let [refused (ui/apply-correction-command after {:refused "nope"})]
(is (= "nope" (get-in refused [:project :status])))
(is (= 1 (count (get-in (store/entry id) [:history :done])))))))

View file

@ -255,10 +255,54 @@ try {
assert.deepEqual(placed(s), [[0, 3], [3, 4], [6, 7], [7, 8], [8, 9]],
'a command selected in the sheet has the timeline command semantics');
assert.equal(s.history.done.length, before.history.done.length + 9);
// Correction authoring is reachable from the same selection. The range is
// in this cel's own frames and Apply is one isolated history transaction.
assert(await evaluate(`(() => {
const section = [...document.querySelectorAll('.section')]
.find(s => s.querySelector('h2')?.textContent.trim() === 'corrections');
const label = [...section.querySelectorAll('label')]
.find(l => l.textContent.trim().startsWith('offset (degrees)'));
const input = label?.querySelector('input');
if (!input) return false;
const set = Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set;
set.call(input, '15');
input.dispatchEvent(new Event('input', {bubbles: true}));
input.dispatchEvent(new Event('change', {bubbles: true}));
return true;
})()`), 'rotation correction value is editable');
await sleep(100);
await click('apply correction');
s = await shot();
const selectedCel = instances(s).find(n => n.time.at === 0);
const rot = Object.values(selectedCel.channels).find(c => c.over?.length);
assert.equal(rot.over.length, 1);
assert(Math.abs(rot.over[0].values.value - Math.PI / 12) < 1e-9,
'the inspector converts the authored degree offset to radians');
assert.equal(s.history.done.length, before.history.done.length + 10);
// A gap targets its column's lane. This catches the stale-selection bug that
// only appears once a sheet has more than one lane.
await click('timeline');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 5);
await click('+ lane');
await click('cel sheet');
assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 2);
await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2)
.find(c => c.textContent.trim() !== '—')).click()`);
await sleep(100);
await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2)
.find(c => c.textContent.trim() === '—')).click()`);
await sleep(100);
await click('overwrite');
s = await shot();
assert(Object.values(s.clip.symbols.main.nodes)
.some(n => n.kind === 'instance' && n.parent !== 'girl' && n.time.at === 0),
'clicking a gap selects that column before overwrite');
assert.equal(s.history.done.length, before.history.done.length + 12,
'correction, lane creation, and overwrite are separate undo steps');
assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: lane commands agree from timeline and cel sheet; no server writes');
console.log('PASS: lane commands and corrections agree from timeline and cel sheet; no server writes');
} finally {
if (ws?.readyState === WebSocket.OPEN) {
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));

View file

@ -416,67 +416,249 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.peer.guest { background: var(--dim); }
/* --------------------------------------------------------------------------
media pool */
media pool
/* Two folders, THIS PROJECT and ALL ASSETS, each holding groups. */
.pool-folder { margin-bottom: 8px; }
.pool-folder > summary {
cursor: pointer;
padding: 2px 0 4px;
font-weight: 600;
color: var(--fg);
A FILE LIST, AND IT IS 210px WIDE. Every row is one line — a picture at the
stage's own proportions, a name, one number — because the pane under this one
is the timeline and a row that costs two lines costs timeline rows. The row is
--row tall, which is a timeline row, so a pool of symbols and the rows they
end up on are the same size object.
One exception, deliberately: the main timeline. See `.pool-row.main`. */
/* The search strip, between the pane head and the tabs. Its own band rather
than crowded into the head, which is one line and already holds the + . */
.pool-find {
position: sticky;
top: 21px;
z-index: 2;
display: flex;
align-items: center;
gap: 4px;
padding: 3px 5px;
background: var(--chrome);
border-bottom: 1px solid var(--hair);
}
.pool-folder > .pool-group { padding-left: 8px; }
.pool-project { margin-bottom: 2px; }
.pool-project > summary { cursor: pointer; color: var(--dim); padding: 1px 0; }
.pool-project > .pool-item { margin-left: 10px; width: calc(100% - 10px); }
.pool-group { margin-bottom: 9px; }
.pool-search {
flex: 1;
min-width: 0;
height: 17px;
padding: 0 5px;
font: inherit;
color: var(--fg);
background: var(--pane);
border: 1px solid var(--line);
border-radius: 2px;
}
/* The one-line gloss under a group heading. Small and quiet: it answers "what
is this list" once, for someone who has not read the model. */
.pool-group > h2 + .dim { margin-bottom: 4px; }
/* Safari draws its own clear button inside a search input, in its own idiom and
at its own size. The one next to it is this file's. */
.pool-search::-webkit-search-decoration,
.pool-search::-webkit-search-cancel-button { -webkit-appearance: none; }
.pool-group > h2 {
margin: 0 0 3px;
.pool-clear {
flex: 0 0 auto;
width: 17px;
height: 17px;
padding: 0;
border: 0;
border-radius: 2px;
background: none;
color: var(--dim);
cursor: pointer;
}
.pool-clear:hover { background: var(--hair); color: var(--fg); }
/* The scope tabs, in the vocabulary `ui/tabs` already established for symbols —
the same object, so two rows of tabs on one screen read as one idea. */
.pool > .tabs { top: 45px; position: sticky; z-index: 2; }
/* A tally, shown only on the tab you are NOT looking at and only while a search
is running: it says "what you asked for is over here". */
.tab .count {
padding: 0 4px;
border-radius: 7px;
background: var(--sel-bg);
color: var(--sel);
font-variant-numeric: tabular-nums;
}
/* MEDIA, SOUNDS, TIMELINES. A heading is one line and it sticks, so scrolling a
long list never leaves you looking at rows with no idea what kind they are. */
.pool-section { margin-bottom: 7px; }
.pool-section > h2 {
position: sticky;
top: 69px;
z-index: 1;
margin: 0 0 2px;
padding: 1px 5px;
font: inherit;
font-weight: 600;
color: var(--dim);
text-transform: uppercase;
letter-spacing: .07em;
background: var(--pane);
}
.pool-item {
display: block;
width: 100%;
text-align: left;
padding: 2px 6px;
.pool-section > .dim { padding: 0 5px 2px; }
.pool-rows { display: flex; flex-direction: column; }
/* What a search found nothing to say. */
.pool-empty { padding: 6px 5px; color: var(--dim); }
.pool-project { margin: 0 0 1px 5px; }
.pool-project > summary { cursor: pointer; color: var(--dim); padding: 1px 0; }
.pool-project > .pool-rows { margin-left: 8px; }
/* THE ROW IS THE BUTTON. Click selects, double-click opens, and drag starts
anywhere across it — the whole strip, not the few characters of the name. The
wrapper carries the state classes and the frame; the button inside it fills
that frame edge to edge, so there is no dead strip anywhere along the row. */
.pool-row {
display: flex;
align-items: center;
gap: 2px;
min-width: 0;
height: var(--row);
padding: 0 4px;
border: 1px solid transparent;
border-radius: 2px;
}
.pool-row:hover:not(.disabled) { background: #fff; }
.pool-row.on { background: var(--sel-bg); border-color: var(--sel); }
/* WHICH ONE IS OPEN, as a mark and not as the word "open" — a list this narrow
cannot spend twenty pixels of every name on a word that is true of one row.
The accent, because selection is the only thing it is ever used for and the
open symbol is what the rest of the screen is showing. */
.pool-row.open { box-shadow: inset 2px 0 0 var(--sel); }
.pool-item {
display: flex;
align-items: center;
gap: 5px;
flex: 1;
min-width: 0;
padding: 0;
text-align: left;
border: 0;
background: none;
color: inherit;
font: inherit;
cursor: grab;
}
/* Shrinks to the name, so the pencil sits against the end of the word rather
than out at the edge of the pane — and ellipses rather than pushing the
number off the row. */
.pool-item .text { display: flex; flex-direction: column; flex: 0 1 auto; min-width: 0; }
.pool-item .name { overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }
/* The number, at the far edge and never moving: `auto` on the left is what
pushes it there, and tabular figures are what stop it shuffling as the rows
scroll past. */
.pool-item > .sub {
flex: 0 0 auto;
margin-left: auto;
padding-left: 4px;
color: var(--dim);
font-variant-numeric: tabular-nums;
}
/* Every row leads with a picture, and they are all this box, so the names line
up down the list whatever is beside them. 16:10 is the stage's own ratio at
320x200 — a thumbnail that is not the picture's shape is a thumbnail you have
to think about. */
.pool-item .thumb {
flex: 0 0 32px;
width: 32px;
height: 20px;
object-fit: cover;
background: var(--stage);
border-radius: 1px;
pointer-events: none;
}
.pool-item .thumb.sound {
display: flex;
align-items: center;
justify-content: center;
color: #d9d9d9;
}
/* THE MAIN TIMELINE, under the PROJECT heading and at the top of the pane.
`clip/opens-on`'s answer: the longest symbol nothing else places, which is
where the work happens. The one row in the pane given size, a second line and
a surface of its own — spent here rather than spread over every row, which is
what keeps the list below it a list. */
.pool-row.main {
height: auto;
margin-bottom: 5px;
padding: 4px;
background: var(--sunk);
border-color: var(--hair);
}
.pool-row.main .thumb {
flex: 0 0 64px;
width: 64px;
height: 40px;
}
.pool-row.main .name { font-weight: 600; }
/* Both facts on one line under the name. Beside a 64px picture there is room,
and this is the one row where a person wants more than the length before
they click. */
.pool-row.main .detail {
color: var(--dim);
font-variant-numeric: tabular-nums;
overflow: hidden;
text-overflow: ellipsis;
white-space: nowrap;
}
.pool-item:hover:not(:disabled) { background: #fff; }
.pool-item.on { background: var(--sel-bg); border-color: var(--sel); }
.pool-item .sub { display: block; color: var(--dim); }
.pool-item .text { display: block; overflow: hidden; text-overflow: ellipsis; }
/* The pencil. A span and not a button — see `ui/pool`'s `row` — so it needs its
own centring and cursor rather than inheriting a control's.
/* A media row leads with one frame of the video. */
.pool-item.media { display: flex; align-items: center; gap: 6px; }
.pool-item .thumb {
flex: 0 0 40px;
width: 40px;
height: 30px;
max-width: 40px;
max-height: 30px;
object-fit: cover;
background: var(--stage);
Hidden until the row is under the pointer or holds focus, because a column of
twenty pencils is a column of twenty pencils; `visibility` rather than
`display`, so it keeps its width and the name beside it does not reflow as the
pointer crosses the list. */
.pool-rename {
display: flex;
align-items: center;
justify-content: center;
flex: 0 0 15px;
width: 15px;
height: 15px;
border-radius: 2px;
color: var(--dim);
line-height: 1;
cursor: pointer;
visibility: hidden;
}
.pool-row:hover .pool-rename,
.pool-row:focus-within .pool-rename { visibility: visible; }
.pool-rename:hover { background: var(--hair); color: var(--fg); }
/* Renaming. The input REPLACES the row at the same height, so a list does not
jump while you type in it. */
.pool-name {
flex: 1;
min-width: 0;
height: 17px;
padding: 0 4px;
font: inherit;
color: var(--fg);
background: #fff;
border: 1px solid var(--sel);
border-radius: 2px;
pointer-events: none;
}
/* The whole pane is the drop target, so the cue has to be the pane and not a
@ -648,6 +830,12 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.inspector-field { display: grid; gap: 2px; color: var(--dim); }
.inspector-field input { width: 100%; color: var(--fg); }
.correction-grid { display: grid; grid-template-columns: 1fr 1fr; gap: 5px; }
.correction-grid select, .correction-grid input { width: 100%; color: var(--fg); }
.correction-list, .correction-conflicts { display: grid; gap: 4px; margin-top: 7px; }
.correction-item { display: flex; align-items: center; gap: 4px; min-width: 0; }
.correction-item > span { flex: 1; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }
/* Label / value, once, for every read-only fact in the pane. */
.facts { display: grid; grid-template-columns: auto 1fr; gap: 2px 8px; margin: 0; }
.facts dt { color: var(--dim); }
@ -962,6 +1150,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
align-items: center;
background: var(--chrome);
font-weight: 600;
cursor: pointer;
}
.cs-head.cs-frame { z-index: 3; }
@ -970,6 +1159,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.cs-cell { text-align: left; cursor: pointer; }
.cs-cell:hover { background: var(--sel-bg); }
.cs-cell.selected { background: var(--sel-bg); color: var(--sel); font-weight: 600; }
.cs-head.selected { background: var(--sel-bg); color: var(--sel); }
/* --------------------------------------------------------------------------
the video -> symbol dialog */