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

Compare commits

base: noe:4ddd6a8d1dbf004ef86130720e14c52953c6557a
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes
...
compare: noe:93f5112bb3feabe8fe8d5a8aaf805bcc2ae75191
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes

10 commits
4ddd6a8d1d ... 93f5112bb3

Author SHA1 Message Date
Your Name
93f5112bb3 Unify clip placement across symbol modes 2026-10-01 20:09:35 -04:00
Your Name
e459307a4a Make lanes explicit symbol views 2026-10-01 19:40:53 -04:00
Your Name
fb38990090 Loop is two things, and the one that matters is unreachable 
Loop playback — the transport repeating the open symbol — is editor state and
the document has never heard of it. A looping INSTANCE is a node repeating the
symbol it places, which is the four-frame tire turning for the hundred and
twenty frames it is on screen, and it lives in the document as
`:playback {:end :loop}`. Same word, two scopes; named apart here before
anything is built on either.

The status of the second one is the surprise: it already works and cannot be
asked for. `node/placed-frame` does the modulo, `node/problems` already admits
`:end :loop`, `audio-tracks` already expands the periods — and no control sets
it anywhere in the UI. So the tire is three pieces of work, not one: somewhere
to edit an instance's playback, a block that draws its repeats rather than
only its first pass as the timeline's own docstring admits it does, and the
audio period guard.

This also pins down when the held cel can be torn out. Turning every drawing
into a one-frame looping instance is only safe once a looping instance can be
seen and edited; otherwise every drawing in the document quietly acquires a
property with no control on it.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 16:32:02 -04:00
Your Name
d029908f0b A held cel is a one-frame symbol that loops 
Holding a drawing and looping a one-frame symbol are the same picture, and the
second is a case the model already carries, so the first is a special case
kept for nothing. Speed 0 goes; a cel becomes a one-frame symbol with
`:end :loop` and a span. Looping and span are already properties of the
instance and `:frames` already belongs to the symbol, so nothing moves — a
mode is deleted. Two spellings of looping collapse to one, `:time :loop?`
giving way to `:playback :end :loop`, and `extend-hold` collapses into
`resize-out`, since it exists only to refuse anything that is not frozen
before editing a span.

What it buys is one rule where there were three refusals. `nest/inside` has no
invertible clock for a hold, for `:end :hold`, or for a loop, so
shift-to-reparent refuses all three — which is most of what anybody would drag
onto. Resolving the move with the destination's map at the CURRENT frame
covers every one: a loop is affine within the period the frame falls in, a
one-frame loop is that rule with a period of one — which lands exactly where
the nesting notes argued it should from first principles — and `:end :hold` is
affine in the played part and frozen in the tail.

The trap is written down beside it, because it would be found the hard way:
`audio-tracks` expands a loop into one walk per period, and is saved today
only by the `(pos? speed)` guard that a held cel fails. Make every drawing a
loop and a drawing held for 120 frames becomes 120 walks emitting any nested
sound 120 times. An audibility precheck has to land in the same change.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 16:31:06 -04:00
Your Name
6e7827e03f Non-overlap is an invariant, not a report 
The plan asked what to draw when a symbol in lane mode holds overlapping
children, and offered to report it as a decision waiting for a person. Wrong
question: they never overlap. Placement claims time — anything placed, moved
or grown over occupied time trims, removes or splits what it lands on — so the
operation that could have made an overlap did not, and `span/finish`, which is
already the single commit path and already refuses rather than half-applying,
is where that is enforced. An overlap is then a bug in a command and not a
state to design around.

The check stays, named `symbol/overlaps` and used three ways: the commit path
refuses one, a property test asserts no command can produce one, and a
document that somehow holds one still LOADS and is drawn visibly wrong with
the status saying so. Not `problems`, which stops a document loading, and not
`conflicts`, which means somebody has a decision to make — a display hint must
never be able to keep a document from opening.

The one place a person can ask for the impossible is toggling lane mode on
over children that already overlap. That refuses and offers to trim them into
a sequence, through the `:required-frames` retry the model already uses.

Also written down, because it is the pair the modifier exists to separate:
a plain body drag is temporal and replaces, trimming extents as needed; shift
is structural and goes through `nest/move-node` into the symbol under the
pointer, which has to keep working for symbols held in a lane.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 16:22:33 -04:00
Your Name
10b96761fa Plan: a lane is a view, not a thing in the document 
The lane model put a second container in the node map — a group with
`:layout :sequence`, with its own membership, its own validation and its own
fourteen commands — and every part of the editor then had to ask which kind of
container it was looking at. The decision recorded here is to delete all of
it: a lane becomes a way of DRAWING a symbol whose children are sequential and
non-overlapping, the display goes back to a row per symbol, and the word
survives only in the timeline and in the drag handling that re-spans a
symbol's children while it is drawn that way.

The commands are not the part being thrown away. `extend-hold`, `resize-out`,
`roll`, `blank` and the rest are what endpoint dragging IS, and their
arithmetic is right; what changes is their subject, from "the children of lane
L in symbol S" to "the children of symbol S". They belong in `span.cljs`,
which already owns re-spanning and `finish`.

The plan takes a position on the one question that decides whether this is a
simplification or a circle: lane mode is a saved hint on the symbol rather
than unsaved view state, because the drag rules follow the mode, and a toggle
the document does not record would make one gesture do two different things
to it. Nothing outside the timeline may read the hint.

It also lists what must not be lost on the way, all of which broke at least
once today: a held clip's contents reachable with no keys and no draggable
edges, double-click to open surviving the selection it leaves behind,
selection waiting for pointer-up, no drop silently deleting what it lands on,
and a sound drawn once.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 16:16:30 -04:00
Your Name
2dc5735ded The timeline opens the whole document 
Making a lane one row cost the thing a row was for. A clip stopped being a row,
so there was no longer any way to open a clip and see what was inside it, and
the inside of a drawing — the most ordinary thing in the document — became
reachable only by opening it as its own tab. This is that capability back,
from the root timeline, down as far as it goes.

An expanded lane opens exactly ONE clip: the selected one. Its own keys, then
the lanes and nodes of the symbol it places, then theirs, each mapped into this
ruler by the recursive walk that was already there. Twelve clips in a lane
still cost one row, and inspection costs one branch rather than twelve.

Two things that only showed up once it ran. The portal is chosen by the whole
LINEAGE of the selection and not by the selected id: selecting a shape inside
the clip — or the end of its span — is still working inside that clip, and
matching the id alone shut the portal the instant anything under it was
touched. And selecting now waits for the pointer to come UP, because selecting
on the way down re-drew the timeline before the gesture had said anything: it
shut the portal holding the lane being dragged INTO, out from under the
pointer.

A HELD clip opens too, which the old row walk never did either. `source-time`
is nil for a hold, so the walk stopped there and the contents of every drawing
were invisible from here. Its rows are shown across the hold — which is when
the node is on screen — and marked `:unmapped?`: no keys, and no draggable
edges, because a frozen clock gives no frame inside it a place on this ruler.
Refusing to place the keys is the honest half; refusing to show the rows was
not.

Double-clicking a clip opens the symbol it places as a tab, as double-clicking
the same symbol in the pool does. That was already written and had never once
run: the track captures the pointer for a slide, so the click and double-click
that follow are delivered to the track and never to the block. The track now
resolves them itself. Fixing the delivery exposed two more: `symbol/lineage`
reported a `parent cycle` for any id in a symbol with NO nodes, because a
one-element chain is longer than zero nodes — and opening a symbol left the
selection pointing into the symbol being left, which the breadcrumb and the
inspector then tried to resolve. The editor unmounted. Both are fixed where
they were wrong, and the browser test asserts the editor is still standing
afterwards.

Audio is a clip in a lane like everything else. A dropped sound lands in one
and is trimmed and moved by the same commands; a lane holds picture or sound
and not both, which is the explicit capability the model asked for rather than
a guess per frame. The refusal lives in the commands and not only in
validation, because placement claims time: `blank` would have deleted the
sound to make room for the picture and left a perfectly valid document behind.
What is in a lane of the open symbol is drawn as a lane; what is nested inside
a placed symbol is still flattened by `audio-tracks`, so no sound is on two
rows.

Everything that enters the timeline now enters a lane: a converted take, a
symbol brought in from another project, a sound. One rule answers where —
`lane-destination` — and every symbol is born with a lane for it to answer
with. An unaimed drop fills an EMPTY lane rather than taking an occupied one
nobody pointed at, because the alternative is trimming away what was there to
make room for what was dropped.

Shift during a clip-body drag means the other intention: put this node INSIDE
the symbol the clip under the pointer places, through `nest/move-node`, which
is what keeps the world transform and the root timing. Overlap cannot say
which of the two is meant — dropping on occupied time already means claiming
it — so the person says, and a label by the pointer says it back. The label
asks `nest/move-refusal`, the same check the command makes, so it cannot
promise what the drop would refuse. Today it refuses more than it allows:
both clips have to be on screen at one frame, which two clips in one lane
never are, and a held destination has no clock to move through at all.
`docs/lane-nesting-notes.md` argues that the second refusal is stronger than
the facts require and says what would settle it.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 16:13:02 -04:00
Your Name
95451798d2 Nesting is a gesture of its own, not an overlap 
Now that a lane is generic, the obvious next move is to read a clip dropped on
another clip as "put it inside that symbol". It cannot mean that: dropping a
clip on occupied lane time already means it claims that time and trims the
incumbent. Structural nesting therefore needs an explicit affordance -- a grab
handle with `grab`/`grabbing` cursors, distinct from the body's temporal move
and the edges' trims -- and its drop must route through `nest/move-node`, which
preserves world transform and root timing, rather than through a weaker
`:parent` assignment that would make a drawing jump when it is rehoused.

The second half of the note is what expansion should be. One permanently
expanded row per lane clip is the vertical growth the one-row lane exists to
avoid, so an expanded lane shows exactly one portal: the currently selected
clip, swapped in place when the selection changes, not following the playhead.
The portal header is the structural drop target, sub-expanding it walks the
source symbol's lanes through the existing recursive root-time mapping, and
collapsed clips carry their instance-level keys as ticks. The cost of
inspection stays constant.

No lane-as-symbol type and no second ownership edge: the hierarchy is still
symbol, lane, clip, source symbol, its nodes. Lane membership owns time; a
symbol instance owns composition. Written before the interaction is built,
because the capability it protects is easy to lose by accident.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 15:13:18 -04:00
Your Name
5ebe776ce4 A lane is a generic row of symbol clips 
A lane was a drawing lane: the only thing that could go in one was a one-frame
held cel, and every other symbol instance stayed a permanent root row of its
own. Those are not two kinds of timing, they are one kind with two creation
policies. `lane/place-symbol` drops any library symbol in as a clip that plays
naturally at speed one, `lane/adopt` moves an instance that is already in the
document into a lane keeping its source, span, playback and corrections, and
`append-drawing`/`overwrite-drawing` keep being the policy that makes a new
empty symbol a one-frame hold. The child shape they produce is the same.

Both new commands claim their interval through `blank` before they write, so
the partition rule is unchanged and unduplicated: placing into occupied lane
time trims, removes or splits the incumbents, and a lane still never stores an
overlap. Real compositing overlap is another lane, where the order is explicit.

Creating a symbol with nothing aimed now makes a lane and a clip in it instead
of a loose root instance, and a pool drop prefers an explicitly targeted lane,
then the selected one, and makes a lane only when there is neither. That is
what stops the row-per-symbol growth coming back in through the drop path, and
it is why `add-lane` now takes a z in front of the existing root nodes and
calls what it makes a "lane" rather than "drawings".

The timeline learned the two gestures that a generic lane needs. A clip body
dragged over another lane's track previews there as a dashed block and lands
through `::adopt-in-lane`; the track is found with `elementsFromPoint` and its
selection read back off the element, because a pointer capture does not
retarget. A pool drop over an existing lane previews as a dashed clip inside
that lane instead of a temporary new row that appears and then vanishes --
which also needed the drag-leave check to be geometric, since inserting the
preview changes the element under the pointer and Chromium then reports a leave
with no related target. Lanes are renameable from their label, by double-click,
F2, or the pencil, through `::rename-node`.

`symbol/lane-cels` is `symbol/lane-clips`, and the vocabulary table in the
handoff now separates the two words it had merged: a clip is an instance in a
lane, and a cel is specifically the one-frame held source that drawing creation
makes. Keeping `cel` for the policy is what lets the lane stop being about
drawings at all.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-10-01 15:13:07 -04:00
Your Name
26ada03591 Unify cel editing in the timeline 2026-10-01 14:37:59 -04:00
34 changed files with 3574 additions and 2538 deletions
Download patch file Download diff file Expand all files Collapse all files

2
docs/correction-authoring-plan.md
View file

@ -3,6 +3,8 @@
Written against `2f1c9b9` (2026-09-30), following the lane handoff in Written against `2f1c9b9` (2026-09-30), following the lane handoff in
`7a54bfc`. Implemented on `codex/correction-authoring`; this now records the `7a54bfc`. Implemented on `codex/correction-authoring`; this now records the
scope and acceptance criteria of that implementation. scope and acceptance criteria of that implementation.
The cel-sheet targeting work described below was removed with the cel-sheet UI
on 2026-10-01; it remains here only as history of that implementation.
Read [lane-handoff.md](lane-handoff.md) and the correction section of 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 [lane-model.md](lane-model.md) first. Their ownership and document rules remain
the foundation. The choices below settle the first implementation's scope. the foundation. The choices below settle the first implementation's scope.

116
docs/lane-handoff.md
View file

@ -1,11 +1,14 @@
# Lane and cel handoff # Lane and symbol-clip handoff
Status (2026-09-30): the lane model is implemented through its commands, its Status (2026-10-01): the timeline is the one timing interface. A lane is a
first two views, and correction authoring. Cels are ordinary nodes with their generic non-overlapping row of symbol clips; it is not a special drawing type.
own playback clock; the timeline draws them as one row and the cel sheet draws Dropping a library symbol makes a naturally playing clip, while creating a new
frames down and lanes across. Both views issue the same commands. Rotation and empty symbol makes a one-frame held clip at the playhead. With no destination
position corrections can be authored as Constant, Ramp, or Return motion on a lane, either operation creates one. Existing legacy root symbol rows can be
lane or cel, survive regeneration, and expose conflicts for removal or retry. dragged into a lane. Blocks move by mouse; edge drags claim time by trimming
neighbors; Shift-edge drags ripple every later clip; and the center of a shared
cut composes the two edge edits into a rolling edit. Linked audio follows picture
moves while its edges remain independently trimmable.
The commits beginning at `3d3c1bb` are the argument for the model and are worth 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 reading before touching what they did — they are the design record, more than
@ -38,9 +41,10 @@ and do not reintroduce the others.
| word | means | | word | means |
| --- | --- | | --- | --- |
| instance | the `:kind`. The general thing, anywhere in a document | | instance | the `:kind`. The general thing, anywhere in a document |
| cel | an instance in a lane. One drawing, held for some duration | | clip | an instance in a lane. It can hold one source frame or play a symbol naturally |
| cel | specifically a one-frame source held over a clip's duration; the empty-symbol/drawing creation policy |
| lane | a group with `:layout :sequence` | | lane | a group with `:layout :sequence` |
| drawing | the content a cel names — an ordinary symbol | | drawing | content authored into a symbol; not a different timeline node type |
| placement | ONLY where a node sits: `nest/placement`, and the transform that puts a face on the stage. Never the node itself | | placement | ONLY where a node sits: `nest/placement`, and the transform that puts a face on the stage. Never the node itself |
`occurrence` and `exposure` are not words for a cel. **`exposure` means something `occurrence` and `exposure` are not words for a cel. **`exposure` means something
@ -53,8 +57,6 @@ on purpose: the layout names the RULE — children follow one another and may no
overlap — and a group carrying it is called a lane. `node/lane?` is where they overlap — and a group carrying it is called a lane. `node/lane?` is where they
meet. meet.
The second view is the CEL SHEET, not the exposure sheet.
## Decisions already made — do not re-litigate ## Decisions already made — do not re-litigate
These were each argued out and are load-bearing. Changing one is a design These were each argued out and are load-bearing. Changing one is a design
@ -83,26 +85,61 @@ decision, not a cleanup.
- **Refuse rather than guess.** Every command returns `{:clip :selection}` or - **Refuse rather than guess.** Every command returns `{:clip :selection}` or
`{:refused why}`, never a half-applied edit. Where the model needs a choice `{:refused why}`, never a half-applied edit. Where the model needs a choice
nobody has made, refusing and saying why is the behaviour, not a placeholder. nobody has made, refusing and saying why is the behaviour, not a placeholder.
- **A cel is not a row.** Rows, expansion and selection are editor state. The - **A clip is not a row.** Rows, expansion and selection are editor state. The
document has never known about rows and must not learn. document has never known about rows and must not learn — which is what let
the row model change three times in one sitting (blocks, then a
selected-clip portal, then sound lanes under the audio heading) without
touching a single document.
- **A lane is generic.** Drawing creation, library placement, and adopting an
existing root instance all produce the same child instance shape. The only
difference is playback policy: a new empty drawing holds source frame zero;
a dropped library symbol plays at speed one.
- **Every symbol is born with a lane,** `clip/lane-node`, id `:lane`. A symbol
with none had nowhere to drop a thing, which made the first drop into any
symbol a special case. An unaimed drop fills an EMPTY lane that is already
there and otherwise makes a new one; it never takes an occupied lane nobody
pointed at, because placement claims time and would trim or delete what was
in it.
- **Placement claims time.** Lanes never store overlaps. A new or extended clip
trims, removes, or splits whatever previously owned the claimed interval.
Real compositing overlap uses another lane, where ordering remains explicit.
## The timeline opens the whole document
Expanding a lane opens exactly one clip — the selected one — and that portal
opens the lanes and nodes of the symbol it places, recursively, mapped into
the open symbol's ruler. The portal follows the LINEAGE of the selection, so
working on something nested keeps the rows that revealed it open. A held clip
opens too, with its rows marked `:unmapped?`: shown across the hold, with no
keys and no draggable edges, because a frozen clock gives its frames no place
on this ruler. `docs/lane-nesting-notes.md` has the reasoning and what is
still missing.
Double-clicking a clip opens the symbol it places as a tab, the same as
double-clicking that symbol in the pool. Shift while dragging a clip body
turns the temporal move into a structural one — see the nesting notes for why
that is mostly refused today.
## Current timeline interaction
- Creating a symbol inside an aimed lane creates a one-frame held clip at the
playhead. With no aimed lane it first creates a lane. Drawing a polygon uses
the existing clip there or creates the same one-frame clip when the frame is
empty.
- Dropping any library symbol into a lane creates a natural-duration playing
clip. Dropping it on unclaimed timeline or stage space first creates a lane.
- Dragging a clip body moves it. A linked audio node follows a picture move;
moving or trimming the audio itself remains independent.
- Dragging a right edge changes its endpoint. Growth consumes adjacent spans
instead of overlapping them. Shift-drag inserts or removes lane time by moving
every later clip by the same delta.
- At a shared boundary, the left and right hit zones trim one side. The center
is a rolling edit: right-edge resize followed by left-edge resize at one frame.
- Split, trim-in, and trim-out are direct buttons and are disabled without an
editable selected span. Movement is a mouse gesture, not a toolbar command.
## Next steps, in order ## Next steps, in order
The cel sheet now supports rectangular selection by pointer drag, Shift-click,
and Shift-arrow, plus an editor-local clipboard (Cmd/Ctrl C/X/V). Paste
overwrites the destination rectangle, including copied gaps, and reuses drawing
symbols. Partial cels retain their local clocks, playback and corrections.
Delete clears frames without closing time. Each cut, paste or clear is one
history transaction. The clipboard belongs to the mounted sheet and current
document; it is not a system clipboard interchange format.
A selected held cel has a bottom-right resize handle. Dragging previews its new
extent and commits one ripple edit on release; Escape cancels. Overflow uses
the existing explicit shot-extension retry. Rectangle edits currently require
lanes on the sheet's clock and paste must fit within the shot and available
columns. Insert-paste, moving rectangles, and repeating multi-cel patterns with
the handle remain future work.
The implemented correction slice and its remaining UI limits are recorded in The implemented correction slice and its remaining UI limits are recorded in
[Correction authoring](correction-authoring-plan.md). [Correction authoring](correction-authoring-plan.md).
@ -157,9 +194,16 @@ The implemented correction slice and its remaining UI limits are recorded in
## Known gaps and traps ## Known gaps and traps
- **Audio lanes do not work.** `symbol/lane-problems` requires `:instance` - **Audio is a clip in a lane too, and a lane holds one kind.** A sound placed
children, so an audio node in a lane is rejected outright. `lane-model.md` from the pool lands in a lane and is moved and trimmed by the same commands
says a lane may hold visual OR audio cels and should reject only a mixture. as picture. The capability the earlier note asked for is the homogeneity
rule rather than a field: `symbol/lane-problems` refuses a lane holding both
kinds, and `lane/place-symbol` and `lane/adopt` refuse BEFORE claiming time,
because placement claims time and would otherwise have deleted the sound to
make room for the picture and left a valid document behind. Audio nested
inside a placed symbol — a take's own sound — is still shown flattened by
`nest/audio-tracks`; what is in a lane of the open symbol is drawn as a lane
and not flattened twice.
- **`:z` is required on cels and means nothing there.** A lane never has two - **`:z` is required on cels and means nothing there.** A lane never has two
cels on one frame, so draw order between them cannot matter. `node/problems` cels on one frame, so draw order between them cannot matter. `node/problems`
requires `:z` on every node uniformly, which is its own kind of simplicity — requires `:z` on every node uniformly, which is its own kind of simplicity —
@ -173,9 +217,9 @@ The implemented correction slice and its remaining UI limits are recorded in
pose selection and plate drawings/tracing, instance-specific picture-rate pose selection and plate drawings/tracing, instance-specific picture-rate
requests, `pose/put-cut` addressing only `:main`. It predates the lane model requests, `pose/put-cut` addressing only `:main`. It predates the lane model
and nobody has squared the two. and nobody has squared the two.
- **The button row in the timeline pane is a test harness, not a design.** It is - **Slip and retime are still absent.** The timeline action strip now applies
how the commands were made reachable and provable. `lane-model.md` describes split/trim uniformly to a selected root or lane clip, but source-time slip and
the real cel action strip, the breadcrumb and the location bar; none exist. retime still need their own proved semantics before they become controls.
- **`shadow-cljs release app` clobbers the dev bundle.** Both builds write - **`shadow-cljs release app` clobbers the dev bundle.** Both builds write
`../static/arthur/js`, which Django serves, and the optimized build does not `../static/arthur/js`, which Django serves, and the optimized build does not
export the `arthur` global — so after a release the browser tests fail with export the `arthur` global — so after a release the browser tests fail with
@ -187,14 +231,14 @@ The implemented correction slice and its remaining UI limits are recorded in
From `frontend/`: From `frontend/`:
npx shadow-cljs compile test && node out/node-tests.js # 437 tests, 5,804 assertions npx shadow-cljs compile test && node out/node-tests.js # 469 tests, 9,592 assertions
npx shadow-cljs compile app # the bundle Django serves npx shadow-cljs compile app # the bundle Django serves
npx shadow-cljs release app # then `compile app` again — see above npx shadow-cljs release app # then `compile app` again — see above
The browser tests need the Django dev server up (`mise exec -- python manage.py The browser tests need the Django dev server up (`mise exec -- python manage.py
runserver 8778` from the repo root) and a compiled dev bundle: runserver 8778` from the repo root) and a compiled dev bundle:
node --experimental-websocket test/browser/lane.mjs # the lane/cel flow node --experimental-websocket test/browser/lane.mjs # generic symbol-lane flow
CHROME=/usr/bin/chromium node --experimental-websocket test/browser/take.mjs CHROME=/usr/bin/chromium node --experimental-websocket test/browser/take.mjs
`take.mjs` defaults to a macOS Chrome path, hence `CHROME=`. It writes a real `take.mjs` defaults to a macOS Chrome path, hence `CHROME=`. It writes a real

72
docs/lane-is-a-view-notes.md Normal file
View file

@ -0,0 +1,72 @@
# Implementation notes — "A lane is a view"
Running log for `docs/lane-is-a-view-plan.md`. `[ ]` not started, `[~]` in
progress, `[x]` done with `npm test` green.
Baseline at `fb38990`: 475 tests, 9621 assertions, 0 failures.
## Order of work
The plan's seven steps, re-grouped — see *Deviation from the plan's order* below.
- [x] A. Domain: `symbol/children`, `symbol/lane?`, `symbol/overlaps`,
`lane.cljs` → `span.cljs`, the overlap check in `span/finish`
(plan steps 3, 4, and the domain half of 5)
- [x] B. Events: re-base callers and remove lane-node-specific commands; keep
explicit `::new-lane` and cross-lane adoption (plan step 5)
- [x] C. UI: row per symbol, explicit lane creation, and drag handling
(plan steps 1, 2, and the UI half of 5)
- [x] D. Audio: delete `holds-other?`, the mixed-lane refusal, the `in-lane`
filter in `sound-rows` (plan step 6)
- [x] E. Tests: `domain/sequence_test`, `events/lane_test`, `browser/lane.mjs`
- [x] F. Shift-to-reparent still works, untouched (plan step 7)
Not in this pass — see *Left for a second pass*: tearing out the held cel, the
instance-playback control, drawing a loop's repeats, the audio period guard.
## Deviation from the plan's order
The plan's steps 1 and 2 are display work that keys off "a symbol's children",
and step 3 is what MAKES the cels a symbol's children. Until then a cel's
`:parent` is the lane node, so there is nothing for the display to read: step 2
cannot draw "a symbol's children as blocks" while the children belong to a
group. So the data model moves first (A) and the display follows (C). The
content of each step is unchanged; only the order is.
The one thing this gives up is the plan's promise that every step leaves the
editor usable — between A and C the timeline draws the new shape with the old
code. `npm test` is green at each step either way.
## Decisions taken
1. **Lane mode is `:display :lane` on the SYMBOL** — plan's recommendation 2,
and open question 1 answered "the symbol, not the instance". A symbol placed
twice is drawn as a lane in both places. Added to `symbol/symbol-keys` and to
`leaf/leaves`' `select-keys` so it saves like `:frames`.
2. **A symbol's children are its parent-less nodes** that have a placed span.
The plan's step 6 settles it: "an audio node is already a parent-less child
of a symbol, which is exactly the new shape". Span-less nodes — a shape on
screen for the whole shot — are not in the sequence and are skipped, which is
also what stops the commands destructuring a nil span.
3. **A symbol holds at most one sequence.** It follows from 1 and 2: the
container is the symbol. Two lanes of picture is now two symbols placed in a
third, which is what compositing already was.
4. **The open symbol gets a row of its own in lane mode**, and only then. The
blocks have to sit on a row and the open symbol had none; expanding it turns
its children into ordinary rows. Not a row always, which would shift every
row in the pane for no gain.
5. **Open question 2** — a lane row's edge drag trims the PLACING INSTANCE's
span, via `span/resize-out`, like the handle on every other row. Rippling
the children is what the cel blocks' own edges already do, and giving one
handle two meanings is what the plan refuses elsewhere.
6. **Open question 3** — the lane work first, the held cel after. The plan says
they are independent, and the held cel is joined to a loop control that does
not exist yet; doing it second costs one more pass over `lane_test`'s
fixtures and risks nothing.
7. **Lane creation stays explicit.** A blank document and `new symbol` create
ordinary symbols. The separate `new → lane` command creates and places a
symbol with `:display :lane`, aims it for immediate drawing or dropping, and
always adds it at the top of the open symbol rather than nesting it in the
previously aimed lane.
## Notes

301
docs/lane-is-a-view-plan.md Normal file
View file

@ -0,0 +1,301 @@
# A lane is a view
Plan, 2026-10-01, written at `2dc5735`. It undoes the lane model as a thing in
the document and keeps what it was for. Build on what is there and tear out
half of it.
## The decision
> A lane is a view over a symbol with sequential, non-overlapping children.
Nothing in the document is a lane. There is no lane type, no lane group, no
`:layout :sequence`, no lane commands and no lane validation. The word
survives in exactly two places: the UI, where a symbol can be DRAWN as a lane,
and the drag handling that re-spans a symbol's children while it is being
drawn that way.
The display model goes back to a row per symbol. A symbol in lane mode draws
its children as blocks on its own single row; expanded, they are rows like
anything else. Everything else is an ordinary row that expands into what it
places.
## What a lane was, and what each part becomes
| was | becomes |
| --- | --- |
| a group node with `:layout :sequence` | nothing — the symbol is the container |
| `node/lane?` | a view question: is this symbol drawn in lane mode |
| `symbol/lane-clips nodes lane-id` | the children of a symbol, sorted by `node/placed-span` |
| `symbol/lane-problems` | `symbol/overlaps`, a diagnostic the write path calls |
| `lane/lane-frame` | `clip/source-time` — one clock instead of two |
| `domain/lane.cljs` | re-based onto `domain/span.cljs`: re-spanning a symbol's children |
| `clip/lane-node`, the born-with lane | gone; a symbol is born empty again |
| `::ui/new-lane`, `::ui/adopt-in-lane`, lane renaming | gone, gone, and ordinary node renaming |
`lane.cljs`'s fourteen commands are not deleted — they are what "endpoint drag
overlap handling" means, and they already do the right arithmetic. What
changes is their subject: every one of them currently takes a host symbol AND
a lane id and asks `lane-clips nodes lane-id`; each takes a symbol and asks
for its children. `extend-hold`, `resize-out`, `resize-in`, `roll`, `blank`,
`place-symbol`, `adopt`, `append-drawing`, `reuse-drawing`,
`duplicate-drawing`, `overwrite-drawing`, `make-unique`. `span/finish` is
already the one commit path and stays exactly as it is.
Put them in `span.cljs`, which already owns "one write to one node's span" and
`finish`. The sequence operations are the same subject — re-spanning children
— and keeping them apart was a consequence of lanes existing.
## Children in lane mode never overlap
This is an invariant, not a condition to check for and report. Placement
claims time: anything placed, moved or grown over occupied time TRIMS the
extents it lands on — trimming the incumbent, removing one wholly covered, or
splitting one it lands inside — so the result has no overlap because the
operation that could have made one did not. That is `blank` followed by a
non-rippling placement, which is what `overwrite-drawing` already composes.
Enforced at the boundary, which already exists: `span/finish` is the single
commit path for every one of these commands, it validates before it returns,
and it refuses rather than half-applying. So `finish` gains the overlap check
for a symbol in lane mode, and no command can commit one. An overlap that
appears anyway is a bug in a command, not a state to design around.
Keep the check as a named diagnostic — `symbol/overlaps`, taking a symbol and
returning the pairs — used three ways:
1. `span/finish` refuses when it would commit one.
2. The test suite asserts no command can produce one: a property over the
commands in the style of `drawn` in `lane_test`, which samples rather than
computing expected numbers by hand.
3. A document that somehow arrives holding one still LOADS — a display hint
must never be able to stop a document loading — and the timeline draws it
visibly wrong with the status line saying so. Not `clip/problems`, which
means the document will not load, and not `clip/conflicts`, which means a
person has a decision to make. This is neither: it is a bug report.
Toggling lane mode ON for a symbol whose children already overlap is the one
place a person can ask for the impossible. Refuse it and say why, with the
`:required-frames` retry pattern offering to trim them into a sequence — the
domain reports what it would need, the UI offers one button.
Outside lane mode nothing is enforced, because overlapping children are what
compositing IS. An endpoint drag there is an ordinary span edit that may
overlap; the claim-time rule follows the mode.
## The two drag intentions
Unchanged from `docs/lane-nesting-notes.md`, and both kept:
- **Plain drag** of a clip body is temporal: it moves in time, within its
symbol or into another symbol drawn as a lane, and it REPLACES — trimming,
removing and splitting extents as needed so nothing overlaps.
- **Shift-drag** is structural: the dragged node goes INSIDE the symbol the
clip under the pointer places, through `nest/move-node`, which preserves the
world transform and the root timing. This must keep working for symbols
contained in a lane, which is the case it exists for.
Overlap cannot distinguish them — dropping on occupied time already means
claiming it — so the modifier says which, and the label by the pointer says it
back. `nest/move-refusal` already answers before the drop.
## Where lane mode lives
A symbol is drawn as a lane because somebody said so, not because of what its
children happen to look like at this moment. Deriving it from "the children do
not currently overlap" means a symbol stops being a lane the moment anything
overlaps, and the rules that maintain non-overlap switch off exactly when they
are needed.
Two options:
1. **Editor state**, `[:ui :lane-mode #{sid}]`. Purest reading of "a lane is a
view". But the drag rules follow the mode, so an unsaved, per-person toggle
would decide whether dropping a symbol trims its neighbour or composites
over it — the same gesture doing two different things to the document
depending on something the document does not record.
2. **A display hint on the symbol**, e.g. `:display :lane`, saved like any
other field (`clip-keys`, `leaf/leaves`, `leaf/clip` in the same commit).
Still not a type: nothing in evaluation reads it, `symbol/problems` does
not check it, and a symbol with it set behaves identically on the stage.
Recommended: 2. It is one field, it keeps editing rules reproducible between
people, and it does not make the symbol a different kind of thing. The thing
to hold the line on is that nothing outside the timeline, and the commit
path's overlap check, is allowed to read it.
## Two things are called loop
Before any of this, name them apart, in the way the vocabulary table in
`lane-handoff.md` names a cel apart from an exposure.
- **Loop playback** is the transport repeating the open symbol while it plays.
It is `[:playback :loop?]` in app-db, the ⟳ button in the strip, and it is
EDITOR STATE. The document does not know about it.
- **A looping instance** is a node repeating the symbol it places: a four-frame
tire turning for the hundred and twenty frames the instance is on screen.
It is `:playback {:end :loop}` on the node, and it is in the DOCUMENT.
The car tire is the second one, and here is its actual status: it already
works in the evaluator and cannot be asked for. `node/placed-frame` does the
modulo, `node/problems` already admits `:end` of `:stop`, `:hold` or `:loop`,
`nest/audio-tracks` already expands a loop into its periods — and nothing in
the UI sets it. It is implemented and unreachable.
So three things are missing, and they are the work:
1. **A control.** Where an instance's playback is edited: `:in`, `:speed`, and
what happens at the end. One place, three fields, rather than a loop
checkbox somewhere else.
2. **Drawing the repeats.** `ui/timeline`'s docstring already admits that only
the first pass of a looping instance is drawn, so a tire turning thirty
times shows one turn's keys and then nothing. A looping block should show
its passes — at minimum the period boundaries, so the row says how many
times round it goes.
3. **The audio period guard** below, which a loop needs whether or not holds
become loops.
## Tear out the held cel
A held cel is a 1-frame symbol shown for many frames. A 1-frame symbol with
`:end :loop`, lengthened, is the same picture by a different route — and the
second route is a case the model already has, so keeping the first one is
keeping a special case for free.
**What is already true**, so that nothing has to move: `:span` is on the node,
in its own frames; `:time` (`:at`, `:rate`) is on the node; looping is on the
node, as `:playback :end`. The SYMBOL owns only `:frames`, the authored
window. So looping and span are instance properties already, and this change
is about deleting a mode, not relocating a field.
It does mean the two changes are joined at one point: making every drawing a
looping instance is not safe until a looping instance can be seen and edited,
or every drawing in the document acquires a property with no control on it.
**What has to be decided and collapsed:**
- There are two spellings of looping — `:time :loop?` and `:playback :end
:loop` — and both are read, in `node/placed-frame` and in
`nest/audio-tracks`. Keep one. `:playback {:in :speed :end}` already says
what happens at the ends, so `:end :loop` is the one to keep and
`:time :loop?` is the one to delete.
- `:playback :speed 0` stops being produced. Make it illegal in
`node/problems` rather than legal-but-unused, so a frozen clock has exactly
one spelling: a 1-frame loop.
- `lane/extend-hold` exists only because holds were special — it refuses
anything whose speed is not 0 and then edits a span. Once a hold is a loop,
lengthening one IS `resize-out`, and the command collapses into it.
- `cel` survives as the word for the creation policy — a new empty symbol is
one frame — but stops naming a playback mode.
**What it buys, and this is the point:** one rule for nesting, which settles
the refusal that blocks shift-to-reparent today. `nest/inside` currently has
no `:time` for a hold, for `:end :hold`, or for a loop, and so refuses all
three. The general rule that covers all of them: **resolve the move with the
destination's map at the CURRENT frame — the affine piece the current frame
falls in.**
- A loop of length L is affine within the period the current frame is in.
Timing is preserved inside that period and repeats after it, which is what
looping means.
- A 1-frame loop — the ex-hold — has a period of length 1, so the map within
it is trivially invertible and lands the moved node on frame 0, aligned to
the current frame. That is exactly the answer `docs/lane-nesting-notes.md`
argues for from first principles, arrived at here as an instance of the
general rule instead of a special case.
- `:end :hold` is affine in the played part and frozen in the tail, which the
same sentence covers.
**The trap, which must be handled in the same change.** `nest/audio-tracks`
expands a loop into one walk PER PERIOD:
periods (range (floor (/ (to-local source lo) length))
(ceil (/ (to-local source hi) length)))
Today a held cel is skipped entirely — `(pos? speed)` is the guard, and the
comment says a visual freeze does not emit a sustained audio sample. Turn
every drawing into a 1-frame loop and that guard stops firing: a drawing held
for 120 frames becomes 120 recursive walks, and any sound inside it is emitted
120 times. That is both a wrong mix and a performance cliff on the most common
node in the document. Required with this change: a cheap `symbol/audible?`
precheck so a source with no audio anywhere inside it is never period-expanded,
and a cap or a different formulation for the ones that are.
Also worth knowing before the change: `ui/timeline`'s own docstring already
says a looping instance draws only its first pass. With every drawing a loop,
that sentence now describes every drawing — harmless, since one pass of a
1-frame symbol is the whole of it, but the docstring should stop sounding like
a limitation.
**Dropping into a 1-frame symbol.** The window is authored and crops what it
holds, so a 10-frame symbol dropped into a 1-frame drawing shows its frame 0
and nothing else. That is consistent — `:frames` is the shot length and
`:extent :grow-symbol` is the opt-in — but it is probably not what somebody
dragging means. Offer the growth through the `:required-frames` retry the
model already uses: the command reports what it would need, the UI offers one
button.
## Order of work
Each step compiles, passes `npm test`, and leaves the editor usable.
1. **Row per symbol.** In `ui/timeline.cljs`, delete `portal`, the `::portal`
hint row, the `under?` lineage predicate and the `chosen` argument; emit a
row for a clip whose parent is a lane instead of skipping it. Keep the
`:cels` blocks for the collapsed row, and keep `inside-rows` — including
its `:unmapped?` branch, which is what makes a held drawing's contents
reachable at all.
2. **Lane mode as a hint.** Add the field and the toggle, draw a symbol's
children as blocks when it is set and as rows when it is not, and move the
lane-row drag handling onto it. Both display paths now exist and nothing in
the domain has changed.
3. **Re-base the commands.** Move `lane.cljs` into `span.cljs`, replacing
`(lane-clips nodes lane-id)` with the symbol's children and dropping the
`lane-id` argument. `frontend/test/arthur/domain/lane_test.cljs` is the
proof: its fixtures should change and its assertions should not, and any
assertion that has to change is a behaviour change worth noticing.
4. **Move the invariant.** `symbol/lane-problems` becomes `symbol/overlaps`,
called by `span/finish` for a symbol in lane mode, plus the property test
that no command can produce an overlap.
5. **Delete the rest.** `node/lane?`, `symbol/lane-clips`, `clip/lane-node`,
`::ui/new-lane`, `::ui/adopt-in-lane`, the lane branch of
`::ui/new-symbol`, lane renaming, `aimed-lane`, and the
`:lane?`/`sound-lane?` row flags. Rename what is left so the word does not
appear outside the timeline.
6. **Audio falls out.** An audio node is already a parent-less child of a
symbol, which is exactly the new shape — so the audio-in-lane rules added
in `2dc5735` (`holds-other?`, the mixed-lane refusal, the `in-lane` filter
in `sound-rows`) delete rather than migrate. A symbol drawn as a lane whose
children are sounds is an audio lane, and that is the whole of it.
7. **Shift-to-reparent stays** as it is: `nest/move-node` and
`nest/move-refusal` never knew about lanes.
## What must not be lost
All of this was broken at some point today and is now proved; each has a test
to keep.
- A held clip's contents are reachable from the root timeline, with no keys
and no draggable edges — `source-time` is nil for a hold, and the walk used
to stop there.
- Double-clicking a clip opens its symbol as a tab, and the editor survives
it: `symbol/lineage` must not report a cycle for an id the symbol does not
hold, and opening a symbol must drop a selection pointing into the one being
left.
- Selection waits for pointer-up, so a press does not re-draw the timeline out
from under the gesture it is starting.
- A drop never silently deletes what it lands on.
- A sound is drawn once, not twice.
## Open questions
1. **Is lane mode a property of the symbol or of the instance placing it?** A
symbol placed twice would be drawn the same way in both places under the
first reading. That is probably right, and worth saying out loud.
2. **Does a lane row's edge drag trim the placing instance's span, or ripple
the children?** Same handle, two commands; the row is now an instance, so
it has a span of its own for the first time.
3. **Does tearing out the held cel come before or after the lane work?** It
is independent of it — `nest` never knew about lanes — and it is what makes
shift-to-reparent work on the thing people would actually drag onto. Doing
it first means the lane work lands on a model with one playback mode fewer;
doing it after means two changes to `lane_test`'s fixtures instead of one.

15
docs/lane-model.md
View file

@ -1,9 +1,11 @@
# The Lane Model # The Lane Model
Revised 2026-09-30. Target design. Cel ownership, source playback, the Revised 2026-10-01. Clip ownership, source playback, one-row generic lanes,
content and cel commands, placement anywhere in a lane, overwrite, a one-row cel direct clip movement and edge editing, correction evaluation, and correction
strip, a frame-down cel sheet, correction evaluation, and correction authoring authoring for rotation and position are implemented. The former cel-sheet
for rotation and position are implemented. Retiming commands are not. projection was removed: the timeline is the single timing interface. Sections
below that describe a cel sheet are retained as design history and are superseded
by this revision. Retiming commands are not.
See the status note under See the status note under
[Proof obligations](#proof-obligations-and-implementation-order). [Proof obligations](#proof-obligations-and-implementation-order).
@ -145,8 +147,9 @@ cel transform and then the content's own transform.
The interval in lane time is derived through `:time`; do not also store parent The interval in lane time is derived through `:time`; do not also store parent
start/end values. Sequence children require finite intervals and positive start/end values. Sequence children require finite intervals and positive
placement rates. Ordering and overlap checks use the mapped intervals, not `:z`. placement rates. Ordering and overlap checks use the mapped intervals, not `:z`.
The sequence group may contain visual cels or audio cels; its The current sequence group contains visual symbol clips. Audio remains an
capability must reject an incompatible mixture rather than infer it per frame. independent root node (and can be linked to picture); if audio lanes are added,
their capability must be explicit rather than inferred per frame.
A source reference is fixed within a cel. The lane changes content when A source reference is fixed within a cel. The lane changes content when
another cel becomes active. This is a deliberate revision of the original another cel becomes active. This is a deliberate revision of the original

161
docs/lane-nesting-notes.md Normal file
View file

@ -0,0 +1,161 @@
# Lane nesting interaction notes
Status: design note, 2026-10-01. This records the interaction before more lane
UI is implemented.
## The capability that must not be lost
A lane owns temporal placement, but a symbol instance is still a doorway into
another symbol. A drawing accidentally authored at the root must be movable into
an instance in any lane, including another lane, without changing its visible
position or timing.
That operation already exists as `nest/move-node`. It resolves the source and
destination at the current root frame, transplants the node, and re-expresses
its transform and time under the new parent. The lane UI must expose a target
path for it; it must not replace it with a weaker `:parent` assignment.
There are therefore two different drag intentions:
1. **Temporal move:** drag a clip body onto lane space. It remains a clip in a
lane, moves in time, and claims the destination interval by trimming/removing
incumbents.
2. **Structural move:** drag from the clip's grab affordance onto another symbol
instance. The dragged node is transplanted into the target instance's source
symbol with `nest/move-node`, preserving its world transform and root timing.
These cannot be inferred from overlap alone. Dropping clip A onto time occupied
by clip B already means “A claims that time and trims B.” Structural nesting
therefore needs an explicit grab affordance/mode. Its cursor is `grab` and
`grabbing`; trim edges keep their resize cursors and the ordinary body keeps its
timeline-move behavior.
Both visible clip blocks and an expanded symbol header are structural drop
targets. This permits moving a root drawing directly into `symbol-3` even when
its lane is collapsed.
## Compact expansion: one selected-clip portal
Expanding a lane must not restore row-per-clip vertical growth. Instead, an
expanded lane reveals exactly one clip portal: the currently selected clip in
that lane.
```text
▾ foreground lane [symbol-1][symbol-2][symbol-3]
▾ symbol-3 instance/source header and drop target
▸ body lane nested rows, mapped to the root ruler
▸ face lane
position nested keyframes mapped to root time
```
- Selecting another block in the same lane swaps the portal in place.
- With no selected clip in that lane, expansion shows a compact “select a clip
to inspect” row. It must not follow the playhead during playback; that would
make the timeline restructure itself while playing.
- The portal header represents the selected instance and is the structural drop
target for moving root or sibling content into its source symbol.
- Sub-expanding the portal uses the existing recursive symbol-row walk. Nested
lanes and channels are mapped through the instance clock into the open/root
ruler, as ordinary expanded instances already are.
- The lane's own transform/channel rows remain available separately. They affect
every clip in the lane and are not properties of the selected portal.
This keeps the cost of inspection constant: an expanded lane adds one selected
symbol branch, not one branch for every temporal clip it contains.
## Keyframe visibility
Two levels should be visible without changing editors:
- The selected clip's instance-level keys (transform, visibility, corrections)
appear as ticks inside that clip block on the lane row.
- Expanding the lane opens the selected clip portal, where source-symbol and
recursively nested keys appear on their own rows, mapped to root time.
Thus the collapsed lane answers “where does this clip change?” and the expanded
portal answers “which property inside this symbol changes?” The second view is
still the root timeline; entering the symbol is not required merely to see or
edit its keys.
## Drag targets and feedback
- Grab onto lane background: move/adopt the instance into that lane.
- Grab onto a symbol clip: structurally transplant into that clip's source
symbol.
- Grab onto the expanded portal header: the same structural transplant, with a
larger and less ambiguous target.
- Grab onto itself or one of its descendants: refuse before drop to prevent a
symbol cycle.
- A structural target receives an inset highlight and the preview stays in that
target. A lane-time target receives the dashed temporal clip preview.
- Successful structural drops expand the target lane and select the moved node
beneath the target portal, so the result is immediately visible.
## Data model consequence
No lane-as-symbol type is required. The hierarchy remains:
```text
symbol -> sequence lane -> instance clip -> source symbol -> its lanes/nodes
```
Lane membership owns time partitioning. Symbol instances own composition
nesting. The UI may present the selected instance below its lane, but that is a
derived portal, not another ownership edge and not a duplicated node.
## Implementation order
1. ~~Render instance-level key ticks within lane clips.~~ Done: a clip's keys
are on its block, drawn after the blocks so they land on the one they
belong to.
2. ~~Add selected-clip portal expansion to `timeline/rows`.~~ Done, with two
additions the note did not anticipate:
- The portal is chosen by the whole LINEAGE of the selection, not the
selected id. Selecting a shape inside the clip, or the end of its span,
is still working inside that clip, and matching the id alone closed the
portal the moment anything under it was touched.
- A HELD clip opens too. `clip/source-time` is nil for a hold, so the walk
used to stop there and the inside of every drawing was unreachable from
the root timeline. Its rows are now shown across the hold and marked
`:unmapped?`: no keys, and no draggable edges, because no frame inside it
has a place on this ruler.
3. ~~Add the explicit structural affordance.~~ Done as SHIFT on a clip-body
drag rather than a separate grab handle: shift turns a temporal move into a
structural one, the target clip takes an inset highlight, and a label by the
pointer says which of the two is about to happen.
4. Route structural drops through `nest/move-node`. **Wired, and blocked in
the domain.** The gesture asks `nest/move-refusal` on the way past, so the
label says before the drop what the command would say after it. Two
refusals stand in the way of ordinary use:
- *both have to be on screen at this frame.* Inherent, and worth keeping:
the move preserves the world transform and there is no common frame to
preserve it at otherwise. It does mean nesting one clip into another in
the SAME lane can never work — a lane never overlaps itself — so this is
a between-lanes gesture with the playhead somewhere both are showing.
- *a held or looping clip has no clock to move through.* `nest/inside`
returns no `:time` for a hold, and a held one-frame drawing is the most
common thing in a document, so today nesting into one is refused — which
is most of what anybody would try.
5. After the transplant, expand the destination portal and reveal/select the
moved row. `::ui/move-node` already selects the moved node and opens the
rows down to it; the portal follows from the lineage rule in 2.
## The held destination, unresolved
A held cel shows ONE source frame for its whole span, so there is no
invertible map from the lane's frames to the drawing's and `move-node`
refuses. But the refusal is stronger than the facts require. Inside a frozen
destination only one frame is ever observed, so:
- the RATE of any map into it is unobservable — every rate shows frame `in`;
- what IS observable is that the moved node should show, at that one frame,
what it shows now at the current root frame.
That pins a unique sensible answer — rate 1, aligned so the current frame maps
to the shown frame — and nothing else about the mapping can be seen. If that
argument holds, it is a rule rather than a guess, and it is the difference
between structural nesting working for drawings and not working at all. It
needs its own proof: a drawing authored at the root, nested into a held cel in
another lane, sampled before and after to show the same picture, in the style
of `drawn` in `lane_test`.

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

@ -159,7 +159,6 @@
:ui {:open nil :ui {:open nil
:tabs [] :tabs []
:selection nil :selection nil
:time-view :timeline
:tone :skin-base :tone :skin-base
:tool nil :tool nil
:auto-key? false :auto-key? false

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

@ -150,10 +150,12 @@
120) 120)
(defn blank (defn blank
"A new, empty document: one empty symbol. "A new, empty document: one symbol, and nothing in it.
`:nodes` is empty rather than seeded with a layer, because an empty symbol is A SYMBOL IS BORN EMPTY. It used to be born holding a lane, because a lane was
a true statement and a layer nobody asked for is one more thing to delete. the only place temporal content could go; now the symbol itself is the
container — see `symbol/children` — so there is nothing to invent and the
first drop into a symbol is the same operation as the second.
The tracking maps are ABSENT rather than empty, because `leaf/leaves` writes no The tracking maps are ABSENT rather than empty, because `leaf/leaves` writes no
leaf for an empty one and so cannot bring it back: a blank document that opened leaf for an empty one and so cannot bring it back: a blank document that opened
@ -410,7 +412,8 @@
(if (or (nil? end) (symbol clip sid) (nil? frame) (neg? frame) (>= frame end)) (if (or (nil? end) (symbol clip sid) (nil? frame) (neg? frame) (>= frame end))
clip clip
(-> clip (-> clip
(assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host) :frames (- end frame) :nodes {}}) (assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host)
:frames (- end frame) :nodes {}})
(place-symbol nil host sid frame uuid nil))))) (place-symbol nil host sid frame uuid nil)))))
(defn free-id (defn free-id

360
frontend/src/arthur/domain/lane.cljs
View file

@ -1,360 +0,0 @@
(ns arthur.domain.lane
"The commands that need a SEQUENCE: make a lane, put drawings in it, change
how long they are exposed, empty part of it, and decide which cels share
content.
WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a
node map: a group with `:layout :sequence`, whose children are non-overlapping
visual cels. This namespace only changes them.
WHAT IS NOT HERE: split, trim and move. Each of those is one write to one
node's span or position, which is a fact every node has, so they live in
`arthur.domain.span` and work on a symbol placed straight into a shot as
readily as on a cel. What stays here is everything that cannot be said about
one node alone — a ripple needs later siblings, a gap needs a row to be a hole
in, and appending needs to know where the row stops.
EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or
`{:refused reason}` — never a half-applied edit, and never a document that
`clip/problems` would reject. A command that cannot say what the person meant
refuses and says why, rather than picking for them: the overflow policy is a
caller's `:extent`, and decoupling shared content is its own command instead
of something an ordinary edit does silently.
IDS FOR CELS COME FROM THE CALLER, because a cel's identity is
a uuid and this namespace is pure. Ids for new CONTENT are derived from the
drawing being copied — `clip/free-id` is pure too, and `drawing-a-2` says what
it came from in a way `symbol-7` does not."
(:require [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn extend-hold
"Change one held cel's duration by `delta` lane frames and ripple its
later siblings. Lane channels, cel channels and source clocks stay put.
Returns {:clip :selection} or {:refused :required-frames?}; never partially edits."
[clip sid id delta {:keys [extent] :or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])
n (get nodes id)
lane (get nodes (:parent n))
rate (:rate (node/time-of n))
span (:span n)
m (when lane (symbol/frame-map nodes (:id lane)))
;; The LANE's own shape, not the whole symbol's: refusing a cel
;; edit over some unrelated defect elsewhere in the symbol would be
;; this command answering for a part of the document it never touches.
broken (first (symbol/lane-problems nodes))]
(cond
(not (node/lane? lane)) {:refused "select a cel in a lane"}
broken {:refused broken}
(not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of lane frames"}
(not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"}
(nil? m) {:refused "cel timing through a stepped or looping lane is not supported"}
(<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive cel"}
:else
(let [[_ boundary] (node/placed-span n)
later (filter #(>= (first (node/placed-span %)) boundary)
(symbol/lane-cels nodes (:id lane)))
nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta)))
nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
nodes later)]
(span/finish clip sid nodes id extent)))))
(defn blank
"Clear lane frames `[a b)` of lane `lane-id`, leaving a GAP.
A gap is not a drawing. Nothing is invented to cover those frames and nothing
closes the hole — the cels after it stay where they are, because
emptying frames and re-timing a performance are different intentions.
What it does to each cel it meets is `span/edged`, applied three ways: one wholly
inside is removed, one overlapping an end is trimmed to it, and the one that
spans the whole range is split, which is the only case that needs `id`. Their
drawings stay in the library — a lane does not own its content, and a drawing
whose last cel is gone is still a drawing somebody made."
[clip sid lane-id [a b] {:keys [id]}]
(let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id)
members (when (node/lane? lane) (symbol/lane-cels nodes lane-id))
spanning (when members
(first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b)))
members)))]
(cond
(not (node/lane? lane)) {:refused "select a lane"}
(not (and (integer? a) (integer? b) (< a b)))
{:refused "a range to blank is whole lane frames, and not empty"}
(and spanning (or (nil? id) (contains? nodes id)))
{:refused "blanking inside one cel splits it, which needs a free ID for the remainder"}
:else
(let [nodes (reduce
(fn [ns n]
(let [[lo hi] (node/placed-span n)]
(cond
(or (<= hi a) (>= lo b)) ns
(and (< lo a) (> hi b))
(-> ns
(assoc (:id n) (span/edged n :out a))
(assoc id (assoc (span/edged n :in b) :id id :z (str "a-" id))))
(and (>= lo a) (<= hi b)) (dissoc ns (:id n))
(< lo a) (assoc ns (:id n) (span/edged n :out a))
:else (assoc ns (:id n) (span/edged n :in b)))))
nodes members)]
(span/finish clip sid nodes (or (when spanning id) lane-id) :keep)))))
(defn sheet-range
"Snapshot a rectangle in open-symbol frames. Cel-local clocks and channels
survive clipping; gaps are represented by the rectangle's duration."
[clip sid lanes [a b]]
(let [nodes (get-in clip [:symbols sid :nodes])]
(if-not (and (seq lanes) (integer? a) (integer? b) (<= 0 a) (< a b)
(every? #(and (node/lane? (get nodes %))
(= {:at 0 :rate 1} (symbol/frame-map nodes %))) lanes))
{:refused "range editing requires lanes with the same clock as the sheet"}
{:duration (- b a)
:columns
(mapv (fn [id]
(vec (for [n (symbol/lane-cels nodes id)
:let [[lo hi] (node/placed-span n)]
:when (and (< lo b) (> hi a))]
(-> n
(span/edged :in (max a lo))
(span/edged :out (min b hi))
(update-in [:time :at] (fnil - 0) a))))) lanes)})))
(defn paste-range
"Overwrite a rectangle atomically, including its gaps. IDs are supplied by
the caller. Copies share drawings and retain cel-local animation."
[clip sid lanes at payload new-id]
(let [duration (:duration payload)
check (when duration (sheet-range clip sid lanes [at (+ at duration)]))]
(cond
(:refused payload) payload
(not= (count lanes) (count (:columns payload)))
{:refused "the copied range does not fit the destination lanes"}
(or (nil? duration) (:refused check))
(or check {:refused "copy a cel-sheet range first"})
(> (+ at duration) (get-in clip [:symbols sid :frames]))
{:refused "the copied range extends beyond the shot"}
:else
(reduce
(fn [result [id cels]]
(if (:refused result) (reduced result)
(let [cleared (blank (:clip result) sid id [at (+ at duration)] {:id (new-id)})]
(if (:refused cleared) (reduced cleared)
(let [nodes (reduce (fn [nodes n]
(let [cid (new-id)]
(assoc nodes cid (-> n
(assoc :id cid :parent id :z (str "a-" cid))
(update-in [:time :at] + at)))))
(get-in (:clip cleared) [:symbols sid :nodes]) cels)
result (span/finish (:clip cleared) sid nodes id :keep)
problems (when (:clip result) (clip/problems (:clip result)))]
(if (seq problems) {:refused (first problems)} result))))))
{:clip clip :selection (first lanes)}
(map vector lanes (:columns payload))))))
(defn add-lane [clip sid id]
(if (or (nil? (clip/symbol clip sid)) (get-in clip [:symbols sid :nodes id]))
{:refused "the symbol is missing or the lane ID is already used"}
{:clip (assoc-in clip [:symbols sid :nodes id]
{:id id :name "drawings" :kind :group :layout :sequence
:z (str "z-" id)})
:selection id}))
;; ---------------------------------------------------------------------------
;; putting drawings in a lane
(defn- held
"A one-frame held cel of `drawing-id`, starting at lane frame `at`.
Held rather than playing, and one frame rather than the length of what it
places: a cel's duration is the lane's business — `extend-hold` is how
it changes — and reading it off the content would make placing a ten-frame
animation and holding its first drawing the same gesture."
[id lane-id drawing-id at]
{:id id :kind :instance :parent lane-id :z (str "a-" id)
:span [0 1] :time {:at at :rate 1}
:source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}})
(defn lane-frame
"Symbol frame `f` as a frame of lane `lane-id`'s OWN time, or nil through a
stepped or looping lane, where one frame of the symbol is not one frame of the
lane and there is no single answer to give a command."
[clip sid lane-id f]
(when-let [{:keys [at rate]} (symbol/frame-map (get-in clip [:symbols sid :nodes]) lane-id)]
(* rate (- f at))))
(defn- lane-end
"Where lane `lane-id`'s occupied frames stop, in its own time."
[nodes lane-id]
(apply max 0 (map #(second (node/placed-span %))
(symbol/lane-cels nodes lane-id))))
(defn- place
"Put a held cel of `drawing-id` into `lane-id` at lane frame `at`, and
RIPPLE: everything starting at or after it moves later by its duration.
There is one placement function and `:end` is a position like any other, so
appending is not a different operation from inserting — the end is just where
nothing has to move. Overwriting is the other policy and is NOT this: taking
frames away from the cel already there is trimming, which is its own
command and not something placing a drawing should do on the quiet.
`:frame` in the result is where it landed, in the open symbol's time, for a
caller that wants to look at what it just made."
[clip sid lane-id id drawing-id at extent ripple?]
(let [nodes (get-in clip [:symbols sid :nodes])
at (if (= :end at) (lane-end nodes lane-id) at)
n (held id lane-id drawing-id at)
[lo hi] (node/placed-span n)
later (when ripple?
(filter #(>= (first (node/placed-span %)) lo)
(symbol/lane-cels nodes lane-id)))
nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo)))
(assoc nodes id n) later)
result (span/finish clip sid nodes id extent)
m (symbol/frame-map nodes lane-id)]
(cond-> result
(:clip result) (assoc :frame (+ (:at m) (/ at (:rate m)))))))
(defn- placeable
"Why a held cel cannot go into `lane-id` at `at`, or nil."
[clip sid lane-id id at]
(let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id)
;; INSIDE a cel is not a position for another one. Splitting that
;; cel is what makes it two, and doing it here would be one command
;; quietly performing two: the caller asks for `split` and then places.
inside (when (number? at)
(some (fn [n] (let [[lo hi] (node/placed-span n)]
(when (< lo at hi) n)))
(symbol/lane-cels nodes lane-id)))]
(cond
(not (node/lane? lane)) "select a lane"
(contains? nodes id) "the new cel ID is already used"
(not (or (= :end at) (and (integer? at) (not (neg? at)))))
"a position is :end or a whole lane frame"
inside (str "frame " at " is inside a cel; split it first")
(nil? (symbol/frame-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported"
:else (first (symbol/lane-problems nodes)))))
(defn append-drawing
"Append fresh empty content and a held cel of it. IDs come from the
caller so a command is deterministic and replayable.
Fresh content, not a blank range: a lane with no cel over a frame shows
nothing there already, and a drawing nobody has drawn in is a different thing
from a gap."
[clip sid lane-id id drawing-id {:keys [at extent] :or {extent :keep at :end}}]
(if-let [why (or (placeable clip sid lane-id id at)
(when (clip/symbol clip drawing-id) "the new drawing ID is already used"))]
{:refused why}
(place (assoc-in clip [:symbols drawing-id]
{:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}})
sid lane-id id drawing-id at extent true)))
(defn reuse-drawing
"Append a held cel of content the document ALREADY has, so the same
drawing is exposed twice and editing it changes both cels.
This is the command `make-unique` is the undo of, and the reason they are two
commands: reuse is a decision to share, and sharing is not something to
discover later when an edit turns up somewhere else."
[clip sid lane-id id drawing-id {:keys [at extent] :or {extent :keep at :end}}]
(if-let [why (or (placeable clip sid lane-id id at)
(when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse")
;; Placing something that contains this symbol would close a
;; loop, and a lane is no different from any other placement.
(when (clip/contains-symbol? clip drawing-id sid)
"a symbol cannot go inside itself"))]
{:refused why}
(place clip sid lane-id id drawing-id at extent true)))
(defn- copied
"A copy of symbol `from`, as `{:clip :id}`.
SHALLOW by default: its own nodes and channels are copied, and its references
to other symbols are kept, so a head built out of reusable eyes still uses
those eyes. `deep?` copies everything it places as well, with new ids
throughout, for a drawing that must share nothing — the distinction the
shallow copy cannot make on its own, and a promise of independence that only
the deep one keeps."
[clip from deep?]
(if deep?
(let [{c :clip ids :ids} (bring/symbols clip clip [from] {})]
{:clip c :id (ids from)})
(let [id (clip/free-id (:symbols clip) from)]
{:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id))
:id id})))
(defn duplicate-drawing
"Append a held cel of a COPY of what cel `id` places, for when
the drawing on screen is the starting point for the next one.
The copy is of the content only. The new cel is a plain one-frame hold
rather than a copy of `id`'s own transform or corrections: those belong to
that cel, and carrying them over would make duplicating a drawing quietly
duplicate the treatment of one use of it."
[clip sid id new-id {:keys [at extent deep?] :or {extent :keep at :end}}]
(let [n (get-in clip [:symbols sid :nodes id])
from (node/source n)]
(if-let [why (or (when-not from "select a cel to duplicate")
(when-not (clip/symbol clip from) "the drawing it places is missing")
(placeable clip sid (:parent n) new-id at))]
{:refused why}
(let [{c :clip copy :id} (copied clip from deep?)]
(place c sid (:parent n) new-id copy at extent true)))))
(defn overwrite-drawing
"Put a fresh one-frame drawing at lane frame `at`, replacing whatever was
there and leaving every other cel where it was.
This is `blank` and placement composed in ONE command and therefore one undo
step. `remainder-id` is used only when clearing the frame cuts one cel into
two; ids still come from the caller because this namespace is pure."
[clip sid lane-id id drawing-id at {:keys [extent remainder-id]
:or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])]
(if-let [why (cond
(not (and (integer? at) (not (neg? at))))
"a position is a nonnegative whole lane frame"
(contains? nodes id) "the new cel ID is already used"
(or (= id remainder-id) (contains? nodes remainder-id))
"the remainder cel needs a free ID different from the new cel"
(clip/symbol clip drawing-id) "the new drawing ID is already used"
(nil? (symbol/frame-map nodes lane-id))
"drawing creation through a stepped or looping lane is not supported")]
{:refused why}
(let [cleared (blank clip sid lane-id [at (inc at)] {:id remainder-id})]
(if (:refused cleared)
cleared
(place (assoc-in (:clip cleared) [:symbols drawing-id]
{:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}})
sid lane-id id drawing-id at extent false))))))
(defn make-unique
"Point cel `id` at a private copy of its content, leaving every other
cel of that drawing sharing the original.
Refused when nothing else uses it: a drawing with one cel is already
unique, and answering with a silent copy would leave a second identical symbol
in the library for no reason a person could see."
[clip sid id {:keys [deep?]}]
(let [n (get-in clip [:symbols sid :nodes id])
from (node/source n)
elsewhere (for [[osid osym] (:symbols clip)
[oid on] (:nodes osym)
:when (and (= from (node/source on)) (not= [sid id] [osid oid]))]
[osid oid])]
(if-let [why (or (when-not from "select a cel to make unique")
(when-not (clip/symbol clip from) "the drawing it places is missing")
(when (empty? elsewhere) "nothing else uses this drawing"))]
{:refused why}
(let [{c :clip copy :id} (copied clip from deep?)
c (assoc-in c [:symbols sid :nodes id :source :symbol] copy)
ps (clip/problems c)]
(if (seq ps) {:refused (first ps)} {:clip c :selection id})))))

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

@ -144,7 +144,7 @@
;; disagree with itself about; `clip` puts it back. ;; disagree with itself about; `clip` puts it back.
(for [[sid sym] (:symbols clip)] (for [[sid sym] (:symbols clip)]
{(at "symbol" (segment sid)) {(at "symbol" (segment sid))
(select-keys sym [:name :frames :fps :width :height :palette])}) (select-keys sym [:name :frames :fps :width :height :palette :display])})
(for [[sid sym] (:symbols clip) (for [[sid sym] (:symbols clip)
[id n] (:nodes sym)] [id n] (:nodes sym)]
{(at "symbol" (segment sid) "node" (segment id)) {(at "symbol" (segment sid) "node" (segment id))

130
frontend/src/arthur/domain/nest.cljs
View file

@ -21,6 +21,7 @@
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
(defn- resolved (defn- resolved
@ -71,7 +72,7 @@
inner (:symbol shown) inner (:symbol shown)
lf (if shown (:frame shown) local)] lf (if shown (:frame shown) local)]
(if (and m (number? local) (if (and m (number? local)
;; A lane over a gap has no inside to be in. ;; A clip over a gap has no inside to be in.
(or (not inst?) shown) (or (not inst?) shown)
(or (nil? inner) (< -1 lf (clip/frames clip inner)))) (or (nil? inner) (< -1 lf (clip/frames clip inner))))
{:sid inner :frame (js/Math.floor lf) {:sid inner :frame (js/Math.floor lf)
@ -271,6 +272,39 @@
(clip/update-symbol target update :nodes (fnil into {}) (clip/update-symbol target update :nodes (fnil into {})
(map (juxt :id identity)) moved))})))) (map (juxt :id identity)) moved))}))))
(defn move-refusal
"Why `move-node` would refuse to move `from` into `to` at frame `f`, or nil.
SAID BEFORE THE DROP, not after it. A drag that reparents has to tell the
person what it would do while they can still change their mind, and the only
honest source for that is the check the command itself makes. Hence one
function, asked by the gesture on the way past and by `move-node` on the way
in.
The one that surprises: BOTH have to be on screen at this frame, because the
move keeps the picture and there is no common frame to keep it at otherwise.
Two clips of one lane never overlap, so nesting one into another there can
never be done — it is a thing to do between symbols, with the playhead
somewhere both of them are showing.
The deeper refusals — generated parts, a stencil parted from what it clips —
belong to the transplant and are only known when it runs."
[clip store open from to f]
(let [here (inside clip store open (pop from) f)
there (inside clip store open to f)
n (get-in clip [:symbols (:sid here) :nodes (peek from)])]
(cond
(nil? n) "nothing to move"
(or (nil? here) (nil? there)) "both have to be on screen at this frame"
(nil? (:sid there)) "only a symbol can take it"
(not (and (:time here) (:time there)))
"a held or looping clip has no clock to move through"
(nil? (some-> there :matrix node/invert)) "the target is scaled to nothing"
(= (:sid here) (:sid there)) "it is already there"
(and (= :instance (:kind n))
(some #(clip/contains-symbol? clip % (:sid there)) (node/sources n)))
"a symbol cannot go inside itself")))
(defn move-node (defn move-node
"Move the node at row path `from` — its last id is the node, the rest the "Move the node at row path `from` — its last id is the node, the rest the
instances down to where it lives — into the symbol placed by the instance at instances down to where it lives — into the symbol placed by the instance at
@ -284,14 +318,9 @@
a (:time here) a (:time here)
b (:time there) b (:time there)
inv (some-> there :matrix node/invert)] inv (some-> there :matrix node/invert)]
(cond (if-let [why (move-refusal clip store open from to f)]
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) {:refused why}
{:refused "nothing to move"} (transplant clip store (:sid here) (:frame here) (peek from) (:sid there)
(or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"}
(nil? (:sid there)) {:refused "only a symbol can take it"}
(not (and a b)) {:refused "a looping instance is in the way"}
(nil? inv) {:refused "the target is scaled to nothing"}
:else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there)
(node/mul! (node/mat) inv (:matrix here)) (node/mul! (node/mat) inv (:matrix here))
(node/then-time (node/invert-time b) a))))) (node/then-time (node/invert-time b) a)))))
@ -305,8 +334,8 @@
only a move that keeps the PICTURE needs a frame, for the matrix." only a move that keeps the PICTURE needs a frame, for the matrix."
[clip sid path] [clip sid path]
(let [;; Structurally, a row leads into a symbol only where it names one: (let [;; Structurally, a row leads into a symbol only where it names one:
;; a cel does, and the lane holding it does not, so the walk ;; a clip does, and a group holding one does not, so the walk stops at
;; stops at a lane rather than picking the drawing showing now — which ;; the group rather than picking the drawing showing now — which
;; would make where a row lives depend on the playhead. ;; would make where a row lives depend on the playhead.
only (fn [sid id] only (fn [sid id]
(when sid (node/source (get-in clip [:symbols sid :nodes id])))) (when sid (node/source (get-in clip [:symbols sid :nodes id]))))
@ -342,13 +371,82 @@
(nil? (:time here)) {:refused "a looping instance is in the way"} (nil? (:time here)) {:refused "a looping instance is in the way"}
:else :else
(let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))] d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))
{:clip (clip/update-symbol shift (fn [n]
clip (:sid here) update-in [:nodes id]
(fn [n]
(if (= :map (get-in n [:time :mode])) (if (= :map (get-in n [:time :mode]))
(update-in n [:time :at] (fnil + 0) d) (update-in n [:time :at] (fnil + 0) d)
(assoc n :time {:mode :map :at d :rate 1}))))})))) (assoc n :time {:mode :map :at d :rate 1})))
moved (assoc nodes id (shift (get nodes id)))
;; An editorial audio link follows a moved picture. Moving or
;; trimming the audio itself remains independent.
moved (if (= :audio (:kind (get nodes id)))
moved
(reduce (fn [ns [audio-id n]]
(if (and (= :audio (:kind n)) (= id (:linked-to n)))
(assoc ns audio-id (shift n))
ns))
moved nodes))
ps (symbol/problems (assoc (clip/symbol clip (:sid here)) :nodes moved))]
(if (seq ps)
{:refused (first ps)}
{:clip (assoc-in clip [:symbols (:sid here) :nodes] moved)})))))
(defn resize-out
"Move the right edge of the node at `path` by `df` frames of `open`.
One command either way: in a symbol drawn as a lane `span/resize-out` claims
the time it grows into, and in a composition it is one write to one span. The
mode says which, and nothing here has to ask."
[clip open path df ripple?]
(let [here (down clip open (pop path))
sid (:sid here)
id (peek path)
nodes (:nodes (clip/symbol clip sid))
n (get nodes id)]
(cond
(nil? n) {:refused "nothing to resize"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))
to (+ (second (node/placed-span n)) d)]
(span/resize-out clip sid id to {:ripple? ripple? :extent :grow-symbol})))))
(defn resize-in
"Move the left edge of the node at `path` by `df` frames of `open`."
[clip open path df]
(let [here (down clip open (pop path))
sid (:sid here)
id (peek path)
nodes (:nodes (clip/symbol clip sid))
n (get nodes id)]
(cond
(nil? n) {:refused "nothing to resize"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))
to (+ (first (node/placed-span n)) d)]
(span/resize-in clip sid id to)))))
(defn roll
"Move the shared boundary at `right-path` and the adjacent `left-path`."
[clip open left-path right-path df]
(let [here (down clip open (pop right-path))
sid (:sid here)
left-id (peek left-path)
right-id (peek right-path)
nodes (:nodes (clip/symbol clip sid))
right (get nodes right-id)]
(cond
(or (not= (pop left-path) (pop right-path)) (nil? right))
{:refused "a rolling edit needs adjacent clips in one sequence"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes right-id))))
d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))
to (+ (first (node/placed-span right)) d)]
(span/roll clip sid left-id right-id to)))))
(defn restack (defn restack
"Put the node at row path `from` just in front of the one at `to` when "Put the node at row path `from` just in front of the one at `to` when

14
frontend/src/arthur/domain/node.cljs
View file

@ -244,16 +244,6 @@
(when (and (<= 0 frame) (< frame length)) (when (and (<= 0 frame) (< frame length))
{:symbol sid :frame frame}))))) {:symbol sid :frame frame})))))
(defn lane?
"Is this group a LANE — a succession of cels rather than a composition?
`:layout :sequence` is the field because it names the RULE: children follow
one another and may not overlap. A group carrying it is called a lane, which
is the one place two words are kept for one thing, and they are kept apart on
purpose — the layout says what the rule is, the noun says what the thing is."
[n]
(and (= :group (:kind n)) (= :sequence (:layout n))))
(defn finite-number? [v] (and (number? v) (js/Number.isFinite v))) (defn finite-number? [v] (and (number? v) (js/Number.isFinite v)))
(defn local-frame (defn local-frame
@ -415,8 +405,8 @@
(finite-number? speed) (<= 0 speed) (finite-number? speed) (<= 0 speed)
(#{:stop :hold :loop} end))))) (#{:stop :hold :loop} end)))))
(conj "playback needs a nonnegative finite :in and :speed, and :end :stop, :hold or :loop") (conj "playback needs a nonnegative finite :in and :speed, and :end :stop, :hold or :loop")
(and (:layout n) (not (lane? n))) (:layout n)
(conj ":layout :sequence belongs to a group") (conj ":layout is not a node field — a lane is how the timeline DRAWS a symbol, not a thing in the document")
(and (= k :audio) (not (some (:source n) [:footage :sound]))) (and (= k :audio) (not (some (:source n) [:footage :sound])))
(conj "an audio node needs a :source :footage or :sound") (conj "an audio node needs a :source :footage or :sound")
(and (some? (get-in n [:time :rate])) (and (some? (get-in n [:time :rate]))

665
frontend/src/arthur/domain/span.cljs
View file

@ -1,28 +1,51 @@
(ns arthur.domain.span (ns arthur.domain.span
"The commands over ONE node's place in time: split it, trim an edge, move it. "The commands over a node's place in time: split it, trim an edge, move it —
and, where the symbol holding it is drawn as a lane, re-span its siblings to
make room.
A `:span` is in the node's OWN frames and its `:time` says where those land in A `:span` is in the node's OWN frames and its `:time` says where those land in
its parent, and that is true of EVERY node — which is why these three are not its parent, and that is true of EVERY node. A clip in a sequence, a symbol
lane commands, though a lane of cels is where they were first needed. A cel in placed straight into a shot, a shape that exists for part of one: each is a
a lane, a symbol placed straight into a shot, a shape that exists for part of span in a parent's frame space, and a span in a parent's frame space is the
one: each is a span in a parent's frame space, and a span in a parent's frame whole of what these commands touch.
space is the whole of what these commands touch. They were gated on a lane for
as long as a lane was the only thing anybody had timed.
THE COORDINATE IS ALWAYS THE PARENT'S. For a cel the parent is its lane, so THE COORDINATE IS ALWAYS THE PARENT'S. `host-frame` reads the frame space the
`host-frame` reads lane time exactly as the lane commands always did; for a node is positioned in, whatever that is, so a caller holding a node does not
node sitting straight in the symbol it reads the symbol's own frames. One rule, branch on what it sits in.
so a caller holding a node does not branch on what it sits in.
A GROUP IS REFUSED. Dividing a group means deciding what becomes of its A GROUP IS REFUSED where one node is being divided. Dividing a group means
children, and nothing in a span says: the right half of a split lane would deciding what becomes of its children, and nothing in a span says: a span that
reference none of its cels, and a span that narrows past a child hides it narrows past a child hides it without saying so.
without saying so. `domain/lane` holds the commands for a sequence, which are
the ones that ripple siblings or leave a gap.
`finish` lives here because every command in this namespace and every one in WHY THE SEQUENCE COMMANDS ARE HERE TOO. They used to be `domain/lane`, gated on
`domain/lane` commits through it." a group with `:layout :sequence`, because a lane was the only thing anybody had
(:require [arthur.domain.clip :as clip] timed. There is no such group any more — the SYMBOL is the container and a lane
is how the timeline draws one, `symbol/lane?` — so their subject is a symbol and
its children, which is the same subject as everything else here: one write to
one node's span, with the siblings re-spanned around it. See
`docs/lane-is-a-view-plan.md`.
THE CLAIM-TIME RULE FOLLOWS THE MODE. In lane mode, placing, moving or growing
over occupied frames TRIMS what it lands on — trimming the incumbent, removing
one wholly covered, splitting one it lands inside — so the result has no overlap
because the operation that could have made one did not. Outside lane mode
nothing is enforced, because overlapping children are what compositing IS.
EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or
`{:refused reason}` — never a half-applied edit, and never a document that
`clip/problems` would reject. A command that cannot say what the person meant
refuses and says why, rather than picking for them: the overflow policy is a
caller's `:extent`, and decoupling shared content is its own command instead of
something an ordinary edit does silently.
IDS COME FROM THE CALLER, because a clip's identity is a uuid and this namespace
is pure. Ids for new CONTENT are derived from the drawing being copied —
`clip/free-id` is pure too, and `drawing-a-2` says what it came from in a way
`symbol-7` does not.
`finish` lives here because every command in this namespace commits through it."
(:require [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
@ -30,32 +53,43 @@
"Commit `nodes` as symbol `sid`'s, or refuse. "Commit `nodes` as symbol `sid`'s, or refuse.
THE SHOT LENGTH IS AUTHORED. `:frames` is the symbol's window — how long the THE SHOT LENGTH IS AUTHORED. `:frames` is the symbol's window — how long the
shot IS — and the occupied extent of its lanes is a different fact derived shot IS — and where its clips reach is a different fact derived from them. A
from the cels. A command may GROW the window when the caller says command may GROW the window when the caller says `:grow-symbol`, and never
`:grow-symbol`, and never shrinks it: emptying the end of a shot leaves a shot shrinks it: emptying the end of a shot leaves a shot with empty frames at the
with empty frames at the end, which is a true statement about what somebody end, which is a true statement about what somebody authored. Deriving the window
authored. Deriving the window from the extent instead would make deleting the from the reach instead would make deleting the last drawing silently shorten the
last drawing silently shorten the film. film.
So there are two numbers and this function keeps them apart: `needed` is where So there are two numbers and this function keeps them apart: `needed` is where
the cels reach, `:frames` is what was authored, and the only way the the clips reach, `:frames` is what was authored, and the only way the second
second follows the first is a caller asking. follows the first is a caller asking.
Only LANES are measured for reach. A node placed straight in a shot may hang Only a symbol drawn AS A LANE is measured for reach. A node placed into a
off the end of it — that is an ordinary thing to author and the window is composition may hang off the end of it — that is an ordinary thing to author and
what crops it — whereas a lane's cels are a sequence whose length is the the window is what crops it — whereas a lane's clips are a sequence whose length
thing being edited." is the thing being edited.
THE OVERLAP INVARIANT IS ENFORCED HERE, and here is the only place it needs to
be: this is the single commit path for every sequence command, it validates
before it returns, and it refuses rather than half-applying. So no command can
commit an overlap in lane mode, and `symbol/overlaps` turning up anything is a
bug in a command rather than a state to design around."
[clip sid nodes selection extent] [clip sid nodes selection extent]
(let [sym (clip/symbol clip sid) (let [sym (clip/symbol clip sid)
reach (for [[id n] nodes :when (node/lane? n) lane? (symbol/lane? sym)
child (symbol/lane-cels nodes id) after (assoc sym :nodes nodes)
:let [m (symbol/frame-map nodes id) needed (if-not lane?
end (second (node/placed-span child))]] 0
(when m (+ (:at m) (/ end (:rate m))))) (js/Math.ceil (apply max 0 (keep #(second (node/placed-span %))
needed (js/Math.ceil (apply max 0 (keep identity reach))) (symbol/children nodes)))))
ps (symbol/problems (assoc sym :nodes nodes))] ps (symbol/problems after)
clashing (when lane? (symbol/overlaps after))]
(cond (cond
(seq ps) {:refused (first ps)} (seq ps) {:refused (first ps)}
(seq clashing)
{:refused (str "that would put " (pr-str (ffirst clashing)) " and "
(pr-str (second (first clashing)))
" on screen over the same frames of a lane")}
(not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"} (not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"}
(and (> needed (:frames sym)) (= :keep extent)) (and (> needed (:frames sym)) (= :keep extent))
{:refused (str "the edit needs " needed " frames; extend the shot to continue") {:refused (str "the edit needs " needed " frames; extend the shot to continue")
@ -73,7 +107,7 @@
;; and `:playback` are untouched — which is why trimming the front of a playing ;; and `:playback` are untouched — which is why trimming the front of a playing
;; insert starts it later in its source instead of resetting it, and why the two ;; insert starts it later in its source instead of resetting it, and why the two
;; halves of a split go on meaning what the one node meant. ;; halves of a split go on meaning what the one node meant.
;; Trim, split and `lane/blank` are all this one operation, applied differently. ;; Trim, split and `blank` are all this one operation, applied differently.
(defn local (defn local
"Parent frame `f` as one of `n`'s own frames." "Parent frame `f` as one of `n`'s own frames."
@ -89,8 +123,10 @@
(defn host-frame (defn host-frame
"Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its "Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its
parent's — which is the frame space every command here takes its coordinate parent's — which is the frame space every command here takes its coordinate
in. Nil through a stepped or looping ancestor, where one frame of the symbol in. For a clip of a lane that is the symbol's own frames, because the symbol is
is not one frame of the parent and there is no single answer to give." the container and the clip has no parent. Nil through a stepped or looping
ancestor, where one frame of the symbol is not one frame of the parent and there
is no single answer to give."
[clip sid id f] [clip sid id f]
(let [nodes (get-in clip [:symbols sid :nodes])] (let [nodes (get-in clip [:symbols sid :nodes])]
(when-let [{:keys [at rate]} (symbol/frame-map nodes (:parent (get nodes id)))] (when-let [{:keys [at rate]} (symbol/frame-map nodes (:parent (get nodes id)))]
@ -98,7 +134,7 @@
(defn- subject (defn- subject
"The node `id` names, as `{:node n}`, or `{:refused why}` where these commands "The node `id` names, as `{:node n}`, or `{:refused why}` where these commands
have nothing to act on. The one guard all three share." have nothing to act on. The one guard they share."
[nodes id] [nodes id]
(let [n (get nodes id)] (let [n (get nodes id)]
(cond (cond
@ -109,6 +145,13 @@
{:refused "this is on screen for the whole shot, so it has no edges to cut"} {:refused "this is on screen for the whole shot, so it has no edges to cut"}
:else {:node n}))) :else {:node n})))
(defn- siblings
"The other clips of `sid`'s sequence, or nil where `sid` is not drawn as a lane
and so has no sequence to re-span."
[clip sid nodes id]
(when (symbol/lane? (clip/symbol clip sid))
(remove #(= id (:id %)) (symbol/children nodes))))
(defn split (defn split
"Cut node `id` in two at parent frame `cut`. The left piece keeps its "Cut node `id` in two at parent frame `cut`. The left piece keeps its
identity; the right gets `new-id`. identity; the right gets `new-id`.
@ -125,8 +168,8 @@
THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at
one depth; nothing orders them against each other, because they are never on one depth; nothing orders them against each other, because they are never on
screen on the same frame. Cels in a lane do not consult `:z` at all — screen on the same frame. A lane's clips do not consult `:z` at all —
`symbol/lane-cels` sorts them by where they start. `symbol/children` sorts them by where they start.
The right piece is the selection, because it is the piece that was made." The right piece is the selection, because it is the piece that was made."
[clip sid id cut new-id] [clip sid id cut new-id]
@ -148,10 +191,10 @@
"Move one edge of node `id` to parent frame `to`, without disturbing anything "Move one edge of node `id` to parent frame `to`, without disturbing anything
else at all. else at all.
TRIM NARROWS. Lengthening a cel is `lane/extend-hold`, which carries a ripple TRIM NARROWS. Lengthening is `resize-out`, which carries a ripple policy and a
policy and a shot-length policy because it needs them; letting trim grow as shot-length policy because it needs them; letting trim grow as well would give
well would give one gesture two sets of rules and a way to overlap its one gesture two sets of rules and a way to overlap its neighbour. `edge` is
neighbour. `edge` is `:in` or `:out`. `:in` or `:out`.
The source clock is untouched, so trimming the front of a playing insert The source clock is untouched, so trimming the front of a playing insert
starts it later INTO its animation rather than restarting it — which is the starts it later INTO its animation rather than restarting it — which is the
@ -170,15 +213,16 @@
(defn move (defn move
"Put node `id` at parent frame `to`, leaving its own length, source and "Put node `id` at parent frame `to`, leaving its own length, source and
corrections alone — and, in a lane, every other cel. corrections alone — and, in a lane, every other clip.
One write to `:time :at`. A destination that would overlap a neighbour IN A One write to `:time :at`. A destination that would overlap a neighbour IN A
LANE is refused rather than rippled or overwritten: moving a drawing and LANE is refused rather than rippled or overwritten: moving a drawing and
re-timing the ones around it are different intentions, and a move that re-timing the ones around it are different intentions, and a move that
silently pushed the rest would be the second one wearing the first one's name. silently pushed the rest would be the second one wearing the first one's name.
Clear the room first — `lane/blank` makes a gap, `trim` shortens a neighbour. Clear the room first — `blank` makes a gap, `trim` shortens a neighbour — or
Outside a lane there is no such rule to break: things placed in a composition say you meant to claim it, which is `adopt`, what a body drag does.
are allowed to be on screen together, so the move simply happens." Outside lane mode there is no such rule to break: things placed in a
composition are allowed to be on screen together, so the move simply happens."
[clip sid id to] [clip sid id to]
(let [nodes (get-in clip [:symbols sid :nodes]) (let [nodes (get-in clip [:symbols sid :nodes])
{:keys [node refused]} (subject nodes id)] {:keys [node refused]} (subject nodes id)]
@ -190,3 +234,520 @@
(if (not= to (first (node/placed-span moved))) (if (not= to (first (node/placed-span moved)))
{:refused "timing through a stepped or looping parent is not supported"} {:refused "timing through a stepped or looping parent is not supported"}
(finish clip sid (assoc nodes id moved) id :keep)))))) (finish clip sid (assoc nodes id moved) id :keep))))))
;; ---------------------------------------------------------------------------
;; the sequence: one edge edit, with the siblings re-spanned around it
(defn- trimmed-into-a-sequence
"`nodes` with every clip's right edge pulled back to where the next one starts,
and any clip the next one wholly covers removed.
THE SAME CLAIM-TIME RULE, APPLIED ALL AT ONCE. Later claims from earlier
everywhere it has to, which is the rule every other command here follows one
edit at a time; doing it as a pass is only what makes the answer to \"make this
a lane\" one undo step."
[nodes]
(reduce
(fn [ns [earlier later]]
(let [[lo hi] (node/placed-span (get ns (:id earlier)))
[next-lo _] (node/placed-span later)]
(cond
(nil? lo) ns
(<= hi next-lo) ns
(<= next-lo lo) (dissoc ns (:id earlier))
:else (assoc ns (:id earlier) (edged (get ns (:id earlier)) :out next-lo)))))
nodes
(partition 2 1 (symbol/children nodes))))
(defn draw-as-lane
"Turn symbol `sid`'s lane mode on or off. `{:clip c}` or `{:refused why}`.
OFF IS ALWAYS POSSIBLE: a composition has no invariant to break, so dropping
the hint drops the rules with it and nothing in the document moves.
ON IS THE ONE PLACE A PERSON CAN ASK FOR THE IMPOSSIBLE. Every other command
maintains the sequence; this one asks a symbol whose clips may already be on
screen together to start being one, and there is no answer that does not throw
frames away. So it refuses and says how many clips it would have to trim,
carrying `:required-trim` for the retry the UI offers as one button — the same
shape as `finish`'s `:required-frames`. With `trim?` it does it: later claims
from earlier, which is the rule everything else here already follows."
[clip sid on? {:keys [trim?]}]
(let [sym (clip/symbol clip sid)]
(cond
(nil? sym) {:refused "there is no such symbol"}
(not on?) {:clip (update-in clip [:symbols sid] dissoc :display)}
:else
(let [clashing (symbol/overlaps sym)]
(cond
(empty? clashing) {:clip (assoc-in clip [:symbols sid :display] :lane)}
(not trim?)
{:refused (str "drawing this as a lane means trimming "
(count clashing) " clip"
(when (< 1 (count clashing)) "s")
" that overlap a neighbour")
:required-trim (count clashing)}
:else
(let [nodes (trimmed-into-a-sequence (:nodes sym))
after (assoc sym :nodes nodes :display :lane)]
(if (seq (symbol/overlaps after))
{:refused "these clips cannot be trimmed into a sequence"}
{:clip (assoc-in clip [:symbols sid] after)})))))))
(defn resize-out
"Put clip `id`'s right edge at parent frame `to`, allowing it to grow.
IN A LANE this claims time. Without `ripple?`, growing consumes the starts of
the clips it reaches: wholly covered clips disappear and the last partially
covered one is trimmed. Shrinking leaves a gap. With `ripple?`, every clip
beginning at or after the old edge moves by the same delta, in either
direction, so their contents are preserved. Either way there is no overlap,
because the operation that could have made one did not.
OUTSIDE A LANE it is one write to one span and nothing else moves, because
things placed in a composition are allowed to be on screen together. One
gesture, and the mode says which rule it plays by."
[clip sid id to {:keys [extent ripple?] :or {extent :keep ripple? false}}]
(let [nodes (get-in clip [:symbols sid :nodes])
{:keys [node refused]} (subject nodes id)
[lo old-out] (when node (node/placed-span node))
later (when node
(filter #(>= (first (node/placed-span %)) old-out)
(siblings clip sid nodes id)))]
(cond
refused {:refused refused}
(not (integer? to)) {:refused "an edge goes to a whole frame"}
(not (< lo to)) {:refused "a clip must keep at least one frame"}
(= to old-out) {:clip clip :selection id}
:else
(let [delta (- to old-out)
resized (assoc nodes id (edged node :out to))
changed
(if ripple?
(reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
resized later)
(if (pos? delta)
(reduce
(fn [ns sibling]
(let [[s e] (node/placed-span sibling)]
(cond
(>= s to) ns
(<= e to) (dissoc ns (:id sibling))
:else (assoc ns (:id sibling) (edged sibling :in to)))))
resized later)
resized))]
(finish clip sid changed id extent)))))
(defn resize-in
"Put clip `id`'s left edge at parent frame `to`. Shrinking leaves a gap;
in a lane, growing left consumes earlier clips symmetrically with `resize-out`."
[clip sid id to]
(let [nodes (get-in clip [:symbols sid :nodes])
{:keys [node refused]} (subject nodes id)
[old-in hi] (when node (node/placed-span node))
earlier (when node
(filter #(<= (second (node/placed-span %)) old-in)
(siblings clip sid nodes id)))]
(cond
refused {:refused refused}
(not (integer? to)) {:refused "an edge goes to a whole frame"}
(not (< to hi)) {:refused "a clip must keep at least one frame"}
(neg? to) {:refused "a clip cannot begin before the shot"}
(= to old-in) {:clip clip :selection id}
:else
(let [resized (assoc nodes id (edged node :in to))
changed (if (< to old-in)
(reduce
(fn [ns sibling]
(let [[s e] (node/placed-span sibling)]
(cond
(<= e to) ns
(>= s to) (dissoc ns (:id sibling))
:else (assoc ns (:id sibling) (edged sibling :out to)))))
resized earlier)
resized)]
(finish clip sid changed id :keep)))))
(defn roll
"Move the shared boundary between adjacent clips `left-id` and `right-id`.
This is deliberately only the composition of the two ordinary edge edits."
[clip sid left-id right-id to]
(let [nodes (get-in clip [:symbols sid :nodes])
left (get nodes left-id)
right (get nodes right-id)
[llo lhi] (when left (node/placed-span left))
[rlo rhi] (when right (node/placed-span right))]
(cond
(not (symbol/lane? (clip/symbol clip sid)))
{:refused "a rolling edit needs a symbol drawn as a lane"}
(not (and llo rlo (nil? (:parent left)) (nil? (:parent right))))
{:refused "a rolling edit needs two clips of one sequence"}
(not= lhi rlo) {:refused "a rolling edit needs one shared boundary"}
(not (integer? to)) {:refused "a clip edge goes to a whole frame"}
(not (< llo to rhi)) {:refused "both clips must keep at least one frame"}
:else
(let [left-result (resize-out clip sid left-id to {})]
(if (:refused left-result)
left-result
(resize-in (:clip left-result) sid right-id to))))))
(defn blank
"Clear frames `[a b)` of symbol `sid`, leaving a GAP.
A gap is not a drawing. Nothing is invented to cover those frames and nothing
closes the hole — the clips after it stay where they are, because emptying
frames and re-timing a performance are different intentions.
What it does to each clip it meets is `edged`, applied three ways: one wholly
inside is removed, one overlapping an end is trimmed to it, and the one that
spans the whole range is split, which is the only case that needs `id`. Their
drawings stay in the library — a symbol does not own its content, and a drawing
whose last clip is gone is still a drawing somebody made."
[clip sid [a b] {:keys [id]}]
(let [nodes (get-in clip [:symbols sid :nodes])
lane? (symbol/lane? (clip/symbol clip sid))
members (when lane? (symbol/children nodes))
spanning (when members
(first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b)))
members)))]
(cond
(not lane?) {:refused "clearing a range of frames needs a symbol drawn as a lane"}
(not (and (integer? a) (integer? b) (< a b)))
{:refused "a range to blank is whole frames, and not empty"}
(and spanning (or (nil? id) (contains? nodes id)))
{:refused "blanking inside one clip splits it, which needs a free ID for the remainder"}
:else
(let [nodes (reduce
(fn [ns n]
(let [[lo hi] (node/placed-span n)]
(cond
(or (<= hi a) (>= lo b)) ns
(and (< lo a) (> hi b))
(-> ns
(assoc (:id n) (edged n :out a))
(assoc id (assoc (edged n :in b) :id id :z (str "a-" id))))
(and (>= lo a) (<= hi b)) (dissoc ns (:id n))
(< lo a) (assoc ns (:id n) (edged n :out a))
:else (assoc ns (:id n) (edged n :in b)))))
nodes members)]
;; NOTHING SENSIBLE IS SELECTED by emptying frames, so nothing is: a
;; split names its remainder, and otherwise the caller keeps whatever was
;; selected rather than being handed a clip it did not ask for.
(finish clip sid nodes (when spanning id) :keep)))))
(defn- cleared
"`clip` with frames `[at (+ at duration))` of `sid` emptied where `sid` is drawn
as a lane, and untouched where it is not: outside lane mode a placement does not
claim time, because being on screen together is what compositing IS.
`{:clip c}` or `{:refused why}`, so one `if-let` covers both."
[clip sid at duration remainder-id]
(if-not (symbol/lane? (clip/symbol clip sid))
{:clip clip}
(blank clip sid [at (+ at duration)] {:id remainder-id})))
(defn extend-hold
"Change one held clip's duration by `delta` frames and ripple its later
siblings. Keys, source clocks and the clips' own channels stay put.
Returns {:clip :selection} or {:refused :required-frames?}; never partially edits."
[clip sid id delta {:keys [extent] :or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])
n (get nodes id)
rate (:rate (node/time-of n))
span (:span n)]
(cond
(not (symbol/lane? (clip/symbol clip sid)))
{:refused "a hold is lengthened in a symbol drawn as a lane"}
(nil? (node/placed-span n)) {:refused "select a clip in the lane"}
(some? (:parent n)) {:refused "select a clip of the lane itself"}
(not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of frames"}
(not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"}
(<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive exposure"}
:else
(let [[_ boundary] (node/placed-span n)
later (filter #(>= (first (node/placed-span %)) boundary)
(siblings clip sid nodes id))
nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta)))
nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
nodes later)]
(finish clip sid nodes id extent)))))
(defn place-node
"Place the already-materialized, direct child `n` into symbol `sid` at `at`.
THIS IS THE PLACEMENT RULE. Materializing a symbol instance, an audio node, or
imported content is deliberately somebody else's job; once it is a node, its
origin no longer matters. The destination alone decides the edit:
- an ordinary symbol attaches it and permits overlap;
- a lane symbol first clears the interval it claims.
The caller hands this function a node not currently present in the destination.
Its duration, channels, source clock and identity are preserved; only its
parent-space start changes. Returns the ordinary command result shape."
[clip sid n at {:keys [extent remainder-id] :or {extent :keep}}]
(let [sym (clip/symbol clip sid)
nodes (:nodes sym)
id (:id n)
[lo hi] (when n (node/placed-span n))
duration (when (and lo hi) (- hi lo))]
(cond
(nil? sym) {:refused "there is no destination symbol"}
(nil? n) {:refused "there is no clip to place"}
(contains? nodes id) {:refused "the destination already uses that clip ID"}
(some? (:parent n)) {:refused "only a direct child can be placed in a symbol"}
(not (and (integer? at) (not (neg? at))))
{:refused "a position is a nonnegative whole frame"}
(not (pos? duration)) {:refused "the clip has no frames to place"}
(and remainder-id (contains? nodes remainder-id))
{:refused "the remainder clip needs a free ID"}
:else
(let [room (cleared clip sid at duration remainder-id)]
(if (:refused room)
room
(let [placed (update-in n [:time :at] (fnil + 0) (- at lo))
nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id placed)]
(finish (:clip room) sid nodes id extent)))))))
(defn place-symbol
"Materialize an instance of `source-id`, then place it into `sid` at `at`.
IN A LANE the new clip claims its interval: existing clips under it are
trimmed, removed, or split, so the sequence stays a partition rather than
storing an overlap. Outside one it is simply placed. This is the generic
operation behind dropping a library symbol into the timeline; one-frame held
drawing creation remains a policy of `append-drawing`/`overwrite-drawing`,
not a different kind of container."
[clip store sid id source-id at
{:keys [extent point remainder-id] :or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])
seeded (clip/place-symbol clip store sid source-id 0 id point)
n (get-in seeded [:symbols sid :nodes id])]
(cond
(contains? nodes id) {:refused "the new clip ID is already used"}
(nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"}
(nil? n) {:refused "a symbol cannot go inside itself"}
:else
(place-node clip sid n at {:extent extent :remainder-id remainder-id}))))
(defn adopt
"Move an existing clip of `sid` to frame `at`, CLAIMING the time it lands on.
Its source, span, transforms, corrections, and identity come with it; in a lane
the destination interval is claimed with the same trimming as a pool drop. This
is what a body drag does, and it is why `move` and this are two commands:
`move` refuses to disturb a neighbour, and a drag onto occupied time has
already said it means to."
[clip sid id at opts]
(let [nodes (get-in clip [:symbols sid :nodes])
n (get nodes id)]
(cond
(nil? n) {:refused "select a clip to move"}
(some? (:parent n)) {:refused "only a clip of the symbol itself is placed in its sequence"}
:else
(place-node (assoc-in clip [:symbols sid :nodes] (dissoc nodes id))
sid n at opts))))
(defn transfer
"Move direct child `id` from `from-sid` into `to-sid` at `at`.
Cross-symbol and same-symbol moves are deliberately the same composition:
detach, then `place-node`. The destination's mode—not the gesture, source, or
payload kind—decides whether occupied time is claimed."
[clip from-sid id to-sid at opts]
(let [from-nodes (get-in clip [:symbols from-sid :nodes])
n (get from-nodes id)]
(cond
(nil? n) {:refused "select a clip to move"}
(some? (:parent n)) {:refused "only a direct child can move between symbols"}
:else
(let [detached (assoc-in clip [:symbols from-sid :nodes] (dissoc from-nodes id))
result (place-node detached to-sid n at opts)]
(if-let [made (:clip result)]
(if-let [why (first (clip/problems made))]
{:refused why}
result)
result)))))
;; ---------------------------------------------------------------------------
;; putting drawings in a sequence
(defn- held
"A one-frame held clip of `drawing-id`, starting at frame `at`.
Held rather than playing, and one frame rather than the length of what it
places: a clip's duration is the sequence's business — `extend-hold` and
`resize-out` are how it changes — and reading it off the content would make
placing a ten-frame animation and holding its first drawing the same gesture."
[id drawing-id at]
{:id id :kind :instance :z (str "a-" id)
:span [0 1] :time {:at at :rate 1}
:source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}})
(defn- sequence-end
"Where `sid`'s occupied frames stop."
[nodes]
(apply max 0 (map #(second (node/placed-span %)) (symbol/children nodes))))
(defn- place
"Put a held clip of `drawing-id` into `sid` at frame `at`, and RIPPLE:
everything starting at or after it moves later by its duration.
There is one placement function and `:end` is a position like any other, so
appending is not a different operation from inserting — the end is just where
nothing has to move. Overwriting is the other policy and is NOT this: taking
frames away from the clip already there is trimming, which is its own command
and not something placing a drawing should do on the quiet.
`:frame` in the result is where it landed, in the symbol's own frames, for a
caller that wants to look at what it just made."
[clip sid id drawing-id at extent ripple?]
(let [nodes (get-in clip [:symbols sid :nodes])
at (if (= :end at) (sequence-end nodes) at)
n (held id drawing-id at)
[lo hi] (node/placed-span n)
;; RIPPLE FOLLOWS THE MODE. Pushing later siblings is what inserting
;; into a sequence means; in a composition there is no "later sibling"
;; to push, because being on screen together is the point.
later (when (and ripple? (symbol/lane? (clip/symbol clip sid)))
(filter #(>= (first (node/placed-span %)) lo) (symbol/children nodes)))
nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo)))
(assoc nodes id n) later)
result (finish clip sid nodes id extent)]
(cond-> result
(:clip result) (assoc :frame at))))
(defn- placeable
"Why a held clip cannot go into `sid` at `at`, or nil."
[clip sid id at]
(let [nodes (get-in clip [:symbols sid :nodes])
;; INSIDE a clip is not a position for another one, IN A LANE. Splitting
;; that clip is what makes it two, and doing it here would be one command
;; quietly performing two: the caller asks for `split` and then places.
;; In a composition landing inside something is not a collision at all.
inside (when (and (number? at) (symbol/lane? (clip/symbol clip sid)))
(some (fn [n] (let [[lo hi] (node/placed-span n)]
(when (< lo at hi) n)))
(symbol/children nodes)))]
(cond
(contains? nodes id) "the new clip ID is already used"
(not (or (= :end at) (and (integer? at) (not (neg? at)))))
"a position is :end or a whole frame"
inside (str "frame " at " is inside a clip; split it first"))))
(defn append-drawing
"Append fresh empty content and a held clip of it. IDs come from the
caller so a command is deterministic and replayable.
Fresh content, not a blank range: a sequence with no clip over a frame shows
nothing there already, and a drawing nobody has drawn in is a different thing
from a gap."
[clip sid id drawing-id {:keys [at extent] :or {extent :keep at :end}}]
(if-let [why (or (placeable clip sid id at)
(when (clip/symbol clip drawing-id) "the new drawing ID is already used"))]
{:refused why}
(place (assoc-in clip [:symbols drawing-id]
{:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}})
sid id drawing-id at extent true)))
(defn reuse-drawing
"Append a held clip of content the document ALREADY has, so the same
drawing is exposed twice and editing it changes both clips.
This is the command `make-unique` is the undo of, and the reason they are two
commands: reuse is a decision to share, and sharing is not something to
discover later when an edit turns up somewhere else."
[clip sid id drawing-id {:keys [at extent] :or {extent :keep at :end}}]
(if-let [why (or (placeable clip sid id at)
(when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse")
;; Placing something that contains this symbol would close a
;; loop, and a sequence is no different from any other placement.
(when (clip/contains-symbol? clip drawing-id sid)
"a symbol cannot go inside itself"))]
{:refused why}
(place clip sid id drawing-id at extent true)))
(defn- copied
"A copy of symbol `from`, as `{:clip :id}`.
SHALLOW by default: its own nodes and channels are copied, and its references
to other symbols are kept, so a head built out of reusable eyes still uses
those eyes. `deep?` copies everything it places as well, with new ids
throughout, for a drawing that must share nothing — the distinction the
shallow copy cannot make on its own, and a promise of independence that only
the deep one keeps."
[clip from deep?]
(if deep?
(let [{c :clip ids :ids} (bring/symbols clip clip [from] {})]
{:clip c :id (ids from)})
(let [id (clip/free-id (:symbols clip) from)]
{:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id))
:id id})))
(defn duplicate-drawing
"Append a held clip of a COPY of what clip `id` places, for when
the drawing on screen is the starting point for the next one.
The copy is of the content only. The new clip is a plain one-frame hold
rather than a copy of `id`'s own transform or corrections: those belong to
that clip, and carrying them over would make duplicating a drawing quietly
duplicate the treatment of one use of it."
[clip sid id new-id {:keys [at extent deep?] :or {extent :keep at :end}}]
(let [n (get-in clip [:symbols sid :nodes id])
from (node/source n)]
(if-let [why (or (when-not from "select a clip to duplicate")
(when-not (clip/symbol clip from) "the drawing it places is missing")
(placeable clip sid new-id at))]
{:refused why}
(let [{c :clip copy :id} (copied clip from deep?)]
(place c sid new-id copy at extent true)))))
(defn overwrite-drawing
"Put a fresh one-frame drawing at frame `at`, replacing whatever was there and
leaving every other clip where it was.
This is `blank` and placement composed in ONE command and therefore one undo
step. `remainder-id` is used only when clearing the frame cuts one clip into
two; ids still come from the caller because this namespace is pure."
[clip sid id drawing-id at {:keys [extent remainder-id] :or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])]
(if-let [why (cond
(not (and (integer? at) (not (neg? at))))
"a position is a nonnegative whole frame"
(contains? nodes id) "the new clip ID is already used"
(or (= id remainder-id) (contains? nodes remainder-id))
"the remainder clip needs a free ID different from the new clip"
(clip/symbol clip drawing-id) "the new drawing ID is already used")]
{:refused why}
(let [room (cleared clip sid at 1 remainder-id)]
(if (:refused room)
room
(place (assoc-in (:clip room) [:symbols drawing-id]
{:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}})
sid id drawing-id at extent false))))))
(defn make-unique
"Point clip `id` at a private copy of its content, leaving every other
clip of that drawing sharing the original.
Refused when nothing else uses it: a drawing with one clip is already
unique, and answering with a silent copy would leave a second identical symbol
in the library for no reason a person could see."
[clip sid id {:keys [deep?]}]
(let [n (get-in clip [:symbols sid :nodes id])
from (node/source n)
elsewhere (for [[osid osym] (:symbols clip)
[oid on] (:nodes osym)
:when (and (= from (node/source on)) (not= [sid id] [osid oid]))]
[osid oid])]
(if-let [why (or (when-not from "select a clip to make unique")
(when-not (clip/symbol clip from) "the drawing it places is missing")
(when (empty? elsewhere) "nothing else uses this drawing"))]
{:refused why}
(let [{c :clip copy :id} (copied clip from deep?)
c (assoc-in c [:symbols sid :nodes id :source :symbol] copy)
ps (clip/problems c)]
(if (seq ps) {:refused (first ps)} {:clip c :selection id})))))

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

@ -71,7 +71,13 @@
repeat cannot be longer than the number of nodes, so one step past that is repeat cannot be longer than the number of nodes, so one step past that is
proof of a loop and needs no bookkeeping. Caught rather than hung — a cycle is proof of a loop and needs no bookkeeping. Caught rather than hung — a cycle is
reachable from one bad `:node/set-parent`, and a hung tab is a far worse reachable from one bad `:node/set-parent`, and a hung tab is a far worse
diagnostic than a stack trace naming the nodes." diagnostic than a stack trace naming the nodes.
THE PROOF ONLY HOLDS FOR A NODE THIS SYMBOL HAS. An id that is not in `nodes`
contributes a step the count knows nothing about, and its lineage is just
itself; in an EMPTY symbol that one step used to be read as a loop, so asking
where a node of another symbol sits threw `parent cycle` instead of answering
that it sits nowhere."
[nodes id] [nodes id]
(let [up (fn [i] (let [up (fn [i]
(when-let [p (:parent (get nodes i))] (when-let [p (:parent (get nodes i))]
@ -81,7 +87,7 @@
{:node i :parent p}))))) {:node i :parent p})))))
chain (into [] (comp (take-while some?) (take (inc (count nodes)))) chain (into [] (comp (take-while some?) (take (inc (count nodes))))
(iterate up id))] (iterate up id))]
(when (> (count chain) (count nodes)) (when (and (contains? nodes id) (> (count chain) (count nodes)))
(throw (ex-info "parent cycle in symbol" {:node id :chain chain}))) (throw (ex-info "parent cycle in symbol" {:node id :chain chain})))
chain)) chain))
@ -90,16 +96,25 @@
[nodes id] [nodes id]
(dec (count (lineage nodes id)))) (dec (count (lineage nodes id))))
(defn lane-cels (defn children
"The cels of lane `lane`, in the order they are exposed. "The symbol's own clips — the nodes placed directly in it — in timeline order.
Sorted by where they START, not by `:z`: a lane's blocks follow one another in THE SYMBOL IS THE CONTAINER. There is no lane node to ask for its members: a
time, and two of them cannot be in the same place for `:z` to decide between. symbol drawn as a lane draws THESE, and the sequence commands re-span THESE.
Ties go to the id so the order is the same on every run." See `docs/lane-is-a-view-plan.md`.
[nodes lane]
Sorted by where they START, not by `:z`: blocks in a sequence follow one
another in time, and two of them cannot be in the same place for `:z` to
decide between. Ties go to the id so the order is the same on every run.
A NODE WITH NO SPAN IS NOT IN THE SEQUENCE. A shape on screen for the whole
shot has no `[in out)` to follow anything else, so it is not something an edge
edit can trim or ripple, and a command that destructured its nil span would
fail on the most ordinary node there is."
[nodes]
(->> (vals nodes) (->> (vals nodes)
(filter #(= lane (:parent %))) (filter #(and (nil? (:parent %)) (node/placed-span %)))
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %)))) (sort-by (juxt #(first (node/placed-span %)) #(str (:id %))))
vec)) vec))
(defn frame-map (defn frame-map
@ -107,10 +122,10 @@
`{:at a :rate r}`, meaning symbol frame `p` is frame `r·(p − a)` of `id`. `{:at a :rate r}`, meaning symbol frame `p` is frame `r·(p − a)` of `id`.
Identity for `nil`, which is a node sitting directly in the symbol. Identity for `nil`, which is a node sitting directly in the symbol.
THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A cel's parent is its THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A direct child reads
lane, so a lane command composing this for the lane reads lane time; a node the symbol's own frames. A node grouped beneath another composes through that
with no parent reads the symbol's own frames. One rule either way, so a caller parent chain. One rule either way, so a caller holding a node does not have to
holding a node does not have to ask what it is sitting in. ask what it is sitting in or how the timeline happens to draw the symbol.
Refuses floors and loops rather than pretend an affine map preserves them: Refuses floors and loops rather than pretend an affine map preserves them:
through either, one frame of the symbol is not one frame of `id` and a command through either, one frame of the symbol is not one frame of `id` and a command
@ -125,51 +140,47 @@
(<= (or (:expose t) 1) 1)) (<= (or (:expose t) 1) 1))
(recur (:parent n) (conj seen id) (conj chain n))))))) (recur (:parent n) (conj seen id) (conj chain n)))))))
(defn lanes (defn lane?
"The symbol's lanes, front-most first. "Whether symbol `sym` is EDITED AND DRAWN as a lane: its clips as blocks on
one row, following one another in time and claiming it from each other.
SAME ORDER THE TIMELINE DRAWS ITS ROWS IN — `:z` descending, the id breaking A DISPLAY HINT AND NOT A TYPE. Nothing in evaluation reads it, `problems` does
ties so it is stable across runs — because the cel sheet's columns are those not check it, and a symbol carrying it behaves identically on the stage — it
rows stood on end, and \"the first lane\" has to mean the same thing to the view says how the timeline draws the symbol and, because the editing rules follow
that shows them and to the command that defaults to one. the mode, which rules an edge drag inside it plays by. It is on the symbol
rather than in editor state so that those rules are reproducible between two
people looking at one document, and it is a field rather than something derived
from \"the clips do not currently overlap\" because a symbol must not stop being
a lane the moment something overlaps — that is when the rules are needed.
Only this symbol's own: a lane inside a nested instance belongs to that Editing and presentation may read it; evaluation may not. See
symbol, and aiming a drawing at it is entering it first." `docs/lane-is-a-view-plan.md`."
[nodes] [sym]
(->> (vals nodes) (= :lane (:display sym)))
(filter node/lane?)
(sort-by (fn [n] [(or (:z n) "") (str (:id n))]))
reverse
vec))
(defn lane-problems (defn overlaps
"What makes a lane not a lane. A SEQUENCE is the one composition rule the node "The pairs of `sym`'s clips that are on screen over the same frames, as
map carries — ordinary groups compose freely — so it is checked here, beside `[[a b] ...]` of ids. Empty for a symbol whose clips form a sequence.
the parent and stencil references, rather than wherever a command happens to
build one.
Cels must be visual, finite and non-overlapping. An accidental overlap A BUG REPORT, NOT A CONDITION TO DESIGN AROUND. In lane mode this cannot
is refused rather than resolved by draw order: two drawings exposed on one happen: placing claims time, so anything placed, moved or grown over occupied
frame of one lane is a document nobody meant to write, and picking a winner frames TRIMS what it lands on, and `span/finish` — the one commit path for
would hide it. Empty lanes are valid — a lane is made before it is filled." every sequence command — refuses rather than committing one. So an overlap that
[nodes] appears anyway is a defect in a command.
(vec
(mapcat Which is why it is NOT `clip/problems`, which means the document will not load:
(fn [[id lane]] a display hint must never be able to stop a document loading, and a document
(when (node/lane? lane) that somehow arrives holding an overlap still opens and is drawn visibly wrong.
(let [children (filter #(= id (:parent %)) (vals nodes)) Nor `clip/conflicts`, which means a person has a decision to make. This is
valid? (fn [n] neither."
(and (= :instance (:kind n)) [sym]
(empty? (node/problems n)) (let [spans (for [n (children (:nodes sym))
(:span n) :let [[lo hi] (node/placed-span n)]
(every? node/finite-number? (node/placed-span n)))) :when (and (node/finite-number? lo) (node/finite-number? hi))]
intervals (sort-by first (map node/placed-span (filter valid? children)))] [lo hi (:id n)])]
(concat (vec (for [[[_ b x] [c _ y]] (partition 2 1 (sort-by (juxt first second str) spans))
(for [n children :when (not (valid? n))] :when (> b c)]
(str "sequence " id " needs finite visual cels: " (:id n))) [x y]))))
(when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals))
[(str "lane " id " has overlapping cels")])))))
nodes)))
(defn order (defn order
"Node ids in topological order: every node after its parent. "Node ids in topological order: every node after its parent.
@ -692,8 +703,12 @@
and saved leaves point at, so renaming a symbol must not change it. and saved leaves point at, so renaming a symbol must not change it.
`:width` and `:height` are the symbol's own stage, and are absent until someone `:width` and `:height` are the symbol's own stage, and are absent until someone
sets them: a symbol without them uses the clip's — see `clip/stage`." sets them: a symbol without them uses the clip's — see `clip/stage`.
#{:id :name :frames :fps :width :height :nodes :palette})
`:display` is how the TIMELINE draws the symbol — `:lane` for its clips as
blocks on one row — and is saved because two people editing one document must
play by the same editing rules. See `lane?`."
#{:id :name :frames :fps :width :height :nodes :palette :display})
(defn problems (defn problems
"Human-readable reasons this symbol will not evaluate. Empty means it will. "Human-readable reasons this symbol will not evaluate. Empty means it will.
@ -711,7 +726,6 @@
(if-not (map? nodes) (if-not (map? nodes)
[":nodes must be a map of id -> node"] [":nodes must be a map of id -> node"]
(-> [] (-> []
(into (lane-problems nodes))
(into (for [[id n] nodes (into (for [[id n] nodes
:when (not= id (:id n))] :when (not= id (:id n))]
(str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) (str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))

38
frontend/src/arthur/events/footage.cljs
View file

@ -6,7 +6,9 @@
address of every block this produces." address of every block this produces."
(:require [arthur.domain.bring :as bring] (:require [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.span :as span]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
[arthur.events.ui :as ui]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.flow.detect :as detect] [arthur.flow.detect :as detect]
[arthur.flow.ingest :as ingest] [arthur.flow.ingest :as ingest]
@ -466,12 +468,13 @@
(rf/reg-event-db (rf/reg-event-db
::ask-convert ::ask-convert
(fn [db [_ {:keys [frames label] :as footage} frame point]] (fn [db [_ {:keys [frames label] :as footage} frame point target]]
(assoc-in db [:ui :convert] (assoc-in db [:ui :convert]
(merge (select-keys footage [:id :label :frames :fps :video]) (merge (select-keys footage [:id :label :frames :fps :video])
{:range [0 frames] {:range [0 frames]
:name (string/replace (str label) #"\.[^.]*$" "") :name (string/replace (str label) #"\.[^.]*$" "")
:host (get-in db [:ui :open]) :frame frame :point point})))) :host (get-in db [:ui :open]) :frame frame :point point
:target target}))))
(rf/reg-event-db (rf/reg-event-db
::convert-set ::convert-set
@ -494,23 +497,38 @@
(rf/reg-event-fx (rf/reg-event-fx
::converted ::converted
(fn [{:keys [db]} [_ {{:keys [name host frame point range]} :request footage-id :footage-id} ;; A TAKE IS A CLIP LIKE ANY OTHER, placed into whichever symbol the drop names
;; — see `ui/drop-destination` — rather than into a container invented for it.
(fn [{:keys [db]} [_ {{:keys [name frame point range target]} :request footage-id :footage-id}
built]] built]]
(let [uuid (random-uuid) (let [entry (store/entry (:clip/current db))
uuid (random-uuid)
fps (get-in db [:clip :fps]) fps (get-in db [:clip :fps])
{:keys [clip sid tracked?]} {:keys [clip sid tracked?]}
(bring/take (:clip (store/entry (:clip/current db))) (:clip built) (bring/take (:clip entry) (:clip built) name footage-id range)
name footage-id range) st (merge (:store entry) (:store built))
imported-frames (clip/output-frames clip sid) imported-frames (clip/output-frames clip sid)
source-fps (get-in built [:clip :fps]) source-fps (get-in built [:clip :fps])
db (edit/edit-entry where (ui/drop-destination db clip st frame target)
result (if (:refused where)
where
(span/place-symbol (:clip where) st (:sid where)
uuid sid (:at where)
{:extent :grow-symbol :point point
:remainder-id (random-uuid)}))]
(if-let [why (or (:refused where) (:refused result))]
{:db (-> db
(update :ui dissoc :convert)
(update :footage merge {:loading? false :status why}))}
(let [db (edit/edit-entry
db db
#(cond-> (bring/placed % clip (:store built) sid host frame uuid point) #(cond-> (assoc % :clip (:clip result) :store st)
tracked? (merge (select-keys built [:footage-id :source-blocks tracked? (merge (select-keys built [:footage-id :source-blocks
:source-inputs]))))] :source-inputs]))))]
{:db (-> db {:db (-> db
(update :ui dissoc :convert) (update :ui dissoc :convert)
(assoc-in [:ui :selection] [:node host uuid [uuid]]) (assoc-in [:ui :selection]
[:node (:sid where) uuid (conj (vec (:path where)) uuid)])
(update :footage merge (update :footage merge
{:loading? false {:loading? false
:status (str "made " name " · " imported-frames " frames at " fps " fps" :status (str "made " name " · " imported-frames " frames at " fps " fps"
@ -518,4 +536,4 @@
(str " · sampled from " source-fps " fps")) (str " · sampled from " source-fps " fps"))
(when-not tracked? (when-not tracked?
" · as drawings: this project already tracks other footage"))})) " · as drawings: this project already tracks other footage"))}))
:dispatch [::pb/refresh-clock]}))) :dispatch [::pb/refresh-clock]})))))

12
frontend/src/arthur/events/playback.cljs
View file

@ -190,6 +190,18 @@
{:db (-> db {:db (-> db
(update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid))) (update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid)))
(assoc-in [:ui :open] sid) (assoc-in [:ui :open] sid)
;; WHAT WAS SELECTED IS NOT IN HERE. A node selection and an
;; aimed target are paths in the symbol being left, and every
;; bar that reads one — the breadcrumb, the inspector, where a
;; new symbol would land — reads it against the open one. So
;; opening a symbol arrives with nothing selected, which is the
;; state the root crumb already means. A `[:symbol _]`
;; selection names a symbol rather than a place inside one and
;; survives.
(update :ui (fn [ui]
(cond-> (dissoc ui :target)
(= :node (first (:selection ui)))
(dissoc :selection))))
(update-in [:ui :trace :faces] #(trace/showing-for clip sid %)) (update-in [:ui :trace :faces] #(trace/showing-for clip sid %))
(assoc-in [:playback :frame] 0) (assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false)) (assoc-in [:playback :playing?] false))

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

@ -24,6 +24,7 @@
(:require [arthur.db :as db] (:require [arthur.db :as db]
[arthur.domain.bring :as bring] [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.span :as span]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
@ -34,6 +35,7 @@
[arthur.domain.wire :as wire] [arthur.domain.wire :as wire]
[arthur.events.footage :as footage] [arthur.events.footage :as footage]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.events.ui :as ui]
[arthur.footage.store :as store] [arthur.footage.store :as store]
[arthur.flow.address :as address] [arthur.flow.address :as address]
[arthur.flow.ingest :as ingest] [arthur.flow.ingest :as ingest]
@ -153,26 +155,38 @@
::import ::import
;; A symbol out of another saved project, dropped at `frame` of the open symbol ;; A symbol out of another saved project, dropped at `frame` of the open symbol
;; and, from the stage, with its middle on `point`. ;; and, from the stage, with its middle on `point`.
(fn [{:keys [db]} [_ carried frame point]] (fn [{:keys [db]} [_ carried frame point target]]
{:db (update db :project merge {:status (str "fetching " (:label carried) "…")}) {:db (update db :project merge {:status (str "fetching " (:label carried) "…")})
::import! (assoc (select-keys carried [:project :cid :symbol :label]) ::import! (assoc (select-keys carried [:project :cid :symbol :label])
:host (get-in db [:ui :open]) :frame frame :point point)})) :host (get-in db [:ui :open]) :frame frame :point point
:target target)}))
(rf/reg-event-fx (rf/reg-event-fx
::imported ::imported
;; As drawing: its tracking stays with the analysis that measured it. See ;; As drawing: its tracking stays with the analysis that measured it. See
;; `arthur.domain.bring`. ;; `arthur.domain.bring`.
(fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]] (fn [{:keys [db]} [_ {:keys [symbol frame point label target]} other]]
(let [sid (leaf/unsegment symbol) (let [entry (store/entry (:clip/current db))
sid (leaf/unsegment symbol)
uuid (random-uuid) uuid (random-uuid)
{:keys [clip ids]} (bring/symbols (:clip (store/entry (:clip/current db))) {:keys [clip ids]} (bring/symbols (:clip entry) (:clip other) [sid] {})
(:clip other) [sid] {}) st (merge (:store entry) (:store other))
db (edit/edit-entry db #(bring/placed % clip (:store other) (ids sid) ;; A symbol from another project arrives as an ordinary clip, the same
host frame uuid point))] ;; as one from this project's pool.
{:db (-> db where (ui/drop-destination db clip st frame target)
(assoc-in [:ui :selection] [:node host uuid [uuid]]) result (if (:refused where)
where
(span/place-symbol (:clip where) st (:sid where)
uuid (ids sid) (:at where)
{:extent :grow-symbol :point point
:remainder-id (random-uuid)}))]
(if-let [why (or (:refused where) (:refused result))]
{:db (update db :project merge {:status why})}
{:db (-> (edit/edit-entry db #(assoc % :clip (:clip result) :store st))
(assoc-in [:ui :selection]
[:node (:sid where) uuid (conj (vec (:path where)) uuid)])
(update :project merge {:status (str "brought in " label)})) (update :project merge {:status (str "brought in " label)}))
:dispatch [::pb/refresh-clock]}))) :dispatch [::pb/refresh-clock]}))))
(defn- clip-payload (defn- clip-payload
"One clip of a save. With `base` — the seq the open document last caught up "One clip of a save. With `base` — the seq the open document last caught up

504
frontend/src/arthur/events/ui.cljs
View file

@ -9,8 +9,8 @@
`lane-model.md` forbids in so many words: \"Selection does not secretly change `lane-model.md` forbids in so many words: \"Selection does not secretly change
where a new symbol goes.\" where a new symbol goes.\"
THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label, THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label
a cel-sheet column, or a breadcrumb is aiming — each names a place in the or a breadcrumb is aiming — each names a place in the
document and nothing else. A click on the stage, or on a timeline bar, is not: document and nothing else. A click on the stage, or on a timeline bar, is not:
it says look at this. So `::select` never writes the target, and `::aim` it says look at this. So `::select` never writes the target, and `::aim`
always writes both. always writes both.
@ -18,12 +18,12 @@
All of it is `assoc-in` under `:ui`. There is no effect in this namespace and All of it is `assoc-in` under `:ui`. There is no effect in this namespace and
there should not be one: an editor's own state is the cheapest thing in the 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." app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip] (:require [clojure.string :as str]
[arthur.domain.clip :as clip]
[arthur.domain.correction :as correction] [arthur.domain.correction :as correction]
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.lane :as lane]
[arthur.domain.span :as span] [arthur.domain.span :as span]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
@ -32,6 +32,17 @@
[arthur.footage.store :as store] [arthur.footage.store :as store]
[re-frame.core :as rf])) [re-frame.core :as rf]))
(rf/reg-event-db
::rename-node
(fn [db [_ sid id value]]
(let [document (:clip (store/entry (:clip/current db)))
value (not-empty (str/trim (str value)))]
(if-not (get-in document [:symbols sid :nodes id])
db
(edit/transaction db #(if value
(assoc-in % [:symbols sid :nodes id :name] value)
(update-in % [:symbols sid :nodes id] dissoc :name)))))))
(defn selected (defn selected
"`db` with `selection` selected, and nothing aimed. "`db` with `selection` selected, and nothing aimed.
@ -44,7 +55,7 @@
[:clip :symbols sid :nodes id :kind]))] [:clip :symbols sid :nodes id :kind]))]
(cond-> (-> db (cond-> (-> db
(assoc-in [:ui :selection] selection) (assoc-in [:ui :selection] selection)
(update :ui dissoc :points :lane-retry)) (update :ui dissoc :points :retry))
(and (= :node kind) path (not sound?)) (and (= :node kind) path (not sound?))
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))) (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path)))))))
@ -72,74 +83,39 @@
(rf/reg-event-db (rf/reg-event-db
::aim ::aim
;; The gestures that name a PLACE in the document rather than a thing on ;; The gestures that name a PLACE in the document rather than a thing on
;; screen: a timeline row label, a cel-sheet column, a breadcrumb. ;; screen: a timeline row label or a breadcrumb.
(fn [db [_ selection]] (aimed db selection))) (fn [db [_ selection]] (aimed db selection)))
(rf/reg-event-db (rf/reg-event-db
::aim-at ::aim-at
;; Aiming without selecting, for the cel sheet: the lane becomes where drawings ;; Aiming without selecting: the lane becomes where drawings go while the
;; go, and what is SELECTED stays whatever cel the sheet picked in it. ;; inspector selection remains independent.
(fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection)))) (fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection))))
(rf/reg-event-db (rf/reg-event-db
::set-tone ::set-tone
(fn [db [_ tone]] (assoc-in db [:ui :tone] tone))) (fn [db [_ tone]] (assoc-in db [:ui :tone] tone)))
(defn- aimed-lane (defn apply-command
"The lane the target names, or nil — including nil for a target aimed at a cel
INSIDE a lane, which is the lane's business and not a lane itself."
[clip db]
(let [{:keys [sid id path]} (get-in db [:ui :target])
n (when id (get-in clip [:symbols sid :nodes id]))]
(when (and n (node/lane? n) (= 1 (count path))
(= sid (get-in db [:ui :open])))
n)))
(defn aim-a-lane
"`db` with a lane of the open symbol aimed, if one is not aimed already.
THE CEL SHEET IS A DRAWING-LANE MODE, so being in it with nothing aimed is not
a state it has anything to say in: every cell belongs to a lane and every new
drawing goes in one. A symbol with no lane at all is the one honest exception,
and the view asks for one to be made rather than this inventing it."
[db]
(let [clip (:clip (store/entry (:clip/current db)))
open (get-in db [:ui :open])]
(if (aimed-lane clip db)
db
(if-let [lane (first (symbol/lanes (get-in clip [:symbols open :nodes])))]
(assoc-in db [:ui :target] {:sid open :id (:id lane) :path [(:id lane)]})
(update db :ui dissoc :target)))))
(rf/reg-event-db
::set-time-view
(fn [db [_ view]]
(if (#{:timeline :cel-sheet} view)
(cond-> (assoc-in db [:ui :time-view] view)
(= :cel-sheet view) aim-a-lane)
db)))
(rf/reg-event-db
::aim-a-lane
;; The cel sheet asks for this when what it had aimed has gone — the lane
;; deleted under it, or the open symbol changed beneath the view.
(fn [db _] (aim-a-lane db)))
(defn apply-lane-command
"Commit a successful domain command as one history step. A refused command "Commit a successful domain command as one history step. A refused command
leaves the document and history untouched; an overflow offers an explicit retry." leaves the document and history untouched; an overflow offers an explicit retry.
A COMMAND NEED NOT NAME A SELECTION. Emptying frames deletes what was selected
and has nothing sensible to put in its place, so a nil `:selection` leaves the
selection alone rather than pointing it at a clip nobody asked for."
[db sid result retry] [db sid result retry]
(if-let [why (:refused result)] (if-let [why (:refused result)]
(-> db (-> db
(assoc-in [:project :status] why) (assoc-in [:project :status] why)
(assoc-in [:ui :lane-retry] (assoc-in [:ui :retry] (when (:required-frames result) retry)))
(when (:required-frames result) retry)))
(let [[_ selected-sid _ path] (get-in db [:ui :selection]) (let [[_ selected-sid _ path] (get-in db [:ui :selection])
prefix (if (and (= sid selected-sid) (seq path)) (pop path) [])] prefix (if (and (= sid selected-sid) (seq path)) (pop path) [])]
(-> db (cond-> (-> db
(edit/transaction (constantly (:clip result))) (edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node sid (:selection result) (conj prefix (:selection result))]) (update :ui dissoc :retry))
(update :ui dissoc :lane-retry))))) (:selection result)
(assoc-in [:ui :selection]
[:node sid (:selection result) (conj prefix (:selection result))])))))
(defn apply-correction-command (defn apply-correction-command
"Commit one correction command while keeping the complete row address that "Commit one correction command while keeping the complete row address that
@ -173,17 +149,19 @@
db (correction/retry-layer clip sid id path layer-id))))) db (correction/retry-layer clip sid id path layer-id)))))
(rf/reg-event-db (rf/reg-event-db
::new-lane ::draw-as-lane
;; AND AIMED AT, because the reason to make a lane is to draw in it: `add-lane` ;; THE ONE PLACE A PERSON CAN ASK FOR THE IMPOSSIBLE. Everything else maintains
;; returns the new lane as its selection, and `apply-lane-command` has already ;; the sequence; this asks a symbol whose clips may already overlap to start
;; worked out the row path that addresses it. ;; being one. `span/draw-as-lane` refuses and says what it would have to trim,
(fn [db _] ;; and `::retry` is the one button that says do it.
(fn [db [_ sid on? trim?]]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
sid (get-in db [:ui :open]) result (span/draw-as-lane clip sid on? {:trim? trim?})]
after (apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil)] (if-let [why (:refused result)]
(cond-> after (-> db (assoc-in [:project :status] why)
(not= (get-in after [:ui :selection]) (get-in db [:ui :selection])) (assoc-in [:ui :retry] (when (:required-trim result) [::draw-as-lane sid on? true])))
(assoc-in [:ui :target] (target-of (get-in after [:ui :selection]))))))) (-> db (edit/transaction (constantly (:clip result)))
(update :ui dissoc :retry))))))
(defn- committed (defn- committed
"One appending command, as effects: commit it, and look at what it made. "One appending command, as effects: commit it, and look at what it made.
@ -198,23 +176,17 @@
{:keys [at rate]} (:time (nest/inside clip st (get-in db [:ui :open]) {:keys [at rate]} (:time (nest/inside clip st (get-in db [:ui :open])
(if (seq path) (pop path) []) (if (seq path) (pop path) [])
(get-in db [:playback :frame])))] (get-in db [:playback :frame])))]
(cond-> {:db (apply-lane-command db sid result retry)} (cond-> {:db (apply-command db sid result retry)}
(and (:clip result) (:frame result) rate) (and (:clip result) (:frame result) rate)
(assoc :dispatch [::playback/seek (+ at (/ (:frame result) rate))])))) (assoc :dispatch [::playback/seek (+ at (/ (:frame result) rate))]))))
(defn- selected-lane
"The lane a command should act in: the selected lane itself, or the one
holding the selected cel."
[clip sid id]
(let [n (get-in clip [:symbols sid :nodes id])]
(if (node/lane? n) id (:parent n))))
(defn selection-frame (defn selection-frame
"The playhead as a frame of the symbol that owns `selection`. "The playhead as a frame of the symbol that owns `selection`.
A timeline selection carries its path from the open symbol. Walking to the A timeline selection carries its path from the open symbol. Walking to the
parent of the selected node crosses every enclosing instance clock before a parent of the selected node crosses every enclosing instance clock, and that
lane command converts that owning-symbol frame into lane time." is the whole of it: a clip of a lane has no parent, so the symbol's own frames
ARE the sequence's. One clock where there used to be two."
[clip st open selection frame] [clip st open selection frame]
(let [[_ sid _ path] selection] (let [[_ sid _ path] selection]
(if (or (= sid open) (not (seq path))) (if (or (= sid open) (not (seq path)))
@ -226,8 +198,7 @@
(fn [{:keys [db]} [_ extent]] (fn [{:keys [db]} [_ extent]]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection]) [_ sid id] (get-in db [:ui :selection])
result (lane/append-drawing clip sid (selected-lane clip sid id) result (span/append-drawing clip sid (random-uuid) (clip/fresh-id clip)
(random-uuid) (clip/fresh-id clip)
{:extent (or extent :keep)})] {:extent (or extent :keep)})]
(committed db sid result [::append-drawing :grow-symbol])))) (committed db sid result [::append-drawing :grow-symbol]))))
@ -236,7 +207,7 @@
(fn [{:keys [db]} [_ extent]] (fn [{:keys [db]} [_ extent]]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection]) [_ sid id] (get-in db [:ui :selection])
result (lane/reuse-drawing clip sid (selected-lane clip sid id) (random-uuid) result (span/reuse-drawing clip sid (random-uuid)
(node/source (get-in clip [:symbols sid :nodes id])) (node/source (get-in clip [:symbols sid :nodes id]))
{:extent (or extent :keep)})] {:extent (or extent :keep)})]
(committed db sid result [::reuse-drawing :grow-symbol])))) (committed db sid result [::reuse-drawing :grow-symbol]))))
@ -246,27 +217,26 @@
(fn [{:keys [db]} [_ extent deep?]] (fn [{:keys [db]} [_ extent deep?]]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection]) [_ sid id] (get-in db [:ui :selection])
result (lane/duplicate-drawing clip sid id (random-uuid) result (span/duplicate-drawing clip sid id (random-uuid)
{:extent (or extent :keep) :deep? deep?})] {:extent (or extent :keep) :deep? deep?})]
(committed db sid result [::duplicate-drawing :grow-symbol deep?])))) (committed db sid result [::duplicate-drawing :grow-symbol deep?]))))
(rf/reg-event-fx (rf/reg-event-fx
::insert-drawing ::insert-drawing
;; The playhead is the position: you scrub to where the drawing goes. A lane ;; The playhead is the position: you scrub to where the drawing goes. The
;; that is stepped or retimed off whole frames has no single lane frame for a ;; symbol's own frames are the sequence's, so there is nothing to convert —
;; symbol frame, and `lane-frame` says so rather than snapping to one. ;; only an enclosing stepped or looping instance can leave the playhead on no
;; single frame of it, which `selection-frame` says by answering nil.
(fn [{:keys [db]} [_ extent]] (fn [{:keys [db]} [_ extent]]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection]) selection (get-in db [:ui :selection])
[_ sid id] selection [_ sid] selection
lane (selected-lane clip sid id) at (selection-frame clip st (get-in db [:ui :open]) selection
owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame])) (get-in db [:playback :frame]))
at (when (number? owner-frame) (lane/lane-frame clip sid lane owner-frame)) result (if (integer? at)
result (if at (span/append-drawing clip sid (random-uuid) (clip/fresh-id clip)
(lane/append-drawing clip sid lane (random-uuid) (clip/fresh-id clip)
{:at at :extent (or extent :keep)}) {:at at :extent (or extent :keep)})
{:refused "this lane's frames are not the open symbol's"})] {:refused "the playhead is not on one frame of this symbol"})]
(committed db sid result [::insert-drawing :grow-symbol])))) (committed db sid result [::insert-drawing :grow-symbol]))))
(defn- at-playhead (defn- at-playhead
@ -295,7 +265,7 @@
::split ::split
(fn [db _] (fn [db _]
(let [{:keys [clip sid id at]} (at-playhead db)] (let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command (apply-command
db sid (if at (span/split clip sid id at (random-uuid)) no-frame) nil)))) db sid (if at (span/split clip sid id at (random-uuid)) no-frame) nil))))
(rf/reg-event-fx (rf/reg-event-fx
@ -303,30 +273,28 @@
(fn [{:keys [db]} [_ extent]] (fn [{:keys [db]} [_ extent]]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection]) selection (get-in db [:ui :selection])
[_ sid id] selection [_ sid] selection
lane-id (selected-lane clip sid id) at (selection-frame clip st (get-in db [:ui :open]) selection
owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame])) (get-in db [:playback :frame]))
at (when (number? owner-frame) (lane/lane-frame clip sid lane-id owner-frame))
result (if (integer? at) result (if (integer? at)
(lane/overwrite-drawing clip sid lane-id (random-uuid) (clip/fresh-id clip) at (span/overwrite-drawing clip sid (random-uuid) (clip/fresh-id clip) at
{:extent (or extent :keep) {:extent (or extent :keep)
:remainder-id (random-uuid)}) :remainder-id (random-uuid)})
{:refused "this lane's frames are not the open symbol's"})] {:refused "the playhead is not on one frame of this symbol"})]
(committed db sid result [::overwrite-drawing :grow-symbol])))) (committed db sid result [::overwrite-drawing :grow-symbol]))))
(rf/reg-event-db (rf/reg-event-db
::trim ::trim
(fn [db [_ edge]] (fn [db [_ edge]]
(let [{:keys [clip sid id at]} (at-playhead db)] (let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command (apply-command
db sid (if at (span/trim clip sid id edge at) no-frame) nil)))) db sid (if at (span/trim clip sid id edge at) no-frame) nil))))
(rf/reg-event-db (rf/reg-event-db
::move ::move
(fn [db _] (fn [db _]
(let [{:keys [clip sid id at]} (at-playhead db)] (let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command (apply-command
db sid (if at (span/move clip sid id at) no-frame) nil)))) db sid (if at (span/move clip sid id at) no-frame) nil))))
(rf/reg-event-db (rf/reg-event-db
@ -336,10 +304,10 @@
(fn [db _] (fn [db _]
(let [{:keys [clip sid node]} (at-playhead db) (let [{:keys [clip sid node]} (at-playhead db)
span (node/placed-span node)] span (node/placed-span node)]
(apply-lane-command (apply-command
db sid (if (and span (every? integer? span)) db sid (if (and span (every? integer? span))
(lane/blank clip sid (:parent node) span {}) (span/blank clip sid span {})
{:refused "select a cel that starts and ends on whole lane frames"}) {:refused "select a clip that starts and ends on whole frames"})
nil)))) nil))))
(rf/reg-event-db (rf/reg-event-db
@ -347,43 +315,23 @@
(fn [db [_ deep?]] (fn [db [_ deep?]]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])] [_ sid id] (get-in db [:ui :selection])]
(apply-lane-command db sid (lane/make-unique clip sid id {:deep? deep?}) nil)))) (apply-command db sid (span/make-unique clip sid id {:deep? deep?}) nil))))
(rf/reg-event-db (rf/reg-event-db
::extend-hold ::extend-hold
(fn [db [_ delta extent]] (fn [db [_ delta extent]]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection]) [_ sid id] (get-in db [:ui :selection])
result (lane/extend-hold clip sid id delta {:extent (or extent :keep)})] result (span/extend-hold clip sid id delta {:extent (or extent :keep)})]
(apply-lane-command db sid result [::extend-hold delta :grow-symbol])))) (apply-command db sid result [::extend-hold delta :grow-symbol]))))
(rf/reg-event-fx (rf/reg-event-fx
::lane-retry ::retry
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
(if-let [event (get-in db [:ui :lane-retry])] (if-let [event (get-in db [:ui :retry])]
{:db (update db :ui dissoc :lane-retry) :dispatch event} {:db (update db :ui dissoc :retry) :dispatch event}
{}))) {})))
(rf/reg-event-db
::sheet-paste
(fn [db [_ sid lanes at payload]]
(let [clip (:clip (store/entry (:clip/current db)))]
(apply-lane-command db sid
(lane/paste-range clip sid lanes at payload random-uuid) nil))))
(rf/reg-event-db
::sheet-hold
(fn [db [_ sid id end extent]]
(let [clip (:clip (store/entry (:clip/current db)))
n (get-in clip [:symbols sid :nodes id])
at (lane/lane-frame clip sid (:parent n) end)
delta (when at (- at (second (node/placed-span n))))]
(if (= 0 delta) db
(apply-lane-command db sid
(if delta
(lane/extend-hold clip sid id delta {:extent (or extent :keep)})
{:refused "this lane's frames are not the open symbol's"})
[::sheet-hold sid id end :grow-symbol])))))
(rf/reg-event-db (rf/reg-event-db
::toggle-row ::toggle-row
@ -459,6 +407,19 @@
(= :instance (get-in clip [:symbols sid :nodes id :kind])) path (= :instance (get-in clip [:symbols sid :nodes id :kind])) path
:else (vec (butlast path))))) :else (vec (butlast path)))))
(defn aimed-symbol
"The symbol a command acts in and the path of rows down to it: `{:sid :path}`.
INSIDE the aimed instance, beside an aimed node of any other kind, the open
symbol when nothing is aimed — which is `where-new-goes`, resolved. There is
no lane to aim at any more: a lane is how a symbol is DRAWN, so what a gesture
names is a symbol, and whether that symbol is drawn as a lane is a separate
question `symbol/lane?` answers."
[clip st db frame]
(let [open (get-in db [:ui :open])
down (where-new-goes clip db)]
(assoc (nest/inside clip st open down frame) :path down)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; drawing a polygon ;; drawing a polygon
;; ;;
@ -479,63 +440,57 @@
(update-in db [:ui :draft] into [x y]) (update-in db [:ui :draft] into [x y])
db))) db)))
(defn into-the-lane (defn into-the-sequence
"Where a polygon drawn in the CEL SHEET goes: the row path of the cel the "Where a polygon drawn into a symbol DRAWN AS A LANE goes: the path of the held
aimed lane exposes at the playhead, and the clip that cel is in. `{:clip clip that symbol exposes at the playhead, and the document containing it.
:path}`, or `{:refused why}`. `{:clip :path}`, or `{:refused why}`.
A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The sheet is a drawing-lane mode A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The frame under the playhead is
and the frame under the playhead is where the drawing belongs, so drawing on where the drawing belongs, so drawing on an empty frame makes the one-frame
an empty frame makes the drawing that was missing — which is the whole reason held clip that was missing. The gesture already says what the removed drawing
there is no `new drawing` button any more: the gesture already says it. controls used to say.
`overwrite-drawing` rather than `append-drawing`, because a gap already has `overwrite-drawing` rather than `append-drawing`, because a gap already has
the room. Appending RIPPLES everything after it later by the new cel's the room. Appending RIPPLES everything after it later by the new clip's
duration — that is what `insert` means, and it is a different intention. duration — that is what `insert` means, and it is a different intention.
Placed into a gap, overwrite clears nothing and moves nobody. Placed into a gap, overwrite clears nothing and moves nobody.
A CEL'S PATH IS ONE STEP. `[cel]` and not `[lane cel]`: within one symbol the THE CLIP'S PATH IS THE SYMBOL'S PATH PLUS ONE STEP, because a clip of a lane
rows are flat and a cel is not a row at all, which is the same addressing is an ordinary row of the symbol holding it — which is the addressing `rows`
`rows` hands the timeline and `trail` reads back." hands the timeline and `trail` reads back."
[clip st db lane] [clip db {:keys [sid frame path]}]
(let [open (get-in db [:ui :open]) (let [exposed (when (integer? frame)
lane-id (:id lane)
owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame])))
at (when (number? owner) (lane/lane-frame clip open lane-id owner))
cel (when (integer? at)
(some (fn [c] (let [[lo hi] (node/placed-span c)] (some (fn [c] (let [[lo hi] (node/placed-span c)]
(when (and (<= lo at) (< at hi)) c))) (when (and (<= lo frame) (< frame hi)) c)))
(symbol/lane-cels (get-in clip [:symbols open :nodes]) lane-id)))] (symbol/children (get-in clip [:symbols sid :nodes]))))]
(cond (cond
(not (integer? at)) (not (integer? frame))
{:refused "the playhead is not on one frame of this lane"} {:refused "the playhead is not on one frame of this symbol"}
cel {:clip clip :path [(:id cel)]} exposed {:clip clip :path (conj (vec path) (:id exposed))}
:else :else
(let [cel-id (random-uuid) (let [cel-id (random-uuid)
made (lane/overwrite-drawing clip open lane-id cel-id (clip/fresh-id clip) at made (span/overwrite-drawing clip sid cel-id (clip/fresh-id clip) frame
{:extent :grow-symbol {:extent :grow-symbol
:remainder-id (random-uuid)})] :remainder-id (random-uuid)})]
(if (:refused made) made {:clip (:clip made) :path [cel-id]}))))) (if (:refused made) made {:clip (:clip made) :path (conj (vec path) cel-id)})))))
(defn polygon-landing (defn polygon-landing
"Choose the document and row path a finished polygon is drawn into. "Choose the document and row path a finished polygon is drawn into.
In the timeline this follows the explicit target. In the cel sheet the aimed WHERE IT GOES IS A SYMBOL, and what happens there follows how that symbol is
lane wins, regardless of what is selected on the stage: an occupied frame DRAWN: in one drawn as a lane an occupied frame lands in its clip and a gap
lands in its cel and a gap first becomes a drawing. Keeping this decision out first becomes a one-frame drawing, because the sequence is what says which
of the event handler makes the selection/target boundary a rule we can assert drawing the playhead is on. In an ordinary composition the polygon goes
without driving re-frame." straight into the symbol, as it always did."
[clip st db] [clip st db]
(if (= :cel-sheet (get-in db [:ui :time-view] :timeline)) (let [into (aimed-symbol clip st db (get-in db [:playback :frame]))]
(if-let [lane (aimed-lane clip db)] (if (and (:sid into) (symbol/lane? (clip/symbol clip (:sid into))))
(assoc (into-the-lane clip st db lane) :lane? true) (assoc (into-the-sequence clip db into) :lane? true)
{:refused "make a drawing lane to draw in — the cel sheet has none" {:clip clip :path (:path into) :lane? false})))
:lane? true})
{:clip clip :path (where-new-goes clip db) :lane? false}))
(defn beginning-polygon (defn beginning-polygon
"Enter polygon mode, first materializing the cel-sheet lane and drawing when "Enter polygon mode, first materializing a drawing at the playhead when the
either is missing. In the timeline this is editor state only. symbol it lands in is drawn as a lane and that frame is empty.
Creating here, rather than when the polygon is finished, means the drawing is Creating here, rather than when the polygon is finished, means the drawing is
already the current cel while points are being placed. Cancelling the polygon already the current cel while points are being placed. Cancelling the polygon
@ -543,20 +498,7 @@
[db] [db]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [{clip :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open]) open (get-in db [:ui :open])
sheet? (= :cel-sheet (get-in db [:ui :time-view] :timeline)) landing (polygon-landing clip st db)
no-lanes? (and sheet?
(empty? (symbol/lanes (get-in clip [:symbols open :nodes]))))
lane-id (when no-lanes? (random-uuid))
lane-result (if no-lanes?
(lane/add-lane clip open lane-id)
{:clip clip})
aimed-db (if (and no-lanes? (not (:refused lane-result)))
(assoc-in db [:ui :target]
{:sid open :id lane-id :path [lane-id]})
db)
landing (if-let [why (:refused lane-result)]
{:refused why :lane? true}
(polygon-landing (:clip lane-result) st aimed-db))
source (:clip landing) source (:clip landing)
made? (and source (not (identical? clip source))) made? (and source (not (identical? clip source)))
db' (cond db' (cond
@ -564,13 +506,13 @@
(update db :project merge {:status (:refused landing)}) (update db :project merge {:status (:refused landing)})
made? made?
(-> aimed-db (-> db
(edit/transaction (constantly source)) (edit/transaction (constantly source))
(assoc-in [:ui :selection] (assoc-in [:ui :selection]
[:node open [:node open
(peek (:path landing)) (:path landing)])) (peek (:path landing)) (:path landing)]))
:else aimed-db)] :else db)]
(if (:refused landing) (if (:refused landing)
db' db'
(update db' :ui merge {:tool :polygon :draft []})))) (update db' :ui merge {:tool :polygon :draft []}))))
@ -599,7 +541,7 @@
(nil? sid) (nil? sid)
(update db :project merge (update db :project merge
{:status (if (:lane? landing) {:status (if (:lane? landing)
"this lane is not on screen at this frame" "this sequence is not on screen at this frame"
"what you are drawing into is not on screen at this frame")}) "what you are drawing into is not on screen at this frame")})
;; `random-uuid` is the one impurity in this namespace, and it is here ;; `random-uuid` is the one impurity in this namespace, and it is here
;; rather than in `domain/paint` for the reason `clip/place-symbol` spells ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
@ -629,36 +571,61 @@
(declare record-auto-frame) (declare record-auto-frame)
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; a new symbol ;; a new symbol or lane
(defn- create-container
"Create and place one empty symbol. Lane creation is explicit: `lane?` marks
the new symbol for linear timeline display; ordinary symbol creation never
does. Both operations place the new symbol through the same span command, so
an explicitly aimed lane still applies its claim-time rule."
[db where lane?]
(let [{document :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
frame (get-in db [:playback :frame])
into (if (= :top where)
(assoc (nest/inside document st open [] frame) :path [])
(aimed-symbol document st db frame))
{host :sid at :frame down :path} into
sid (clip/fresh-id document)
instance-id (random-uuid)
end (clip/frames document host)
result (cond
(nil? host)
{:refused "what you are adding to is not on screen at this frame"}
(not (integer? at))
{:refused "the playhead is not on one frame of this symbol"}
(or (nil? end) (>= at end))
{:refused "the playhead is past the end of this symbol"}
:else
(let [new-symbol (cond-> {:id sid :name (name sid)
:fps (clip/fps document host)
:frames (- end at) :nodes {}}
lane? (assoc :display :lane))
seeded (assoc-in document [:symbols sid] new-symbol)]
(span/place-symbol seeded st host instance-id sid at
{:extent :grow-symbol
:remainder-id (random-uuid)})))]
(if-let [why (:refused result)]
(update db :project merge {:status why})
(let [selection [:node host instance-id (conj (vec down) instance-id)]]
(cond-> (-> db
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] selection)
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down))))
lane? (assoc-in [:ui :target] (target-of selection)))))))
(rf/reg-event-db (rf/reg-event-db
::new-symbol ::new-symbol
;; `where` is `:inside` — in whatever the target names — or `:top`, in the open
;; symbol regardless of it. Two items on one menu rather than a rule nobody can
;; see: `lane-model.md` asks that "creation controls next to the breadcrumb act
;; in that explicit location", and the honest way to offer the other location is
;; to offer it.
(fn [db [_ where]] (fn [db [_ where]]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (create-container db where false)))
down (if (= :top where) [] (where-new-goes clip db))
{host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down (rf/reg-event-db
(get-in db [:playback :frame])) ::new-lane
sid (clip/fresh-id clip) (fn [db _]
uuid (random-uuid)] ;; A lane is an explicit top-level track of the open symbol. It must not
(if-not host ;; become nested merely because the previously created lane is still aimed.
(update db :project merge (create-container db :top true)))
{:status "what you are adding to is not on screen at this frame"})
(let [made [:node host uuid (conj down uuid)]]
(-> db
(edit/transaction #(clip/new-symbol % host sid frame uuid))
;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the
;; next thing made goes in it; the outline says so before anybody
;; has to find out by drawing.
(aimed made)
;; Open every row down to it, or the new row is inside a closed one
;; and the button looks like it did nothing.
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down)))))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; a drop in flight ;; a drop in flight
@ -679,27 +646,101 @@
::drop-clear ::drop-clear
(fn [db _] (update db :ui dissoc :drop))) (fn [db _] (update db :ui dissoc :drop)))
(rf/reg-event-db (defn drop-destination
::drop-symbol "Which symbol a drop lands in and on which of its frames: `{:clip :sid :at
;; `point` is the stage pixel it was dropped on, or nil from the timeline. :path}`, or `{:refused why}`.
(fn [db [_ sid frame point]]
(let [uuid (random-uuid) ONE RULE AND EVERY DROP ASKS IT — a symbol from the pool, a sound, and a video
host (get-in db [:ui :open])] brought in as a take alike. The pointer names a ROW, `target`, and a row leads
into a symbol exactly where it names an instance, which is what `nest/inside`
already answers; with nothing under the pointer it is the open symbol. Nothing
is created to receive the drop: the symbol IS the container, so the first drop
into one is the same operation as the second.
`:clip` is handed back unchanged and is in the result only so the callers that
used to be given a document with a freshly made lane in it go on reading one
thing."
[db document st frame target]
(let [target (if (vector? target)
(let [[_ sid id path] target]
{:sid sid :id id :path path})
target)
open (get-in db [:ui :open])
path (cond
(nil? target) []
(= :instance (get-in document [:symbols (:sid target)
:nodes (:id target) :kind]))
(vec (:path target))
:else (vec (butlast (:path target))))
{:keys [sid] at :frame} (nest/inside document st open path frame)]
(cond
(nil? sid) {:refused "what you are dropping into is not on screen at this frame"}
(not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
:else {:clip document :sid sid :at at :path path})))
(defn landed
"`db` after a drop that produced `result`, with `uuid` selected."
[db {:keys [sid path]} uuid result]
(if-let [why (:refused result)]
(-> db (update :ui dissoc :drop) (update :project merge {:status why}))
(-> db (-> db
(update :ui dissoc :drop) (update :ui dissoc :drop)
(edit/edit-entry #(update % :clip clip/place-symbol (:store %) (edit/transaction (constantly (:clip result)))
host sid (* frame (:rate (clip/grid-time (:clip %) host))) uuid point)) (assoc-in [:ui :selection] [:node sid uuid (conj (vec path) uuid)]))))
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
(rf/reg-event-db
::drop-symbol
;; A symbol dropped on a row becomes a naturally playing clip in the symbol that
;; row leads into. Whether it claims the time it lands on is `span/place-symbol`'s
;; question and it answers it from the destination's display mode, so a drop onto
;; a lane trims its neighbour and a drop into a composition does not.
(fn [db [_ source-id frame point target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
where (drop-destination db document st frame target)
uuid (random-uuid)]
(if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
(landed db where uuid
(span/place-symbol (:clip where) st (:sid where)
uuid source-id (:at where)
{:extent :grow-symbol :point point
:remainder-id (random-uuid)}))))))
(rf/reg-event-db (rf/reg-event-db
::drop-sound ::drop-sound
(fn [db [_ {:keys [source label length rate]} frame]] ;; A SOUND IS A CLIP TOO. It is placed and then adopted rather than written
(let [uuid (random-uuid) ;; straight in, so one command owns where a sound's frames are —
host (get-in db [:ui :open])] ;; `clip/place-sound` — and one owns what claiming time means.
(-> db (fn [db [_ {:keys [source label length rate]} frame target]]
(update :ui dissoc :drop) (let [{document :clip st :store} (store/entry (:clip/current db))
(edit/edit #(clip/place-sound % host source label length rate (* frame (:rate (clip/grid-time % host))) uuid)) where (drop-destination db document st frame target)
(assoc-in [:ui :selection] [:node host uuid [uuid]]))))) uuid (random-uuid)]
(if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
(let [sid (:sid where)
seeded (clip/place-sound (:clip where) sid source label length rate
(* (:at where)
(:rate (clip/grid-time (:clip where) sid)))
uuid)]
(landed db where uuid
(span/adopt seeded sid uuid (:at where)
{:extent :grow-symbol :remainder-id (random-uuid)})))))))
(rf/reg-event-db
::drop-clip
;; A clip body is already materialized, so its whole drop is: resolve the
;; destination, then transfer it. `span/transfer` asks the destination whether
;; it claims time; this event does not know or care whether that is a lane.
(fn [db [_ [_ from-sid id _] target frame]]
(let [{document :clip st :store} (store/entry (:clip/current db))
where (drop-destination db document st frame target)
result (when-not (:refused where)
(span/transfer document from-sid id (:sid where) (:at where)
{:extent :grow-symbol
:remainder-id (random-uuid)}))]
(if-let [why (or (:refused where) (:refused result))]
(update db :project merge {:status why})
(landed db where id result)))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; moving rows between symbols ;; moving rows between symbols
@ -729,16 +770,23 @@
::sliding ::sliding
;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the ;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the
;; drag is abandoned. ;; drag is abandoned.
(fn [db [_ path df]] (fn [db [_ path df kind ripple? other]]
(if path (if path
(assoc-in db [:ui :sliding] {:path path :df df}) (assoc-in db [:ui :sliding] {:path path :df df :kind (or kind :slide)
:ripple? (boolean ripple?) :other other})
(update db :ui dissoc :sliding)))) (update db :ui dissoc :sliding))))
(rf/reg-event-db (rf/reg-event-db
::slide ::slide
(fn [db [_ path df]] (fn [db [_ path df kind ripple? other]]
(let [db (update db :ui dissoc :sliding) (let [db (update db :ui dissoc :sliding)
r (nest/slide (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]) path df)] clip (:clip (store/entry (:clip/current db)))
open (get-in db [:ui :open])
r (case kind
:out (nest/resize-out clip open path df ripple?)
:in (nest/resize-in clip open path df)
:roll (nest/roll clip open other path df)
(nest/slide clip open path df))]
(cond (cond
(zero? df) db (zero? df) db
(:refused r) (refused db (:refused r)) (:refused r) (refused db (:refused r))

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

@ -44,8 +44,12 @@
;; lets go, so the stage and the rows follow the pointer. Nothing is written ;; lets go, so the stage and the rows follow the pointer. Nothing is written
;; until then: one drag is one undo step and one write to collaborators. ;; until then: one drag is one undo step and one write to collaborators.
(let [c (:clip (footage/entry id))] (let [c (:clip (footage/entry id))]
(or (when-let [{:keys [path df]} sliding] (or (when-let [{:keys [path df kind ripple? other]} sliding]
(:clip (nest/slide c open path df))) (:clip (case kind
:out (nest/resize-out c open path df ripple?)
:in (nest/resize-in c open path df)
:roll (nest/roll c open other path df)
(nest/slide c open path df))))
(when-let [{:keys [sid id frame values]} gesture] (when-let [{:keys [sid id frame values]} gesture]
;; A held stage control owns the touched parameters completely. Make ;; A held stage control owns the touched parameters completely. Make
;; them temporary static channels for the preview, so their existing ;; them temporary static channels for the preview, so their existing

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

@ -13,8 +13,7 @@
(rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection])))
(rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) (rf/reg-sub ::target (fn [db _] (get-in db [:ui :target])))
(rf/reg-sub ::time-view (fn [db _] (get-in db [:ui :time-view] :timeline))) (rf/reg-sub ::retry (fn [db _] (get-in db [:ui :retry])))
(rf/reg-sub ::lane-retry (fn [db _] (get-in db [:ui :lane-retry])))
(rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone]))) (rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone])))
(rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool]))) (rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool])))
(rf/reg-sub ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?])))) (rf/reg-sub ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?]))))

30
frontend/src/arthur/ui/drag.cljs
View file

@ -57,8 +57,9 @@
(defn row! (defn row!
"Start carrying the timeline row at `path` — a node of kind `node-kind`, to be "Start carrying the timeline row at `path` — a node of kind `node-kind`, to be
moved into another symbol or grouped with another node." moved into another symbol or grouped with another node."
[path node-kind] [path node-kind selection]
(reset! carrying {:kind :row :path path :node-kind node-kind})) (reset! carrying {:kind :row :path path :node-kind node-kind
:selection selection}))
(defn row (defn row
"The path of the row being carried, or nil when it is not a row." "The path of the row being carried, or nil when it is not a row."
@ -70,6 +71,9 @@
[] []
(:node-kind @carrying)) (:node-kind @carrying))
(defn row-selection []
(when (= :row (:kind @carrying)) (:selection @carrying)))
(defn other! (defn other!
"Start carrying something that is not yet in the document: `:kind` says what, "Start carrying something that is not yet in the document: `:kind` says what,
and the rest is what a preview can show of it before it is fetched." and the rest is what a preview can show of it before it is fetched."
@ -85,11 +89,13 @@
(defn hover! (defn hover!
"Say where the drag would land, for the previews. `point` is nil over the "Say where the drag would land, for the previews. `point` is nil over the
timeline." timeline."
[where frame point] ([where frame point] (hover! where frame point nil))
([where frame point target]
(when-let [{:keys [kind label frames]} @carrying] (when-let [{:keys [kind label frames]} @carrying]
(rf/dispatch [::ui/drop-hover {:where where :frame frame :point point (rf/dispatch [::ui/drop-hover {:where where :frame frame :point point
:label label :frames frames :label label :frames frames
:sound? (= :sound kind)}]))) :target target
:sound? (= :sound kind)}]))))
(defn pos-for (defn pos-for
"Where the preview goes so the symbol's middle is under `point` — what "Where the preview goes so the symbol's middle is under `point` — what
@ -100,15 +106,17 @@
(defn land! (defn land!
"Drop what is being carried at `frame` of the open symbol: with its middle on "Drop what is being carried at `frame` of the open symbol: with its middle on
stage pixel `point`, or, with no point — the timeline — where it was drawn." stage pixel `point`, or, with no point — the timeline — where it was drawn."
[frame point] ([frame point] (land! frame point nil))
([frame point target]
(when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)] (when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)]
(case kind (case kind
:symbol (rf/dispatch [::ui/drop-symbol sid frame point]) :symbol (rf/dispatch [::ui/drop-symbol sid frame point target])
;; Video is asked about before anything happens: which frames, and what ;; Video is asked about before anything happens: which frames, and what
;; the symbol they become is called. ;; the symbol they become is called. The lane it was aimed at travels
:footage (rf/dispatch [::footage/ask-convert c frame point]) ;; with the question, so the answer lands where the drop pointed.
:import (rf/dispatch [::project/import c frame point]) :footage (rf/dispatch [::footage/ask-convert c frame point target])
:import (rf/dispatch [::project/import c frame point target])
;; Where it is dropped in time; a sound has no place in space. ;; Where it is dropped in time; a sound has no place in space.
:sound (rf/dispatch [::ui/drop-sound c frame]) :sound (rf/dispatch [::ui/drop-sound c frame target])
nil)) nil))
(done!)) (done!)))

5
frontend/src/arthur/ui/location.cljs
View file

@ -76,7 +76,8 @@
(map (fn [a] (map (fn [a]
(let [m (get nodes a)] (let [m (get nodes a)]
{:kind (:kind m) {:kind (:kind m)
:lane? (node/lane? m) :lane? (and (= :instance (:kind m))
(symbol/lane? (clip/symbol clip (node/source m))))
:sid in :id a :of (node/source m) :sid in :id a :of (node/source m)
:label (crumb-label clip a m) :label (crumb-label clip a m)
:select [:node in a (conj so-far a)]}))) :select [:node in a (conj so-far a)]})))
@ -199,5 +200,5 @@
", ignoring what is aimed") ", ignoring what is aimed")
:on-click #(rf/dispatch [::ui/new-symbol :top])} :on-click #(rf/dispatch [::ui/new-symbol :top])}
{:label "lane" {:label "lane"
:sub (str "a row of drawings in " (clip/symbol-name clip open)) :sub (str "a row for symbol clips in " (clip/symbol-name clip open))
:on-click #(rf/dispatch [::ui/new-lane])}]}]])) :on-click #(rf/dispatch [::ui/new-lane])}]}]]))

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

@ -14,6 +14,7 @@
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
[arthur.events.history :as history] [arthur.events.history :as history]
[arthur.events.paint :as paint-events] [arthur.events.paint :as paint-events]
@ -281,11 +282,10 @@
(defn- correction-section [[sid selected-id selected]] (defn- correction-section [[sid selected-id selected]]
(let [clip @(rf/subscribe [::render/clip]) (let [clip @(rf/subscribe [::render/clip])
parent (get-in clip [:symbols sid :nodes (:parent selected)]) lane-context? (or (symbol/lane? (clip-domain/symbol clip sid))
targets (cond (and (= :instance (:kind selected))
(node/lane? selected) [selected-id] (symbol/lane? (clip-domain/symbol clip (node/source selected)))))
(node/lane? parent) [selected-id (:id parent)] targets (if lane-context? [selected-id] [])]
:else [])]
(when (seq targets) (when (seq targets)
(r/with-let [draft (r/atom (correction-initial clip sid selected-id))] (r/with-let [draft (r/atom (correction-initial clip sid selected-id))]
(let [target (:target @draft) (let [target (:target @draft)
@ -303,7 +303,7 @@
(doall (for [[i id] (map-indexed vector targets)] (doall (for [[i id] (map-indexed vector targets)]
^{:key (str id)} ^{:key (str id)}
[:option {:value i} [:option {:value i}
(str (if (= id selected-id) "selected · " "lane · ") (brief id))]))]] (str "selected · " (brief id))]))]]
[:label.inspector-field "property" [:label.inspector-field "property"
[:select {:value (if (= [:xform :rot] (:path @draft)) "rotation" "position") [:select {:value (if (= [:xform :rot] (:path @draft)) "rotation" "position")
:on-change #(swap! draft assoc :path :on-change #(swap! draft assoc :path

893
frontend/src/arthur/ui/timeline.cljs
View file

File diff suppressed because it is too large Load diff

3
frontend/test/arthur/domain/bring_test.cljs
View file

@ -22,6 +22,7 @@
(is (= {:main :take :inner :inner-2} ids) (is (= {:main :take :inner :inner-2} ids)
"the root gets the name asked for; a taken id gets the next free one") "the root gets the name asked for; a taken id gets the next free one")
(is (= 10 (clip/frames clip :inner)) "what was already here is untouched") (is (= 10 (clip/frames clip :inner)) "what was already here is untouched")
(is (= #{:inner-2} (node/sources (first (vals (get-in clip [:symbols :take :nodes]))))) (is (= #{:inner-2} (node/sources (first (filter #(= :instance (:kind %))
(vals (get-in clip [:symbols :take :nodes]))))))
"and the copy's instance follows its renamed symbol") "and the copy's instance follows its renamed symbol")
(is (empty? (clip/problems clip))))) (is (empty? (clip/problems clip)))))

32
frontend/test/arthur/domain/correction_test.cljs
View file

@ -4,22 +4,22 @@
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.correction :as correction] [arthur.domain.correction :as correction]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.lane-test :as fixture])) [arthur.domain.sequence-test :as fixture]))
(defn- channel [doc id path] (defn- channel [doc id path]
(get-in doc [:symbols :main :nodes id :channels path])) (get-in doc [:symbols :main :nodes id :channels path]))
(deftest authors-the-three-motions-as-ordinary-layer-channels (deftest authors-the-three-motions-as-ordinary-layer-channels
(let [doc (fixture/document) (let [doc (fixture/document)
constant (correction/add doc :main :girl [:xform :rot] constant (correction/add doc :main :a [:xform :rot]
{:id :flat :support [2 5] :motion :constant :delta 1}) {:id :flat :support [2 5] :motion :constant :delta 1})
ramp (correction/add (:clip constant) :main :girl [:xform :rot] ramp (correction/add (:clip constant) :main :a [:xform :rot]
{:id :ramp :support [6 9] :motion :ramp :start 0 :end 2}) {:id :ramp :support [6 9] :motion :ramp :start 0 :end 2})
returned (correction/add (:clip ramp) :main :girl [:xform :rot] returned (correction/add (:clip ramp) :main :a [:xform :rot]
{:id :return :support [9 12] :motion :return {:id :return :support [9 12] :motion :return
:start 0 :peak 3 :peak-frame 10}) :start 0 :peak 3 :peak-frame 10})
c (channel (:clip returned) :girl [:xform :rot])] c (channel (:clip returned) :a [:xform :rot])]
(is (= :girl (:selection returned))) (is (= :a (:selection returned)))
(is (= [:flat :ramp :return] (mapv :id (:over c)))) (is (= [:flat :ramp :return] (mapv :id (:over c))))
(is (= [0 0 1 1 1 0 0 1 2 0 3 0] (is (= [0 0 1 1 1 0 0 1 2 0 3 0]
(mapv #(ch/value-at c % nil) (range 12)))) (mapv #(ch/value-at c % nil) (range 12))))
@ -47,19 +47,19 @@
put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3])) put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3]))
add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1])) add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1]))
stacked (assoc base :over [put3 add3]) stacked (assoc base :over [put3 add3])
doc (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos]] stacked)] doc (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos]] stacked)]
(is (:refused (correction/remove-layer doc :main :girl [:xform :pos] :put3)) (is (:refused (correction/remove-layer doc :main :a [:xform :pos] :put3))
"removing the replacement would expose a wrong-shaped base") "removing the replacement would expose a wrong-shaped base")
(let [conflicted (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict] (let [conflicted (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict]
"old topology") "old topology")
retried (correction/retry-layer conflicted :main :girl [:xform :pos] :add3)] retried (correction/retry-layer conflicted :main :a [:xform :pos] :add3)]
(is (:clip retried)) (is (:clip retried))
(is (nil? (get-in (:clip retried) (is (nil? (get-in (:clip retried)
[:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict])))) [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict]))))
(let [without-replacement (-> doc (let [without-replacement (-> doc
(assoc-in [:symbols :main :nodes :girl :channels [:xform :pos] :over] (assoc-in [:symbols :main :nodes :a :channels [:xform :pos] :over]
[(assoc add3 :conflict "old topology")]))] [(assoc add3 :conflict "old topology")]))]
(is (:refused (correction/retry-layer without-replacement :main :girl (is (:refused (correction/retry-layer without-replacement :main :a
[:xform :pos] :add3)) [:xform :pos] :add3))
"retry refuses when the current effective base still has the wrong shape")))) "retry refuses when the current effective base still has the wrong shape"))))
@ -74,13 +74,13 @@
(deftest corrections-round-trip-with-identity-support-and-order (deftest corrections-round-trip-with-identity-support-and-order
(let [doc (fixture/document) (let [doc (fixture/document)
one (:clip (correction/add doc :main :girl [:xform :rot] one (:clip (correction/add doc :main :a [:xform :rot]
{:id :one :support [0 3] :motion :constant :delta 1})) {:id :one :support [0 3] :motion :constant :delta 1}))
two (:clip (correction/add one :main :girl [:xform :rot] two (:clip (correction/add one :main :a [:xform :rot]
{:id :two :support [3 6] :motion :ramp {:id :two :support [3 6] :motion :ramp
:start 0 :end 2})) :start 0 :end 2}))
back (leaf/clip "u" (leaf/leaves "u" two))] back (leaf/clip "u" (leaf/leaves "u" two))]
(is (= two back)) (is (= two back))
(is (= [:one :two] (is (= [:one :two]
(mapv :id (get-in back [:symbols :main :nodes :girl (mapv :id (get-in back [:symbols :main :nodes :a
:channels [:xform :rot] :over])))))) :channels [:xform :rot] :over]))))))

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

@ -243,7 +243,7 @@
(is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide") (is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide")
(is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}} (is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}}
(clip/symbol made :symbol-1)) (clip/symbol made :symbol-1))
"empty, and as long as the rest of what it was placed in") "empty, ordinary, and as long as the rest of what it was placed in")
(is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}} (is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}}
(select-keys (get-in made [:symbols :outer :nodes u]) [:span :time]))) (select-keys (get-in made [:symbols :outer :nodes u]) [:span :time])))
(is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u]))) (is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u])))

561
frontend/test/arthur/domain/lane_test.cljs
View file

@ -1,561 +0,0 @@
(ns arthur.domain.lane-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.bring :as bring]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.lane :as lane]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn drawing [id x frames]
{:id id :frames frames
:nodes {:mark {:id :mark :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 4)
[:xform :pos] (ch/framed [x 0])}}}})
(defn cel [id source at duration speed]
{:id id :kind :instance :parent :girl :z (name id)
:source {:symbol source} :playback {:in 0 :speed speed :end :stop}
:time {:at at :rate 1} :span [0 duration]})
(defn document []
(let [a (cel :a :drawing-a 0 4 0)
b (assoc-in (cel :b :drawing-b 4 4 0)
[:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold))
insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)]
{:name "cels" :fps 24 :width 320 :height 200
:symbols
{:main {:id :main :frames 12
:nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}}
:a a :b b :insert insert
:plate {:id :plate :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 10)
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
:drawing-a (drawing :drawing-a 10 1)
:drawing-b (drawing :drawing-b 20 1)
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
(deftest sheet-copy-clips-without-resetting-source-or-local-keys
(let [doc (document)
payload (lane/sheet-range doc :main [:girl] [9 11])
copied (first (first (:columns payload)))
result (lane/paste-range doc :main [:girl] 1 payload random-uuid)
nodes (get-in (:clip result) [:symbols :main :nodes])
pasted (first (filter #(and (= :wave (node/source %))
(= [1 3] (node/placed-span %))) (vals nodes)))]
(is (= 2 (:duration payload)))
(is (= [1 3] (:span copied)))
(is (= (:playback copied) (:playback pasted)))
(is (= [1 3] (:span pasted)))
(is (= :wave (node/source pasted)))
(is (empty? (clip/problems (:clip result))))
(is (= [0 1] (node/placed-span (:a nodes))))
(is (some #(= [3 4] (node/placed-span %)) (vals nodes)))))
(deftest sheet-paste-preserves-gaps-and-refuses-overflow-and-incompatible-clocks
(let [doc (document)
gap (:clip (lane/blank doc :main :girl [1 3] {:id :remainder}))
payload (lane/sheet-range gap :main [:girl] [0 4])
result (lane/paste-range gap :main [:girl] 4 payload random-uuid)
cels (symbol/lane-cels (get-in (:clip result) [:symbols :main :nodes]) :girl)]
(is (empty? (clip/problems (:clip result))))
(is (not-any? #(let [[a b] (node/placed-span %)] (and (< a 7) (> b 5))) cels))
(is (:refused (lane/paste-range doc :main [:girl] 10 payload random-uuid)))
(is (:refused (lane/paste-range doc :main [] 0 payload random-uuid)))
(is (:refused (lane/sheet-range
(assoc-in doc [:symbols :main :nodes :girl :time] {:rate 2})
:main [:girl] [0 4])))))
(defn sample [doc fs]
(let [r (clip/resolver doc :main nil pal/index-of nil)]
(into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))
(deftest one-lane-mixes-held-drawings-and-playing-content
(let [doc (document) at (sample doc (range 12))]
(is (empty? (clip/problems doc)))
(is (= 40 (get-in at [3 [:a :mark]])))
(is (= 60 (get-in at [4 [:b :mark]])))
(is (= 72 (get-in at [5 [:b :mark]])))
(is (= 340 (get-in at [8 [:insert :mark]])))
(is (= 610 (get-in at [11 [:insert :mark]])))
(is (= (zipmap (range 12) (range -40 80 10))
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)))
(is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner")))
(deftest cel-ripple-keeps-lane-keys-and-moves-cel-corrections
(let [doc (document)
result (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})
after (:clip result)
nodes (get-in after [:symbols :main :nodes])]
(is (= :a (:selection result)))
(is (= 14 (get-in after [:symbols :main :frames])))
(is (= [0 6] (node/placed-span (:a nodes))))
(is (= [6 10] (node/placed-span (:b nodes))))
(is (= [10 14] (node/placed-span (:insert nodes))))
(doseq [id [:girl :a :b :insert :plate]]
(is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id))))
(is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id)))))
(let [at (sample after [5 6 7 10])]
(is (= 60 (get-in at [5 [:a :mark]])))
(is (= 80 (get-in at [6 [:b :mark]])))
(is (= 72 (get-in at [7 [:b :mark]])) "B's correction follows B")
(is (= 320 (get-in at [10 [:insert :mark]])) "insert starts on source frame 3"))
(is (empty? (clip/problems after)))
(is (= (assoc-in doc [:symbols :main :frames] 14)
(:clip (lane/extend-hold after :main :a -2 {})))
"shrinking restores content, except the explicitly grown shot")))
(deftest overflow-and-invalid-edits-are-atomic
(let [doc (document)
result (lane/extend-hold doc :main :a 2 {})]
(is (:refused result))
(is (= 14 (:required-frames result)))
(is (not (contains? result :clip)))
(doseq [delta [0 -4 0.5 js/NaN]]
(is (:refused (lane/extend-hold doc :main :a delta {}))))
(is (:refused (lane/extend-hold doc :main :insert 1 {})))
(is (:refused (lane/extend-hold doc :main :missing 1 {})))))
(deftest a-gap-is-an-uncovered-interval
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
at (sample doc [3 4 7 8])]
(is (= #{:plate} (set (keys (at 4)))))
(is (= #{:plate} (set (keys (at 7)))))
(is (get-in at [8 [:insert :mark]]))
(is (empty? (clip/problems doc)))))
(deftest validation-rejects-overlap-but-allows-empty-lanes
(is (some #(re-find #"overlap" %)
(clip/problems (assoc-in (document) [:symbols :main :nodes :b :time :at] 3))))
(is (empty? (clip/problems
(update-in (document) [:symbols :main :nodes] dissoc :a :b :insert))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf]))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1))))
(is (seq (node/problems {:id :old :kind :instance :z "a"
:channels {[:source] (ch/framed {:of :wave :in 0})}}))
"the obsolete format is rejected"))
(deftest playback-is-independent-of-property-channel-shape
(let [doc (document)
n (get-in doc [:symbols :main :nodes :a])
keyed (node/toggle-key n [:xform :rot] 0 nil)
unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)]
(doseq [n [n keyed unkeyed]]
(is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1))))
(let [n (get-in doc [:symbols :main :nodes :insert])]
(is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10)))
(is (nil? (node/placed-frame n 7 10)))
(is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10))))
(is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10)))))))
(deftest navigation-and-hit-testing-use-the-same-source-time
(let [doc (document)
n (get-in doc [:symbols :main :nodes :insert])]
(is (= 5 (:frame (nest/inside doc nil :main [:insert] 10))))
(is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10))))
(is (= 0 (:frame (nest/inside doc nil :main [:a] 3))))
(is (nil? (:time (nest/inside doc nil :main [:a] 3))))
(is (nil? (nest/inside doc nil :main [:a] 4)))
(is (= ((pick/bounds-of doc nil :main n) 2)
((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0)))))
(deftest seeking-and-source-reuse-do-not-share-cursors
(let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a)
fs [11 0 5 3 8 4 10 1 6 2 9 7]
at (sample doc fs)]
(is (= at (sample doc (reverse fs))))
(is (= at (sample doc (range 12))))
(let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]]
(ch/framed [99 0]))]
(is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]])))
(is (= 139 (get-in (sample edited [0 4]) [4 [:b :mark]]))))))
(deftest cel-identities-and-playback-round-trip
(let [doc (:clip (lane/extend-hold (document) :main :a 2 {:extent :grow-symbol}))
leaves (leaf/leaves :project doc)]
(is (= doc (leaf/clip :project leaves)))
(is (contains? leaves "clip/project/symbol/main/node/a"))
(is (not (contains? leaves "clip/project/symbol/main/channel/girl/source")))
(let [{copied :clip ids :ids}
(bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1))
doc [:main] {})]
(is (= :drawing-a-2 (:drawing-a ids)))
(is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids))))
(is (empty? (clip/problems copied))))))
(deftest one-transaction-undoes-the-ripple-and-shot-extension
(let [doc (document)
after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))
before-leaves (leaf/leaves :p doc)
after-leaves (leaf/leaves :p after)
h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle)
undo (history/undo h after-leaves)
redo (history/redo (:history undo) (:leaves undo))]
(is (= 1 (count (:done h))))
(is (= before-leaves (:leaves undo)))
(is (= after-leaves (:leaves redo)))))
(deftest create-lane-and-append-drawings
(let [doc (:clip (lane/add-lane (clip/blank) :main :girl))
a (:clip (lane/append-drawing doc :main :girl :a :drawing-a {}))
b (:clip (lane/append-drawing a :main :girl :b :drawing-b {}))]
(is (empty? (clip/problems b)))
(is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b]))))
(is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
(is (:refused (lane/append-drawing b :main :girl :a :new {})))))
(deftest fractional-placement-rates-convert-the-hold-delta
(let [doc (-> (document)
(assoc-in [:symbols :main :nodes :a :time :rate] 2)
(assoc-in [:symbols :main :nodes :a :span] [0 8]))
after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
(is (= [0 12] (get-in after [:symbols :main :nodes :a :span])))
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b]))))))
(deftest bare-shapes-agree-in-reference-and-playback
(let [sym (drawing :bare 12 1)]
(is (= (symbol/eval-frame sym 0 nil pal/index-of nil)
((symbol/resolver sym nil pal/index-of nil) 0))
"omitted style colour must not crash a missing cursor")))
(deftest audio-follows-only-the-playing-cel
(let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"}
:span [0 10]
:channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}}
doc (-> (document)
(assoc-in [:symbols :wave :nodes :voice] voice)
(assoc-in [:symbols :drawing-a :nodes :voice] voice))
[track :as tracks] (nest/audio-tracks doc :main)]
(is (= 1 (count tracks)) "the frozen drawing contributes no audio")
(is (= [8 12] (node/placed-span track)))
(is (= [3 7] (:span track)) "the source in-point trims the audio too")
(is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys])))
(let [moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))
[track] (nest/audio-tracks moved :main)]
(is (= [10 14] (node/placed-span track)))
(is (= [3 7] (:span track))))
(let [fast (-> doc
(assoc-in [:symbols :main :nodes :girl :time] {:at 2 :rate 2})
(assoc-in [:symbols :main :nodes :insert :playback :speed] 2))
[track] (nest/audio-tracks fast :main)]
(is (= [6 7.75] (node/placed-span track)))
(is (= [3 10] (:span track)))
(is (= 4 (get-in track [:time :rate]))))))
(deftest a-looped-insert-schedules-distinct-audio-intervals
(let [doc (-> (document)
(assoc-in [:symbols :wave :frames] 4)
(assoc-in [:symbols :wave :nodes :voice]
{:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]})
(assoc-in [:symbols :main :nodes :insert :playback]
{:in 3 :speed 1 :end :loop}))]
(is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main))))))
(deftest enclosing-retiming-is-respected-when-extending-the-shot
(let [doc (assoc-in (document) [:symbols :main :nodes :girl :time] {:at 8 :rate 2})
result (lane/extend-hold doc :main :a 2 {})]
(is (= 15 (:required-frames result)))
(is (nil? (:clip result)))
(is (= 15 (get-in (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})
[:clip :symbols :main :frames])))))
(deftest reuse-shares-content-and-make-unique-decouples-one-cel
(let [doc (document)
shared (:clip (lane/reuse-drawing doc :main :girl :c :drawing-a
{:extent :grow-symbol}))
edit (fn [c sym x]
(assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]]
(ch/framed [x 0])))]
(is (:refused (lane/reuse-drawing doc :main :girl :c :drawing-a {}))
"the shot has to be extended on purpose")
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c]))))
(is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c]))))
(is (empty? (clip/problems shared)))
;; One drawing, two cels: the edit arrives at both.
(let [at (sample (edit shared :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 99 (get-in at [12 [:c :mark]]))))
(let [unique (:clip (lane/make-unique shared :main :c {}))]
(is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c]))))
(is (= (:nodes (get-in shared [:symbols :drawing-a]))
(:nodes (get-in unique [:symbols :drawing-a-2])))
"a copy of the same drawing, not an empty one")
(is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a])))
"the other cel keeps the original")
(let [at (sample (edit unique :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched"))
(let [at (sample (edit unique :drawing-a-2 99) [0 12])]
(is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back"))
(is (empty? (clip/problems unique))))
;; Nothing else places drawing-b, so there is nothing to decouple from.
(is (:refused (lane/make-unique doc :main :b {})))
(is (:refused (lane/make-unique doc :main :girl {}))
"a lane places nothing itself")))
(deftest duplicate-copies-the-drawing-and-not-the-cel
(let [doc (document)
made (:clip (lane/duplicate-drawing doc :main :b :d {:extent :grow-symbol}))
n (get-in made [:symbols :main :nodes :d])]
(is (= :drawing-b-2 (node/source n)))
(is (= (:nodes (get-in doc [:symbols :drawing-b]))
(:nodes (get-in made [:symbols :drawing-b-2]))))
(is (= [12 13] (node/placed-span n)))
(is (= {:in 0 :speed 0 :end :stop} (:playback n)))
(is (nil? (:channels n)) "B's own position correction belongs to B's cel")
(is (= (get-in doc [:symbols :main :nodes :b])
(get-in made [:symbols :main :nodes :b]))
"the drawing duplicated is left as it was")
(is (empty? (clip/problems made)))))
(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them
;; A drawing assembled from another symbol: copying it shallowly must keep
;; using that part, and only an explicit deep copy may promise independence.
(let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part]
{:id :part :kind :instance :z "b" :span [0 1]
:time {:at 0 :rate 1} :source {:symbol :wave}
:playback {:in 0 :speed 0 :end :stop}})
copy (fn [opts] (:clip (lane/duplicate-drawing
doc :main :a :d (merge {:extent :grow-symbol} opts))))
shallow (copy {})
deep (copy {:deep? true})]
(is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part]))))
(is (nil? (get-in shallow [:symbols :wave-2])))
(is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part]))))
(is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2]))))
(is (empty? (clip/problems shallow)))
(is (empty? (clip/problems deep)))))
(deftest reuse-refuses-what-would-not-be-a-document
(let [doc (document)]
(is (:refused (lane/reuse-drawing doc :main :girl :c :nothing-here {})))
(is (:refused (lane/reuse-drawing doc :main :girl :c :main {:extent :grow-symbol}))
"a symbol cannot go inside itself")
(is (:refused (lane/reuse-drawing doc :main :girl :a :drawing-a {:extent :grow-symbol}))
"a cel ID in use is not free")
(is (:refused (lane/reuse-drawing doc :main :plate :c :drawing-a {})))
(is (:refused (lane/duplicate-drawing doc :main :girl :d {})))))
(deftest drawing-on-twos-does-not-quantize-the-lane-transform
;; Cel length IS the drawing cadence, and it is the only thing on twos
;; here: the lane's transform has its own clock and keeps moving every frame.
;; Stepping it would be the cel cadence leaking into continuous motion.
(let [cel (fn [id source at] (cel id source at 2 0))
doc (-> (document)
(update-in [:symbols :main :nodes] dissoc :a :b :insert)
(update-in [:symbols :main :nodes] merge
{:c0 (cel :c0 :drawing-a 0)
:c1 (cel :c1 :drawing-b 2)
:c2 (cel :c2 :drawing-a 4)}))
xs {:c0 10 :c1 20 :c2 10}
at (sample doc (range 6))
showing (fn [f] (first (dissoc (at f) :plate)))]
(is (empty? (clip/problems doc)))
(is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(first (key (showing %))) (range 6)))
"the drawing showing changes every second frame")
(is (= [0 10 20 30 40 50]
(mapv (fn [f] (let [[[id _] cx] (showing f)] (- cx (xs id)))) (range 6)))
"and the lane moves on every frame, odd ones included")))
(defn- drawn
"What every frame draws, as sorted values, so a picture can be compared
without naming the cels that produced it."
[doc fs]
(let [at (sample doc fs)]
(mapv #(sort (vals (get at %))) fs)))
(deftest a-drawing-goes-anywhere-in-the-lane-and-ripples-what-follows
(let [doc (document)
keys-of #(get-in % [:symbols :main :nodes :girl :channels [:xform :pos] :keys])
spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id])))
[:a :n :b :insert])
r (lane/append-drawing doc :main :girl :n :drawing-n
{:at 4 :extent :grow-symbol})]
(is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r))))
(is (= 13 (get-in r [:clip :symbols :main :frames])))
(is (= (keys-of doc) (keys-of (:clip r))) "lane keys stay where they were authored")
(is (= :n (:selection r)))
(is (= 4 (:frame r)))
(is (empty? (clip/problems (:clip r))))
;; The same command with no room refuses, and says how much it needs.
(is (= 13 (:required-frames (lane/append-drawing doc :main :girl :n :drawing-n {:at 4}))))
;; At the very front everything moves.
(is (= [[1 5] [0 1] [5 9] [9 13]]
(spans (:clip (lane/append-drawing doc :main :girl :n :drawing-n
{:at 0 :extent :grow-symbol})))))
;; Inside a cel is not a position for another one.
(is (re-find #"split it first"
(:refused (lane/append-drawing doc :main :girl :n :drawing-n
{:at 2 :extent :grow-symbol}))))
(is (:refused (lane/append-drawing doc :main :girl :n :drawing-n
{:at -1 :extent :grow-symbol})))
(is (:refused (lane/append-drawing doc :main :girl :n :drawing-n
{:at ##Inf :extent :grow-symbol})))
;; Reuse and duplicate take a position too; it is one placement rule.
(is (= [4 5] (node/placed-span
(get-in (lane/reuse-drawing doc :main :girl :n :drawing-b
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))
(is (= [4 5] (node/placed-span
(get-in (lane/duplicate-drawing doc :main :b :n
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))))
(deftest split-then-place-puts-a-drawing-inside-a-hold
;; The two commands the doc asks for, composed: neither one guesses.
(let [doc (document)
cut (:clip (span/split doc :main :a 2 :right))
r (lane/append-drawing cut :main :girl :n :drawing-n
{:at 2 :extent :grow-symbol})
after (:clip r)]
(is (= [[0 2] [2 3] [3 5] [5 9] [9 13]]
(mapv #(node/placed-span (get-in after [:symbols :main :nodes %]))
[:a :n :right :b :insert])))
(is (= (get-in doc [:symbols :main :nodes :girl :channels])
(get-in after [:symbols :main :nodes :girl :channels]))
"the performance is still timed the way it was authored")
(is (empty? (clip/problems after)))))
(deftest a-three-frame-correction-crosses-a-drawing-boundary
;; The lane model's worked example. The correction belongs to the GIRL, so it
;; applies across whichever drawings are showing under it, and outside its
;; three frames the animation evaluates exactly as it did before.
(let [doc (document)
fs (range 12)
before (drawn doc fs)
beat (ch/layer :beat [3 6] :offset (ch/framed [30 0]))
c (update-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over]
(fnil conj []) beat)
after (drawn c fs)
outside [0 1 2 6 7 8 9 10 11]]
(is (empty? (clip/problems c)))
(is (= (mapv before outside) (mapv after outside))
"outside the support, frame for frame identical")
(let [at (sample c [3 4 5])]
;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one
;; correction, reaching across the cut between them.
(is (= 70 (get-in at [3 [:a :mark]])))
(is (= 90 (get-in at [4 [:b :mark]])))
(is (= 102 (get-in at [5 [:b :mark]])) "and B's own correction still applies under it")
(is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5]))
"while the background, which is not in the lane, does not move"))
;; One document change: one step, and it persists in the channel's own leaf.
(let [b (leaf/leaves :p doc)
a (leaf/leaves :p c)
h (-> nil history/hold (history/record b a 0) history/settle)]
(is (= 1 (count (:done h))))
(is (= b (:leaves (history/undo h a))))
(is (= c (leaf/clip :p a)) "a correction needs no codec of its own"))))
(deftest a-correction-on-one-cel-travels-with-it
;; The other half of ownership: a layer on a cel is in that
;; cel's own frames, so moving the cel moves the correction and
;; nothing has to say so.
(let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0]))
doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over]
(fnil conj []) beat)
moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
;; Stated as the difference from the same document without the correction,
;; so the claim is about WHERE the layer applies and not about arithmetic.
(let [nudge (fn [with without f]
(- (get-in (sample with [f]) [f [:b :mark]])
(get-in (sample without [f]) [f [:b :mark]])))]
(is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7]))
"B's first two frames, which are lane frames 4 and 5")
(is (= [7 7 0 0]
(mapv #(nudge moved (:clip (lane/extend-hold (document) :main :a 2
{:extent :grow-symbol}))
%)
[6 7 8 9]))
"and after A's hold grows, B's first two frames, which are now 6 and 7"))
(is (= (get-in doc [:symbols :main :nodes :b :channels])
(get-in moved [:symbols :main :nodes :b :channels]))
"the layer itself was not touched by the retiming")
(is (empty? (clip/problems moved)))))
(defn- spans [clip ids]
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids))
(deftest blanking-leaves-a-gap-and-does-not-close-it
(let [doc (document)
r (lane/blank doc :main :girl [5 7] {:id :rest})
after (:clip r)]
;; B spanned the range, so it became two cels with a hole between them.
(is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert])))
(is (= :rest (:selection r)))
(let [at (sample after [4 5 6 7])]
(is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame")
(is (= #{:plate} (set (keys (at 6)))))
(is (get-in at [4 [:b :mark]]))
(is (get-in at [7 [:rest :mark]])))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing
(let [doc (document)
after (:clip (lane/blank doc :main :girl [4 8] {}))]
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing")
(is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b]))
"a lane does not own its content")
(is (empty? (clip/problems after)))))
(deftest blanking-a-range-trims-what-it-only-partly-covers
(let [doc (document)
after (:clip (lane/blank doc :main :girl [3 9] {}))]
(is (= [[0 3] [9 12]] (spans after [:a :insert])))
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= (get-in (sample doc [9]) [9 [:insert :mark]])
(get-in (sample after [9]) [9 [:insert :mark]]))
"the insert kept its own frames, so frame 9 shows what it showed")
(is (empty? (clip/problems after)))))
(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows
(let [r (lane/overwrite-drawing (document) :main :girl :n :drawing-n 5
{:extent :keep :remainder-id :right})
after (:clip r)
nodes (get-in after [:symbols :main :nodes])]
(is (= :n (:selection r)))
(is (= [[0 4] [4 5] [5 6] [6 8] [8 12]]
(mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert])))
(is (= :drawing-b (node/source (:right nodes))))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blank-refuses-what-it-cannot-do-in-one-piece
(let [doc (document)]
(is (re-find #"free ID" (:refused (lane/blank doc :main :girl [5 7] {})))
"splitting a cel needs an ID for the remainder")
(is (:refused (lane/blank doc :main :girl [5 7] {:id :a})) "and a free one")
(is (:refused (lane/blank doc :main :girl [7 5] {})))
(is (:refused (lane/blank doc :main :girl [5 5] {})))
(is (:refused (lane/blank doc :main :girl [5 6.5] {})))
(is (:refused (lane/blank doc :main :plate [0 2] {})))))
(deftest the-shot-length-is-authored-and-emptying-a-lane-does-not-shorten-it
;; The window and the occupied extent are two facts. A shot with nothing in
;; the last half is a shot somebody authored that long, and deleting the last
;; drawing must not quietly shorten the film.
(let [doc (document)
empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))]
(is (empty? (symbol/lane-cels (get-in empty-lane [:symbols :main :nodes]) :girl)))
(is (= 12 (get-in empty-lane [:symbols :main :frames])))
(is (empty? (clip/problems empty-lane)))
;; Growing is still the caller's word, and only ever grows.
(is (:refused (lane/append-drawing empty-lane :main :girl :n :drawing-n {:at 20})))
(is (= 21 (get-in (lane/append-drawing empty-lane :main :girl :n :drawing-n
{:at 20 :extent :grow-symbol})
[:clip :symbols :main :frames])))
(is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9))
[:symbols :main :frames]))
"and trimming the last cel leaves the window where it was")))

22
frontend/test/arthur/domain/nest_test.cljs
View file

@ -170,7 +170,8 @@
inst (get-in grouped [:symbols :main :nodes b-uuid])] inst (get-in grouped [:symbols :main :nodes b-uuid])]
(is (nil? (:refused r)) (:refused r)) (is (nil? (:refused r)) (:refused r))
(is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes]))))) (is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes])))))
(is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were") (is (= [b-uuid] (keys (dissoc (get-in grouped [:symbols :main :nodes]) :lane)))
"one instance where they were")
(is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts") (is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts")
(is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends") (is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends")
(is (= (picture c :main fs) (picture grouped :main fs))) (is (= (picture c :main fs) (picture grouped :main fs)))
@ -222,6 +223,25 @@
:main [a-uuid :inner] 3)) :main [a-uuid :inner] 3))
"but through a loop one frame outside is many inside"))) "but through a loop one frame outside is many inside")))
(deftest linked-audio-follows-picture-moves-but-keeps-independent-edges
(let [c (-> (clip/blank)
(assoc-in [:symbols :drawing] {:id :drawing :frames 8 :nodes {}})
(clip/place-symbol nil :main :drawing 2 :picture nil)
(clip/place-sound :main {:sound "voice"} "voice" 8 1 2 :voice)
(assoc-in [:symbols :main :nodes :voice :linked-to] :picture))
moved (:clip (nest/slide c :main [:picture] 3))
audio-only (:clip (nest/slide c :main [:voice] 1))
trimmed (:clip (nest/resize-out c :main [:voice] -2 false))]
(is (= [5 13] (node/placed-span (get-in moved [:symbols :main :nodes :picture]))))
(is (= [5 13] (node/placed-span (get-in moved [:symbols :main :nodes :voice])))
"moving picture carries its linked audio")
(is (= [2 10] (node/placed-span (get-in audio-only [:symbols :main :nodes :picture]))))
(is (= [3 11] (node/placed-span (get-in audio-only [:symbols :main :nodes :voice])))
"moving audio itself does not carry picture")
(is (= [2 8] (node/placed-span (get-in trimmed [:symbols :main :nodes :voice])))
"an audio endpoint trims independently")
(is (= [2 10] (node/placed-span (get-in trimmed [:symbols :main :nodes :picture]))))))
(deftest restacking-is-one-write-to-z (deftest restacking-is-one-write-to-z
(let [shape (fn [z] {:kind :poly :z z :channels {}}) (let [shape (fn [z] {:kind :poly :z z :channels {}})
c (-> (clip/blank) c (-> (clip/blank)

859
frontend/test/arthur/domain/sequence_test.cljs Normal file
View file

@ -0,0 +1,859 @@
(ns arthur.domain.sequence-test
"The commands that need a SEQUENCE, which is now a symbol drawn as a lane and
its own children rather than a group with `:layout :sequence`. Was
`lane_test`; the fixtures changed and the assertions did not, except where
they are called out below as behaviour that changed on purpose."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.bring :as bring]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn drawing [id x frames]
{:id id :frames frames
:nodes {:mark {:id :mark :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 4)
[:xform :pos] (ch/framed [x 0])}}}})
(defn cel
"A clip of the sequence. PARENTLESS, because the symbol is the container."
[id source at duration speed]
{:id id :kind :instance :z (name id)
:source {:symbol source} :playback {:in 0 :speed speed :end :stop}
:time {:at at :rate 1} :span [0 duration]})
(defn document
"`:main`, drawn as a lane, holding three clips and a background shape.
`:plate` HAS NO SPAN, so it is on screen for the whole shot and is not in the
sequence at all — which is what `symbol/children` skips, and the reason an
ordinary shape sitting in a lane symbol is not something an edge edit can trim."
[]
(let [a (cel :a :drawing-a 0 4 0)
b (assoc-in (cel :b :drawing-b 4 4 0)
[:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold))
insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)]
{:name "cels" :fps 24 :width 320 :height 200
:symbols
{:main {:id :main :frames 12 :display :lane
:nodes {:a a :b b :insert insert
:plate {:id :plate :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 10)
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
:drawing-a (drawing :drawing-a 10 1)
:drawing-b (drawing :drawing-b 20 1)
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
(defn shot
"`doc` with `:main` placed in a containing symbol as the instance `:girl`,
carrying the keyed transform the LANE GROUP used to carry, and the plate moved
out to be the background that is not in the sequence.
THE PLACING INSTANCE IS WHERE THE LANE'S TRANSFORM WENT. A lane was a group
and could be animated; a symbol cannot, so what moves a whole sequence is now
the instance that places it. These are the tests that used to animate `:girl`
the group and now animate `:girl` the instance — the same six keys, and the
same answer frame for frame."
[doc]
(-> doc
(update-in [:symbols :main :nodes] dissoc :plate)
(assoc-in [:symbols :shot]
{:id :shot :frames 12 :fps 24
:nodes {:girl {:id :girl :kind :instance :z "b" :span [0 12]
:time {:mode :map :at 0 :rate 1}
:source {:symbol :main}
:playback {:in 0 :speed 1 :end :stop}
:channels {[:xform :pos]
(ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}}
:plate (get-in doc [:symbols :main :nodes :plate])}})))
(defn sample-in [doc sid fs]
(let [r (clip/resolver doc sid nil pal/index-of nil)]
(into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))
(defn sample [doc fs] (sample-in doc :main fs))
(deftest one-sequence-mixes-held-drawings-and-playing-content
(let [doc (document) at (sample doc (range 12))]
(is (empty? (clip/problems doc)))
(is (= 10 (get-in at [3 [:a :mark]])))
(is (= 20 (get-in at [4 [:b :mark]])))
(is (= 22 (get-in at [5 [:b :mark]])))
(is (= 300 (get-in at [8 [:insert :mark]])))
(is (= 600 (get-in at [11 [:insert :mark]])))
(is (= (zipmap (range 12) (range -40 80 10))
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)))
(is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner")))
(deftest the-placing-instance-animates-the-whole-sequence
;; What `:girl` the lane group used to do, `:girl` the instance does: one
;; transform over whichever drawing is showing under it, every frame.
(let [doc (shot (document)) at (sample-in doc :shot (range 12))]
(is (empty? (clip/problems doc)))
(is (= 40 (get-in at [3 [:girl :a :mark]])))
(is (= 60 (get-in at [4 [:girl :b :mark]])))
(is (= 72 (get-in at [5 [:girl :b :mark]])))
(is (= 340 (get-in at [8 [:girl :insert :mark]])))
(is (= 610 (get-in at [11 [:girl :insert :mark]])))
(is (= (zipmap (range 12) (range -40 80 10))
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at))
"and the background, which is not in the sequence, does not move with it")))
(deftest cel-ripple-keeps-the-containers-keys-and-moves-cel-corrections
(let [doc (shot (document))
result (span/extend-hold doc :main :a 2 {:extent :grow-symbol})
after (:clip result)
nodes (get-in after [:symbols :main :nodes])]
(is (= :a (:selection result)))
(is (= 14 (get-in after [:symbols :main :frames])))
(is (= [0 6] (node/placed-span (:a nodes))))
(is (= [6 10] (node/placed-span (:b nodes))))
(is (= [10 14] (node/placed-span (:insert nodes))))
(doseq [id [:a :b :insert]]
(is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id))))
(is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id)))))
(is (= (get-in doc [:symbols :shot :nodes :girl])
(get-in after [:symbols :shot :nodes :girl]))
"re-spanning a sequence does not touch what places it")
(let [at (sample-in after :shot [5 6 7 10])]
(is (= 60 (get-in at [5 [:girl :a :mark]])))
(is (= 80 (get-in at [6 [:girl :b :mark]])))
(is (= 72 (get-in at [7 [:girl :b :mark]])) "B's correction follows B")
(is (= 320 (get-in at [10 [:girl :insert :mark]])) "insert starts on source frame 3"))
(is (empty? (clip/problems after)))
(is (= (assoc-in doc [:symbols :main :frames] 14)
(:clip (span/extend-hold after :main :a -2 {})))
"shrinking restores content, except the explicitly grown shot")))
(deftest overflow-and-invalid-edits-are-atomic
(let [doc (document)
result (span/extend-hold doc :main :a 2 {})]
(is (:refused result))
(is (= 14 (:required-frames result)))
(is (not (contains? result :clip)))
(doseq [delta [0 -4 0.5 js/NaN]]
(is (:refused (span/extend-hold doc :main :a delta {}))))
(is (:refused (span/extend-hold doc :main :insert 1 {})))
(is (:refused (span/extend-hold doc :main :missing 1 {})))
(is (:refused (span/extend-hold (update-in doc [:symbols :main] dissoc :display)
:main :a 2 {:extent :grow-symbol}))
"lengthening a hold is a sequence edit, so it needs a symbol drawn as one")))
(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them
(let [doc (document)
clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes])))
plain (:clip (span/resize-out doc :main :a 6 {}))
across (:clip (span/resize-out doc :main :a 9 {}))
ripple (:clip (span/resize-out doc :main :a 6 {:ripple? true
:extent :grow-symbol}))
shrink (:clip (span/resize-out doc :main :a 2 {:ripple? true}))]
(is (= [[0 6] [6 8] [8 12]] (clips plain))
"a normal grow eats the beginning of the adjacent cel")
(is (= [[0 9] [9 12]] (clips across))
"a long grow removes wholly consumed cels and trims the survivor")
(is (= [[0 6] [6 10] [10 14]] (clips ripple))
"shift-grow moves every later cel")
(is (= [[0 2] [2 6] [6 10]] (clips shrink))
"shift-shrink pulls every later cel left")
(is (:refused (span/resize-out doc :main :a 0 {})))
(is (:refused (span/resize-out doc :main :a 2.5 {})))))
(deftest outside-lane-mode-an-edge-edit-disturbs-nothing
;; The claim-time rule FOLLOWS THE MODE. The same document not drawn as a lane
;; is a composition, and things in a composition are allowed to be on screen
;; together — so growing one clip over another simply does that.
(let [doc (update-in (document) [:symbols :main] dissoc :display)
after (:clip (span/resize-out doc :main :a 6 {}))
nodes (get-in after [:symbols :main :nodes])]
(is (= [0 6] (node/placed-span (:a nodes))))
(is (= [4 8] (node/placed-span (:b nodes))) "the neighbour is left exactly as it was")
(is (= 1 (count (symbol/overlaps (get-in after [:symbols :main])))))
(is (empty? (clip/problems after)) "and an overlap is not a reason a document will not load")))
(deftest the-middle-of-a-cut-rolls-both-edges
(let [doc (document)
clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes])))
rolled (:clip (span/roll doc :main :a :b 6))
right-only (:clip (span/resize-in doc :main :b 6))
grown-left (:clip (span/resize-in doc :main :b 2))]
(is (= [[0 6] [6 8] [8 12]] (clips rolled))
"the shared cut moves without moving either clip")
(is (= [[0 4] [6 8] [8 12]] (clips right-only))
"the right side of the junction trims only the right clip")
(is (= [[0 2] [2 8] [8 12]] (clips grown-left))
"growing the right clip left trims the neighbour instead of overlapping")
(is (:refused (span/roll doc :main :a :b 0)))
(is (:refused (span/roll doc :main :a :insert 6)))
(is (:refused (span/roll (update-in doc [:symbols :main] dissoc :display) :main :a :b 6))
"a roll is a sequence edit")))
(deftest a-gap-is-an-uncovered-interval
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
at (sample doc [3 4 7 8])]
(is (= #{:plate} (set (keys (at 4)))))
(is (= #{:plate} (set (keys (at 7)))))
(is (get-in at [8 [:insert :mark]]))
(is (empty? (clip/problems doc)))))
(deftest an-overlap-is-a-bug-report-and-not-a-reason-not-to-load
;; It used to be `clip/problems`, which means the document will not load. A
;; display hint must never be able to do that, so it is its own diagnostic.
(let [clashing (assoc-in (document) [:symbols :main :nodes :b :time :at] 3)]
(is (= [[:a :b]] (symbol/overlaps (get-in clashing [:symbols :main]))))
(is (empty? (clip/problems clashing))
"and the document still loads, to be drawn visibly wrong")
(is (empty? (symbol/overlaps (get-in (document) [:symbols :main]))))
(is (empty? (clip/problems
(update-in (document) [:symbols :main :nodes] dissoc :a :b :insert)))
"an empty sequence is valid — a shot is authored before it is filled")
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf]))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :layout] :sequence)))
":layout is not a node field any more")
(is (seq (node/problems {:id :old :kind :instance :z "a"
:channels {[:source] (ch/framed {:of :wave :in 0})}}))
"the obsolete format is rejected")))
(deftest no-command-can-commit-an-overlap
;; THE INVARIANT, ASSERTED OVER THE COMMANDS rather than reasoned about: every
;; one of them commits through `span/finish`, so sampling them is enough.
;; Sampled, in the style of `drawn`, rather than computing expected spans by
;; hand — what is being claimed is that no result holds an overlap, whatever
;; the numbers are.
(let [doc (document)
every-command
(concat
(for [to (range -1 15)] #(span/resize-out % :main :a to {:extent :grow-symbol}))
(for [to (range -1 15)] #(span/resize-out % :main :b to {:ripple? true :extent :grow-symbol}))
(for [to (range -1 15)] #(span/resize-in % :main :b to))
(for [to (range -1 15)] #(span/roll % :main :a :b to))
(for [cut (range -1 15)] #(span/split % :main :insert cut :piece))
(for [to (range -1 15)] #(span/trim % :main :insert :out to))
(for [to (range -1 15)] #(span/move % :main :insert to))
(for [d (range -5 6)] #(span/extend-hold % :main :a d {:extent :grow-symbol}))
(for [a (range 0 13) b (range 0 13)] #(span/blank % :main [a b] {:id :rest}))
(for [at (range -1 15)] #(span/append-drawing % :main :n :drawing-n
{:at at :extent :grow-symbol}))
(for [at (range -1 15)] #(span/reuse-drawing % :main :n :drawing-b
{:at at :extent :grow-symbol}))
(for [at (range -1 15)] #(span/duplicate-drawing % :main :b :n
{:at at :extent :grow-symbol}))
(for [at (range -1 15)] #(span/overwrite-drawing % :main :n :drawing-n at
{:extent :grow-symbol
:remainder-id :rest}))
(for [at (range -1 15)] #(span/place-symbol % nil :main :n :wave at
{:extent :grow-symbol
:remainder-id :rest}))
(for [at (range -1 15)] #(span/adopt % :main :b at {:extent :grow-symbol
:remainder-id :rest}))
[#(span/make-unique (:clip (span/reuse-drawing % :main :n :drawing-a
{:extent :grow-symbol}))
:main :n {})])
results (keep (fn [command] (:clip (command doc))) every-command)]
(is (< 190 (count results)) "the sample is of commands that actually did something")
(doseq [after results]
(is (empty? (symbol/overlaps (get-in after [:symbols :main])))
(str "a command committed an overlap: "
(pr-str (mapv (juxt :id node/placed-span)
(symbol/children (get-in after [:symbols :main :nodes]))))))
(is (empty? (clip/problems after))))))
(deftest turning-lane-mode-on-is-the-one-thing-that-can-be-refused
(let [composed (-> (document)
(update-in [:symbols :main] dissoc :display)
(assoc-in [:symbols :main :nodes :b :time :at] 3))
refused (span/draw-as-lane composed :main true {})
trimmed (:clip (span/draw-as-lane composed :main true {:trim? true}))]
(is (:refused refused))
(is (= 1 (:required-trim refused)))
(is (nil? (:clip refused)) "and nothing moved")
(is (= :lane (get-in trimmed [:symbols :main :display])))
(is (= [[0 3] [3 7] [8 12]]
(mapv node/placed-span (symbol/children (get-in trimmed [:symbols :main :nodes]))))
"the retry trims later-claims-from-earlier, the rule everything else follows")
(is (empty? (symbol/overlaps (get-in trimmed [:symbols :main]))))
(is (empty? (clip/problems trimmed)))
;; A clip the next one wholly covers has nothing left to be.
(let [buried (assoc-in composed [:symbols :main :nodes :b :time :at] 0)
after (:clip (span/draw-as-lane buried :main true {:trim? true}))]
(is (nil? (get-in after [:symbols :main :nodes :a])))
(is (empty? (symbol/overlaps (get-in after [:symbols :main])))))
;; Off is always possible, and changes nothing but the hint.
(let [off (:clip (span/draw-as-lane (document) :main false {}))]
(is (nil? (get-in off [:symbols :main :display])))
(is (= (get-in (document) [:symbols :main :nodes])
(get-in off [:symbols :main :nodes]))))
(is (:refused (span/draw-as-lane (document) :nothing-here true {})))
(is (= :lane (get-in (:clip (span/draw-as-lane (document) :main true {}))
[:symbols :main :display]))
"a sequence that is already one turns on with nothing to trim")))
(deftest playback-is-independent-of-property-channel-shape
(let [doc (document)
n (get-in doc [:symbols :main :nodes :a])
keyed (node/toggle-key n [:xform :rot] 0 nil)
unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)]
(doseq [n [n keyed unkeyed]]
(is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1))))
(let [n (get-in doc [:symbols :main :nodes :insert])]
(is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10)))
(is (nil? (node/placed-frame n 7 10)))
(is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10))))
(is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10)))))))
(deftest navigation-and-hit-testing-use-the-same-source-time
(let [doc (document)
n (get-in doc [:symbols :main :nodes :insert])]
(is (= 5 (:frame (nest/inside doc nil :main [:insert] 10))))
(is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10))))
(is (= 0 (:frame (nest/inside doc nil :main [:a] 3))))
(is (nil? (:time (nest/inside doc nil :main [:a] 3))))
(is (nil? (nest/inside doc nil :main [:a] 4)))
(is (= ((pick/bounds-of doc nil :main n) 2)
((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0)))))
(deftest seeking-and-source-reuse-do-not-share-cursors
(let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a)
fs [11 0 5 3 8 4 10 1 6 2 9 7]
at (sample doc fs)]
(is (= at (sample doc (reverse fs))))
(is (= at (sample doc (range 12))))
(let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]]
(ch/framed [99 0]))]
(is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]])))
(is (= 99 (get-in (sample edited [0 4]) [4 [:b :mark]]))))))
(deftest cel-identities-and-playback-round-trip
(let [doc (:clip (span/extend-hold (document) :main :a 2 {:extent :grow-symbol}))
leaves (leaf/leaves :project doc)]
(is (= doc (leaf/clip :project leaves)))
(is (contains? leaves "clip/project/symbol/main/node/a"))
(is (= :lane (get-in (leaf/clip :project leaves) [:symbols :main :display]))
"lane mode is saved like any other field of a symbol")
(let [{copied :clip ids :ids}
(bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1))
doc [:main] {})]
(is (= :drawing-a-2 (:drawing-a ids)))
(is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids))))
(is (empty? (clip/problems copied))))))
(deftest one-transaction-undoes-the-ripple-and-shot-extension
(let [doc (document)
after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))
before-leaves (leaf/leaves :p doc)
after-leaves (leaf/leaves :p after)
h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle)
undo (history/undo h after-leaves)
redo (history/redo (:history undo) (:leaves undo))]
(is (= 1 (count (:done h))))
(is (= before-leaves (:leaves undo)))
(is (= after-leaves (:leaves redo)))))
(deftest a-new-document-is-ordinary-and-a-lane-is-created-explicitly
(let [doc (clip/blank)
lane (:clip (span/draw-as-lane doc :main true {}))
a (:clip (span/append-drawing lane :main :a :drawing-a {}))
b (:clip (span/append-drawing a :main :b :drawing-b {}))]
(is (= {} (get-in doc [:symbols :main :nodes])))
(is (nil? (get-in doc [:symbols :main :display])))
(is (= :lane (get-in lane [:symbols :main :display])))
(is (empty? (clip/problems b)))
(is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b]))))
(is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
(is (:refused (span/append-drawing b :main :a :new {})))))
(deftest arbitrary-symbols-drop-into-the-sequence-and-claim-their-time
(let [doc (document)
dropped (span/place-symbol doc nil :main :clip :wave 2
{:extent :grow-symbol :remainder-id :tail})
after (:clip dropped)
clips (symbol/children (get-in after [:symbols :main :nodes]))]
(is (= :clip (:selection dropped)))
(is (= [[0 2] [2 12]] (mapv node/placed-span clips))
"the natural ten-frame symbol claims [2,12), trimming/removing incumbents")
(is (= :wave (node/source (second clips))))
(is (= 1 (:speed (node/playback-of (second clips))))
"a dropped symbol plays; it is not converted into a drawing hold")
(is (empty? (clip/problems after)))
;; Outside lane mode the same drop claims nothing.
(let [composed (update-in doc [:symbols :main] dissoc :display)
after (:clip (span/place-symbol composed nil :main :clip :wave 2
{:extent :grow-symbol :remainder-id :tail}))]
(is (= [[0 4] [2 12] [4 8] [8 12]]
(mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes]))))
"it is simply placed, on screen with what was already there"))))
(deftest repeated-symbol-drops-keep-the-symbols-natural-duration
(let [empty-lane (assoc-in (document) [:symbols :main]
{:id :main :frames 40 :display :lane :nodes {}})
once (:clip (span/place-symbol empty-lane nil :main :one :wave 0
{:extent :grow-symbol :remainder-id :r1}))
twice (:clip (span/place-symbol once nil :main :two :wave 10
{:extent :grow-symbol :remainder-id :r2}))
thrice (:clip (span/place-symbol twice nil :main :three :wave 20
{:extent :grow-symbol :remainder-id :r3}))]
(is (= [[:one [0 10]] [:two [10 20]] [:three [20 30]]]
(mapv (juxt :id node/placed-span)
(symbol/children (get-in thrice [:symbols :main :nodes]))))
"materializing the same source repeatedly does not collapse later instances")
(is (every? #(= [0 10] (:span %))
(symbol/children (get-in thrice [:symbols :main :nodes]))))
(let [resolve (clip/resolver thrice :main nil pal/index-of nil)]
(doseq [[id at] [[:one 0] [:two 10] [:three 20]]]
(is (= [0 300 600 900]
(mapv (fn [f]
(let [op (first (filter #(= [id :mark] (:node %))
(resolve (+ at f))))]
(js/Math.round (:cx op))))
[0 3 6 9]))
(str id " gets its own complete source clock"))))
(is (empty? (clip/problems thrice)))))
(deftest transfer-is-one-placement-rule-with-two-destination-modes
(let [doc (document)
moved (:clip (span/transfer doc :main :insert :main 2
{:extent :grow-symbol :remainder-id :rest}))
clips (symbol/children (get-in moved [:symbols :main :nodes]))]
(is (= [[0 2] [2 6] [6 8]] (mapv node/placed-span clips))
"moving within a lane claims the landing interval from both neighbours")
(is (= :insert (:id (second clips))))
(is (empty? (symbol/overlaps (get-in moved [:symbols :main]))))
;; The identical transfer into an ordinary symbol simply composites.
(let [ordinary (assoc-in doc [:symbols :other]
{:id :other :frames 12
:nodes {:existing (cel :existing :drawing-a 0 4 0)}})
free (:clip (span/transfer ordinary :main :b :other 1
{:extent :grow-symbol :remainder-id :rest}))]
(is (= #{:existing :b} (set (keys (get-in free [:symbols :other :nodes])))))
(is (= 1 (count (symbol/overlaps (get-in free [:symbols :other]))))
"overlap is ordinary composition outside lane mode")
(is (nil? (get-in free [:symbols :main :nodes :b])))
(is (empty? (clip/problems free))))))
(deftest an-existing-clip-can-be-moved-and-claim-where-it-lands
(let [doc (assoc-in (document) [:symbols :main :nodes :badge]
{:id :badge :kind :instance :z "z"
:source {:symbol :wave} :span [0 3]
:time {:at 1 :rate 1}
:playback {:in 2 :speed 1 :end :stop}})
result (span/adopt doc :main :badge 5
{:extent :grow-symbol :remainder-id :tail})
after (:clip result)
n (get-in after [:symbols :main :nodes :badge])]
(is (= [5 8] (node/placed-span n)))
(is (= {:in 2 :speed 1 :end :stop} (:playback n))
"a move changes placement, not source timing")
(is (= [[0 4] [4 5] [5 8] [8 12]]
(mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes])))))
(is (empty? (clip/problems after)))
(is (:refused (span/adopt doc :main :plate 5 {})) "and a shape has no frames to place")))
(deftest fractional-placement-rates-convert-the-hold-delta
(let [doc (-> (document)
(assoc-in [:symbols :main :nodes :a :time :rate] 2)
(assoc-in [:symbols :main :nodes :a :span] [0 8]))
after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
(is (= [0 12] (get-in after [:symbols :main :nodes :a :span])))
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b]))))))
(deftest bare-shapes-agree-in-reference-and-playback
(let [sym (drawing :bare 12 1)]
(is (= (symbol/eval-frame sym 0 nil pal/index-of nil)
((symbol/resolver sym nil pal/index-of nil) 0))
"omitted style colour must not crash a missing cursor")))
(deftest audio-follows-only-the-playing-cel
(let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"}
:span [0 10]
:channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}}
doc (-> (document)
(assoc-in [:symbols :wave :nodes :voice] voice)
(assoc-in [:symbols :drawing-a :nodes :voice] voice))
[track :as tracks] (nest/audio-tracks doc :main)]
(is (= 1 (count tracks)) "the frozen drawing contributes no audio")
(is (= [8 12] (node/placed-span track)))
(is (= [3 7] (:span track)) "the source in-point trims the audio too")
(is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys])))
(let [moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))
[track] (nest/audio-tracks moved :main)]
(is (= [10 14] (node/placed-span track)))
(is (= [3 7] (:span track))))
;; The retime that used to be the lane group's is the placing instance's.
(let [fast (-> (shot doc)
(assoc-in [:symbols :shot :nodes :girl :time] {:mode :map :at 2 :rate 2})
(assoc-in [:symbols :main :nodes :insert :playback :speed] 2))
[track] (nest/audio-tracks fast :shot)]
(is (= [6 7.75] (node/placed-span track)))
(is (= [3 10] (:span track)))
(is (= 4 (get-in track [:time :rate]))))))
(deftest a-looped-insert-schedules-distinct-audio-intervals
(let [doc (-> (document)
(assoc-in [:symbols :wave :frames] 4)
(assoc-in [:symbols :wave :nodes :voice]
{:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]})
(assoc-in [:symbols :main :nodes :insert :playback]
{:in 3 :speed 1 :end :loop}))]
(is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main))))))
(deftest the-shot-a-sequence-needs-is-in-its-own-frames
;; CHANGED ON PURPOSE. It used to be that an enclosing retime changed how many
;; frames an edit needed, because the lane was INSIDE the symbol being measured
;; and its clock sat between them. The symbol is now the container, so its
;; `:frames` is its own authored window and how fast some instance plays it is
;; not a fact about it.
(let [doc (shot (document))
slow (assoc-in doc [:symbols :shot :nodes :girl :time] {:mode :map :at 8 :rate 2})]
(is (= 14 (:required-frames (span/extend-hold slow :main :a 2 {}))))
(is (= 14 (:required-frames (span/extend-hold doc :main :a 2 {}))))
(is (= 14 (get-in (span/extend-hold slow :main :a 2 {:extent :grow-symbol})
[:clip :symbols :main :frames])))))
(deftest reuse-shares-content-and-make-unique-decouples-one-cel
(let [doc (document)
shared (:clip (span/reuse-drawing doc :main :c :drawing-a {:extent :grow-symbol}))
edit (fn [c sym x]
(assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]]
(ch/framed [x 0])))]
(is (:refused (span/reuse-drawing doc :main :c :drawing-a {}))
"the shot has to be extended on purpose")
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c]))))
(is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c]))))
(is (empty? (clip/problems shared)))
;; One drawing, two cels: the edit arrives at both.
(let [at (sample (edit shared :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 99 (get-in at [12 [:c :mark]]))))
(let [unique (:clip (span/make-unique shared :main :c {}))]
(is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c]))))
(is (= (:nodes (get-in shared [:symbols :drawing-a]))
(:nodes (get-in unique [:symbols :drawing-a-2])))
"a copy of the same drawing, not an empty one")
(is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a])))
"the other cel keeps the original")
(let [at (sample (edit unique :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched"))
(let [at (sample (edit unique :drawing-a-2 99) [0 12])]
(is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back"))
(is (empty? (clip/problems unique))))
;; Nothing else places drawing-b, so there is nothing to decouple from.
(is (:refused (span/make-unique doc :main :b {})))
(is (:refused (span/make-unique doc :main :plate {}))
"a shape places nothing itself")))
(deftest duplicate-copies-the-drawing-and-not-the-cel
(let [doc (document)
made (:clip (span/duplicate-drawing doc :main :b :d {:extent :grow-symbol}))
n (get-in made [:symbols :main :nodes :d])]
(is (= :drawing-b-2 (node/source n)))
(is (= (:nodes (get-in doc [:symbols :drawing-b]))
(:nodes (get-in made [:symbols :drawing-b-2]))))
(is (= [12 13] (node/placed-span n)))
(is (= {:in 0 :speed 0 :end :stop} (:playback n)))
(is (nil? (:channels n)) "B's own position correction belongs to B's cel")
(is (= (get-in doc [:symbols :main :nodes :b])
(get-in made [:symbols :main :nodes :b]))
"the drawing duplicated is left as it was")
(is (empty? (clip/problems made)))))
(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them
;; A drawing assembled from another symbol: copying it shallowly must keep
;; using that part, and only an explicit deep copy may promise independence.
(let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part]
{:id :part :kind :instance :z "b" :span [0 1]
:time {:at 0 :rate 1} :source {:symbol :wave}
:playback {:in 0 :speed 0 :end :stop}})
copy (fn [opts] (:clip (span/duplicate-drawing
doc :main :a :d (merge {:extent :grow-symbol} opts))))
shallow (copy {})
deep (copy {:deep? true})]
(is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part]))))
(is (nil? (get-in shallow [:symbols :wave-2])))
(is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part]))))
(is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2]))))
(is (empty? (clip/problems shallow)))
(is (empty? (clip/problems deep)))))
(deftest reuse-refuses-what-would-not-be-a-document
(let [doc (document)]
(is (:refused (span/reuse-drawing doc :main :c :nothing-here {})))
(is (:refused (span/reuse-drawing doc :main :c :main {:extent :grow-symbol}))
"a symbol cannot go inside itself")
(is (:refused (span/reuse-drawing doc :main :a :drawing-a {:extent :grow-symbol}))
"a cel ID in use is not free")
(is (:refused (span/duplicate-drawing doc :main :plate :d {})))))
(deftest drawing-on-twos-does-not-quantize-the-containers-transform
;; Cel length IS the drawing cadence, and it is the only thing on twos here:
;; the instance placing the sequence has its own clock and keeps moving every
;; frame. Stepping it would be the cel cadence leaking into continuous motion.
(let [cel (fn [id source at] (cel id source at 2 0))
doc (-> (shot (document))
(update-in [:symbols :main :nodes] dissoc :a :b :insert)
(update-in [:symbols :main :nodes] merge
{:c0 (cel :c0 :drawing-a 0)
:c1 (cel :c1 :drawing-b 2)
:c2 (cel :c2 :drawing-a 4)}))
xs {:c0 10 :c1 20 :c2 10}
at (sample-in doc :shot (range 6))
showing (fn [f] (first (dissoc (at f) :plate)))]
(is (empty? (clip/problems doc)))
(is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(second (key (showing %))) (range 6)))
"the drawing showing changes every second frame")
(is (= [0 10 20 30 40 50]
(mapv (fn [f] (let [[[_ id _] cx] (showing f)] (- cx (xs id)))) (range 6)))
"and the sequence moves on every frame, odd ones included")))
(defn- drawn
"What every frame draws, as sorted values, so a picture can be compared
without naming the cels that produced it."
[doc sid fs]
(let [at (sample-in doc sid fs)]
(mapv #(sort (vals (get at %))) fs)))
(deftest a-drawing-goes-anywhere-in-the-sequence-and-ripples-what-follows
(let [doc (shot (document))
keys-of #(get-in % [:symbols :shot :nodes :girl :channels [:xform :pos] :keys])
spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id])))
[:a :n :b :insert])
r (span/append-drawing doc :main :n :drawing-n {:at 4 :extent :grow-symbol})]
(is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r))))
(is (= 13 (get-in r [:clip :symbols :main :frames])))
(is (= (keys-of doc) (keys-of (:clip r)))
"the container's keys stay where they were authored")
(is (= :n (:selection r)))
(is (= 4 (:frame r)))
(is (empty? (clip/problems (:clip r))))
;; The same command with no room refuses, and says how much it needs.
(is (= 13 (:required-frames (span/append-drawing doc :main :n :drawing-n {:at 4}))))
;; At the very front everything moves.
(is (= [[1 5] [0 1] [5 9] [9 13]]
(spans (:clip (span/append-drawing doc :main :n :drawing-n
{:at 0 :extent :grow-symbol})))))
;; Inside a cel is not a position for another one.
(is (re-find #"split it first"
(:refused (span/append-drawing doc :main :n :drawing-n
{:at 2 :extent :grow-symbol}))))
(is (:refused (span/append-drawing doc :main :n :drawing-n
{:at -1 :extent :grow-symbol})))
(is (:refused (span/append-drawing doc :main :n :drawing-n
{:at ##Inf :extent :grow-symbol})))
;; Reuse and duplicate take a position too; it is one placement rule.
(is (= [4 5] (node/placed-span
(get-in (span/reuse-drawing doc :main :n :drawing-b
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))
(is (= [4 5] (node/placed-span
(get-in (span/duplicate-drawing doc :main :b :n
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))))
(deftest split-then-place-puts-a-drawing-inside-a-hold
;; The two commands the doc asks for, composed: neither one guesses.
(let [doc (shot (document))
cut (:clip (span/split doc :main :a 2 :right))
r (span/append-drawing cut :main :n :drawing-n {:at 2 :extent :grow-symbol})
after (:clip r)]
(is (= [[0 2] [2 3] [3 5] [5 9] [9 13]]
(mapv #(node/placed-span (get-in after [:symbols :main :nodes %]))
[:a :n :right :b :insert])))
(is (= (get-in doc [:symbols :shot :nodes :girl :channels])
(get-in after [:symbols :shot :nodes :girl :channels]))
"the performance is still timed the way it was authored")
(is (empty? (clip/problems after)))))
(deftest a-three-frame-correction-crosses-a-drawing-boundary
;; The lane model's worked example, with the correction on the INSTANCE that
;; places the sequence: it applies across whichever drawings are showing under
;; it, and outside its three frames the animation evaluates exactly as before.
(let [doc (shot (document))
fs (range 12)
before (drawn doc :shot fs)
beat (ch/layer :beat [3 6] :offset (ch/framed [30 0]))
c (update-in doc [:symbols :shot :nodes :girl :channels [:xform :pos] :over]
(fnil conj []) beat)
after (drawn c :shot fs)
outside [0 1 2 6 7 8 9 10 11]]
(is (empty? (clip/problems c)))
(is (= (mapv before outside) (mapv after outside))
"outside the support, frame for frame identical")
(let [at (sample-in c :shot [3 4 5])]
;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one
;; correction, reaching across the cut between them.
(is (= 70 (get-in at [3 [:girl :a :mark]])))
(is (= 90 (get-in at [4 [:girl :b :mark]])))
(is (= 102 (get-in at [5 [:girl :b :mark]]))
"and B's own correction still applies under it")
(is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5]))
"while the background, which is not in the sequence, does not move"))
;; One document change: one step, and it persists in the channel's own leaf.
(let [b (leaf/leaves :p doc)
a (leaf/leaves :p c)
h (-> nil history/hold (history/record b a 0) history/settle)]
(is (= 1 (count (:done h))))
(is (= b (:leaves (history/undo h a))))
(is (= c (leaf/clip :p a)) "a correction needs no codec of its own"))))
(deftest a-correction-on-one-cel-travels-with-it
;; The other half of ownership: a layer on a cel is in that cel's own frames,
;; so moving the cel moves the correction and nothing has to say so.
(let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0]))
doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over]
(fnil conj []) beat)
moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
;; Stated as the difference from the same document without the correction,
;; so the claim is about WHERE the layer applies and not about arithmetic.
(let [nudge (fn [with without f]
(- (get-in (sample with [f]) [f [:b :mark]])
(get-in (sample without [f]) [f [:b :mark]])))]
(is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7]))
"B's first two frames, 4 and 5")
(is (= [7 7 0 0]
(mapv #(nudge moved (:clip (span/extend-hold (document) :main :a 2
{:extent :grow-symbol}))
%)
[6 7 8 9]))
"and after A's hold grows, B's first two frames, which are now 6 and 7"))
(is (= (get-in doc [:symbols :main :nodes :b :channels])
(get-in moved [:symbols :main :nodes :b :channels]))
"the layer itself was not touched by the retiming")
(is (empty? (clip/problems moved)))))
(defn- spans [clip ids]
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids))
(deftest blanking-leaves-a-gap-and-does-not-close-it
(let [doc (document)
r (span/blank doc :main [5 7] {:id :rest})
after (:clip r)]
;; B spanned the range, so it became two cels with a hole between them.
(is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert])))
(is (= :rest (:selection r)))
(let [at (sample after [4 5 6 7])]
(is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame")
(is (= #{:plate} (set (keys (at 6)))))
(is (get-in at [4 [:b :mark]]))
(is (get-in at [7 [:rest :mark]])))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing
(let [doc (document)
r (span/blank doc :main [4 8] {})
after (:clip r)]
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing")
(is (nil? (:selection r))
"and names nothing, because emptying frames selects nothing sensible")
(is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b]))
"a symbol does not own its content")
(is (empty? (clip/problems after)))))
(deftest blanking-a-range-trims-what-it-only-partly-covers
(let [doc (document)
after (:clip (span/blank doc :main [3 9] {}))]
(is (= [[0 3] [9 12]] (spans after [:a :insert])))
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= (get-in (sample doc [9]) [9 [:insert :mark]])
(get-in (sample after [9]) [9 [:insert :mark]]))
"the insert kept its own frames, so frame 9 shows what it showed")
(is (empty? (clip/problems after)))))
(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows
(let [r (span/overwrite-drawing (document) :main :n :drawing-n 5
{:extent :keep :remainder-id :right})
after (:clip r)
nodes (get-in after [:symbols :main :nodes])]
(is (= :n (:selection r)))
(is (= [[0 4] [4 5] [5 6] [6 8] [8 12]]
(mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert])))
(is (= :drawing-b (node/source (:right nodes))))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blank-refuses-what-it-cannot-do-in-one-piece
(let [doc (document)]
(is (re-find #"free ID" (:refused (span/blank doc :main [5 7] {})))
"splitting a cel needs an ID for the remainder")
(is (:refused (span/blank doc :main [5 7] {:id :a})) "and a free one")
(is (:refused (span/blank doc :main [7 5] {})))
(is (:refused (span/blank doc :main [5 5] {})))
(is (:refused (span/blank doc :main [5 6.5] {})))
(is (:refused (span/blank (update-in doc [:symbols :main] dissoc :display)
:main [0 2] {}))
"and a composition has no sequence to leave a hole in")))
(deftest the-shot-length-is-authored-and-emptying-it-does-not-shorten-it
;; The window and the occupied extent are two facts. A shot with nothing in
;; the last half is a shot somebody authored that long, and deleting the last
;; drawing must not quietly shorten the film.
(let [doc (document)
emptied (:clip (span/blank doc :main [0 12] {}))]
(is (empty? (symbol/children (get-in emptied [:symbols :main :nodes]))))
(is (= 12 (get-in emptied [:symbols :main :frames])))
(is (empty? (clip/problems emptied)))
;; Growing is still the caller's word, and only ever grows.
(is (:refused (span/append-drawing emptied :main :n :drawing-n {:at 20})))
(is (= 21 (get-in (span/append-drawing emptied :main :n :drawing-n
{:at 20 :extent :grow-symbol})
[:clip :symbols :main :frames])))
(is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9))
[:symbols :main :frames]))
"and trimming the last cel leaves the window where it was")))
(deftest a-take-placed-in-a-sequence-is-still-heard
;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that
;; "wherever the symbol is placed it is heard". A sequence is one of the places
;; it can be placed, and must not be the one place that goes silent.
(let [doc (assoc-in (document) [:symbols :take]
{:id :take :frames 10 :fps 24
:nodes {:pic {:id :pic :kind :instance :z "a"
:source {:symbol :wave} :span [0 10]
:time {:mode :map :at 0 :rate 1}
:playback {:in 0 :speed 1 :end :stop}}
:sound {:id :sound :name "sound" :kind :audio
:parent nil :z "z-sound"
:source {:footage "f1"} :span [0 10]
:time {:mode :map :at 0 :rate 1}}}})
at-root (clip/place-symbol doc nil :main :take 0 :root nil)
placed (:clip (span/place-symbol doc nil :main :drop :take 0
{:extent :grow-symbol :remainder-id :tail}))]
(is (= 1 (count (nest/audio-tracks at-root :main)))
"a take placed at the root is heard")
(is (some? placed) "the take goes into the sequence")
(is (= 1 (count (nest/audio-tracks placed :main)))
"and is still heard from inside one")))
(deftest a-sound-is-a-clip-of-a-sequence-like-any-other
;; A sound claims time by the same rule as a picture, and THERE IS NO MIXTURE
;; RULE ANY MORE: a symbol whose clips are sounds is an audio lane, and that is
;; the whole of it. The refusal that used to say "picture or sound, not both"
;; was a property of a lane node, and there is no lane node.
(let [seeded (clip/place-sound (document) :main {:sound "s1"} "voice" 6 1 2 :vo)
result (span/adopt seeded :main :vo 2 {:extent :grow-symbol})
after (:clip result)
n (get-in after [:symbols :main :nodes :vo])]
(is (nil? (:refused result)) (str (:refused result)))
(is (= [2 8] (node/placed-span n)))
(is (empty? (clip/problems after)))
(is (= 1 (count (nest/audio-tracks after :main)))
"a sound in a sequence is still heard")
(is (contains? (set (map :id (symbol/children (get-in after [:symbols :main :nodes]))))
:vo))
;; Picture over sound is picture claiming the frames, like anything else.
(let [mixed (:clip (span/place-symbol after nil :main :also :wave 2
{:extent :grow-symbol :remainder-id :rest}))]
(is (empty? (symbol/overlaps (get-in mixed [:symbols :main]))))
(is (empty? (clip/problems mixed))))))

247
frontend/test/arthur/domain/span_test.cljs
View file

@ -1,53 +1,22 @@
(ns arthur.domain.span-test (ns arthur.domain.span-test
"Split, trim and move, over the two things they have to work on alike: a cel "Generic span edits in an explicit lane and an ordinary compositing symbol."
inside a lane, and a symbol placed straight into a shot. The fixture carries
both on purpose — the commands were lane-gated for as long as a lane was the
only thing anybody had timed, and the point of these tests is that nothing in
them reads a lane."
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.lane :as lane]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.sequence-test :as fixture]
[arthur.domain.span :as span])) [arthur.domain.span :as span]))
(defn- drawing [id x frames] (defn document [] (fixture/document))
{:id id :frames frames
:nodes {:mark {:id :mark :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 4)
[:xform :pos] (ch/framed [x 0])}}}})
(defn- cel [id source at duration speed] (defn- ordinary-document []
{:id id :kind :instance :parent :girl :z (name id) (-> (document)
:source {:symbol source} :playback {:in 0 :speed speed :end :stop} (update-in [:symbols :main] dissoc :display)
:time {:at at :rate 1} :span [0 duration]}) (assoc-in [:symbols :main :nodes :badge]
{:id :badge :kind :instance :z "z"
(defn document
"A lane of three cels, and — the part lane_test's fixture has no equivalent of
— `:badge`, an instance of an animated symbol placed straight into `:main`
with a span of its own and no parent at all. Its frames are the SYMBOL's, so
it is the case where the coordinate a command takes is not lane time."
[]
(let [a (cel :a :drawing-a 0 4 0)
b (cel :b :drawing-b 4 4 0)
insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)]
{:name "spans" :fps 24 :width 320 :height 200
:symbols
{:main {:id :main :frames 12
:nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"}
:a a :b b :insert insert
:badge {:id :badge :kind :instance :z "c"
:source {:symbol :wave} :source {:symbol :wave}
:playback {:in 0 :speed 1 :end :stop} :playback {:in 0 :speed 1 :end :stop}
:time {:at 2 :rate 1} :span [0 8]} :time {:at 2 :rate 1} :span [0 8]})))
:plate {:id :plate :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 10)
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
:drawing-a (drawing :drawing-a 10 1)
:drawing-b (drawing :drawing-b 20 1)
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
(defn- sample [doc fs] (defn- sample [doc fs]
(let [r (clip/resolver doc :main nil pal/index-of nil)] (let [r (clip/resolver doc :main nil pal/index-of nil)]
@ -57,167 +26,67 @@
(let [at (sample doc fs)] (let [at (sample doc fs)]
(mapv #(sort (vals (get at %))) fs))) (mapv #(sort (vals (get at %))) fs)))
(defn- spans [clip ids] (deftest fixtures-state-the-mode-explicitly
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) (is (= :lane (get-in (document) [:symbols :main :display])))
(is (nil? (get-in (ordinary-document) [:symbols :main :display])))
(is (empty? (clip/problems (document))))
(is (empty? (clip/problems (ordinary-document)))))
(deftest the-fixture-places-one-thing-outside-the-lane (deftest splitting-preserves-the-picture-in-both-modes
(let [doc (document)] (doseq [[label doc id cut] [["lane clip" (document) :a 2]
(is (empty? (clip/problems doc))) ["ordinary placement" (ordinary-document) :badge 6]]]
(is (nil? (:parent (get-in doc [:symbols :main :nodes :badge])))
"so a command acting on it has only the symbol's frames to go by")
(is (= [2 10] (node/placed-span (get-in doc [:symbols :main :nodes :badge]))))))
;; ---------------------------------------------------------------------------
;; split
(deftest splitting-changes-nothing-that-is-drawn
(let [doc (document)
fs (range 12)
before (drawn doc fs)]
(doseq [[label id cut] [["a held drawing in a lane" :a 2]
["a playing insert in a lane" :insert 10]
["a placement with no lane at all" :badge 6]]]
(testing label (testing label
(let [r (span/split doc :main id cut :right) (let [before (drawn doc (range 12))
r (span/split doc :main id cut :right)
after (:clip r)] after (:clip r)]
(is (= :right (:selection r))) (is (= :right (:selection r)))
(is (= before (drawn after fs)) "the same picture, frame for frame") (is (= before (drawn after (range 12))))
(is (= (node/placed-span (get-in doc [:symbols :main :nodes id])) (is (= cut
[(first (node/placed-span (get-in after [:symbols :main :nodes id]))) (second (node/placed-span (get-in after [:symbols :main :nodes id])))
(second (node/placed-span (get-in after [:symbols :main :nodes :right])))])
"the pieces occupy the frames the one node did")
(is (= cut (second (node/placed-span (get-in after [:symbols :main :nodes id])))
(first (node/placed-span (get-in after [:symbols :main :nodes :right]))))) (first (node/placed-span (get-in after [:symbols :main :nodes :right])))))
(is (= (:time (get-in doc [:symbols :main :nodes id])) (is (empty? (clip/problems after)))))))
(:time (get-in after [:symbols :main :nodes :right])))
"one time map, so the right piece's own frames carry on")
(is (= (select-keys (get-in doc [:symbols :main :nodes id])
[:source :playback :channels :parent :z])
(select-keys (get-in after [:symbols :main :nodes :right])
[:source :playback :channels :parent :z]))
"and it keeps its parent and its depth, so it draws where it drew")
(is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question")
(is (empty? (clip/problems after))))))))
(deftest split-refuses-anything-but-one-cut-inside-one-thing (deftest split-refuses-an-edge-a-missing-node-and-a-spanless-node
(let [doc (document)] (let [doc (document)]
(doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]] (doseq [cut [0 4 -1 2.5 ##NaN nil]]
(is (:refused (span/split doc :main :b cut :right)) (str "cut at " (pr-str cut)))) (is (:refused (span/split doc :main :a cut :right))))
(is (:refused (span/split doc :main :a 2 :b)) "the new ID has to be free")
(is (:refused (span/split doc :main :missing 2 :right))) (is (:refused (span/split doc :main :missing 2 :right)))
(is (re-find #"group" (:refused (span/split doc :main :girl 2 :right))) (is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right))))))
"a group is divided by its children, not by its span")
(is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right)))
"and a node with no span has no edges to cut")))
;; --------------------------------------------------------------------------- (deftest trimming-only-narrows-the-selected-placement
;; trim (doseq [[doc id edge to kept] [[(document) :b :out 6 [4 6]]
[(ordinary-document) :badge :in 5 [5 10]]]]
(deftest trimming-narrows-one-thing-and-moves-nothing-else (let [before (get-in doc [:symbols :main :nodes id])
(let [doc (document)] r (span/trim doc :main id edge to)
(doseq [[label id edge to kept] [["a cel in a lane" :b :out 6 [4 6]]
["a placement outside one" :badge :out 7 [2 7]]
["the front of one outside a lane" :badge :in 5 [5 10]]]]
(testing label
(let [r (span/trim doc :main id edge to)
after (:clip r)] after (:clip r)]
(is (= kept (node/placed-span (get-in after [:symbols :main :nodes id]))))
(is (= id (:selection r))) (is (= id (:selection r)))
(is (= (select-keys (get-in doc [:symbols :main :nodes id]) (is (= kept (node/placed-span (get-in after [:symbols :main :nodes id]))))
[:time :playback :channels :source]) (is (= (dissoc before :span)
(select-keys (get-in after [:symbols :main :nodes id]) (dissoc (get-in after [:symbols :main :nodes id]) :span)))
[:time :playback :channels :source])) (is (empty? (clip/problems after))))))
"only :span changed")
(is (= [[0 4] [8 12]] (spans after [:a :insert])) "and no neighbour moved")
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after))))))))
(deftest trimming-the-front-does-not-restart-what-is-playing (deftest resizing-an-ordinary-placement-may-overlap
;; The difference between trimming and slipping, asserted on the node that has (let [doc (ordinary-document)
;; no lane: its own frames are where they were, so the frames that survive after (:clip (span/resize-out doc :main :badge 11 {}))]
;; show exactly what they showed. (is (= [2 11] (node/placed-span (get-in after [:symbols :main :nodes :badge]))))
(is (:refused (span/resize-out doc :main :badge 2 {})))))
(deftest moving-follows-the-symbol-mode
(let [lane (document)
ordinary (ordinary-document)]
(is (:refused (span/move lane :main :insert 6)) "a lane clip cannot overlap B")
(let [after (:clip (span/move ordinary :main :badge 0))]
(is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge])))
"an ordinary symbol is free to composite over occupied frames")
(is (empty? (clip/problems after))))))
(deftest clearing-room-then-moving-is-explicit-composition
(let [doc (document) (let [doc (document)
before (sample doc [6 7]) cleared (:clip (span/blank doc :main [4 8] {}))
after (:clip (span/trim doc :main :badge :in 6))] after (:clip (span/move cleared :main :insert 4))]
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) (is (= [4 8] (node/placed-span (get-in after [:symbols :main :nodes :insert]))))
(is (= (:playback (get-in doc [:symbols :main :nodes :badge]))
(:playback (get-in after [:symbols :main :nodes :badge]))))
(is (= (get-in before [6 [:badge :mark]])
(get-in (sample after [6]) [6 [:badge :mark]]))
"the same animation on the frames it kept")
(is (nil? (get-in (sample after [5]) [5 [:badge :mark]]))
"and the frames it gave up show nothing of it")))
(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge
(let [doc (document)]
(doseq [[label id edge to] [["at its own start" :b :in 4]
["at its own end" :b :out 8]
["past its end" :b :out 9]
["before its start" :b :in 2]
["off a whole frame" :b :out 5.5]
["past the end of one outside a lane" :badge :out 11]
["before the start of one outside a lane" :badge :in 1]]]
(is (:refused (span/trim doc :main id edge to)) label))
(is (:refused (span/trim doc :main :b :middle 6)))
(is (re-find #"group" (:refused (span/trim doc :main :girl :out 6))))))
;; ---------------------------------------------------------------------------
;; move
(deftest moving-keeps-its-length-and-its-source-origin
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
r (span/move doc :main :insert 4)
after (:clip r)]
(is (= [[0 4] [4 8]] (spans after [:a :insert])))
(is (= :insert (:selection r)))
(is (= (:playback (get-in doc [:symbols :main :nodes :insert]))
(:playback (get-in after [:symbols :main :nodes :insert]))))
;; It began on source frame 3 at lane 8; it begins on source frame 3 at lane 4.
(is (= (get-in (sample doc [8]) [8 [:insert :mark]])
(get-in (sample after [4]) [4 [:insert :mark]])))
(is (empty? (clip/problems after))))) (is (empty? (clip/problems after)))))
(deftest a-move-outside-a-lane-is-free-to-land-on-an-occupied-frame (deftest host-frame-of-a-parentless-clip-is-the-symbol-frame
;; The non-overlap rule is the LANE's, and `:badge` is not in one. Things (is (= 6 (span/host-frame (document) :main :b 6)))
;; placed in a composition are allowed to be on screen together, so there is (is (= 6 (span/host-frame (ordinary-document) :main :badge 6))))
;; nothing here for a move to refuse.
(let [doc (document)
r (span/move doc :main :badge 0)
after (:clip r)]
(is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge]))))
(is (= [[0 4] [4 8] [8 12]] (spans after [:a :b :insert]))
"and the lane beside it did not notice")
(is (= (get-in (sample doc [2]) [2 [:badge :mark]])
(get-in (sample after [0]) [0 [:badge :mark]]))
"its source origin came with it")
(is (empty? (clip/problems after)))))
(deftest a-move-onto-an-occupied-frame-of-a-lane-is-refused-rather-than-rippled
(let [doc (document)]
(is (:refused (span/move doc :main :insert 6)) "it would overlap B")
(is (:refused (span/move doc :main :insert 4.5)))
(is (re-find #"group" (:refused (span/move doc :main :girl 2))))
(is (re-find #"whole shot" (:refused (span/move doc :main :plate 2))))
;; Clearing the room first is the composition, and then it goes.
(let [cleared (:clip (lane/blank doc :main :girl [4 8] {}))]
(is (= [[0 4] [4 8]] (spans (:clip (span/move cleared :main :insert 4))
[:a :insert]))))))
;; ---------------------------------------------------------------------------
;; the coordinate
(deftest host-frame-reads-lane-time-for-a-cel-and-symbol-time-for-everything-else
(let [doc (document)
retimed (assoc-in doc [:symbols :main :nodes :girl :time] {:at 4 :rate 2})]
(is (= 6 (span/host-frame doc :main :b 6))
"an untimed lane reads the symbol's frames as its own")
(is (= 6 (span/host-frame doc :main :badge 6))
"and so does a node with no parent, always")
(is (= 4 (span/host-frame retimed :main :b 6))
"through a lane at :at 4 :rate 2, symbol frame 6 is lane frame 4")
(is (= 6 (span/host-frame retimed :main :badge 6))
"which is the lane's business and not the badge's")
(is (nil? (span/host-frame (assoc-in doc [:symbols :main :nodes :girl :time]
{:loop? true})
:main :b 6))
"and a looping parent has no single answer to give")))

208
frontend/test/arthur/events/lane_test.cljs
View file

@ -1,43 +1,53 @@
(ns arthur.events.lane-test (ns arthur.events.lane-test
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is]]
[arthur.domain.lane-test :as fixture]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.correction :as correction]
[arthur.domain.lane :as lane]
[arthur.events.ui :as ui]
[arthur.domain.history :as history] [arthur.domain.history :as history]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.symbol :as symbol] [arthur.domain.sequence-test :as fixture]
[arthur.domain.span :as span]
[arthur.events.ui :as ui]
[arthur.footage.store :as store] [arthur.footage.store :as store]
[arthur.ui.timeline :as timeline])) [arthur.ui.timeline :as timeline]
[re-frame.core :as rf]
[re-frame.db :as rf-db]))
(deftest one-row-projects-all-cels-and-keeps-selection-addresses (deftest symbol-and-lane-creation-are-distinct-explicit-commands
(letfn [(run [event key]
(let [doc (clip/blank)
id (store/install! {:clip doc :store {}} key)]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 0}})
(rf/dispatch-sync event)
(let [db @rf-db/app-db
saved (:clip (store/entry id))
[_ _ instance-id] (get-in db [:ui :selection])
sid (get-in saved [:symbols :main :nodes instance-id :source :symbol])]
{:db db :symbol (clip/symbol saved sid)})))]
(let [{ordinary :symbol} (run [::ui/new-symbol :inside] "explicit-symbol")
{lane :symbol lane-db :db} (run [::ui/new-lane] "explicit-lane")]
(is (nil? (:display ordinary)) "new symbol means ordinary symbol")
(is (= :lane (:display lane)) "only the lane command creates a lane")
(is (some? (get-in lane-db [:ui :target]))
"the new lane is aimed so drawing and pool drops can go into it"))))
(deftest an-explicit-lane-is-one-row-of-clips
(let [doc (fixture/document) (let [doc (fixture/document)
rows (timeline/rows doc :main #{}) rows (timeline/rows doc :main #{})
lane (first (filter :cels rows))] lane (first (filter :lane? rows))]
(is (= 2 (count rows))) (is (= 2 (count rows)) "the lane row plus the span-less plate")
(is (= [[0 4] [4 8] [8 12]] (mapv :span (:cels lane)))) (is (= [[0 4] [4 8] [8 12]] (mapv :span (:cels lane))))
(is (= [[:node :main :a [:a]] [:node :main :b [:b]] [:node :main :insert [:insert]]]
(mapv :select (:cels lane))))
(is (= [0 6 12] (:keys lane)))
(is (= 1 (count (filter :cels (timeline/rows doc :main #{[:girl]})))))))
(deftest the-cel-sheet-is-the-same-cels-with-the-axes-turned
(let [doc (fixture/document)
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]] (is (= [[:node :main :a [:a]]
[:node :main :b [:b]] [:node :main :b [:b]]
[:node :main :insert [:insert]]] [:node :main :insert [:insert]]]
(mapv #(get-in cells [% :cel :select]) [0 4 8]))) (mapv :select (:cels lane))))))
(is (= (mapv :select (:cels (first (filter :cels (timeline/rows doc :main #{})))))
(mapv #(get-in cells [% :cel :select]) [0 4 8])))))
(deftest a-nested-selection-converts-the-open-playhead-to-its-owning-symbol (deftest an-ordinary-symbol-keeps-a-row-per-node
(let [doc (update-in (fixture/document) [:symbols :main] dissoc :display)
rows (timeline/rows doc :main #{})]
(is (empty? (filter :lane? rows)))
(is (= #{[:a] [:b] [:insert] [:plate]} (set (map :path rows))))))
(deftest a-nested-selection-converts-the-open-playhead-to-its-owner
(let [doc (assoc-in (fixture/document) [:symbols :outer] (let [doc (assoc-in (fixture/document) [:symbols :outer]
{:id :outer :frames 30 {:id :outer :frames 30
:nodes {:take {:id :take :kind :instance :z "a" :nodes {:take {:id :take :kind :instance :z "a"
@ -49,133 +59,59 @@
(is (= 12 (ui/selection-frame doc nil :main (is (= 12 (ui/selection-frame doc nil :main
[:node :main :a [:a]] 12))))) [:node :main :a [:a]] 12)))))
(deftest polygon-landing-follows-the-target-not-the-selection (deftest polygon-landing-obeys-the-destination-symbol-mode
(let [doc (fixture/document) (let [lane (fixture/document)
db {:ui {:open :main ordinary (update-in lane [:symbols :main] dissoc :display)
:time-view :timeline db {:ui {:open :main :target {:sid :main :id :plate :path [:plate]}}
:selection [:node :main :plate [:plate]] :playback {:frame 5}}]
:target {:sid :main :id :insert :path [:insert]}} (is (true? (:lane? (ui/polygon-landing lane {} db))))
:playback {:frame 5}} (is (false? (:lane? (ui/polygon-landing ordinary {} db))))))
landing (ui/polygon-landing doc {} db)]
(is (= doc (:clip landing)))
(is (= [:insert] (:path landing))
"looking at another shape does not silently move the creation target")
(is (false? (:lane? landing)))))
(deftest cel-sheet-polygon-landing-is-decided-by-the-aimed-lane (deftest beginning-a-polygon-does-not-invent-a-lane
(let [doc (fixture/document)
base {:ui {:open :main
:time-view :cel-sheet
:selection [:node :main :plate [:plate]]
:target {:sid :main :id :girl :path [:girl]}}
:playback {:frame 5}}
occupied (ui/polygon-landing doc {} base)
with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest}))
gap (ui/polygon-landing with-gap {} (assoc-in base [:playback :frame] 6))]
(is (= [:b] (:path occupied))
"the cel on screen wins even while an unrelated stage node is selected")
(is (= doc (:clip occupied)) "an existing cel needs no document edit")
(is (true? (:lane? occupied)))
(is (= 1 (count (:path gap))))
(is (not (contains? (get-in with-gap [:symbols :main :nodes])
(first (:path gap))))
"a gap receives a fresh drawing")
(is (contains? (get-in (:clip gap) [:symbols :main :nodes])
(first (:path gap))))
(is (empty? (clip/problems (:clip gap))))))
(deftest cel-sheet-polygon-landing-refuses-without-an-aimed-lane
(let [doc (fixture/document)
db {:ui {:open :main :time-view :cel-sheet
:target {:sid :main :id :plate :path [:plate]}}
:playback {:frame 5}}
landing (ui/polygon-landing doc {} db)]
(is (re-find #"drawing lane" (:refused landing)))
(is (true? (:lane? landing)))
(is (nil? (:clip landing)))))
(deftest beginning-a-polygon-materializes-a-missing-cel-sheet-drawing
(let [doc (fixture/document)
with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest}))
id (store/install! {:clip with-gap :store {}} "polygon-start-test")
db {:clip/current id :paint/revision 0
:ui {:open :main :time-view :cel-sheet
:target {:sid :main :id :girl :path [:girl]}}
:playback {:frame 6}}
after (ui/beginning-polygon db)
saved (:clip (store/entry (:clip/current after)))
[_ sid cel-id path] (get-in after [:ui :selection])]
(is (= :polygon (get-in after [:ui :tool])))
(is (= [] (get-in after [:ui :draft])))
(is (= :main sid))
(is (= [cel-id] path))
(is (contains? (get-in saved [:symbols :main :nodes]) cel-id)
"the drawing exists before the first draft point is added")
(is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at])))
(is (empty? (clip/problems saved)))))
(deftest beginning-a-polygon-materializes-a-lane-before-its-drawing
(let [doc (clip/blank) (let [doc (clip/blank)
id (store/install! {:clip doc :store {}} "polygon-lane-start-test") id (store/install! {:clip doc :store {}} "polygon-no-implicit-lane")
db {:clip/current id :paint/revision 0 db {:clip/current id :paint/revision 0
:ui {:open :main :time-view :cel-sheet} :ui {:open :main}
:playback {:frame 6}} :playback {:frame 6}}
after (ui/beginning-polygon db) after (ui/beginning-polygon db)
saved (:clip (store/entry (:clip/current after))) saved (:clip (store/entry (:clip/current after)))]
lanes (symbol/lanes (get-in saved [:symbols :main :nodes]))
lane-id (:id (first lanes))
[_ sid cel-id path] (get-in after [:ui :selection])]
(is (= :polygon (get-in after [:ui :tool]))) (is (= :polygon (get-in after [:ui :tool])))
(is (= 1 (count lanes))) (is (= {} (get-in saved [:symbols :main :nodes])))
(is (= {:sid :main :id lane-id :path [lane-id]} (is (nil? (get-in saved [:symbols :main :display])))
(get-in after [:ui :target]))) (is (nil? (get-in (store/entry (:clip/current after)) [:history :done])))))
(is (= :main sid))
(is (= [cel-id] path))
(is (= lane-id (get-in saved [:symbols :main :nodes cel-id :parent])))
(is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at])))
(is (= 1 (count (get-in (store/entry (:clip/current after))
[:history :done])))
"the lane and drawing are one start-polygon undo step")
(is (empty? (clip/problems saved)))))
(deftest sequence-commands-use-isolated-history-transactions (deftest sequence-commands-use-isolated-history-transactions
(let [doc (fixture/document) (let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "sequence-test") id (store/install! {:clip doc :store {}} "sequence-command-test")
db {:clip/current id :paint/revision 0 db {:clip/current id :paint/revision 0
:ui {:open :main :selection [:node :main :a [:a]]}} :ui {:open :main :selection [:node :main :a [:a]]}}
refused (ui/apply-lane-command db :main refused (ui/apply-command db :main
(lane/extend-hold doc :main :a 1 {}) [:retry])] (span/extend-hold doc :main :a 1 {}) [:retry])]
(is (= doc (:clip (store/entry id)))) (is (= doc (:clip (store/entry id))))
(is (nil? (:history (store/entry id)))) (is (= [:retry] (get-in refused [:ui :retry])))
(is (= [:retry] (get-in refused [:ui :lane-retry]))) (let [r1 (span/extend-hold doc :main :a 1 {:extent :grow-symbol})
(let [r1 (lane/extend-hold doc :main :a 1 {:extent :grow-symbol}) db1 (ui/apply-command db :main r1 nil)
db1 (ui/apply-lane-command db :main r1 nil) r2 (span/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol})
r2 (lane/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol}) db2 (ui/apply-command db1 :main r2 nil)
db2 (ui/apply-lane-command db1 :main r2 nil)
h (:history (store/entry id)) h (:history (store/entry id))
undo (history/undo h (leaf/leaves "u" (:clip r2))) undo (history/undo h (leaf/leaves "u" (:clip r2)))
undo2 (history/undo (:history undo) (:leaves undo))] undo2 (history/undo (:history undo) (:leaves undo))]
(is (= 2 (count (:done h))) "rapid button presses remain separate commands") (is (= 2 (count (:done h))))
(is (= (:clip r1) (leaf/clip "u" (:leaves undo)))) (is (= (:clip r1) (leaf/clip "u" (:leaves undo))))
(is (= doc (leaf/clip "u" (:leaves undo2)))) (is (= doc (leaf/clip "u" (:leaves undo2))))
(is (= [:node :main :a [:a]] (get-in db2 [:ui :selection])))))) (is (= [:node :main :a [:a]] (get-in db2 [:ui :selection]))))))
(deftest a-correction-is-one-step-and-keeps-the-full-selection-address (deftest an-expanded-lane-opens-the-selected-clip
(let [doc (fixture/document) (let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "correction-event-test") rows (timeline/rows doc :main #{[:arthur.ui.timeline/lane] [:insert]} [:insert])
selection [:node :main :a [:outer :a]] portal (first (filter :portal? rows))]
db {:clip/current id :paint/revision 0 (is (= [:insert] (:path portal)))
:ui {:open :outer :selection selection}} (is (= [:node :main :insert [:insert]] (:select portal)))
result (correction/add doc :main :a [:xform :rot] (is (some #{"mark"} (map :label rows)))))
{:id :nudge :support [0 3] :motion :return
:start 0 :peak 0.5 :peak-frame 1}) (deftest a-lane-of-sounds-is-not-flattened-twice
after (ui/apply-correction-command db result) (let [base (:clip (span/draw-as-lane (clip/blank) :main true {}))
entry (store/entry id)] doc (clip/place-sound base :main {:sound "s1"} "voice" 6 1 2 :vo)
(is (= selection (get-in after [:ui :selection]))) lane (first (filter :lane? (timeline/rows doc :main #{} nil)))]
(is (= 1 (count (get-in entry [:history :done])))) (is (= [:vo] (mapv :id (:cels lane))))
(is (= 0.5 (get-in (:clip entry) (is (empty? (timeline/sound-rows doc :main #{})))))
[: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])))))))

442
frontend/test/browser/lane.mjs
View file

@ -1,5 +1,5 @@
// Local editor smoke test. Uses the in-memory blank document and disables the // Browser smoke test for the explicit-lane workflow. It uses the in-memory
// project route, so it never creates an account, project, or server-side write. // document and disables project routing, so it performs no server-side write.
import { spawn } from 'node:child_process'; import { spawn } from 'node:child_process';
import { mkdtempSync, rmSync } from 'node:fs'; import { mkdtempSync, rmSync } from 'node:fs';
import { tmpdir } from 'node:os'; import { tmpdir } from 'node:os';
@ -7,7 +7,7 @@ import { join } from 'node:path';
import assert from 'node:assert/strict'; import assert from 'node:assert/strict';
const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/'; const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/';
const profile = mkdtempSync(join(tmpdir(), 'arthur-sequence-')); const profile = mkdtempSync(join(tmpdir(), 'arthur-explicit-lane-'));
const port = 9335; const port = 9335;
const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [ const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
'--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run', '--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run',
@ -16,6 +16,7 @@ const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
], { stdio: 'ignore' }); ], { stdio: 'ignore' });
const sleep = ms => new Promise(resolve => setTimeout(resolve, ms)); const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));
let ws; let ws;
try { try {
let target; let target;
for (let i = 0; i < 100 && !target; i++) { for (let i = 0; i < 100 && !target; i++) {
@ -23,11 +24,12 @@ try {
try { try {
target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json())) target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json()))
.find(t => t.type === 'page' && t.url.startsWith(url)); .find(t => t.type === 'page' && t.url.startsWith(url));
} catch { /* browser starting */ } } catch { /* Chromium is still starting. */ }
} }
assert(target, 'browser exposes the editor page'); assert(target, 'browser exposes the editor page');
ws = new WebSocket(target.webSocketDebuggerUrl); ws = new WebSocket(target.webSocketDebuggerUrl);
await new Promise((resolve, reject) => { ws.onopen = resolve; ws.onerror = reject; }); await new Promise((resolve, reject) => { ws.onopen = resolve; ws.onerror = reject; });
let serial = 0; let serial = 0;
const pending = new Map(); const pending = new Map();
const errors = []; const errors = [];
@ -35,10 +37,10 @@ try {
const msg = JSON.parse(data); const msg = JSON.parse(data);
if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails); if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails);
if (msg.id && pending.has(msg.id)) { if (msg.id && pending.has(msg.id)) {
const { resolve, reject } = pending.get(msg.id); const waiting = pending.get(msg.id);
pending.delete(msg.id); pending.delete(msg.id);
if (msg.error) reject(new Error(JSON.stringify(msg.error))); if (msg.error) waiting.reject(new Error(JSON.stringify(msg.error)));
else resolve(msg.result); else waiting.resolve(msg.result);
} }
}; };
const send = (method, params = {}) => new Promise((resolve, reject) => { const send = (method, params = {}) => new Promise((resolve, reject) => {
@ -47,13 +49,16 @@ try {
ws.send(JSON.stringify({ id, method, params })); ws.send(JSON.stringify({ id, method, params }));
}); });
const evaluate = async expression => { const evaluate = async expression => {
const r = await send('Runtime.evaluate', { expression, returnByValue: true, awaitPromise: true }); const result = await send('Runtime.evaluate', {
if (r.exceptionDetails) throw new Error(JSON.stringify(r.exceptionDetails)); expression, returnByValue: true, awaitPromise: true,
return r.result.value; });
if (result.exceptionDetails) throw new Error(JSON.stringify(result.exceptionDetails));
return result.result.value;
}; };
await send('Runtime.enable'); await send('Runtime.enable');
for (let i = 0; i < 100; i++) { for (let i = 0; i < 100; i++) {
if (await evaluate('typeof arthur !== "undefined" && !!arthur.events?.ui && !!document.querySelector("canvas.stage")')) break; if (await evaluate('typeof arthur !== "undefined" && !!document.querySelector("canvas.stage")')) break;
await sleep(100); await sleep(100);
} }
await evaluate(`(() => { await evaluate(`(() => {
@ -61,332 +66,145 @@ try {
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test'))); cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test')));
window.laneSnapshot = () => { window.laneSnapshot = () => {
const db = cljs.core.deref(re_frame.db.app_db); const db = cljs.core.deref(re_frame.db.app_db);
const entry = arthur.footage.store.entry(cljs.core.get(db, k('clip/current'))); return cljs.core.clj__GT_js(arthur.footage.store.entry(cljs.core.get(db, k('clip/current'))));
return cljs.core.clj__GT_js(entry);
}; };
return true; return true;
})()`); })()`);
await sleep(250); await sleep(250);
// A command is named the same wherever it is drawn, and since the transport
// strip was consolidated it is drawn in one of two places: as a button in the const named = label => `(b => b.getAttribute('aria-label') === ${JSON.stringify(label)}` +
// strip, or as a row in one of the strip's menus. So the test asks for it by ` || b.textContent.trim() === ${JSON.stringify(label)})`;
// name and this finds it — opening each menu in turn to look — rather than the const closeMenus = async () => {
// test knowing which menu anything ended up in. An icon button is matched on await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(x => x.click()); return true })()`);
// its `aria-label`, which is also what a screen reader is told it is. await sleep(80);
// Two bars carry commands: the location bar says where an edit lands and holds
// what creates things there, the transport strip holds what acts on a cel.
const bars = ['.loc', '.pane.time .pane-head', '.section'];
const within = (suffix) => bars.map((b) => `${b} ${suffix}`).join(', ');
const named = label =>
`(b => b.textContent.trim() === ${JSON.stringify(label)}` +
` || b.getAttribute('aria-label') === ${JSON.stringify(label)})`;
const shut = async () => {
await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(s => s.click()); return true })()`);
await sleep(120);
}; };
// Leaves the control on screen and returns what to select it with. const clickNew = async label => {
const reveal = async label => { await closeMenus();
await shut();
if (await evaluate(`![...document.querySelectorAll('${within('button')}')].find(${named(label)})`)) {
const menus = await evaluate(
`[...document.querySelectorAll('${within('.menu-wrap > button')}')].map(b => b.textContent.trim())`);
let found = false;
for (const menu of menus) {
await evaluate(`(() => { [...document.querySelectorAll('${within('.menu-wrap > button')}')]
.find(b => b.textContent.trim() === ${JSON.stringify(menu)}).click(); return true })()`);
await sleep(180);
if (await evaluate(`!![...document.querySelectorAll('.menu-item')].find(${named(label)})`)) { found = true; break; }
await shut();
}
assert(found, `a control named: ${label}`);
return '.menu-item';
}
return within('button');
};
const click = async label => {
const where = await reveal(label);
assert(await evaluate(`(() => { assert(await evaluate(`(() => {
const b = [...document.querySelectorAll('${where}')].find(${named(label)}); const menu = document.querySelector('.loc .menu-wrap > button');
if (!b || b.disabled) return false; if (!menu) return false;
b.click(); return true; menu.click(); return true;
})()`), `enabled control: ${label}`); })()`), 'new menu exists');
await sleep(180); await sleep(100);
await shut(); assert(await evaluate(`(() => {
const item = [...document.querySelectorAll('.menu-item')].find(${named(label)});
if (!item || item.disabled) return false;
item.click(); return true;
})()`), `enabled creation command: ${label}`);
await sleep(220);
await closeMenus();
}; };
// UUIDs expose a mutable hash cache through clj->js; compare their identity,
// not that implementation detail, when asserting exact undo restoration.
const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'), const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'),
(_key, value) => value?.uuid ?? value)); (_key, value) => value?.uuid ?? value));
const instances = s => Object.values(s.clip.symbols.main.nodes).filter(n => n.kind === 'instance') const mainInstances = s => Object.values(s.clip.symbols.main.nodes)
.sort((a, b) => a.time.at - b.time.at); .filter(n => n.kind === 'instance');
await click('lane'); const laneSymbols = s => Object.values(s.clip.symbols).filter(sym => sym.display === 'lane');
await click('new drawing');
await click('hold +'); assert.equal((await shot()).clip.symbols.main.display, undefined,
await click('hold +'); 'a blank document starts as an ordinary symbol');
await click('hold +');
await click('new drawing'); await clickNew('inside');
let s = await shot(); let s = await shot();
assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 4], [4, 1]]); let placed = mainInstances(s);
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 2); assert.equal(placed.length, 1, 'new symbol places one instance');
assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1); assert.equal(s.clip.symbols[placed[0].source.symbol].display, undefined,
assert.equal(await evaluate(`cljs.core.get_in(cljs.core.deref(re_frame.db.app_db), 'new symbol remains ordinary');
cljs.core.vector(cljs.core.keyword('playback'), cljs.core.keyword('frame')))`), 4, assert.equal(await evaluate('document.querySelectorAll(".tl-track").length'), 1,
'new drawing seeks to its cel'); 'an ordinary symbol is an ordinary timeline row');
// Shorten this test shot to the occupied extent, purely in memory. await clickNew('lane');
await evaluate(`(() => {
const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db);
arthur.footage.store.edit_clip_BANG_(cljs.core.get(db, k('clip/current')),
clip => cljs.core.assoc_in(clip, cljs.core.vector(k('symbols'), k('main'), k('frames')), 5));
document.querySelector('.tl-cel').click();
})()`);
await sleep(200);
const before = await shot();
await click('hold +');
s = await shot(); s = await shot();
assert.deepEqual(s.clip, before.clip, 'refused overflow makes no document change'); placed = mainInstances(s);
assert.equal(s.history.done.length, before.history.done.length); assert.equal(placed.length, 2, 'explicit lane places a second symbol');
await click('extend shot and apply'); assert.equal(laneSymbols(s).length, 1, 'only the lane command marks a symbol as a lane');
s = await shot(); assert.equal(await evaluate('[...document.querySelectorAll(".tl-track")].filter(t => t.arthurLane).length'), 1,
assert.equal(s.clip.symbols.main.frames, 6); 'the explicit lane is drawn as one linear track');
assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 5], [5, 1]]);
assert.equal(s.history.done.length, before.history.done.length + 1);
await evaluate(`document.dispatchEvent(new KeyboardEvent('keydown', {key:'z', ctrlKey:true, bubbles:true}))`);
await sleep(250);
assert.deepEqual((await shot()).clip, before.clip, 'one undo restores cel, ripple, and shot length');
// Sharing: one drawing exposed twice, then one cel decoupled. Room is assert.equal(await evaluate('document.querySelectorAll(".tl-rename").length'), 1,
// made first so these assertions are about content and not about overflow. 'the lane exposes its rename control');
await evaluate(`(() => { await evaluate('document.querySelector(".tl-rename").click()');
const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); await sleep(80);
arthur.footage.store.edit_clip_BANG_(cljs.core.get(db, k('clip/current')),
clip => cljs.core.assoc_in(clip, cljs.core.vector(k('symbols'), k('main'), k('frames')), 20));
document.querySelector('.tl-cel').click();
})()`);
await sleep(200);
const enabled = async label => {
const where = await reveal(label);
const yes = await evaluate(`(() => {
const b = [...document.querySelectorAll('${where}')].find(${named(label)});
return !!b && !b.disabled;
})()`);
await shut();
return yes;
};
assert.equal(await enabled('make unique'), false, 'nothing to decouple from yet');
await click('reuse');
s = await shot();
let cels = instances(s);
assert.equal(cels.length, 3);
assert.equal(cels[2].source.symbol, cels[0].source.symbol, 'reuse exposes the same drawing');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 3);
assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1,
'three cels, still one row');
assert.equal(await enabled('make unique'), true);
await click('make unique');
s = await shot();
cels = instances(s);
assert.notEqual(cels[2].source.symbol, cels[0].source.symbol, 'that cel has its own drawing');
assert.equal(await enabled('make unique'), false, 'and is not shared any more');
await click('duplicate');
s = await shot();
cels = instances(s);
assert.equal(cels.length, 4);
assert.equal(new Set(cels.map(n => n.source.symbol)).size, 4,
'four cels of four drawings: nothing is shared once every copy is made');
assert.equal(s.history.done.length, before.history.done.length + 3, 'three more commands, three more steps');
// A drawing into the middle of a hold: split, then insert. Both act at the
// playhead, and neither guesses what the other one is for.
const placed = s => instances(s)
.map(n => [n.time.at + n.span[0] / (n.time.rate ?? 1), n.time.at + n.span[1] / (n.time.rate ?? 1)])
.sort((a, b) => a[0] - b[0]);
assert.deepEqual(placed(s), [[0, 4], [4, 5], [5, 6], [6, 7]]);
await evaluate(`document.querySelector('.tl-cel').click()`);
await sleep(200);
assert.equal(await enabled('split'), false, 'the start of a cel is not inside it');
await click('+1');
await click('+1');
assert.equal(await enabled('split'), true);
await click('split');
s = await shot();
assert.deepEqual(placed(s), [[0, 2], [2, 4], [4, 5], [5, 6], [6, 7]],
'one cel became two, over the frames it had');
await click('insert');
s = await shot();
assert.deepEqual(placed(s), [[0, 2], [2, 3], [3, 5], [5, 6], [6, 7], [7, 8]],
'the new drawing took frame 2 and everything from there rippled later');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 6);
assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1,
'six cels, still one row');
assert.equal(s.history.done.length, before.history.done.length + 5);
// Trim, move and blank: three gestures that move nothing but their own
// cel, and a shot whose length does not follow what is in it.
await evaluate(`[...document.querySelectorAll('.tl-cel')][2].click()`);
await sleep(200);
assert.deepEqual(placed(await shot()).slice(2, 4), [[3, 5], [5, 6]]);
await click('+1');
assert.equal(await enabled('trim out'), true, 'the playhead is inside it');
await click('trim out');
s = await shot();
assert.deepEqual(placed(s), [[0, 2], [2, 3], [3, 4], [5, 6], [6, 7], [7, 8]],
'it ends at the playhead and every other cel stayed');
assert.equal(await enabled('move here'), true);
await click('move here');
s = await shot();
assert.deepEqual(placed(s), [[0, 2], [2, 3], [4, 5], [5, 6], [6, 7], [7, 8]],
'and moves to the playhead, into the gap it just made');
await click('blank');
s = await shot();
assert.deepEqual(placed(s), [[0, 2], [2, 3], [5, 6], [6, 7], [7, 8]],
'blanked: a gap where it was, and nothing closed it');
assert.equal(s.clip.symbols.main.frames, 20, 'the shot is as long as it was authored');
assert.equal(s.history.done.length, before.history.done.length + 8);
// The same cels with the axes turned. Selecting a sheet cell feeds the same
// action strip and therefore the same domain command and undo transaction.
await click('cel sheet');
assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 1,
'one lane is one cel-sheet column');
assert.equal(await evaluate('document.querySelectorAll(".cs-cell").length'), 20,
'one cell per authored frame');
await evaluate(`document.querySelector('.cs-cell').click()`);
await sleep(180);
await click('hold +');
s = await shot();
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(`(() => { assert(await evaluate(`(() => {
const section = [...document.querySelectorAll('.section')] const input = document.querySelector('.tl-name-input');
.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; if (!input) return false;
const set = Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set; Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value')
set.call(input, '15'); .set.call(input, 'Foreground');
input.dispatchEvent(new Event('input', {bubbles: true})); input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText'}));
input.dispatchEvent(new Event('change', {bubbles: true})); input.blur(); return true;
return true; })()`), 'lane rename editor opens');
})()`), 'rotation correction value is editable'); await sleep(180);
await sleep(100);
await click('apply correction');
s = await shot(); s = await shot();
const selectedCel = instances(s).find(n => n.time.at === 0); assert(mainInstances(s).some(n => n.name === 'Foreground'), 'lane name persists');
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 // Drag a library symbol into the explicit lane. The row itself is the target;
// only appears once a sheet has more than one lane. // no temporary lane is previewed or created.
await click('timeline'); const drop = await evaluate(`(() => {
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 5); const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]');
await click('lane'); const track = [...document.querySelectorAll('.tl-track')].find(t => t.arthurLane);
await click('cel sheet'); if (!source || !track) return null;
assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 2); source.scrollIntoView({block: 'center'});
await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2) const a = source.getBoundingClientRect(), b = track.getBoundingClientRect();
.find(c => c.textContent.trim() !== '—')).click()`); return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * .085, ty: b.top + b.height / 2};
})()`);
assert(drop, 'a pool symbol and explicit lane are available');
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx, y: drop.sy});
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: drop.sx, y: drop.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 12, y: drop.sy,
button: 'left', buttons: 1});
await sleep(100); await sleep(100);
await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2) await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.tx, y: drop.ty,
.find(c => c.textContent.trim() === '—')).click()`); button: 'left', buttons: 1});
await sleep(100); await sleep(120);
await click('overwrite'); assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0,
'pool drop does not preview an invented lane');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel.ghost").length'), 1,
'pool drop previews inside the existing lane');
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: drop.tx, y: drop.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
s = await shot(); s = await shot();
assert(Object.values(s.clip.symbols.main.nodes) assert.equal(Object.keys(laneSymbols(s)[0].nodes).length, 1,
.some(n => n.kind === 'instance' && n.parent !== 'girl' && n.time.at === 0), `the dropped clip remains in the explicit lane: ${JSON.stringify(s)}`);
'clicking a gap selects that column before overwrite'); assert.equal(laneSymbols(s).length, 1, 'the drop creates no extra lane');
assert.equal(s.history.done.length, before.history.done.length + 12,
'correction, lane creation, and overwrite are separate undo steps'); // A second explicit lane is a sibling in the open symbol even though the
// Real pointer capture and keyboard events exercise the spreadsheet surface. // first remains aimed. Move the clip between their linear tracks.
const cellAt = async (c, f) => evaluate(`(() => { await clickNew('lane');
const el = document.querySelector('[data-cs-col="${c}"][data-cs-frame="${f}"]'); s = await shot();
el.scrollIntoView({block: 'center'}); assert.equal(laneSymbols(s).length, 2, 'a second explicit command creates a second lane');
const r = el.getBoundingClientRect(); const move = await evaluate(`(() => {
return {x: r.x + r.width / 2, y: r.y + r.height / 2}; const tracks = [...document.querySelectorAll('.tl-track')].filter(t => t.arthurLane);
const from = tracks.find(t => t.querySelector('.tl-cel'));
const to = tracks.find(t => t !== from);
const cel = from?.querySelector('.tl-cel');
if (!cel || !to) return null;
const a = cel.getBoundingClientRect(), b = to.getBoundingClientRect();
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * .12, ty: b.top + b.height / 2};
})()`); })()`);
const mouse = (type, p) => send('Input.dispatchMouseEvent', { assert(move, 'two explicit lanes and a source clip are available');
type, ...p, button: 'left', buttons: type === 'mouseReleased' ? 0 : 1, clickCount: 1, await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: move.sx, y: move.sy,
}); button: 'left', buttons: 1, clickCount: 1});
const key = async (key, extra = {}) => { await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: move.tx, y: move.ty,
await send('Input.dispatchKeyEvent', {type: 'keyDown', key, ...extra}); button: 'left', buttons: 1});
await send('Input.dispatchKeyEvent', {type: 'keyUp', key, ...extra});
await sleep(120);
};
const start = await cellAt(0, 0);
await mouse('mousePressed', start);
await mouse('mouseMoved', await cellAt(1, 2));
await mouse('mouseReleased', await cellAt(1, 2));
await sleep(150); await sleep(150);
assert.equal(await evaluate('document.querySelectorAll(".cs-cell.selected").length'), 6); await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: move.tx, y: move.ty,
await key('c', {modifiers: 2}); button: 'left', buttons: 0, clickCount: 1});
const dest = await cellAt(0, 10); await sleep(300);
await mouse('mousePressed', dest); s = await shot();
await mouse('mouseReleased', dest); assert.deepEqual(laneSymbols(s).map(x => Object.keys(x.nodes).length).sort(), [0, 1],
await sleep(120); 'a clip body moves from one explicit lane to the other');
const beforePaste = await shot();
await key('v', {modifiers: 2});
const pasted = await shot();
assert.equal(pasted.history.done.length, beforePaste.history.done.length + 1,
'multi-lane paste is one undo step');
assert.deepEqual(Object.keys(pasted.clip.symbols), Object.keys(beforePaste.clip.symbols),
'copy reuses the drawings');
await key('z', {modifiers: 2});
assert.deepEqual((await shot()).clip, beforePaste.clip, 'undo restores the entire rectangle');
await key('ArrowDown', {modifiers: 8});
assert.equal(await evaluate('document.querySelectorAll(".cs-cell.selected").length'), 2);
const first = await cellAt(0, 0);
await mouse('mousePressed', first);
await mouse('mouseReleased', first);
await sleep(150);
const handle = await evaluate(`(() => {
const r = document.querySelector('.cs-fill-handle').getBoundingClientRect();
return {x: r.x + r.width / 2, y: r.y + r.height / 2};
})()`);
const beforeHold = await shot();
await mouse('mousePressed', handle);
await mouse('mouseMoved', await cellAt(0, 4));
await mouse('mouseReleased', await cellAt(0, 4));
await sleep(150);
const afterHold = await shot();
assert.equal(afterHold.history.done.length, beforeHold.history.done.length + 1,
'a hold drag commits once');
assert.equal(instances(afterHold).filter(n => {
const old = instances(beforeHold).find(o => o.id === n.id);
return old && n.span[1] !== old.span[1] && n.time.at + n.span[1] === 5;
}).length, 1, 'the dragged hold ends at the previewed boundary');
await key('z', {modifiers: 2});
assert.deepEqual((await shot()).clip, beforeHold.clip);
await key('Delete');
const cleared = await shot();
assert.equal(cleared.history.done.length, beforeHold.history.done.length + 1,
'Delete clears selected frames in one step, without the global node-delete handler');
assert.equal(cleared.clip.symbols.main.frames, beforeHold.clip.symbols.main.frames);
await key('z', {modifiers: 2});
assert.deepEqual((await shot()).clip, beforeHold.clip);
await key('x', {modifiers: 2});
assert.equal((await shot()).history.done.length, beforeHold.history.done.length + 1);
await key('z', {modifiers: 2});
assert.deepEqual((await shot()).clip, beforeHold.clip, 'cut is independently undoable');
assert.equal(errors.length, 0, JSON.stringify(errors)); assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: lane commands and corrections agree from timeline and cel sheet; no server writes'); console.log('PASS: symbols are ordinary; explicit lanes rename, accept drops, and exchange clips');
} finally { } finally {
if (ws?.readyState === WebSocket.OPEN) { if (ws?.readyState === WebSocket.OPEN) ws.close();
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); chrome.kill('SIGTERM');
await sleep(350); await new Promise(resolve => chrome.once('exit', resolve));
}
ws?.close();
chrome.kill();
await new Promise(resolve => { if (chrome.exitCode !== null || chrome.signalCode !== null) resolve(); else chrome.once('exit', resolve); });
try { try {
rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 });
} catch (error) { } catch (error) {
console.warn(`Temporary browser profile retained at ${profile}: ${error.code}`); if (error.code !== 'ENOTEMPTY') throw error;
} }
} }

137
static/arthur/app.css
View file

@ -228,8 +228,7 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
/* Buttons that are one control: a transport, a stepper, a mode picker. They /* Buttons that are one control: a transport, a stepper, a mode picker. They
share their borders, so the group reads as a single object with parts rather share their borders, so the group reads as a single object with parts rather
than as several things that happen to be adjacent — which is the whole claim than as several things that happen to be adjacent — which is the whole claim
a segmented control makes, and the reason `timeline` and `cel sheet` are one a segmented control makes. `.seg` is `.group` with that meaning; both are drawn
of these. `.seg` is `.group` with that meaning; they are drawn the same
because the difference is what the buttons do, not how they look. because the difference is what the buttons do, not how they look.
The negative margin collapses the doubled border between two buttons into The negative margin collapses the doubled border between two buttons into
@ -252,12 +251,6 @@ button.ico > svg { display: block; width: 11px; height: 11px; }
/* Play is the one control in the strip you aim at without looking. */ /* Play is the one control in the strip you aim at without looking. */
button.ico-play { padding-left: 8px; padding-right: 8px; } button.ico-play { padding-left: 8px; padding-right: 8px; }
/* `hold −` / `hold +`: one label over two steppers, because the word is shared
and repeating it in both buttons was most of their width. */
.stepper { display: flex; align-items: center; gap: 4px; }
.stepper-label { color: var(--dim); }
.stepper button { padding: 1px 6px; }
/* A number that changes every frame. Tabular figures stop it twitching, and /* A number that changes every frame. Tabular figures stop it twitching, and
stop the controls after it being nudged about as the count passes 9 and 99. */ stop the controls after it being nudged about as the count passes 9 and 99. */
.readout { font-variant-numeric: tabular-nums; } .readout { font-variant-numeric: tabular-nums; }
@ -1003,9 +996,13 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
} }
.tl-label.on { background: var(--sel-bg); } .tl-label.on { background: var(--sel-bg); }
.tl-label.aimed { box-shadow: inset 0 0 0 2px var(--aim); }
.tl-label:hover:not(.on) { background: #fff; } .tl-label:hover:not(.on) { background: #fff; }
.tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; } .tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; }
.tl-label .kind { color: var(--dim); } .tl-label .kind { color: var(--dim); }
.tl-name-input { min-width: 0; flex: 1; font: inherit; }
.tl-rename { margin-left: auto; padding: 0 3px; border: 0; background: none; color: var(--dim); }
.tl-rename:hover { color: var(--fg); }
/* A fixed-width cell whether or not there is a triangle in it, so names at the /* A fixed-width cell whether or not there is a triangle in it, so names at the
same depth line up down the column. */ same depth line up down the column. */
@ -1087,7 +1084,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
} }
/* The preview row of a drop in flight: its own length, where it would start. */ /* The preview row of a drop in flight: its own length, where it would start. */
.tl-span.ghost, .tl-label.ghost { pointer-events: none; } .tl-span.ghost, .tl-label.ghost, .tl-cel.ghost { pointer-events: none; }
.tl-cel.ghost { background: transparent; border: 1px dashed var(--sel); color: var(--sel); }
/* A row being dragged over another: into an instance, or grouped with a node, /* A row being dragged over another: into an instance, or grouped with a node,
by its middle; in front of it or behind it, by its top or bottom edge. */ by its middle; in front of it or behind it, by its top or bottom edge. */
@ -1099,6 +1097,29 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
/* A node's bar slides it along its symbol's time. */ /* A node's bar slides it along its symbol's time. */
.tl-span.movable { cursor: ew-resize; touch-action: none; } .tl-span.movable { cursor: ew-resize; touch-action: none; }
.tl-span.movable.sliding { border-color: var(--sel); } .tl-span.movable.sliding { border-color: var(--sel); }
.tl-edge {
position: absolute;
top: -1px;
bottom: -1px;
width: 7px;
cursor: e-resize;
touch-action: none;
z-index: 2;
}
.tl-edge.out { right: -3px; }
.tl-edge.in { left: -3px; }
.tl-junction {
position: absolute;
top: -1px;
left: 0;
bottom: -1px;
width: 12px;
transform: translateX(-50%);
cursor: col-resize;
touch-action: none;
z-index: 3;
}
.tl-cel-label { display: block; overflow: hidden; text-overflow: ellipsis; pointer-events: none; }
.tl-span.ghost { .tl-span.ghost {
background: transparent; background: transparent;
border: 1px dashed var(--sel); border: 1px dashed var(--sel);
@ -1143,79 +1164,6 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.tl-empty { padding: 9px; color: var(--dim); } .tl-empty { padding: 9px; color: var(--dim); }
/* The second temporal view. Its cells carry the same selection addresses as
the cel blocks above; only the axes change. */
.cel-sheet {
flex: 1;
min-height: 0;
overflow: auto;
display: grid;
align-content: start;
background: var(--line);
gap: 1px;
}
.cs-head,
.cs-frame,
.cs-cell {
min-width: 0;
height: 24px;
border: 0;
border-radius: 0;
padding: 0 6px;
background: #fff;
color: var(--fg);
overflow: hidden;
text-overflow: ellipsis;
white-space: nowrap;
}
.cs-head {
position: sticky;
top: 0;
z-index: 2;
display: flex;
align-items: center;
background: var(--chrome);
font-weight: 600;
cursor: pointer;
}
.cs-head.cs-frame { z-index: 3; }
.cs-frame { position: sticky; left: 0; z-index: 1; color: var(--dim); text-align: right; }
.cs-frame.on, .cs-cell.current { box-shadow: inset 3px 0 0 var(--playhead); }
.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); }
/* AIMED COMPOSES WITH SELECTED rather than replacing it: the ring is the aim,
the tint is the selection, and a row that is both wears both. No name tag in
the chrome — the thing the ring is around is already the name. */
.tl-label.aimed,
.cs-head.aimed { box-shadow: inset 0 0 0 2px var(--aim); }
.cs-head.aimed { color: var(--aim); }
.cs-empty {
display: grid;
justify-items: center;
align-content: center;
gap: 6px;
padding: 28px 16px;
background: var(--pane);
text-align: center;
}
.cs-empty p { margin: 0; }
.cs-empty .dim { color: var(--dim); font-size: 11px; }
.cs-empty button { margin-top: 4px; }
.cel-sheet { user-select: none; touch-action: none; }
.cs-cell { position: relative; }
.cs-cell:focus-visible { outline: 2px solid var(--sel); outline-offset: -2px; }
.cs-help { padding: 6px 10px; color: var(--dim); font-size: 11px;
white-space: nowrap; overflow: hidden; text-overflow: ellipsis; }
.cs-fill-handle { position: absolute; right: 0; bottom: 0; width: 9px; height: 9px;
background: var(--sel); border: 1px solid white; cursor: ns-resize; z-index: 2; }
.cs-preview { outline: 1px dashed var(--sel); outline-offset: -1px; }
/* -------------------------------------------------------------------------- /* --------------------------------------------------------------------------
the video -> symbol dialog */ the video -> symbol dialog */
@ -1323,3 +1271,28 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
letter-spacing: 0.04px; letter-spacing: 0.04px;
} }
.paint-overlay:focus { outline: none; } .paint-overlay:focus { outline: none; }
/* What a drag in flight would do, beside the pointer: a clip body moves in
time, and with shift it goes inside the clip under the pointer. Said next to
the cursor because that is where the eye already is mid-gesture. */
.tl-hint {
position: fixed;
z-index: 60;
padding: 2px 6px;
border-radius: 3px;
background: var(--fg);
color: var(--bg);
font-size: 11px;
white-space: nowrap;
pointer-events: none;
}
.tl-hint.nesting { background: var(--sel); color: #fff; }
/* The clip a shift-drag would nest into. Inset, so it reads as "into this"
rather than as a boundary between rows. */
.tl-cel.nest-target { outline: 2px solid var(--sel); outline-offset: -2px; }
/* A row inside a held clip: shown because the node is on screen for the whole
hold, dimmed because its own frames have no place on this ruler. */
.tl-span.unmapped { opacity: 0.45; cursor: pointer; }
.tl-hint.refusing { background: var(--bad, #b00); color: #fff; }