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

Compare commits

base: noe:ae03b61dcaf7b93f1bfadbc48da00cad2cbbf15f
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes
...
compare: noe:3dbbe285fc3f4e289fb2ce775f961d27fcb4f172
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes

15 commits
ae03b61dca ... 3dbbe285fc

Author SHA1 Message Date
Your Name
3dbbe285fc bread crumbs 2026-10-01 00:27:01 -04:00
Your Name
5fb04f6a7d better toolbar 2026-10-01 00:11:16 -04:00
Your Name
2f1c9b9c02 Turn the lane sideways without changing what it means 
The cel sheet is a second projection of the same lane rows: frames run down, lanes run across, and each occupied cell carries the timeline cel's exact selection address. The shared action strip proves the point in the browser test by selecting a cell and issuing the existing hold command.

Before exposing that second entrance, fix the boundary mistakes it revealed. Nested commands now convert the open playhead through their enclosing instance path. Overwrite composes blanking with non-rippling placement as one transaction. Picture-rate and pose sampling select only the generated base frame while hand corrections retain the node's authored frame. Stack validation follows covering replacement layers so a document accepted by the validator cannot throw solely because a later offset sees a different shape.

429 tests, 5,767 assertions; both browser flows; 56 Django tests; optimized frontend build.
 2026-09-30 19:59:38 -04:00
Your Name
7a54bfca56 Write down what the next person needs 
`docs/lane-handoff.md`, after `timing-handoff.md`'s shape, because the next
thread starts cold and the expensive part of that is not the code — it is the
decisions that were argued out and would otherwise be argued again.

So the section that matters most is the one listing what NOT to re-litigate:
the shot length is authored, placing ripples and overwrite is blank-then-place,
a position inside a cel refuses and names split, a correction has no time space
of its own, a layer's values are a channel, a conflict is not a problem, and a
command refuses rather than guesses. Each of those is a paragraph here and a
commit message in full.

Then the vocabulary, since it was settled one commit ago and the old words are
still in this repository's history: instance, cel, lane, drawing, and placement
for where a node sits only. With the warning that `exposure` still means the
`:expose` grid and always did.

Then the mechanisms that keep paying out — `:span` in the node's own frames
above all, which is why split, trim and blank cost almost nothing — the known
gaps, and how to run the suites, including that a release build clobbers the dev
bundle the browser tests need.

Recommended next piece is the cel sheet: it needs no new model, and it is the
first real evidence the document is not shaped by the timeline that grew up
with it.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 19:45:28 -04:00
Your Name
598c186c4f One word for one thing: it is a cel 
Four words had accumulated for a node that puts a symbol inside another symbol.
`instance` was the document's, from the model. `placement` was the stage and
export work's. `occurrence` came in with the lane model. `exposure` came in with
me, because it is what an animator would say. Three bodies of work each brought
a word and none of them retired anybody else's, which is how you get a codebase
that reads like three people describing the same object over each other.

It is a CEL. One drawing, held for some duration. `cel` was already the view's
word — `.tl-cel`, the cel strip — so choosing it was also the smallest change,
and the app already says "drawing" for the content, which is what frees the word
up: historically a cel IS the celluloid with the drawing on it, and that sense
has somewhere else to live here.

  instance   the `:kind`. The general thing, anywhere in a document.
  cel        an instance in a lane. UI labels, command names, prose.
  lane       the group with `:layout :sequence`.
  drawing    the content a cel names.
  placement  kept ONLY for where a node sits — `nest/placement` and the
             transform that puts a face on the stage. Retired as a noun for the
             node itself.
  occurrence gone.

AND IT SETTLES A COLLISION I SHOULD HAVE SEEN EARLIER. `:time :expose` already
existed and means something else entirely: how many frames each step of a
subtree lasts, which is what shooting on twos is. Had the block been called an
exposure too, `node/expose`, `clock/exposed-frame` and `subs/render ::exposure`
would have been permanently confusable with it. Choosing `cel` lets the word
`exposure` keep the thing it actually names, and every remaining use of it in
`src` is now that one.

`:layout :sequence` stays as the field, and it is the one place two words are
kept deliberately: the layout names the RULE — children follow one another and
may not overlap — and a group carrying it is called a lane. `node/lane?` says so
where the two meet.

The second view is traditionally the exposure sheet. It will be the CEL SHEET,
for one vocabulary.

Renamed with a script and then read, because a blind pass does real damage: it
produced "an cel" thirty times, renamed the `::exposure` sub that is about the
`:expose` grid, and turned an "exposure grid" into a "cel grid" in two
docstrings. All three classes are fixed. `arthur.domain.sequence` is now
`arthur.domain.lane`, which is what its test file was already called.

424 tests, 5,749 assertions, and both browser flows — `test/browser/lane.mjs`,
renamed too.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 19:43:18 -04:00
Your Name
76106d36ee The shot is as long as somebody said it was 
Trim, move and blank, and the decision they all three walked into: is the shot's
length authored, or derived from what is in it?

AUTHORED. `:frames` is the symbol's window — how long the shot IS — and the
occupied extent of its lanes is a different fact, read off the occurrences. A
command grows the window when the caller says `:grow-symbol` and NEVER shrinks
it, so blanking the end of a shot leaves a shot with empty frames at the end.
That is a true statement about what somebody authored, and the alternative is
deleting the last drawing and quietly shortening the film. `finish` had the
right behaviour by accident — `(apply max (:frames sym) ...)` — and now says
which number is which: `needed` is where the occurrences reach, `:frames` is
what was authored, and the only thing that makes the second follow the first is
a caller asking.

The three commands turned out to be one piece of geometry, which is `split`'s.
A `:span` is in the occurrence's OWN frames and `:time` says where those land in
the lane, so moving an edge of an exposure is ONE WRITE to `:span` and `:time`
and `:playback` are never touched. `local` and `edged` are the whole of it, and
split now goes through them too.

  trim   narrows one edge and moves nothing else. Lengthening is `extend-hold`,
         which carries a ripple policy and a shot-length policy because it needs
         them; letting trim grow as well would give one gesture two sets of
         rules and a way to overlap its neighbour.
  move   one write to `:time :at`, and a destination that would overlap is
         REFUSED rather than rippled. Moving a drawing and re-timing the ones
         around it are different intentions, and a move that pushed the rest
         would be the second wearing the first one's name. Clear the room first.
  blank  leaves a gap and does not close it. Wholly inside the range goes,
         overlapping an end is trimmed to it, spanning the range is split — the
         one case that needs an ID, and it asks for one instead of inventing it.

Because the source clock is untouched, trimming the front of a playing insert
starts it LATER INTO its animation rather than restarting it, which is the
difference between trimming and slipping and the reason they stay two commands.
The test samples the frames it kept and asserts they show what they showed.

Blanking leaves the drawings in the library. A lane does not own its content,
and a drawing whose last exposure is gone is still a drawing somebody made.

Overwrite is now `blank` then `place` and needs no policy argument of its own,
which is why it still is not one.

424 tests, 5,749 assertions. The browser flow trims an exposure at the playhead,
moves it into the gap that made, blanks it, and checks the shot is still as long
as it was authored.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 16:32:59 -04:00
Your Name
72b57e3786 Regenerate the base, keep the hand work, and say when you cannot 
The loop the layer design exists for, tested for the first time: correct a
generated channel by hand, turn the generator's knob, and get the new base with
the correction still on it. `replace-feature` already carried `:over` across —
somebody anticipated this — so the feature path needed a test and not a fix.
The head path needed a fix, and there was a second fault of my own making.

`regenerate-head` leaves the head's authored channels alone once somebody has
placed it by hand, and decided that by `(= (:channels old) (:measured old))`.
Sound, until a correction exists: an `:over` layer makes those unequal, so the
FIRST correction anyone made would have stopped the head following
re-measurement for good — the exact opposite of what a layer is for. It compares
the channels without their layers now. The test fails against the old guard,
which is how I know the bug was real and not a story about one.

The other fault was mine, from the commit before this one. An `:offset` whose
shape does not match its base threw, which is right for authored data — the
validator catches it — but WRONG for the case the model actually names: turn the
mouth's `:verts` knob and the re-freeze gives it a different number of points,
so a correction that was correct when it was made stops fitting through nobody's
error, and a throw in the read path takes the stage down.

So a base that has outgrown a correction is a CONFLICT, and a conflict is the
third thing beside applied and discarded. The regeneration records `:conflict`
on the layer; the layer stays exactly where it is; `over-at` skips it, so the
picture is the base meanwhile; and `clip/conflicts` lists them for a view to
offer. A later regeneration that restores the shape clears the mark, so
resolving one can be as simple as putting the knob back.

Deliberately NOT `problems`. A document with a conflict loads, evaluates and
saves — it contains a decision nobody has made yet, and refusing to open it
would be the persistence layer taking a side in an editing question. The
distinction in the validator is one line: a shape mismatch nobody has recorded
is an authoring bug, and one a regeneration recorded is a conflict.

`channel/conflict-with` is the single rule for "can this layer apply to this
base", used by the validator, by `conflicts`, and by the regeneration that marks
them. Only `:offset` can conflict, since `:replace` states a whole value and has
nothing to agree with; a shape that cannot be read yet — an empty key map — is
not a disagreement. `value-shape` answers it without sampling anything.

414 tests, 5,696 assertions, and `:verts` in the test is a real topology change
rather than a synthetic one.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 16:22:02 -04:00
Your Name
94c0a21de1 A correction is a layer, and a layer's values are a channel 
`:over` was specified in animation-model.md, refused in two places, and
produced by nothing: `check-unimplemented!` threw on read and `channel/problems`
reported it. It reads now. This is the part of the model the rotoscoping half
depends on — generate motion, correct it by hand, turn the knob, keep the
correction — and it was the last thing in the design that had never been tried.

The shape that made it small: A LAYER'S VALUES ARE A CHANNEL.

  {:id :nudge :support [88 98] :op :offset
   :values {:animated? true :interp :linear :keys {88 [2 0], 96 [0 0]}}}

So the three commands the lane model asks for over a selected range — a
constant adjustment, a ramp, a return motion — are one mechanism and not three:
framed values say the same thing on every frame they cover, keyed values move,
and neither needs a new way to say what a value is over time. A layer reads
through `value-at` and `cursor` like any channel, which is also what stopped
blending from becoming two implementations: `over-at` is shared, and the
specification and the playback path differ only in how they READ a layer —
recursively through `value-at`, or through a reading head of its own. One level
deep; a layer's values may not carry layers, which the stack already orders.

That was the risk worth spiking for. A cursor that drifts produces the wrong
pose rather than an error, and a stack means several reading heads per channel
where there was one. The agreement test that holds the cursor to the
specification in forward, backward and random frame order now covers stacked
channels too — including a layer whose head is asked for nothing across the long
stretches outside its support and then asked again, which is where drift would
hide.

`:support` is half-open and explicit. Outside it the base evaluates exactly as
it did before, which is the whole difference between a bounded correction and
inserting boundary keys: the latter alters the neighbouring segments, and the
lane model says so.

A LAYER HAS NO TIME SPACE OF ITS OWN, and this is the design question the doc
left open. Its support and its values' keys are in the frames the base channel's
keys are in — the node's. A correction on a lane is therefore in lane frames and
reaches across the drawings exposed beneath it; one on a single occurrence is in
that occurrence's frames and travels with it when the exposure moves. Ownership
had already answered it, so there is no field to disagree with, and both halves
are under test at lane level.

Two things cost nothing, which is worth recording. A channel is ONE LEAF, so a
correction persists inside it with no codec change at all. And `node/problems`
already reports every channel's problems, so a malformed layer surfaces at the
document level and in the sequence commands' post-check without plumbing.

What is still missing is a command that MAKES one, and with it the question of
how a view offers a constant, a ramp and a return over a selected range. The
evaluator no longer has an opinion about that, which was the point.

`offset` adds component-wise and never writes into a dense value, which is a
view onto the block itself; a shape mismatch throws rather than being dropped,
since a correction that silently does not take is the failure this design exists
to prevent. `replace` can supply a value over an absent base and `offset`
cannot, as animation-model.md required.

408 tests, 5,655 assertions.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 16:07:38 -04:00
Your Name
26517af2fd A position is an argument, not another command 
Everything could only be added to the end, because `append` computed its own
position — the max end of the lane — and so had no opinion to state. Insert is
not a new command; it is the argument that function was missing. `:at` takes a
lane frame or `:end`, `:end` is the position where nothing has to move, and
appending stops being a separate operation from inserting. New, reused and
duplicated drawings all take it, because there was only ever one placement rule.

Placing ripples: occurrences at or after the position move later by the new
exposure's duration, and `:keep` against `:grow-symbol` still decides what
happens at the shot's end. OVERWRITE is deliberately not a policy argument yet.
Taking frames away from the occurrence already there is TRIMMING, and an
argument whose second value is unimplemented is worse than an argument that is
not there. A position strictly inside an existing exposure refuses and names
`split`, rather than splitting on the quiet: one command performing two is how
a command stops being predictable.

Then split, which turned out to cost almost nothing, and that is the
interesting part. The two pieces keep ONE `:time` and differ only in `:span`.
The right piece's own frames therefore carry on exactly where the left's
stopped, so its source clock, its keys and its corrections go on meaning what
they meant: a held drawing holds the same frame either side of the cut, and a
playing insert plays through it without a seam. There is no arithmetic on
in-points to get wrong, and no shot-length question, since the pieces occupy
the frames the one exposure occupied. The test samples every frame before and
after and asserts the picture is identical — for a hold, for an exposure with a
correction of its own, and for a playing insert.

That is not a clever split. It is `:span` being in the node's OWN coordinates,
which was decided long before there were lanes, paying for something it was not
designed for. The same property is why extending a hold leaves lane keys alone.

Both new commands act at the playhead, which needed `lane-frame` — the symbol's
frame as a frame of the lane's own time, nil through a stepped or looping lane
where one is not the other. Nil refuses; it does not snap to a nearby frame.

Two smaller things found while doing it. `placeable` promised "a whole lane
frame" in its refusal and then accepted 2.5, so both it and `split` now require
an integer, as `extend-hold` already did for its delta. And `lane-end` is
private: `:end` is the only way to ask for it.

401 tests, 5,612 assertions. The browser flow now splits an exposure at the
playhead and puts a drawing in the gap, and checks that six exposures are still
one row.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 15:56:26 -04:00
Your Name
9446829774 Reuse, duplicate and make unique: deciding what is shared 
The model's whole claim is that content and its occurrences are different
things, and until now nothing in the editor could tell them apart: you could
make a drawing and time it, but not expose one drawing twice, and so never find
out whether an edit arrives in two places. That is the first proof obligation in
the lane model and it was the one the commands could not reach.

Three commands, and the distinctions between them are the point:

  reuse       another occurrence of the same drawing. A decision to share,
              made on purpose, because sharing discovered later — when an edit
              turns up somewhere you did not expect — is the bad version.
  duplicate   a copy of the drawing, appended, for when what is on screen is
              the starting point for the next one.
  make unique this occurrence gets a private copy; the others keep sharing.
              The undo of reuse, and refused when nothing else uses the
              drawing: a copy nobody asked for is a second identical symbol in
              the library for no reason a person could see.

Duplicate copies the CONTENT and not the exposure. Its new occurrence is a plain
one-frame hold, not a copy of the source occurrence's transform or corrections,
because those belong to that use of the drawing — carrying them over would make
duplicating a drawing quietly duplicate the treatment of one exposure of it.

A copy is SHALLOW by default and keeps its references to other symbols, so a
head built out of reusable eyes still uses those eyes. `:deep? true` copies
everything it places with new ids throughout. The lane model asks for both and
says why: never promise decoupling while leaving the edited object shared, and
only the deep copy can keep that promise. `bring/symbols` already did the
reachability walk and the id remapping, so the deep copy is that function
pointed at its own clip.

`node/sources` was still being read as a SET at five call sites, each with a
comment about a lane that cuts between several drawings — the keyed source that
no longer exists. An occurrence names one symbol, so they now ask `node/source`,
and `placed-frame` answers with `:symbol` rather than `:of`, which was the last
echo of the retired field name.

To let the commands use `clip/free-id` and the copy machinery, the lane's own
validation moved from `domain/sequence` to `domain/symbol`, which is where it
belonged anyway: a sequence is the one composition rule a node map carries, and
it now sits beside the parent and stencil checks rather than in the namespace
that happens to build lanes. That also breaks the cycle — sequence can require
clip and bring, and nothing below it requires sequence. Preconditions still
check only the LANE's shape: refusing an exposure edit over an unrelated defect
elsewhere in the symbol would be this command answering for a part of the
document it never touches.

The cel strip gains reuse, duplicate and make unique, the last shown only where
the selected exposure actually shares its drawing. Drawing on twos is also now
under test: exposure length is the cadence, the lane's transform has its own
clock, and it still moves on every frame — stepping it would be the cel cadence
leaking into continuous motion.

397 tests, 5,561 assertions. `test/browser/sequence.mjs` drives the three new
commands through the real editor and checks that three exposures are still one
row.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 15:30:59 -04:00
Your Name
3d3c1bbca0 An occurrence is a node, with a clock of its own 
A lane's drawings were going to be one instance whose source was a KEYED
channel: frame 0 says `:drawing-a`, frame 4 says `:drawing-b`, and the cels of
a row are that channel's keys. Two things followed from it, and both were
wrong.

The first is that playback meant whichever shape the channel happened to have.
A framed source played its symbol; a keyed source froze the selected frame.
So `node/placed-at` read animation out of storage, and adding an ordinary key
to a still turned it into an animation — the last-key bug, which was not a bug
in the code so much as the rule working as written. But WHICH drawing is used
and HOW time runs inside it are independent questions, and all four combinations
are ordinary: hold one drawing, play one animation, cut between held drawings,
cut between playing ones.

So an occurrence names one symbol in `:source {:symbol ...}` and says how its
source time advances in `:playback {:in :speed :end}` — `source = in + speed *
f`, a hold being speed 0, with `:stop`, `:hold` or `:loop` at the end named
rather than guessed. `node/placed-frame` samples it forwards, which works for
holds too, and `node/source-time` is the separate, invertible edit map, nil
where inversion is meaningless. The two were one function before, and a hold
had to lie about one of them.

The second is that a keyed source only looked necessary because an occurrence
was assumed to need a ROW. It does not. A lane is a group with `:layout
:sequence`, its occurrences are ordinary instances in the same flat node map,
and `timeline/rows` draws them as cel blocks on the lane's own row: twelve
exposures, one row, each cel still separately selectable and addressable. The
vertical growth that justified the keyed source is a presentation question, and
it is answered in the view.

`arthur.domain.sequence` holds the first commands over that shape — add lane,
append drawing, extend hold — each one history step, each refusing rather than
half-applying. Extending a hold leaves the lane's keys at their authored times,
because you are adjusting drawings underneath timed motion; a correction owned
by an occurrence travels with it. Ownership does that work, so no key needs a
flag saying what it follows. Ripple past the symbol's end is refused with the
frame count it would need, and `:extent :grow-symbol` is the caller saying yes.

`clip/blank` no longer carries `:subjects {} :features {} :groups {}`. Empty
maps write no leaf, so a blank document could not survive its own round trip —
`leaf/leaves` promises exactness and was the only honest side of that.

Documents are schema 3. A version 2 document is not read; nothing here converts
one. `docs/lane-model.md` is the design, and says which of its parts are built.

392 tests, 5,525 assertions, and `test/browser/sequence.mjs` drives the editor
through create, hold, explicit overflow and undo.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 15:20:23 -04:00
Your Name
624242b407 An options map for the resolvers, and sid beside the clip it is in 
Finishing the last commit, which traded a simpler definition for noisier call
sites: deleting the arity ladders left `(symbol/resolver sym st pal/index-of
nil nil)` at twenty-odd places, and two trailing nils tell a reader nothing
except to go and count positions.

The ladder was a symptom. The disease is five positional parameters, and the
split that matters is which of them are OPTIONAL:

  store, palette    positional, because neither is optional. A dense channel
                    cannot be read without the store it names — that is the
                    crash two commits ago — and every op carries a colour.
  pose-tracks       one call site, in `clip/resolver`'s own recursion
  source/picture-fps  two call sites

So the last three become one `opts` map, and the common call loses a nil. The
point is not the nil: it is that the sixth option, whenever it arrives, is a
key at one call site rather than a nil at fifty.

`clip/resolver` also had `sid` FOURTH, behind two arguments that say nothing
about which symbol is being resolved. It is second now, beside the clip it is
in: `(clip/resolver c :main store pal/index-of nil)`.

62 call sites rewritten by parsing the forms rather than by regex, because
`clip/resolver`'s arguments move past each other and a regex cannot see that.
An earlier attempt at this dropped `palette` on the floor and still compiled
at 62 sites — it only surfaced as an arity error, so if that had been a
same-arity mistake the tests would have been the last line of defence.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 12:21:12 -04:00
Your Name
ee66680a0c Make every caller say what it means: no defaulted arities 
Pre-alpha. Nothing here is owed a call shape it used to have.

Twelve convenience arities deleted, and the only reason to single any of
them out is that one of them was a live bug: `channel/value-at`'s `([ch f])`
filled in a nil tier-2 store, so a caller could omit it, read correctly for
every channel that happened not to be dense, and throw the first time one
was. That is the iris crash, and threading the store through `gesture/values`
last commit fixed the symptom while leaving the trapdoor open. Deleting the
arity found `node/toggle-key` standing on it too — the inspector's stopwatch
on a measured channel, the same throw, never reported.

Gone, and what the compiler then made explicit at each site:

  channel/value-at, cursor, dense-at   the store, and `nil` where a caller
                                       genuinely has none and means it
  channel/keyed                        `:hold`, which is a cut rather than a
                                       tween and not a thing to leave implied
  symbol/resolver (4), eval-frame (3)  store, palette, pose-tracks, opts
  clip/resolver                        opts
  mix/buffer!, store/install!          dead: no caller used the short form

`pick/local-bounds` goes the same way — it was `bounds-of` with the closure
thrown away, so callers build the closure and call it.

Every site was found by shadow-cljs `:fn-arity` rather than by grep, which is
the argument for the change: 90-odd call sites, and the compiler listed all of
them. BUILD BOTH TARGETS — the last three only appear in `:app`, since `:test`
compiles what the tests reach and the inspector, the pool drag and the vertex
overlay are not that.

Left alone, because an argument with a default is not the same thing as a
shim: genuine optionality like `fx/http`'s body, `geom`'s iteration count,
`zip`'s injected clock.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 12:10:22 -04:00
Your Name
11093079de Scale a part about the middle of what it draws, from the document as it is 
Three faults, one gesture. None of them was in `gesture/scale`, whose
`s' = s·b/a` about the pivot was right all along.

THE PIVOT. `clip/place-symbol` writes an instance's anchor, `paint/new-shape`
a drawing's, `nest/group` a new symbol's and `face-placement` the source
placement's — and `flow/freeze` wrote none for the parts underneath, so a
traced mouth turned and scaled about its own coordinate ORIGIN, which for
head-local geometry is the top-left corner of the footage. On a 320x200 stage
that put the mouth's pivot at (-234, -395), so dragging a corner outward slid
the shape about and shrank it. `pick/pivot` is `clip/center`'s rule for a node
rather than a symbol; `freeze/pivoted` applies it to every node the freeze
makes, skipping `node/measured?` — the predicate `gesture/refusal` already
refuses a hand edit by, so a pivot is written exactly where a hand can use
one. That also keeps it off `:head`, whose scale is not 1 and where an anchor
would NOT cancel out of `local!`; skipping it for drawing nothing would have
been true only by accident. Asserted in pixels: the pass moves nothing.

THE JUMP. `ui/stage`'s overlay dereferenced the document while RENDERING and
used it when the pointer went down. The store is a mutable handle behind an id
that does not change when the document does — `:paint/revision` says that, and
the overlay subscribes to neither it nor `::render/clip` — so after any edit
the next drag began from the transform the node had before the last one: still
under the press, jumping on the first pointermove. `ctx` now carries the id and
`loaded` reads at pointer-down.

THE CRASH. `gesture/values` read its channels without the tier-2 store, which
is fine until a selection lands on a dense transform — an iris follows the
gaze, a brow the raise, a head the similarity — and then `dense-at` throws and
takes the stage down, in `begin!` and again in `handles`. It takes the store
now. Kept in this commit because it is the same two functions.

`pick/bounds-of` yields a closure, as `clip/resolver` does, so an instance's
resolver is built once for a walk instead of once per frame — which is what
let `pivot` be the one walk it is rather than a separate path for instances.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 11:53:50 -04:00
Your Name
ed88c5e674 Hold a tracing photo steady, and switch it on where you would look 
The photo blinked out for a frame or two and sometimes never arrived, from
three causes that each present as the same bug. The still cache emptied
itself on the frame it filled, so every still on screen had to be fetched
and decoded again — every 48 frames of a scrub, and with two traced faces a
permanent flicker, each one's still evicting the other's; it drops the least
recently used now, a still being touched on every frame it is drawn. A still
cannot decode in the animation frame that asks for it, and a face whose next
one had not arrived drew nothing, so it now keeps the still it was showing
until the new one is there. And nothing was read ahead, so continuous
playback was always a frame behind its own footage; the next few frames'
stills are asked for while the playhead is moving on its own, and only then,
because a scrub asks for a different few at every step.

Whether the footage shows is no longer the document's. It was an :underlay
on an instance, inherited down the row path, nearest wins, and it went
through edit — so showing a reference photo was an undo step that travelled
to collaborators. It is [:ui :trace] now, the faces switched on and one
opacity, like solo, and there is nothing left to inherit: a face is the same
face wherever it is placed, so one switch covers every placement of it. The
paint loop asks for its own redraw when that changes, since the resolver no
longer does it for them.

Opening a face shows its footage, because a symbol has measured footage
behind it only because it was traced from that; a take does not, because a
take is the picture. The switch is on the bar above the stage, with the tone
and the tool, and on each face's timeline row beside solo — not a section
that appeared once the right row had been found. A face open in its own tab
could not show its footage at all before, shown having walked instances, and
that is the one place tracing matters most. The inspector keeps the face's
own keyed facts, its trace keys and its origin, and says why it cannot key a
frame rather than greying out the only button in the section.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
 2026-09-30 10:42:39 -04:00
72 changed files with 5351 additions and 761 deletions
Download patch file Download diff file Expand all files Collapse all files

13
clips/migrations/0011_occurrence_schema.py Normal file
View file

@ -0,0 +1,13 @@
from django.db import migrations, models
class Migration(migrations.Migration):
dependencies = [("clips", "0010_sounds")]
operations = [
migrations.AlterField(
model_name="project",
name="schema_version",
field=models.PositiveIntegerField(default=3),
),
]

2
clips/models.py
View file

@ -229,7 +229,7 @@ class Project(models.Model):
settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects", settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects",
) )
name = models.CharField(max_length=200, default="untitled") name = models.CharField(max_length=200, default="untitled")
schema_version = models.PositiveIntegerField(default=2) schema_version = models.PositiveIntegerField(default=3)
seq = models.PositiveBigIntegerField(default=0) seq = models.PositiveBigIntegerField(default=0)
palette = models.CharField(max_length=64, default="arthur/default") palette = models.CharField(max_length=64, default="arthur/default")
created = models.DateTimeField(auto_now_add=True) created = models.DateTimeField(auto_now_add=True)

2
clips/tests/test_api.py
View file

@ -422,7 +422,7 @@ class DocumentTests(TestCase):
self.assertEqual(5, len(response.json()["written"])) self.assertEqual(5, len(response.json()["written"]))
loaded = self.client.get(f"/api/projects/{self.project.id}").json() loaded = self.client.get(f"/api/projects/{self.project.id}").json()
self.assertEqual(2, loaded["schema_version"]) self.assertEqual(3, loaded["schema_version"])
self.assertEqual(1, len(loaded["clips"])) self.assertEqual(1, len(loaded["clips"]))
clip = loaded["clips"][0] clip = loaded["clips"][0]
self.assertEqual("c1", clip["cid"]) self.assertEqual("c1", clip["cid"])

49
docs/animation-model.md
View file

@ -1,5 +1,10 @@
# arthur — the animation model # arthur — the animation model
The revised target for lanes, occurrences, source playback, shared editing, and
multi-view UX is [The Lane Model](lane-model.md). It supersedes conflicting
proposals below. Backward compatibility is not required; this document still
contains descriptions of earlier shapes and planned features.
The data that describes a moving picture: what the primitives are, how they The data that describes a moving picture: what the primitives are, how they
nest, how they change over time, and how rotoscoped and hand-authored work end nest, how they change over time, and how rotoscoped and hand-authored work end
up being the same thing with one flag between them. up being the same thing with one flag between them.
@ -230,10 +235,30 @@ combines:
```clojure ```clojure
{:animated? true :interp :hold {:animated? true :interp :hold
:dense {...} :generated {...} :dense {...} :generated {...}
:over [{:blend :offset :keys {88 [2 0], 96 [0 0]}} :over [{:id :nudge :support [88 98] :op :offset
{:blend :replace :keys {104 [[3 7] [4 7] …]}}]} :values {:animated? true :interp :linear :keys {88 [2 0], 96 [0 0]}}}
{:id :redraw :support [104 105] :op :replace
:values {:animated? false :value [[3 7] [4 7] …]}}]}
``` ```
A LAYER'S VALUES ARE A CHANNEL, which is what keeps a constant adjustment, a
ramp and a return motion from being three mechanisms: a framed one says the same
thing on every frame it covers, a keyed one moves. They read through `value-at`
and `cursor` like any channel, one reading head each, so the specification and
the playback path share their blending and differ only in how they read — and a
layer's values may not carry layers of their own, which the stack already
orders.
`:support` is half-open and explicit, `[in out)`. Outside it a layer is inactive
and the base evaluates exactly as it did before, which is the difference between
a bounded correction and inserting boundary keys — the latter alters the
neighbouring segments. And a layer has NO TIME SPACE of its own: its support and
its values' keys are in the frames the base channel's keys are in, the node's
own. A correction on a lane is therefore in lane frames and reaches across the
drawings exposed under it; one on a single occurrence is in that occurrence's
frames and travels with it when the exposure moves. Ownership had already
answered the question, so there is no field to disagree with.
- **`:offset`** adds a delta to the base. "Nudge the mouth two pixels right for - **`:offset`** adds a delta to the base. "Nudge the mouth two pixels right for
ten frames" survives a re-freeze at different parameters, because it was never ten frames" survives a re-freeze at different parameters, because it was never
a position — it was a correction. a position — it was a correction.
@ -243,6 +268,22 @@ This is what `docs/design.md` means by an override layer, and it is why
re-freezing is safe: the base is regenerated, the layers are untouched. It is re-freezing is safe: the base is regenerated, the layers are untouched. It is
Blender's NLA blending and AE's effect stack at one property. Blender's NLA blending and AE's effect stack at one property.
WHEN THE BASE OUTGROWS A CORRECTION it is a CONFLICT, which is neither a dropped
layer nor an applied one. Turning `:verts` gives the mouth a different number of
points, and an `:offset` is a row of components that has to match: so the
regeneration records `:conflict` on the layer, the layer stays in the document,
the picture is the base meanwhile, and `clip/conflicts` is the list a view
offers to resolve. Deliberately not `problems` — the document loads and saves
fine, it just contains a decision nobody has made yet. A later regeneration
that restores the shape clears the mark. Only `:offset` can conflict; `:replace`
states a whole value and has nothing to agree with.
A correction is NOT a hand placement. `regenerate-head` leaves the head's
authored channels alone once somebody has placed it by hand, and it compares the
channels WITHOUT their layers to decide: otherwise the first correction anyone
made would stop the head following re-measurement forever, which is the opposite
of what a layer is for.
Layers are what "set it by hand" means for anything measured, and the measured Layers are what "set it by hand" means for anything measured, and the measured
channel does not need to know. A hand-set gaze is an `:over` on channel does not need to know. A hand-set gaze is an `:over` on
`[:xform :pos]` of the iris; a hand-set mouth shape is an `:over` on `[:xform :pos]` of the iris; a hand-set mouth shape is an `:over` on
@ -491,7 +532,9 @@ for all three is the same — **their own**:
### Instances ### Instances
A node with `:kind :instance` and `:of :sym/blink` places one. Its own channels A node with `:kind :instance` and `:source {:symbol :sym/blink}` places one, and
its `:playback` says how time runs inside it — which drawing is used and how it
is played are separate facts, per [the lane model](lane-model.md). Its own channels
compose *over* the symbol's, so one definition is placed many times and tinted, compose *over* the symbol's, so one definition is placed many times and tinted,
offset or retimed at each placement — that is how a three-frame blink is reused offset or retimed at each placement — that is how a three-frame blink is reused
at frames 40, 88 and 200 without copying it. at frames 40, 88 and 200 without copying it.

5
docs/architecture.md
View file

@ -8,6 +8,9 @@ rotoscoping rather than a sketch bolted to the side.
`docs/animation-model.md` specifies the data both of them are about — nodes, `docs/animation-model.md` specifies the data both of them are about — nodes,
channels, symbols and time maps — and supersedes this document wherever the two channels, symbols and time maps — and supersedes this document wherever the two
describe the same type. describe the same type.
The newer [Lane Model](lane-model.md) takes precedence for occurrence ownership,
playback semantics, shared editing operations, and multi-view UX. It explicitly
allows replacing the current format without backward compatibility.
Nothing here revises an aesthetic decision; several things here split a Nothing here revises an aesthetic decision; several things here split a
decision that is currently made in two places at once. decision that is currently made in two places at once.
@ -819,7 +822,7 @@ collaborator's keying. The fix is addressing, not an algorithm:
``` ```
palette palette
sequence/:sid lane/:sid
clip/:cid/timing clip rate clip/:cid/timing clip rate
clip/:cid/subject/:sid tracked subject and settings clip/:cid/subject/:sid tracked subject and settings
clip/:cid/feature/:fid tracked feature and settings clip/:cid/feature/:fid tracked feature and settings

184
docs/lane-handoff.md Normal file
View file

@ -0,0 +1,184 @@
# Lane and cel handoff
Status (2026-09-30): the lane model is implemented through its commands and its
first two views. Cels are ordinary nodes with their own playback clock, the
timeline draws them as one row, the cel sheet draws frames down and lanes across,
and both views issue the same commands. Correction layers evaluate and survive
regeneration. What is missing is the commands that make a correction.
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
this file is.
3d3c1bb An occurrence is a node, with a clock of its own
9446829 Reuse, duplicate and make unique: deciding what is shared
26517af A position is an argument, not another command
94c0a21 A correction is a layer, and a layer's values are a channel
72b57e3 Regenerate the base, keep the hand work, and say when you cannot
76106d3 The shot is as long as somebody said it was
598c186 One word for one thing: it is a cel
## Read first, in this order
1. [The Lane Model](lane-model.md) — the design, and the status note under
*Proof obligations* says what is built. It supersedes `animation-model.md`,
`timing-model.md` and `architecture.md` wherever they overlap.
2. `frontend/src/arthur/domain/lane.cljs` — every command, and the reasoning in
its docstrings.
3. `frontend/test/arthur/domain/lane_test.cljs` — what the model is asserted to
do. It is the fastest way to see the shapes.
4. `frontend/src/arthur/domain/channel.cljs`, the correction-layer section.
## Vocabulary — one word for one thing
Renamed in `598c186`, after four words had accumulated for one object. Use these
and do not reintroduce the others.
| word | means |
| --- | --- |
| instance | the `:kind`. The general thing, anywhere in a document |
| cel | an instance in a lane. One drawing, held for some duration |
| lane | a group with `:layout :sequence` |
| drawing | the content a cel names — an ordinary symbol |
| 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
else and still does**: `:time :expose` is how many frames each step of a subtree
lasts, which is what shooting on twos is — `node/expose`, `clock/exposed-frame`,
`subs/render ::exposure`. Keeping these apart is why the block is called a cel.
`:layout :sequence` stays as the field, and is the one place two words are kept
on purpose: the layout names the RULE — children follow one another and may not
overlap — and a group carrying it is called a lane. `node/lane?` is where they
meet.
The second view is the CEL SHEET, not the exposure sheet.
## Decisions already made — do not re-litigate
These were each argued out and are load-bearing. Changing one is a design
decision, not a cleanup.
- **The shot length is authored.** `:frames` is the symbol's window; the
occupied extent of its lanes is a different fact derived from the cels. A
command grows the window only when the caller passes `:extent :grow-symbol`,
and never shrinks it. Blanking the end of a shot leaves empty frames at the
end, because deriving the window from the extent would make deleting the last
drawing silently shorten the film. `lane/finish`.
- **Placing ripples; overwrite is `blank` then non-rippling placement.**
`lane/overwrite-drawing` composes those pieces as one transaction. Insertion
retains its ripple rule; overwrite does not move any surviving cel.
- **A position inside a cel refuses and names `split`.** One command must not
quietly perform two. The UI offers the retry.
- **A correction has no time space of its own.** Its `:support` and its values'
keys are in the frames the base channel's keys are in — the node's. A
correction on a lane is in lane frames and reaches across the drawings under
it; one on a cel travels with that cel. Ownership already answered it.
- **A layer's values are a channel.** Constant, ramp and return motion are one
mechanism. Do not add a second way to say what a value is over time.
- **A conflict is not a `problem`.** A document whose topology outgrew a
correction loads, evaluates and saves; `clip/conflicts` lists the decisions
waiting for a person. `problems` means the document will not load.
- **Refuse rather than guess.** Every command returns `{:clip :selection}` or
`{: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.
- **A cel is not a row.** Rows, expansion and selection are editor state. The
document has never known about rows and must not learn.
## Next steps, in order
1. **The commands that make a correction** — Constant adjustment, Ramp, Return
motion over a selected range, per `lane-model.md`. The evaluator is done and
has no opinion about how a range or a motion shape is chosen, which is now a
view question. A panel also needs to offer `clip/conflicts` for resolution.
Note the one open question: a correction needs a stable `:id` from somewhere,
and cel ids come from the caller because this namespace is pure.
2. **Slip source and retime.** Both have real design questions open and the doc
says to refuse rather than approximate: retime needs a defined warp and
interpolation behaviour, and is not moving keys whose numbers happen to fall
inside a selection.
3. **Deleting reused content.** Reference discovery exists (`node/sources`,
`clip/places`, `clip/contains-symbol?`); the policy does not.
4. **Collaboration.** `lane-model.md` is explicit that one leaf per channel does
NOT solve two people editing different keys of the same channel. No conflict
policy exists for that.
## Mechanisms to reuse — these keep paying out
- **`:span` is in the node's OWN frames** and `:time` says where they land in
the lane. Moving an edge of a cel is therefore one write to `:span`, with
`:time` and `:playback` untouched. This is why split costs nothing, why the
two halves of a split go on meaning what the one cel meant, why trimming the
front of a playing insert starts it later into its animation instead of
restarting it, and why extending a hold leaves lane keys alone. `lane/local`
and `lane/edged` are the whole geometry; trim, split and blank are all it.
- **`lane/finish`** is the one commit path: it validates, applies the shot-length
policy, and returns the refusal. New commands go through it.
- **`:required-frames` plus the retry event** is the pattern for "this needs a
decision you have not made": the domain reports what it would need, the UI
offers one button. `events/ui/lane-retry`.
- **`lane/lane-frame`** converts a symbol frame to a lane frame, or returns nil
through a stepped or looping lane where there is no single answer. Nil refuses;
it never snaps.
- **`channel/conflict-with`** is the rule for whether one offset fits a base,
used by `conflicts` and regeneration. Validation additionally follows prior
replacement layers, so it cannot approve a stack that throws when read.
- **Generated sampling applies to the base, not the hand correction.** Picture
rate and pose selection may choose an earlier generated frame; correction
support and values still read the node's current authored frame.
- **Two test patterns worth copying.** `the-cursor-agrees-with-the-specification-in-any-frame-order`
holds the optimized cursor to `value-at` in forward, backward and random order
— add a case to it for any new channel shape. And `drawn` in `lane_test`
samples every frame before and after an edit, which is how split and trim are
proved to change nothing: state a claim as "the same picture" rather than as
numbers computed by hand.
## Known gaps and traps
- **Audio lanes do not work.** `symbol/lane-problems` requires `:instance`
children, so an audio node in a lane is rejected outright. `lane-model.md`
says a lane may hold visual OR audio cels and should reject only a mixture.
- **`: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`
requires `:z` on every node uniformly, which is its own kind of simplicity —
but the field is noise on a cel.
- **`channel/offset-onto` throws** on a shape mismatch that no regeneration has
recorded as a conflict. That is deliberate — a correction that silently does
not take is the failure the design exists to prevent, and `channel/problems`
catches the authored case — but it is a throw in the read path, so any new
producer of layers must not create a mismatched one.
- **`docs/timing-handoff.md` is a separate, unreconciled thread.** Performance-
pose selection and plate drawings/tracing, instance-specific picture-rate
requests, `pose/put-cut` addressing only `:main`. It predates the lane model
and nobody has squared the two.
- **The button row in the timeline pane is a test harness, not a design.** It is
how the commands were made reachable and provable. `lane-model.md` describes
the real cel action strip, the breadcrumb and the location bar; none exist.
- **`shadow-cljs release app` clobbers the dev bundle.** Both builds write
`../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
`ReferenceError: arthur is not defined`. Run `npx shadow-cljs compile app` to
restore it. A running `watch app` does not notice; it rebuilds on the next
source change.
## Running it
From `frontend/`:
npx shadow-cljs compile test && node out/node-tests.js # 429 tests, 5,767 assertions
npx shadow-cljs compile app # the bundle Django serves
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
runserver 8778` from the repo root) and a compiled dev bundle:
node --experimental-websocket test/browser/lane.mjs # the lane/cel flow
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
project to the local server by design; `lane.mjs` never writes to the server.
From the repo root: `mise exec -- python manage.py test clips` — 56 tests.
Documents are schema 3. A version 2 document is not read and nothing converts
one; there is no backward compatibility to preserve anywhere in this work.

581
docs/lane-model.md Normal file
View file

@ -0,0 +1,581 @@
# The Lane Model
Revised 2026-09-30. Target design. Cel ownership, source playback, the
content and cel commands, placement anywhere in a lane, overwrite, a one-row cel
strip, a frame-down cel sheet and the correction-layer evaluator are implemented;
the commands that produce a correction and the retiming commands are not.
See the status note under
[Proof obligations](#proof-obligations-and-implementation-order).
[Lane and cel handoff](lane-handoff.md) records what is built, the decisions
that are settled, and what to do next.
This revises the Claude artifact [The Lane Model](https://claude.ai/code/artifact/cd42981d-ed08-493f-94df-b7dd6657f0e6).
Its prose and diagram source were recovered from session
`1c603f71-84eb-498e-aeaf-4c0346f1f513`; the live artifact was not accessible for
reading or editing here. This repository document is the revised design. The
original artifact has not been updated, and edits made there outside the recorded
session may not be represented here.
For the subjects covered here, this document supersedes the original artifact
and conflicting proposals in `animation-model.md`, `timing-model.md`, and
`architecture.md`. Those documents retain useful detail about the existing system.
## Goal and compatibility policy
Arthur is one animation document with several ways to see and edit it: drawing
on the stage, arranging clips, timing cels, editing curves, and generating
motion from footage. Each view exposes relevant facts and invokes shared editing
operations. Switching views must preserve the meaning of the work.
The user explicitly requires no backward compatibility. Replace obsolete shapes,
APIs, and tests when a better model requires it. Do not retain compatibility
branches, adapters, or migrations solely to preserve the current document format.
A format marker can reject unsupported files clearly; it does not promise to
convert them. This policy does not authorize deleting existing user assets.
Simplicity means predictable composition, clear ownership, and few independent
rules. Minimizing field count is secondary to representing independent choices.
## What stays
- A symbol is the one container for authored scene nodes. A drawing can be a
one-frame symbol; an animation uses the same container over more frames.
- Nodes have stable identities and flat parent references. Shared content is
referenced rather than copied implicitly.
- Animatable properties are addressed by channel paths. Generated and authored
values participate in the same evaluation machinery.
- Authored data, generated blocks, and source media remain separate. Documents
reference immutable blocks; caches and resolver indexes remain derived.
- A pure reference evaluator specifies the result. Playback, seeking, preview,
export, and optimized cursors must agree with it.
- Existence, visibility, and missing measured data remain distinct facts.
## Content, cels, lanes, and rows
These have different identities and responsibilities:
| Concept | Owns | Example |
| --- | --- | --- |
| Content | Reusable nodes and their animation | Drawing `a2`, an animated head, or a sound asset |
| Cel | One use of content, its interval, source playback, and local treatment | `a2` exposed on frames 12–16 |
| Lane | A sequence of cels and shared properties | The girl's drawings and the girl's overall transform |
| View row or column | Presentation and editor state | Timeline row, cel-sheet column, or property curve |
Use the existing instance/node identity mechanism for cels. A cel
should not acquire a second identity system just because it is shown as a cel.
Lanes group cels; they do not introduce another node-holding content type.
The concrete candidate below uses existing group and instance nodes; its ownership
boundaries are part of the design. It is now the implemented shape, and the field
spellings below are the ones the runtime reads.
Each cel has a stable ID. Moving it, changing its hold, swapping its source,
or trimming it preserves that ID. Repeating it creates a new cel that may
reference the same content. A split retains the original ID on the left and gives
the right piece a new ID; commands return the resulting selection explicitly.
Cels are the canonical authored arrangement. A source-at-time channel or
interval index may be compiled from them for evaluation, but is not a second
editable copy of the schedule. This replaces the earlier proposal that every cel
must be represented solely as a source key. Ordinary property animation still
uses lightweight keys; it does not need cel objects.
A lane has non-overlapping half-open cel intervals `[start,end)`
in its own time space. Uncovered intervals are gaps. Empty lanes are valid.
Compositing and simultaneous sounds are represented by multiple lanes or ordinary
scene composition; an accidental overlap never silently selects a winner.
Transitions, if added, need explicit overlap and mixing semantics.
Properties can belong to content, one cel, or the lane. For example:
- Rotate the reusable drawing: all its uses change.
- Rotate one cel: only that cel changes.
- Animate the lane's rotation: whichever drawing is showing follows it.
A cel can have its own transform, gain, corrections, and source timing
while remaining a block in the same timeline row. Independent treatment never
requires a new row or an otherwise unnecessary wrapper symbol.
### Concrete candidate: a lane and ordinary instances
A lane is a group node with `:layout :sequence`. Its cels are ordinary
instance nodes whose `:parent` points to the group. All remain in their symbol's
flat node map. The sequence constraint is document semantics; which rows the UI
expands remains editor state. Ordinary groups retain unconstrained composition.
This example is a document the runtime accepts, built and evaluated by
`frontend/test/arthur/domain/lane_test.cljs`. Times here are zero-based. Channels
use the existing representation; cel source references and playback have
replaced the `[:source]` channel, which no longer exists.
```clojure
;; Within :main's :nodes; referenced drawings/animations live in :symbols.
{:girl
{:id :girl :kind :group :layout :sequence :z "b"
:channels {[:xform :rot]
{:animated? true :interp :linear :keys {0 0, 6 30, 12 0}}}}
:cel-a
{:id :cel-a :kind :instance :parent :girl :z "a"
:time {:at 0 :rate 1} :span [0 4]
:source {:symbol :drawing-a}
:playback {:in 0 :speed 0 :end :stop}}
:cel-b
{:id :cel-b :kind :instance :parent :girl :z "b"
:time {:at 4 :rate 1} :span [0 4]
:source {:symbol :drawing-b}
:playback {:in 0 :speed 0 :end :stop}
:channels {[:xform :pos]
{:animated? true :interp :hold :keys {0 [0 0], 1 [2 0]}}}}
:animated-insert
{:id :animated-insert :kind :instance :parent :girl :z "c"
:time {:at 8 :rate 1} :span [0 4]
:source {:symbol :wave}
:playback {:in 3 :speed 1 :end :stop}}}
```
The lane's rotation reads lane time. Each cel's channels read cel
time. Its content reads source time. The stills sample frame 0, while the insert
samples source frames 3, 4, 5, and 6. The group transform composes with the
cel transform and then the content's own transform.
`:span` remains in the node's own coordinates, consistent with ordinary nodes.
The interval in lane time is derived through `:time`; do not also store parent
start/end values. Sequence children require finite intervals and positive
placement rates. Ordering and overlap checks use the mapped intervals, not `:z`.
The sequence group may contain visual cels or audio cels; its
capability must reject an incompatible mixture rather than infer it per frame.
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
diagnosis that making `:of` a channel was necessary to avoid vertical growth:
multiple instances can occupy one row when the view presents their containing
sequence. A lane-level source schedule is therefore derived, not authored twice.
## Source selection and source playback are independent
The current implementation makes framed sources play and keyed sources hold.
Retire that rule. Channel storage shape must not determine playback behavior.
Adding or removing a key must not turn a still into an animation or vice versa.
A cel names content and describes how its source time is sampled. In the
basic case, after mapping lane time into cel time:
```text
source_time = in_point + speed × cel_time
```
A newly created cel starts at local time zero. Moving it preserves this
origin relative to its content. Trimming can narrow its local support without
resetting that origin; split pieces likewise preserve the source and property
values at the cut. Trimming, slipping, and retiming are distinct operations with
explicitly different effects on the interval and the source map.
| Intent | Source playback |
| --- | --- |
| Hold a drawing | Constant source frame, equivalently speed 0 |
| Play an animated symbol | Advancing source time, normally speed 1 |
| Cut between animations | Several cels, each with its own in-point and speed |
| Mix stills and animation in a lane | Constant and advancing maps in the same sequence |
The source reference itself is discrete and never numerically interpolated.
Interpolation belongs to properties that support it; a property registry should
declare value types, defaults, and permitted interpolation and correction modes.
Generic key toggles must consult those capabilities rather than assume every
non-boolean value can be tweened.
Define source bounds and end behavior explicitly: stop contributing outside the
source, hold an endpoint, or loop an explicit range. A still uses a valid constant
frame. A loop uses a nonempty half-open range and a defined modulo rule. Playback
never guesses these policies from whether a channel happens to have keys.
Audio shares cel arrangement, trimming, gain ownership, and clock mapping.
It does not inherit visual frame-hold semantics: holding one audio sample is not
an audio freeze effect. Validate supported playback policies by media capability.
Actual audio scheduling must follow active cels, including gaps and cuts,
rather than playing every sound reachable through a structural reference.
## Time spaces and sampling
Name the relevant space whenever an API accepts a time or range: project,
symbol/lane, cel, or source. Store authored frame coordinates exactly;
avoid cumulative rounding when moving through nested mappings. Quantize at a
declared sampling boundary, not at every traversal step. Audio also needs its
continuous clock/sample space rather than visual frame quantization.
A hold is an evaluable time map with no unique inverse. A loop can map many
displayed cels to one source time. APIs must distinguish forward sampling
from inverse editing, and expose enough context to resolve a cel or
explicitly refuse an ambiguous operation. Do not report a missing time map merely
because inversion is unavailable.
Separate invertible placement timing from source sampling. A zero source speed
can mean hold without making the cel's own edit clock non-invertible.
Reparenting through changing transforms or non-invertible timing must either
preserve the full result by an explicit bake or return a reason it cannot; a
matrix captured at one frame does not prove preservation across the animation.
The source's frame step, generated-pose sampling, and the lane's transform clock
are independent scopes. Drawing on twos must not accidentally step a smooth lane
transform. An explicit whole-subtree stepping operation can exist separately.
Share the quantization primitive where possible, but retain its units, phase,
rounding policy, and order relative to retiming and lead. The original suggestion
that cel and picture-rate sampling are simply one floor is insufficient:
noninteger grids and source-frame quantization require specified behavior.
Identity timing can be implicit; remove `:time :mode` if it only duplicates that.
A cel interval is authored. Lane content extent is derived from its
cels, including the explicit end of the last one. A separately authored
container trim/window is legitimate when it intentionally gates children. Do not
conflate that window with occupied extent or infer a final hold from the next key
when no next key exists. A range of frame numbers alone cannot encode visibility
or a missing measurement.
## Shared editing operations
Every view issues the same domain commands. A command accepts an explicit target
and edit policy, computes a valid change, and returns the change, resulting
selection, and any refusal reason. A button and a drag must not implement two
versions of cel extension.
An edit target identifies the symbol, cel path, selected entities or
properties, and the time range with its space. Navigation also distinguishes
editing shared content directly from editing it through a particular cel.
Crossing a source cut must not silently redirect an active drawing edit to a
different symbol: retain the explicit content target until navigation changes it.
Core commands include new drawing, reuse drawing, duplicate drawing, make unique,
blank range, split, trim, move, extend cel, slip source, retime, and apply a
bounded property edit. Ripple/overwrite policy and the set of affected lanes are
explicit command arguments. Preview consequences before committing a gesture.
New drawing creates fresh empty content and a cel. Blank range removes
content coverage without inventing a hidden drawing. These are different actions.
Reuse creates another cel pointing at existing content. Duplicate creates
a new content identity. Make unique rebinds the selected cel only.
Copy semantics must specify nested sharing. A normal content copy duplicates its
owned nodes and channels while preserving references to other reusable symbols.
For a fully independent drawing assembled from nested symbols, provide an
explicit deep-copy operation with ID remapping. Never promise decoupling while
leaving the relevant edited object shared. Immutable media blocks may remain shared.
Commands are atomic undo transactions, even when they touch several leaves.
Pointer movement and keyboard invocation use explicit begin/preview/commit or
cancel boundaries; a timing heuristic alone must not decide user intent.
Collaboration applies a transaction consistently, validates affected references,
and detects conflicts at the owned data being changed. One leaf per channel does
not solve simultaneous edits to different keys of that same channel; define a
conflict policy rather than claiming that granularity solves all collaboration.
### Default timing behavior: cel edits preserve lane keys
Working default from the follow-up discussion: extending a drawing's hold changes
cel timing, leaving lane animation at its authored times. The user raised
keeping keyframes in place as a possibility; this is the proposed predictable
default, not a claim that they selected every timing policy below.
Ownership supplies the remaining rule: properties attached to a cel
travel with it. Extending its end does not stretch those properties; moving it
changes where their existing local times land. No per-key attachment flag is
needed to recover ownership that the document already expresses.
For the concrete example, extend `:cel-a` by two lane frames with ripple:
| Fact | Before | After |
| --- | --- | --- |
| Cel A's lane interval | `[0,4)` | `[0,6)` |
| Cel B's lane interval | `[4,8)` | `[6,10)` |
| Animated insert's lane interval | `[8,12)` | `[10,14)` |
| Girl's rotation peak | Lane frame 6 | Lane frame 6 |
| B's position change | B frame 1, lane frame 5 | B frame 1, lane frame 7 |
| Insert's first source frame | Source frame 3 | Source frame 3 |
The rotation peak now coincides with a different point in the drawing sequence.
That is the intended consequence of changing cels underneath timed motion.
The position correction stays attached to drawing B's cel. Neither the
background's keys nor audio on another lane moves.
The command contract for this edit names the symbol and cel, a delta in
lane frames, `:ripple` behavior, and an explicit scope of cel timing. It
extends A's local support by the delta converted through A's placement rate,
and shifts subsequent cel placements by that delta in lane time. It does
not modify any channel's key map, source in-point, or playback speed. Reject a
nonpositive resulting duration. Validate and commit the entire change together.
The symbol's authored end is another explicit boundary: preview an overflow and
offer to extend the symbol or cancel. A command can request that extension as
part of its transaction; it must not silently truncate later cels or grow
other uses of a shared symbol. In the example, a 12-frame symbol needs an explicit
extension to 14 frames or the edit must be refused without partial changes.
Retime performance is a separate operation over explicitly selected cels
and channels. It applies the same time transformation to their relevant clocks,
keys, and correction supports. Stretching an interval requires a defined warp
and interpolation behavior; it is not merely moving keys whose frame numbers
happen to lie inside the selection. Until supported, refuse this operation
rather than approximating it with a cel ripple.
The initial UI should default stage transforms to the lane when drawing in a cel
workflow, so movement usually remains independent of cel timing. The
inspector names the target: lane motion, this cel, or shared drawing.
Changing that scope is explicit. It changes what the edit means, not just which
panel happens to be open.
## Three-frame rotation and correction layers
A range says where an edit applies; it does not specify the motion. Offer distinct
commands for a constant adjustment, a ramp, and a return-to-start motion. For UI
frames 10–12, the internal range contains exactly three frame samples after
conversion from the displayed numbering convention.
- Constant adjustment: the same offset throughout those three samples.
- Ramp: interpolate from the specified start value to the target over the range.
- Return motion: interpolate from the starting value to a peak and back.
For a return motion sampled on three frames, the values can be `0, angle, 0`.
Outside the selected range, the underlying animation must evaluate exactly as it
did before. A range-scoped correction layer expresses this directly; blindly
inserting boundary keys can alter neighboring segments or destroy existing motion.
Implement corrections as an ordered stack over the base channel. Each correction
has stable identity, explicit support interval, blend operation, and values in a
named time space. Outside its support it is inactive. `replace` can supply a value
over an absent base; `offset` cannot offset a nonexistent value. Blend capability
depends on property type, and geometry corrections require compatible topology.
Regeneration replaces the generated base and preserves corrections. If changed
topology or removed targets make a correction incompatible, report a resolvable
conflict instead of silently dropping or misapplying it. Provenance explains
where the base came from; explicit sampling policy determines its playback.
This is core to the workflow: generate motion, correct it by hand, adjust the
generator, and keep the corrections. It should be proven before adding many views.
## Other unifications worth keeping
Pose choices, tracing-frame choices, and ordinary held values should share the
channel evaluator and cursor infrastructure. Preserve their different ownership,
fallback behavior, and sampling scope. A pose choice must address the relevant
content/feature explicitly; switching to another symbol must not accidentally
reuse a track just because both symbols contain a node with the same local name.
Keep the two animation idioms distinct: keyed geometry modifies one mark over
time; drawing substitution selects content that may have different structure.
Linear geometry interpolation requires compatible vertex correspondence, not
merely two drawings that happen to look related.
Derived library grouping may collect drawings used by a single lane. This is a
convenience, not ownership or deletion authority. Reference discovery for cycle
validation, copying, and deletion examines all structural references, including
currently inactive cels. Authored folders, favorites, and labels remain
legitimate user data even when the UI could have suggested defaults.
## UX: location, selection, and controls
The breadcrumb sits above the timeline and states the editing location, shared
content identity, and cel context when applicable. Show local time and
its project context where a useful mapping exists. Holds and loops need an honest
description instead of a fictitious unique global frame.
Creation controls next to the breadcrumb act in that explicit location. Selection
does not secretly change where a new symbol goes. A shared drawing indicates its
reuse and offers Make this cel unique. Names help identify content;
linked-use indicators must rely on IDs, because different drawings can share names.
| Surface | Primary scope and controls |
| --- | --- |
| Topbar | Project name, save/open/export, project rate and stage size |
| Location bar | Breadcrumb, add lane/content, shared-content context |
| Cel action strip | New drawing, duplicate drawing, hold longer/shorter, blank range |
| Lane header | Lane selection, lock, mute/solo where applicable, onion settings, expansion |
| Stage tools | Drawing and transform modes, active target and scope |
| Inspector | Selected content/cel/lane properties and valid key controls |
Cel actions have visible contextual buttons, shortcuts, a context menu, and
command-palette entries. These are different entrances to the same commands.
Shortcut names from the original sketch (`N`, `D`, `H`, `B`, `K`) are provisional;
their meanings must match the visible labels and avoid tool conflicts.
The inspector normally edits values and the timeline normally edits timing, but
this is an organizational default. Numeric duration and in-point controls are
useful inspector edits to the same domain facts. Do not ban a convenient control
just to preserve a visual division.
Default nesting navigation enters content; expanding a lane reveals properties.
Other views may show hierarchies differently without changing the document.
Tabs can pin explicit locations. Zoom, expansion, onion preferences, and current
selection are editor state rather than animation content. Persistent workspace
preferences can be saved separately.
## A session, revised
1. In `main`, create a girl lane and a new drawing. Draw; use New drawing (`N`)
to create the next one with the previous cel ghosted behind it.
2. Use Duplicate drawing (`D`) when the current shapes are the starting point.
Use Reuse drawing for a deliberately linked cel. The UI shows the
difference before an edit can change other uses.
3. Time the performance. Hold longer (`H`) extends the selected cel and
ripples later cels in the explicitly targeted lane. A trim gesture
can use overwrite instead. The preview shows which boundaries will move.
4. Choose a two-frame default cel for newly created drawings, or run a
separate Retime cels command on a selected range. This does not quantize
lane transforms or silently retime already authored cels.
5. Place the background in a lane below. Its source holds one frame throughout
its cel. Key the lane's X position at the beginning and end and choose
linear interpolation. The background slides while the girl's drawings cut.
6. Select three frames on the girl's lane, choose Return motion, and rotate to
the desired peak. A bounded rotation correction affects the girl across any
drawing boundaries in that range. Existing motion survives outside it.
7. Insert a playing animated symbol among the girl's held drawings. Set that
cel's source playback to advance. No lane conversion is required.
The timeline shows named cel blocks with property marks and optional curve
subrows. The cel sheet shows the same cels by frame and lane. The
graph editor edits the same properties; the stage resolves the same document.
Onion skin is configurable and counts neighboring cel events, skipping gaps
by default; a long hold does not consume the budget. Repeated uses of the same
drawing remain distinct events. Deduplicating identical ghosts is a display option.
## Proof obligations and implementation order
The source-channel prototype has been removed: a cel names one symbol
and carries its own playback clock, and `node/problems` rejects the old
`[:source]` channel. What a lane IS lives in `arthur.domain.symbol` beside the
other rules about a node map; `arthur.domain.lane` holds the commands over
one — add lane, place a drawing (new, reused or duplicated), make unique, split,
trim, move, blank and extend hold. Each is one history step, and each refuses rather than
half-applying. The timeline draws a lane's cels as cel blocks on the
lane's own row, and offers Make unique only where the selected cel actually
shares its drawing.
There is ONE placement function and a position argument, so appending is not a
different operation from inserting: `:end` is a position like any other, the one
where nothing has to move. Placing ripples — cels at or after the
position move later by the new cel's duration — and `:keep` versus
`:grow-symbol` still decides what happens at the shot's end. OVERWRITE is not a
policy argument yet, deliberately: taking frames away from the cel
already there is trimming, and until `trim` exists, placement that would need it
refuses instead of approximating it. A position inside an existing cel
refuses too, and names `split` — one command does not quietly perform two.
Splitting turned out to cost almost nothing, which is evidence for the
representation rather than for the command. The two pieces keep ONE `:time` and
differ only in `:span`, so the right piece's own frames carry on where the
left's stopped and its source clock, keys and corrections go on meaning what
they meant — a held drawing holds the same frame either side, a playing insert
plays through the cut without a seam, and the test for it samples every frame
before and after and asserts the picture is identical. That falls out of `:span`
being in the node's own coordinates; it is not something split arranges.
Content copies are shallow by default and keep their references to other
symbols; `:deep? true` is the explicit copy that shares nothing, so the promise
of independence is only made where it is kept.
THE SHOT LENGTH IS AUTHORED, which is the decision the range commands forced.
`:frames` is the symbol's window — how long the shot IS — and the occupied
extent of its lanes is a different fact derived from the cels. A command
grows the window only when the caller says `:grow-symbol`, and never shrinks it:
blanking the end of a shot leaves a shot with empty frames at the end, because
that is a true statement about what somebody authored, and deriving the window
from the extent would make deleting the last drawing quietly shorten the film.
`finish` keeps the two numbers apart by name now rather than by a `max` that
read like an accident.
Trim NARROWS one edge and moves nothing else; lengthening is `extend-hold`,
which carries the ripple and shot-length policies because it needs them.
Move is one write to `:time :at` and REFUSES a destination that would overlap,
because moving a drawing and re-timing the ones around it are different
intentions — clear the room with `blank` or `trim` first, which is the
composition. Blank leaves a gap and does not close it; a cel wholly inside
the range goes, one overlapping an end is trimmed to it, and the one spanning
the range is split. Their drawings stay in the library, since a lane does not
own its content.
All three are the same geometry as `split`: a `:span` is in the cel's own
frames, so moving an edge is one write and `:time` and `:playback` are never
touched. That is why trimming the front of a playing insert starts it later into
its animation instead of restarting it — the difference between trimming and
slipping, and the reason they stay separate commands.
Correction layers EVALUATE. `channel/problems` used to refuse an `:over` stack
and `value-at`/`cursor` used to throw on one; both now read it, and the
agreement test that holds the optimized cursor to the specification covers
stacked channels in forward, backward and random frame order. A layer's values
are themselves a channel, so a constant adjustment, a ramp and a return motion
are one mechanism; `:support` is half-open and a layer is inactive outside it;
and a layer has no time space of its own, because the node its channel is on
already has one. Nothing had to change in the codec — a channel is one leaf, so
a correction persists inside it — and nothing had to change in validation
plumbing, since `node/problems` already reports every channel's problems.
Both halves of ownership are under test at lane level: a three-frame correction
on the girl's lane reaches across the drawing boundary beneath it and leaves
every frame outside its support identical, and a correction owned by one
cel travels with that cel when a hold before it grows.
Regeneration keeps them, which is the obligation the layer design exists to
meet: `rebased` replaces a base and carries its corrections across, and a
correction the new base no longer fits is MARKED rather than dropped or
misapplied — `clip/conflicts` lists those for a view to offer, separately from
`problems`, because a conflict is a decision nobody has made yet and not a
document that will not load. Turning the mouth's `:verts` knob is a real
topology change and is what the test uses. Two latent faults turned up there and
are fixed: `regenerate-head` compared authored channels to measured ones
directly, so the first correction on the head would have stopped it following
re-measurement for good; and an incompatible offset threw in the read path,
which would have taken the stage down on exactly the case the model says to
report.
Overwrite is `blank` followed by non-rippling placement, composed inside one
transaction; insertion keeps its ripple rule. Still unbuilt: slip source,
retime, and deleting reused content. A lane cannot hold AUDIO cels — `lane-problems`
requires visual ones, though this document says a lane may hold either and
should reject only a mixture.
What is NOT implemented is a command that produces a layer — the doc's Constant
adjustment, Ramp and Return motion — and with it the question of how a view
offers those three over a selected range, and how it offers a conflict for
resolution. Slip source and retime are also not implemented; a refusal is the
current behavior where the model demands an explicit choice nobody has made yet.
The cel sheet is the same projected cels and selection addresses with its axes
turned: frames down and lanes across, so commands selected there and in the
timeline have identical targets. The suite stands at 429 tests and 5,767
assertions, with `frontend/test/browser/lane.mjs` driving the editor through
create, hold, overflow, undo, reuse, make unique, duplicate, split, insert,
trim, move and blank. Rewrite tests that encode superseded
behavior rather than preserving behavior to keep them green.
Build small adversarial documents and test their domain operations before
expanding the interface:
| Scenario | Required invariant |
| --- | --- |
| Same drawing exposed twice, then one made unique | Linked edits affect both before copying and only the selected content after |
| Holds, playing inserts, nonzero in-points, and gaps on one lane | Source behavior is independent of property key count and channel encoding |
| Adjacent cels, final hold, split, trim, ripple, and overwrite | Exact boundaries, stable IDs, deterministic collision handling |
| Extend a hold under lane keys and cel-local corrections | Lane key times remain fixed; later cel corrections travel with their owners; source playback origins survive |
| Ripple beyond the symbol end | Explicit extent policy; refusal leaves the document unchanged; resizing and retiming undo together |
| Girl on twos over a moving background | Drawing cadence does not quantize either lane's continuous properties |
| Three-frame correction crossing a drawing boundary | Exact support, same result outside it, one undo step |
| Nested retiming, holds, loops, and fractional sampling | Explicit time spaces; ambiguous inverse edits cannot silently choose a target |
| Audio inside changing source cels | Only active intervals sound, with correct trim and source timing |
| Regenerate with corrections and a topology change | Compatible edits survive; incompatible ones produce actionable conflicts |
| Reference cycles and deletion of reused content | Inactive references are validated too; no dangling references |
| Save/load and command undo/redo | Identity, source maps, corrections, and evaluation round-trip |
| Timeline and cel-sheet invocation of one command | Identical document changes and selection targets |
| Random forward/backward seeks and export | Reference and optimized evaluation agree, including defaults and absence |
| Concurrent commands on overlapping and disjoint targets | Transactions remain valid; conflicts are explicit and undo preserves others' work |
Implementation order: cel ownership and playback semantics; shared
commands and validation; correction layers and time-addressing contracts; then
breadcrumb, cel strip, and a cel-sheet projection. Use those two temporal
views plus direct stage editing to prove the model before broadening the UI.
A new presentation should not require duplicate animation state. A genuinely new
authoring capability may require new domain data. The model is successful when
such additions have a clear owner and compose with existing operations, not when
it can claim that no future feature will ever need another field.

6
docs/multi-face-representation.md
View file

@ -11,8 +11,10 @@ and persistence. No new kind of scene container is needed.
:symbols :symbols
{:main {:nodes {:root {:time {:mode :map :expose 2}} {:main {:nodes {:root {:time {:mode :map :expose 2}}
:face {:parent :root :channels <source-to-stage placement>} :face {:parent :root :channels <source-to-stage placement>}
:face-1 {:kind :instance :of :face-1 :parent :face :z "a0"} :face-1 {:kind :instance :source {:symbol :face-1}
:face-2 {:kind :instance :of :face-2 :parent :face :z "a1"}}} :parent :face :z "a0"}
:face-2 {:kind :instance :source {:symbol :face-2}
:parent :face :z "a1"}}}
:face-1 {:nodes {:head {...} :mouth {:parent :head ...} ...}} :face-1 {:nodes {:head {...} :mouth {:parent :head ...} ...}}
:face-2 {:nodes {:head {...} :mouth {:parent :head ...} ...}}} :face-2 {:nodes {:head {...} :mouth {:parent :head ...} ...}}}

4
docs/timing-model.md
View file

@ -1,5 +1,9 @@
# Timing model # Timing model
[The Lane Model](lane-model.md) defines the revised target for occurrence timing,
source playback, sampling scope, and inverse editing. It supersedes conflicting
proposals here; the sections below describe earlier implementation decisions.
The source footage, authored drawings, generated face motion, and stage placement The source footage, authored drawings, generated face motion, and stage placement
have different frame decisions. They share a clock but do not share one kept-frame have different frame decisions. They share a clock but do not share one kept-frame
list. `timing-handoff.md` records earlier implementation notes. list. `timing-handoff.md` records earlier implementation notes.

15
frontend/src/arthur/audio/mix.cljs
View file

@ -87,12 +87,16 @@
(.then (fn [buffer] [source {:buffer buffer :fps (.-fps manifest)}])))))))) (.then (fn [buffer] [source {:buffer buffer :fps (.-fps manifest)}]))))))))
(defn- automate! [^js param channel start end fps factor default store] (defn- automate! [^js param channel start end fps factor default store]
(let [channel (or channel (ch/framed default))] (let [channel (or channel (ch/framed default))
(.setValueAtTime param (* factor (ch/value-at channel start store)) (/ start fps)) sample (fn [f] (ch/value-at channel
(if-let [{:keys [at rate]} (:sample-time channel)]
(js/Math.floor (* rate (- f at))) f)
store))]
(.setValueAtTime param (* factor (sample start)) (/ start fps))
(cond (cond
(:dense channel) (:dense channel)
(doseq [f (range (inc start) end)] (doseq [f (range (inc start) end)]
(.setValueAtTime param (* factor (ch/value-at channel f store)) (/ f fps))) (.setValueAtTime param (* factor (sample f)) (/ f fps)))
(:animated? channel) (:animated? channel)
(doseq [[f v] (sort-by key (:keys channel)) (doseq [[f v] (sort-by key (:keys channel))
@ -147,14 +151,13 @@
The raw product. `mix!` packages it as a WAV URL for the transport and The raw product. `mix!` packages it as a WAV URL for the transport and
`export/frames` packages it as WAV bytes in an archive; a muxer would take it as `export/frames` packages it as WAV bytes in an archive; a muxer would take it as
it is, which is why this is the function the others are written in terms of." it is, which is why this is the function the others are written in terms of."
([document sid] (buffer! document sid nil)) [document sid store]
([document sid store]
(let [tracks (tracks-of document sid)] (let [tracks (tracks-of document sid)]
(if (empty? tracks) (if (empty? tracks)
(js/Promise.resolve nil) (js/Promise.resolve nil)
(-> (js/Promise.all (-> (js/Promise.all
(into-array (map source! (distinct (map :source tracks))))) (into-array (map source! (distinct (map :source tracks)))))
(.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store)))))))) (.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store)))))))
(defn decode! (defn decode!
"Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain "Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain

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

@ -12,6 +12,7 @@
are entirely dense." are entirely dense."
(:require [arthur.demo :as demo] (:require [arthur.demo :as demo]
[arthur.domain.clip :as domain-clip] [arthur.domain.clip :as domain-clip]
[arthur.domain.trace :as trace]
[arthur.demo.swarm :as swarm] [arthur.demo.swarm :as swarm]
[arthur.demo.take :as take])) [arthur.demo.take :as take]))
@ -159,10 +160,12 @@
: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
:draft [] :draft []
:knobs {} :knobs {}
:trace {:faces #{} :opacity trace/opacity-default}
:expanded #{}}}) :expanded #{}}})
(def rates (def rates

3
frontend/src/arthur/demo.cljs
View file

@ -6,6 +6,7 @@
validates would not be the one that renders, and the model would be validated validates would not be the one that renders, and the model would be validated
against a scene nobody ever looked at." against a scene nobody ever looked at."
(:require [arthur.domain.clip :as domain-clip] (:require [arthur.domain.clip :as domain-clip]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[cljs.reader :as reader] [cljs.reader :as reader]
[shadow.resource :as rc])) [shadow.resource :as rc]))
@ -25,4 +26,4 @@
"Draw ops for one frame, via the specification path. The page uses "Draw ops for one frame, via the specification path. The page uses
`symbol/resolver` instead; this is here for the REPL." `symbol/resolver` instead; this is here for the REPL."
[f] [f]
(symbol/eval-frame main f)) (symbol/eval-frame main f nil pal/index-of nil))

15
frontend/src/arthur/demo/stage.cljs
View file

@ -22,15 +22,17 @@
(defn compose (defn compose
"The authored layout plus a source clip -> the composed stage document. "The authored layout plus a source clip -> the composed stage document.
A PLACEMENT IS KEYED BY ITS :uuid, not by the authored id. The authored id AN INSTANCE IS KEYED BY ITS :uuid, not by the authored id. The authored id
(`:left`, `:voice-right`) is a handle for reading the EDN and for the (`:left`, `:voice-right`) is a handle for reading the EDN and for the
`:linked-to` written there; it does not appear in the document this returns. `:linked-to` written there; it does not appear in the document this returns.
What replaces it is an identity that means one placement and nothing else: seven What replaces it is an identity that means one instance and nothing else: seven
instances of one symbol are seven different things to name — to export on their instances of one symbol are seven different things to name — to export on their
own, to link a voice to, to point at later — and an id like `:left` is a own, to link a voice to, to point at later — and an id like `:left` is a
description of where a thing sits, which is exactly what changes when the stage description of where a thing sits, which is exactly what changes when the stage
is re-arranged. `:name` carries the label for a human and `:of` carries the is re-arranged. `:name` carries the label for a human and `:source :symbol`
symbol, so the node still says what it is and which drawing it plays." carries the symbol, so the node still says what it is and which drawing it
plays — and `:playback` says how time runs inside it, which is a separate
question from which drawing that is."
[source] [source]
(let [{:keys [name width height frames symbol instances audio scale]} layout (let [{:keys [name width height frames symbol instances audio scale]} layout
default-anchor (or (:anchor layout) default-anchor (or (:anchor layout)
@ -42,16 +44,17 @@
by-id (into {} (map (juxt :id :uuid)) (concat instances audio)) by-id (into {} (map (juxt :id :uuid)) (concat instances audio))
uuid-of (fn [what id] uuid-of (fn [what id]
(or (get by-id id) (or (get by-id id)
(throw (ex-info "the stage layout names a placement that is not there" (throw (ex-info "the stage layout names an instance that is not there"
{:in what :id id {:in what :id id
:known (vec (sort-by str (keys by-id)))})))) :known (vec (sort-by str (keys by-id)))}))))
nodes (into nodes (into
{:root {:id :root :name "stage" :kind :group :z "a1"}} {:root {:id :root :name "stage" :kind :group :z "a1"}}
(map (fn [{:keys [uuid name z span at center anchor drift phase]}] (map (fn [{:keys [uuid name z span at center anchor drift phase]}]
(let [anchor (or anchor default-anchor)] (let [anchor (or anchor default-anchor)]
[uuid {:id uuid :name name :kind :instance :of symbol [uuid {:id uuid :name name :kind :instance
:parent :root :z z :span span :parent :root :z z :span span
:time {:mode :map :at at :rate 1} :time {:mode :map :at at :rate 1}
:source {:symbol symbol}
:channels {[:xform :pos] (if drift :channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames) (position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor))) (ch/framed (mapv - center anchor)))

15
frontend/src/arthur/domain/bring.cljs
View file

@ -11,6 +11,7 @@
so the events that fetch them are only fetching." so the events that fetch them are only fetching."
(:refer-clojure :exclude [take]) (:refer-clojure :exclude [take])
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[clojure.string :as string])) [clojure.string :as string]))
(defn symbols (defn symbols
@ -19,8 +20,8 @@
`other` to its id here. `other` to its id here.
AN ID THAT IS TAKEN IS RENAMED, never merged: two symbols that happen to share AN ID THAT IS TAKEN IS RENAMED, never merged: two symbols that happen to share
an id are two drawings, and an instance's `:of` inside the copy is rewritten to an id are two drawings, and a cel's `:source :symbol` inside the copy is
follow. `wanted` maps a root's id in `other` to the id it should preferably get, rewritten to follow. `wanted` maps a root's id in `other` to the id it should preferably get,
which is how a symbol made from footage is called what the person typed rather which is how a symbol made from footage is called what the person typed rather
than `:main`. than `:main`.
@ -35,12 +36,16 @@
(some #{%} (vals ids)))] (some #{%} (vals ids)))]
(assoc ids sid (clip/free-id taken? (get wanted sid sid))))) (assoc ids sid (clip/free-id taken? (get wanted sid sid)))))
{} (sort-by str reach)) {} (sort-by str reach))
;; Cel identity and timing stay put; content references follow
;; the symbol IDs assigned in the destination document.
repoint (fn [n ids]
(if (node/source n)
(update-in n [:source :symbol] ids)
n))
copy (fn [sid] copy (fn [sid]
(-> (clip/symbol other sid) (-> (clip/symbol other sid)
(assoc :id (ids sid)) (assoc :id (ids sid))
(update :nodes #(into {} (map (fn [[id n]] (update :nodes #(into {} (map (fn [[id n]] [id (repoint n ids)])) %))))]
[id (cond-> n (:of n) (update :of ids))]))
%))))]
{:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach) {:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach)
:ids ids})) :ids ids}))

294
frontend/src/arthur/domain/channel.cljs
View file

@ -68,8 +68,11 @@
(defn framed [v] {:animated? false :value v}) (defn framed [v] {:animated? false :value v})
(defn keyed (defn keyed
([ks] (keyed ks :hold)) "A channel of keys, and how each one leads to the next. `interp` is an
([ks interp] {:animated? true :interp interp :keys ks :over []})) argument, never a default: `:hold` and `:linear` are the difference between a
cut and a tween, which is the whole content of the channel."
[ks interp]
{:animated? true :interp interp :keys ks :over []})
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -91,17 +94,160 @@
(when-let [ks (:keys ch)] (when-let [ks (:keys ch)]
(vec (sort (keys ks))))) (vec (sort (keys ks)))))
(defn- check-unimplemented! ;; ---------------------------------------------------------------------------
"An override layer must fail LOUDLY rather than be ignored. ;; correction layers
;;
;; `:over` is an ORDERED STACK on top of whatever the channel already says.
;; Generated motion stays the base; a hand correction is a layer above it, so
;; regenerating replaces the base and the corrections survive. That is the whole
;; reason the stack exists rather than the hand edit being written into the keys.
;;
;; A LAYER'S VALUES ARE A CHANNEL. A constant adjustment is a framed one, a ramp
;; or a return motion is a keyed one, and neither needs a second way of saying
;; what a value is over time: layers read through `value-at` and `cursor` like
;; anything else, which is also what stops the fast path and the specification
;; from being two implementations of blending.
;;
;; A LAYER HAS NO TIME SPACE OF ITS OWN. Its `:support` and its values' keys are
;; in the frames the base channel's keys are in — the node's own. A correction on
;; a lane is therefore in lane frames and crosses the drawing boundaries under
;; it; a correction on one cel is in that cel's frames and travels
;; with it when it moves. Ownership already answered the question, so there is no
;; field to get wrong.
Silently dropping an :over layer would present as a hand (defn layer
correction that did not take — a correction the user made once, watched fail, "One correction: `values` applied to the base wherever `support` covers the
and has no reason to trust again. Nothing can produce one yet, so this can frame. `op` is `:offset` or `:replace`."
only fire on a data shape that has run ahead of the code." [id support op values]
{:id id :support support :op op :values values})
(defn- covers?
"Half-open, as a span is: a correction over frames 10 to 12 is `[10 13)`."
[[in out] f]
(and (<= in f) (< f out)))
(defn- width
"Components in a value, or nil for a number. A dense value is a typed-array
view, an authored one a vector, and a correction has to add to either."
[v]
(cond (number? v) nil (vector? v) (count v) :else (.-length v)))
(defn- shape
"What kind of value this is, for asking whether one can be added to another:
`:scalar`, a component count, or `:opaque` for a value that is neither — a
`[:vis]` boolean is opaque, and can be replaced but not offset."
[v]
(cond
(number? v) :scalar
(vector? v) (count v)
(and (some? v) (number? (.-length v))) (.-length v)
:else :opaque))
(defn value-shape
"The shape of the values a channel yields, without sampling it, or nil where
there is nothing to read it off — an empty key map says nothing about what its
values would have been, and nil must not be taken for a scalar."
[ch] [ch]
(when (seq (:over ch)) (cond
(throw (ex-info "channel has :over layers and the override layer is not built (port-plan step 2 scope)" (not (:animated? ch)) (when (some? (:value ch)) (shape (:value ch)))
{:over (:over ch) :channel (dissoc ch :dense)})))) (:dense ch) (if (= 1 (:stride (:dense ch))) :scalar (:stride (:dense ch)))
(seq (:keys ch)) (shape (val (first (:keys ch))))
:else nil))
(defn- shape-conflict [base-shape correction-shape]
(cond
(or (nil? base-shape) (nil? correction-shape)) nil
(= :opaque base-shape) "the base is not a number or a row of components"
(= :opaque correction-shape) "the correction is not a number or a row of components"
(not= base-shape correction-shape)
(str "the base has " (pr-str base-shape) " and the correction "
(pr-str correction-shape) " — a correction cannot offset a value of"
" a different shape")))
(defn conflict-with
"Why correction `l` cannot apply to base channel `base`, or nil.
ONLY `:offset` can conflict. It adds component by component, so it needs the
base to have the components it has — which is what a topology change takes
away when a re-freeze gives a mouth a different number of points. `:replace`
states a whole value and so has nothing to agree with.
Shapes that cannot be read yet do not conflict: an empty key map is not a
disagreement, it is a channel with nothing in it."
[base l]
(when (= :offset (:op l))
(shape-conflict (value-shape base) (value-shape (:values l)))))
(defn- stack-conflict
"Why layer `i` can encounter a value of the wrong shape after the layers
before it. A replace covering all of this layer's support becomes the only
possible input; a partly overlapping replace adds another possible input."
[ch i l]
(when (and (= :offset (:op l))
(vector? (:support l)) (= 2 (count (:support l))))
(let [[a b] (:support l)
shapes (reduce
(fn [possible prior]
(let [[c d] (when (and (vector? (:support prior))
(= 2 (count (:support prior))))
(:support prior))]
(if (and c d (not (:conflict prior)) (= :replace (:op prior))
(< a d) (< c b))
(let [s (value-shape (:values prior))]
(if (and (<= c a) (<= b d)) #{s} (conj possible s)))
possible)))
#{(value-shape ch)} (take i (:over ch)))
v (value-shape (:values l))]
(some #(shape-conflict % v) shapes))))
(defn conflicts
"Corrections on `ch` that cannot apply to its base, as `[{:id :why}]`.
NOT `problems`. A conflict is a legitimate state for a document to be in: a
regeneration changed the topology under a correction that was right when it was
made, and resolving it is a person's decision, not a reason the document will
not load. `flow/regenerate` records one on the layer, a conflicted layer is not
applied, and this is how a view finds them to offer."
[ch]
(vec (for [l (:over ch)
:let [why (or (:conflict l) (conflict-with ch l))]
:when why]
{:id (:id l) :why why})))
(defn- offset-onto
"`base` plus `v`, component-wise. A vector, never a write into `base`, which
for a dense channel is a view onto the block itself."
[base v ch]
(let [wb (width base) wv (width v)]
(cond
(and (nil? wb) (nil? wv)) (+ base v)
(and wb wv (= wb wv))
(mapv (fn [i] (+ (component base i) (component v i))) (range wb))
:else
(throw (ex-info "a correction cannot offset a value of a different shape"
{:base wb :correction wv :channel (dissoc ch :dense)})))))
(defn- over-at
"Fold `ch`'s layers onto `base` at frame f. `read` samples one layer's values
and is the only thing that differs between the specification and the cursor."
[ch f base read]
(reduce-kv
(fn [v i {:keys [support op values conflict]}]
;; A conflicted correction is neither applied nor forgotten: it stays in
;; the document, `conflicts` reports it, and a person decides. Applying it
;; would misapply it; removing it would throw away hand work.
(if (or conflict (not (covers? support f)))
v
(let [x (read i values f)]
(cond
(nothing? x) v
(= :replace op) x
;; `replace` can supply a value over an absent base; `offset` has
;; nothing to add to and says so rather than inventing a pose.
(nothing? v) absent
:else (offset-onto v x ch)))))
base
(vec (:over ch))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; dense blocks ;; dense blocks
@ -147,9 +293,9 @@
Decoding costs the view. `out` is a stride-sized destination the caller owns — Decoding costs the view. `out` is a stride-sized destination the caller owns —
`cursor` allocates one per channel — because a copy per node per frame is the `cursor` allocates one per channel — because a copy per node per frame is the
allocation this whole model is arranged to avoid; passing nil allocates, which allocation this whole model is arranged to avoid; passing nil allocates, which
is what `value-at`, the specification, does." is what `value-at`, the specification, does — and it says so by passing nil,
([blk f st] (dense-at blk f st nil)) because there is no arity here that decides it for a caller."
([{:keys [store offset stride scale] nf :frames} f st out] [{:keys [store offset stride scale] nf :frames} f st out]
(let [{:keys [data state]} (get st store)] (let [{:keys [data state]} (get st store)]
(when (nil? data) (when (nil? data)
(throw (ex-info "dense channel's store key is not in the store" (throw (ex-info "dense channel's store key is not in the store"
@ -164,7 +310,7 @@
:else (let [dst (or out (js/Float64Array. stride))] :else (let [dst (or out (js/Float64Array. stride))]
(dotimes [k stride] (dotimes [k stride]
(aset dst k (/ (aget data (+ o k)) scale))) (aset dst k (/ (aget data (+ o k)) scale)))
dst)))))))) dst)))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the specification ;; the specification
@ -201,17 +347,28 @@
(defn value-at (defn value-at
"Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and "Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and
O(n) in the keys. `cursor`/`sample!` is what playback uses." O(n) in the keys. `cursor`/`sample!` is what playback uses.
([ch f] (value-at ch f nil))
([ch f store] `store` IS AN ARGUMENT, NEVER A DEFAULT. A dense channel cannot be read
(check-unimplemented! ch) without the tier-2 store it names, and an arity that filled in nil let a
(cond caller omit it, read correctly for every channel that happened not to be
dense, and throw the first time a selection landed on one that was. That is
how `gesture/values` took the stage down on an iris. A caller with no store
says `nil` and means it."
([ch f store] (value-at ch f f store))
([ch base-f correction-f store]
(let [base (cond
(not (:animated? ch)) (:value ch) (not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) f store) (:dense ch) (dense-at (:dense ch) base-f store nil)
(:keys ch) (let [ks (:keys ch)] (:keys ch) (let [ks (:keys ch)]
(if (empty? ks) absent (keyed-at ch f))) (if (empty? ks) absent (keyed-at ch base-f)))
:else :else
(throw (ex-info "animated channel has neither :keys nor :dense" {:channel ch}))))) (throw (ex-info "animated channel has neither :keys nor :dense"
{:channel ch})))]
(if (seq (:over ch))
(over-at ch correction-f base
(fn [_ values f] (value-at values f store)))
base))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the playback path ;; the playback path
@ -233,7 +390,7 @@
(recur (inc mid) hi mid) (recur (inc mid) hi mid)
(recur lo (dec mid) best)))))) (recur lo (dec mid) best))))))
(deftype Cursor [ch ks store buf ^:mutable i] (deftype Cursor [ch ks store buf overs ^:mutable i]
Object Object
(toString [_] (str "#Cursor{" (pr-str (if ks :keyed (if (:dense ch) :dense :framed))) " i=" i "}"))) (toString [_] (str "#Cursor{" (pr-str (if ks :keyed (if (:dense ch) :dense :framed))) " i=" i "}")))
@ -244,26 +401,28 @@
needs, for the same reason the resolver owns one point buffer per node. needs, for the same reason the resolver owns one point buffer per node.
Only a wide fixed-point block gets a buffer: a stride-1 block decodes to a Only a wide fixed-point block gets a buffer: a stride-1 block decodes to a
number and a block with no `:scale` is handed back as a view." number and a block with no `:scale` is handed back as a view.
([ch] (cursor ch nil))
([ch store] A correction layer gets a reading head of its own, because its values are a
(check-unimplemented! ch) channel and this is how a channel is read fast. One level deep: a layer's
values may not themselves carry layers, which `problems` refuses.
`store` is an argument for the reason it is one on `value-at`."
[ch store]
(let [d (:dense ch)] (let [d (:dense ch)]
(->Cursor ch (->Cursor ch
(when (and (:animated? ch) (not d) (seq (:keys ch))) (frames ch)) (when (and (:animated? ch) (not d) (seq (:keys ch))) (frames ch))
store store
(when (and d (:scale d) (> (:stride d) 1)) (when (and d (:scale d) (> (:stride d) 1))
(js/Float64Array. (:stride d))) (js/Float64Array. (:stride d)))
0)))) (mapv #(cursor (:values %) store) (:over ch))
0)))
(defn sample! (defn- base-sample!
"Value of the cursor's channel at f. O(1) when f is at or one key past where "What the cursor's channel says at f BEFORE its corrections. Advancing the
the cursor already sits — the playback case — and O(log n) otherwise, which is reading head is this function's whole job, and it is separate from blending so
a seek. Advancing and seeking are deliberately different costs: a scrub can that a layer cannot accidentally be read through the base's index."
afford a binary search and a frame cannot." [^Cursor cur ch ks f]
[^Cursor cur f]
(let [ch (.-ch cur)
ks (.-ks cur)]
(cond (cond
(not (:animated? ch)) (:value ch) (not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) f (.-store cur) (.-buf cur)) (:dense ch) (dense-at (:dense ch) f (.-store cur) (.-buf cur))
@ -285,7 +444,25 @@
:else (bsearch ks f))] :else (bsearch ks f))]
(set! (.-i cur) i') (set! (.-i cur) i')
(interpolate ch f (nth ks i') (when (< i' last) (nth ks (inc i')))))))) (interpolate ch f (nth ks i') (when (< i' last) (nth ks (inc i')))))))
(defn sample!
"Value of the cursor's channel at f. O(1) when f is at or one key past where
the cursor already sits — the playback case — and O(log n) otherwise, which is
a seek. Advancing and seeking are deliberately different costs: a scrub can
afford a binary search and a frame cannot.
A correction layer is sampled through its OWN cursor, so a stacked channel is
still one reading head per key map and `value-at` stays the specification for
the blending as well as for the base."
([cur f] (sample! cur f f))
([^Cursor cur base-f correction-f]
(let [ch (.-ch cur)
base (base-sample! cur ch (.-ks cur) base-f)]
(if (seq (:over ch))
(over-at ch correction-f base
(fn [i _ f] (sample! (nth (.-overs cur) i) f)))
base))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -345,8 +522,45 @@
(or (:dense ch) (not linear-values?))) (or (:dense ch) (not linear-values?)))
(conj ":linear interpolation needs numeric keys of one shape") (conj ":linear interpolation needs numeric keys of one shape")
(and (map? ch) (seq (:over ch))) (and (map? ch) (contains? ch :over) (not (vector? (:over ch))))
(conj ":over layers are not implemented (port-plan step 2 scope)") (conj ":over is an ORDERED stack, so it is a vector")
(and (map? ch) (vector? (:over ch)))
(into (for [{:keys [id support op values]} (:over ch)
p (cond-> []
(nil? id)
(conj "needs an :id — a correction has an identity a regeneration can keep")
(not (and (vector? support) (= 2 (count support))
(every? #(and (number? %) (js/Number.isFinite %)) support)
(< (first support) (second support))))
(conj (str ":support " (pr-str support)
" must be a finite, increasing [in out)"))
(not (#{:offset :replace} op))
(conj (str ":op " (pr-str op) " is not :offset or :replace"))
;; One level. A layer over a layer is an ordering mechanism
;; the stack already is, and it would make the read
;; unbounded in depth for nothing.
(seq (:over values))
(conj "a layer's values cannot carry layers of their own")
(seq (problems (dissoc values :over)))
(conj (str "values are not a channel: "
(first (problems (dissoc values :over))))))]
(str "correction " (pr-str id) " " p)))
;; A shape mismatch NOBODY HAS RECORDED is an authoring bug; one a
;; regeneration recorded is a conflict awaiting a person, and `conflicts`
;; reports those. The distinction is what keeps a topology change from
;; making a document that will not load.
(and (map? ch) (vector? (:over ch)))
(into (for [[i l] (map-indexed vector (:over ch))
:when (not (:conflict l))
:let [why (stack-conflict ch i l)]
:when why]
(str "correction " (pr-str (:id l)) " " why)))
;; A scale of zero divides every value in the block by zero, and a negative ;; A scale of zero divides every value in the block by zero, and a negative
;; one mirrors the geometry. Both are authored-data bugs that present as a ;; one mirrors the geometry. Both are authored-data bugs that present as a

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

@ -38,7 +38,8 @@
instance is `:rate` on its `:time` map, which is a factor and not a rate. A instance is `:rate` on its `:time` map, which is a factor and not a rate. A
frame COUNT is a property of a frame space, so every symbol has its own." frame COUNT is a property of a frame space, so every symbol has its own."
(:refer-clojure :exclude [symbol]) (:refer-clojure :exclude [symbol])
(:require [arthur.domain.feature :as feature] (:require [arthur.domain.channel :as ch]
[arthur.domain.feature :as feature]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
@ -84,8 +85,7 @@
(defn places (defn places
"The ids of the symbols `sid` places, directly." "The ids of the symbols `sid` places, directly."
[clip sid] [clip sid]
(into #{} (keep (fn [n] (when (= :instance (:kind n)) (:of n)))) (into #{} (mapcat node/sources) (vals (:nodes (symbol clip sid)))))
(vals (:nodes (symbol clip sid)))))
(defn contains-symbol? (defn contains-symbol?
"Whether `inner` is `outer` or is placed anywhere inside it. Placing `outer` "Whether `inner` is `outer` or is placed anywhere inside it. Placing `outer`
@ -124,14 +124,18 @@
"A new, empty document: one empty symbol. "A new, empty document: one empty symbol.
`:nodes` is empty rather than seeded with a layer, because an empty symbol is `:nodes` is empty rather than seeded with a layer, because an empty symbol is
a true statement and a layer nobody asked for is one more thing to delete. The a true statement and a layer nobody asked for is one more thing to delete.
tracking maps are present and empty for the same reason `clip-keys` exists: a
field that is sometimes absent is a field every reader needs a fallback for." 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
as a different map than it saved from is exactly the round trip that namespace
promises not to have. Nothing drawn by hand has them either — the demo scene
and the swarm carry no `:subjects` — so every reader already reads absence as
none, and `clip-keys` says which fields MAY be here, not which must."
[] []
{:name "untitled" {:name "untitled"
:fps 30 :fps 30
:width 320 :height 200 :width 320 :height 200
:subjects {} :features {} :groups {}
:symbols {:main {:id :main :frames blank-frames :nodes {}}}}) :symbols {:main {:id :main :frames blank-frames :nodes {}}}})
(defn- transform-op (defn- transform-op
@ -174,8 +178,7 @@
own frame. Nil for a node that was not on that frame. It is how something own frame. Nil for a node that was not on that frame. It is how something
drawn beside the picture, like a tracing photo, rides a node inside it without drawn beside the picture, like a tracing photo, rides a node inside it without
resolving anything a second time." resolving anything a second time."
([clip store palette sid] (resolver clip store palette sid nil)) [clip sid store palette {:keys [picture-fps] :as opts}]
([clip store palette sid {:keys [picture-fps] :as opts}]
(letfn [(build [sid chain pose-tracks] (letfn [(build [sid chain pose-tracks]
(when (some #{sid} chain) (when (some #{sid} chain)
(throw (ex-info "symbol cycle" {:chain (conj chain sid)}))) (throw (ex-info "symbol cycle" {:chain (conj chain sid)})))
@ -184,17 +187,24 @@
nodes (:nodes sym) nodes (:nodes sym)
rank (symbol/draw-rank nodes (symbol/order nodes)) rank (symbol/draw-rank nodes (symbol/order nodes))
ids (sort-by rank (keys nodes)) ids (sort-by rank (keys nodes))
own (symbol/resolver sym store palette pose-tracks own (symbol/resolver sym store palette
(assoc opts :source-fps (:fps clip))) (assoc opts :pose-tracks pose-tracks
:source-fps (:fps clip)))
;; Each cel owns its source resolver and mutable buffers.
children (into {} children (into {}
(for [[id n] nodes :when (= :instance (:kind n))] (for [[id n] nodes
[id (build (:of n) (conj chain sid) :when (= :instance (:kind n))
child (sort-by str (node/sources n))]
[[id child] (build child (conj chain sid)
(get-in n [:playback :tracks]))])) (get-in n [:playback :tracks]))]))
;; The instances that were on the last frame. Their resolvers ;; The instances that were on the last frame, and WHICH
;; still hold the frame before whenever they were not. ;; drawing each was showing — a row path is read back through
entered (volatile! #{}) ;; the child that was actually resolved, not the only one
;; there used to be. Their resolvers still hold the frame
;; before whenever they were not on.
entered (volatile! {})
step (fn [f] step (fn [f]
(vreset! entered #{}) (vreset! entered {})
(let [by-id (into {} (map (juxt :node identity)) (own f))] (let [by-id (into {} (map (juxt :node identity)) (own f))]
(into [] (into []
(mapcat (mapcat
@ -203,15 +213,14 @@
(if (= :instance (:kind n)) (if (= :instance (:kind n))
(let [m (symbol/world-of own id) (let [m (symbol/world-of own id)
local (symbol/frame-of own id) local (symbol/frame-of own id)
target (symbol clip (:of n)) length (frames clip (node/source n))
length (:frames target) shown (when (and m (number? local))
frame (when (and m (number? local)) (node/placed-frame n local length))
(if (get-in n [:time :loop?]) frame (:frame shown)]
(mod local length)
local))]
(if (and frame (<= 0 frame) (< frame length)) (if (and frame (<= 0 frame) (< frame length))
(do (vswap! entered conj id) (do (vswap! entered assoc id (:symbol shown))
(map #(transform-op % m [id]) ((get children id) frame))) (map #(transform-op % m [id])
((get children [id (:symbol shown)]) frame)))
[])) []))
(when-let [op (get by-id id)] [op])))) (when-let [op (get by-id id)] [op]))))
ids))))] ids))))]
@ -222,15 +231,16 @@
(world-of [_ [id & more]] (world-of [_ [id & more]]
(if more (if more
(when-let [w (and (contains? @entered id) (when-let [w (and (contains? @entered id)
(symbol/world-of (get children id) (vec more)))] (symbol/world-of (get children [id (get @entered id)])
(vec more)))]
(node/mul! (node/mat) (symbol/world-of own id) w)) (node/mul! (node/mat) (symbol/world-of own id) w))
(symbol/world-of own id))) (symbol/world-of own id)))
(frame-of [_ [id & more]] (frame-of [_ [id & more]]
(if more (if more
(when (contains? @entered id) (when (contains? @entered id)
(symbol/frame-of (get children id) (vec more))) (symbol/frame-of (get children [id (get @entered id)]) (vec more)))
(symbol/frame-of own id))))))] (symbol/frame-of own id))))))]
(build sid [] nil)))) (build sid [] nil)))
(defn center (defn center
"The middle of everything symbol `sid` draws, over all its frames, in its own "The middle of everything symbol `sid` draws, over all its frames, in its own
@ -244,7 +254,7 @@
Effects' anchor point are set once and left. A symbol that grows later keeps Effects' anchor point are set once and left. A symbol that grows later keeps
its instances' pivots where they were, so nothing on screen moves." its instances' pivots where they were, so nothing on screen moves."
[clip store sid] [clip store sid]
(let [resolve (resolver clip store pal/index-of sid) (let [resolve (resolver clip sid store pal/index-of nil)
bounds (fn [[x0 y0 x1 y1 :as b] x y] bounds (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y])) (if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
[x0 y0 x1 y1] [x0 y0 x1 y1]
@ -272,7 +282,7 @@
middle goes there; without one — a drop on the timeline — the drawing stays middle goes there; without one — a drop on the timeline — the drawing stays
where it was drawn. where it was drawn.
THE UUID IS AN ARGUMENT. A placement's identity is the key it has in the node THE UUID IS AN ARGUMENT. An instance's identity is the key it has in the node
map — it is what `:linked-to`, an export target and a saved leaf all name — so map — it is what `:linked-to`, an export target and a saved leaf all name — so
generating one in here would make this function's result depend on when it was generating one in here would make this function's result depend on when it was
called, and this namespace is the pure one. called, and this namespace is the pure one.
@ -296,13 +306,14 @@
{:id uuid {:id uuid
:name (symbol-name clip sid) :name (symbol-name clip sid)
:kind :instance :kind :instance
:of sid
:parent nil :parent nil
;; Lexicographic draw order, as `domain/paint` does it: a placement made ;; Lexicographic draw order, as `domain/paint` does it: an instance made
;; later sits above one made earlier, and neither has to renumber. ;; later sits above one made earlier, and neither has to renumber.
:z (str "z" (js/Date.now) "-" (name sid)) :z (str "z" (js/Date.now) "-" (name sid))
:span [0 (:frames target)] :span [0 (:frames target)]
:time {:mode :map :at frame :rate 1} :time {:mode :map :at frame :rate 1}
:source {:symbol sid}
:playback {:in 0 :speed 1 :end :stop}
:channels {[:xform :pos] {:animated? false :channels {[:xform :pos] {:animated? false
:value (if point (mapv - point middle) [0 0])} :value (if point (mapv - point middle) [0 0])}
[:xform :anchor] {:animated? false :value middle}}}))))) [:xform :anchor] {:animated? false :value middle}}})))))
@ -355,6 +366,23 @@
(map #(keyword (namespace wanted) (str (name wanted) "-" %)) (map #(keyword (namespace wanted) (str (name wanted) "-" %))
(iterate inc 2)))))) (iterate inc 2))))))
(defn conflicts
"Every hand correction in the document that its base has outgrown, as
`[{:symbol :node :channel :id :why}]`.
SEPARATE FROM `problems` on purpose. A conflict is a document a person still
has to make a decision about — a regeneration changed the topology under a
correction that was right when it was made — and not a reason the document
will not load. Nothing is dropped and nothing is misapplied meanwhile: the
layer stays where it is, the picture is the base, and this is the list a view
offers to resolve."
[clip]
(vec (for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
[prop c] (:channels n)
{:keys [why] :as x} (ch/conflicts c)]
(assoc (select-keys x [:id]) :symbol sid :node id :channel prop :why why))))
(defn problems (defn problems
"Human-readable reasons this clip will not evaluate or save." "Human-readable reasons this clip will not evaluate or save."
[clip] [clip]
@ -374,22 +402,23 @@
(str "symbol " (pr-str id) ": " p)) (str "symbol " (pr-str id) ": " p))
(for [[sid sym] (:symbols clip) (for [[sid sym] (:symbols clip)
[id n] (:nodes sym) [id n] (:nodes sym)
:when (and (= :instance (:kind n)) :when (= :instance (:kind n))
(not (contains? (:symbols clip) (:of n))))] missing (remove (:symbols clip) (node/sources n))]
(str "symbol " (pr-str sid) " instance " (pr-str id) (str "symbol " (pr-str sid) " instance " (pr-str id)
" names missing symbol " (pr-str (:of n)))) " names missing symbol " (pr-str missing)))
;; Pose tracks belong to this cel's single source symbol.
(for [[sid sym] (:symbols clip) (for [[sid sym] (:symbols clip)
[id n] (:nodes sym) [id n] (:nodes sym)
:when (= :instance (:kind n)) :when (= :instance (:kind n))
:let [target (get-in clip [:symbols (:of n)]) :let [targets (keep #(get-in clip [:symbols %]) (node/sources n))
active (filter (fn [node] active (filter (fn [node]
(some :pose-sampled? (vals (:channels node)))) (some :pose-sampled? (vals (:channels node))))
(vals (:nodes target))) (mapcat #(vals (:nodes %)) targets))
groups (set (concat groups (set (concat
(map #(or (:pose-group %) (:id %)) active) (map #(or (:pose-group %) (:id %)) active)
(map #(vector :node (:id %)) active)))] (map #(vector :node (:id %)) active)))]
p (pose/problems (get-in n [:playback :tracks]) p (pose/problems (get-in n [:playback :tracks])
(:frames target) groups)] (apply max 0 (keep :frames targets)) groups)]
(str "symbol " (pr-str sid) " instance " (pr-str id) ": " p)) (str "symbol " (pr-str sid) " instance " (pr-str id) ": " p))
(for [[sid sym] (:symbols clip) (for [[sid sym] (:symbols clip)
[id n] (:nodes sym) [id n] (:nodes sym)

17
frontend/src/arthur/domain/gesture.cljs
View file

@ -15,9 +15,17 @@
[arthur.domain.node :as node])) [arthur.domain.node :as node]))
(defn values (defn values
"Node `n`'s transform on its own frame `f`, as vectors." "Node `n`'s transform on its own frame `f`, as vectors.
[n f]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f) `store` IS NOT OPTIONAL, though `ch/value-at` would let it be. A measured
transform is a dense channel, and a dense channel read without the tier-2
store it names throws — so leaving it off read correctly for every hand-placed
node and crashed the stage the moment a selection landed on an iris, a brow or
a head. Those are not hard to land on: `pick/choose` keeps a selection at the
depth it already has, so once anything inside a face is selected, an ordinary
click beside it selects its neighbour — which near the eyes is an iris."
[n f store]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f store)
xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])] xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
{:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)})) {:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
@ -27,8 +35,7 @@
it would throw the measurement away." it would throw the measurement away."
[n] [n]
(cond (cond
(some #(let [c (get-in n [:channels [:xform %]])] (or (:dense c) (:generated c))) (node/measured? n)
[:pos :rot :scale])
"its transform is measured — place the instance it is in")) "its transform is measured — place the instance it is in"))
(defn- through [m [x y]] (defn- through [m [x y]]

450
frontend/src/arthur/domain/lane.cljs Normal file
View file

@ -0,0 +1,450 @@
(ns arthur.domain.lane
"The commands over a lane of cels: make one, put drawings in it, change
how long they are exposed, and decide which of them 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.
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.symbol :as symbol]))
(defn- lane-map
"Lane -> containing symbol, as an invertible map in the opposite direction.
Refuse floors and loops rather than pretend an affine map preserves them."
[nodes id]
(loop [id id seen #{} chain []]
(if (nil? id)
(reduce node/then-time {:at 0 :rate 1} (map node/time-of (reverse chain)))
(let [n (get nodes id) t (:time n)]
(when (and n (not (contains? seen id))
(not (:loop? t)) (not (:sample-fps t))
(<= (or (:expose t) 1) 1))
(recur (:parent n) (conj seen id) (conj chain n)))))))
(defn- finish
"Commit `nodes` as symbol `sid`'s, or refuse.
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
from the cels. A command may GROW the window when the caller says
`:grow-symbol`, and never shrinks it: emptying the end of a shot leaves a shot
with empty frames at the end, which is a true statement about what somebody
authored. Deriving the window from the extent instead would make deleting the
last drawing silently shorten the film.
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
second follows the first is a caller asking."
[clip sid nodes selection extent]
(let [sym (clip/symbol clip sid)
reach (for [[id n] nodes :when (node/lane? n)
child (symbol/lane-cels nodes id)
:let [m (lane-map nodes id)
end (second (node/placed-span child))]]
(when m (+ (:at m) (/ end (:rate m)))))
needed (js/Math.ceil (apply max 0 (keep identity reach)))
ps (symbol/problems (assoc sym :nodes nodes))]
(cond
(seq ps) {:refused (first ps)}
(not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"}
(and (> needed (:frames sym)) (= :keep extent))
{:refused (str "the edit needs " needed " frames; extend the shot to continue")
:required-frames needed}
:else {:clip (cond-> (assoc-in clip [:symbols sid :nodes] nodes)
(> needed (:frames sym))
(assoc-in [:symbols sid :frames] needed))
:selection selection})))
;; ---------------------------------------------------------------------------
;; the geometry every cel edit is made of
;;
;; A `:span` is in the cel's OWN frames and its `:time` says where those
;; land in the lane. So moving an edge of a cel is one write to `:span`,
;; and `:time` 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 halves of a split go on meaning what the one cel meant.
;; Trim, split and blank are all this one operation, applied differently.
(defn- local
"Lane frame `f` as one of `n`'s own frames."
[n f]
(let [{:keys [at rate]} (node/time-of n)]
(* rate (- f at))))
(defn- edged
"`n` with its `:in` or `:out` edge at lane frame `f`."
[n which f]
(assoc-in n [:span (case which :in 0 :out 1)] (local n f)))
(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 (lane-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)]
(finish clip sid nodes id extent)))))
(defn split
"Cut cel `id` in two at lane frame `cut`. The left piece keeps its
identity; the right gets `new-id`.
NOTHING BUT `:span` DIFFERS between the two pieces. They keep one `:time`, so
the right piece's own frames carry on exactly where the left's stopped, and its
source clock, its keys and its corrections therefore go on meaning what they
meant before the cut — preserved by construction rather than by arithmetic on
in-points that could be wrong. A held drawing holds the same frame on both
sides; a playing insert plays on through the cut without a seam. That is what
`:span` being in the node's OWN coordinates buys, and it is why splitting
needs no shot-length policy: the pieces occupy the frames the one cel
occupied.
The right piece is the selection, because it is the piece that was made."
[clip sid id cut new-id]
(let [nodes (get-in clip [:symbols sid :nodes])
n (get nodes id)
lane (get nodes (:parent n))
{:keys [at rate]} (node/time-of n)
[lo hi] (or (node/placed-span n) [nil nil])]
(cond
(not (node/lane? lane)) {:refused "select a cel in a lane"}
(not (integer? cut)) {:refused "a cut is a whole lane frame"}
(contains? nodes new-id) {:refused "the new cel ID is already used"}
(not (and lo (< lo cut hi)))
{:refused (str "frame " cut " is not inside this cel")}
:else
(let [nodes (-> nodes
(assoc id (edged n :out cut))
(assoc new-id (assoc (edged n :in cut)
:id new-id :z (str "a-" new-id))))]
(finish clip sid nodes new-id :keep)))))
(defn trim
"Move one edge of cel `id` to lane frame `to`, without disturbing a
single other cel.
TRIM NARROWS. Lengthening a cel is `extend-hold`, which carries a ripple
policy and a shot-length policy because it needs them; letting trim grow as
well would give one gesture two sets of rules and a way to overlap its
neighbour. `edge` is `:in` or `:out`.
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
difference between trimming and slipping, and why they are separate commands."
[clip sid id edge to]
(let [nodes (get-in clip [:symbols sid :nodes])
n (get nodes id)
lane (get nodes (:parent n))
[lo hi] (or (node/placed-span n) [nil nil])]
(cond
(not (node/lane? lane)) {:refused "select a cel in a lane"}
(not (#{:in :out} edge)) {:refused "an edge is :in or :out"}
(not (integer? to)) {:refused "an edge goes to a whole lane frame"}
(not (and lo (< lo to hi)))
{:refused (str "frame " to " is not inside this cel; trim narrows it")}
:else (finish clip sid (assoc nodes id (edged n edge to)) id :keep))))
(defn move
"Put cel `id` at lane frame `to`, leaving every other cel and
its own length, source and corrections alone.
One write to `:time :at`. A destination that would overlap a neighbour is
REFUSED rather than rippled or overwritten: moving a drawing and 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. Clear the room
first — `blank` makes a gap, `trim` shortens a neighbour."
[clip sid id to]
(let [nodes (get-in clip [:symbols sid :nodes])
n (get nodes id)
lane (get nodes (:parent n))
{:keys [at]} (node/time-of n)]
(cond
(not (node/lane? lane)) {:refused "select a cel in a lane"}
(not (integer? to)) {:refused "a cel moves to a whole lane frame"}
(nil? (node/placed-span n)) {:refused "a cel needs a span to move"}
:else
(let [moved (update-in n [:time :at] (fnil + 0) (- to (first (node/placed-span n))))]
(if (not= to (first (node/placed-span moved)))
{:refused "cel timing through a stepped or looping lane is not supported"}
(finish clip sid (assoc nodes id moved) id :keep))))))
(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 the edge geometry above: 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) (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)]
(finish clip sid nodes (or (when spanning id) lane-id) :keep)))))
(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]} (lane-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 (finish clip sid nodes id extent)
m (lane-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? (lane-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) :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? (lane-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) :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})))))

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

@ -33,7 +33,7 @@
[clip store sid frame id] [clip store sid frame id]
(let [sym (clip/symbol clip sid) (let [sym (clip/symbol clip sid)
sym (update sym :nodes select-keys (symbol/lineage (:nodes sym) id)) sym (update sym :nodes select-keys (symbol/lineage (:nodes sym) id))
r (symbol/resolver sym store pal/index-of nil {:source-fps (:fps clip)})] r (symbol/resolver sym store pal/index-of {:source-fps (:fps clip)})]
(r frame) (r frame)
r)) r))
@ -61,13 +61,28 @@
chain (map #(get nodes %) (rseq (symbol/lineage nodes id))) chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))
m (symbol/world-of r id) m (symbol/world-of r id)
local (symbol/frame-of r id) local (symbol/frame-of r id)
inner (get-in nodes [id :of])] inst? (= :instance (:kind (get nodes id)))
;; WHICH symbol, and which frame of it, are both read off the
;; cel: inside a held cel is its drawing on the frame
;; the hold pins, not on `local`, and inside a playing insert
;; is its animation at its own in-point and speed.
shown (when (number? local)
(node/placed-frame (get nodes id) local
(clip/frames clip (node/source (get nodes id)))))
inner (:symbol shown)
lf (if shown (:frame shown) local)]
(if (and m (number? local) (if (and m (number? local)
(or (nil? inner) (< -1 local (clip/frames clip inner)))) ;; A lane over a gap has no inside to be in.
{:sid inner :frame (js/Math.floor local) (or (not inst?) shown)
(or (nil? inner) (< -1 lf (clip/frames clip inner))))
{:sid inner :frame (js/Math.floor lf)
:matrix (node/mul! (node/mat) matrix m) :matrix (node/mul! (node/mat) matrix m)
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain)) ;; Forward sampling above works for holds too. :time is the
(reduce node/then-time time (map node/time-of chain)))} ;; invertible edit map; source in-points and speeds belong in it.
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain)
(or (not inst?) (node/source-time (get nodes id))))
(cond-> (reduce node/then-time time (map node/time-of chain))
inst? (node/then-time (node/source-time (get nodes id)))))}
(reduced nil)))) (reduced nil))))
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}} {:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
path)) path))
@ -109,41 +124,68 @@
(partition 2 pts))))))) (partition 2 pts)))))))
(defn audio-tracks (defn audio-tracks
"Every sound symbol `sid` plays, as audio nodes in `sid`'s own frames: its own "Flatten audible source intervals through cel and parent clocks.
and, recursively, those inside the instances it places. A held visual source is silent. Every returned track carries a source offset,
an output interval, and automation mapped into the open symbol's time."
A sound inside a placed symbol is heard where the instance puts it, so each one
is carried OUT through the instance's time map — the same map a timeline row
draws with — and cut to the instance's own span, until it is in the frames of
the symbol being played. Keyed automation moves with it. What comes back is
what a mixer that only knows flat tracks can play as it is."
[clip sid] [clip sid]
(let [sym (clip/symbol clip sid)] (letfn [(to-local [m f] (* (:rate m) (- f (:at m))))
(into (vec (filter #(= :audio (:kind %)) (vals (:nodes sym)))) (to-outer [m f] (+ (:at m) (/ f (:rate m))))
(window [m span bounds]
(if span
[(max (first bounds) (to-outer m (first span)))
(min (second bounds) (to-outer m (second span)))]
bounds))
(channels [chs m]
(into {}
(map (fn [[p c]]
[p (cond-> c
(:keys c) (update :keys #(into {} (map (fn [[f v]] [(to-outer m f) v])) %))
(:segments c) (update :segments #(into {} (map (fn [[f v]] [(to-outer m f) v])) %))
(:dense c) (assoc :sample-time m))]))
chs))
(walk [sid outer bounds path seen]
(when (contains? seen sid)
(throw (ex-info "symbol cycle in audio" {:symbol sid})))
(let [sym (clip/symbol clip sid)
nodes (:nodes sym)
bounds (window outer [0 (:frames sym)] bounds)
positions (reduce
(fn [acc id]
(let [n (get nodes id)
parent (if-let [pid (:parent n)] (get acc pid)
{:time outer :bounds bounds})
m (node/then-time (:time parent) (node/time-of n))]
(assoc acc id {:time m :bounds (window m (:span n) (:bounds parent))})))
{} (symbol/order nodes))]
(mapcat (mapcat
(fn [inst] (fn [[id n]]
(let [outer (node/time-of inst) (let [{m :time [lo hi] :bounds} (get positions id)]
->outer (fn [x] (+ (:at outer) (/ x (:rate outer)))) (when (< lo hi)
[in out] (or (:span inst) [0 (clip/frames clip (:of inst))])] (case (:kind n)
(keep (fn [a] :audio [(-> n
(let [[p0 p1] (or (node/placed-span a) [in out]) (assoc :parent nil :path (conj path id) :owner sid
x0 (max p0 in) :span [(to-local m lo) (to-local m hi)]
x1 (min p1 out) :time (merge (:time n) {:mode :map :at (:at m) :rate (:rate m) :offset 0})
own (node/time-of a) :channels (channels (:channels n) m)))]
->own (fn [x] (* (:rate own) (- x (:at own)))) :instance
world (node/then-time outer own)] (let [{:keys [in speed end]} (node/playback-of n)
(when (< x0 x1) child (node/source n)
(-> a length (clip/frames clip child)]
(assoc :span [(->own x0) (->own x1)] ;; A visual freeze does not emit a sustained audio sample.
:time {:mode :map :at (:at world) :rate (:rate world)}) (when (and child length (pos? speed))
(update :channels (let [source (node/then-time m {:at (- (/ in speed)) :rate speed})
(fn [chs] loop? (or (= end :loop) (get-in n [:time :loop?]))
(into {} (map (fn [[p ch]] periods (if loop?
[p (cond-> ch (:keys ch) (range (js/Math.floor (/ (to-local source lo) length))
(update :keys #(into {} (map (fn [[f v]] [(->outer f) v])) %)))])) (js/Math.ceil (/ (to-local source hi) length)))
chs))))))) [0])]
(audio-tracks clip (:of inst))))) (mapcat (fn [period]
(filter #(= :instance (:kind %)) (vals (:nodes sym))))))) (let [cycle (update source :at + (/ (* period length) (:rate source)))]
(walk child cycle [lo hi] (conj path id) (conj seen sid))))
periods))))
nil))))
(sort-by (comp str key) nodes))))]
(vec (walk sid {:at 0 :rate 1} [0 (clip/frames clip sid)] [] #{}))))
(defn- retime (defn- retime
"Node `n` with its own time map replaced by `m`, and nothing else touched: its "Node `n` with its own time map replaced by `m`, and nothing else touched: its
@ -184,7 +226,8 @@
js/Float64Array.from))] js/Float64Array.from))]
(cond (cond
(= host target) {:refused "it is already there"} (= host target) {:refused "it is already there"}
(and (= :instance (:kind n)) (clip/contains-symbol? clip (:of n) target)) (and (= :instance (:kind n))
(some #(clip/contains-symbol? clip % target) (node/sources n)))
{:refused "a symbol cannot go inside itself"} {:refused "a symbol cannot go inside itself"}
(some (fn [m] (or (:measured (get nodes m)) (some (fn [m] (or (:measured (get nodes m))
(some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m)))))) (some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m))))))
@ -254,7 +297,13 @@
there are the same on every frame, so asking needs nothing to be on screen; there are the same on every frame, so asking needs nothing to be on screen;
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 [sids (reductions #(get-in clip [:symbols %1 :nodes %2 :of]) sid path) (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
;; stops at a lane rather than picking the drawing showing now — which
;; would make where a row lives depend on the playhead.
only (fn [sid id]
(when sid (node/source (get-in clip [:symbols sid :nodes id]))))
sids (reductions only sid path)
;; Every node on the way, outermost first: each instance, after its ;; Every node on the way, outermost first: each instance, after its
;; parents in the symbol it is in. ;; parents in the symbol it is in.
chain (mapcat (fn [sid id] chain (mapcat (fn [sid id]
@ -262,8 +311,12 @@
(map #(get nodes %) (rseq (symbol/lineage nodes id))))) (map #(get nodes %) (rseq (symbol/lineage nodes id)))))
sids path)] sids path)]
{:sid (last sids) {:sid (last sids)
:time (when (not-any? #(get-in % [:time :loop?]) chain) :time (when (not-any? #(or (get-in % [:time :loop?])
(reduce node/then-time {:at 0 :rate 1} (map node/time-of chain)))})) (and (= :instance (:kind %)) (nil? (node/source-time %)))) chain)
(reduce node/then-time {:at 0 :rate 1}
(mapcat (fn [n] (cond-> [(node/time-of n)]
(= :instance (:kind n)) (conj (node/source-time n))))
chain)))}))
(defn slide (defn slide
"Move the node at row path `path` along its symbol's time by `df` frames of "Move the node at row path `path` along its symbol's time by `df` frames of
@ -343,7 +396,8 @@
:let [n (get nodes (peek from))]] :let [n (get nodes (peek from))]]
(or (node/placed-span n) (or (node/placed-span n)
(when (= :instance (:kind n)) (when (= :instance (:kind n))
(node/placed-span (assoc n :span [0 (clip/frames clip (:of n))]))) (node/placed-span
(assoc n :span [0 (or (clip/frames clip (node/source n)) 0)])))
whole)) whole))
start (js/Math.floor (max 0 (apply min (map first spans)))) start (js/Math.floor (max 0 (apply min (map first spans))))
end (min (second whole) (apply max (map second spans))) end (min (second whole) (apply max (map second spans)))

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

@ -81,6 +81,21 @@
[n] [n]
(merge (defaults-of n) (:channels n))) (merge (defaults-of n) (:channels n)))
(defn measured?
"Is this node's transform regenerated from the footage rather than authored?
ONE PREDICATE, TWO CALLERS, and they are the same question asked twice: a hand
edit to a measured transform is thrown away by the next regenerate, which is
what `gesture/refusal` refuses — and a DEFAULT written under one is worse than
useless, which is what `flow/freeze`'s pivot pass declines to do. A node a hand
cannot transform has no use for a pivot, and at a measured scale an anchor does
not cancel out of `local!` the way it does at the identity, so writing one
would move the very thing it was meant to leave alone."
[n]
(boolean (some #(let [c (get-in n [:channels [:xform %]])]
(or (:dense c) (:generated c)))
[:pos :rot :scale])))
(defn set-channel (defn set-channel
"Write `v` into channel `path`: a key on the node's own frame `f` when the "Write `v` into channel `path`: a key on the node's own frame `f` when the
channel is keyed, its one value when it is not." channel is keyed, its one value when it is not."
@ -92,10 +107,13 @@
(defn toggle-key (defn toggle-key
"Key channel `path` on the node's own frame `f` with the value it has there, or "Key channel `path` on the node's own frame `f` with the value it has there, or
take the key there off. The first key starts the channel animating and taking take the key there off. The first key starts the channel animating and taking
the last one off leaves it that one value. A boolean holds; anything else tweens." the last one off leaves it that one value. A boolean holds; anything else tweens.
[n path f]
`store` because the value it keys is read out of the channel, and a measured
channel's values live in tier 2."
[n path f store]
(let [c (get (channels n) path) (let [c (get (channels n) path)
v (ch/value-at c f) v (ch/value-at c f store)
ks (dissoc (:keys c) f)] ks (dissoc (:keys c) f)]
(assoc-in n [:channels path] (assoc-in n [:channels path]
(cond (cond
@ -118,13 +136,13 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; time maps ;; time maps
;; ;;
;; Exposure, mouth lead and a symbol instance's timing are ONE mechanism, and ;; Cel, mouth lead and a symbol instance's timing are ONE mechanism, and
;; seeing that is what keeps them from being three implementations that disagree ;; seeing that is what keeps them from being three implementations that disagree
;; at the edges. ;; at the edges.
(defn expose (defn expose
"Hold a frame back onto an exposure grid: 1 = on 1s, 2 = on 2s. Frame 5 at "Hold a frame back onto an exposure grid: 1 = on 1s, 2 = on 2s. Frame 5 at
exposure 2 reads the pose from frame 4. cel 2 reads the pose from frame 4.
FLOOR, NEVER ROUND. Rounding would let an output frame read a pose from the FLOOR, NEVER ROUND. Rounding would let an output frame read a pose from the
FUTURE, which is a lead — a separate control, applied after this one, for a FUTURE, which is a lead — a separate control, applied after this one, for a
@ -152,12 +170,12 @@
"A node's own time as the affine map it is: `{:at a :rate r}`, meaning a frame "A node's own time as the affine map it is: `{:at a :rate r}`, meaning a frame
`p` of its parent is frame `r·(p − a)` of its own. THE SAME FOR EVERY NODE. A `p` of its parent is frame `r·(p − a)` of its own. THE SAME FOR EVERY NODE. A
node with no time map is `{:at 0 :rate 1}`, reading its parent's frames as its node with no time map is `{:at 0 :rate 1}`, reading its parent's frames as its
own; a mouth lead's `:offset` is folded into `:at`. Exposure and picture own; a mouth lead's `:offset` is folded into `:at`. Cel and picture
sampling are floors, not part of the map, and are left out: this is the map a sampling are floors, not part of the map, and are left out: this is the map a
move preserves and a timeline row draws with, and `local-frame` is what reads move preserves and a timeline row draws with, and `local-frame` is what reads
a frame, floors and the lead in their load-bearing order." a frame, floors and the lead in their load-bearing order."
[n] [n]
(let [{:keys [mode at rate offset] :or {at 0 rate 1 offset 0}} (:time n)] (let [{:keys [mode at rate offset] :or {mode :map at 0 rate 1 offset 0}} (:time n)]
(if (= mode :map) (if (= mode :map)
{:at (- at (/ offset rate)) :rate rate} {:at (- at (/ offset rate)) :rate rate}
{:at 0 :rate 1}))) {:at 0 :rate 1})))
@ -185,21 +203,75 @@
(let [{:keys [at rate]} (time-of n)] (let [{:keys [at rate]} (time-of n)]
[(+ at (/ in rate)) (+ at (/ out rate))]))) [(+ at (/ in rate)) (+ at (/ out rate))])))
;; ---------------------------------------------------------------------------
;; what an instance places
;;
(defn source
"The symbol used by this cel. Sequence groups arrange cels;
a row is a view of that group, not one row per source."
[n]
(when (= :instance (:kind n)) (get-in n [:source :symbol])))
(defn sources
"Structural references, including cels outside the playhead."
[n]
(if-let [sid (source n)] #{sid} #{}))
(defn playback-of [n]
(merge {:in 0 :speed 1 :end :stop} (:playback n)))
(defn source-time
"Invertible cel -> source map, or nil for holds and endpoint policies.
Forward sampling remains available through `placed-frame` in every case."
[n]
(let [{:keys [in speed end]} (playback-of n)]
(when (and (pos? speed) (= :stop end) (not (get-in n [:time :loop?])))
{:at (- (/ in speed)) :rate speed})))
(defn placed-frame
"Sample source time without changing the cel's property clock:
`{:symbol :frame}`, the symbol shown and which of its frames. `length` is that
symbol's frame count. Nil means no source contribution — this cel
places nothing, or its playback has run past what there is to show."
[n f length]
(when-let [sid (source n)]
(when (and (number? length) (pos? length))
(let [{:keys [in speed end]} (playback-of n)
raw (+ in (* speed f))
frame (case (if (get-in n [:time :loop?]) :loop end)
:loop (mod raw length)
:hold (max 0 (min (dec length) raw))
:stop raw)]
(when (and (<= 0 frame) (< frame length))
{: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 local-frame (defn local-frame
"Apply a node's time map to the frame it was handed by its parent. "Apply a node's time map to the frame it was handed by its parent.
ORDER IS LOAD-BEARING: expose first, then offset. Flooring onto a grid and ORDER IS LOAD-BEARING: expose first, then offset. Flooring onto a grid and
shifting against the clock do not commute — shift first and the floor discards shifting against the clock do not commute — shift first and the floor discards
it on most frames, so the lead slider reads as doing nothing at exposures above it on most frames, so the lead slider reads as doing nothing at cels above
1, which is indistinguishable from the slider being unwired. 1, which is indistinguishable from the slider being unwired.
Composed along the parent chain, outermost first, by symbol/eval-frame. Two Composed along the parent chain, outermost first, by symbol/eval-frame. Two
rules fall out and they are different rules: exposure INHERITS STRICTLY, rules fall out and they are different rules: cel INHERITS STRICTLY,
because a head cutting on odd frames against a mouth cutting on even ones reads because a head cutting on odd frames against a mouth cutting on even ones reads
as two performances; offset is PER-NODE by design, because mouth lead applies as two performances; offset is PER-NODE by design, because mouth lead applies
to performance nodes and not to the plate, which is the entire point of it." to performance nodes and not to the plate, which is the entire point of it."
[n f] [n f]
(let [{:keys [mode source-fps sample-fps] ex :expose :or {mode :inherit}} (:time n)] (let [{:keys [mode source-fps sample-fps] ex :expose :or {mode :map}} (:time n)]
(if (= mode :inherit) (if (= mode :inherit)
f f
(do (do
@ -352,15 +424,27 @@
(not (contains? implemented-kinds k))) (not (contains? implemented-kinds k)))
(conj (str ":kind " k " is in the vocabulary but not implemented")) (conj (str ":kind " k " is in the vocabulary but not implemented"))
(and (= k :instance) (nil? (:of n))) (conj "an instance needs :of") (and (= k :instance) (not (keyword? (source n))))
(conj "an instance needs :source {:symbol <symbol-id>}")
(and (= k :instance)
(let [{:keys [in speed end]} (playback-of n)]
(not (and (finite-number? in) (<= 0 in)
(finite-number? speed) (<= 0 speed)
(#{:stop :hold :loop} end)))))
(conj "playback needs a nonnegative finite :in and :speed, and :end :stop, :hold or :loop")
(and (:layout n) (not (lane? n)))
(conj ":layout :sequence belongs to a group")
(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]))
(not (pos? (get-in n [:time :rate])))) (not (and (finite-number? (get-in n [:time :rate]))
(pos? (get-in n [:time :rate])))))
(conj ":time :rate must be positive") (conj ":time :rate must be positive")
(nil? (:z n)) (conj "no :z — draw order is authored per scene, not implied by the tree") (nil? (:z n)) (conj "no :z — draw order is authored per scene, not implied by the tree")
(and (:span n) (not= 2 (count (:span n)))) (and (:span n) (not (and (vector? (:span n)) (= 2 (count (:span n)))
(conj ":span must be [in out]") (every? finite-number? (:span n))
(apply < (:span n)))))
(conj ":span must be a finite, increasing [in out]")
(some? (get-in n [:time :in])) (some? (get-in n [:time :in]))
(conj ":time has an :in — an instance's first frame is the start of its own :span")) (conj ":time has an :in — an instance's first frame is the start of its own :span"))

6
frontend/src/arthur/domain/paint.cljs
View file

@ -25,7 +25,7 @@
{:id id :name (str "shape " (inc (count (shapes clip sid)))) {:id id :name (str "shape " (inc (count (shapes clip sid))))
:kind :poly :paint? true :parent nil :z z :kind :poly :paint? true :parent nil :z z
:span [frame end] :span [frame end]
:channels {geometry (channel/keyed {frame points}) :channels {geometry (channel/keyed {frame points} :hold)
[:style :color] (channel/framed color) [:style :color] (channel/framed color)
;; Turned and scaled about its middle, as a placed ;; Turned and scaled about its middle, as a placed
;; symbol is: set once here and never followed. ;; symbol is: set once here and never followed.
@ -41,7 +41,9 @@
[start end] (:span node)] [start end] (:span node)]
(if (and (:paint? node) (<= start frame) (< frame end) ch) (if (and (:paint? node) (<= start frame) (< frame end) ch)
(assoc-in clip (into path [:channels geometry :keys frame]) (assoc-in clip (into path [:channels geometry :keys frame])
(vec (channel/value-at ch frame))) ;; A drawing is authored and keyed, never dense, so there is
;; no tier-2 store to read it out of.
(vec (channel/value-at ch frame nil)))
clip))) clip)))
(defn set-vertex [clip sid id key-frame vertex [x y]] (defn set-vertex [clip sid id key-frame vertex [x y]]

82
frontend/src/arthur/domain/pick.cljs
View file

@ -75,20 +75,45 @@
(subvec hit 0 (inc (count selected))) (subvec hit 0 (inc (count selected)))
selected)) selected))
(defn local-bounds (defn- union
"`[x0 y0 x1 y1]` around what node `n` draws on its own frame `f`, in its own "The smaller box around both, either of which may be nil."
coordinates, or nil when it draws nothing there. Inside an instance is its [a b]
symbol, resolved at that frame." (cond (nil? a) b
[document store n f] (nil? b) a
:else (let [[ax0 ay0 ax1 ay1] a [bx0 by0 bx1 by1] b]
[(min ax0 bx0) (min ay0 by0) (max ax1 bx1) (max ay1 by1)])))
(defn bounds-of
"A closure from a frame to `[x0 y0 x1 y1]` around what node `n` draws on it, in
its own coordinates — nil on a frame it draws nothing on.
A CLOSURE, as `clip/resolver` is, and for the same reason it is: inside an
instance is its whole symbol resolved at that frame, and a resolver costs the
symbol to BUILD and a lookup to RUN. Asking frame by frame through a fresh one
is a resolver per frame, which is what made `pivot` want a separate path for
instances rather than the one walk it is."
[document store n]
(let [grow (fn [[x0 y0 x1 y1 :as b] x y] (let [grow (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y])) (if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
at #(ch/value-at (get (node/channels n) %) f store)] at (fn [f p] (ch/value-at (get (node/channels n) p) f store))]
(case (:kind n) (case (:kind n)
:instance :instance
(let [sid (:of n) ;; ONE RESOLVER PER DRAWING THE LANE CAN SHOW, built once for the reason
frames (clip/frames document sid) ;; the single one used to be: a resolver costs the symbol to build and a
f (if (get-in n [:time :loop?]) (mod f frames) f)] ;; lookup to run, and a lane asked frame by frame through a fresh one is a
(when (< -1 f frames) ;; resolver per frame.
(let [loop? (get-in n [:time :loop?])
resolvers (into {} (map (fn [child]
[child (clip/resolver document child store
pal/index-of nil)]))
(node/sources n))]
(fn [f0]
(let [shown (node/placed-frame n f0 (clip/frames document (node/source n)))
frames (when shown (clip/frames document (:symbol shown)))
f (when (number? frames)
(if loop? (mod (:frame shown) frames) (:frame shown)))
resolve (when shown (get resolvers (:symbol shown)))]
(when (and resolve (< -1 f frames))
(reduce (fn [b {:keys [kind pts n cx cy r size]}] (reduce (fn [b {:keys [kind pts n cx cy r size]}]
(case kind (case kind
:poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2)))) :poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2))))
@ -98,12 +123,35 @@
(-> b (grow (- cx h) (- cy h)) (grow (+ cx h) (+ cy h)))) (-> b (grow (- cx h) (- cy h)) (grow (+ cx h) (+ cy h))))
b)) b))
nil nil
((clip/resolver document store pal/index-of sid) f)))) (resolve f))))))
:poly (let [pts (at [:geom :pts])] :poly (fn [f]
(let [pts (at f [:geom :pts])]
(when-not (ch/nothing? pts) (when-not (ch/nothing? pts)
(reduce (fn [b i] (grow b (ch/component pts (* 2 i)) (ch/component pts (inc (* 2 i))))) (reduce (fn [b i] (grow b (ch/component pts (* 2 i)) (ch/component pts (inc (* 2 i)))))
nil (range (quot (if (vector? pts) (count pts) (.-length pts)) 2))))) nil (range (quot (if (vector? pts) (count pts) (.-length pts)) 2))))))
:disc (let [r (at [:geom :radius])] (when-not (ch/nothing? r) [(- r) (- r) r r])) :disc (fn [f]
:rect (let [s (at [:geom :size])] (let [r (at f [:geom :radius])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h]))) (when-not (ch/nothing? r) [(- r) (- r) r r])))
nil))) :rect (fn [f]
(let [s (at f [:geom :size])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h]))))
(constantly nil))))
(defn pivot
"The middle of everything node `n` draws over its own frames `fs`, in its own
coordinates — where it should turn and scale about. Nil for a node that draws
nothing on any of them.
`clip/center`'s rule, for a NODE rather than a symbol, and the same rule
`clip/place-symbol` and `paint/new-shape` already set theirs by. A node left
without one pivots about its own coordinate ORIGIN, and an origin is not a
middle: traced geometry is in the footage's normalised space, whose origin is
the top-left corner of the IMAGE, so the pivot lands hundreds of stage pixels
off the stage and a corner drag slides the shape about instead of resizing it.
ALL its frames, not the first, for the reason `clip/center` says: a mouth that
opens and travels still has its middle where the mouth is."
[document store n fs]
(let [bounds (bounds-of document store n)]
(when-let [[x0 y0 x1 y1] (reduce #(union %1 (bounds %2)) nil fs)]
[(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)])))

18
frontend/src/arthur/domain/pose.cljs
View file

@ -2,10 +2,11 @@
"An instance's explicit, held choices of source pose for each shape group. "An instance's explicit, held choices of source pose for each shape group.
A track is {local-frame -> source-frame}. The key is when the cut happens; A track is {local-frame -> source-frame}. The key is when the cut happens;
the value is the frozen pose to read. Skipped source frames remain available.") the value is the frozen pose to read. Skipped source frames remain available."
(:require [arthur.domain.node :as node]))
(defn prepare (defn prepare
"Sort exposure tracks once when building a resolver." "Sort pose tracks once when building a resolver."
[tracks] [tracks]
(into {} (into {}
(map (fn [[group entries]] (map (fn [[group entries]]
@ -35,14 +36,17 @@
"Set one held pose on an instance inside symbol `sid`. Earlier motion stays "Set one held pose on an instance inside symbol `sid`. Earlier motion stays
untouched." untouched."
[clip sid instance group at source] [clip sid instance group at source]
(let [node (get-in clip [:symbols sid :nodes instance]) (let [inst (get-in clip [:symbols sid :nodes instance])
placed (get-in clip [:symbols (:of node)]) ;; A cut is checked against the ONE symbol this cel places. Which
length (:frames placed) ;; drawing a lane shows is a question about the lane's other cels,
;; and each of them owns its own tracks — so there is nothing to union.
placed (get-in clip [:symbols (node/source inst)])
length (or (:frames placed) 0)
active (filter (fn [n] (some :pose-sampled? (vals (:channels n)))) active (filter (fn [n] (some :pose-sampled? (vals (:channels n))))
(vals (:nodes placed))) (vals (:nodes placed)))
groups (set (map #(or (:pose-group %) (:id %)) active)) groups (set (map #(or (:pose-group %) (:id %)) active))
ids (set (map :id active))] ids (set (map :id active))]
(when-not (and (= :instance (:kind node)) (when-not (and (= :instance (:kind inst))
(or (contains? groups group) (or (contains? groups group)
(and (vector? group) (= 2 (count group)) (and (vector? group) (= 2 (count group))
(= :node (first group)) (= :node (first group))
@ -66,7 +70,7 @@
clip))) clip)))
(defn problems (defn problems
"Errors in one symbol instance's exposure tracks." "Errors in one symbol instance's pose tracks."
[tracks source-frames groups] [tracks source-frames groups]
(cond (cond
(nil? tracks) [] (nil? tracks) []

7
frontend/src/arthur/domain/project.cljs
View file

@ -30,10 +30,9 @@
[arthur.domain.wire :as wire])) [arthur.domain.wire :as wire]))
(def schema-version (def schema-version
"The stored document format this client reads and writes. 2 is symbols: leaf "3 stores cel source references and explicit playback clocks. Older
paths say `symbol`, a placing node is `:kind :instance`, and no symbol id is source-channel documents are unsupported; there is no compatibility conversion."
reserved. `clips/migrations/0007` moved every saved project from 1." 3)
2)
(defn block-keys (defn block-keys
"Every tier-2 key a leaf map names, in a stable order." "Every tier-2 key a leaf map names, in a stable order."

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

@ -26,11 +26,13 @@
Two ways to evaluate one at a frame: Two ways to evaluate one at a frame:
(eval-frame sym f store) THE SPECIFICATION. Allocating, order-free, (eval-frame sym f store palette opts)
THE SPECIFICATION. Allocating, order-free,
obviously correct. Use it in tests and for a obviously correct. Use it in tests and for a
one-off render. one-off render.
(resolver sym store) -> (fn [f] ops). What playback uses. Caches the (resolver sym store palette opts)
-> (fn [f] ops). What playback uses. Caches the
topological order and the z paths, holds one topological order and the z paths, holds one
CURSOR per channel and one PREALLOCATED point CURSOR per channel and one PREALLOCATED point
buffer per node, so a frame allocates the op buffer per node, so a frame allocates the op
@ -88,6 +90,47 @@
[nodes id] [nodes id]
(dec (count (lineage nodes id)))) (dec (count (lineage nodes id))))
(defn lane-cels
"The cels of lane `lane`, in the order they are exposed.
Sorted by where they START, not by `:z`: a lane's blocks 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."
[nodes lane]
(->> (vals nodes)
(filter #(= lane (:parent %)))
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %))))
vec))
(defn lane-problems
"What makes a lane not a lane. A SEQUENCE is the one composition rule the node
map carries — ordinary groups compose freely — so it is checked here, beside
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
is refused rather than resolved by draw order: two drawings exposed on one
frame of one lane is a document nobody meant to write, and picking a winner
would hide it. Empty lanes are valid — a lane is made before it is filled."
[nodes]
(vec
(mapcat
(fn [[id lane]]
(when (node/lane? lane)
(let [children (filter #(= id (:parent %)) (vals nodes))
valid? (fn [n]
(and (= :instance (:kind n))
(empty? (node/problems n))
(:span n)
(every? node/finite-number? (node/placed-span n))))
intervals (sort-by first (map node/placed-span (filter valid? children)))]
(concat
(for [n children :when (not (valid? n))]
(str "sequence " id " needs finite visual cels: " (:id n)))
(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.
@ -353,7 +396,7 @@
{:keys (vec (sort-by str (keys sym)))}))) {:keys (vec (sort-by str (keys sym)))})))
(into {} (remove #(= :audio (:kind (val %)))) nodes))) (into {} (remove #(= :audio (:kind (val %)))) nodes)))
(defn- channel-frame (defn- base-channel-frame
"A trace selects the measured frames its node reads; marked channels read "A trace selects the measured frames its node reads; marked channels read
instance pose choices." instance pose choices."
[choices traces nodes source-fps picture-fps id c lf] [choices traces nodes source-fps picture-fps id c lf]
@ -422,25 +465,21 @@
the only place the space changes. the only place the space changes.
This is the definition of what a frame means. `resolver` is what plays it." This is the definition of what a frame means. `resolver` is what plays it."
([sym f] (eval-frame sym f nil pal/index-of)) [sym f store palette {:keys [pose-tracks source-fps picture-fps]}]
([sym f store] (eval-frame sym f store pal/index-of))
([sym f store palette] (eval-frame sym f store palette nil nil))
([sym f store palette pose-tracks opts]
(let [nodes (nodes-of sym) (let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
traces (prepared-traces nodes) traces (prepared-traces nodes)
{:keys [source-fps picture-fps]} opts
ord (order nodes)] ord (order nodes)]
(eval-into {:read (fn [id path c lf] (eval-into {:read (fn [id path c lf]
(ch/value-at c (channel-frame choices traces nodes (ch/value-at c (base-channel-frame choices traces nodes
source-fps picture-fps id c lf) source-fps picture-fps id c lf)
store)) lf store))
:palette palette :palette palette
:mat-for (fn [_id] (node/mat)) :mat-for (fn [_id] (node/mat))
:pinv-for (fn [id] (node/pinv (get nodes id))) :pinv-for (fn [id] (node/pinv (get nodes id)))
:buf-for (fn [_id n] (js/Float64Array. (* 2 n))) :buf-for (fn [_id n] (js/Float64Array. (* 2 n)))
:scratch (node/mat)} :scratch (node/mat)}
nodes ord (draw-rank nodes ord) f)))) nodes ord (draw-rank nodes ord) f)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the playback path ;; the playback path
@ -484,12 +523,15 @@
The op maps themselves are allocated fresh, and deliberately: there are a dozen The op maps themselves are allocated fresh, and deliberately: there are a dozen
of them per frame against hundreds of points, so pooling them would buy of them per frame against hundreds of points, so pooling them would buy
nothing and cost the ability to hand an op list around as plain data." nothing and cost the ability to hand an op list around as plain data.
([sym] (resolver sym nil pal/index-of nil nil))
([sym store] (resolver sym store pal/index-of nil nil)) `store` and `palette` are POSITIONAL because neither is optional: a dense
([sym store palette] (resolver sym store palette nil nil)) channel cannot be read without the store it names, and every op carries a
([sym store palette pose-tracks] (resolver sym store palette pose-tracks nil)) colour index. `opts` is a map because the rest genuinely are optional, and
([sym store palette pose-tracks {:keys [source-fps picture-fps]}] because a fifth of them later is then a key rather than a nil at every one of
these call sites — which is what the arity ladder that used to be here was
standing in for."
[sym store palette {:keys [pose-tracks source-fps picture-fps]}]
(let [nodes (nodes-of sym) (let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
traces (prepared-traces nodes) traces (prepared-traces nodes)
@ -515,9 +557,11 @@
;; placed but emit no op, and which are exactly what an underlay rides. ;; placed but emit no op, and which are exactly what an underlay rides.
placed (volatile! {}) placed (volatile! {})
ctx {:read (fn [id path c lf] ctx {:read (fn [id path c lf]
(ch/sample! (get-in cursors [id path]) (when-let [cursor (get-in cursors [id path])]
(channel-frame choices traces nodes (ch/sample! cursor
source-fps picture-fps id c lf))) (base-channel-frame choices traces nodes
source-fps picture-fps id c lf)
lf)))
:palette palette :palette palette
:mat-for (fn [id] (get mats id)) :mat-for (fn [id] (get mats id))
:on-place (fn [id p] (vswap! placed assoc id p)) :on-place (fn [id p] (vswap! placed assoc id p))
@ -532,7 +576,7 @@
(-invoke [_ f] (step f)) (-invoke [_ f] (step f))
IResolver IResolver
(world-of [_ id] (:m (get @placed id))) (world-of [_ id] (:m (get @placed id)))
(frame-of [_ id] (:f (get @placed id))))))) (frame-of [_ id] (:f (get @placed id))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -570,6 +614,7 @@
(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)))))

86
frontend/src/arthur/domain/trace.cljs
View file

@ -9,13 +9,12 @@
:trace {:frames [0 12 30] :origin :keys} :trace {:frames [0 12 30] :origin :keys}
Whether the photo is showing, and how strongly, is a viewing aid for one Whether the photo is showing, and how strongly, is not the document's at all.
placement. It is on an INSTANCE, not keyed, and draws nothing into the picture. It is a viewing aid, like soloing a row, so it lives in the editor's own state
It covers every face at or below that instance, and the nearest instance that — `[:ui :trace]`, a set of face symbols switched on and one opacity — and is
says anything decides, so a take shows its faces' footage and one face inside never keyed, saved or exported. A face is the same face wherever it is placed,
it can still be switched off: so one switch shows it in the take it is placed in AND in its own tab, which is
where it is drawn over; nothing has to be switched on twice or per placement.
:underlay {:on? true :opacity 0.5}
THE TRACE IS THE ONE FACT about which measured frame a head reads. `:continuous` THE TRACE IS THE ONE FACT about which measured frame a head reads. `:continuous`
reads the frame it is on, `:keys` jumps to each trace frame's measured head and reads the frame it is on, `:keys` jumps to each trace frame's measured head and
@ -29,6 +28,10 @@
(def origins [:continuous :keys :start]) (def origins [:continuous :keys :start])
(def ^:const opacity-default
"How strongly a switched-on photo draws until someone moves the slider."
0.5)
(defn of (defn of
"The head's trace, a head that has none being one that moves freely." "The head's trace, a head that has none being one that moves freely."
[head] [head]
@ -111,37 +114,50 @@
(letfn [(walk [sid path] (letfn [(walk [sid path]
(mapcat (fn [[id n]] (mapcat (fn [[id n]]
(when (= :instance (:kind n)) (when (= :instance (:kind n))
;; Every drawing the lane can show, not only the one it
;; happens to be on: a face traced in one cel is the same
;; face when the lane cuts to another.
(let [p (conj path id)] (let [p (conj path id)]
(cond->> (walk (:of n) p) (mapcat (fn [child]
(traceable? clip (:of n)) (cons {:path p :in sid :face (:of n)}))))) (cond->> (walk child p)
(traceable? clip child)
(cons {:path p :in sid :face child})))
(sort-by str (node/sources n))))))
(sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))] (sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))]
(vec (walk sid [])))) (vec (walk sid []))))
(defn underlay-at (defn traceable-faces
"The underlay in force at the instance at row path `path` from symbol `sid`: "Every face that can be traced while symbol `sid` is open, each once: `sid`
the nearest one set on it or above it, `:own?` saying which. Nil when none is." itself when it is a face — open in its own tab, to be drawn over — and the
[clip sid path] faces placed inside it at any depth."
(:u (reduce (fn [{:keys [sid u]} id] [clip sid]
(let [n (get-in clip [:symbols sid :nodes id])] (into [] (distinct)
{:sid (:of n) (cond->> (map :face (faces clip sid))
:u (if-let [own (:underlay n)] (traceable? clip sid) (cons sid))))
(assoc own :own? true)
(some-> u (assoc :own? false)))})) (defn showing-for
{:sid sid} path))) "The faces showing their footage once `sid` is the open symbol, given the ones
`on` already showing.
OPENING A FACE IS ASKING TO DRAW OVER IT: a symbol has measured footage behind
it only because it was traced from that footage, so its own tab starts with the
footage showing rather than with a switch to be found first. A take or a scene
is the picture itself, and a reference drawn over one would read as part of it,
so nothing is switched on for those. Either way it is switched by hand
afterwards, from the bar above the stage or from a face's own timeline row."
[clip sid on]
(cond-> (set on) (traceable? clip sid) (conj sid)))
(defn shown (defn shown
"Every face whose footage shows from symbol `sid` down, as `{:path :face "The faces whose footage is showing while symbol `sid` is open, as `faces` lists
:opacity}`: the row path of the face's instance, the face's symbol, and how them — the row path of the face's instance from `sid`, and the face — filtered
strongly to draw it." to the `showing` set.
[clip sid]
(letfn [(walk [sid path opacity] The open symbol itself is in the list, at the EMPTY path, when it is a face:
(mapcat (fn [[id n]] that is a face open in its own tab to be drawn over, and the one place tracing
(when (= :instance (:kind n)) matters most. There is no inheritance to work out and no opacity to carry
(let [path (conj path id) because the switch is the face's, not a placement's."
u (:underlay n) [clip sid showing]
opacity (if u (when (:on? u) (:opacity u 0.5)) opacity)] (into [] (filter (comp (set showing) :face))
(cond->> (walk (:of n) path opacity) (cond->> (faces clip sid)
(and opacity (traceable? clip (:of n))) (traceable? clip sid) (cons {:path [] :in sid :face sid}))))
(cons {:path path :face (:of n) :opacity opacity})))))
(get-in clip [:symbols sid :nodes])))]
(vec (walk sid [] nil))))

8
frontend/src/arthur/events/edit.cljs
View file

@ -73,3 +73,11 @@
"Apply `f` to the loaded clip and return the new db." "Apply `f` to the loaded clip and return the new db."
[db f] [db f]
(edit-entry db #(update % :clip f))) (edit-entry db #(update % :clip f)))
(defn transaction
"One command is one undo step, independent of neighboring edits or timing."
[db f]
(-> db
(history history/hold)
(edit f)
(history history/settle)))

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

@ -13,6 +13,7 @@
(:require [arthur.audio.mix :as mix] (:require [arthur.audio.mix :as mix]
[arthur.clock :as clock] [arthur.clock :as clock]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.trace :as trace]
[arthur.footage.store :as footage] [arthur.footage.store :as footage]
[re-frame.core :as rf])) [re-frame.core :as rf]))
@ -36,7 +37,13 @@
(-> db (-> db
(assoc :clip/current id (assoc :clip/current id
:clip (select-keys entry [:fps :width :height :audio :display-fps])) :clip (select-keys entry [:fps :width :height :audio :display-fps]))
(update :ui merge {:open sid :tabs (if sid [sid] [])}) (update :ui merge
{:open sid :tabs (if sid [sid] [])
;; From scratch, not merged: the faces switched on were another
;; document's, and a face id means nothing in this one.
:trace {:faces (trace/showing-for (:clip entry) sid #{})
:opacity (or (get-in db [:ui :trace :opacity])
trace/opacity-default)}})
(assoc-in [:playback :frame] 0) (assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false)))) (assoc-in [:playback :playing?] false))))
@ -188,6 +195,7 @@
{: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)
(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))
::pause! nil ::pause! nil

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

@ -622,7 +622,8 @@
(rf/reg-event-db (rf/reg-event-db
::toggle-key ::toggle-key
(fn [db [_ sid id path frame]] (fn [db [_ sid id path frame]]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame)))) (let [st (:store (store/entry (:clip/current db)))]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame st)))))
;; A face's trace frames and origin, on its symbol — see `domain/trace`. ;; A face's trace frames and origin, on its symbol — see `domain/trace`.
(rf/reg-event-db (rf/reg-event-db
@ -630,12 +631,6 @@
(fn [db [_ sid value]] (fn [db [_ sid value]]
(edit/edit db #(assoc-in % [:symbols sid :nodes :head :trace] value)))) (edit/edit db #(assoc-in % [:symbols sid :nodes :head :trace] value))))
;; Whether one instance shows its face's footage under it. Not keyed: it is a
;; drawing aid, not part of the picture.
(rf/reg-event-db
::set-underlay
(fn [db [_ sid id underlay]]
(edit/edit db #(assoc-in % [:symbols sid :nodes id :underlay] underlay))))
(rf/reg-event-db (rf/reg-event-db
::set-segment-interp ::set-segment-interp

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

@ -8,8 +8,11 @@
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[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.lane :as lane]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
[arthur.events.paint :as paint] [arthur.events.paint :as paint]
[arthur.events.playback :as playback]
[arthur.footage.store :as store] [arthur.footage.store :as store]
[re-frame.core :as rf])) [re-frame.core :as rf]))
@ -24,7 +27,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)) (update :ui dissoc :points :lane-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))))))))
@ -32,6 +35,222 @@
::set-tone ::set-tone
(fn [db [_ tone]] (assoc-in db [:ui :tone] tone))) (fn [db [_ tone]] (assoc-in db [:ui :tone] tone)))
(rf/reg-event-db
::set-time-view
(fn [db [_ view]]
(if (#{:timeline :cel-sheet} view)
(assoc-in db [:ui :time-view] view)
db)))
(defn apply-lane-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."
[db sid result retry]
(if-let [why (:refused result)]
(-> db
(assoc-in [:project :status] why)
(assoc-in [:ui :lane-retry]
(when (:required-frames result) retry)))
(let [[_ selected-sid _ path] (get-in db [:ui :selection])
prefix (if (and (= sid selected-sid) (seq path)) (pop path) [])]
(-> db
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node sid (:selection result) (conj prefix (:selection result))])
(update :ui dissoc :lane-retry)))))
(rf/reg-event-db
::new-lane
(fn [db _]
(let [clip (:clip (store/entry (:clip/current db)))
sid (get-in db [:ui :open])]
(apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil))))
(defn- committed
"One appending command, as effects: commit it, and look at what it made.
Seeking is the whole reason these are `-fx` events. An appended cel lands
past the end of the lane, off the playhead, and a drawing you cannot see is not
one you can draw in. An inserted one is already under the playhead and the
seek is a no-op, which is the same rule and not a second one."
[db sid result retry]
(let [{clip :clip st :store} (store/entry (:clip/current db))
path (nth (get-in db [:ui :selection]) 3 nil)
{:keys [at rate]} (:time (nest/inside clip st (get-in db [:ui :open])
(if (seq path) (pop path) [])
(get-in db [:playback :frame])))]
(cond-> {:db (apply-lane-command db sid result retry)}
(and (:clip result) (: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
"The playhead as a frame of the symbol that owns `selection`.
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
lane command converts that owning-symbol frame into lane time."
[clip st open selection frame]
(let [[_ sid _ path] selection]
(if (or (= sid open) (not (seq path)))
frame
(:frame (nest/inside clip st open (pop path) frame)))))
(rf/reg-event-fx
::append-drawing
(fn [{:keys [db]} [_ extent]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])
result (lane/append-drawing clip sid (selected-lane clip sid id)
(random-uuid) (clip/fresh-id clip)
{:extent (or extent :keep)})]
(committed db sid result [::append-drawing :grow-symbol]))))
(rf/reg-event-fx
::reuse-drawing
(fn [{:keys [db]} [_ extent]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])
result (lane/reuse-drawing clip sid (selected-lane clip sid id) (random-uuid)
(node/source (get-in clip [:symbols sid :nodes id]))
{:extent (or extent :keep)})]
(committed db sid result [::reuse-drawing :grow-symbol]))))
(rf/reg-event-fx
::duplicate-drawing
(fn [{:keys [db]} [_ extent deep?]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])
result (lane/duplicate-drawing clip sid id (random-uuid)
{:extent (or extent :keep) :deep? deep?})]
(committed db sid result [::duplicate-drawing :grow-symbol deep?]))))
(rf/reg-event-fx
::insert-drawing
;; The playhead is the position: you scrub to where the drawing goes. A lane
;; that is stepped or retimed off whole frames has no single lane frame for a
;; symbol frame, and `lane-frame` says so rather than snapping to one.
(fn [{:keys [db]} [_ extent]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection])
[_ sid id] selection
lane (selected-lane clip sid id)
owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame]))
at (when (number? owner-frame) (lane/lane-frame clip sid lane owner-frame))
result (if at
(lane/append-drawing clip sid lane (random-uuid) (clip/fresh-id clip)
{:at at :extent (or extent :keep)})
{:refused "this lane's frames are not the open symbol's"})]
(committed db sid result [::insert-drawing :grow-symbol]))))
(rf/reg-event-db
::split-cel
(fn [db _]
(let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection])
[_ sid id] selection
owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame]))
cut (when (number? owner-frame)
(lane/lane-frame clip sid (:parent (get-in clip [:symbols sid :nodes id]))
owner-frame))]
(apply-lane-command
db sid (if cut
(lane/split clip sid id cut (random-uuid))
{:refused "this lane's frames are not the open symbol's"})
nil))))
(defn- at-playhead
"The selected cel, its lane, and the playhead as a frame of that lane's
own time — or a refusal in place of the frame where there is no single one."
[db]
(let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection])
[_ sid id] selection
n (get-in clip [:symbols sid :nodes id])]
{:clip clip :sid sid :id id :node n
:at (when-let [owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame]))]
(lane/lane-frame clip sid (:parent n) owner-frame))}))
(rf/reg-event-fx
::overwrite-drawing
(fn [{:keys [db]} [_ extent]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection])
[_ sid id] selection
lane-id (selected-lane clip sid id)
owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame]))
at (when (number? owner-frame) (lane/lane-frame clip sid lane-id owner-frame))
result (if (integer? at)
(lane/overwrite-drawing clip sid lane-id (random-uuid) (clip/fresh-id clip) at
{:extent (or extent :keep)
:remainder-id (random-uuid)})
{:refused "this lane's frames are not the open symbol's"})]
(committed db sid result [::overwrite-drawing :grow-symbol]))))
(rf/reg-event-db
::trim-cel
(fn [db [_ edge]]
(let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command
db sid (if at
(lane/trim clip sid id edge at)
{:refused "this lane's frames are not the open symbol's"})
nil))))
(rf/reg-event-db
::move-cel
(fn [db _]
(let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command
db sid (if at
(lane/move clip sid id at)
{:refused "this lane's frames are not the open symbol's"})
nil))))
(rf/reg-event-db
::blank-cel
;; The selected cel's own frames, so the range needs no second gesture and
;; the case that would split a cel cannot arise.
(fn [db _]
(let [{:keys [clip sid node]} (at-playhead db)
span (node/placed-span node)]
(apply-lane-command
db sid (if (and span (every? integer? span))
(lane/blank clip sid (:parent node) span {})
{:refused "select a cel that starts and ends on whole lane frames"})
nil))))
(rf/reg-event-db
::make-unique
(fn [db [_ deep?]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])]
(apply-lane-command db sid (lane/make-unique clip sid id {:deep? deep?}) nil))))
(rf/reg-event-db
::extend-hold
(fn [db [_ delta extent]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])
result (lane/extend-hold clip sid id delta {:extent (or extent :keep)})]
(apply-lane-command db sid result [::extend-hold delta :grow-symbol]))))
(rf/reg-event-fx
::lane-retry
(fn [{:keys [db]} _]
(if-let [event (get-in db [:ui :lane-retry])]
{:db (update db :ui dissoc :lane-retry) :dispatch event}
{})))
(rf/reg-event-db (rf/reg-event-db
::toggle-row ::toggle-row
(fn [db [_ path]] (fn [db [_ path]]
@ -49,6 +268,32 @@
(= on #{path}) #{} (= on #{path}) #{}
:else #{path}))))) :else #{path})))))
(rf/reg-event-db
::trace-face
;; Showing the footage under a face is a viewing aid, like solo: editor state
;; rather than the document, so it is not an undo step, does not travel to a
;; collaborator and cannot reach an export. Per FACE and not per placement — a
;; face is the same face wherever it is placed, and it is the face being traced
;; — so one switch shows it in the take and in its own tab both.
(fn [db [_ face]]
(update-in db [:ui :trace :faces]
#(if (contains? % face) (disj % face) (conj (set %) face)))))
(rf/reg-event-db
::trace-faces
;; Every face the open symbol has, from the bar above the stage: switched on
;; unless they all already are, which is the one gesture a person wants when
;; there is exactly one face and when there are five.
(fn [db [_ faces]]
(let [faces (set faces)
on (set (get-in db [:ui :trace :faces]))]
(assoc-in db [:ui :trace :faces]
(if (every? on faces) (reduce disj on faces) (into on faces))))))
(rf/reg-event-db
::trace-opacity
(fn [db [_ opacity]] (assoc-in db [:ui :trace :opacity] opacity)))
(defn- where-new-goes (defn- where-new-goes
"The row path, from the open symbol down, of the symbol a new thing goes into: "The row path, from the open symbol down, of the symbol a new thing goes into:
INSIDE the selected instance, or BESIDE any other selected node, or at the top INSIDE the selected instance, or BESIDE any other selected node, or at the top

15
frontend/src/arthur/export.cljs
View file

@ -84,14 +84,14 @@
Four things, and each for its own reason: Four things, and each for its own reason:
the node itself; the node itself;
everything ABOVE it, because a placement's transform is relative to its everything ABOVE it, because an instance's transform is relative to its
parent and dropping the chain would move the thing being isolated; parent and dropping the chain would move the thing being isolated;
everything BELOW it, because a group instance is its children; everything BELOW it, because a group instance is its children;
any audio track `:linked-to` it, because the link is the statement that this any audio track `:linked-to` it, because the link is the statement that this
sound belongs to that placement, and a face exported without its voice is sound belongs to that instance, and a face exported without its voice is
not the thing that was asked for. not the thing that was asked for.
Siblings go. That is the whole point: what comes out is one placement, where it Siblings go. That is the whole point: what comes out is one instance, where it
sits, in the symbol it sits in." sits, in the symbol it sits in."
[nodes id] [nodes id]
(let [up (loop [i id acc #{}] (let [up (loop [i id acc #{}]
@ -117,9 +117,9 @@
"The symbol with only `id` and its kin kept. `nil` leaves it alone. "The symbol with only `id` and its kin kept. `nil` leaves it alone.
The FRAME SPACE IS UNTOUCHED, which is what makes this different from exporting The FRAME SPACE IS UNTOUCHED, which is what makes this different from exporting
the symbol a placement plays. Rooting at `:sym/face-8625` renders the drawing in the symbol an instance plays. Rooting at `:sym/face-8625` renders the drawing in
its own time, identically for all seven placements. Isolating one placement its own time, identically for all seven instances. Isolating one instance
renders the STAGE — its length, its rate, the placement's span, drift and scale renders the STAGE — its length, its rate, the instance's span, drift and scale
— with the other six removed. The first is the drawing; the second is that face — with the other six removed. The first is the drawing; the second is that face
on the stage, and they are different deliverables." on the stage, and they are different deliverables."
[sym id] [sym id]
@ -195,8 +195,7 @@
;; inside it still resolve — clip/resolver is the function that knows ;; inside it still resolve — clip/resolver is the function that knows
;; how. ;; how.
doc (assoc-in clip [:symbols sid] sym) doc (assoc-in clip [:symbols sid] sym)
resolve-frame (clip/resolver doc store palette sid resolve-frame (clip/resolver doc sid store palette {:picture-fps picture-fps})
{:picture-fps picture-fps})
ras (raster/make width height) ras (raster/make width height)
bg (get palette :bg 0)] bg (get palette :bg 0)]
(-> (audio! doc sid store audio-url) (-> (audio! doc sid store audio-url)

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

@ -35,6 +35,8 @@
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.feature :as feature] [arthur.domain.feature :as feature]
[arthur.domain.geom :as geom] [arthur.domain.geom :as geom]
[arthur.domain.node :as node]
[arthur.domain.pick :as pick]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
[arthur.flow.address :as address])) [arthur.flow.address :as address]))
@ -310,7 +312,7 @@
(when (or (zero? f) (when (or (zero? f)
(not= (nth shown f) (nth shown (dec f)))) (not= (nth shown f) (nth shown (dec f))))
[f (nth shown f)]))) [f (nth shown f)])))
(range (count shown)))) (range (count shown))) :hold)
:generated generated))) :generated generated)))
(defn- keyed-visibility [values generated] (defn- keyed-visibility [values generated]
@ -318,7 +320,7 @@
(when (or (zero? f) (when (or (zero? f)
(not= (nth values f) (nth values (dec f)))) (not= (nth values f) (nth values (dec f))))
[f (nth values f)]))) [f (nth values f)])))
(range (count values)))) (range (count values))) :hold)
:generated generated)) :generated generated))
(def ^:private pose-groups (def ^:private pose-groups
@ -671,6 +673,46 @@
{}) {})
:store (into (:store head) (mapcat :store) parts)})) :store (into (:store head) (mapcat :store) parts)}))
(defn pivoted
"Every node a freeze makes that a hand can transform, pivoting about the
middle of what it draws.
THE SAME RULE AS EVERYWHERE ELSE, and this is the one place that used to skip
it: `clip/place-symbol` writes an instance's anchor, `paint/new-shape` a
drawing's, `nest/group` a new symbol's, and `face-placement` the source
placement's — and the traced parts underneath it got none, so each of them
turned and scaled about ITS OWN ORIGIN, which for head-local geometry is the
top-left corner of the footage. `freeze_test` already said why that is wrong
for the face; it is no less wrong for the mouth.
WHAT IT SKIPS IS `node/measured?`, the predicate `gesture/refusal` refuses a
hand edit by — so a node gets a pivot exactly when a hand can use one, which
is the invariant worth having rather than a list of exceptions. It is also
what keeps this off `:head`: the head carries the measured similarity, its
scale is nowhere near 1, and an anchor under a scale does NOT cancel out of
`node/local!` the way it does at the identity, so writing one there would move
the whole face. Skipping it because it draws nothing would be true today and
true by accident.
A DEFAULT, written once, never followed: an anchor already on a node is left
alone, and nothing updates one when the geometry moves later. On everything it
does write to, rotation and scale are the identity, where the anchor cancels
out — so this changes where a part pivots and not one pixel of what it draws."
[clip store]
(reduce
(fn [c [sid id]]
(let [n (get-in c [:symbols sid :nodes id])
at [:symbols sid :nodes id :channels [:xform :anchor]]]
(if (or (get-in c at) (node/measured? n))
c
(if-let [p (pick/pivot c store n (range (get-in c [:symbols sid :frames])))]
(assoc-in c at (ch/framed p))
c))))
clip
(for [sid (sort-by str (keys (:symbols clip)))
id (sort-by str (keys (get-in clip [:symbols sid :nodes])))]
[sid id])))
(defn clip (defn clip
"Subject-id -> conditioned measurements becomes one symbol per face, and a "Subject-id -> conditioned measurements becomes one symbol per face, and a
symbol called :main that places them. symbol called :main that places them.
@ -709,8 +751,9 @@
:channels (face-placement params subjects)}} :channels (face-placement params subjects)}}
(map-indexed (map-indexed
(fn [i [id _]] (fn [i [id _]]
[id {:id id :kind :instance :of id :parent :face [id {:id id :kind :instance :parent :face
:z (str "a" i)}])) :z (str "a" i)
:source {:symbol id}}]))
ordered)}} ordered)}}
(map (fn [[id part]] [id (:symbol part)])) parts)}] (map (fn [[id part]] [id (:symbol part)])) parts)}]
(doseq [[subject inputs] ordered (doseq [[subject inputs] ordered
@ -719,8 +762,10 @@
(= subject (get-in built [:features (feature/owned subject id) :subject]))) (= subject (get-in built [:features (feature/owned subject id) :subject])))
(throw (ex-info "presence must name this subject's feature and span the take" (throw (ex-info "presence must name this subject's feature and span the take"
{:subject subject :feature id :frames nf :actual (count track)})))) {:subject subject :feature id :frames nf :actual (count track)}))))
{:store (merged :store) (let [store (merged :store)]
:clip (reduce (fn [c [subject inputs]] {:store store
:clip (-> (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :trace (get inputs :trace (:trace params))} (head-mode {:subject subject :trace (get inputs :trace (:trace params))}
{:clip c})) {:clip c}))
built ordered)})) built ordered)
(pivoted store))})))

42
frontend/src/arthur/flow/regenerate.cljs
View file

@ -1,7 +1,8 @@
(ns arthur.flow.regenerate (ns arthur.flow.regenerate
"Recompute a changed feature from retained source tracks, then replace only "Recompute a changed feature from retained source tracks, then replace only
channels owned by that feature. Upload remains project/save's ordinary job." channels owned by that feature. Upload remains project/save's ordinary job."
(:require [arthur.domain.feature :as feature] (:require [arthur.domain.channel :as ch]
[arthur.domain.feature :as feature]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.flow.address :as address] [arthur.flow.address :as address]
[arthur.flow.freeze :as freeze] [arthur.flow.freeze :as freeze]
@ -33,6 +34,35 @@
(select-keys (settings clip fid) (select-keys (settings clip fid)
(address/area-knobs (get-in clip [:features fid :area])))) (address/area-knobs (get-in clip [:features fid :area]))))
(defn- rebased
"`fresh` in place of `old`, carrying `old`'s corrections across.
THIS IS WHAT A LAYER IS FOR. The base is regenerated and the hand work is not,
which is the whole reason a correction is stored over a channel rather than
written into it. A correction the new base no longer fits is MARKED rather than
dropped or misapplied — `channel/conflicts` is how a view finds it — and one
that fits again has its mark cleared, because a regeneration that restores the
topology has resolved it."
[old fresh]
(if-let [over (seq (:over old))]
(assoc fresh :over
(mapv (fn [l]
(if-let [why (ch/conflict-with fresh l)]
(assoc l :conflict why)
(dissoc l :conflict)))
over))
fresh))
(defn- bases
"A node's channels without their corrections.
For asking whether the authored channels still ARE the measurement: a
correction is not a hand PLACEMENT. The base under it has to go on following
re-measurement, or the first correction anyone makes would freeze the part it
was meant to adjust."
[channels]
(into {} (map (fn [[p c]] [p (dissoc c :over)])) channels))
(defn- replace-feature [entry fragment fid] (defn- replace-feature [entry fragment fid]
(let [paths (for [id (get-in entry [:clip :features fid :nodes]) (let [paths (for [id (get-in entry [:clip :features fid :nodes])
[prop channel] (get-in fragment [:nodes id :channels]) [prop channel] (get-in fragment [:nodes id :channels])
@ -42,9 +72,7 @@
(let [at [:clip :symbols (get-in entry [:clip :features fid :symbol]) (let [at [:clip :symbols (get-in entry [:clip :features fid :symbol])
:nodes id :channels prop] :nodes id :channels prop]
old (get-in entry at)] old (get-in entry at)]
(assoc-in entry at (assoc-in entry at (rebased old channel))))
(cond-> channel
(contains? old :over) (assoc :over (:over old))))))
entry paths) entry paths)
(update :store merge (:store fragment))))) (update :store merge (:store fragment)))))
@ -109,8 +137,10 @@
(cond-> (-> entry (cond-> (-> entry
(assoc-in (conj at :measured) measured) (assoc-in (conj at :measured) measured)
(update :store merge (:store baked))) (update :store merge (:store baked)))
(= (:channels old) (:measured old)) (= (bases (:channels old)) (bases (:measured old)))
(assoc-in (conj at :channels) measured)))) (assoc-in (conj at :channels)
(into {} (map (fn [[p c]] [p (rebased (get-in old [:channels p]) c)]))
measured)))))
(defn change (defn change
"One scoped static edit. `source-inputs` holds dense landmarks and, when the "One scoped static edit. `source-inputs` holds dense landmarks and, when the

5
frontend/src/arthur/footage/store.cljs
View file

@ -18,14 +18,13 @@
with nothing to evict it, and the timeline that would want several is out of with nothing to evict it, and the timeline that would want several is out of
scope. `kind` only names the id — `:footage/3`, `:project/4` — so that a clip's scope. `kind` only names the id — `:footage/3`, `:project/4` — so that a clip's
origin is legible in the db without a lookup." origin is legible in the db without a lookup."
([entry] (install! entry "footage")) [entry kind]
([entry kind]
(let [id (keyword kind (str (swap! serial inc)))] (let [id (keyword kind (str (swap! serial inc)))]
(when-let [old (:audio @loaded)] (when-let [old (:audio @loaded)]
(when (and (not= old (:audio entry)) (.startsWith old "blob:")) (when (and (not= old (:audio entry)) (.startsWith old "blob:"))
(js/URL.revokeObjectURL old))) (js/URL.revokeObjectURL old)))
(reset! loaded (assoc entry :id id)) (reset! loaded (assoc entry :id id))
id))) id))
(defn entry [id] (defn entry [id]
(if (= id (:id @loaded)) (if (= id (:id @loaded))

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

@ -10,6 +10,7 @@
(:require [arthur.domain.clip :as clip] (:require [arthur.domain.clip :as clip]
[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.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
@ -24,6 +25,7 @@
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding]))) (rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
(rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture]))) (rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture])))
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])]))) (rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
(rf/reg-sub ::tracing (fn [db _] (get-in db [:ui :trace])))
(rf/reg-sub (rf/reg-sub
::clip ::clip
@ -72,10 +74,11 @@
::exposure ::exposure
:<- [::symbol] :<- [::symbol]
(fn [sym _] (fn [sym _]
;; Exposure lives on the symbol's root node and is INHERITED, so reading it ;; NOT a cel. This is `:time :expose` — how many frames each step of a
;; there is reading it everywhere. The transport shows it so that `exposure 2` ;; subtree lasts, which is what shooting on twos means — and it lives on the
;; is visibly doing something at the transport rather than only inside the ;; symbol's root node and is INHERITED, so reading it there is reading it
;; document. ;; everywhere. The transport shows it so that `exposure 2` is visibly doing
;; something rather than only inside the document.
(or (get-in sym [:nodes :root :time :expose]) 1))) (or (get-in sym [:nodes :root :time :expose]) 1)))
(rf/reg-sub (rf/reg-sub
@ -113,7 +116,11 @@
(defn- placed? (defn- placed?
"Does row `path` from symbol `sid` still name an instance, all the way down?" "Does row `path` from symbol `sid` still name an instance, all the way down?"
[clip sid path] [clip sid path]
(reduce (fn [sid id] (or (get-in clip [:symbols sid :nodes id :of]) (reduced nil))) ;; Only a cel names a symbol. A lane is a group, so a row path that
;; ends at the lane rather than at one of its cels names no placement — which
;; is the structural answer, and does not move as the lane cuts.
(reduce (fn [sid id]
(or (node/source (get-in clip [:symbols sid :nodes id])) (reduced nil)))
sid path)) sid path))
(rf/reg-sub (rf/reg-sub
@ -125,7 +132,7 @@
:<- [::playback/display-fps] :<- [::playback/display-fps]
(fn [[document sid store palette picture-fps] _] (fn [[document sid store palette picture-fps] _]
(when (and document (clip/symbol document sid)) (when (and document (clip/symbol document sid))
(clip/resolver document store palette sid {:picture-fps picture-fps})))) (clip/resolver document sid store palette {:picture-fps picture-fps}))))
(rf/reg-sub (rf/reg-sub
::shown ::shown
@ -163,12 +170,19 @@
:<- [::store] :<- [::store]
:<- [::open] :<- [::open]
:<- [::solo] :<- [::solo]
(fn [[id document store open solo] _] :<- [::tracing]
;; What `ui/underlay` needs to paint the footage under the faces being (fn [[id document store open solo {:keys [faces opacity]}] _]
;; traced, besides the resolver that says where they went. A face outside ;; What `ui/underlay` needs to paint the footage of the faces being traced,
;; every soloed row is not on stage, so neither is its footage. ;; besides the resolver that says where they went. A face outside every soloed
;; row is not on stage, so neither is its footage.
(let [solo (filter #(placed? document open %) solo)] (let [solo (filter #(placed? document open %) solo)]
{:document document :store store {:document document :store store
:footage-id (:footage-id (footage/entry id)) :footage-id (:footage-id (footage/entry id))
:traces (cond->> (when document (trace/shown document open)) :opacity (or opacity trace/opacity-default)
(seq solo) (filterv (fn [{:keys [path]}] (some #(= % (take (count %) path)) solo))))}))) :traces (cond->> (when document (trace/shown document open faces))
(seq solo) (filterv (fn [{:keys [path]}]
;; The open symbol's own face is at the
;; empty path: it is not under any row, so
;; soloing a row cannot hide it.
(or (empty? path)
(some #(= % (take (count %) path)) solo)))))})))

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

@ -12,6 +12,8 @@
[re-frame.core :as rf])) [re-frame.core :as rf]))
(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 ::time-view (fn [db _] (get-in db [:ui :time-view] :timeline)))
(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 ::draft (fn [db _] (get-in db [:ui :draft]))) (rf/reg-sub ::draft (fn [db _] (get-in db [:ui :draft])))
@ -66,7 +68,7 @@
(when n (when n
(let [st (:store (store/entry clip-id))] (let [st (:store (store/entry clip-id))]
(when-let [pl (nest/placement clip st open (or path [id]) f)] (when-let [pl (nest/placement clip st open (or path [id]) f)]
(assoc pl :node n :bounds (pick/local-bounds clip st n (:frame pl)))))))) (assoc pl :node n :bounds ((pick/bounds-of clip st n) (:frame pl))))))))
(rf/reg-sub (rf/reg-sub
::project-footage ::project-footage

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

@ -29,7 +29,7 @@
:disc (select-keys op [:kind :cx :cy :r]) :disc (select-keys op [:kind :cx :cy :r])
:rect (select-keys op [:kind :cx :cy :size]) :rect (select-keys op [:kind :cx :cy :size])
nil)) nil))
((clip/resolver document st pal/index-of sid) 0)))) ((clip/resolver document sid st pal/index-of nil) 0))))
(defn symbol! (defn symbol!
"Start carrying symbol `sid` of the loaded document into the open symbol." "Start carrying symbol `sid` of the loaded document into the open symbol."

55
frontend/src/arthur/ui/icon.cljs Normal file
View file

@ -0,0 +1,55 @@
(ns arthur.ui.icon
"The handful of glyphs the chrome uses, drawn here rather than imported.
NOT an icon library, on purpose. Three reasons, in order of weight:
1. SIZE. These render at 11px against 11px type. Lucide, Feather and the rest
are drawn on a 24px grid with a 2px stroke and sub-pixel curves; scaled to
11 they go soft and land off the pixel grid, in a tool whose entire premise
is that you can see individual pixels. These are drawn on a 12px grid with
whole and half coordinates, so the bars and edges fall where the renderer
wants them.
2. REGISTER. `app.css` argues the chrome is Macromedia-era — flat, hairline,
no bevels, one accent. A modern rounded icon set is a second visual voice
in a strip 21px tall.
3. COST. Six glyphs is forty lines. The alternative is a dependency, a build
step's worth of tree-shaking, and a license file, for forty lines.
Icons are used ONLY where the word is worse than the picture: the transport,
where `|<` was ASCII pretending to be a glyph, and the two playback toggles,
which are state rather than actions. Everything else in the strip keeps its
word, because `insert` and `overwrite` have no pictures and inventing some
would be a puzzle rather than a shorthand. Every one carries an `aria-label`
at the call site; nothing here is the only statement of what a control does."
(:require [clojure.string :as str]))
;; A glyph is its paths on a 12x12 grid. Solid shapes are filled; the two
;; drawn with a line are stroked, which `kind` says.
(def ^:private glyphs
{:start {:fill ["M2 2.5h1.3v7H2z" ; the bar it stops against
"M10 2.5v7L4.2 6z"]} ; and the triangle into it
:play {:fill ["M3.4 2.3L10 6 3.4 9.7z"]}
:pause {:fill ["M3.3 2.4h1.9v7.2H3.3z"
"M6.8 2.4h1.9v7.2H6.8z"]}
;; Two arrows round a rectangle: the clip's end rejoining its start.
:loop {:stroke ["M3 5.4V4.6A1.2 1.2 0 0 1 4.2 3.4h5"
"M7.8 1.8 9.4 3.4 7.8 5"
"M9 6.6v.8A1.2 1.2 0 0 1 7.8 8.6h-5"
"M4.2 7 2.6 8.6 4.2 10.2"]}
;; One speaker, with or without the sound coming out of it.
:sound {:fill ["M2.4 4.6h1.8L6.4 2.6v6.8L4.2 7.4H2.4z"]
:stroke ["M8 4.1a2.7 2.7 0 0 1 0 3.8"]}
:muted {:fill ["M2.4 4.6h1.8L6.4 2.6v6.8L4.2 7.4H2.4z"]
:stroke ["M7.9 4.4 10.7 7.6" "M10.7 4.4 7.9 7.6"]}})
(defn view
"The glyph named `k`, sized by CSS and inked in `currentColor` — so a button's
`.on` state colours its icon without this knowing the palette exists."
[k]
(let [{:keys [fill stroke]} (glyphs k)]
[:svg {:viewBox "0 0 12 12" :aria-hidden true :focusable false}
(when (seq fill)
[:path {:d (str/join " " fill) :fill "currentColor"}])
(when (seq stroke)
[:path {:d (str/join " " stroke) :fill "none" :stroke "currentColor"
:stroke-width 1.2 :stroke-linecap "round" :stroke-linejoin "round"}])]))

182
frontend/src/arthur/ui/location.cljs Normal file
View file

@ -0,0 +1,182 @@
(ns arthur.ui.location
"The location bar: where you are, and therefore where an edit would land.
`lane-model.md`, under *UX: location, selection, and controls*, asks for a bar
above the timeline carrying three things — the breadcrumb, the creation
controls, and the shared-content context — and this is it. Until now the
answer to \"which symbol am I editing, five levels down a nested take\" was to
read the timeline's indentation and infer, which is exactly the inference the
document can do for you.
THE TRAIL IS READ OFF THE DOCUMENT, NOT REMEMBERED. It is the selection's row
path — the vector `nest/inside` reduces over for a frame and a matrix, and the
one `ui/select` carries — with each symbol's own parent chain filled in; see
`trail`. So the bar states a fact about where the selection IS rather than
where somebody has clicked, and every crumb on it is a selection in its own
right, which is what makes clicking one go back out to that level.
THE TIME IT PRINTS IS HONEST OR ABSENT. `lane-model.md` is explicit that holds
and loops need a true description instead of a fictitious unique global frame,
so the readout comes from `nest/inside` — which samples forward through holds
and refuses to invent an invertible map through a loop — and where that has no
answer this says so instead of computing one."
(:require [arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[arthur.domain.symbol :as symbol]
[arthur.events.ui :as ui]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.menu :as menu]
[re-frame.core :as rf]))
(defn- crumb-label
"What to call a node in the trail.
An INSTANCE is named after the symbol it places, because crossing one is how
you got further in and the symbol is what you are now inside — `main ▸ head ▸
mouth` is the useful sentence, and `main ▸ 3f2a91c0 ▸ …` is not. Everything
else is named as the timeline names it: `:name` when it has one, and a legible
stand-in when it has not."
[clip id n]
(let [of (node/source n)]
(or (when of (:name (clip/symbol clip of)))
(:name n)
(when of (name of))
(if (keyword? id) (subs (str id) 1) (subs (str id) 0 8)))))
(defn trail
"The crumbs from symbol `sid` down to the end of row path `path`, the symbol
first. Each carries the selection that names it, so clicking one goes back out
to that level.
TWO KINDS OF NESTING, and the trail has to show both. A row path crosses
INSTANCES — each step is a symbol entered — but within one symbol it names
only the node at the end, because `rows` presents a symbol's nodes flat: a cel
is addressed `[cel]` and not `[lane cel]`, since a cel is not a row. So inside
each symbol the walk takes the node's own ancestry as well, which is what puts
the lane a cel sits in on the trail — the thing you are most obviously nested
in, and the one the path alone never mentions.
A path that has gone stale — the node deleted under it — stops the walk where
it stops being true rather than inventing the rest."
[clip sid path]
(loop [in sid, left (seq path), so-far [], out [{:kind :symbol :sid sid
:label (clip/symbol-name clip sid)}]]
(let [id (first left)
n (when id (get-in clip [:symbols in :nodes id]))]
(if-not n
out
(let [nodes (:nodes (clip/symbol clip in))
;; Root first, the node itself last. Every one of them is a row of
;; this symbol in its own right, so each addresses as the path so
;; far with that id on the end.
chain (rseq (symbol/lineage nodes id))]
(recur (or (node/source n) in) (next left) (conj so-far id)
(into out
(map (fn [a]
(let [m (get nodes a)]
{:kind (:kind m)
:lane? (node/lane? m)
:sid in :id a :of (node/source m)
:label (crumb-label clip a m)
:select [:node in a (conj so-far a)]})))
chain)))))))
(defn- whereabouts
"The one line of context beside the trail: which frame of its own the selection
is showing, and whether that mapping is honest. Nil where there is nothing
true to say.
WORTH SAYING BECAUSE IT IS NOT THE PLAYHEAD. Every instance between the open
symbol and the selection carries a time map, so a shape six levels down is
showing its frame 6 while the transport reads 7 — a difference nobody can do
in their head and the one the transport cannot report, because the transport
belongs to the open symbol."
[clip n inside]
(let [{inner :sid f :frame t :time} inside
held? (and n (= :instance (:kind n)) (zero? (:speed (node/playback-of n))))
len (when inner (clip/frames clip inner))]
(cond
(nil? n) nil
(nil? inside) "not on screen on this frame"
(number? f)
(str (if held? "held on frame " "frame ") f
;; A node that places a symbol has that symbol's length to be a frame
;; OF; a shape has only its own frame, and inventing a denominator for
;; it would be inventing a fact.
(when len (str " of " len))
;; `nest/inside` gives `:time` only where the map back out is
;; invertible, and a HOLD is one of the things that makes it not —
;; but "held" has already said that, and repeating it as a caveat
;; would put the warning on the ordinary case. What is left to warn
;; about is a cel whose frames come round again, where the frame
;; above is being drawn more than once and names no single frame of
;; the open symbol.
(when (and (nil? t) (not held?)) " · repeats; no single frame above"))
:else nil)))
(defn- shared-with
"How many places in the document use the same drawing as `n`, or nil where it
places none. Counted rather than flagged, because \"used in 4 places\" is the
fact somebody needs before deciding to decouple one — and counted over every
node that places it, not only over cels, because a drawing reused as a plain
instance somewhere else is just as shared and `make unique` is just as much
the answer."
[clip n]
(when-let [of (and n (node/source n))]
(count (for [[_ sym] (:symbols clip)
[_ other] (:nodes sym)
:when (= of (node/source other))]
other))))
(defn view []
(let [clip @(rf/subscribe [::render/clip])
open @(rf/subscribe [::render/open])
selection @(rf/subscribe [::sub/selection])
inside @(rf/subscribe [::sub/selected-local])
[kind sid id path] selection
n (when (= :node kind) (get-in clip [:symbols sid :nodes id]))
crumbs (trail clip open (if (and n (seq path)) path (when n [id])))
last-i (dec (count crumbs))
shared (shared-with clip n)
says (whereabouts clip n inside)]
[:section.loc
[:nav.crumbs {:aria-label "editing location"}
(doall
(for [[i {:keys [label select lane?] crumb-kind :kind}] (map-indexed vector crumbs)]
^{:key i}
[:<>
(when (pos? i) [:span.crumb-sep "▸"])
[:button.crumb
{:class (str (when (= i last-i) "on") (when lane? " lane"))
;; The root crumb is the open symbol, and going out to it is having
;; nothing selected — which is a real state, not an absence of one.
:title (if (zero? i)
"the open symbol — clear the selection"
(str label " · " (if lane? "lane" (name crumb-kind))))
:on-click #(rf/dispatch [::ui/select (when (pos? i) select)])}
label]]))]
(when says
[:span.loc-fact {:title "the frame this selection is showing, in its own time"}
says])
;; Offered where it means something and nowhere else, which is also what
;; makes it an indicator: the row only appears when the drawing IS shared.
(when (and shared (< 1 shared))
[:span.loc-shared
(str "used in " shared " places")
[:button.link {:title "give this cel its own copy; other cels keep sharing"
:on-click #(rf/dispatch [::ui/make-unique])}
"make unique"]])
[:span.spacer]
;; CREATION LIVES HERE because this bar is what says where it would land.
;; `lane-model.md`: "Creation controls next to the breadcrumb act in that
;; explicit location." Both commands read the selection, and the trail to
;; the left of them is that selection written out.
[menu/view
{:label "new" :title "add to the document, at the location named on the left"
:items [{:label "symbol"
:sub "empty, inside the selected instance or beside the selected node"
:on-click #(rf/dispatch [::ui/new-symbol])}
{:label "lane"
:sub "a row that holds one drawing after another"
:on-click #(rf/dispatch [::ui/new-lane])}]}]]))

81
frontend/src/arthur/ui/menu.cljs Normal file
View file

@ -0,0 +1,81 @@
(ns arthur.ui.menu
"A labelled drop of commands, for a pane head that has more commands than room.
THE POINT IS NOT SPACE, IT IS THE EXPLANATION. A command that applies only to
a selected cel spends most of its life disabled, and a disabled button is a
grey word with its reason hidden in a `title` nobody hovers. The same command
as a menu row gets a second line saying what it does, visible at the moment
somebody is looking for it, which is the moment the menu is open.
So a menu stays openable even when every row in it is disabled, and says what
is missing instead. Hiding the rows would answer \"where did split go\" with
silence.
IT IS PLACED IN THE VIEWPORT, NOT IN THE PANE. A pane clips its own overflow —
`.time` must, or the timeline would push the window taller — so a panel laid
out inside one is cut off at its edge. Measured once per opening against the
button it hangs under, which is also what lets it flip above the button when
there is more room there. The measurement is of the BUTTON and not of the
panel, so it does not need the panel to exist yet.
The scrim is `ui/openmenu`'s, for the reason given there: a catcher behind the
panel dismisses on any outside click without a document listener that has to
be added, removed, and told to ignore the click that opened the menu."
(:require [reagent.core :as r]))
(def ^:private gap 2)
(def ^:private margin 8)
(defn- placement
"Where to put the panel, given the button it belongs to. `:bottom` rather than
`:top` when it opens upward, so the panel grows away from the button in both
directions without anything measuring the panel."
[^js button]
(let [r (.getBoundingClientRect button)
vh (.-innerHeight js/window)
vw (.-innerWidth js/window)
below (- vh (.-bottom r) gap margin)
above (- (.-top r) gap margin)
up? (> above below)]
(merge {:left (max margin (min (.-left r) (- vw 280 margin)))
:max-height (max 120 (if up? above below))}
(if up?
{:bottom (+ (- vh (.-top r)) gap)}
{:top (+ (.-bottom r) gap)}))))
(defn view
"`{:label :title :note :items}`. An item is
`{:label :sub :disabled? :on-click}`; a nil item is dropped, so a caller can
put a row behind a `when`. `note` is shown when nothing in the menu applies."
[_]
(let [at (r/atom nil)]
(fn [{:keys [label title note items]}]
(let [items (remove nil? items)
dead? (every? :disabled? items)
close! #(reset! at nil)]
[:div.menu-wrap
[:button {:class (when @at "on") :title title
:aria-haspopup "menu" :aria-expanded (boolean @at)
:on-click (fn [^js e]
(if @at (close!) (reset! at (placement (.-currentTarget e)))))}
label " ▾"]
(when-let [{:keys [left top bottom max-height]} @at]
[:<>
[:div.menu-scrim {:on-click close!}]
[:div.menu.menu-drop
{:role "menu"
:style (cond-> {:left (str left "px") :max-height (str max-height "px")}
top (assoc :top (str top "px"))
bottom (assoc :bottom (str bottom "px")))}
(when (and dead? note) [:div.dim.menu-note note])
(doall
(for [{:keys [label sub disabled? on-click]} items]
^{:key label}
;; The row's accessible name is the COMMAND, not the command
;; followed by its explanation — which is what `textContent` is
;; here, and what a screen reader would otherwise read out.
[:button.menu-item {:role "menuitem" :disabled (boolean disabled?)
:aria-label label :title sub
:on-click (fn [] (close!) (on-click))}
label
(when sub [:span.sub sub])]))]])]))))

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

@ -11,9 +11,18 @@
Slot 0 is the background, which is why it is shown and not selectable: a Slot 0 is the background, which is why it is shown and not selectable: a
polygon filled with index 0 is invisible against a stage cleared to index 0, so polygon filled with index 0 is invisible against a stage cleared to index 0, so
offering it as a fill is offering a shape that vanishes on creation." offering it as a fill is offering a shape that vanishes on creation.
The footage switch is here too, because it is the same kind of thing as the
tone and the tool: something you set before you draw and leave alone, in one
place whatever is selected. In the inspector it was a section that appeared
only once the right row had been found — so the way to see the footage you are
tracing depended on what you had clicked, which is not a thing anyone can be
expected to learn."
(:require [arthur.domain.palette :as pal] (:require [arthur.domain.palette :as pal]
[arthur.domain.trace :as trace]
[arthur.events.ui :as ui] [arthur.events.ui :as ui]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub] [arthur.subs.ui :as sub]
[re-frame.core :as rf])) [re-frame.core :as rf]))
@ -34,6 +43,31 @@
:disabled (not pick) :disabled (not pick)
:on-click #(rf/dispatch [::ui/set-tone slot-tone])}])) :on-click #(rf/dispatch [::ui/set-tone slot-tone])}]))
(defn- tracing
"The footage under the faces the open symbol has, on or off and how strongly.
ONE SWITCH FOR THE FACES THAT ARE HERE. A face's footage is the face's, not a
placement's, so there is nothing to inherit and nothing to set twice; with
several faces in a take the box says how many are showing and switches the rest
on, and one face alone is switched from its own timeline row."
[]
(let [clip @(rf/subscribe [::render/clip])
open @(rf/subscribe [::render/open])
{:keys [faces opacity]} @(rf/subscribe [::render/tracing])
here (trace/traceable-faces clip open)
on (filterv (set faces) here)]
(when (seq here)
[:<>
[:label.dim {:title (str "show the footage these faces were traced from, over the "
"picture · a reference, never exported")}
[:input {:type "checkbox" :checked (= (count on) (count here))
:on-change #(rf/dispatch [::ui/trace-faces here])}]
(str " footage" (when (< 1 (count here)) (str " " (count on) "/" (count here))))]
[:input.trace-opacity
{:type "range" :min 0 :max 1 :step 0.05 :title "how strongly the footage draws"
:value (or opacity trace/opacity-default) :disabled (empty? on)
:on-change #(rf/dispatch [::ui/trace-opacity (js/parseFloat (.. % -target -value))])}]])))
(defn bar [] (defn bar []
(let [tone @(rf/subscribe [::sub/tone]) (let [tone @(rf/subscribe [::sub/tone])
tool @(rf/subscribe [::sub/tool]) tool @(rf/subscribe [::sub/tool])
@ -42,6 +76,7 @@
[:div.swatches (doall (map #(swatch % tone) (range slots)))] [:div.swatches (doall (map #(swatch % tone) (range slots)))]
[:span.dim (name tone)] [:span.dim (name tone)]
[:span {:style {:flex 1}}] [:span {:style {:flex 1}}]
[tracing]
(if (= :polygon tool) (if (= :polygon tool)
[:<> [:<>
[:span.dim (str (quot (count draft) 2) " points")] [:span.dim (str (quot (count draft) 2) " points")]

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

@ -180,7 +180,9 @@
(defn- channel-control [sid id path ch frame] (defn- channel-control [sid id path ch frame]
(let [keyed? (some? (:keys ch)) (let [keyed? (some? (:keys ch))
v (channel/value-at ch (or frame 0)) ;; No store: the call site below hands this only channels that are not
;; `:dense`, which are the only ones with anything in tier 2 to read.
v (channel/value-at ch (or frame 0) nil)
off? (and keyed? (nil? frame)) off? (and keyed? (nil? frame))
deg? (= path [:xform :rot]) deg? (= path [:xform :rot])
;; A boolean has nothing between true and false to tween through. ;; A boolean has nothing between true and false to tween through.
@ -213,9 +215,9 @@
[facts [facts
"name" (or (:name n) (brief id)) "name" (or (:name n) (brief id))
"id" (brief id) "id" (brief id)
;; Which symbol an instance places. The one fact that makes an instance ;; Which symbol a cel places. The one fact that makes an instance
;; legible as an instance rather than as a node. ;; legible as an instance rather than as a node.
"of" (when (= :instance (:kind n)) (str (:of n))) "of" (when (= :instance (:kind n)) (str (node/source n)))
;; A span is in the node's OWN frames and `at` is where its frame 0 sits ;; A span is in the node's OWN frames and `at` is where its frame 0 sits
;; in this symbol. See `node/placed-span`. ;; in this symbol. See `node/placed-span`.
"span" (when start (str start " … " end)) "span" (when start (str start " … " end))
@ -236,21 +238,32 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; tracing a face ;; tracing a face
;; ;;
;; Two owners in one section, and the heading says whose each is. Showing the ;; THE FACE'S OWN FACTS ONLY, and both of them are keyed to the face rather than
;; footage and how strongly is this INSTANCE's, a drawing aid that is not keyed, ;; to an instance of it: which of its frames its drawings were made over, and
;; and it covers every face at or below it — so a take shows its faces' footage. ;; what its origin does between those frames. See `domain/trace`.
;; The trace keys and the origin are the FACE's — its symbol's head — so they are ;;
;; the same in every placement of it. See `domain/trace`. ;; Whether the footage is SHOWING is deliberately not here. It is a viewing aid
;; and it belongs with the other things you look through rather than edit, on the
;; bar above the stage — where it is in the same place whatever is selected,
;; instead of appearing in the inspector only once the right row has been found.
(defn- face-trace [face] (defn- trace-keys
"The face's trace keys and origin. `frame` is the frame of the FACE that the
playhead is over, and `seek!` goes to one of its frames — both of which depend
on whether the face is open in its own tab or placed in what is."
[face frame seek!]
(let [t (trace/of (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head])) (let [t (trace/of (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head]))
{:keys [frame time]} @(rf/subscribe [::sub/selected-local]) put #(rf/dispatch [::project/set-trace face %])
put #(rf/dispatch [::project/set-trace face %])] key? (boolean (some #{frame} (:frames t)))]
[:<> [:<>
[:div.row {:style {:margin "5px 0"}} [:div.row {:style {:margin "5px 0"}}
[:button {:disabled (nil? frame) ;; A DEAD BUTTON WITH NO REASON GIVEN is what reads as the feature not
:on-click #(put (trace/toggle-frame t frame))} ;; working. There is no frame of this face under the playhead, so say that
(if (some #{frame} (:frames t)) "remove trace key" "trace key here")]] ;; rather than greying out the one control in the section.
(if (nil? frame)
[:span.dim "move the playhead over this face to key it"]
[:button {:on-click #(put (trace/toggle-frame t frame))}
(if key? (str "remove trace key at " frame) (str "trace key at " frame))])]
(when (seq (:frames t)) (when (seq (:frames t))
[:div.row [:div.row
[:span.dim "keys"] [:span.dim "keys"]
@ -258,9 +271,8 @@
(for [f (:frames t)] (for [f (:frames t)]
^{:key f} ^{:key f}
[:button {:class (when (= frame f) "on") [:button {:class (when (= frame f) "on")
:disabled (nil? time) :disabled (nil? seek!)
:on-click #(rf/dispatch [::pb/seek (js/Math.round :on-click #(seek! f)}
(+ (:at time) (/ f (:rate time))))])}
(str f)]))]) (str f)]))])
[:div.row {:style {:margin-top "5px"}} [:div.row {:style {:margin-top "5px"}}
[:span.dim "origin"] [:span.dim "origin"]
@ -268,36 +280,38 @@
(for [[o label] (map vector trace/origins ["continuous" "at keys" "start"])] (for [[o label] (map vector trace/origins ["continuous" "at keys" "start"])]
^{:key o} ^{:key o}
[:button {:class (when (= o (:origin t)) "on") [:button {:class (when (= o (:origin t)) "on")
:title (case o
:continuous "the head reads the frame it is on"
:keys "the head jumps to each trace key and holds it"
:start "the head holds frame 0 forever")
:on-click #(put (assoc t :origin o))} :on-click #(put (assoc t :origin o))}
label]))]])) label]))]]))
(defn- tracing-section [[sid id n] faces] (defn- tracing-section
"`face` is the face these facts belong to, `faces` the faces placed inside it
to offer as somewhere to go next, and `path` the row path `faces` are under."
[face faces path]
(let [clip @(rf/subscribe [::render/clip]) (let [clip @(rf/subscribe [::render/clip])
open @(rf/subscribe [::render/open]) own? (= face @(rf/subscribe [::render/open]))
[_ _ _ path] @(rf/subscribe [::sub/selection]) ;; The face's OWN frame, which is the playhead itself when the face is
path (or path [id]) ;; the open symbol, and the selected placement's local frame when it is
{:keys [on? opacity own?] :or {opacity 0.5} :as u} (trace/underlay-at clip open path) ;; placed in it. `time` maps the open symbol's frames to that
show #(rf/dispatch [::project/set-underlay sid id (merge {:on? (boolean on?) :opacity opacity} %)])] ;; placement's, so seeking to one of the face's frames is a conversion.
[section (str "tracing · " (name (:of n))) {:keys [frame time]} (when-not own? @(rf/subscribe [::sub/selected-local]))
[:div.row frame (if own? @(rf/subscribe [::playback/frame]) frame)
[:label.dim [:input {:type "checkbox" :checked (boolean on?) seek! (cond own? #(rf/dispatch [::pb/seek %])
:on-change #(show {:on? (.. % -target -checked)})}] time #(rf/dispatch [::pb/seek (js/Math.round
" footage" (+ (:at time) (/ % (:rate time))))]))]
(when (and u (not own?)) " · as above")] [section (str "tracing · " (name face))
[:input {:type "range" :min 0 :max 1 :step 0.05 :value opacity (when (trace/traceable? clip face) [trace-keys face frame seek!])
:disabled (not on?)
:on-focus #(rf/dispatch [::history/hold])
:on-blur #(rf/dispatch [::history/settle])
:on-change #(show {:opacity (js/parseFloat (.. % -target -value))})}]]
(when (trace/traceable? clip (:of n)) [face-trace (:of n)])
(when (seq faces) (when (seq faces)
[:div.row {:style {:margin-top "5px"}} [:div.row {:style {:margin-top "5px"}}
[:span.dim "faces"] [:span.dim "faces"]
(doall (doall
(for [{p :path in :in face :face} faces] (for [{p :path in :in f :face} faces]
^{:key (str p)} ^{:key (str p)}
[:button {:on-click #(rf/dispatch [::ui/select [:node in (peek p) (into path p)]])} [:button {:on-click #(rf/dispatch [::ui/select [:node in (peek p) (into path p)]])}
(name face)]))])])) (name f)]))])]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; a symbol ;; a symbol
@ -416,17 +430,32 @@
(defn view [] (defn view []
(let [clip @(rf/subscribe [::render/clip]) (let [clip @(rf/subscribe [::render/clip])
open @(rf/subscribe [::render/open])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
node @(rf/subscribe [::sub/selected-node]) node @(rf/subscribe [::sub/selected-node])
tracked? (seq (owners clip))] tracked? (seq (owners clip))
;; The face the tracing section is about: the SELECTED PLACEMENT's symbol,
;; or, when the selection is not an instance or there is none, the OPEN
;; symbol — which is the face itself when a face is open to be drawn over.
;; That last case had no section at all before, and it is the one where
;; the keys are actually being set.
;; The symbol this cel places, or nil for a lane: which face a
;; lane traces is not a question with one answer, and naming the drawing
;; showing now would move the section under the playhead.
placed (node/source (peek node))
face (or placed (when (trace/traceable? clip open) open))
faces (when face (trace/faces clip face))
;; Where that face sits, as a row path from the open symbol, so the faces
;; inside it can be selected by their own rows. A selection made on the
;; stage has no path and names a node directly in the open symbol; the
;; open symbol itself is at no path at all.
path (if placed (or (nth selection 3 nil) [(second node)]) [])]
[:section.pane.params [:section.pane.params
[:div.pane-head "inspector"] [:div.pane-head "inspector"]
[:div {:style {:min-height 0}} [:div {:style {:min-height 0}}
[clip-section] [clip-section]
(when node [node-section node]) (when node [node-section node])
(when-let [of (:of (peek node))] (when (and face (or (trace/traceable? clip face) (seq faces)))
(let [faces (trace/faces clip of)] [tracing-section face faces path])
(when (or (trace/traceable? clip of) (seq faces))
[tracing-section node faces])))
(when (= :symbol (first selection)) [symbol-section (second selection)]) (when (= :symbol (first selection)) [symbol-section (second selection)])
(when tracked? [tracking-section])]])) (when tracked? [tracking-section])]]))

25
frontend/src/arthur/ui/player.cljs
View file

@ -101,8 +101,9 @@
(some-> @tracker ratom/dispose!) (some-> @tracker ratom/dispose!)
(reset! tracker (reset! tracker
(ratom/run! (ratom/run!
(let [was (:resolver @snapshot) (let [{was :resolver was-u :underlay} @snapshot
now @(rf/subscribe [::render/shown])] now @(rf/subscribe [::render/shown])
u @(rf/subscribe [::render/underlay])]
(reset! snapshot (reset! snapshot
{:resolver now {:resolver now
:palette @(rf/subscribe [::render/palette]) :palette @(rf/subscribe [::render/palette])
@ -111,12 +112,23 @@
:frames @(rf/subscribe [::render/frames]) :frames @(rf/subscribe [::render/frames])
:width @(rf/subscribe [::sub/width]) :width @(rf/subscribe [::sub/width])
:height @(rf/subscribe [::sub/height]) :height @(rf/subscribe [::sub/height])
:underlay @(rf/subscribe [::render/underlay]) :underlay u
:frame @(rf/subscribe [::sub/frame]) :frame @(rf/subscribe [::sub/frame])
:playing? @(rf/subscribe [::sub/playing?])}) :playing? @(rf/subscribe [::sub/playing?])})
;; A new resolver means a new scene or a new palette, and neither ;; A new resolver means a new scene or a new palette, and neither
;; moves the playhead — so nothing else would ask for a redraw. ;; moves the playhead — so nothing else would ask for a redraw.
(when-not (identical? was now) (repaint!)))))) ;;
;; Switching a face's footage on wants the same redraw for the same
;; reason, and it needs asking for SEPARATELY: it is a viewing aid
;; in the editor's own state, so it changes what the canvases should
;; show without touching the frame number OR the resolver. The
;; document and the store are left out of the comparison because
;; they are what a new resolver already means.
;; Comparing the whole map is as cheap as picking fields out of it:
;; the document and the store it carries are the same OBJECTS unless
;; the resolver changed too, and that is tested first.
(when-not (and (identical? was now) (= was-u u))
(repaint!))))))
(defn set-canvas! [el] (defn set-canvas! [el]
(swap! state assoc :canvas el) (swap! state assoc :canvas el)
@ -146,7 +158,7 @@
rasterised before the next frame is asked for." rasterised before the next frame is asked for."
[f] [f]
(let [{:keys [canvas]} @state (let [{:keys [canvas]} @state
{:keys [resolver palette ramp width height underlay]} @snapshot] {:keys [resolver palette ramp width height underlay playing?]} @snapshot]
(when (and canvas resolver width height) (when (and canvas resolver width height)
;; User Timing, so a profile in the DevTools performance panel has named ;; User Timing, so a profile in the DevTools performance panel has named
;; spans in the Timings track instead of a wall of anonymous frames. Three ;; spans in the Timings track instead of a wall of anonymous frames. Three
@ -163,7 +175,8 @@
(raster/draw-ops! ops))) (raster/draw-ops! ops)))
(js/performance.mark "arthur/blit:start") (js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras ramp) (canvas/blit! canvas ras ramp)
(underlay/paint! (assoc underlay :width width) resolver repaint!)) (underlay/paint! (assoc underlay :width width :playing? playing?)
resolver repaint!))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start") (js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start") (js/performance.measure "arthur/paint" "arthur/paint:start")
;; User Timing entries otherwise accumulate forever in the browser's ;; User Timing entries otherwise accumulate forever in the browser's

7
frontend/src/arthur/ui/shell.cljs
View file

@ -1,5 +1,5 @@
(ns arthur.ui.shell (ns arthur.ui.shell
"The window: one grid, five panes, and the audio element. "The window: one grid, five panes, a location bar, and the audio element.
Nothing else. Each pane owns its own subscriptions, so this component re-renders Nothing else. Each pane owns its own subscriptions, so this component re-renders
only when the grid itself would change — which is never. The picture is put on only when the grid itself would change — which is never. The picture is put on
@ -10,6 +10,7 @@
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.subs.playback :as playback] [arthur.subs.playback :as playback]
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.ui.location :as location]
[arthur.ui.palette :as palette] [arthur.ui.palette :as palette]
[arthur.ui.params :as params] [arthur.ui.params :as params]
[arthur.ui.pool :as pool] [arthur.ui.pool :as pool]
@ -52,6 +53,10 @@
[palette/bar] [palette/bar]
[stage/view]] [stage/view]]
[params/view] [params/view]
;; Above the timeline rather than inside it: the bar says where an edit would
;; land, which is a fact about the SELECTION and not about either temporal
;; view, and both views are drawn below it unchanged.
[location/view]
[timeline/view] [timeline/view]
[convert/view] [convert/view]
[audio]]) [audio]])

34
frontend/src/arthur/ui/stage.cljs
View file

@ -118,23 +118,40 @@
;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`. ;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`.
(defonce ^:private gesture (atom nil)) (defonce ^:private gesture (atom nil))
(defn- loaded
"The document and its tier-2 store, read WHEN THE POINTER GOES DOWN.
NOT AT RENDER TIME, which is the bug it does not look like. `footage/store` is
a mutable handle behind an id, and — see `events/edit` — the id does not change
when the document does; `:paint/revision` is what says it did, and nothing this
component subscribes to reads it. So a clip dereferenced while rendering is the
clip as it was BEFORE the last edit, and a drag begun from one starts by
putting the node back where it was two edits ago: the node sits still under the
press and then jumps on the first pointermove, which is the whole of the drag
that follows being right and its first frame being wrong. Every id here is
reactive except the document, and the document is the one read late."
[{:keys [clip-id]}]
(store/entry clip-id))
(defn- select! (defn- select!
"Select the node at row path `path` of the open symbol — the selection a "Select the node at row path `path` of the open symbol — the selection a
timeline row makes, so the row, the inspector and the stage all show it — or timeline row makes, so the row, the inspector and the stage all show it — or
nothing." nothing."
[{:keys [document st open f]} path] [{:keys [open f] :as ctx} path]
(let [{document :clip st :store} (loaded ctx)]
(rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path) (rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path)
(nest/placement document st open path f))] (nest/placement document st open path f))]
[:node sid id path])])) [:node sid id path])])))
(defn- begin! (defn- begin!
"Start dragging `kind` of the node at `path` from stage point `p`." "Start dragging `kind` of the node at `path` from stage point `p`."
[{:keys [document st open f]} kind path p] [{:keys [open f] :as ctx} kind path p]
(let [{document :clip st :store} (loaded ctx)]
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)] (when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
(let [n (get-in document [:symbols sid :nodes id]) (let [n (get-in document [:symbols sid :nodes id])
v0 (gesture/values n frame)] v0 (gesture/values n frame st)]
(reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n (reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n
:a (gesture/angle pl v0 p) :turned 0})))) :a (gesture/angle pl v0 p) :turned 0})))))
(defn- drag! [p ^js event] (defn- drag! [p ^js event]
(let [{:keys [kind pl v0 p0 n a turned values]} @gesture (let [{:keys [kind pl v0 p0 n a turned values]} @gesture
@ -175,7 +192,7 @@
[ctx] [ctx]
(let [{:keys [world bounds node frame]} @(rf/subscribe [::sub/selected-placement]) (let [{:keys [world bounds node frame]} @(rf/subscribe [::sub/selected-placement])
[_ _ _ path] @(rf/subscribe [::sub/selection]) [_ _ _ path] @(rf/subscribe [::sub/selection])
[ax ay] (when world (:anchor (gesture/values node frame))) [ax ay] (when world (:anchor (gesture/values node frame (:store (loaded ctx)))))
[px py] (when world (through world [ax ay])) [px py] (when world (through world [ax ay]))
grab (fn [kind] grab (fn [kind]
(fn [^js event] (fn [^js event]
@ -209,12 +226,13 @@
drawing? (= :polygon tool) drawing? (= :polygon tool)
[_ _ _ selected] @(rf/subscribe [::sub/selection]) [_ _ _ selected] @(rf/subscribe [::sub/selection])
clip-id @(rf/subscribe [::render/clip-id]) clip-id @(rf/subscribe [::render/clip-id])
ctx {:document (:clip (store/entry clip-id)) :st (:store (store/entry clip-id)) ctx {:clip-id clip-id
:open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::playback/frame]) :open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::playback/frame])
:w w :h h} :w w :h h}
points? @(rf/subscribe [::sub/points]) points? @(rf/subscribe [::sub/points])
[sid id geom active editable? frame matrix] (when points? (editing)) [sid id geom active editable? frame matrix] (when points? (editing))
pts (when geom (through matrix (channel/value-at geom frame)))] pts (when geom (through matrix (channel/value-at geom frame
(:store (store/entry clip-id)))))]
[:svg {:class (str "paint-overlay" (when drawing? " drawing")) [:svg {:class (str "paint-overlay" (when drawing? " drawing"))
:width (* zoom w) :height (* zoom h) :width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h) :view-box (str "0 0 " w " " h)

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

@ -22,8 +22,15 @@
happen and not where they happen again." happen and not where they happen again."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.nest :as nest]
[arthur.domain.lane :as lane]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.events.ui :as ui] [arthur.events.ui :as ui]
[arthur.footage.store :as store]
[arthur.ui.icon :as icon]
[arthur.ui.menu :as menu]
[arthur.subs.playback :as playback] [arthur.subs.playback :as playback]
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.subs.ui :as sub] [arthur.subs.ui :as sub]
@ -44,17 +51,23 @@
frame 48 of the symbol it is in, and drawing it at 0 puts every placement's frame 48 of the symbol it is in, and drawing it at 0 puts every placement's
keys in the same place however staggered they are. keys in the same place however staggered they are.
Exposure is not inverted, because it is a floor and has no inverse: a key on a Cel is not inverted, because it is a floor and has no inverse: a key on a
frame the exposure grid never samples is still authored on that frame, and that frame the exposure grid never samples is still authored on that frame, and that
is where the row should show it." is where the row should show it."
[n] [n]
(let [{:keys [at rate]} (node/time-of n)] (let [{:keys [at rate]} (node/time-of n)]
(if (and (zero? at) (= 1 rate)) (if (and (zero? at) (= 1 rate))
identity identity
(fn [f] (js/Math.round (+ at (/ f rate))))))) (fn [f] (+ at (/ f rate))))))
(defn- keyed-frames [ch] (some-> (:keys ch) keys sort)) (defn- keyed-frames [ch] (some-> (:keys ch) keys sort))
(defn- source-frames
"How long the thing this node places is, for a placement carrying no span of
its own. 0 for a node that places nothing, or a reference with nothing there."
[clip n]
(or (get-in clip [:symbols (node/source n) :frames]) 0))
(defn- node-label (defn- node-label
"What to call a node in the label column. "What to call a node in the label column.
@ -104,19 +117,23 @@
;; symbol is resolved in — `clip/resolver` roots the ;; symbol is resolved in — `clip/resolver` roots the
;; child at this node's local frame — so the nested ;; child at this node's local frame — so the nested
;; walk carries it down unchanged. ;; walk carries it down unchanged.
self (comp ->open (local->parent n)) ancestors (rest (symbol/lineage (:nodes sym) id))
span (mapv ->open parent-map (reduce comp ->open
(map #(local->parent (get-in sym [:nodes %]))
(reverse ancestors)))
self (comp parent-map (local->parent n))
span (mapv parent-map
(or (node/placed-span (or (node/placed-span
(cond-> n (cond-> n
(and (= :instance (:kind n)) (nil? (:span n))) (and (= :instance (:kind n)) (nil? (:span n)))
(assoc :span [0 (get-in clip [:symbols (:of n) :frames])]))) (assoc :span [0 (source-frames clip n)])))
[0 (:frames sym)])) [0 (:frames sym)]))
row {:path rpath row {:path rpath
:depth depth :depth depth
:label (node-label id n) :label (node-label id n)
:kind :node :kind :node
:node-kind (:kind n) :node-kind (:kind n)
:of (:of n) :of (node/source n)
:select [:node sid id rpath] :select [:node sid id rpath]
:expandable? true :expandable? true
:expanded? open? :expanded? open?
@ -126,60 +143,65 @@
(distinct)) (distinct))
(vals channels)) (vals channels))
:dense? (boolean (some :dense (vals channels)))}] :dense? (boolean (some :dense (vals channels)))}]
;; AN CEL IS NOT A ROW. A lane's drawings are cel
;; blocks on the lane's own row, so a lane of twelve
;; cels is one row and not twelve — which is the
;; vertical growth that made a keyed source look
;; necessary. The cel is still the thing selected
;; and addressed; only its presentation is shared.
(if (node/lane? (get-in sym [:nodes (:parent n)]))
[]
(let [row (cond-> row
(node/lane? n)
(assoc :cels
(mapv (fn [child]
{:id (:id child)
:label (or (get-in clip [:symbols (node/source child) :name])
(some-> (node/source child) name))
:source (node/source child)
:span (mapv self (node/placed-span child))
:select [:node sid (:id child) (conj path (:id child))]})
(symbol/lane-cels (:nodes sym) id))))]
(if-not open? (if-not open?
[row] [row]
(-> [row] (-> [row]
(into (channel-rows n rpath (inc depth) self span)) (into (channel-rows n rpath (inc depth) self span))
(into (when (= :instance (:kind n)) (into (when-let [{:keys [at rate]} (and (= :instance (:kind n))
(walk (:of n) rpath (inc depth) self))))))) (node/source-time n))]
(when-let [child (node/source n)]
(walk child rpath (inc depth)
(comp self #(+ at (/ % rate)))))))))))))
ordered))))] ordered))))]
(if (get-in clip [:symbols sid]) (if (get-in clip [:symbols sid])
(walk sid [] 0 identity) (walk sid [] 0 identity)
[]))) [])))
(defn sound-rows (defn sound-rows
"Every sound symbol `sid` plays, one row each, below the picture as an "Audio rows use the same flattened intervals as the mixer, including source
editor's audio tracks are: its own, and those inside what it places at any in-points, cel speeds, parent timing, and silence beneath visual holds."
depth — each TIED to the placement it is heard through, `:via`, and drawn
where it is heard, cut to that placement's span as the mix cuts it."
[clip sid expanded] [clip sid expanded]
(letfn [(walk [sid path ->open [lo hi] via] (if-not (get-in clip [:symbols sid]) []
(vec
(mapcat (mapcat
(fn [[id n]] (fn [[path tracks]]
(let [rpath (conj path id) (let [n (first tracks)
self (comp ->open (local->parent n)) span (node/placed-span n)
[a b] (mapv ->open (or (node/placed-span select [:node (:owner n) (:id n) path]
(cond-> n open? (contains? expanded path)
(and (= :instance (:kind n)) (nil? (:span n))) via (when (< 1 (count path)) (str (first path)))
(assoc :span [0 (get-in clip [:symbols (:of n) :frames])]))) row {:path path :depth 0 :label (node-label (:id n) n)
[0 (get-in clip [:symbols sid :frames])])) :kind :node :node-kind :audio :via via
span [(max lo a) (min hi b)] :slides (if via (subvec path 0 1) path)
open? (contains? expanded rpath)] :select select :expandable? true :expanded? open? :span span
(case (:kind n) :keys (vec (distinct (mapcat keyed-frames (vals (:channels n)))))}]
:audio (cons {:path rpath (cons (cond-> row
:depth 0 (< 1 (count tracks))
:label (node-label id n) (assoc :cels (mapv (fn [i track]
:kind :node {:id i :label (node-label (:id track) track)
:node-kind :audio :span (node/placed-span track) :select select})
:via via (range) tracks)))
;; A sound heard through a placement is (when open? (channel-rows n path 1 identity span)))))
;; that placement's picture's sound: its bar (sort-by (comp str key) (group-by :path (nest/audio-tracks clip sid)))))))
;; moves the placement, so the two stay in
;; sync. Moving the placement moves it too.
:slides (if via (subvec rpath 0 1) rpath)
:select [:node sid id rpath]
:expandable? true
:expanded? open?
:span span
:keys (into [] (comp (mapcat keyed-frames) (map self) (distinct))
(vals (node/channels n)))}
(when open? (channel-rows n rpath 1 self span)))
:instance (walk (:of n) rpath self span (or via (node-label id n)))
nil)))
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]) (get-in clip [:symbols sid :nodes]))))]
(if (get-in clip [:symbols sid])
(vec (walk sid [] identity [##-Inf ##Inf] nil))
[])))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; geometry ;; geometry
@ -203,38 +225,166 @@
(defn- transport [] (defn- transport []
(let [playing? @(rf/subscribe [::playback/playing?]) (let [playing? @(rf/subscribe [::playback/playing?])
rate @(rf/subscribe [::playback/rate]) rate @(rf/subscribe [::playback/rate])
loop? @(rf/subscribe [::playback/loop?])
muted? @(rf/subscribe [::playback/muted?])
view @(rf/subscribe [::sub/time-view])
frame @(rf/subscribe [::playback/frame]) frame @(rf/subscribe [::playback/frame])
frames @(rf/subscribe [::render/frames]) frames @(rf/subscribe [::render/frames])
{:keys [fps drop]} @player/meter] {:keys [fps drop]} @player/meter
clip @(rf/subscribe [::render/clip])
clip-id @(rf/subscribe [::render/clip-id])
selection @(rf/subscribe [::sub/selection])
[_ sid id] selection
open @(rf/subscribe [::render/open])
st (:store (store/entry clip-id))
n (get-in clip [:symbols sid :nodes id])
lane (if (node/lane? n) n (get-in clip [:symbols sid :nodes (:parent n)]))
lane? (node/lane? lane)
cel? (and lane? (= :instance (:kind n)) (some? (node/source n)))
held? (and cel? (zero? (:speed (node/playback-of n))))
;; Shared use is shown rather than discovered: the row that decouples
;; a cel is only offered where there is something to decouple from.
shared? (and cel? (< 1 (count (for [[_ sym] (:symbols clip)
[_ other] (:nodes sym)
:when (= (node/source n) (node/source other))]
other))))
;; Both act at the playhead, so both are offered only where the playhead
;; is somewhere they mean something.
owner-frame (ui/selection-frame clip st open selection frame)
at (when (and lane? (number? owner-frame))
(lane/lane-frame clip sid (:id lane) owner-frame))
insertable? (and lane? (integer? at))
splittable? (and cel? (integer? at)
(let [[lo hi] (node/placed-span n)] (< lo at hi)))
act (fn [event] #(rf/dispatch event))]
[:div.pane-head [:div.pane-head
[:button {:on-click #(rf/dispatch [::pb/toggle])} (if playing? "pause" "play")] ;; ----------------------------------------------------------------- time
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"] ;; Where the playhead is and how it moves. Nothing here depends on a
[:button {:on-click #(rf/dispatch [::pb/step -1])} "-1"] ;; selection, which is why it is the one group that is never greyed.
[:button {:on-click #(rf/dispatch [::pb/step 1])} "+1"] [:div.group
[:button {:class (when @(rf/subscribe [::playback/loop?]) "on") [:button.ico {:aria-label "go to start" :title "go to the first frame"
:on-click #(rf/dispatch [::pb/toggle-loop])} "loop"] :on-click (act [::pb/seek 0])} [icon/view :start]]
[:button {:class (when @(rf/subscribe [::playback/muted?]) "on") [:button {:aria-label "−1" :title "step back one frame"
:on-click #(rf/dispatch [::pb/toggle-mute])} "mute"] :on-click (act [::pb/step -1])} "−1"]
(doall [:button.ico.ico-play {:aria-label (if playing? "pause" "play")
(for [r [0.25 0.5 1.0 2.0 4.0]] :title (if playing? "pause" "play")
^{:key r} :on-click (act [::pb/toggle])}
[icon/view (if playing? :pause :play)]]
[:button {:aria-label "+1" :title "step forward one frame"
:on-click (act [::pb/step 1])} "+1"]]
[:div.group
[:button.ico {:class (when loop? "on") :aria-label "loop"
:title "loop playback" :on-click (act [::pb/toggle-loop])}
[icon/view :loop]]
[:button.ico {:class (when muted? "on") :aria-label (if muted? "unmute" "mute")
:title (if muted? "unmute" "mute") :on-click (act [::pb/toggle-mute])}
[icon/view (if muted? :muted :sound)]]]
;; Beside the transport rather than off at the right margin: it is what you
;; read WHILE scrubbing, and tabular figures keep it from twitching as it
;; counts.
[:span.readout.at-frame (str frame " / " frames)]
;; Five buttons for one mutually exclusive choice that is 1× almost always.
;; A select says "pick one of these" in the width of the answer.
;; playbackRate on the audio element and nothing else: the sound slows, ;; playbackRate on the audio element and nothing else: the sound slows,
;; currentTime advances proportionally, and the derived frame follows. Slow ;; currentTime advances proportionally, and the derived frame follows. Slow
;; motion cannot desync by construction. ;; motion cannot desync by construction.
[:button {:class (when (== r rate) "on") [:span.pick
:on-click #(rf/dispatch [::pb/set-rate r])} [:select {:value rate :aria-label "playback speed" :title "playback speed"
(case r 1.0 "1x" 0.5 "½" 0.25 "¼" 2.0 "2x" 4.0 "4x" (str r))])) :on-change #(rf/dispatch [::pb/set-rate
[:button {:title "a new empty symbol inside the selected instance, or beside the selected node, or in the open symbol" (js/parseFloat (.. % -target -value))])}
:on-click #(rf/dispatch [::ui/new-symbol])} (doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]]
"+ symbol"] ^{:key r} [:option {:value r} label]))]]
[:span.sep]
;; ----------------------------------------------------------------- view
;; TWO VIEWS OF ONE THING, and you are always in exactly one. Two separate
;; toggles said neither half of that; joined, with the one in force filled,
;; the control is the statement.
[:div.seg {:role "radiogroup" :aria-label "time view"}
(doall
(for [[k label title] [[:timeline "timeline" "lanes across, frames left to right"]
[:cel-sheet "cel sheet" "frames down, one column per lane"]]]
^{:key k}
[:button {:class (when (= k view) "on") :role "radio"
:aria-checked (= k view) :title title
:on-click (act [::ui/set-time-view k])}
label]))]
[:span.sep]
;; ------------------------------------------------------------- commands
;; Fourteen of these, and all but two mean nothing without a selected lane
;; or cel — so as buttons they were a permanent grey hedge across the strip
;; with their explanations hidden in `title`. Grouped by what they change,
;; with the explanation on the row, they cost three slots and read as a
;; vocabulary. There is also room here for the correction commands, which
;; `docs/lane-handoff.md` says are next.
;; `new` is NOT here. Creating a symbol or a lane acts at the location the
;; breadcrumb names, so it lives on the location bar beside it rather than
;; among the commands that act on a cel. `ui/location`.
[menu/view
{:label "drawing" :title "what the lane exposes"
:note "select a lane, or a cel in one"
:items [{:label "new drawing" :disabled? (not lane?)
:sub "append a new independent drawing to the selected lane"
:on-click (act [::ui/append-drawing])}
{:label "insert" :disabled? (not insertable?)
:sub "a new drawing at the playhead; later drawings ripple later"
:on-click (act [::ui/insert-drawing])}
{:label "overwrite" :disabled? (not insertable?)
:sub "replace the drawing at the playhead; later drawings stay put"
:on-click (act [::ui/overwrite-drawing])}
{:label "reuse" :disabled? (not cel?)
:sub "expose this same drawing again — one drawing, two cels"
:on-click (act [::ui/reuse-drawing])}
{:label "duplicate" :disabled? (not cel?)
:sub "append a copy of this drawing, to draw the next one over it"
:on-click (act [::ui/duplicate-drawing])}
{:label "make unique" :disabled? (not shared?)
:sub "give this cel its own copy; other cels keep sharing"
:on-click (act [::ui/make-unique])}]}]
[menu/view
{:label "cel" :title "where this cel sits and how long it lasts"
:note "select a cel in the timeline or the cel sheet"
:items [{:label "split" :disabled? (not splittable?)
:sub "cut this cel in two at the playhead; the picture does not change"
:on-click (act [::ui/split-cel])}
{:label "trim in" :disabled? (not splittable?)
:sub "start this cel at the playhead; nothing else moves"
:on-click (act [::ui/trim-cel :in])}
{:label "trim out" :disabled? (not splittable?)
:sub "end this cel at the playhead; nothing else moves"
:on-click (act [::ui/trim-cel :out])}
{:label "move here" :disabled? (not (and cel? (integer? at)))
:sub "put this cel at the playhead; refused if something is there"
:on-click (act [::ui/move-cel])}
{:label "blank" :disabled? (not cel?)
:sub "clear this cel's frames, leaving a gap; later drawings stay put"
:on-click (act [::ui/blank-cel])}]}]
;; THE ONE PAIR THAT STAYS A BUTTON. Deciding how many frames a drawing is
;; held for is shooting on ones or twos — the most repeated edit in the
;; list, done by eye, a frame at a time. Two clicks into a menu per frame
;; would be the one place this consolidation made the tool worse.
[:span.stepper
[:span.stepper-label "hold"]
[:span.group
[:button {:disabled (not held?) :aria-label "hold −"
:title "shorten this cel; ripple later drawings, keeping lane keys fixed"
:on-click (act [::ui/extend-hold -1])} "−"]
[:button {:disabled (not held?) :aria-label "hold +"
:title "extend this cel; ripple later drawings, keeping lane keys fixed"
:on-click (act [::ui/extend-hold 1])} "+"]]]
[:span.spacer] [:span.spacer]
[:span.dim (str frame " / " frames)] ;; After the spacer, both of them: an offer that appears and a reading that
;; comes and goes must not shove the fixed controls sideways when they do.
(when @(rf/subscribe [::sub/lane-retry])
[:button.retry {:title "the command was refused because the shot is too short"
:on-click (act [::ui/lane-retry])} "extend shot and apply"])
;; Measured in the loop, not derived from the clock — the whole question ;; Measured in the loop, not derived from the clock — the whole question
;; while profiling is whether the painting keeps up with the clock, and a ;; while profiling is whether the painting keeps up with the clock, and a
;; number computed FROM the clock would answer itself. ;; number computed FROM the clock would answer itself. Shown only while it
[:span {:class (if (and drop (> drop 1.35)) "warn" "dim")} ;; has something to say: paused, it read "0.0 paint/s" for ever.
(str (.toFixed (or fps 0) 1) " paint/s" (when (pos? (or fps 0))
(when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]])) [:span.readout {:class (if (and drop (> drop 1.35)) "warn" "dim")}
(str (.toFixed fps 1) " paint/s"
(when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))])]))
(defn- takes? (defn- takes?
"Whether the row at `target`, a `target-kind` node, can take the row being "Whether the row at `target`, a `target-kind` node, can take the row being
@ -266,7 +416,7 @@
(memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"})))))) (memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"}))))))
(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of via]} (defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of via]}
selection over solo] selection over solo tracing]
(let [node? (= :node kind) (let [node? (= :node kind)
[over-path where] @over] [over-path where] @over]
[:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
@ -323,6 +473,17 @@
(when expandable? (if expanded? "▾" "▸"))] (when expandable? (if expanded? "▾" "▸"))]
[:span.name label] [:span.name label]
(when node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))]) (when node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))])
;; A face's row is where its own footage is switched on, next to solo
;; because the two are the same kind of thing: what this row shows, here,
;; now, and nothing the picture keeps. The bar above the stage does all of
;; them at once; this is how one face out of a take is singled out.
(when (contains? (:faces tracing) of)
[:button {:class (str "tl-trace" (when (contains? (:on tracing) of) " on"))
:title "show the footage this face was traced from"
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/trace-face of]))}
"T"])
(when (= :instance node-kind) (when (= :instance node-kind)
[:button {:class (str "tl-solo" (when (contains? solo path) " on")) [:button {:class (str "tl-solo" (when (contains? solo path) " on"))
:title "show only this on the stage (⇧ for more than one)" :title "show only this on the stage (⇧ for more than one)"
@ -341,7 +502,7 @@
"`sliding` is the pointer's side of a bar being dragged, `{:path :x :width "`sliding` is the pointer's side of a bar being dragged, `{:path :x :width
:df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every
row and the stage are drawn from already has in it." row and the stage are drawn from already has in it."
[{:keys [path span keys dense? kind node-kind select slides]} frames sliding] [{:keys [path span keys dense? kind node-kind select slides cels]} frames sliding]
(let [{from :path x0 :x width :width} @sliding (let [{from :path x0 :x width :width} @sliding
slide (fn [^js e] slide (fn [^js e]
(when (= path from) (when (= path from)
@ -362,7 +523,7 @@
:on-pointer-cancel (fn [_] (done false))} :on-pointer-cancel (fn [_] (done false))}
;; Clipped to the ruler: an instance longer than the room left in its ;; Clipped to the ruler: an instance longer than the room left in its
;; symbol still plays its own frames from 0, it is just cut off at the end. ;; symbol still plays its own frames from 0, it is just cut off at the end.
(when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])] (when-let [[in out] (when (and span (nil? cels)) [(max 0 (first span)) (min frames (second span))])]
(when (< in out) (when (< in out)
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
(when (= :audio node-kind) " sound") (when (= :audio node-kind) " sound")
@ -381,6 +542,22 @@
;; the browser has no record of. ;; the browser has no record of.
(try (.setPointerCapture track (.-pointerId e)) (try (.setPointerCapture track (.-pointerId e))
(catch :default _ nil)))))}])) (catch :default _ nil)))))}]))
(doall
(for [{:keys [id label source span select]} cels
:let [in (max 0 (first span)) out (min frames (second span))]
:when (< in out)]
^{:key (str id)}
[:button.tl-cel
{:title (str label " · select cel; double-click to edit shared drawing")
:style {:position "absolute" :left (edge% in frames)
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")
:top "2px" :bottom "2px" :overflow "hidden" :padding "0 3px"}
:on-click (fn [e] (.stopPropagation e)
(rf/dispatch [::ui/select select])
(rf/dispatch [::pb/seek (js/Math.floor in)]))
:on-double-click (fn [e] (.stopPropagation e)
(when source (rf/dispatch [::pb/open-symbol source])))}
label]))
;; A dense channel has a value on every frame, so ticking each one is a solid ;; A dense channel has a value on every frame, so ticking each one is a solid
;; block that says less than the bar behind it already does. ;; block that says less than the bar behind it already does.
(when-not dense? (when-not dense?
@ -388,7 +565,7 @@
(for [f keys :when (and (<= 0 f) (< f frames))] (for [f keys :when (and (<= 0 f) (< f frames))]
^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])) ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))]))
(defn view [] (defn- timeline-view []
(r/with-let [scrubbing (r/atom false) (r/with-let [scrubbing (r/atom false)
;; The row a carried row is over and which part of it, for the ;; The row a carried row is over and which part of it, for the
;; highlight. ;; highlight.
@ -402,6 +579,11 @@
drop @(rf/subscribe [::sub/drop]) drop @(rf/subscribe [::sub/drop])
solo (set @(rf/subscribe [::render/solo])) solo (set @(rf/subscribe [::render/solo]))
open @(rf/subscribe [::render/open]) open @(rf/subscribe [::render/open])
;; Which rows offer a footage switch, and which of them are switched
;; on. A set rather than a lookup per row: the answer is the same for
;; every placement of a face, because the switch is the face's.
tracing {:faces (set (trace/traceable-faces clip open))
:on (set (:faces @(rf/subscribe [::render/tracing])))}
;; Where a drag out of the pool would land, as a row of its own at the ;; Where a drag out of the pool would land, as a row of its own at the
;; top of its section: its own length, starting on the frame it would ;; top of its section: its own length, starting on the frame it would
;; start on. The stage's drop shows it too, at the playhead. ;; start on. The stage's drop shows it too, at the playhead.
@ -441,7 +623,7 @@
(doall (for [row visible] (doall (for [row visible]
(with-meta (if (= :section (:kind row)) (with-meta (if (= :section (:kind row))
[:div.tl-label.tl-section (:label row)] [:div.tl-label.tl-section (:label row)]
[label-cell row selection over solo]) [label-cell row selection over solo tracing])
{:key (str (:path row))})))] {:key (str (:path row))})))]
[:div.tl-tracks [:div.tl-tracks
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
@ -494,3 +676,56 @@
{:key (str (:path row))}))) {:key (str (:path row))})))
[:div.tl-empty "nothing in this symbol"]) [:div.tl-empty "nothing in this symbol"])
[:div.tl-playhead {:style {:left (at% frame frames)}}]]]]))) [:div.tl-playhead {:style {:left (at% frame frames)}}]]]])))
(defn cel-sheet
"The cel-sheet projection of one symbol: frames down, one column per lane.
It reuses `rows`, so its spans and selection addresses are exactly the ones
the timeline presents rather than a second interpretation of the document."
[clip sid frames]
(mapv (fn [{:keys [path label cels]}]
{:id (peek path)
:label label
:cells (mapv (fn [f]
(let [cel (some (fn [{[in out] :span :as cel}]
(when (and (<= in f) (< f out)) cel))
cels)]
{:frame f :lane (peek path) :cel cel}))
(range frames))})
(filter :cels (rows clip sid #{}))))
(defn- cel-sheet-view []
(let [clip @(rf/subscribe [::render/clip])
sid @(rf/subscribe [::render/open])
frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
frame @(rf/subscribe [::playback/frame])
selection @(rf/subscribe [::sub/selection])
columns (cel-sheet clip sid frames)
style {:grid-template-columns
(str "52px repeat(" (max 1 (count columns)) ", minmax(110px, 1fr))")}]
[:div.cel-sheet {:style style}
[:div.cs-head.cs-frame "frame"]
(doall (for [{:keys [id label]} columns]
^{:key (str "head-" id)} [:div.cs-head label]))
(doall
(for [f (range frames)
item (cons {:frame-label? true}
(map #(get-in % [:cells f]) columns))]
(if (:frame-label? item)
^{:key (str "frame-" f)}
[:button.cs-frame {:class (when (= f frame) "on")
:on-click #(rf/dispatch [::pb/seek f])} f]
(let [{:keys [id label select]} (:cel item)]
^{:key (str f "-" (:lane item) "-" (or id "gap"))}
[:button.cs-cell
{:class (str (when (= f frame) " current")
(when (and select (= select selection)) " selected"))
:title (if id (str label " · frame " f) (str "gap · frame " f))
:on-click (fn []
(rf/dispatch [::pb/seek f])
(when select (rf/dispatch [::ui/select select])))}
(or label "—")]))))]))
(defn view []
(if (= :cel-sheet @(rf/subscribe [::sub/time-view]))
[:section.pane.time [transport] [cel-sheet-view]]
[timeline-view]))

142
frontend/src/arthur/ui/underlay.cljs
View file

@ -2,18 +2,27 @@
"The footage a face is traced over, on its own canvas above the stage. "The footage a face is traced over, on its own canvas above the stage.
A REFERENCE, NOT OUTPUT. The tracing still never enters the indexed raster, so A REFERENCE, NOT OUTPUT. The tracing still never enters the indexed raster, so
it cannot reach an export, and it is drawn OVER the picture at the instance's it cannot reach an export, and it is drawn OVER the picture at the face's
opacity rather than under it, because the raster clears to an opaque ground. opacity rather than under it, because the raster clears to an opaque ground.
The canvas is the stage's size on screen, not the raster's, so a 1280px still The canvas is the stage's size on screen, not the raster's, so a 1280px still
is not squeezed through a 320px stage on its way to being seen. is not squeezed through a 320px stage on its way to being seen.
Painted by `ui/player` straight after each frame, from the same snapshot, so Painted by `ui/player` straight after each frame, from the same snapshot, so
it moves with the face it registers to — see `domain/trace/photo-matrix`." it moves with the face it registers to — see `domain/trace/photo-matrix`.
THREE THINGS KEEP IT STEADY, because a still is decoded asynchronously and the
frame it belongs to is already on screen by the time it arrives: the cache drops
the stills used longest ago rather than emptying itself, a face keeps showing
the still it last showed until its next one has decoded, and the stills a little
way ahead of the playhead are asked for before they are needed. Each is a
separate cause of the same symptom — the tracing blinking out for a frame or two
— and none of them covers the others: the hold is what survives a seek, the
reading ahead is what keeps playback from being a frame behind for good."
(:require [arthur.domain.symbol :as symbol] (:require [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
[arthur.flow.ingest :as ingest])) [arthur.flow.ingest :as ingest]))
(defonce ^:private state (atom {:canvas nil :urls {} :images {}})) (defonce ^:private state (atom {:canvas nil :urls {} :images {} :order [] :last {}}))
(defn set-canvas! [el] (swap! state assoc :canvas el)) (defn set-canvas! [el] (swap! state assoc :canvas el))
@ -37,45 +46,134 @@
scrubbing a face with no trace keys asks for every frame of the take." scrubbing a face with no trace keys asks for every frame of the take."
48) 48)
(def ^:private ^:const ahead
"Frames past the playhead whose stills are asked for while the current one is
drawn. A still cannot be decoded in the animation frame that wants it, so
playing a continuously traced face would otherwise always be a frame or two
behind its own footage."
8)
(defn- decoded
"`img` if the still has arrived and can be drawn."
[^js img]
(when (and (.-complete img) (pos? (.-naturalHeight img))) img))
(defn- touch!
"Hold `img` under `url` as the most recently used still, dropping the ones used
longest ago once there are more than `kept`.
LEAST RECENTLY USED, touched when it arrives and again on every frame it is
DRAWN, which is what makes it safe without a list of exceptions: the still on
screen is the newest thing in the cache and cannot be the one dropped — a still
held at a trace key for a hundred frames included. Read-and-not-drawn does not
touch, because a still read only to be warmed was just inserted anyway, and
reordering the whole list ten times per face per frame in the draw loop is the
kind of allocation `ui/player` exists to avoid. What this replaces emptied the
cache on the frame it filled, so every still on screen had to be fetched and
decoded again: a blink every `kept` frames of a scrub, and with two faces and a
full cache a permanent one."
[url img]
(swap! state
(fn [{:keys [images order] :as s}]
(let [images (assoc images url img)
order (conj (into [] (remove #{url}) order) url)
over (- (count order) kept)]
(if (pos? over)
(assoc s :images (apply dissoc images (subvec order 0 over))
:order (subvec order over))
(assoc s :images images :order order))))))
(defn- image (defn- image
"The still at `url`, or nil until it has loaded." "The still at `url`, or nil until it has loaded. Asks for it the first time it
is wanted; `on-ready` paints again once it is there.
A still that fails is remembered as having failed, so a broken URL is one
console line and one request rather than one of each per animation frame."
[url on-ready] [url on-ready]
(let [img (or (get-in @state [:images url]) (when url
(let [img (js/Image.)] (let [held (get-in @state [:images url])]
(cond
(= :failed held) nil
held (decoded held)
:else (let [img (js/Image.)]
(set! (.-onload img) on-ready) (set! (.-onload img) on-ready)
(set! (.-onerror img)
(fn [_]
(swap! state assoc-in [:images url] :failed)
(js/console.error "arthur: a tracing still did not load" url)))
(set! (.-src img) url) (set! (.-src img) url)
(swap! state update :images (touch! url img)
#(assoc (if (< (count %) kept) % {}) url img)) nil)))))
img))]
(when (and (.-complete img) (pos? (.-naturalHeight img))) img))) (defn- still
"The URL of the still showing the face's own frame `p`. The manifest is the
whole footage's and `p` is an index into the analysed range, so the range's
start is where the face's frame 0 was filmed."
[us start p]
(get us (+ start p)))
(defn- warm!
"Ask for the stills the next `ahead` frames will want. Held trace frames
collapse to the one still, so a face traced at keys asks for almost nothing.
WHILE PLAYING ONLY, because that is the only time the next frame is the one
after this one. A scrub asks for a different `ahead` frames at every step, so
reading ahead through one would be `ahead` requests per step for stills the
pointer has already gone past — and a cache thrashed by its own guesses."
[us start t lf on-ready]
(doseq [p (distinct (map #(trace/photo-frame t %) (range (inc lf) (+ lf 1 ahead))))]
(image (still us start p) on-ready)))
(defn paint! (defn paint!
"Draw every switched-on underlay on the frame `resolver` last resolved. It "Draw every switched-on face's footage on the frame `resolver` last resolved. It
says where each face's head went and which of its frames it was on, so this says where each face's head went and which of its frames it was on, so this
reads the frame rather than resolving it again. `on-ready` is called when a reads the frame rather than resolving it again. `on-ready` is called when a
still or a manifest that was missing arrives, to paint again." still or a manifest that was missing arrives, to paint again."
[{:keys [document store footage-id traces width]} resolver on-ready] [{:keys [document store footage-id traces opacity width playing?]} resolver on-ready]
(when-let [^js canvas (:canvas @state)] (when-let [^js canvas (:canvas @state)]
(let [ctx (.getContext canvas "2d") (let [ctx (.getContext canvas "2d")
zoom (/ (.-width canvas) width)] zoom (/ (.-width canvas) width)]
(.setTransform ctx 1 0 0 1 0 0) (.setTransform ctx 1 0 0 1 0 0)
(.clearRect ctx 0 0 (.-width canvas) (.-height canvas)) (.clearRect ctx 0 0 (.-width canvas) (.-height canvas))
;; What each face is showing, forgotten for the faces switched off. Before
;; the early exits, so switching them all off forgets all of them.
(swap! state update :last select-keys (map :path traces))
(when-let [us (and (seq traces) footage-id (urls footage-id on-ready))] (when-let [us (and (seq traces) footage-id (urls footage-id on-ready))]
(let [start (first (get-in document [:analysis :range] [0]))] (let [start (first (get-in document [:analysis :range] [0]))
(doseq [{:keys [path face opacity]} traces ;; Read once: each face writes only its own entry below, and what it
:let [at (conj path :head) ;; was showing is what it falls back to. A face that has been off
;; stage for a few frames still has the still it went away with.
was (:last @state)]
;; ONE OPACITY for all of them, set once: how strongly the reference
;; draws is a property of looking at the stage, not of a face.
(set! (.-globalAlpha ctx) opacity)
(doseq [{:keys [path face]} traces]
(let [at (conj path :head)
world (symbol/world-of resolver at) world (symbol/world-of resolver at)
frame (symbol/frame-of resolver at)] frame (symbol/frame-of resolver at)]
:when (and world (number? frame)) (when (and world (number? frame))
:let [head (get-in document [:symbols face :nodes :head]) (let [head (get-in document [:symbols face :nodes :head])
p (trace/photo-frame (trace/of head) (js/Math.floor frame)) t (trace/of head)
img (some-> (get us (+ start p)) (image on-ready)) lf (js/Math.floor frame)
want (trace/photo-frame t lf)
;; THE STILL IT HAS, not nothing. A frame whose still is
;; still decoding keeps the one before it — a reference a
;; frame stale, registered where that frame's face was,
;; rather than a face with its footage blinking off.
[img url p] (or (let [u (still us start want)]
(when-let [i (image u on-ready)] [i u want]))
(let [{:keys [url p]} (get was path)]
(when-let [i (image url on-ready)] [i url p])))
m (when img m (when img
(trace/photo-matrix world head store p (.-naturalHeight img)))] (trace/photo-matrix world head store p (.-naturalHeight img)))]
:when m] (when m
(set! (.-globalAlpha ctx) opacity) ;; Drawn, so it is the newest still in the cache and what
;; this face falls back to while its next one decodes.
(touch! url img)
(swap! state assoc-in [:last path] {:url url :p p})
(.setTransform ctx (.setTransform ctx
(* zoom (aget m 0)) (* zoom (aget m 1)) (* zoom (aget m 0)) (* zoom (aget m 1))
(* zoom (aget m 2)) (* zoom (aget m 3)) (* zoom (aget m 2)) (* zoom (aget m 3))
(* zoom (aget m 4)) (* zoom (aget m 5))) (* zoom (aget m 4)) (* zoom (aget m 5)))
(.drawImage ctx img 0 0))))))) (.drawImage ctx img 0 0))
(when playing? (warm! us start t lf on-ready)))))))))))

2
frontend/test/arthur/bench_test.cljs
View file

@ -24,7 +24,7 @@
(/ dt n)))) (/ dt n))))
(deftest bench (deftest bench
(let [res (symbol/resolver (clip/symbol @swarm/clip :main) @swarm/store pal/index-of) (let [res (symbol/resolver (clip/symbol @swarm/clip :main) @swarm/store pal/index-of nil)
ras (raster/make 320 200) ras (raster/make 320 200)
dest (js/Uint8ClampedArray. (* 320 200 4)) dest (js/Uint8ClampedArray. (* 320 200 4))
n 120] n 120]

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

@ -1,7 +1,8 @@
(ns arthur.domain.bring-test (ns arthur.domain.bring-test
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is]]
[arthur.domain.bring :as bring] [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip])) [arthur.domain.clip :as clip]
[arthur.domain.node :as node]))
(defn- nested (defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing." "Three symbols: :outer places :inner, and :loose is placed by nothing."
@ -21,6 +22,6 @@
(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 (:of (first (vals (get-in clip [:symbols :take :nodes]))))) (is (= #{:inner-2} (node/sources (first (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)))))

240
frontend/test/arthur/domain/channel_test.cljs
View file

@ -11,55 +11,55 @@
(deftest framed-is-the-same-value-at-every-frame (deftest framed-is-the-same-value-at-every-frame
(let [c (ch/framed :skin-dark)] (let [c (ch/framed :skin-dark)]
(is (= :framed (ch/describe c))) (is (= :framed (ch/describe c)))
(is (every? #(= :skin-dark (ch/value-at c %)) (range -5 20))))) (is (every? #(= :skin-dark (ch/value-at c % nil)) (range -5 20)))))
(deftest keyed-holds-until-the-next-key (deftest keyed-holds-until-the-next-key
;; Hold is the DEFAULT, not a special case: docs/design.md requires it of every ;; Hold is the DEFAULT, not a special case: docs/design.md requires it of every
;; cut part, and a tweened mouth reads as puppet software. ;; cut part, and a tweened mouth reads as puppet software.
(let [c (ch/keyed {0 :a, 4 :b, 12 :c})] (let [c (ch/keyed {0 :a, 4 :b, 12 :c} :hold)]
(is (= :keyed (ch/describe c))) (is (= :keyed (ch/describe c)))
(is (= [:a :a :a :a :b :b :b :b :b :b :b :b :c :c] (is (= [:a :a :a :a :b :b :b :b :b :b :b :b :c :c]
(mapv #(ch/value-at c %) (range 0 14)))))) (mapv #(ch/value-at c % nil) (range 0 14))))))
(deftest linear-vector-keys-interpolate-each-component (deftest linear-vector-keys-interpolate-each-component
(let [c (ch/keyed {0 [0.4 0.6], 10 [0.6 0.4]} :linear) (let [c (ch/keyed {0 [0.4 0.6], 10 [0.6 0.4]} :linear)
frames [0 5 10 5 2] frames [0 5 10 5 2]
cursor (ch/cursor c)] cursor (ch/cursor c nil)]
(is (empty? (ch/problems c))) (is (empty? (ch/problems c)))
(is (= [0.5 0.5] (ch/value-at c 5))) (is (= [0.5 0.5] (ch/value-at c 5 nil)))
(is (= (mapv #(ch/value-at c %) frames) (is (= (mapv #(ch/value-at c % nil) frames)
(mapv #(ch/sample! cursor %) frames))))) (mapv #(ch/sample! cursor %) frames)))))
(deftest one-channel-can-cut-then-tween (deftest one-channel-can-cut-then-tween
(let [c (assoc (ch/keyed {0 [0 0], 4 [4 0], 8 [8 0]}) (let [c (assoc (ch/keyed {0 [0 0], 4 [4 0], 8 [8 0]} :hold)
:segments {4 :linear}) :segments {4 :linear})
cursor (ch/cursor c)] cursor (ch/cursor c nil)]
(is (= [0 0] (ch/value-at c 2))) (is (= [0 0] (ch/value-at c 2 nil)))
(is (= [4 0] (ch/value-at c 4))) (is (= [4 0] (ch/value-at c 4 nil)))
(is (= [6 0] (ch/value-at c 6))) (is (= [6 0] (ch/value-at c 6 nil)))
(is (= (mapv #(ch/value-at c %) [0 2 4 6 8 3 7]) (is (= (mapv #(ch/value-at c % nil) [0 2 4 6 8 3 7])
(mapv #(ch/sample! cursor %) [0 2 4 6 8 3 7]))))) (mapv #(ch/sample! cursor %) [0 2 4 6 8 3 7])))))
(deftest a-frame-before-the-first-key-reads-the-first-key (deftest a-frame-before-the-first-key-reads-the-first-key
;; The JS activeKey clamps low, and that is kept: a channel's first key is the ;; The JS activeKey clamps low, and that is kept: a channel's first key is the
;; pose the part starts in. Having NO value is a different question — it is a ;; pose the part starts in. Having NO value is a different question — it is a
;; state bit, not an empty region of the key map. ;; state bit, not an empty region of the key map.
(let [c (ch/keyed {10 :a, 20 :b})] (let [c (ch/keyed {10 :a, 20 :b} :hold)]
(is (= :a (ch/value-at c 0))) (is (= :a (ch/value-at c 0 nil)))
(is (= :a (ch/value-at c 9))) (is (= :a (ch/value-at c 9 nil)))
(is (= :b (ch/value-at c 999)) "and clamps high by holding the last key"))) (is (= :b (ch/value-at c 999 nil)) "and clamps high by holding the last key")))
(deftest keys-are-a-map-so-frame-order-in-the-literal-cannot-matter (deftest keys-are-a-map-so-frame-order-in-the-literal-cannot-matter
;; Transit and JSON both lose sortedness, so the sorted index is built at read ;; Transit and JSON both lose sortedness, so the sorted index is built at read
;; time. A resolver that trusted insertion order would work in the REPL and ;; time. A resolver that trusted insertion order would work in the REPL and
;; fail after a round trip through the server, which is the worst possible way ;; fail after a round trip through the server, which is the worst possible way
;; to find out. ;; to find out.
(let [forward (ch/keyed (array-map 0 :a, 4 :b, 12 :c)) (let [forward (ch/keyed (array-map 0 :a, 4 :b, 12 :c) :hold)
backward (ch/keyed (array-map 12 :c, 4 :b, 0 :a)) backward (ch/keyed (array-map 12 :c, 4 :b, 0 :a) :hold)
shuffled (ch/keyed (array-map 4 :b, 12 :c, 0 :a))] shuffled (ch/keyed (array-map 4 :b, 12 :c, 0 :a) :hold)]
(doseq [c [backward shuffled]] (doseq [c [backward shuffled]]
(is (= (mapv #(ch/value-at forward %) (range 0 16)) (is (= (mapv #(ch/value-at forward % nil) (range 0 16))
(mapv #(ch/value-at c %) (range 0 16))))))) (mapv #(ch/value-at c % nil) (range 0 16)))))))
(deftest dense-reads-one-value-per-frame-out-of-a-typed-array (deftest dense-reads-one-value-per-frame-out-of-a-typed-array
(let [store {"blk" {:data (js/Int16Array. #js [0 0, 10 20, 30 40, 50 60]) :state nil}} (let [store {"blk" {:data (js/Int16Array. #js [0 0, 10 20, 30 40, 50 60]) :state nil}}
@ -148,7 +148,7 @@
"Sample one cursor at each of `fs` in the order given, which is the point: a "Sample one cursor at each of `fs` in the order given, which is the point: a
cursor carries state between calls." cursor carries state between calls."
[c fs] [c fs]
(let [cur (ch/cursor c)] (let [cur (ch/cursor c nil)]
(mapv #(ch/sample! cur %) fs))) (mapv #(ch/sample! cur %) fs)))
(deftest the-cursor-agrees-with-the-specification-in-any-frame-order (deftest the-cursor-agrees-with-the-specification-in-any-frame-order
@ -156,11 +156,30 @@
;; the WRONG POSE rather than an error, so nothing would report it: the mouth ;; the WRONG POSE rather than an error, so nothing would report it: the mouth
;; would simply be a beat behind on some frames and not others, which reads as ;; would simply be a beat behind on some frames and not others, which reads as
;; a bad take. ;; a bad take.
(doseq [[label c] [["sparse" (ch/keyed {0 :a, 4 :b, 12 :c, 13 :d, 40 :e})] (doseq [[label c] [["sparse" (ch/keyed {0 :a, 4 :b, 12 :c, 13 :d, 40 :e} :hold)]
["one key" (ch/keyed {7 :only})] ["one key" (ch/keyed {7 :only} :hold)]
["dense-ish" (ch/keyed (into {} (map (juxt identity #(* 10 %))) (range 40)))] ["dense-ish" (ch/keyed (into {} (map (juxt identity #(* 10 %))) (range 40)) :hold)]
["framed" (ch/framed :static)]]] ["framed" (ch/framed :static)]
(let [spec #(ch/value-at c %) ;; A stacked channel has a reading head per key map, and a
;; layer's head is asked for nothing at all across the long
;; stretches outside its support — then asked again. That is
;; the drift this test exists to catch, now squared.
["corrected"
(assoc (ch/keyed {0 0, 20 200, 44 440} :linear)
:over [(ch/layer :a [10 20] :offset
(ch/keyed {10 1, 19 90} :linear))])]
["corrected twice, and over a constant"
(assoc (ch/keyed {0 0, 30 300} :linear)
:over [(ch/layer :a [5 15] :offset (ch/framed 7))
(ch/layer :b [12 25] :replace
(ch/keyed {12 -1, 24 -12} :linear))
(ch/layer :c [20 44] :offset
(ch/keyed {20 0, 43 23} :linear))])]
["a corrected framed base"
(assoc (ch/framed 3)
:over [(ch/layer :a [8 36] :offset
(ch/keyed {8 0, 35 27} :linear))])]]]
(let [spec #(ch/value-at c % nil)
forward (range 0 45) forward (range 0 45)
back (reverse forward) back (reverse forward)
jumpy [0 44 1 43 12 12 13 3 40 7 0 22 22 21 44]] jumpy [0 44 1 43 12 12 13 3 40 7 0 22 22 21 44]]
@ -213,27 +232,122 @@
(is (= [1 2 3 4 5] (mapv #(ch/sample! cur %) (range 5)))) (is (= [1 2 3 4 5] (mapv #(ch/sample! cur %) (range 5))))
(is (= [5 1] (mapv #(ch/sample! cur %) [4 0])) "and seeks"))) (is (= [5 1] (mapv #(ch/sample! cur %) [4 0])) "and seeks")))
;; ---- what is deliberately not built has to fail loudly ---- ;; ---- correction layers ----
(deftest an-override-layer-is-refused-rather-than-ignored (defn- corrected
;; :over is specified in docs/animation-model.md and out of scope for this "A base channel with layers over it."
;; step. Dropping one silently would present as a hand correction that did not [base & layers]
;; take — a correction the user made once, watched fail, and has no reason to (assoc base :over (vec layers)))
;; trust again.
(let [c (assoc (ch/keyed {0 [0 0]}) :over [{:blend :offset :keys {0 [2 0]}}])] (deftest a-correction-applies-only-over-its-support
(is (thrown-with-msg? ExceptionInfo #":over" (ch/value-at c 0))) ;; THE property. A range says where an edit applies, so outside it the
(is (thrown-with-msg? ExceptionInfo #":over" (ch/cursor c))) ;; underlying animation must evaluate exactly as it did before — which is what
(is (seq (ch/problems c))))) ;; makes a bounded correction different from inserting boundary keys, and the
;; reason the stack exists at all.
(let [base (ch/keyed {0 0, 10 100} :linear)
c (corrected base (ch/layer :nudge [3 6] :offset (ch/framed 5)))
plain (mapv #(ch/value-at base % nil) (range 11))
with (mapv #(ch/value-at c % nil) (range 11))]
(is (= (concat (take 3 plain) [35 45 55] (drop 6 plain)) with))
(is (= (assoc plain 3 35 4 45 5 55) with) "and nothing else moved at all")))
(deftest a-return-motion-is-a-keyed-layer-and-a-constant-is-a-framed-one
;; The three commands the lane model asks for over one selected range, and
;; none of them needs a new way to say what a value is over time.
(let [base (ch/keyed {0 0} :hold)
at (fn [c] (mapv #(ch/value-at c % nil) (range 6)))]
(is (= [0 0 10 10 10 0]
(at (corrected base (ch/layer :flat [2 5] :offset (ch/framed 10)))))
"a constant adjustment")
(is (= [0 0 0 5 10 0]
(at (corrected base (ch/layer :ramp [2 5] :offset
(ch/keyed {2 0, 4 10} :linear)))))
"a ramp")
(is (= [0 0 0 10 0 0]
(at (corrected base (ch/layer :return [2 5] :offset
(ch/keyed {2 0, 3 10, 4 0} :linear)))))
"and a return motion, which is three samples and no new mechanism")))
(deftest the-stack-is-ordered-and-replace-wins-where-it-covers
(let [base (ch/keyed {0 1} :hold)
two (fn [a b] (mapv #(ch/value-at (corrected base a b) % nil) (range 4)))
add2 (ch/layer :a [0 4] :offset (ch/framed 2))
put9 (ch/layer :b [1 3] :replace (ch/framed 9))]
(is (= [3 9 9 3] (two add2 put9)) "the later layer sees the earlier one's result")
(is (= [3 11 11 3] (two put9 add2)) "and order therefore matters")))
(deftest validation-follows-the-shape-produced-by-an-ordered-stack
(let [base (ch/framed [0 0])
put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3]))
add2 (ch/layer :add2 [0 2] :offset (ch/framed [1 1]))
add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1]))]
(is (seq (ch/problems (corrected base put3 add2)))
"validation rejects a stack that would throw while reading")
(is (empty? (ch/problems (corrected base put3 add3)))
"a covering replacement establishes the shape seen by later layers")
(is (= [2 3 4] (ch/value-at (corrected base put3 add3) 0 nil)))))
(deftest generated-base-time-and-authored-correction-time-can-differ
(let [c (corrected (ch/keyed {0 0, 2 20} :hold)
(ch/layer :nudge [1 2] :offset (ch/framed 3)))
cursor (ch/cursor c nil)]
(is (= 3 (ch/value-at c 0 1 nil)))
(is (= 3 (ch/sample! cursor 0 1)))
(is (= 23 (ch/value-at c 2 1 nil)))
(is (= 20 (ch/sample! cursor 2 0)))))
(deftest replace-can-supply-a-value-where-offset-has-nothing-to-add-to
;; An absent value is not zero. `replace` states a pose; `offset` cannot
;; offset a pose that was never measured, and must not invent one.
(let [gone (ch/keyed {} :hold)]
(is (ch/nothing? (ch/value-at gone 0 nil)))
(is (ch/nothing? (ch/value-at (corrected gone (ch/layer :o [0 2] :offset (ch/framed 5))) 0 nil)))
(is (= 5 (ch/value-at (corrected gone (ch/layer :r [0 2] :replace (ch/framed 5))) 0 nil)))
;; And outside the support it is still absent, not the layer's value.
(is (ch/nothing? (ch/value-at (corrected gone (ch/layer :r [0 2] :replace (ch/framed 5))) 7 nil)))))
(deftest a-correction-offsets-geometry-component-wise-over-a-dense-base
;; The base a correction matters most for is generated, and a dense value is a
;; VIEW onto the block: offsetting must not write into it.
(let [data (js/Int16Array. #js [10 20, 30 40])
store {"blk" {:data data :state nil}}
base {:animated? true :dense {:store "blk" :offset 0 :stride 2 :frames 2}}
c (corrected base (ch/layer :nudge [1 2] :offset (ch/framed [5 -5])))]
(is (= [[10 20] [35 35]]
(mapv (fn [f] (let [v (ch/value-at c f store)]
[(ch/component v 0) (ch/component v 1)]))
(range 2))))
(is (= [10 20 30 40] (vec data)) "the block itself is untouched")
(is (thrown-with-msg?
ExceptionInfo #"different shape"
(ch/value-at (corrected base (ch/layer :bad [0 2] :offset (ch/framed 1))) 0 store))
"a correction of the wrong shape is loud, not silently dropped")))
(deftest a-malformed-correction-is-reported-rather-than-read
(let [ok (ch/layer :a [0 2] :offset (ch/framed 1))
base (ch/keyed {0 1} :hold)]
(is (empty? (ch/problems (corrected base ok))))
(is (seq (ch/problems (assoc base :over (list ok)))) "an ordered stack is a vector")
(doseq [[label bad] [["no id" (dissoc ok :id)]
["backwards support" (assoc ok :support [5 2])]
["open-ended support" (assoc ok :support [0 ##Inf])]
["a support that is not a pair" (assoc ok :support 3)]
["an unknown op" (assoc ok :op :multiply)]
["no values" (dissoc ok :values)]
["values that are not a channel" (assoc ok :values {:keys {0 1}})]
["layers under a layer"
(assoc ok :values (corrected base ok))]]]
(is (seq (ch/problems (corrected base bad))) label))))
(deftest an-empty-over-is-fine-and-is-what-scenes-carry (deftest an-empty-over-is-fine-and-is-what-scenes-carry
(is (empty? (ch/problems (ch/keyed {0 1})))) (is (empty? (ch/problems (ch/keyed {0 1} :hold))))
(is (= 1 (ch/value-at (ch/keyed {0 1}) 0)))) (is (= 1 (ch/value-at (ch/keyed {0 1} :hold) 0 nil))))
;; ---- shape validation ---- ;; ---- shape validation ----
(deftest problems-names-the-ways-a-channel-is-malformed (deftest problems-names-the-ways-a-channel-is-malformed
(is (empty? (ch/problems (ch/framed 1)))) (is (empty? (ch/problems (ch/framed 1))))
(is (empty? (ch/problems (ch/keyed {0 1})))) (is (empty? (ch/problems (ch/keyed {0 1} :hold))))
(testing "keys as a vector is the mistake most worth catching" (testing "keys as a vector is the mistake most worth catching"
(is (seq (ch/problems {:animated? true :keys [[0 1]]})))) (is (seq (ch/problems {:animated? true :keys [[0 1]]}))))
(is (seq (ch/problems {:value 1})) "no :animated?") (is (seq (ch/problems {:value 1})) "no :animated?")
@ -248,9 +362,9 @@
(deftest numeric-channels-can-ramp-between-keys (deftest numeric-channels-can-ramp-between-keys
(let [c (ch/keyed {0 0.0, 10 1.0} :linear) (let [c (ch/keyed {0 0.0, 10 1.0} :linear)
cursor (ch/cursor c)] cursor (ch/cursor c nil)]
(is (= [0.0 0.5 1.0 1.0] (is (= [0.0 0.5 1.0 1.0]
(mapv #(ch/value-at c %) [0 5 10 15]))) (mapv #(ch/value-at c % nil) [0 5 10 15])))
(is (= [0.0 0.5 1.0 0.2] (is (= [0.0 0.5 1.0 0.2]
(mapv #(ch/sample! cursor %) [0 5 10 2]))))) (mapv #(ch/sample! cursor %) [0 5 10 2])))))
@ -270,3 +384,45 @@
with (assoc base :generated {:by :roto/lips-outer :params {:verts 8}})] with (assoc base :generated {:by :roto/lips-outer :params {:verts 8}})]
(is (= (mapv #(ch/value-at base % store) (range 3)) (is (= (mapv #(ch/value-at base % store) (range 3))
(mapv #(ch/value-at with % store) (range 3)))))) (mapv #(ch/value-at with % store) (range 3))))))
(deftest a-correction-the-base-outgrew-is-a-conflict-and-not-a-problem
;; What a topology change does: a re-freeze gives the mouth a different number
;; of points, and a correction that was right when it was made can no longer
;; be added component by component. That is not a broken document — it is a
;; decision waiting for a person.
(let [pts (fn [n] {:animated? true :interp :hold :keys {0 (vec (repeat n 1))}})
nudge (ch/layer :nudge [0 4] :offset (ch/framed [1 1 1 1]))
fits (assoc (pts 4) :over [nudge])
outgrown (assoc (pts 6) :over [nudge])]
(is (nil? (ch/conflict-with (pts 4) nudge)))
(is (empty? (ch/conflicts fits)))
(is (empty? (ch/problems fits)))
(is (re-find #"different shape" (ch/conflict-with (pts 6) nudge)))
;; Unrecorded, it is an authoring bug and says so.
(is (seq (ch/problems outgrown)))
(is (= [:nudge] (mapv :id (ch/conflicts outgrown))))
;; Recorded, the document is sound and the correction is simply not applied.
(let [marked (assoc (pts 6) :over [(assoc nudge :conflict "outgrown")])]
(is (empty? (ch/problems marked)) "a recorded conflict is not a reason not to load")
(is (= [:nudge] (mapv :id (ch/conflicts marked))))
(is (= [1 1 1 1 1 1] (vec (ch/value-at marked 0 nil)))
"the base alone — neither misapplied nor silently dropped")
(is (= (ch/value-at marked 0 nil) (first (via-cursor marked [0])))
"and the cursor skips it too"))))
(deftest replace-never-conflicts-and-an-opaque-value-cannot-be-offset
(let [flag (ch/keyed {0 true} :hold)]
(is (nil? (ch/conflict-with flag (ch/layer :r [0 2] :replace (ch/framed false))))
"replace states a whole value, so it has nothing to agree with")
(is (re-find #"not a number" (ch/conflict-with flag (ch/layer :o [0 2] :offset (ch/framed 1)))))
(is (nil? (ch/conflict-with (ch/keyed {} :hold) (ch/layer :o [0 2] :offset (ch/framed 1))))
"an empty key map is not a disagreement")))
(deftest the-shape-of-a-channels-values-is-readable-without-sampling-it
(is (= :scalar (ch/value-shape (ch/framed 3))))
(is (= 2 (ch/value-shape (ch/framed [1 2]))))
(is (= :scalar (ch/value-shape {:animated? true :dense {:stride 1}})))
(is (= 40 (ch/value-shape {:animated? true :dense {:stride 40}})))
(is (= 2 (ch/value-shape (ch/keyed {0 [1 2], 4 [3 4]} :linear))))
(is (= :opaque (ch/value-shape (ch/keyed {0 :a} :hold))))
(is (nil? (ch/value-shape (ch/keyed {} :hold))) "nothing to read it off"))

179
frontend/test/arthur/domain/gesture_test.cljs
View file

@ -1,5 +1,6 @@
(ns arthur.domain.gesture-test (ns arthur.domain.gesture-test
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
@ -33,13 +34,13 @@
(defn- drawn [c path] (defn- drawn [c path]
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %)) (partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %))
((clip/resolver c nil pal/index-of :main) 16)))))))) ((clip/resolver c :main nil pal/index-of nil) 16))))))))
(defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b)))) (defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b))))
(defn- dragged [c path f vs-fn] (defn- dragged [c path f vs-fn]
(let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16) (let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame)] v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame nil)]
(gesture/apply-values c sid id frame (vs-fn pl v0)))) (gesture/apply-values c sid id frame (vs-fn pl v0))))
(deftest a-shape-two-symbols-down-moves-under-the-pointer (deftest a-shape-two-symbols-down-moves-under-the-pointer
@ -75,6 +76,174 @@
"the corner grabbed is under the pointer, through a turned, unevenly scaled parent") "the corner grabbed is under the pointer, through a turned, unevenly scaled parent")
(is (near? (at world 5 3) (at w2 5 3)) "about the pivot"))) (is (near? (at world 5 3) (at w2 5 3)) "about the pivot")))
;; ---------------------------------------------------------------------------
;; which way a corner drag goes
;;
;; `scale` takes the point under the pointer to the pointer, about the node's
;; PIVOT, and that is the whole of it — so which way a corner drag goes is
;; decided entirely by where the pivot is. With it in the middle of what the node
;; draws, where `clip/place-symbol`, `paint/new-shape` and now `flow/freeze` all
;; put it, pulling a corner away from the middle makes the node bigger. With it
;; at the node's coordinate ORIGIN, which is what a node with no anchor gets,
;; every corner drag is a drag away from some point off in the corner of the
;; footage: the shape shrinks and slides while the corner dutifully follows the
;; pointer, which is what the bug looked like from the outside.
(defn- at [m p] (let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 m (first p) (second p))))))
(defn- handles
"Where the stage would draw this node's box and pivot: its own bounds and
anchor through its `:world`, which is what `ui/stage`'s `handles` does."
[c st open path f]
(let [{:keys [sid id world frame]} (nest/placement c st open path f)
n (get-in c [:symbols sid :nodes id])
[x0 y0 x1 y1] ((pick/bounds-of c st n) frame)]
{:corners (mapv #(at world %) [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])
:pivot (at world (:anchor (gesture/values n frame st)))}))
(defn- span
"How big the box is, as the length of its diagonals — which does not care that
a turned parent leaves it off the screen's axes."
[{[a b c* d] :corners}]
(+ (js/Math.hypot (- (first c*) (first a)) (- (second c*) (second a)))
(js/Math.hypot (- (first d) (first b)) (- (second d) (second b)))))
(defn- corner-drag
"Drag corner `i` of the node's box by `d`, exactly as the stage does: read the
placement and the transform off the document AS IT IS NOW, scale from where
the pointer went down to where it is."
[c st open path f i d]
(let [{:keys [sid id frame] :as pl} (nest/placement c st open path f)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame st)
p0 (nth (:corners (handles c st open path f)) i)
p1 (mapv + p0 d)]
{:clip (gesture/apply-values c sid id frame (gesture/scale pl v0 p0 p1 false))
:p0 p0 :p1 p1}))
(defn- away
"A pull of `k` stage pixels straight away from the pivot, from corner `i`."
[{:keys [corners pivot]} i k]
(let [[dx dy] (mapv - (nth corners i) pivot)
len (max 1e-9 (js/Math.hypot dx dy))]
[(* k (/ dx len)) (* k (/ dy len))]))
(defn- middled
"`two-down` with the shape pivoting about the middle of what it draws — which
is what `paint/new-shape` writes and what `two-down` deliberately moves off, so
that the rest of this file is not accidentally testing the easy case."
[]
(let [c (two-down)]
(assoc-in c [:symbols :box :nodes :shape :channels [:xform :anchor]]
(ch/framed (pick/pivot c nil (get-in c [:symbols :box :nodes :shape]) [4])))))
(deftest dragging-a-corner-away-from-the-middle-makes-it-bigger
(doseq [[what c path f]
[["a shape on its own"
(paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow)
[:shape] 4]
["a shape two symbols down, through a turned and unevenly scaled parent"
(middled) [u v :shape] 16]]
i (range 4)]
(let [before (handles c nil :main path f)
out (corner-drag c nil :main path f i (away before i 6))
in (corner-drag c nil :main path f i (away before i -6))
grown (handles (:clip out) nil :main path f)
shrunk (handles (:clip in) nil :main path f)]
(is (< (span before) (span grown))
(str what ", corner " i ": pulled away from the middle it got smaller"))
(is (> (span before) (span shrunk))
(str what ", corner " i ": pushed towards the middle it got bigger"))
(is (near? (:p1 out) (nth (:corners grown) i))
(str what ", corner " i ": the corner grabbed is not under the pointer"))
(is (near? (:pivot before) (:pivot grown))
(str what ", corner " i ": the pivot moved")))))
(deftest a-corner-pulled-up-and-left-grows-up-and-left
;; The report, literally: no turned parent in the way, so the box's corners are
;; the screen's, and the top-left one dragged further top-left has to make the
;; box bigger rather than smaller.
(let [c (paint/new-shape (clip/blank) :main :shape 4 [100 80 140 80 140 110 100 110] :brow)
before (handles c nil :main [:shape] 4)
after (handles (:clip (corner-drag c nil :main [:shape] 4 0 [-10 -10]))
nil :main [:shape] 4)
[tl _ br _] (:corners after)]
(is (= [100 80] (first (:corners before))) "corner 0 is the top left")
(is (near? [90 70] tl) "the corner grabbed is under the pointer")
(is (and (> (first br) 140) (> (second br) 110))
"and the far corner went the other way, about the middle")
(is (< (span before) (span after)) "so the shape is bigger")))
(deftest a-face-part-scales-about-its-own-middle
;; The whole measured rig, from `demo/take`: source-space geometry under a
;; dense head similarity, under the authored source placement, inside an
;; instance. Before `freeze/pivoted` the mouth's pivot sat at (-234, -395) on a
;; 320x200 stage — the top-left corner of the FOOTAGE, carried onto the stage —
;; and every corner drag was a drag away from it.
(let [{c :clip st :store} @take/frozen
f 10]
(doseq [path [[:face-1] [:face-1 :mouth] [:face-1 :eye-r]]]
(let [before (handles c st :main path f)
[px py] (:pivot before)]
(is (and (< 0 px (:width c)) (< 0 py (:height c)))
(str path "'s pivot " (pr-str (:pivot before)) " is off the stage"))
(doseq [i (range 4)]
(let [out (corner-drag c st :main path f i (away before i 8))
grown (handles (:clip out) st :main path f)]
(is (< (span before) (span grown))
(str path ", corner " i " pulled away from the middle got smaller"))
(is (near? (:p1 out) (nth (:corners grown) i))
(str path ", corner " i " is not under the pointer"))
(is (near? (:pivot before) (:pivot grown))
(str path ", corner " i ": the pivot moved"))))))))
(deftest every-node-in-a-face-can-have-its-transform-read
;; What a click near the eyes hit, and it took the stage down with it — in
;; `begin!` selecting the node, and again in `handles` drawing its pivot
;; cross. `values` asked its channels for a value WITHOUT the tier-2 store,
;; which is fine for every hand-placed node and throws the moment one of them
;; is dense: an iris follows the gaze, a brow follows the raise, a head
;; follows the measured similarity, and all three are ordinary things to
;; select. Over every node of a real take, so a new dense channel on any of
;; them is covered the day it is added.
(let [{c :clip st :store} @take/frozen]
(doseq [sid [:main :face-1]
[id n] (get-in c [:symbols sid :nodes])]
(let [v (gesture/values n 10 st)]
(is (map? v) (str sid "/" id " could not be read at all"))
(is (every? #(or (number? %) (ch/nothing? %))
(concat (:pos v) (:scale v) (:anchor v) [(:rot v)]))
(str sid "/" id " did not read as numbers: " (pr-str v))))
(when (node/measured? n)
(is (thrown? js/Error (gesture/values n 10 nil))
(str sid "/" id " has a dense transform, so reading it storeless"
" has to throw — otherwise this test proves nothing"))
(is (string? (gesture/refusal n))
(str sid "/" id " is measured but a drag on it is not refused"))))))
(deftest a-drag-starts-from-the-document-as-it-is-now
;; What `ui/stage`'s `loaded` is for. A drag reads the placement and the
;; transform when the pointer goes DOWN; reading them when the overlay last
;; rendered is the same code with a clip in it that predates the last edit, and
;; this is what that costs — the node is put back where it was before the
;; previous drag and only then moved, so it sits still under the press and
;; jumps on the first pointermove. Two drags have to compose.
(let [c (two-down)
path [u v :shape]
once (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26]))
twice (dragged once path 16 #(gesture/move %1 %2 [30 30] [33 31]))
;; The same second drag, begun from the clip as it was BEFORE the first.
stale (let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame nil)]
(gesture/apply-values once sid id frame
(gesture/move pl v0 [30 30] [33 31])))]
(is (near? (map (fn [[x y]] [(+ x 10) (- y 3)]) (drawn c path)) (drawn twice path))
"(7, -4) then (3, 1) leaves the shape moved by (10, -3)")
(is (near? (map (fn [[x y]] [(+ x 3) (+ y 1)]) (drawn c path)) (drawn stale path))
"begun from the stale clip it lands where the FIRST drag never happened")
(is (not (near? (drawn twice path) (drawn stale path)))
"which is the jump, and it is the whole of the difference")))
(deftest a-drag-keys-a-keyed-channel-and-sets-a-framed-one (deftest a-drag-keys-a-keyed-channel-and-sets-a-framed-one
(let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]] (let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]]
(constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear))) (constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear)))
@ -90,7 +259,7 @@
(deftest a-measured-transform-is-not-set-by-hand (deftest a-measured-transform-is-not-set-by-hand
(is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}}))) (is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
(is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]})}})))) (is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]} :hold)}}))))
(deftest a-click-selects-the-level-figma-would (deftest a-click-selects-the-level-figma-would
(let [hit [:a :b :c :shape]] (let [hit [:a :b :c :shape]]
@ -118,5 +287,5 @@
(deftest an-instances-box-is-what-its-symbol-draws (deftest an-instances-box-is-what-its-symbol-draws
(let [c (two-down) (let [c (two-down)
{:keys [frame]} (nest/placement c nil :main [u v] 16)] {:keys [frame]} (nest/placement c nil :main [u v] 16)]
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :mid :nodes v]) frame))) (is (= [0 0 10 10] ((pick/bounds-of c nil (get-in c [:symbols :mid :nodes v])) frame)))
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :box :nodes :shape]) 4))))) (is (= [0 0 10 10] ((pick/bounds-of c nil (get-in c [:symbols :box :nodes :shape])) 4)))))

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

@ -17,7 +17,7 @@
:nodes {:root {:id :root :kind :group :z "a1"} :nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root :z "a1" :mark {:id :mark :kind :rect :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0] :channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
2 [20 0] 3 [30 0]}) 2 [20 0] 3 [30 0]} :hold)
[:geom :size] (ch/framed 4) [:geom :size] (ch/framed 4)
[:style :color] (ch/framed :brow)}}}}}}) [:style :color] (ch/framed :brow)}}}}}})
@ -27,16 +27,18 @@
(assoc-in [:symbols :main] (assoc-in [:symbols :main]
{:id :main :frames 6 {:id :main :frames 6
:nodes {:root {:id :root :kind :group :z "a1"} :nodes {:root {:id :root :kind :group :z "a1"}
:left {:id :left :kind :instance :of :sym/test :left {:id :left :kind :instance
:parent :root :z "a1" :span [0 4] :parent :root :z "a1" :span [0 4]
:source {:symbol :sym/test}
:channels {[:xform :pos] (ch/framed [100 50])}} :channels {[:xform :pos] (ch/framed [100 50])}}
:right {:id :right :kind :instance :of :sym/test :right {:id :right :kind :instance
:parent :root :z "a2" :span [0 4] :parent :root :z "a2" :span [0 4]
:time {:mode :map :at 2 :rate 1} :time {:mode :map :at 2 :rate 1}
:source {:symbol :sym/test}
:channels {[:xform :pos] (ch/framed [120 50])}}}}) :channels {[:xform :pos] (ch/framed [120 50])}}}})
(assoc-in [:symbols :sym/test] (assoc-in [:symbols :sym/test]
(assoc (get-in source [:symbols :main]) :id :sym/test))) (assoc (get-in source [:symbols :main]) :id :sym/test)))
resolve (clip/resolver document nil pal/index-of :main) resolve (clip/resolver document :main nil pal/index-of nil)
at (fn [f] (mapv (juxt :node :cx) (resolve f)))] at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
(is (empty? (clip/problems document))) (is (empty? (clip/problems document)))
(is (= [[[:left :mark] 110]] (at 1))) (is (= [[[:left :mark] 110]] (at 1)))
@ -46,13 +48,14 @@
(deftest a-placement-holds-and-cuts-each-generated-shape-independently (deftest a-placement-holds-and-cuts-each-generated-shape-independently
(let [values (js/Int16Array. (clj->js (range 2 32))) (let [values (js/Int16Array. (clj->js (range 2 32)))
visible (ch/keyed {0 true 20 true 21 false}) visible (ch/keyed {0 true 20 true 21 false} :hold)
dense {:animated? true :interp :hold dense {:animated? true :interp :hold
:dense {:store "sizes" :offset 0 :stride 1 :frames 30} :dense {:store "sizes" :offset 0 :stride 1 :frames 30}
:pose-sampled? true} :pose-sampled? true
:over [(ch/layer :nudge [7 8] :offset (ch/framed 100))]}
shape (fn [id z group] shape (fn [id z group]
{:id id :kind :rect :parent :root :z z :pose-group group {:id id :kind :rect :parent :root :z z :pose-group group
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]}) :channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]} :hold)
[:geom :size] dense [:geom :size] dense
[:vis] (assoc visible :pose-sampled? true) [:vis] (assoc visible :pose-sampled? true)
[:style :color] (ch/framed :brow)}}) [:style :color] (ch/framed :brow)}})
@ -66,53 +69,54 @@
:symbols :symbols
{:main {:id :main :frames 30 {:main {:id :main :frames 30
:nodes {:root {:id :root :kind :group :z "a1"} :nodes {:root {:id :root :kind :group :z "a1"}
:first {:id :first :kind :instance :of :sym/poses :first {:id :first :kind :instance
:parent :root :z "a1" :parent :root :z "a1"
:source {:symbol :sym/poses}
:playback {:tracks {:mouth {0 0, 8 20, 9 21} :playback {:tracks {:mouth {0 0, 8 20, 9 21}
[:node :mouth-detail] {0 0, 8 4} [:node :mouth-detail] {0 0, 8 4}
:eye {0 0, 4 4}}}} :eye {0 0, 4 4}}}}
:second {:id :second :kind :instance :of :sym/poses :second {:id :second :kind :instance
:parent :root :z "a2" :parent :root :z "a2"
:source {:symbol :sym/poses}
:playback {:tracks {:mouth {0 0, 8 8}}}}}} :playback {:tracks {:mouth {0 0, 8 8}}}}}}
:sym/poses symbol}} :sym/poses symbol}}
resolve (clip/resolver document {"sizes" {:data values}} pal/index-of :main) store {"sizes" {:data values}}
low-resolve (clip/resolver document {"sizes" {:data values}} resolve (clip/resolver document :main store pal/index-of nil)
pal/index-of :main {:picture-fps 8}) low-resolve (clip/resolver document :main store pal/index-of {:picture-fps 8})
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f))) at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))
low-at (fn [f] (into {} (map (fn [op] [(:node op) op])) (low-resolve f)))] low-at (fn [f] (into {} (map (fn [op] [(:node op) op])) (low-resolve f)))]
(is (empty? (clip/problems document))) (is (empty? (clip/problems document)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document)))) (is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (= 2 (:size (get (at 7) [:first :mouth]))) "eight static frames") (is (= 102 (:size (get (at 7) [:first :mouth]))) "eight static frames, plus its correction")
(is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20") (is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20")
(is (= 6 (:size (get (at 8) [:first :mouth-detail]))) (is (= 6 (:size (get (at 8) [:first :mouth-detail])))
"one node may depart from its shared mouth group") "one node may depart from its shared mouth group")
(is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8") (is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8")
(is (= 6 (:size (get (at 7) [:first :eye]))) "eye has its own timing") (is (= 106 (:size (get (at 7) [:first :eye]))) "eye has its own timing")
(is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time") (is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time")
(is (nil? (get (at 9) [:first :mouth])) (is (nil? (get (at 9) [:first :mouth]))
"generated visibility is read from the same selected pose") "generated visibility is read from the same selected pose")
(is (some? (get (at 9) [:second :mouth]))) (is (some? (get (at 9) [:second :mouth])))
(is (= 5 (:size (get (low-at 7) [:first :brow]))) (is (= 105 (:size (get (low-at 7) [:first :brow])))
"picture rate samples only generated motion") "picture rate samples the generated base and leaves correction time alone")
(is (= 22 (:size (get (low-at 8) [:first :mouth]))) (is (= 22 (:size (get (low-at 8) [:first :mouth])))
"an explicit cut occurs at its exact local frame, even off the picture grid") "an explicit cut occurs at its exact local frame, even off the picture grid")
(is (= 8 (:cx (get (low-at 8) [:first :eye]))) (is (= 8 (:cx (get (low-at 8) [:first :eye])))
"authored position ignores the picture grid") "authored position ignores the picture grid")
(let [sym (get-in document [:symbols :sym/poses]) (let [sym (get-in document [:symbols :sym/poses])
opts {:source-fps 30 :picture-fps 8}] opts {:source-fps 30 :picture-fps 8 :pose-tracks {:mouth {0 0, 8 20}}}]
(is (= (mapv #(select-keys % [:node :cx :size]) (is (= (mapv #(select-keys % [:node :cx :size])
(symbol/eval-frame sym 8 {"sizes" {:data values}} (symbol/eval-frame sym 8 store pal/index-of opts))
pal/index-of {:mouth {0 0, 8 20}} opts))
(mapv #(select-keys % [:node :cx :size]) (mapv #(select-keys % [:node :cx :size])
((symbol/resolver sym {"sizes" {:data values}} ((symbol/resolver sym store pal/index-of opts) 8)))
pal/index-of {:mouth {0 0, 8 20}} opts) 8)))
"pure evaluation and playback apply the same pose choice")))) "pure evaluation and playback apply the same pose choice"))))
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save (deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
(let [document (-> source (let [document (-> source
(assoc-in [:symbols :main :nodes :placed] (assoc-in [:symbols :main :nodes :placed]
{:id :placed :kind :instance :of :sym/test :parent :root {:id :placed :kind :instance :parent :root
:z "a2"}) :z "a2"
:source {:symbol :sym/test}})
(assoc-in [:symbols :sym/test] (assoc-in [:symbols :sym/test]
{:id :sym/test :frames 4 {:id :sym/test :frames 4
:nodes {:root {:id :root :kind :group :z "a1"} :nodes {:root {:id :root :kind :group :z "a1"}
@ -155,8 +159,8 @@
(let [document (stage/compose source)] (let [document (stage/compose source)]
(is (empty? (clip/problems document))) (is (empty? (clip/problems document)))
(is (= #{:main :sym/face-8625} (set (keys (:symbols document))))) (is (= #{:main :sym/face-8625} (set (keys (:symbols document)))))
(is (= :sym/face-8625 (:of (placement document :left)))) (is (= #{:sym/face-8625} (node/sources (placement document :left))))
(is (= :sym/face-8625 (:of (placement document :right)))) (is (= #{:sym/face-8625} (node/sources (placement document :right))))
(testing "every placement is keyed by its own uuid" (testing "every placement is keyed by its own uuid"
;; The identity change: seven placements of one drawing are seven things, ;; The identity change: seven placements of one drawing are seven things,
;; and each is named by something that means only itself. Sharing a key, or ;; and each is named by something that means only itself. Sharing a key, or
@ -167,7 +171,7 @@
(is (every? uuid? (map key symbols))) (is (every? uuid? (map key symbols)))
(is (= 7 (count (distinct (map key symbols))))) (is (= 7 (count (distinct (map key symbols)))))
(testing "and each still says which drawing it plays and what to call it" (testing "and each still says which drawing it plays and what to call it"
(is (every? #(= :sym/face-8625 (:of (val %))) symbols)) (is (every? #(= #{:sym/face-8625} (node/sources (val %))) symbols))
(is (every? #(string? (:name (val %))) symbols)) (is (every? #(string? (:name (val %))) symbols))
(is (= 7 (count (distinct (map #(:name (val %)) symbols)))))))) (is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :instance (:kind %)) (is (= 7 (count (filter #(= :instance (:kind %))
@ -178,15 +182,15 @@
scale (get-in left [:channels [:xform :scale]]) scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value]) anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]]) pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0)] start-pos (ch/value-at pos 0 nil)]
(is (= [160 100] anchor) "the source center becomes a stored pivot") (is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos)) (is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40)) "the face drifts during playback") (is (not= start-pos (ch/value-at pos 40 nil)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0))) (is (= [0.4 0.4] (ch/value-at scale 0 nil)))
(is (= [0.56 0.56] (ch/value-at scale 12))) (is (= [0.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48))) (is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]] (doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f) [0 0] anchor) (let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f nil) [0 0] anchor)
out (js/Float64Array. 2)] out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100) (node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)]) (is (= [40 40] [(aget out 0) (aget out 1)])
@ -200,10 +204,10 @@
(is (= [48 260] (node/placed-span (placement document :voice-right)))) (is (= [48 260] (node/placed-span (placement document :voice-right))))
(is (= 0.5 (ch/value-at (is (= 0.5 (ch/value-at
(get-in (placement document :voice-right) (get-in (placement document :voice-right)
[:channels [:audio :gain]]) 54))) [:channels [:audio :gain]]) 54 nil)))
(is (< -0.8 (ch/value-at (is (< -0.8 (ch/value-at
(get-in (placement document :voice-right) (get-in (placement document :voice-right)
[:channels [:audio :pan]]) 110) 0.7)) [:channels [:audio :pan]]) 110 nil) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document)))))) (is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- nested (defn- nested
@ -223,7 +227,7 @@
(is (= :main (clip/opens-on (clip/blank))))) (is (= :main (clip/opens-on (clip/blank)))))
(testing "an instance can go into any symbol, and spans that symbol's frames" (testing "an instance can go into any symbol, and spans that symbol's frames"
(let [[n] (vals (get-in c [:symbols :outer :nodes]))] (let [[n] (vals (get-in c [:symbols :outer :nodes]))]
(is (= :inner (:of n))) (is (= #{:inner} (node/sources n)))
(is (= [0 10] (:span n)) "its own frames: all of what it places, from its own 0") (is (= [0 10] (:span n)) "its own frames: all of what it places, from its own 0")
(is (= [5 15] (node/placed-span n)) "and where that lands in the symbol it is in"))) (is (= [5 15] (node/placed-span n)) "and where that lands in the symbol it is in")))
(testing "placing is refused when it would make a cycle" (testing "placing is refused when it would make a cycle"
@ -248,14 +252,17 @@
(is (= {:id :symbol-1 :name "symbol-1" :frames 180 :nodes {}} (is (= {:id :symbol-1 :name "symbol-1" :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, and as long as the rest of what it was placed in")
(is (= {:of :symbol-1 :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]) [:of :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])))
"and it places the symbol it just made")
(is (empty? (clip/problems made))) (is (empty? (clip/problems made)))
(is (= c (clip/new-symbol c :outer :inner 0 u)) "an id already in use is refused") (is (= c (clip/new-symbol c :outer :inner 0 u)) "an id already in use is refused")
(is (= c (clip/new-symbol c :outer id 200 u)) "past the end is refused"))) (is (= c (clip/new-symbol c :outer id 200 u)) "past the end is refused")))
(deftest an-instance-span-is-in-its-own-frames (deftest an-instance-span-is-in-its-own-frames
(let [n {:id :i :kind :instance :of :x :z "a1" :span [3 13] (let [n {:id :i :kind :instance :z "a1" :span [3 13]
:source {:symbol :x}
:time {:mode :map :at 40 :rate 2}}] :time {:mode :map :at 40 :rate 2}}]
(is (= [41.5 46.5] (node/placed-span n)) "own frames 3 to 13, at double rate, from 40") (is (= [41.5 46.5] (node/placed-span n)) "own frames 3 to 13, at double rate, from 40")
(is (= 0 (node/local-frame n 40)) "the parent's :at is where its own frame 0 lands") (is (= 0 (node/local-frame n 40)) "the parent's :at is where its own frame 0 lands")

622
frontend/test/arthur/domain/lane_test.cljs Normal file
View file

@ -0,0 +1,622 @@
(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.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))}}))
(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 n) 2)
((pick/bounds-of doc nil (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 splitting-an-cel-changes-nothing-that-is-drawn
(let [doc (document)
fs (range 12)
before (drawn doc fs)]
(doseq [[label id cut] [["a held drawing" :a 2]
["a cel with a correction of its own" :b 6]
["a playing insert" :insert 10]]]
(testing label
(let [r (lane/split doc :main id cut :right)
after (:clip r)]
(is (= :right (:selection r)))
(is (= before (drawn after fs)) "the same picture, frame for frame")
(is (= (node/placed-span (get-in doc [:symbols :main :nodes id]))
[(first (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 cel 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])))))
(is (= (:time (get-in doc [:symbols :main :nodes id]))
(: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])
(select-keys (get-in after [:symbols :main :nodes :right]) [:source :playback :channels])))
(is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question")
(is (empty? (clip/problems after))))))))
(deftest split-refuses-anything-that-is-not-one-cut-inside-one-cel
(let [doc (document)]
(doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]]
(is (:refused (lane/split doc :main :b cut :right)) (str "cut at " (pr-str cut))))
(is (:refused (lane/split doc :main :girl 2 :right)) "a lane is not a cel")
(is (:refused (lane/split doc :main :plate 2 :right)) "nor is a shape outside one")
(is (:refused (lane/split doc :main :a 2 :b)) "the new ID has to be free")))
(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 (lane/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 trimming-narrows-one-cel-and-moves-nothing-else
(let [doc (document)
r (lane/trim doc :main :b :out 6)
after (:clip r)]
(is (= [[0 4] [4 6] [8 12]] (spans after [:a :b :insert])))
(is (= :b (:selection r)))
(is (= (select-keys (get-in doc [:symbols :main :nodes :b]) [:time :playback :channels :source])
(select-keys (get-in after [:symbols :main :nodes :b]) [:time :playback :channels :source]))
"only :span changed")
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest trimming-the-front-of-a-playing-insert-does-not-restart-it
;; The difference between trimming and slipping. Its own frames are where they
;; were, so the frames that survive show exactly what they showed.
(let [doc (document)
before (sample doc [10 11])
after (:clip (lane/trim doc :main :insert :in 10))]
(is (= [10 12] (node/placed-span (get-in after [:symbols :main :nodes :insert]))))
(is (= (:playback (get-in doc [:symbols :main :nodes :insert]))
(:playback (get-in after [:symbols :main :nodes :insert]))))
(is (= before (sample after [10 11])) "the same animation on the frames it kept")
;; And the frames it gave up show nothing of it.
(is (= #{:plate} (set (keys (get (sample after [9]) 9)))))))
(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge
(let [doc (document)]
(doseq [[label edge to] [["at its own start" :in 4]
["at its own end" :out 8]
["past its end" :out 9]
["before its start" :in 2]
["off a whole frame" :out 5.5]]]
(is (:refused (lane/trim doc :main :b edge to)) label))
(is (:refused (lane/trim doc :main :b :middle 6)))
(is (:refused (lane/trim doc :main :girl :out 6)) "a lane is not a cel")))
(deftest moving-an-cel-keeps-its-length-and-its-source-origin
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
r (lane/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)))))
(deftest a-move-onto-an-occupied-frame-is-refused-rather-than-rippled
(let [doc (document)]
(is (:refused (lane/move doc :main :insert 6)) "it would overlap B")
(is (:refused (lane/move doc :main :insert 4.5)))
(is (:refused (lane/move doc :main :girl 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 (lane/move cleared :main :insert 4))
[:a :insert]))))))
(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 (lane/trim doc :main :insert :out 9))
[:symbols :main :frames]))
"and trimming the last cel leaves the window where it was")))

12
frontend/test/arthur/domain/leaf_test.cljs
View file

@ -34,7 +34,12 @@
;; No node leaves, and still `:nodes {}`: nil there is what `symbol/nodes-of` ;; No node leaves, and still `:nodes {}`: nil there is what `symbol/nodes-of`
;; refuses, so a saved blank document would not open. ;; refuses, so a saved blank document would not open.
(is (= (get-in (clip/blank) [:symbols :main]) (is (= (get-in (clip/blank) [:symbols :main])
(get-in (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))) [:symbols :main])))) (get-in (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))) [:symbols :main])))
;; And the WHOLE blank document, not only its symbol. An empty field that the
;; codec cannot write is an empty field it cannot restore, so a blank document
;; carrying one comes back unequal to itself — which undo, whose steps are
;; leaves, then reports as a document change nobody made.
(is (= (clip/blank) (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))))))
(deftest the-leaves-are-the-paths-the-sync-design-names (deftest the-leaves-are-the-paths-the-sync-design-names
(let [ls (leaf/leaves :c7 @take/clip)] (let [ls (leaf/leaves :c7 @take/clip)]
@ -115,8 +120,9 @@
;; right in a log and resolves nothing: `:linked-to` dangles and an export target ;; right in a log and resolves nothing: `:linked-to` dangles and an export target
;; matches no node, with no error anywhere. ;; matches no node, with no error anywhere.
(let [u #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218" (let [u #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
c (one-symbol {u {:id u :kind :instance :of :sym/face-8625 :parent nil c (one-symbol {u {:id u :kind :instance :parent nil
:z "a1" :name "8625 bottom left"}}) :z "a1" :name "8625 bottom left"
:source {:symbol :sym/face-8625}}})
ls (leaf/leaves :c1 c)] ls (leaf/leaves :c1 c)]
(is (contains? ls (str "clip/c1/symbol/main/node/" u)) (is (contains? ls (str "clip/c1/symbol/main/node/" u))
"written plainly, with no sigil") "written plainly, with no sigil")

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

@ -40,7 +40,7 @@
{:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn) {:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn)
c (paint/new-shape c sid :shape frame pts :brow) c (paint/new-shape c sid :shape frame pts :brow)
[op] (filter #(= [u :shape] (:node %)) [op] (filter #(= [u :shape] (:node %))
((clip/resolver c nil pal/index-of :main) 16))] ((clip/resolver c :main nil pal/index-of nil) 16))]
(is (= :box sid)) (is (= :box sid))
(is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10") (is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10")
(is (every? #(< (js/Math.abs %) 1e-9) (is (every? #(< (js/Math.abs %) 1e-9)
@ -64,7 +64,7 @@
(turn :mid v [5 -3] 0.3 1.5) (turn :mid v [5 -3] 0.3 1.5)
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow)) (paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow))
draw #(take 6 (array-seq (:pts (first (filter (fn [op] (= [u v :shape] (:node op))) draw #(take 6 (array-seq (:pts (first (filter (fn [op] (= [u v :shape] (:node op)))
((clip/resolver % nil pal/index-of :main) 16)))))) ((clip/resolver % :main nil pal/index-of nil) 16))))))
{:keys [frame matrix time]} (nest/inside c nil :main [u v :shape] 16) {:keys [frame matrix time]} (nest/inside c nil :main [u v :shape] 16)
out (js/Float64Array. 2) out (js/Float64Array. 2)
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y)))) seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
@ -86,15 +86,15 @@
(deftest a-placed-symbols-sound-is-heard-where-it-is-placed (deftest a-placed-symbols-sound-is-heard-where-it-is-placed
(let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1" (let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1"
:span [10 40] :time {:mode :map :at -10 :rate 1} :span [10 40] :time {:mode :map :at -10 :rate 1}
:channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}} :channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0} :hold)}}
c (-> (clip/blank) c (-> (clip/blank)
(assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}}) (assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}})
(clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil)) (clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil))
[t] (nest/audio-tracks c :main)] [t] (nest/audio-tracks c :main)]
(is (= [10 40] (:span t)) "the same frames of the source") (is (= [10 40] (:span t)) "the same frames of the source")
(is (= [50 80] (node/placed-span t)) "starting where the instance starts") (is (= [50 80] (node/placed-span t)) "starting where the instance starts")
(is (= #{50 55} (set (keys (get-in t [:channels [:audio :gain] :keys])))) (is (= #{40 45} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
"with its automation moved along") "automation is in the sound's own clock, including its source offset")
(testing "and cut off where the instance's own span ends" (testing "and cut off where the instance's own span ends"
(let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12]) (let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12])
[t] (nest/audio-tracks c :main)] [t] (nest/audio-tracks c :main)]
@ -105,7 +105,7 @@
"What `sid` draws at each of `fs`, without the node paths a move changes: "What `sid` draws at each of `fs`, without the node paths a move changes:
per frame, the sorted marks with their points rounded to a thousandth." per frame, the sorted marks with their points rounded to a thousandth."
[c sid fs] [c sid fs]
(let [resolve (clip/resolver c nil pal/index-of sid) (let [resolve (clip/resolver c sid nil pal/index-of nil)
round #(/ (js/Math.round (* 1000 %)) 1000)] round #(/ (js/Math.round (* 1000 %)) 1000)]
(mapv (fn [f] (mapv (fn [f]
(sort-by str (map (fn [op] (sort-by str (map (fn [op]
@ -122,7 +122,7 @@
[] []
(let [tri (fn [id x keyed] (let [tri (fn [id x keyed]
{:id id :kind :poly :z "a1" :paint? true :span [4 60] {:id id :kind :poly :z "a1" :paint? true :span [4 60]
:channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed)) :channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed) :hold)
[:style :color] (ch/framed :brow)}})] [:style :color] (ch/framed :brow)}})]
(-> (clip/blank) (-> (clip/blank)
(assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40})) (assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40}))
@ -199,7 +199,7 @@
(update-in [:symbols :main :nodes] dissoc :tri) (update-in [:symbols :main :nodes] dissoc :tri)
(assoc-in [:symbols :main :nodes a-uuid :time :rate] 2) (assoc-in [:symbols :main :nodes a-uuid :time :rate] 2)
(assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]] (assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]]
(ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]}))) (ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]} :hold)))
{slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6) {slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6)
fs [13 15 18 20]] fs [13 15 18 20]]
(is (nil? (:refused r)) (:refused r)) (is (nil? (:refused r)) (:refused r))
@ -251,7 +251,7 @@
(is (= [0 8] (:span heard)) (is (= [0 8] (:span heard))
"own frames 0-8: it starts on inner's 2 and inner ends on 10") "own frames 0-8: it starts on inner's 2 and inner ends on 10")
(is (= [7 15] (node/placed-span heard)) "inner starts on 5 of outer") (is (= [7 15] (node/placed-span heard)) "inner starts on 5 of outer")
(is (empty? ((clip/resolver c nil pal/index-of :inner) 3)) (is (empty? ((clip/resolver c :inner nil pal/index-of nil) 3))
"and it draws nothing") "and it draws nothing")
(is (= c (clip/place-sound c :inner {:sound "tone"} "tone.mp3" 40 1 10 (random-uuid))) (is (= c (clip/place-sound c :inner {:sound "tone"} "tone.mp3" 40 1 10 (random-uuid)))
"nor lands past the end of its symbol") "nor lands past the end of its symbol")

24
frontend/test/arthur/domain/node_test.cljs
View file

@ -145,14 +145,14 @@
(deftest transform-channels-default-to-the-identity (deftest transform-channels-default-to-the-identity
(let [chs (node/channels {:id :x :kind :group})] (let [chs (node/channels {:id :x :kind :group})]
(is (= [0.0 0.0] (ch/value-at (get chs [:xform :pos]) 0))) (is (= [0.0 0.0] (ch/value-at (get chs [:xform :pos]) 0 nil)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0))) (is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0 nil)))
(is (= true (ch/value-at (get chs [:vis]) 0)))) (is (= true (ch/value-at (get chs [:vis]) 0 nil))))
(testing "and a node's own channels win" (testing "and a node's own channels win"
(let [chs (node/channels {:id :x :kind :group (let [chs (node/channels {:id :x :kind :group
:channels {[:xform :pos] (ch/framed [5 5])}})] :channels {[:xform :pos] (ch/framed [5 5])}})]
(is (= [5 5] (ch/value-at (get chs [:xform :pos]) 0))) (is (= [5 5] (ch/value-at (get chs [:xform :pos]) 0 nil)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0)))))) (is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0 nil))))))
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them (deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
;; A decomposition is not extensible after the fact: adding a component later ;; A decomposition is not extensible after the fact: adding a component later
@ -193,26 +193,26 @@
(deftest keying-a-channel-from-the-inspector (deftest keying-a-channel-from-the-inspector
(let [n {:id :x :kind :group} (let [n {:id :x :kind :group}
a (node/set-channel n [:xform :rot] 3 1.0) a (node/set-channel n [:xform :rot] 3 1.0)
b (node/toggle-key a [:xform :rot] 3) b (node/toggle-key a [:xform :rot] 3 nil)
c (-> b (node/set-channel [:xform :pos] 9 [5 5]) c (-> b (node/set-channel [:xform :pos] 9 [5 5])
(node/toggle-key [:xform :pos] 0) (node/toggle-key [:xform :pos] 0 nil)
(node/set-channel [:xform :pos] 10 [10 0])) (node/set-channel [:xform :pos] 10 [10 0]))
rot #(ch/value-at (get (node/channels %1) [:xform :rot]) %2) rot #(ch/value-at (get (node/channels %1) [:xform :rot]) %2 nil)
pos #(ch/value-at (get (node/channels %1) [:xform :pos]) %2)] pos #(ch/value-at (get (node/channels %1) [:xform :pos]) %2 nil)]
(is (= 1.0 (rot a 50)) "an unkeyed channel is its one value") (is (= 1.0 (rot a 50)) "an unkeyed channel is its one value")
(is (= {3 1.0} (get-in b [:channels [:xform :rot] :keys])) "the first key is its value here") (is (= {3 1.0} (get-in b [:channels [:xform :rot] :keys])) "the first key is its value here")
(is (= [7.5 2.5] (pos c 5)) "an edit on a keyed channel keys it, and keys tween") (is (= [7.5 2.5] (pos c 5)) "an edit on a keyed channel keys it, and keys tween")
(is (= 1.0 (rot (node/set-channel b [:xform :rot] 8 2.0) 3)) "without moving the key before it") (is (= 1.0 (rot (node/set-channel b [:xform :rot] 8 2.0) 3)) "without moving the key before it")
(let [d (node/toggle-key b [:xform :rot] 3)] (let [d (node/toggle-key b [:xform :rot] 3 nil)]
(is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again") (is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again")
(is (= 1.0 (rot d 0)))) (is (= 1.0 (rot d 0))))
(is (= :hold (get-in (node/toggle-key n [:vis] 0) [:channels [:vis] :interp])) "a boolean holds") (is (= :hold (get-in (node/toggle-key n [:vis] 0 nil) [:channels [:vis] :interp])) "a boolean holds")
(let [h (node/set-segment-interp c [:xform :pos] 0 :hold)] (let [h (node/set-segment-interp c [:xform :pos] 0 :hold)]
(is (= [5 5] (pos h 5)) "a gap set to hold cuts at the next key") (is (= [5 5] (pos h 5)) "a gap set to hold cuts at the next key")
(is (= [10 0] (pos h 10))) (is (= [10 0] (pos h 10)))
(is (= [7.5 2.5] (pos (node/set-segment-interp h [:xform :pos] 0 :linear) 5)) "and back to a tween") (is (= [7.5 2.5] (pos (node/set-segment-interp h [:xform :pos] 0 :linear) 5)) "and back to a tween")
(is (= h (node/set-segment-interp h [:xform :pos] 10 :hold)) "the last key has no gap after it") (is (= h (node/set-segment-interp h [:xform :pos] 10 :hold)) "the last key has no gap after it")
(is (empty? (ch/problems (get-in h [:channels [:xform :pos]]))))) (is (empty? (ch/problems (get-in h [:channels [:xform :pos]])))))
(let [d (node/toggle-key (node/set-segment-interp c [:xform :pos] 0 :hold) [:xform :pos] 0)] (let [d (node/toggle-key (node/set-segment-interp c [:xform :pos] 0 :hold) [:xform :pos] 0 nil)]
(is (not (contains? (get-in d [:channels [:xform :pos] :segments]) 0)) (is (not (contains? (get-in d [:channels [:xform :pos] :segments]) 0))
"taking a key off takes its gap's choice with it")))) "taking a key off takes its gap's choice with it"))))

13
frontend/test/arthur/domain/paint_test.cljs
View file

@ -5,6 +5,7 @@
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
(defn- geometry [clip] (defn- geometry [clip]
@ -22,13 +23,13 @@
node/set-segment-interp paint/geometry 9 :linear) node/set-segment-interp paint/geometry 9 :linear)
mixed (geometry mixed-clip)] mixed (geometry mixed-clip)]
(is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span]))) (is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span])))
(is (= a (channel/value-at held 8))) (is (= a (channel/value-at held 8 nil)))
(is (= 10 (first (channel/value-at held 8)))) (is (= 10 (first (channel/value-at held 8 nil))))
(is (= 22 (first (channel/value-at held 9)))) (is (= 22 (first (channel/value-at held 9 nil))))
(is (= 10 (first (channel/value-at mixed 6))) "the first gap cuts") (is (= 10 (first (channel/value-at mixed 6 nil))) "the first gap cuts")
(is (= 28 (first (channel/value-at mixed 12))) "the second gap tweens") (is (= 28 (first (channel/value-at mixed 12 nil))) "the second gap tweens")
(is (empty? (channel/problems mixed))) (is (empty? (channel/problems mixed)))
;; The demo's root is exposed on 2s. Paint at frame 3 must still appear at 3. ;; The demo's root is exposed on 2s. Paint at frame 3 must still appear at 3.
(is (some #(= :paint-test (:node %)) (is (some #(= :paint-test (:node %))
(symbol/eval-frame (get-in c2 [:symbols :main]) 3))) (symbol/eval-frame (get-in c2 [:symbols :main]) 3 nil pal/index-of nil)))
(is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip)))))) (is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))

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

@ -21,6 +21,7 @@
[arthur.demo.take :as take] [arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
[arthur.domain.project :as project] [arthur.domain.project :as project]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.flow.freeze :as freeze] [arthur.flow.freeze :as freeze]
@ -147,7 +148,7 @@
;; frame rather than hidden, and its partner is not. ;; frame rather than hidden, and its partner is not.
(let [back (wired :c1 @gappy) (let [back (wired :c1 @gappy)
drawn (into #{} (map :node) drawn (into #{} (map :node)
((symbol/resolver (face-symbol (:clip back)) (:store back)) 12))] ((symbol/resolver (face-symbol (:clip back)) (:store back) pal/index-of nil) 12))]
(is (not (contains? drawn :eye-r))) (is (not (contains? drawn :eye-r)))
(is (contains? drawn :eye-l)) (is (contains? drawn :eye-l))
(is (contains? drawn :mouth)))) (is (contains? drawn :mouth))))

66
frontend/test/arthur/domain/symbol_test.cljs
View file

@ -27,7 +27,7 @@
{:nodes (into {} (map (juxt :id identity)) nodes)}) {:nodes (into {} (map (juxt :id identity)) nodes)})
(defn- ids-at [scene f] (defn- ids-at [scene f]
(mapv :node (symbol/eval-frame scene f))) (mapv :node (symbol/eval-frame scene f nil pal/index-of nil)))
(def ^:private pts-of ops/points) (def ^:private pts-of ops/points)
@ -70,9 +70,9 @@
(is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b])) (is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b]))
"and so is the new one") "and so is the new one")
(is (= [[0 0] [10 0] [10 10]] (is (= [[0 0] [10 0] [10 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s 0)))))) (pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s 0 nil pal/index-of nil))))))
(is (= [[100 0] [110 0] [110 10]] (is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s' 0)))))))) (pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s' 0 nil pal/index-of nil))))))))
;; ---- draw order ---- ;; ---- draw order ----
@ -129,7 +129,7 @@
:channels {[:xform :pos] (ch/framed [100 50]) :channels {[:xform :pos] (ch/framed [100 50])
[:xform :scale] (ch/framed [2 2])}} [:xform :scale] (ch/framed [2 2])}}
(poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base)) (poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base))
op (first (symbol/eval-frame s 0))] op (first (symbol/eval-frame s 0 nil pal/index-of nil))]
(is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op))))) (is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op)))))
(deftest a-keyed-group-position-moves-its-children-and-holds-between-keys (deftest a-keyed-group-position-moves-its-children-and-holds-between-keys
@ -137,9 +137,9 @@
;; group whose [:xform :pos] is keyed on four frames. ;; group whose [:xform :pos] is keyed on four frames.
(let [s (sc {:id :g :kind :group :z "a1" (let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] :channels {[:xform :pos]
(ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]})}} (ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]} :hold)}}
(poly :p :g "a1" [0 0 2 0 2 2] :skin-base)) (poly :p :g "a1" [0 0 2 0 2 2] :skin-base))
at #(first (pts-of (first (symbol/eval-frame s %))))] at #(first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil))))]
(is (= [0 0] (at 0))) (is (= [0 0] (at 0)))
(is (= [0 0] (at 3)) "held") (is (= [0 0] (at 3)) "held")
(is (= [10 0] (at 4))) (is (= [10 0] (at 4)))
@ -154,17 +154,17 @@
;; odd frames against a mouth cutting on even ones reads as two performances. ;; odd frames against a mouth cutting on even ones reads as two performances.
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}} (let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}}
{:id :g :kind :group :parent :root :z "a1" {:id :g :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}} :channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)) :hold)}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base)) (poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (symbol/eval-frame s %)))))] x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12))))) (is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12)))))
(testing "and a node may set its own grid, which the model permits deliberately" (testing "and a node may set its own grid, which the model permits deliberately"
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}} (let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}}
{:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4} {:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4}
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}} :channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)) :hold)}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base)) (poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (symbol/eval-frame s %)))))] x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12))))))) (is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead (deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
@ -173,12 +173,12 @@
(let [keys (into {} (map (juxt identity #(vector % 0))) (range 12)) (let [keys (into {} (map (juxt identity #(vector % 0))) (range 12))
s (sc {:id :root :kind :group :z "a1"} s (sc {:id :root :kind :group :z "a1"}
{:id :plate :kind :group :parent :root :z "a1" {:id :plate :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed keys)}} :channels {[:xform :pos] (ch/keyed keys :hold)}}
(poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base) (poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base)
{:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2} {:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2}
:channels {[:xform :pos] (ch/keyed keys)}} :channels {[:xform :pos] (ch/keyed keys :hold)}}
(poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark)) (poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark))
x-of (fn [f id] (->> (symbol/eval-frame s f) x-of (fn [f id] (->> (symbol/eval-frame s f nil pal/index-of nil)
(filter #(= id (:node %))) first pts-of first first))] (filter #(= id (:node %))) first pts-of first first))]
(is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4)))) (is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4))))
(is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead"))) (is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead")))
@ -194,12 +194,12 @@
{:span [2 5] {:span [2 5]
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1]) :channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])
[:style :color] (ch/framed :brow) [:style :color] (ch/framed :brow)
[:vis] (ch/keyed {0 true, 3 false, 4 true})}}))] [:vis] (ch/keyed {0 true, 3 false, 4 true} :hold)}}))]
(is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7)))))) (is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7))))))
(deftest a-hidden-group-takes-its-children-with-it (deftest a-hidden-group-takes-its-children-with-it
(let [s (sc {:id :g :kind :group :z "a1" (let [s (sc {:id :g :kind :group :z "a1"
:channels {[:vis] (ch/keyed {0 true, 2 false})}} :channels {[:vis] (ch/keyed {0 true, 2 false} :hold)}}
(poly :p :g "a1" [0 0 1 0 1 1] :brow))] (poly :p :g "a1" [0 0 1 0 1 1] :brow))]
(is (= [:p] (ids-at s 0))) (is (= [:p] (ids-at s 0)))
(is (= [] (ids-at s 2))))) (is (= [] (ids-at s 2)))))
@ -221,11 +221,11 @@
:dense {:store "pts" :offset 0 :stride 6 :frames 2}} :dense {:store "pts" :offset 0 :stride 6 :frames 2}}
[:style :color] (ch/framed :mouth-dark)}} [:style :color] (ch/framed :mouth-dark)}}
(poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))] (poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:child] (mapv :node (symbol/eval-frame absent-pos 0 store)))) (is (= [:child] (mapv :node (symbol/eval-frame absent-pos 0 store pal/index-of nil))))
(is (= [] (mapv :node (symbol/eval-frame absent-pos 1 store))) (is (= [] (mapv :node (symbol/eval-frame absent-pos 1 store pal/index-of nil)))
"an absent transform gives the children nowhere to be") "an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (symbol/eval-frame absent-pts 0 store)))) (is (= [:m :teeth] (mapv :node (symbol/eval-frame absent-pts 0 store pal/index-of nil))))
(is (= [:teeth] (mapv :node (symbol/eval-frame absent-pts 1 store))) (is (= [:teeth] (mapv :node (symbol/eval-frame absent-pts 1 store pal/index-of nil)))
"an absent outline removes only itself"))) "an absent outline removes only itself")))
;; ---- stencils ---- ;; ---- stencils ----
@ -239,7 +239,7 @@
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2" {:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4) :channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}}) [:style :color] (ch/framed :iris)}})
ops (symbol/eval-frame s 0)] ops (symbol/eval-frame s 0 nil pal/index-of nil)]
(is (= [:sclera :iris] (mapv :node ops))) (is (= [:sclera :iris] (mapv :node ops)))
(is (= (:eye-white pal/index-of) (:stencil (second ops)))))) (is (= (:eye-white pal/index-of) (:stencil (second ops))))))
@ -250,7 +250,7 @@
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white (poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white
{:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10]) {:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10])
[:style :color] (ch/framed :eye-white) [:style :color] (ch/framed :eye-white)
[:vis] (ch/keyed {0 true, 1 false})}}) [:vis] (ch/keyed {0 true, 1 false} :hold)}})
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2" {:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4) :channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})] [:style :color] (ch/framed :iris)}})]
@ -266,7 +266,7 @@
:channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}} :channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}}
{:id :r :kind :rect :parent :g :z "a2" {:id :r :kind :rect :parent :g :z "a2"
:channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}}) :channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}})
[d r] (symbol/eval-frame s 0)] [d r] (symbol/eval-frame s 0 nil pal/index-of nil)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)])) (is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
(is (= 3.4 (:size r))))) (is (= 3.4 (:size r)))))
@ -291,7 +291,7 @@
(deftest the-resolver-reuses-one-buffer-per-node (deftest the-resolver-reuses-one-buffer-per-node
;; At 30fps per-frame allocation is the only thing that will make this stutter, ;; At 30fps per-frame allocation is the only thing that will make this stutter,
;; and fixed topology is what makes the buffer size knowable at all. ;; and fixed topology is what makes the buffer size knowable at all.
(let [res (symbol/resolver demo/main) (let [res (symbol/resolver demo/main nil pal/index-of nil)
buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))] buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))]
(is (identical? (buf-of 0 :card) (buf-of 30 :card))))) (is (identical? (buf-of 0 :card) (buf-of 30 :card)))))
@ -308,15 +308,15 @@
;; The mistake this split makes easy: both are maps with an :id, and the wrong ;; The mistake this split makes easy: both are maps with an :id, and the wrong
;; one resolves to no ops rather than to an error. ;; one resolves to no ops rather than to an error.
(is (thrown-with-msg? ExceptionInfo #"not a symbol" (is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/resolver demo/clip))) (symbol/resolver demo/clip nil pal/index-of nil)))
(is (thrown-with-msg? ExceptionInfo #"not a symbol" (is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/eval-frame demo/clip 0))))) (symbol/eval-frame demo/clip 0 nil pal/index-of nil)))))
(deftest the-hand-written-clip-renders-and-moves (deftest the-hand-written-clip-renders-and-moves
;; port-plan step 2's done condition, as an assertion rather than a look: the ;; port-plan step 2's done condition, as an assertion rather than a look: the
;; scene rasterises, it writes only palette indices, and the pixels are not the ;; scene rasterises, it writes only palette indices, and the pixels are not the
;; same on every frame. ;; same on every frame.
(let [res (symbol/resolver demo/main) (let [res (symbol/resolver demo/main nil pal/index-of nil)
render (fn [f] render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))] (let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of)) (raster/clear! r (:bg pal/index-of))
@ -334,7 +334,7 @@
;; Exposure 2 on the clip root, inherited, so odd frames are identical to the ;; Exposure 2 on the clip root, inherited, so odd frames are identical to the
;; even frame before them. If this fails, exposure is being applied somewhere ;; even frame before them. If this fails, exposure is being applied somewhere
;; other than the frame the channels are sampled at. ;; other than the frame the channels are sampled at.
(let [res (symbol/resolver demo/main) (let [res (symbol/resolver demo/main nil pal/index-of nil)
render (fn [f] render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))] (let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of)) (raster/clear! r (:bg pal/index-of))
@ -351,7 +351,7 @@
(deftest the-hand-written-clip-keeps-the-iris-and-pupil-inside-the-card (deftest the-hand-written-clip-keeps-the-iris-and-pupil-inside-the-card
;; The stencil chain, on real pixels: the iris is clipped by the card and the ;; The stencil chain, on real pixels: the iris is clipped by the card and the
;; pupil by the iris, and neither is expressed anywhere as a chain. ;; pupil by the iris, and neither is expressed anywhere as a chain.
(let [res (symbol/resolver demo/main)] (let [res (symbol/resolver demo/main nil pal/index-of nil)]
(doseq [f (range 0 demo/frames 4)] (doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/clip) (:height demo/clip)) (let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/clip) (:height demo/clip)) after (raster/make (:width demo/clip) (:height demo/clip))
@ -384,9 +384,9 @@
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base)) (poly :p :root "a1" [0 0 10 0 10 10] :skin-base))
day {:skin-base 1} day {:skin-base 1}
night {:skin-base 17}] night {:skin-base 17}]
(is (= 1 (:color (first (symbol/eval-frame s 0 nil day))))) (is (= 1 (:color (first (symbol/eval-frame s 0 nil day nil)))))
(is (= 17 (:color (first (symbol/eval-frame s 0 nil night))))) (is (= 17 (:color (first (symbol/eval-frame s 0 nil night nil)))))
(is (= 17 (:color (first ((symbol/resolver s nil night) 0)))) (is (= 17 (:color (first ((symbol/resolver s nil night nil) 0))))
"and the playback path agrees"))) "and the playback path agrees")))
(deftest a-tone-the-ramp-does-not-define-is-loudly-wrong (deftest a-tone-the-ramp-does-not-define-is-loudly-wrong
@ -394,7 +394,7 @@
;; authored data and should be impossible to miss. ;; authored data and should be impossible to miss.
(let [s (sc {:id :root :kind :group :z "a1"} (let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))] (poly :p :root "a1" [0 0 10 0 10 10] :skin-base))]
(is (= 255 (:color (first (symbol/eval-frame s 0 nil {}))))))) (is (= 255 (:color (first (symbol/eval-frame s 0 nil {} nil)))))))
(deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil (deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil
;; A stencil is a colour key, so two nodes sharing a tone share a stencil — ;; A stencil is a colour key, so two nodes sharing a tone share a stencil —
@ -407,6 +407,6 @@
[:style :color] (ch/framed :iris)}}) [:style :color] (ch/framed :iris)}})
;; :night's tones sit above :day's in one concatenated space ;; :night's tones sit above :day's in one concatenated space
night {:eye-white 14 :iris 15} night {:eye-white 14 :iris 15}
ops (symbol/eval-frame s 0 nil night)] ops (symbol/eval-frame s 0 nil night nil)]
(is (= 14 (:stencil (second ops))) (is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in"))) "the stencil resolves to the index the stencil node actually drew in")))

61
frontend/test/arthur/domain/trace_test.cljs
View file

@ -52,7 +52,7 @@
(defn- photo-at (defn- photo-at
"The photo matrix of face-1 alone at frame `f`, the still being 1000px tall." "The photo matrix of face-1 alone at frame `f`, the still being 1000px tall."
[c f] [c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of) (let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil)
h (head c)] h (head c)]
(r f) (r f)
(vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store (vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store
@ -70,40 +70,49 @@
"a continuous head carries the held photo along with it"))) "a continuous head carries the held photo along with it")))
(defn- wrapped (defn- wrapped
"Face-1's take placed, moved, inside a symbol :wrap, with `underlays` on the "Face-1's take placed, moved, inside a symbol :wrap."
instances named." []
[{:keys [outer inner]}] (assoc-in @frozen [:symbols :wrap]
(-> @frozen {:id :wrap :frames 200
(assoc-in [:symbols :wrap] {:id :wrap :frames 200 :nodes {:m {:id :m :kind :instance :z "a0"
:nodes {:m (cond-> {:id :m :kind :instance :of :main :z "a0" :source {:symbol :main}
:channels {[:xform :pos] {:animated? false :channels {[:xform :pos] {:animated? false :value [30 -10]}}}}}))
:value [30 -10]}}}
outer (assoc :underlay outer))}})
(cond-> inner (assoc-in [:symbols :main :nodes :face-1 :underlay] inner))))
(deftest an-underlay-covers-the-faces-below-it-and-the-nearest-decides (deftest a-face-switched-on-shows-wherever-it-is-placed
(is (= [{:path [:m :face-1] :face :face-1 :opacity 0.3}] (let [c (wrapped)]
(trace/shown (wrapped {:outer {:on? true :opacity 0.3}}) :wrap)) (is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/shown c :wrap #{:face-1}))
"switched on at the take, its face shows") "a face inside a take inside a symbol, at the row path it is at")
(is (= [] (trace/shown (wrapped {:outer {:on? true} :inner {:on? false}}) :wrap)) (is (= [] (trace/shown c :wrap #{})) "and nothing when it is switched off")
"and the face can still be switched off inside it") (is (= [{:path [:face-1] :in :main :face :face-1}] (trace/shown c :main #{:face-1}))
(is (= [{:path [:m :face-1] :face :face-1 :opacity 0.8}] "the same switch, one symbol down")
(trace/shown (wrapped {:inner {:on? true :opacity 0.8}}) :wrap))) (is (= [{:path [] :in :face-1 :face :face-1}] (trace/shown c :face-1 #{:face-1}))
(let [c (wrapped {:outer {:on? true :opacity 0.3}})] "the face open in its own tab is at no path at all — it IS the stage")
(is (= {:on? true :opacity 0.3 :own? false} (trace/underlay-at c :wrap [:m :face-1]))) (is (= [] (trace/shown c :wrap #{:main}))
(is (= {:on? true :opacity 0.3 :own? true} (trace/underlay-at c :wrap [:m]))) "a symbol that is not a face has no footage of its own to show")))
(is (nil? (trace/underlay-at @frozen :main [:face-1])))))
(deftest the-faces-that-can-be-traced-are-listed-once-each
(is (= [:face-1] (trace/traceable-faces (wrapped) :wrap)))
(is (= [:face-1] (trace/traceable-faces @frozen :main)) "the take it was frozen into")
(is (= [:face-1] (trace/traceable-faces @frozen :face-1)) "itself, open to draw over"))
(deftest a-face-opened-to-be-drawn-over-starts-with-its-footage-showing
(let [c (wrapped)]
(is (= #{:face-1} (trace/showing-for c :face-1 #{})) "the face's own tab")
(is (= #{} (trace/showing-for c :main #{}))
"and not the take it is placed in, which is the picture itself")
(is (= #{:face-1} (trace/showing-for c :main #{:face-1}))
"one already switched on stays on wherever you go")))
(deftest a-take-lists-the-faces-in-it (deftest a-take-lists-the-faces-in-it
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/faces @frozen :main))) (is (= [{:path [:face-1] :in :main :face :face-1}] (trace/faces @frozen :main)))
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/faces (wrapped {}) :wrap))) (is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/faces (wrapped) :wrap)))
(is (= [] (trace/faces @frozen :face-1)))) (is (= [] (trace/faces @frozen :face-1))))
(deftest the-resolver-says-where-a-nested-head-went-on-its-last-frame (deftest the-resolver-says-where-a-nested-head-went-on-its-last-frame
;; The same answer as `nest/placement`, which walks and resolves the path all ;; The same answer as `nest/placement`, which walks and resolves the path all
;; over again — the resolver has it already, from drawing the frame. ;; over again — the resolver has it already, from drawing the frame.
(let [c (wrapped {}) (let [c (wrapped)
r (clip/resolver c @store pal/index-of :wrap) r (clip/resolver c :wrap @store pal/index-of nil)
path [:m :face-1 :head]] path [:m :face-1 :head]]
(doseq [f [0 17 60]] (doseq [f [0 17 60]]
(r f) (r f)

8
frontend/test/arthur/domain/wire_test.cljs
View file

@ -13,10 +13,10 @@
;; THE reason this is transit. Keys are a map by FRAME, and `{"0" v}` is not ;; THE reason this is transit. Keys are a map by FRAME, and `{"0" v}` is not
;; `{0 v}`: `value-at` would find no key at frame 0 and the part would hold its ;; `{0 v}`: `value-at` would find no key at frame 0 and the part would hold its
;; first pose forever, on a document that looked fine. ;; first pose forever, on a document that looked fine.
(let [c (ch/keyed {0 true 4 false 12 true})] (let [c (ch/keyed {0 true 4 false 12 true} :hold)]
(is (= c (round c))) (is (= c (round c)))
(is (every? number? (keys (:keys (round c))))) (is (every? number? (keys (:keys (round c)))))
(is (= true (ch/value-at (round c) 13))))) (is (= true (ch/value-at (round c) 13 nil)))))
(deftest an-id-comes-back-a-keyword (deftest an-id-comes-back-a-keyword
(is (= {:id :mouth-in :kind :poly :parent :mouth :z "a2"} (is (= {:id :mouth-in :kind :poly :parent :mouth :z "a2"}
@ -35,7 +35,7 @@
;; Transit loses sortedness, which is why `domain/channel` says keys are a PLAIN ;; Transit loses sortedness, which is why `domain/channel` says keys are a PLAIN
;; map and builds the sorted index at read time. Asserted so that nobody ;; map and builds the sorted index at read time. Asserted so that nobody
;; "improves" the codec into a sorted map that works until the first round trip. ;; "improves" the codec into a sorted map that works until the first round trip.
(let [c (round (ch/keyed (into {} (map (juxt identity str)) (range 20))))] (let [c (round (ch/keyed (into {} (map (juxt identity str)) (range 20)) :hold))]
(is (map? (:keys c))) (is (map? (:keys c)))
(is (not (sorted? (:keys c)))) (is (not (sorted? (:keys c))))
(is (= (vec (range 20)) (ch/frames c))))) (is (= (vec (range 20)) (ch/frames c)))))
@ -50,7 +50,7 @@
;; turned `[]` into nil or into `[nil]` would either lose the field or refuse to ;; turned `[]` into nil or into `[nil]` would either lose the field or refuse to
;; play the document back. ;; play the document back.
(is (= {:over []} (round {:over []}))) (is (= {:over []} (round {:over []})))
(is (= [] (:over (round (ch/keyed {0 1})))))) (is (= [] (:over (round (ch/keyed {0 1} :hold))))))
(deftest a-whole-leaf-map-round-trips-through-parsed-json (deftest a-whole-leaf-map-round-trips-through-parsed-json
;; What a save actually does: transit, then parsed so the column holds JSON. ;; What a save actually does: transit, then parsed so the column holds JSON.

10
frontend/test/arthur/events/export_test.cljs
View file

@ -60,12 +60,14 @@
:nodes {:root {:id :root :kind :group :z "a1"} :nodes {:root {:id :root :kind :group :z "a1"}
#uuid "22222222-2222-4222-8222-222222222222" #uuid "22222222-2222-4222-8222-222222222222"
{:id #uuid "22222222-2222-4222-8222-222222222222" {:id #uuid "22222222-2222-4222-8222-222222222222"
:kind :instance :of :sym/face :parent :root :z "a2" :kind :instance :parent :root :z "a2"
:name "8625 right"} :name "8625 right"
:source {:symbol :sym/face}}
#uuid "11111111-1111-4111-8111-111111111111" #uuid "11111111-1111-4111-8111-111111111111"
{:id #uuid "11111111-1111-4111-8111-111111111111" {:id #uuid "11111111-1111-4111-8111-111111111111"
:kind :instance :of :sym/face :parent :root :z "a1" :kind :instance :parent :root :z "a1"
:name "8625 left"} :name "8625 left"
:source {:symbol :sym/face}}
:a-rect {:id :a-rect :kind :rect :parent :root :z "a3"}}} :a-rect {:id :a-rect :kind :rect :parent :root :z "a3"}}}
:sym/face {:frames 40 :nodes {:root {:id :root :kind :group :z "a1"}}}}}) :sym/face {:frames 40 :nodes {:root {:id :root :kind :group :z "a1"}}}}})

67
frontend/test/arthur/events/lane_test.cljs Normal file
View file

@ -0,0 +1,67 @@
(ns arthur.events.lane-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.lane-test :as fixture]
[arthur.domain.lane :as lane]
[arthur.events.ui :as ui]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.footage.store :as store]
[arthur.ui.timeline :as timeline]))
(deftest one-row-projects-all-cels-and-keeps-selection-addresses
(let [doc (fixture/document)
rows (timeline/rows doc :main #{})
lane (first (filter :cels rows))]
(is (= 2 (count rows)))
(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 (= [:a :b :insert] (mapv #(get-in cells [% :cel :id]) [0 4 8])))
(is (= [[:node :main :a [:a]]
[:node :main :b [:b]]
[:node :main :insert [:insert]]]
(mapv #(get-in cells [% :cel :select]) [0 4 8])))
(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
(let [doc (assoc-in (fixture/document) [:symbols :outer]
{:id :outer :frames 30
:nodes {:take {:id :take :kind :instance :z "a"
:time {:at 10 :rate 1} :span [0 12]
:source {:symbol :main}
:playback {:in 0 :speed 1 :end :stop}}}})]
(is (= 2 (ui/selection-frame doc nil :outer
[:node :main :a [:take :a]] 12)))
(is (= 12 (ui/selection-frame doc nil :main
[:node :main :a [:a]] 12)))))
(deftest sequence-commands-use-isolated-history-transactions
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "sequence-test")
db {:clip/current id :paint/revision 0
:ui {:open :main :selection [:node :main :a [:a]]}}
refused (ui/apply-lane-command db :main
(lane/extend-hold doc :main :a 1 {}) [:retry])]
(is (= doc (:clip (store/entry id))))
(is (nil? (:history (store/entry id))))
(is (= [:retry] (get-in refused [:ui :lane-retry])))
(let [r1 (lane/extend-hold doc :main :a 1 {:extent :grow-symbol})
db1 (ui/apply-lane-command db :main r1 nil)
r2 (lane/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol})
db2 (ui/apply-lane-command db1 :main r2 nil)
h (:history (store/entry id))
undo (history/undo h (leaf/leaves "u" (:clip r2)))
undo2 (history/undo (:history undo) (:leaves undo))]
(is (= 2 (count (:done h))) "rapid button presses remain separate commands")
(is (= (:clip r1) (leaf/clip "u" (:leaves undo))))
(is (= doc (leaf/clip "u" (:leaves undo2))))
(is (= [:node :main :a [:a]] (get-in db2 [:ui :selection]))))))

10
frontend/test/arthur/export_test.cljs
View file

@ -222,10 +222,12 @@
{:main {:main
{:frames 12 {:frames 12
:nodes (cond-> {:root {:id :root :kind :group :z "a1"} :nodes (cond-> {:root {:id :root :kind :group :z "a1"}
p1 {:id p1 :kind :instance :of :sym/face :parent :root :z "a1" p1 {:id p1 :kind :instance :parent :root :z "a1"
:name "left" :channels {[:xform :pos] (ch/framed [0 0])}} :name "left" :source {:symbol :sym/face}
p2 {:id p2 :kind :instance :of :sym/face :parent :root :z "a2" :channels {[:xform :pos] (ch/framed [0 0])}}
:name "right" :channels {[:xform :pos] (ch/framed [4 0])}} p2 {:id p2 :kind :instance :parent :root :z "a2"
:name "right" :source {:symbol :sym/face}
:channels {[:xform :pos] (ch/framed [4 0])}}
:loose (assoc (poly :loose "a4" [0 0 1 0 1 1] :brow) :loose (assoc (poly :loose "a4" [0 0 1 0 1 1] :brow)
:parent :root)} :parent :root)}
voice? (assoc v1 {:id v1 :kind :audio :parent :root :z "a3" voice? (assoc v1 {:id v1 :kind :audio :parent :root :z "a3"

2
frontend/test/arthur/flow/eye_occlusion_test.cljs
View file

@ -59,7 +59,7 @@
(is (not (ch/nothing? (sample :eye-l f)))) (is (not (ch/nothing? (sample :eye-l f))))
(is (not (ch/nothing? (sample :mouth f))))) (is (not (ch/nothing? (sample :mouth f)))))
(let [drawn (into #{} (map :node) (let [drawn (into #{} (map :node)
((symbol/resolver (clip/symbol clip :face-1) store pal/index-of) 11))] ((symbol/resolver (clip/symbol clip :face-1) store pal/index-of nil) 11))]
(is (not (contains? drawn :eye-r))) (is (not (contains? drawn :eye-r)))
(is (not (contains? drawn :iris-r))) (is (not (contains? drawn :iris-r)))
(is (contains? drawn :eye-l)) (is (contains? drawn :eye-l))

110
frontend/test/arthur/flow/freeze_test.cljs
View file

@ -13,9 +13,11 @@
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.geom :as geom] [arthur.domain.geom :as geom]
[arthur.domain.gesture :as gesture]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.raster :as raster] [arthur.domain.raster :as raster]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
@ -54,7 +56,7 @@
(defn- ops-at (defn- ops-at
"Ops for one frame of a TIMELINE." "Ops for one frame of a TIMELINE."
[sym f] [sym f]
((symbol/resolver sym @store pal/index-of) f)) ((symbol/resolver sym @store pal/index-of nil) f))
(defn- render (defn- render
"One frame of a CLIP into a byte buffer. The stage's size comes off the clip and "One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
@ -62,7 +64,7 @@
[c f] [c f]
(let [r (raster/make (:width c) (:height c))] (let [r (raster/make (:width c) (:height c))]
(raster/clear! r (get pal/index-of :bg)) (raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r ((clip/resolver c @store pal/index-of :main) f)) (raster/draw-ops! r ((clip/resolver c :main @store pal/index-of nil) f))
(vec (array-seq (:buf r))))) (vec (array-seq (:buf r)))))
(defn- drawn (defn- drawn
@ -85,7 +87,7 @@
(deftest the-tree-is-the-one-the-model-specifies (deftest the-tree-is-the-one-the-model-specifies
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face))) (is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
(is (= :face-1 (get-in @clip* [:symbols :main :nodes :face-1 :of]))) (is (= #{:face-1} (node/sources (get-in @clip* [:symbols :main :nodes :face-1]))))
(is (= [:head] (symbol/lineage (:nodes @sym*) :head))) (is (= [:head] (symbol/lineage (:nodes @sym*) :head)))
(is (= [:mouth :head] (symbol/lineage (:nodes @sym*) :mouth))) (is (= [:mouth :head] (symbol/lineage (:nodes @sym*) :mouth)))
(is (= [:mouth-in :mouth :head] (symbol/lineage (:nodes @sym*) :mouth-in))) (is (= [:mouth-in :mouth :head] (symbol/lineage (:nodes @sym*) :mouth-in)))
@ -193,7 +195,7 @@
;; checking arithmetic against itself; this checks `node/local!`, `node/world!` ;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
;; and `emit` as well. ;; and `emit` as well.
(let [c (freeze/head-mode {} @frozen) (let [c (freeze/head-mode {} @frozen)
res (clip/resolver c @store pal/index-of :main) res (clip/resolver c :main @store pal/index-of nil)
k (first (:value (chan :face [:xform :scale]))) k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor])) anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos])) pos (:value (chan :face [:xform :pos]))
@ -247,14 +249,11 @@
"the trace survives the document round trip"))) "the trace survives the document round trip")))
(deftest trace-keys-hold-the-whole-measured-transform (deftest trace-keys-hold-the-whole-measured-transform
(let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen)) (let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen)) @store pal/index-of nil)
@store pal/index-of)
held (symbol/resolver (face-symbol held (symbol/resolver (face-symbol
(freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen)) (freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen)) @store pal/index-of nil)
@store pal/index-of)
start (symbol/resolver (face-symbol start (symbol/resolver (face-symbol
(freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen)) (freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen)) @store pal/index-of nil)
@store pal/index-of)
world (fn [resolver frame] world (fn [resolver frame]
(resolver frame) (resolver frame)
(vec (array-seq (symbol/world-of resolver :head))))] (vec (array-seq (symbol/world-of resolver :head))))]
@ -309,6 +308,83 @@
(is (= :framed (ch/describe c)) (str path " is not framed")) (is (= :framed (ch/describe c)) (str path " is not framed"))
(is (nil? (:generated c)) (str path " claims provenance"))))) (is (nil? (:generated c)) (str path " claims provenance")))))
(deftest a-part-has-a-pivot-exactly-when-a-hand-can-use-one
;; The face's anchor was always the head's centre — the test below — and the
;; parts underneath it had none at all, so each one turned and scaled about ITS
;; OWN origin, which is the top-left corner of the FOOTAGE. On a 320x200 stage
;; the mouth's pivot sat at (-234, -395): off the stage by more than a stage,
;; so a corner drag slid the mouth about instead of resizing it.
;;
;; BY BICONDITIONAL, over every node the freeze makes, rather than against a
;; list of the ones that happen to have geometry today. The rule `pivoted` goes
;; by is `node/measured?` — the one `gesture/refusal` refuses a hand edit by —
;; so the two have to agree exactly: a pivot is written where a hand could use
;; it and nowhere else. A brow has a dense `[:xform :pos]` and so gets none,
;; which is not an exception to the rule, it is the rule.
(let [c @clip*]
(doseq [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes]))
;; `:face` authors its own in `face-placement`, upstream of this.
:when (not= [:main :face] [sid id])]
(let [n (get-in c [:symbols sid :nodes id])
frames (range (get-in c [:symbols sid :frames]))
anchor (:value (get-in n [:channels [:xform :anchor]]))
usable (and (not (node/measured? n))
(some? (pick/pivot c @store n frames)))]
(is (= usable (some? anchor))
(str sid "/" id " has a pivot: " (some? anchor)
", but a hand can use one: " usable))
(is (= (nil? (gesture/refusal n)) (not (node/measured? n)))
(str sid "/" id ": `refusal` and `measured?` disagree"))
(when anchor
(let [bounds (pick/bounds-of c @store n)
[x0 y0 x1 y1] (reduce #(let [k (bounds %2)]
(cond (nil? %1) k (nil? k) %1
:else (mapv (fn [op i] (op (nth %1 i) (nth k i)))
[min min max max] (range 4))))
nil frames)]
(is (and (<= x0 (nth anchor 0) x1) (<= y0 (nth anchor 1) y1))
(str sid "/" id "'s pivot " (pr-str anchor) " is outside what it draws, "
(pr-str [x0 y0 x1 y1])))))))))
(deftest the-head-keeps-no-pivot-of-its-own
;; The case that makes `measured?` the right predicate rather than "draws
;; nothing": `:head` carries the measured similarity, so its scale is nowhere
;; near 1 and an anchor on it would NOT cancel out of `node/local!` — it would
;; move the whole face. It is skipped for that reason, and would still be
;; skipped if it were ever given geometry.
(is (node/measured? (node :head)))
(is (nil? (get-in (node :head) [:channels [:xform :anchor]]))))
(deftest giving-every-part-its-pivot-moves-nothing-on-screen
;; The claim `pivoted`'s docstring makes, asserted in pixels rather than
;; trusted: rotation and scale are the identity on a node a freeze has just
;; made, and at the identity the anchor cancels out of `node/local!`. So the
;; pass decides where a part PIVOTS and nothing else — if it ever renders
;; differently, it has been applied to a node whose transform is not the
;; identity, which is the one way it could go wrong.
(let [c @clip*
;; Every node the freeze makes EXCEPT `:face`, whose anchor
;; `face-placement` authors — which is the set `pivoted` writes.
every (for [sid [:main :face-1]
id (keys (get-in c [:symbols sid :nodes]))
:when (and (not= [:main :face] [sid id])
(seq (get-in c [:symbols sid :nodes id :channels])))]
[sid id])
anchors #(into {} (for [[sid id] every]
[[sid id] (get-in % [:symbols sid :nodes id
:channels [:xform :anchor]])]))
bare (reduce (fn [c [sid id]]
(update-in c [:symbols sid :nodes id :channels]
dissoc [:xform :anchor]))
c every)
again (freeze/pivoted bare @store)]
(is (every? nil? (vals (anchors bare))) "stripped")
(is (= (anchors c) (anchors again)) "the pass puts back exactly what the freeze wrote")
(doseq [f (range 0 take/frames 17)]
(is (= (render bare f) (render again f))
(str "frame " f " draws differently once every part has a pivot")))))
(deftest the-face-puts-the-head-s-centre-where-it-says-it-does (deftest the-face-puts-the-head-s-centre-where-it-says-it-does
;; anchor + pos is where the anchor lands in the parent, which is what makes ;; anchor + pos is where the anchor lands in the parent, which is what makes
;; `:anchor` the registration point: scale and rotation happen about the head's ;; `:anchor` the registration point: scale and rotation happen about the head's
@ -354,7 +430,7 @@
peak (reduce max ap) peak (reduce max ap)
want (mapv #(>= (/ % peak) 0.12) ap)] want (mapv #(>= (/ % peak) 0.12) ap)]
(is (= :keyed (ch/describe c))) (is (= :keyed (ch/describe c)))
(is (= want (mapv #(ch/value-at c %) (range take/frames))) (is (= want (mapv #(ch/value-at c % nil) (range take/frames)))
"the held keys do not reproduce the threshold") "the held keys do not reproduce the threshold")
;; The reason it is keyed: a threshold crossing is a handful of transitions, ;; The reason it is keyed: a threshold crossing is a handful of transitions,
;; hold is the default, and keys are the shape a human can correct. A dense ;; hold is the default, and keys are the shape a human can correct. A dense
@ -432,7 +508,7 @@
(is (not (ch/nothing? (at :eye-r 60)))) (is (not (ch/nothing? (at :eye-r 60))))
(is (not (ch/nothing? (at :eye-l 50)))) (is (not (ch/nothing? (at :eye-l 50))))
(is (not (ch/nothing? (at :mouth 50)))) (is (not (ch/nothing? (at :mouth 50))))
(let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of) 50))] (let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of nil) 50))]
(is (not (contains? drawn-nodes :eye-r))) (is (not (contains? drawn-nodes :eye-r)))
(is (contains? drawn-nodes :eye-l)) (is (contains? drawn-nodes :eye-l))
(is (contains? drawn-nodes :mouth))) (is (contains? drawn-nodes :mouth)))
@ -507,7 +583,7 @@
;; Hoisted: the resolver caches its order and reuses its buffers, so the ;; Hoisted: the resolver caches its order and reuses its buffers, so the
;; node ids come out before the next frame is asked for. ;; node ids come out before the next frame is asked for.
nodes-at (fn [c] nodes-at (fn [c]
(let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of)] (let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of nil)]
(fn [f] (into #{} (map :node) (r f))))) (fn [f] (into #{} (map :node) (r f)))))
ref-at (nodes-at ref) ref-at (nodes-at ref)
occ-at (nodes-at occ) occ-at (nodes-at occ)
@ -544,7 +620,7 @@
c (freeze/clip (assoc take/params :name "gappy") c (freeze/clip (assoc take/params :name "gappy")
{:face-1 (assoc @take/measured :detected det)}) {:face-1 (assoc @take/measured :detected det)})
sym (face-symbol (:clip c)) sym (face-symbol (:clip c))
res (symbol/resolver sym (:store c) pal/index-of)] res (symbol/resolver sym (:store c) pal/index-of nil)]
(doseq [f [39 40 50 59 60]] (doseq [f [39 40 50 59 60]]
(let [ops (res f)] (let [ops (res f)]
(if (contains? gap f) (if (contains? gap f)
@ -553,9 +629,9 @@
;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is ;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is
;; unchanged across the gap, because hiding and absence are different ;; unchanged across the gap, because hiding and absence are different
;; questions with different answers. ;; questions with different answers.
(is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) %) (is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) % nil)
(range take/frames)) (range take/frames))
(mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames)))))) (mapv #(ch/value-at (chan :mouth-in [:vis]) % nil) (range take/frames))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the rings are still rings ;; the rings are still rings
@ -603,7 +679,7 @@
shot (fn [f] shot (fn [f]
(let [r (raster/make W H) (let [r (raster/make W H)
mouth (filter #(= [:face-1 :mouth] (:node %)) mouth (filter #(= [:face-1 :mouth] (:node %))
((clip/resolver locked @store pal/index-of :main) f))] ((clip/resolver locked :main @store pal/index-of nil) f))]
(raster/clear! r (get pal/index-of :bg)) (raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r mouth) (raster/draw-ops! r mouth)
(vec (array-seq (:buf r))))) (vec (array-seq (:buf r)))))

6
frontend/test/arthur/flow/multi_face_test.cljs
View file

@ -35,7 +35,7 @@
(defn channel [entry subject node path] (defn channel [entry subject node path]
(get-in entry [:clip :symbols subject :nodes node :channels path])) (get-in entry [:clip :symbols subject :nodes node :channels path]))
(defn snapshot [c store f] (ops/snapshot ((clip/resolver c store pal/index-of :main) f))) (defn snapshot [c store f] (ops/snapshot ((clip/resolver c :main store pal/index-of nil) f)))
(defn by-node [c store f] (into {} (map (juxt :node identity)) (snapshot c store f))) (defn by-node [c store f] (into {} (map (juxt :node identity)) (snapshot c store f)))
(deftest subjects-share-local-names-without-sharing-blocks (deftest subjects-share-local-names-without-sharing-blocks
@ -178,8 +178,8 @@
(merge (dissoc (:nodes (clip/symbol clip :main)) :face-1) (merge (dissoc (:nodes (clip/symbol clip :main)) :face-1)
(assoc-in (get-in clip [:symbols :face-1 :nodes]) (assoc-in (get-in clip [:symbols :face-1 :nodes])
[:head :parent] :face))) [:head :parent] :face)))
nested (clip/resolver clip store pal/index-of :main) nested (clip/resolver clip :main store pal/index-of nil)
reference (clip/resolver flat store pal/index-of :main)] reference (clip/resolver flat :main store pal/index-of nil)]
(doseq [f [0 1 7 20 39]] (doseq [f [0 1 7 20 39]]
(let [a (ops/snapshot (nested f)) b (ops/snapshot (reference f))] (let [a (ops/snapshot (nested f)) b (ops/snapshot (reference f))]
(is (= (mapv (comp second :node) a) (mapv :node b))) (is (= (mapv (comp second :node) a) (mapv :node b)))

96
frontend/test/arthur/flow/regenerate_test.cljs
View file

@ -2,6 +2,7 @@
(:require [cljs.test :refer [deftest is testing]] (:require [cljs.test :refer [deftest is testing]]
[clojure.walk :as walk] [clojure.walk :as walk]
[arthur.demo.stage :as stage] [arthur.demo.stage :as stage]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.domain.project :as project] [arthur.domain.project :as project]
@ -256,3 +257,98 @@
(doseq [[_ n] (filter (comp #{:audio} :kind val) nodes)] (doseq [[_ n] (filter (comp #{:audio} :kind val) nodes)]
(is (contains? nodes (:linked-to n)) (is (contains? nodes (:linked-to n))
(str "the voice " (:id n) " still links to a node that is there"))))) (str "the voice " (:id n) " still links to a node that is there")))))
;; ---- corrections survive the thing they are corrections to ----
(defn- corrected
"Put one offset correction on a node's channel, as a hand edit would."
[entry node path values]
(update-in entry [:clip :symbols :face-1 :nodes node :channels path :over]
(fnil conj []) (ch/layer :by-hand [2 6] :offset values)))
(deftest regenerating-replaces-the-base-and-keeps-the-hand-correction
;; The loop the whole layer design exists for: generate motion, correct it by
;; hand, turn the generator's knob, keep the correction.
(let [width (count (:keys (channel @initial :iris-r [:xform :pos])))
before (corrected @initial :iris-r [:xform :pos] (ch/framed [3 -3]))
after (regenerate/change before
{:scope :feature :id :face-1/eye-r :knob :gaze-gain :value 2})
base (fn [entry] (dissoc (channel entry :iris-r [:xform :pos]) :over))]
(is (not= (base before) (base after)) "the base was regenerated")
(is (= (base (regenerate/change @initial
{:scope :feature :id :face-1/eye-r :knob :gaze-gain :value 2}))
(base after))
"and regenerated to exactly what it would have been without the correction")
(is (= [(ch/layer :by-hand [2 6] :offset (ch/framed [3 -3]))]
(:over (channel after :iris-r [:xform :pos])))
"while the correction came across untouched, and unconflicted")
(is (empty? (ch/conflicts (channel after :iris-r [:xform :pos]))))
(is (empty? (clip/problems (:clip after))))
(is (= width (count (:keys (channel after :iris-r [:xform :pos]))))
"sanity: this channel is keyed, so the correction rides a keyed base")))
(deftest a-correction-does-not-stop-the-head-following-its-measurement
;; `regenerate-head` leaves the authored channels alone once somebody has
;; PLACED the head by hand — but a correction is not a placement. Comparing
;; the bases is what keeps the first correction from freezing the part it was
;; made to adjust.
(let [plain (regenerate/change @initial
{:scope :subject :id :face-1 :knob :anchor-avg :value 4})
path [:clip :symbols :face-1 :nodes :head]
prop (first (keys (get-in @initial (conj path :measured))))
shape (ch/value-shape (get-in @initial (conj path :channels prop)))
nudge (ch/layer :by-hand [2 6] :offset
(ch/framed (if (= :scalar shape) 1 (vec (repeat shape 0.5)))))
before (update-in @initial (conj path :channels prop :over) (fnil conj []) nudge)
after (regenerate/change before
{:scope :subject :id :face-1 :knob :anchor-avg :value 4})
base (fn [entry] (dissoc (get-in entry (conj path :channels prop)) :over))]
(is (= (base plain) (base after))
"the head's base followed the re-measurement, correction and all")
(is (= [nudge] (:over (get-in after (conj path :channels prop))))
"and the correction is the one that was made, unmarked")
(is (empty? (ch/conflicts (get-in after (conj path :channels prop)))))
(is (empty? (clip/problems (:clip after))))))
(deftest a-regeneration-that-outgrows-a-correction-records-the-conflict
;; `:verts` is the mouth's vertex count, so turning it IS the topology change
;; the lane model names. A geometry correction is a row of components, and a
;; base with a different number of them cannot take it. Marked, not dropped:
;; the hand work stays in the document for a person to move, and the picture
;; meanwhile is the base.
(let [path [:geom :pts]
fitted (fn [entry]
(ch/layer :by-hand [2 6] :offset
(ch/framed (vec (repeat (ch/value-shape (channel entry :mouth path))
0.5)))))
with (fn [layer] (update-in @initial
[:clip :symbols :face-1 :nodes :mouth :channels path :over]
(fnil conj []) layer))
before (with (fitted @initial))
after (regenerate/change before
{:scope :feature :id :face-1/mouth :knob :verts :value 10})
layer (first (:over (channel after :mouth path)))]
(is (not= (ch/value-shape (channel @initial :mouth path))
(ch/value-shape (channel after :mouth path)))
"the mouth really does have a different number of points now")
(is (= :by-hand (:id layer)) "the correction is still in the document")
(is (re-find #"different shape" (:conflict layer)))
(is (= [:by-hand] (mapv :id (ch/conflicts (channel after :mouth path)))))
(is (empty? (clip/problems (:clip after)))
"a recorded conflict does not make the document unloadable")
(is (= (dissoc (channel (regenerate/change @initial
{:scope :feature :id :face-1/mouth :knob :verts :value 10})
:mouth path)
:over)
(dissoc (channel after :mouth path) :over))
"and the base is what it would have been with no correction at all")
;; And the document says so once, for a view to offer.
(is (= [{:id :by-hand :symbol :face-1 :node :mouth :channel [:geom :pts]}]
(mapv #(dissoc % :why) (clip/conflicts (:clip after)))))
;; A mouth edit that does not change the vertex count leaves it applying.
(let [fine (regenerate/change before
{:scope :feature :id :face-1/mouth :knob :aperture-cut :value 0.2})]
(is (nil? (:conflict (first (:over (channel fine :mouth path))))))
(is (empty? (ch/conflicts (channel fine :mouth path))))
(is (empty? (clip/conflicts (:clip fine))))
(is (empty? (clip/problems (:clip fine)))))))

4
frontend/test/arthur/support/ops.cljs
View file

@ -52,11 +52,11 @@
"(fn [f] -> snapshot) through `eval-frame`, the specification." "(fn [f] -> snapshot) through `eval-frame`, the specification."
([sym store] (specified sym store pal/index-of)) ([sym store] (specified sym store pal/index-of))
([sym store palette] ([sym store palette]
(fn [f] (snapshot (symbol/eval-frame sym f store palette))))) (fn [f] (snapshot (symbol/eval-frame sym f store palette nil)))))
(defn resolved (defn resolved
"(fn [f] -> snapshot) through `resolver`, the playback path." "(fn [f] -> snapshot) through `resolver`, the playback path."
([sym store] (resolved sym store pal/index-of)) ([sym store] (resolved sym store pal/index-of))
([sym store palette] ([sym store palette]
(let [res (symbol/resolver sym store palette)] (let [res (symbol/resolver sym store palette nil)]
(fn [f] (snapshot (res f)))))) (fn [f] (snapshot (res f))))))

275
frontend/test/browser/lane.mjs Normal file
View file

@ -0,0 +1,275 @@
// Local editor smoke test. Uses the in-memory blank document and disables the
// project route, so it never creates an account, project, or server-side write.
import { spawn } from 'node:child_process';
import { mkdtempSync, rmSync } from 'node:fs';
import { tmpdir } from 'node:os';
import { join } from 'node:path';
import assert from 'node:assert/strict';
const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/';
const profile = mkdtempSync(join(tmpdir(), 'arthur-sequence-'));
const port = 9335;
const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
'--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run',
'--no-default-browser-check', '--mute-audio', '--window-size=1440,1000',
`--user-data-dir=${profile}`, `--remote-debugging-port=${port}`, url,
], { stdio: 'ignore' });
const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));
let ws;
try {
let target;
for (let i = 0; i < 100 && !target; i++) {
await sleep(100);
try {
target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json()))
.find(t => t.type === 'page' && t.url.startsWith(url));
} catch { /* browser starting */ }
}
assert(target, 'browser exposes the editor page');
ws = new WebSocket(target.webSocketDebuggerUrl);
await new Promise((resolve, reject) => { ws.onopen = resolve; ws.onerror = reject; });
let serial = 0;
const pending = new Map();
const errors = [];
ws.onmessage = ({ data }) => {
const msg = JSON.parse(data);
if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails);
if (msg.id && pending.has(msg.id)) {
const { resolve, reject } = pending.get(msg.id);
pending.delete(msg.id);
if (msg.error) reject(new Error(JSON.stringify(msg.error)));
else resolve(msg.result);
}
};
const send = (method, params = {}) => new Promise((resolve, reject) => {
const id = ++serial;
pending.set(id, { resolve, reject });
ws.send(JSON.stringify({ id, method, params }));
});
const evaluate = async expression => {
const r = await send('Runtime.evaluate', { expression, returnByValue: true, awaitPromise: true });
if (r.exceptionDetails) throw new Error(JSON.stringify(r.exceptionDetails));
return r.result.value;
};
await send('Runtime.enable');
for (let i = 0; i < 100; i++) {
if (await evaluate('typeof arthur !== "undefined" && !!arthur.events?.ui && !!document.querySelector("canvas.stage")')) break;
await sleep(100);
}
await evaluate(`(() => {
const k = cljs.core.keyword;
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test')));
window.laneSnapshot = () => {
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(entry);
};
return true;
})()`);
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
// strip, or as a row in one of the strip's menus. So the test asks for it by
// name and this finds it — opening each menu in turn to look — rather than the
// test knowing which menu anything ended up in. An icon button is matched on
// its `aria-label`, which is also what a screen reader is told it is.
// 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'];
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 reveal = async label => {
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(`(() => {
const b = [...document.querySelectorAll('${where}')].find(${named(label)});
if (!b || b.disabled) return false;
b.click(); return true;
})()`), `enabled control: ${label}`);
await sleep(180);
await shut();
};
const shot = async () => (await evaluate('laneSnapshot()'));
const instances = s => Object.values(s.clip.symbols.main.nodes).filter(n => n.kind === 'instance')
.sort((a, b) => a.time.at - b.time.at);
await click('lane');
await click('new drawing');
await click('hold +');
await click('hold +');
await click('hold +');
await click('new drawing');
let s = await shot();
assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 4], [4, 1]]);
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 2);
assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1);
assert.equal(await evaluate(`cljs.core.get_in(cljs.core.deref(re_frame.db.app_db),
cljs.core.vector(cljs.core.keyword('playback'), cljs.core.keyword('frame')))`), 4,
'new drawing seeks to its cel');
// Shorten this test shot to the occupied extent, purely in memory.
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();
assert.deepEqual(s.clip, before.clip, 'refused overflow makes no document change');
assert.equal(s.history.done.length, before.history.done.length);
await click('extend shot and apply');
s = await shot();
assert.equal(s.clip.symbols.main.frames, 6);
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
// made first so these assertions are about content and not about overflow.
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')), 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);
await click('timeline');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 5);
assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: lane commands agree from timeline and cel sheet; no server writes');
} finally {
if (ws?.readyState === WebSocket.OPEN) {
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));
await sleep(350);
}
ws?.close();
chrome.kill();
await new Promise(resolve => { if (chrome.exitCode !== null || chrome.signalCode !== null) resolve(); else chrome.once('exit', resolve); });
try {
rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 });
} catch (error) {
console.warn(`Temporary browser profile retained at ${profile}: ${error.code}`);
}
}

19
frontend/test/browser/take.mjs
View file

@ -185,7 +185,7 @@ const PROBE = `(() => {
w: c.width, h: c.height, drawn, tones: [...tones].length, toneSet: [...tones], w: c.width, h: c.height, drawn, tones: [...tones].length, toneSet: [...tones],
cx: drawn ? cx / drawn : null, cy: drawn ? cy / drawn : null, cx: drawn ? cx / drawn : null, cy: drawn ? cy / drawn : null,
hash: h >>> 0, hash: h >>> 0,
frame: document.querySelector('.time .pane-head .dim')?.textContent ?? '', frame: document.querySelector('.time .pane-head .at-frame')?.textContent ?? '',
// What the top bar says about the document. The media pool holds the OPEN // What the top bar says about the document. The media pool holds the OPEN
// document's library now and no longer names documents at all, so the status // document's library now and no longer names documents at all, so the status
// line is the page's own answer to "what am I looking at". // line is the page's own answer to "what am I looking at".
@ -202,7 +202,7 @@ const PROBE = `(() => {
// knows which frame it wants, not how long the clip it is looking at happens to // knows which frame it wants, not how long the clip it is looking at happens to
// be, and reading it here is one place instead of every call site. // be, and reading it here is one place instead of every call site.
const SEEK = (f) => `(() => { const SEEK = (f) => `(() => {
const read = document.querySelector('.time .pane-head .dim').textContent; const read = document.querySelector('.time .pane-head .at-frame').textContent;
// Split, not a regex: this is inside a template literal, where an escaped // Split, not a regex: this is inside a template literal, where an escaped
// slash collapses to a bare one and the two together open a line comment that // slash collapses to a bare one and the two together open a line comment that
// eats the rest of the statement. The readout is "12 / 229" and nothing else. // eats the rest of the statement. The readout is "12 / 229" and nothing else.
@ -216,7 +216,7 @@ const SEEK = (f) => `(() => {
clientY: box.top + box.height / 2, clientY: box.top + box.height / 2,
})); }));
ruler.dispatchEvent(new PointerEvent('pointerup', { bubbles: true, pointerId: 1 })); ruler.dispatchEvent(new PointerEvent('pointerup', { bubbles: true, pointerId: 1 }));
return document.querySelector('.time .pane-head .dim').textContent; return document.querySelector('.time .pane-head .at-frame').textContent;
})()`; })()`;
// Everything the page has to say about loading, saving and opening. Read off the // Everything the page has to say about loading, saving and opening. Read off the
@ -231,10 +231,15 @@ const STATUS = `[...document.querySelectorAll('.top .status, .pool .pane-body >
// pane each one lived in would be a second copy of the layout. // pane each one lived in would be a second copy of the layout.
// //
// `firstChild` is the label: a media-pool row has a second line in a child span, // `firstChild` is the label: a media-pool row has a second line in a child span,
// so matching on textContent would never find "take". // so matching on textContent would never find "take". `aria-label` is the same
// label for a control whose face is a glyph — the transport's play and pause —
// and it is the right fallback rather than a test hook, because it is already
// what that button is called for anybody not reading it with their eyes.
const CLICK = (label) => `(() => { const CLICK = (label) => `(() => {
const want = ${JSON.stringify(label)};
const b = [...document.querySelectorAll('button')] const b = [...document.querySelectorAll('button')]
.find((b) => (b.firstChild?.textContent ?? '').trim() === ${JSON.stringify(label)}); .find((b) => (b.firstChild?.textContent ?? '').trim() === want
|| b.getAttribute('aria-label') === want);
if (!b || b.disabled) return false; if (!b || b.disabled) return false;
b.click(); b.click();
return true; return true;
@ -626,7 +631,7 @@ async function main() {
check(irisSlider !== null, 'the stage eye has an iris-size slider'); check(irisSlider !== null, 'the stage eye has an iris-size slider');
if (irisSlider) { if (irisSlider) {
check(await page.eval(CLICK('play')), 'the stage starts playing'); check(await page.eval(CLICK('play')), 'the stage starts playing');
const startFrame = await page.eval(`Number(document.querySelector('.time .pane-head .dim').textContent.match(/\\d+/)[0])`); const startFrame = await page.eval(`Number(document.querySelector('.time .pane-head .at-frame').textContent.match(/\\d+/)[0])`);
await page.send('Input.dispatchMouseEvent', { await page.send('Input.dispatchMouseEvent', {
type: 'mousePressed', x: irisSlider.x, y: irisSlider.y, button: 'left', clickCount: 1, type: 'mousePressed', x: irisSlider.x, y: irisSlider.y, button: 'left', clickCount: 1,
}); });
@ -638,7 +643,7 @@ async function main() {
check(preview !== null, 'the slider updates the stage preview', preview ?? debug); check(preview !== null, 'the slider updates the stage preview', preview ?? debug);
check(debug.includes(':face-1/eye-r') && debug.includes('tier 1 only'), check(debug.includes(':face-1/eye-r') && debug.includes('tier 1 only'),
'the panel reports the affected feature and tier', debug); 'the panel reports the affected feature and tier', debug);
const endFrame = await page.eval(`Number(document.querySelector('.time .pane-head .dim').textContent.match(/\\d+/)[0])`); const endFrame = await page.eval(`Number(document.querySelector('.time .pane-head .at-frame').textContent.match(/\\d+/)[0])`);
check(endFrame > startFrame, 'playback continues during tuning', `${startFrame} -> ${endFrame}`); check(endFrame > startFrame, 'playback continues during tuning', `${startFrame} -> ${endFrame}`);
await page.eval(CLICK('pause')); await page.eval(CLICK('pause'));
} }

212
static/arthur/app.css
View file

@ -81,10 +81,14 @@ audio { display: none; }
display: grid; display: grid;
height: 100%; height: 100%;
grid-template-columns: var(--label) minmax(0, 1fr) 250px; grid-template-columns: var(--label) minmax(0, 1fr) 250px;
grid-template-rows: 30px minmax(0, 1fr) 232px; /* The location bar is its own row and takes its height from the stage, not
from the timeline: it exists to explain what the timeline is showing, so
paying for it in timeline rows would be the wrong trade. */
grid-template-rows: 30px minmax(0, 1fr) 21px 232px;
grid-template-areas: grid-template-areas:
"top top top" "top top top"
"pool view params" "pool view params"
"loc loc loc"
"time time time"; "time time time";
gap: 1px; gap: 1px;
background: var(--line); background: var(--line);
@ -94,6 +98,7 @@ audio { display: none; }
.pool { grid-area: pool; } .pool { grid-area: pool; }
.view { grid-area: view; } .view { grid-area: view; }
.params { grid-area: params; } .params { grid-area: params; }
.loc { grid-area: loc; }
.time { grid-area: time; } .time { grid-area: time; }
/* Every pane is its own scroll container. `min-height: 0` is what lets a grid /* Every pane is its own scroll container. `min-height: 0` is what lets a grid
@ -123,6 +128,33 @@ audio { display: none; }
border-bottom: 1px solid var(--line); border-bottom: 1px solid var(--line);
color: var(--dim); color: var(--dim);
letter-spacing: .03em; letter-spacing: .03em;
/* One line, always. A strip of controls that reflows to two lines resizes the
pane under it, and the pane under this one is the timeline. */
white-space: nowrap;
}
.pane-head .readout { color: var(--fg); }
/* A pick-one that looks like the other pick-ones. A native select in this strip
draws a tall white well and a chevron of the browser's choosing, which reads
as a form field among buttons; the app's own idiom for "choose one of these"
is `label ▾`, and this IS one of those. So: the select keeps the behaviour and
the keyboard, and borrows the look. The arrow is the wrapper's, because an
option list cannot carry one. */
.pick { position: relative; display: inline-flex; align-items: center; }
.pick > select {
appearance: none;
background: var(--pane);
padding: 1px 15px 1px 6px;
cursor: pointer;
}
.pick > select:hover { background: #fff; }
.pick::after {
content: "▾";
position: absolute;
right: 5px;
color: var(--dim);
pointer-events: none;
} }
.pane-head .spacer { flex: 1; } .pane-head .spacer { flex: 1; }
@ -173,6 +205,47 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
.dim { color: var(--dim); } .dim { color: var(--dim); }
.warn { color: var(--warn); } .warn { color: var(--warn); }
/* 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
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
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.
The negative margin collapses the doubled border between two buttons into
one hairline. A pressed button then has to be raised, or the neighbour's
plain border covers half of its accent one. */
.group, .seg { display: flex; align-items: center; }
.group > button, .seg > button { border-radius: 0; margin-left: -1px; }
.group > button:first-child, .seg > button:first-child { margin-left: 0; border-radius: 2px 0 0 2px; }
.group > button:last-child, .seg > button:last-child { border-radius: 0 2px 2px 0; }
.group > button.on, .seg > button.on { position: relative; z-index: 1; }
/* The rule between two groups of unrelated controls. Shorter than the strip, so
it reads as a division of the row rather than as a wall across it. */
.sep { flex: 0 0 1px; width: 1px; height: 13px; background: var(--line); }
/* An icon button. The glyph is inked in `currentColor`, so `.on` colours it
with the same rule that colours a word. 11px to sit on 11px type. */
button.ico { padding: 2px 5px; line-height: 0; }
button.ico > svg { display: block; width: 11px; height: 11px; }
/* Play is the one control in the strip you aim at without looking. */
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
stop the controls after it being nudged about as the count passes 9 and 99. */
.readout { font-variant-numeric: tabular-nums; }
/* The answer to a refusal rather than a standing command — `lane-retry` only
exists because something was declined and named this as the way through. */
button.retry { border-color: var(--sel); color: var(--sel); }
/* -------------------------------------------------------------------------- /* --------------------------------------------------------------------------
top bar */ top bar */
@ -296,6 +369,39 @@ a.brand { text-decoration: none; }
.undo > .undo-list { padding: 0 4px; margin-right: 4px; border-left: 0; border-radius: 0 2px 2px 0; } .undo > .undo-list { padding: 0 4px; margin-right: 4px; border-left: 0; border-radius: 0 2px 2px 0; }
.menu.menu-left { left: 0; right: auto; } .menu.menu-left { left: 0; right: auto; }
/* A menu dropping out of a PANE HEAD. Fixed and placed by `ui/menu` against the
button, because a pane clips its own overflow and an absolutely positioned
panel would be cut off at the pane's edge — invisibly, and more of it the
longer the menu gets. `top`/`bottom`/`left`/`max-height` all come from there.
Wide enough that a command's one-line explanation is one line. At 215px every
`.sub` in the cel menu wrapped, which doubled the panel's height for no gain:
the explanations are the reason these are menu rows and not buttons, so they
get the width to be read in. */
.menu.menu-drop {
position: fixed;
/* BOTH offsets on each axis are reset, and `ui/menu` sets exactly one of each
inline. Leaving `.menu`'s own `top` standing alongside an inline `bottom`
over-constrains the box, and a fixed box given both offsets takes its HEIGHT
from them — which, from a toolbar near the foot of the window, computes
negative and collapses the panel to its padding with the commands still
inside it. */
top: auto;
bottom: auto;
left: auto;
right: auto;
width: 272px;
overflow: auto;
}
.menu-note { padding: 1px 6px 5px; }
/* A disabled row still says what the command is FOR. That is the whole trade:
a greyed button hides its reason in a `title`, a greyed row prints it. */
.menu-item:disabled { opacity: .5; cursor: default; }
.menu-item:disabled:hover { background: none; }
.menu-item { padding: 3px 6px; }
.menu-item .sub { font-size: 10px; line-height: 1.3; white-space: normal; }
/* The one way to hand the document to somebody else, so it looks like one. */ /* The one way to hand the document to somebody else, so it looks like one. */
button.share-button { background: var(--sel); color: #fff; border-color: var(--sel); font-weight: 600; padding: 1px 12px; } button.share-button { background: var(--sel); color: #fff; border-color: var(--sel); font-weight: 600; padding: 1px 12px; }
button.share-button:hover, button.share-button.on { filter: brightness(1.1); } button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
@ -435,6 +541,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.tab:hover .close, .tab.on .close { visibility: visible; } .tab:hover .close, .tab.on .close { visibility: visible; }
.tab .close:hover { background: var(--hair); color: var(--fg); } .tab .close:hover { background: var(--hair); color: var(--fg); }
.trace-opacity { width: 64px; }
.palette-bar label.dim { display: inline-flex; align-items: center; gap: 2px; white-space: nowrap; }
.palette-bar { .palette-bar {
display: flex; display: flex;
align-items: center; align-items: center;
@ -555,6 +664,55 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
border-radius: 2px; border-radius: 2px;
} }
/* --------------------------------------------------------------------------
the location bar
Where you are, above the timeline that draws it. Chrome-coloured like a pane
head, because that is what it is to the two temporal views below it — but it
is not one of their heads, since it says the same thing whichever is showing. */
.loc {
display: flex;
align-items: center;
gap: 7px;
padding: 0 7px;
min-width: 0;
background: var(--chrome);
color: var(--dim);
white-space: nowrap;
overflow: hidden;
}
.crumbs { display: flex; align-items: center; gap: 1px; min-width: 0; overflow: hidden; }
/* A crumb is a place, not a command: no border and no fill until it is pointed
at. The trail has to read as one sentence, and five outlined buttons in a row
read as five things to press. */
.crumb {
flex: 0 1 auto;
min-width: 0;
overflow: hidden;
text-overflow: ellipsis;
padding: 1px 4px;
border: 1px solid transparent;
border-radius: 2px;
background: none;
color: var(--dim);
}
.crumb:hover:not(:disabled) { background: var(--sel-bg); color: var(--fg); }
/* The last crumb is the selection itself. Weight and full contrast say so; the
fill and accent border `button.on` would otherwise give it are undone here,
because a filled crumb reads as a pressed control and the thing it marks is
where you ARE, not something switched on. */
.crumb.on { color: var(--fg); font-weight: 600; background: none; border-color: transparent; }
.crumb.lane::before { content: "≡ "; color: var(--dim); font-weight: 400; }
.crumb-sep { flex: 0 0 auto; color: var(--line); }
.loc-fact { flex: 0 0 auto; }
.loc-fact::before, .loc-shared::before { content: "· "; color: var(--line); }
.loc-shared { flex: 0 0 auto; display: inline-flex; align-items: baseline; gap: 5px; }
.loc .spacer { flex: 1; }
/* -------------------------------------------------------------------------- /* --------------------------------------------------------------------------
timeline */ timeline */
@ -650,10 +808,10 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.tl-twist:disabled { opacity: 0; cursor: default; } .tl-twist:disabled { opacity: 0; cursor: default; }
.tl-delete { margin-left: auto; padding: 0 4px; border: 0; background: none; color: var(--dim); } .tl-delete { margin-left: auto; padding: 0 4px; border: 0; background: none; color: var(--dim); }
.tl-delete:hover { color: var(--fg); } .tl-delete:hover { color: var(--fg); }
.tl-solo { margin-left: auto; padding: 0 4px; border: 0; background: none; color: var(--dim); font-size: 10px; } .tl-solo, .tl-trace { margin-left: auto; padding: 0 4px; border: 0; background: none; color: var(--dim); font-size: 10px; }
.tl-solo:hover { color: var(--fg); } .tl-solo:hover, .tl-trace:hover { color: var(--fg); }
.tl-solo.on { color: var(--sel); font-weight: 600; } .tl-solo.on, .tl-trace.on { color: var(--sel); font-weight: 600; }
.tl-solo + .tl-delete { margin-left: 0; } .tl-solo + .tl-delete, .tl-trace + .tl-solo { margin-left: 0; }
/* The ruler and the corner above the labels stay at the top of the body while /* The ruler and the corner above the labels stay at the top of the body while
the rows scroll under them: the ruler is the scrubber, and scrolling down to the rows scroll under them: the ruler is the scrubber, and scrolling down to
@ -769,6 +927,50 @@ 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;
}
.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; }
/* -------------------------------------------------------------------------- /* --------------------------------------------------------------------------
the video -> symbol dialog */ the video -> symbol dialog */