diff --git a/docs/correction-authoring-plan.md b/docs/correction-authoring-plan.md index 5823fc5..9997d81 100644 --- a/docs/correction-authoring-plan.md +++ b/docs/correction-authoring-plan.md @@ -3,6 +3,8 @@ Written against `2f1c9b9` (2026-09-30), following the lane handoff in `7a54bfc`. Implemented on `codex/correction-authoring`; this now records the scope and acceptance criteria of that implementation. +The cel-sheet targeting work described below was removed with the cel-sheet UI +on 2026-10-01; it remains here only as history of that implementation. Read [lane-handoff.md](lane-handoff.md) and the correction section of [lane-model.md](lane-model.md) first. Their ownership and document rules remain the foundation. The choices below settle the first implementation's scope. diff --git a/docs/lane-handoff.md b/docs/lane-handoff.md index 912df41..b164ed0 100644 --- a/docs/lane-handoff.md +++ b/docs/lane-handoff.md @@ -1,11 +1,14 @@ -# Lane and cel handoff +# Lane and symbol-clip handoff -Status (2026-09-30): the lane model is implemented through its commands, its -first two views, and correction authoring. Cels are ordinary nodes with their -own playback clock; the timeline draws them as one row and the cel sheet draws -frames down and lanes across. Both views issue the same commands. Rotation and -position corrections can be authored as Constant, Ramp, or Return motion on a -lane or cel, survive regeneration, and expose conflicts for removal or retry. +Status (2026-10-01): the timeline is the one timing interface. A lane is a +generic non-overlapping row of symbol clips; it is not a special drawing type. +Dropping a library symbol makes a naturally playing clip, while creating a new +empty symbol makes a one-frame held clip at the playhead. With no destination +lane, either operation creates one. Existing legacy root symbol rows can be +dragged into a lane. Blocks move by mouse; edge drags claim time by trimming +neighbors; Shift-edge drags ripple every later clip; and the center of a shared +cut composes the two edge edits into a rolling edit. Linked audio follows picture +moves while its edges remain independently trimmable. The commits beginning at `3d3c1bb` are the argument for the model and are worth reading before touching what they did — they are the design record, more than @@ -38,9 +41,10 @@ and do not reintroduce the others. | word | means | | --- | --- | | instance | the `:kind`. The general thing, anywhere in a document | -| cel | an instance in a lane. One drawing, held for some duration | +| clip | an instance in a lane. It can hold one source frame or play a symbol naturally | +| cel | specifically a one-frame source held over a clip's duration; the empty-symbol/drawing creation policy | | lane | a group with `:layout :sequence` | -| drawing | the content a cel names — an ordinary symbol | +| drawing | content authored into a symbol; not a different timeline node type | | placement | ONLY where a node sits: `nest/placement`, and the transform that puts a face on the stage. Never the node itself | `occurrence` and `exposure` are not words for a cel. **`exposure` means something @@ -53,8 +57,6 @@ on purpose: the layout names the RULE — children follow one another and may no overlap — and a group carrying it is called a lane. `node/lane?` is where they 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 @@ -83,26 +85,61 @@ decision, not a cleanup. - **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. +- **A clip is not a row.** Rows, expansion and selection are editor state. The + document has never known about rows and must not learn — which is what let + the row model change three times in one sitting (blocks, then a + selected-clip portal, then sound lanes under the audio heading) without + touching a single document. +- **A lane is generic.** Drawing creation, library placement, and adopting an + existing root instance all produce the same child instance shape. The only + difference is playback policy: a new empty drawing holds source frame zero; + a dropped library symbol plays at speed one. +- **Every symbol is born with a lane,** `clip/lane-node`, id `:lane`. A symbol + with none had nowhere to drop a thing, which made the first drop into any + symbol a special case. An unaimed drop fills an EMPTY lane that is already + there and otherwise makes a new one; it never takes an occupied lane nobody + pointed at, because placement claims time and would trim or delete what was + in it. +- **Placement claims time.** Lanes never store overlaps. A new or extended clip + trims, removes, or splits whatever previously owned the claimed interval. + Real compositing overlap uses another lane, where ordering remains explicit. + +## The timeline opens the whole document + +Expanding a lane opens exactly one clip — the selected one — and that portal +opens the lanes and nodes of the symbol it places, recursively, mapped into +the open symbol's ruler. The portal follows the LINEAGE of the selection, so +working on something nested keeps the rows that revealed it open. A held clip +opens too, with its rows marked `:unmapped?`: shown across the hold, with no +keys and no draggable edges, because a frozen clock gives its frames no place +on this ruler. `docs/lane-nesting-notes.md` has the reasoning and what is +still missing. + +Double-clicking a clip opens the symbol it places as a tab, the same as +double-clicking that symbol in the pool. Shift while dragging a clip body +turns the temporal move into a structural one — see the nesting notes for why +that is mostly refused today. + +## Current timeline interaction + +- Creating a symbol inside an aimed lane creates a one-frame held clip at the + playhead. With no aimed lane it first creates a lane. Drawing a polygon uses + the existing clip there or creates the same one-frame clip when the frame is + empty. +- Dropping any library symbol into a lane creates a natural-duration playing + clip. Dropping it on unclaimed timeline or stage space first creates a lane. +- Dragging a clip body moves it. A linked audio node follows a picture move; + moving or trimming the audio itself remains independent. +- Dragging a right edge changes its endpoint. Growth consumes adjacent spans + instead of overlapping them. Shift-drag inserts or removes lane time by moving + every later clip by the same delta. +- At a shared boundary, the left and right hit zones trim one side. The center + is a rolling edit: right-edge resize followed by left-edge resize at one frame. +- Split, trim-in, and trim-out are direct buttons and are disabled without an + editable selected span. Movement is a mouse gesture, not a toolbar command. ## Next steps, in order -The cel sheet now supports rectangular selection by pointer drag, Shift-click, -and Shift-arrow, plus an editor-local clipboard (Cmd/Ctrl C/X/V). Paste -overwrites the destination rectangle, including copied gaps, and reuses drawing -symbols. Partial cels retain their local clocks, playback and corrections. -Delete clears frames without closing time. Each cut, paste or clear is one -history transaction. The clipboard belongs to the mounted sheet and current -document; it is not a system clipboard interchange format. - -A selected held cel has a bottom-right resize handle. Dragging previews its new -extent and commits one ripple edit on release; Escape cancels. Overflow uses -the existing explicit shot-extension retry. Rectangle edits currently require -lanes on the sheet's clock and paste must fit within the shot and available -columns. Insert-paste, moving rectangles, and repeating multi-cel patterns with -the handle remain future work. - The implemented correction slice and its remaining UI limits are recorded in [Correction authoring](correction-authoring-plan.md). @@ -157,9 +194,16 @@ The implemented correction slice and its remaining UI limits are recorded in ## Known gaps and traps -- **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. +- **Audio is a clip in a lane too, and a lane holds one kind.** A sound placed + from the pool lands in a lane and is moved and trimmed by the same commands + as picture. The capability the earlier note asked for is the homogeneity + rule rather than a field: `symbol/lane-problems` refuses a lane holding both + kinds, and `lane/place-symbol` and `lane/adopt` refuse BEFORE claiming time, + because placement claims time and would otherwise have deleted the sound to + make room for the picture and left a valid document behind. Audio nested + inside a placed symbol — a take's own sound — is still shown flattened by + `nest/audio-tracks`; what is in a lane of the open symbol is drawn as a lane + and not flattened twice. - **`:z` is required on cels and means nothing there.** A lane never has two 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 — @@ -173,9 +217,9 @@ The implemented correction slice and its remaining UI limits are recorded in pose selection and plate drawings/tracing, instance-specific picture-rate 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. +- **Slip and retime are still absent.** The timeline action strip now applies + split/trim uniformly to a selected root or lane clip, but source-time slip and + retime still need their own proved semantics before they become controls. - **`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 @@ -187,14 +231,14 @@ The implemented correction slice and its remaining UI limits are recorded in From `frontend/`: - npx shadow-cljs compile test && node out/node-tests.js # 437 tests, 5,804 assertions + npx shadow-cljs compile test && node out/node-tests.js # 469 tests, 9,592 assertions npx shadow-cljs compile app # the bundle Django serves npx shadow-cljs 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 + node --experimental-websocket test/browser/lane.mjs # generic symbol-lane 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 diff --git a/docs/lane-is-a-view-notes.md b/docs/lane-is-a-view-notes.md new file mode 100644 index 0000000..989d02a --- /dev/null +++ b/docs/lane-is-a-view-notes.md @@ -0,0 +1,72 @@ +# Implementation notes — "A lane is a view" + +Running log for `docs/lane-is-a-view-plan.md`. `[ ]` not started, `[~]` in +progress, `[x]` done with `npm test` green. + +Baseline at `fb38990`: 475 tests, 9621 assertions, 0 failures. + +## Order of work + +The plan's seven steps, re-grouped — see *Deviation from the plan's order* below. + +- [x] A. Domain: `symbol/children`, `symbol/lane?`, `symbol/overlaps`, + `lane.cljs` → `span.cljs`, the overlap check in `span/finish` + (plan steps 3, 4, and the domain half of 5) +- [x] B. Events: re-base callers and remove lane-node-specific commands; keep + explicit `::new-lane` and cross-lane adoption (plan step 5) +- [x] C. UI: row per symbol, explicit lane creation, and drag handling + (plan steps 1, 2, and the UI half of 5) +- [x] D. Audio: delete `holds-other?`, the mixed-lane refusal, the `in-lane` + filter in `sound-rows` (plan step 6) +- [x] E. Tests: `domain/sequence_test`, `events/lane_test`, `browser/lane.mjs` +- [x] F. Shift-to-reparent still works, untouched (plan step 7) + +Not in this pass — see *Left for a second pass*: tearing out the held cel, the +instance-playback control, drawing a loop's repeats, the audio period guard. + +## Deviation from the plan's order + +The plan's steps 1 and 2 are display work that keys off "a symbol's children", +and step 3 is what MAKES the cels a symbol's children. Until then a cel's +`:parent` is the lane node, so there is nothing for the display to read: step 2 +cannot draw "a symbol's children as blocks" while the children belong to a +group. So the data model moves first (A) and the display follows (C). The +content of each step is unchanged; only the order is. + +The one thing this gives up is the plan's promise that every step leaves the +editor usable — between A and C the timeline draws the new shape with the old +code. `npm test` is green at each step either way. + +## Decisions taken + +1. **Lane mode is `:display :lane` on the SYMBOL** — plan's recommendation 2, + and open question 1 answered "the symbol, not the instance". A symbol placed + twice is drawn as a lane in both places. Added to `symbol/symbol-keys` and to + `leaf/leaves`' `select-keys` so it saves like `:frames`. +2. **A symbol's children are its parent-less nodes** that have a placed span. + The plan's step 6 settles it: "an audio node is already a parent-less child + of a symbol, which is exactly the new shape". Span-less nodes — a shape on + screen for the whole shot — are not in the sequence and are skipped, which is + also what stops the commands destructuring a nil span. +3. **A symbol holds at most one sequence.** It follows from 1 and 2: the + container is the symbol. Two lanes of picture is now two symbols placed in a + third, which is what compositing already was. +4. **The open symbol gets a row of its own in lane mode**, and only then. The + blocks have to sit on a row and the open symbol had none; expanding it turns + its children into ordinary rows. Not a row always, which would shift every + row in the pane for no gain. +5. **Open question 2** — a lane row's edge drag trims the PLACING INSTANCE's + span, via `span/resize-out`, like the handle on every other row. Rippling + the children is what the cel blocks' own edges already do, and giving one + handle two meanings is what the plan refuses elsewhere. +6. **Open question 3** — the lane work first, the held cel after. The plan says + they are independent, and the held cel is joined to a loop control that does + not exist yet; doing it second costs one more pass over `lane_test`'s + fixtures and risks nothing. +7. **Lane creation stays explicit.** A blank document and `new symbol` create + ordinary symbols. The separate `new → lane` command creates and places a + symbol with `:display :lane`, aims it for immediate drawing or dropping, and + always adds it at the top of the open symbol rather than nesting it in the + previously aimed lane. + +## Notes diff --git a/docs/lane-is-a-view-plan.md b/docs/lane-is-a-view-plan.md new file mode 100644 index 0000000..cc136d6 --- /dev/null +++ b/docs/lane-is-a-view-plan.md @@ -0,0 +1,301 @@ +# A lane is a view + +Plan, 2026-10-01, written at `2dc5735`. It undoes the lane model as a thing in +the document and keeps what it was for. Build on what is there and tear out +half of it. + +## The decision + +> A lane is a view over a symbol with sequential, non-overlapping children. + +Nothing in the document is a lane. There is no lane type, no lane group, no +`:layout :sequence`, no lane commands and no lane validation. The word +survives in exactly two places: the UI, where a symbol can be DRAWN as a lane, +and the drag handling that re-spans a symbol's children while it is being +drawn that way. + +The display model goes back to a row per symbol. A symbol in lane mode draws +its children as blocks on its own single row; expanded, they are rows like +anything else. Everything else is an ordinary row that expands into what it +places. + +## What a lane was, and what each part becomes + +| was | becomes | +| --- | --- | +| a group node with `:layout :sequence` | nothing — the symbol is the container | +| `node/lane?` | a view question: is this symbol drawn in lane mode | +| `symbol/lane-clips nodes lane-id` | the children of a symbol, sorted by `node/placed-span` | +| `symbol/lane-problems` | `symbol/overlaps`, a diagnostic the write path calls | +| `lane/lane-frame` | `clip/source-time` — one clock instead of two | +| `domain/lane.cljs` | re-based onto `domain/span.cljs`: re-spanning a symbol's children | +| `clip/lane-node`, the born-with lane | gone; a symbol is born empty again | +| `::ui/new-lane`, `::ui/adopt-in-lane`, lane renaming | gone, gone, and ordinary node renaming | + +`lane.cljs`'s fourteen commands are not deleted — they are what "endpoint drag +overlap handling" means, and they already do the right arithmetic. What +changes is their subject: every one of them currently takes a host symbol AND +a lane id and asks `lane-clips nodes lane-id`; each takes a symbol and asks +for its children. `extend-hold`, `resize-out`, `resize-in`, `roll`, `blank`, +`place-symbol`, `adopt`, `append-drawing`, `reuse-drawing`, +`duplicate-drawing`, `overwrite-drawing`, `make-unique`. `span/finish` is +already the one commit path and stays exactly as it is. + +Put them in `span.cljs`, which already owns "one write to one node's span" and +`finish`. The sequence operations are the same subject — re-spanning children +— and keeping them apart was a consequence of lanes existing. + +## Children in lane mode never overlap + +This is an invariant, not a condition to check for and report. Placement +claims time: anything placed, moved or grown over occupied time TRIMS the +extents it lands on — trimming the incumbent, removing one wholly covered, or +splitting one it lands inside — so the result has no overlap because the +operation that could have made one did not. That is `blank` followed by a +non-rippling placement, which is what `overwrite-drawing` already composes. + +Enforced at the boundary, which already exists: `span/finish` is the single +commit path for every one of these commands, it validates before it returns, +and it refuses rather than half-applying. So `finish` gains the overlap check +for a symbol in lane mode, and no command can commit one. An overlap that +appears anyway is a bug in a command, not a state to design around. + +Keep the check as a named diagnostic — `symbol/overlaps`, taking a symbol and +returning the pairs — used three ways: + +1. `span/finish` refuses when it would commit one. +2. The test suite asserts no command can produce one: a property over the + commands in the style of `drawn` in `lane_test`, which samples rather than + computing expected numbers by hand. +3. A document that somehow arrives holding one still LOADS — a display hint + must never be able to stop a document loading — and the timeline draws it + visibly wrong with the status line saying so. Not `clip/problems`, which + means the document will not load, and not `clip/conflicts`, which means a + person has a decision to make. This is neither: it is a bug report. + +Toggling lane mode ON for a symbol whose children already overlap is the one +place a person can ask for the impossible. Refuse it and say why, with the +`:required-frames` retry pattern offering to trim them into a sequence — the +domain reports what it would need, the UI offers one button. + +Outside lane mode nothing is enforced, because overlapping children are what +compositing IS. An endpoint drag there is an ordinary span edit that may +overlap; the claim-time rule follows the mode. + +## The two drag intentions + +Unchanged from `docs/lane-nesting-notes.md`, and both kept: + +- **Plain drag** of a clip body is temporal: it moves in time, within its + symbol or into another symbol drawn as a lane, and it REPLACES — trimming, + removing and splitting extents as needed so nothing overlaps. +- **Shift-drag** is structural: the dragged node goes INSIDE the symbol the + clip under the pointer places, through `nest/move-node`, which preserves the + world transform and the root timing. This must keep working for symbols + contained in a lane, which is the case it exists for. + +Overlap cannot distinguish them — dropping on occupied time already means +claiming it — so the modifier says which, and the label by the pointer says it +back. `nest/move-refusal` already answers before the drop. + +## Where lane mode lives + +A symbol is drawn as a lane because somebody said so, not because of what its +children happen to look like at this moment. Deriving it from "the children do +not currently overlap" means a symbol stops being a lane the moment anything +overlaps, and the rules that maintain non-overlap switch off exactly when they +are needed. + +Two options: + +1. **Editor state**, `[:ui :lane-mode #{sid}]`. Purest reading of "a lane is a + view". But the drag rules follow the mode, so an unsaved, per-person toggle + would decide whether dropping a symbol trims its neighbour or composites + over it — the same gesture doing two different things to the document + depending on something the document does not record. +2. **A display hint on the symbol**, e.g. `:display :lane`, saved like any + other field (`clip-keys`, `leaf/leaves`, `leaf/clip` in the same commit). + Still not a type: nothing in evaluation reads it, `symbol/problems` does + not check it, and a symbol with it set behaves identically on the stage. + +Recommended: 2. It is one field, it keeps editing rules reproducible between +people, and it does not make the symbol a different kind of thing. The thing +to hold the line on is that nothing outside the timeline, and the commit +path's overlap check, is allowed to read it. + +## Two things are called loop + +Before any of this, name them apart, in the way the vocabulary table in +`lane-handoff.md` names a cel apart from an exposure. + +- **Loop playback** is the transport repeating the open symbol while it plays. + It is `[:playback :loop?]` in app-db, the ⟳ button in the strip, and it is + EDITOR STATE. The document does not know about it. +- **A looping instance** is a node repeating the symbol it places: a four-frame + tire turning for the hundred and twenty frames the instance is on screen. + It is `:playback {:end :loop}` on the node, and it is in the DOCUMENT. + +The car tire is the second one, and here is its actual status: it already +works in the evaluator and cannot be asked for. `node/placed-frame` does the +modulo, `node/problems` already admits `:end` of `:stop`, `:hold` or `:loop`, +`nest/audio-tracks` already expands a loop into its periods — and nothing in +the UI sets it. It is implemented and unreachable. + +So three things are missing, and they are the work: + +1. **A control.** Where an instance's playback is edited: `:in`, `:speed`, and + what happens at the end. One place, three fields, rather than a loop + checkbox somewhere else. +2. **Drawing the repeats.** `ui/timeline`'s docstring already admits that only + the first pass of a looping instance is drawn, so a tire turning thirty + times shows one turn's keys and then nothing. A looping block should show + its passes — at minimum the period boundaries, so the row says how many + times round it goes. +3. **The audio period guard** below, which a loop needs whether or not holds + become loops. + +## Tear out the held cel + +A held cel is a 1-frame symbol shown for many frames. A 1-frame symbol with +`:end :loop`, lengthened, is the same picture by a different route — and the +second route is a case the model already has, so keeping the first one is +keeping a special case for free. + +**What is already true**, so that nothing has to move: `:span` is on the node, +in its own frames; `:time` (`:at`, `:rate`) is on the node; looping is on the +node, as `:playback :end`. The SYMBOL owns only `:frames`, the authored +window. So looping and span are instance properties already, and this change +is about deleting a mode, not relocating a field. + +It does mean the two changes are joined at one point: making every drawing a +looping instance is not safe until a looping instance can be seen and edited, +or every drawing in the document acquires a property with no control on it. + +**What has to be decided and collapsed:** + +- There are two spellings of looping — `:time :loop?` and `:playback :end + :loop` — and both are read, in `node/placed-frame` and in + `nest/audio-tracks`. Keep one. `:playback {:in :speed :end}` already says + what happens at the ends, so `:end :loop` is the one to keep and + `:time :loop?` is the one to delete. +- `:playback :speed 0` stops being produced. Make it illegal in + `node/problems` rather than legal-but-unused, so a frozen clock has exactly + one spelling: a 1-frame loop. +- `lane/extend-hold` exists only because holds were special — it refuses + anything whose speed is not 0 and then edits a span. Once a hold is a loop, + lengthening one IS `resize-out`, and the command collapses into it. +- `cel` survives as the word for the creation policy — a new empty symbol is + one frame — but stops naming a playback mode. + +**What it buys, and this is the point:** one rule for nesting, which settles +the refusal that blocks shift-to-reparent today. `nest/inside` currently has +no `:time` for a hold, for `:end :hold`, or for a loop, and so refuses all +three. The general rule that covers all of them: **resolve the move with the +destination's map at the CURRENT frame — the affine piece the current frame +falls in.** + +- A loop of length L is affine within the period the current frame is in. + Timing is preserved inside that period and repeats after it, which is what + looping means. +- A 1-frame loop — the ex-hold — has a period of length 1, so the map within + it is trivially invertible and lands the moved node on frame 0, aligned to + the current frame. That is exactly the answer `docs/lane-nesting-notes.md` + argues for from first principles, arrived at here as an instance of the + general rule instead of a special case. +- `:end :hold` is affine in the played part and frozen in the tail, which the + same sentence covers. + +**The trap, which must be handled in the same change.** `nest/audio-tracks` +expands a loop into one walk PER PERIOD: + + periods (range (floor (/ (to-local source lo) length)) + (ceil (/ (to-local source hi) length))) + +Today a held cel is skipped entirely — `(pos? speed)` is the guard, and the +comment says a visual freeze does not emit a sustained audio sample. Turn +every drawing into a 1-frame loop and that guard stops firing: a drawing held +for 120 frames becomes 120 recursive walks, and any sound inside it is emitted +120 times. That is both a wrong mix and a performance cliff on the most common +node in the document. Required with this change: a cheap `symbol/audible?` +precheck so a source with no audio anywhere inside it is never period-expanded, +and a cap or a different formulation for the ones that are. + +Also worth knowing before the change: `ui/timeline`'s own docstring already +says a looping instance draws only its first pass. With every drawing a loop, +that sentence now describes every drawing — harmless, since one pass of a +1-frame symbol is the whole of it, but the docstring should stop sounding like +a limitation. + +**Dropping into a 1-frame symbol.** The window is authored and crops what it +holds, so a 10-frame symbol dropped into a 1-frame drawing shows its frame 0 +and nothing else. That is consistent — `:frames` is the shot length and +`:extent :grow-symbol` is the opt-in — but it is probably not what somebody +dragging means. Offer the growth through the `:required-frames` retry the +model already uses: the command reports what it would need, the UI offers one +button. + +## Order of work + +Each step compiles, passes `npm test`, and leaves the editor usable. + +1. **Row per symbol.** In `ui/timeline.cljs`, delete `portal`, the `::portal` + hint row, the `under?` lineage predicate and the `chosen` argument; emit a + row for a clip whose parent is a lane instead of skipping it. Keep the + `:cels` blocks for the collapsed row, and keep `inside-rows` — including + its `:unmapped?` branch, which is what makes a held drawing's contents + reachable at all. +2. **Lane mode as a hint.** Add the field and the toggle, draw a symbol's + children as blocks when it is set and as rows when it is not, and move the + lane-row drag handling onto it. Both display paths now exist and nothing in + the domain has changed. +3. **Re-base the commands.** Move `lane.cljs` into `span.cljs`, replacing + `(lane-clips nodes lane-id)` with the symbol's children and dropping the + `lane-id` argument. `frontend/test/arthur/domain/lane_test.cljs` is the + proof: its fixtures should change and its assertions should not, and any + assertion that has to change is a behaviour change worth noticing. +4. **Move the invariant.** `symbol/lane-problems` becomes `symbol/overlaps`, + called by `span/finish` for a symbol in lane mode, plus the property test + that no command can produce an overlap. +5. **Delete the rest.** `node/lane?`, `symbol/lane-clips`, `clip/lane-node`, + `::ui/new-lane`, `::ui/adopt-in-lane`, the lane branch of + `::ui/new-symbol`, lane renaming, `aimed-lane`, and the + `:lane?`/`sound-lane?` row flags. Rename what is left so the word does not + appear outside the timeline. +6. **Audio falls out.** An audio node is already a parent-less child of a + symbol, which is exactly the new shape — so the audio-in-lane rules added + in `2dc5735` (`holds-other?`, the mixed-lane refusal, the `in-lane` filter + in `sound-rows`) delete rather than migrate. A symbol drawn as a lane whose + children are sounds is an audio lane, and that is the whole of it. +7. **Shift-to-reparent stays** as it is: `nest/move-node` and + `nest/move-refusal` never knew about lanes. + +## What must not be lost + +All of this was broken at some point today and is now proved; each has a test +to keep. + +- A held clip's contents are reachable from the root timeline, with no keys + and no draggable edges — `source-time` is nil for a hold, and the walk used + to stop there. +- Double-clicking a clip opens its symbol as a tab, and the editor survives + it: `symbol/lineage` must not report a cycle for an id the symbol does not + hold, and opening a symbol must drop a selection pointing into the one being + left. +- Selection waits for pointer-up, so a press does not re-draw the timeline out + from under the gesture it is starting. +- A drop never silently deletes what it lands on. +- A sound is drawn once, not twice. + +## Open questions + +1. **Is lane mode a property of the symbol or of the instance placing it?** A + symbol placed twice would be drawn the same way in both places under the + first reading. That is probably right, and worth saying out loud. +2. **Does a lane row's edge drag trim the placing instance's span, or ripple + the children?** Same handle, two commands; the row is now an instance, so + it has a span of its own for the first time. +3. **Does tearing out the held cel come before or after the lane work?** It + is independent of it — `nest` never knew about lanes — and it is what makes + shift-to-reparent work on the thing people would actually drag onto. Doing + it first means the lane work lands on a model with one playback mode fewer; + doing it after means two changes to `lane_test`'s fixtures instead of one. diff --git a/docs/lane-model.md b/docs/lane-model.md index 1593170..84da5d9 100644 --- a/docs/lane-model.md +++ b/docs/lane-model.md @@ -1,9 +1,11 @@ # 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, correction evaluation, and correction authoring -for rotation and position are implemented. Retiming commands are not. +Revised 2026-10-01. Clip ownership, source playback, one-row generic lanes, +direct clip movement and edge editing, correction evaluation, and correction +authoring for rotation and position are implemented. The former cel-sheet +projection was removed: the timeline is the single timing interface. Sections +below that describe a cel sheet are retained as design history and are superseded +by this revision. Retiming commands are not. See the status note under [Proof obligations](#proof-obligations-and-implementation-order). @@ -145,8 +147,9 @@ cel transform and then the content's own transform. The interval in lane time is derived through `:time`; do not also store parent 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. +The current sequence group contains visual symbol clips. Audio remains an +independent root node (and can be linked to picture); if audio lanes are added, +their capability must be explicit rather than inferred per frame. A source reference is fixed within a cel. The lane changes content when another cel becomes active. This is a deliberate revision of the original diff --git a/docs/lane-nesting-notes.md b/docs/lane-nesting-notes.md new file mode 100644 index 0000000..73d6ec0 --- /dev/null +++ b/docs/lane-nesting-notes.md @@ -0,0 +1,161 @@ +# Lane nesting interaction notes + +Status: design note, 2026-10-01. This records the interaction before more lane +UI is implemented. + +## The capability that must not be lost + +A lane owns temporal placement, but a symbol instance is still a doorway into +another symbol. A drawing accidentally authored at the root must be movable into +an instance in any lane, including another lane, without changing its visible +position or timing. + +That operation already exists as `nest/move-node`. It resolves the source and +destination at the current root frame, transplants the node, and re-expresses +its transform and time under the new parent. The lane UI must expose a target +path for it; it must not replace it with a weaker `:parent` assignment. + +There are therefore two different drag intentions: + +1. **Temporal move:** drag a clip body onto lane space. It remains a clip in a + lane, moves in time, and claims the destination interval by trimming/removing + incumbents. +2. **Structural move:** drag from the clip's grab affordance onto another symbol + instance. The dragged node is transplanted into the target instance's source + symbol with `nest/move-node`, preserving its world transform and root timing. + +These cannot be inferred from overlap alone. Dropping clip A onto time occupied +by clip B already means “A claims that time and trims B.” Structural nesting +therefore needs an explicit grab affordance/mode. Its cursor is `grab` and +`grabbing`; trim edges keep their resize cursors and the ordinary body keeps its +timeline-move behavior. + +Both visible clip blocks and an expanded symbol header are structural drop +targets. This permits moving a root drawing directly into `symbol-3` even when +its lane is collapsed. + +## Compact expansion: one selected-clip portal + +Expanding a lane must not restore row-per-clip vertical growth. Instead, an +expanded lane reveals exactly one clip portal: the currently selected clip in +that lane. + +```text +▾ foreground lane [symbol-1][symbol-2][symbol-3] + ▾ symbol-3 instance/source header and drop target + ▸ body lane nested rows, mapped to the root ruler + ▸ face lane + position nested keyframes mapped to root time +``` + +- Selecting another block in the same lane swaps the portal in place. +- With no selected clip in that lane, expansion shows a compact “select a clip + to inspect” row. It must not follow the playhead during playback; that would + make the timeline restructure itself while playing. +- The portal header represents the selected instance and is the structural drop + target for moving root or sibling content into its source symbol. +- Sub-expanding the portal uses the existing recursive symbol-row walk. Nested + lanes and channels are mapped through the instance clock into the open/root + ruler, as ordinary expanded instances already are. +- The lane's own transform/channel rows remain available separately. They affect + every clip in the lane and are not properties of the selected portal. + +This keeps the cost of inspection constant: an expanded lane adds one selected +symbol branch, not one branch for every temporal clip it contains. + +## Keyframe visibility + +Two levels should be visible without changing editors: + +- The selected clip's instance-level keys (transform, visibility, corrections) + appear as ticks inside that clip block on the lane row. +- Expanding the lane opens the selected clip portal, where source-symbol and + recursively nested keys appear on their own rows, mapped to root time. + +Thus the collapsed lane answers “where does this clip change?” and the expanded +portal answers “which property inside this symbol changes?” The second view is +still the root timeline; entering the symbol is not required merely to see or +edit its keys. + +## Drag targets and feedback + +- Grab onto lane background: move/adopt the instance into that lane. +- Grab onto a symbol clip: structurally transplant into that clip's source + symbol. +- Grab onto the expanded portal header: the same structural transplant, with a + larger and less ambiguous target. +- Grab onto itself or one of its descendants: refuse before drop to prevent a + symbol cycle. +- A structural target receives an inset highlight and the preview stays in that + target. A lane-time target receives the dashed temporal clip preview. +- Successful structural drops expand the target lane and select the moved node + beneath the target portal, so the result is immediately visible. + +## Data model consequence + +No lane-as-symbol type is required. The hierarchy remains: + +```text +symbol -> sequence lane -> instance clip -> source symbol -> its lanes/nodes +``` + +Lane membership owns time partitioning. Symbol instances own composition +nesting. The UI may present the selected instance below its lane, but that is a +derived portal, not another ownership edge and not a duplicated node. + +## Implementation order + +1. ~~Render instance-level key ticks within lane clips.~~ Done: a clip's keys + are on its block, drawn after the blocks so they land on the one they + belong to. +2. ~~Add selected-clip portal expansion to `timeline/rows`.~~ Done, with two + additions the note did not anticipate: + - The portal is chosen by the whole LINEAGE of the selection, not the + selected id. Selecting a shape inside the clip, or the end of its span, + is still working inside that clip, and matching the id alone closed the + portal the moment anything under it was touched. + - A HELD clip opens too. `clip/source-time` is nil for a hold, so the walk + used to stop there and the inside of every drawing was unreachable from + the root timeline. Its rows are now shown across the hold and marked + `:unmapped?`: no keys, and no draggable edges, because no frame inside it + has a place on this ruler. +3. ~~Add the explicit structural affordance.~~ Done as SHIFT on a clip-body + drag rather than a separate grab handle: shift turns a temporal move into a + structural one, the target clip takes an inset highlight, and a label by the + pointer says which of the two is about to happen. +4. Route structural drops through `nest/move-node`. **Wired, and blocked in + the domain.** The gesture asks `nest/move-refusal` on the way past, so the + label says before the drop what the command would say after it. Two + refusals stand in the way of ordinary use: + - *both have to be on screen at this frame.* Inherent, and worth keeping: + the move preserves the world transform and there is no common frame to + preserve it at otherwise. It does mean nesting one clip into another in + the SAME lane can never work — a lane never overlaps itself — so this is + a between-lanes gesture with the playhead somewhere both are showing. + - *a held or looping clip has no clock to move through.* `nest/inside` + returns no `:time` for a hold, and a held one-frame drawing is the most + common thing in a document, so today nesting into one is refused — which + is most of what anybody would try. +5. After the transplant, expand the destination portal and reveal/select the + moved row. `::ui/move-node` already selects the moved node and opens the + rows down to it; the portal follows from the lineage rule in 2. + +## The held destination, unresolved + +A held cel shows ONE source frame for its whole span, so there is no +invertible map from the lane's frames to the drawing's and `move-node` +refuses. But the refusal is stronger than the facts require. Inside a frozen +destination only one frame is ever observed, so: + +- the RATE of any map into it is unobservable — every rate shows frame `in`; +- what IS observable is that the moved node should show, at that one frame, + what it shows now at the current root frame. + +That pins a unique sensible answer — rate 1, aligned so the current frame maps +to the shown frame — and nothing else about the mapping can be seen. If that +argument holds, it is a rule rather than a guess, and it is the difference +between structural nesting working for drawings and not working at all. It +needs its own proof: a drawing authored at the root, nested into a held cel in +another lane, sampled before and after to show the same picture, in the style +of `drawn` in `lane_test`. + diff --git a/frontend/src/arthur/db.cljs b/frontend/src/arthur/db.cljs index 8fe4358..bba47ec 100644 --- a/frontend/src/arthur/db.cljs +++ b/frontend/src/arthur/db.cljs @@ -159,7 +159,6 @@ :ui {:open nil :tabs [] :selection nil - :time-view :timeline :tone :skin-base :tool nil :auto-key? false diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index e4233a9..fee987c 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -150,10 +150,12 @@ 120) (defn blank - "A new, empty document: one empty symbol. + "A new, empty document: one symbol, and nothing in it. - `:nodes` is empty rather than seeded with a layer, because an empty symbol is - a true statement and a layer nobody asked for is one more thing to delete. + A SYMBOL IS BORN EMPTY. It used to be born holding a lane, because a lane was + the only place temporal content could go; now the symbol itself is the + container — see `symbol/children` — so there is nothing to invent and the + first drop into a symbol is the same operation as the second. The tracking maps are ABSENT rather than empty, because `leaf/leaves` writes no leaf for an empty one and so cannot bring it back: a blank document that opened @@ -410,7 +412,8 @@ (if (or (nil? end) (symbol clip sid) (nil? frame) (neg? frame) (>= frame end)) clip (-> clip - (assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host) :frames (- end frame) :nodes {}}) + (assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host) + :frames (- end frame) :nodes {}}) (place-symbol nil host sid frame uuid nil))))) (defn free-id diff --git a/frontend/src/arthur/domain/lane.cljs b/frontend/src/arthur/domain/lane.cljs deleted file mode 100644 index 3c5c743..0000000 --- a/frontend/src/arthur/domain/lane.cljs +++ /dev/null @@ -1,360 +0,0 @@ -(ns arthur.domain.lane - "The commands that need a SEQUENCE: make a lane, put drawings in it, change - how long they are exposed, empty part of it, and decide which cels share - content. - - WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a - node map: a group with `:layout :sequence`, whose children are non-overlapping - visual cels. This namespace only changes them. - - WHAT IS NOT HERE: split, trim and move. Each of those is one write to one - node's span or position, which is a fact every node has, so they live in - `arthur.domain.span` and work on a symbol placed straight into a shot as - readily as on a cel. What stays here is everything that cannot be said about - one node alone — a ripple needs later siblings, a gap needs a row to be a hole - in, and appending needs to know where the row stops. - - EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or - `{:refused reason}` — never a half-applied edit, and never a document that - `clip/problems` would reject. A command that cannot say what the person meant - refuses and says why, rather than picking for them: the overflow policy is a - caller's `:extent`, and decoupling shared content is its own command instead - of something an ordinary edit does silently. - - IDS FOR CELS COME FROM THE CALLER, because a cel's identity is - a uuid and this namespace is pure. Ids for new CONTENT are derived from the - drawing being copied — `clip/free-id` is pure too, and `drawing-a-2` says what - it came from in a way `symbol-7` does not." - (:require [arthur.domain.bring :as bring] - [arthur.domain.clip :as clip] - [arthur.domain.node :as node] - [arthur.domain.span :as span] - [arthur.domain.symbol :as symbol])) - -(defn extend-hold - "Change one held cel's duration by `delta` lane frames and ripple its - later siblings. Lane channels, cel channels and source clocks stay put. - Returns {:clip :selection} or {:refused :required-frames?}; never partially edits." - [clip sid id delta {:keys [extent] :or {extent :keep}}] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - rate (:rate (node/time-of n)) - span (:span n) - m (when lane (symbol/frame-map nodes (:id lane))) - ;; The LANE's own shape, not the whole symbol's: refusing a cel - ;; edit over some unrelated defect elsewhere in the symbol would be - ;; this command answering for a part of the document it never touches. - broken (first (symbol/lane-problems nodes))] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - broken {:refused broken} - (not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of lane frames"} - (not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"} - (nil? m) {:refused "cel timing through a stepped or looping lane is not supported"} - (<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive cel"} - :else - (let [[_ boundary] (node/placed-span n) - later (filter #(>= (first (node/placed-span %)) boundary) - (symbol/lane-cels nodes (:id lane))) - nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta))) - nodes (reduce (fn [ns sibling] - (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) - nodes later)] - (span/finish clip sid nodes id extent))))) - -(defn blank - "Clear lane frames `[a b)` of lane `lane-id`, leaving a GAP. - - A gap is not a drawing. Nothing is invented to cover those frames and nothing - closes the hole — the cels after it stay where they are, because - emptying frames and re-timing a performance are different intentions. - - What it does to each cel it meets is `span/edged`, applied three ways: one wholly - inside is removed, one overlapping an end is trimmed to it, and the one that - spans the whole range is split, which is the only case that needs `id`. Their - drawings stay in the library — a lane does not own its content, and a drawing - whose last cel is gone is still a drawing somebody made." - [clip sid lane-id [a b] {:keys [id]}] - (let [nodes (get-in clip [:symbols sid :nodes]) - lane (get nodes lane-id) - members (when (node/lane? lane) (symbol/lane-cels nodes lane-id)) - spanning (when members - (first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b))) - members)))] - (cond - (not (node/lane? lane)) {:refused "select a lane"} - (not (and (integer? a) (integer? b) (< a b))) - {:refused "a range to blank is whole lane frames, and not empty"} - (and spanning (or (nil? id) (contains? nodes id))) - {:refused "blanking inside one cel splits it, which needs a free ID for the remainder"} - :else - (let [nodes (reduce - (fn [ns n] - (let [[lo hi] (node/placed-span n)] - (cond - (or (<= hi a) (>= lo b)) ns - (and (< lo a) (> hi b)) - (-> ns - (assoc (:id n) (span/edged n :out a)) - (assoc id (assoc (span/edged n :in b) :id id :z (str "a-" id)))) - (and (>= lo a) (<= hi b)) (dissoc ns (:id n)) - (< lo a) (assoc ns (:id n) (span/edged n :out a)) - :else (assoc ns (:id n) (span/edged n :in b))))) - nodes members)] - (span/finish clip sid nodes (or (when spanning id) lane-id) :keep))))) - -(defn sheet-range - "Snapshot a rectangle in open-symbol frames. Cel-local clocks and channels - survive clipping; gaps are represented by the rectangle's duration." - [clip sid lanes [a b]] - (let [nodes (get-in clip [:symbols sid :nodes])] - (if-not (and (seq lanes) (integer? a) (integer? b) (<= 0 a) (< a b) - (every? #(and (node/lane? (get nodes %)) - (= {:at 0 :rate 1} (symbol/frame-map nodes %))) lanes)) - {:refused "range editing requires lanes with the same clock as the sheet"} - {:duration (- b a) - :columns - (mapv (fn [id] - (vec (for [n (symbol/lane-cels nodes id) - :let [[lo hi] (node/placed-span n)] - :when (and (< lo b) (> hi a))] - (-> n - (span/edged :in (max a lo)) - (span/edged :out (min b hi)) - (update-in [:time :at] (fnil - 0) a))))) lanes)}))) - -(defn paste-range - "Overwrite a rectangle atomically, including its gaps. IDs are supplied by - the caller. Copies share drawings and retain cel-local animation." - [clip sid lanes at payload new-id] - (let [duration (:duration payload) - check (when duration (sheet-range clip sid lanes [at (+ at duration)]))] - (cond - (:refused payload) payload - (not= (count lanes) (count (:columns payload))) - {:refused "the copied range does not fit the destination lanes"} - (or (nil? duration) (:refused check)) - (or check {:refused "copy a cel-sheet range first"}) - (> (+ at duration) (get-in clip [:symbols sid :frames])) - {:refused "the copied range extends beyond the shot"} - :else - (reduce - (fn [result [id cels]] - (if (:refused result) (reduced result) - (let [cleared (blank (:clip result) sid id [at (+ at duration)] {:id (new-id)})] - (if (:refused cleared) (reduced cleared) - (let [nodes (reduce (fn [nodes n] - (let [cid (new-id)] - (assoc nodes cid (-> n - (assoc :id cid :parent id :z (str "a-" cid)) - (update-in [:time :at] + at))))) - (get-in (:clip cleared) [:symbols sid :nodes]) cels) - result (span/finish (:clip cleared) sid nodes id :keep) - problems (when (:clip result) (clip/problems (:clip result)))] - (if (seq problems) {:refused (first problems)} result)))))) - {:clip clip :selection (first lanes)} - (map vector lanes (:columns payload)))))) - -(defn add-lane [clip sid id] - (if (or (nil? (clip/symbol clip sid)) (get-in clip [:symbols sid :nodes id])) - {:refused "the symbol is missing or the lane ID is already used"} - {:clip (assoc-in clip [:symbols sid :nodes id] - {:id id :name "drawings" :kind :group :layout :sequence - :z (str "z-" id)}) - :selection id})) - -;; --------------------------------------------------------------------------- -;; putting drawings in a lane - -(defn- held - "A one-frame held cel of `drawing-id`, starting at lane frame `at`. - - Held rather than playing, and one frame rather than the length of what it - places: a cel's duration is the lane's business — `extend-hold` is how - it changes — and reading it off the content would make placing a ten-frame - animation and holding its first drawing the same gesture." - [id lane-id drawing-id at] - {:id id :kind :instance :parent lane-id :z (str "a-" id) - :span [0 1] :time {:at at :rate 1} - :source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}}) - -(defn lane-frame - "Symbol frame `f` as a frame of lane `lane-id`'s OWN time, or nil through a - stepped or looping lane, where one frame of the symbol is not one frame of the - lane and there is no single answer to give a command." - [clip sid lane-id f] - (when-let [{:keys [at rate]} (symbol/frame-map (get-in clip [:symbols sid :nodes]) lane-id)] - (* rate (- f at)))) - -(defn- lane-end - "Where lane `lane-id`'s occupied frames stop, in its own time." - [nodes lane-id] - (apply max 0 (map #(second (node/placed-span %)) - (symbol/lane-cels nodes lane-id)))) - -(defn- place - "Put a held cel of `drawing-id` into `lane-id` at lane frame `at`, and - RIPPLE: everything starting at or after it moves later by its duration. - - There is one placement function and `:end` is a position like any other, so - appending is not a different operation from inserting — the end is just where - nothing has to move. Overwriting is the other policy and is NOT this: taking - frames away from the cel already there is trimming, which is its own - command and not something placing a drawing should do on the quiet. - - `:frame` in the result is where it landed, in the open symbol's time, for a - caller that wants to look at what it just made." - [clip sid lane-id id drawing-id at extent ripple?] - (let [nodes (get-in clip [:symbols sid :nodes]) - at (if (= :end at) (lane-end nodes lane-id) at) - n (held id lane-id drawing-id at) - [lo hi] (node/placed-span n) - later (when ripple? - (filter #(>= (first (node/placed-span %)) lo) - (symbol/lane-cels nodes lane-id))) - nodes (reduce (fn [ns sibling] - (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) - (assoc nodes id n) later) - result (span/finish clip sid nodes id extent) - m (symbol/frame-map nodes lane-id)] - (cond-> result - (:clip result) (assoc :frame (+ (:at m) (/ at (:rate m))))))) - -(defn- placeable - "Why a held cel cannot go into `lane-id` at `at`, or nil." - [clip sid lane-id id at] - (let [nodes (get-in clip [:symbols sid :nodes]) - lane (get nodes lane-id) - ;; INSIDE a cel is not a position for another one. Splitting that - ;; cel is what makes it two, and doing it here would be one command - ;; quietly performing two: the caller asks for `split` and then places. - inside (when (number? at) - (some (fn [n] (let [[lo hi] (node/placed-span n)] - (when (< lo at hi) n))) - (symbol/lane-cels nodes lane-id)))] - (cond - (not (node/lane? lane)) "select a lane" - (contains? nodes id) "the new cel ID is already used" - (not (or (= :end at) (and (integer? at) (not (neg? at))))) - "a position is :end or a whole lane frame" - inside (str "frame " at " is inside a cel; split it first") - (nil? (symbol/frame-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported" - :else (first (symbol/lane-problems nodes))))) - -(defn append-drawing - "Append fresh empty content and a held cel of it. IDs come from the - caller so a command is deterministic and replayable. - - Fresh content, not a blank range: a lane with no cel over a frame shows - nothing there already, and a drawing nobody has drawn in is a different thing - from a gap." - [clip sid lane-id id drawing-id {:keys [at extent] :or {extent :keep at :end}}] - (if-let [why (or (placeable clip sid lane-id id at) - (when (clip/symbol clip drawing-id) "the new drawing ID is already used"))] - {:refused why} - (place (assoc-in clip [:symbols drawing-id] - {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) - sid lane-id id drawing-id at extent true))) - -(defn reuse-drawing - "Append a held cel of content the document ALREADY has, so the same - drawing is exposed twice and editing it changes both cels. - - This is the command `make-unique` is the undo of, and the reason they are two - commands: reuse is a decision to share, and sharing is not something to - discover later when an edit turns up somewhere else." - [clip sid lane-id id drawing-id {:keys [at extent] :or {extent :keep at :end}}] - (if-let [why (or (placeable clip sid lane-id id at) - (when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse") - ;; Placing something that contains this symbol would close a - ;; loop, and a lane is no different from any other placement. - (when (clip/contains-symbol? clip drawing-id sid) - "a symbol cannot go inside itself"))] - {:refused why} - (place clip sid lane-id id drawing-id at extent true))) - -(defn- copied - "A copy of symbol `from`, as `{:clip :id}`. - - SHALLOW by default: its own nodes and channels are copied, and its references - to other symbols are kept, so a head built out of reusable eyes still uses - those eyes. `deep?` copies everything it places as well, with new ids - throughout, for a drawing that must share nothing — the distinction the - shallow copy cannot make on its own, and a promise of independence that only - the deep one keeps." - [clip from deep?] - (if deep? - (let [{c :clip ids :ids} (bring/symbols clip clip [from] {})] - {:clip c :id (ids from)}) - (let [id (clip/free-id (:symbols clip) from)] - {:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id)) - :id id}))) - -(defn duplicate-drawing - "Append a held cel of a COPY of what cel `id` places, for when - the drawing on screen is the starting point for the next one. - - The copy is of the content only. The new cel is a plain one-frame hold - rather than a copy of `id`'s own transform or corrections: those belong to - that cel, and carrying them over would make duplicating a drawing quietly - duplicate the treatment of one use of it." - [clip sid id new-id {:keys [at extent deep?] :or {extent :keep at :end}}] - (let [n (get-in clip [:symbols sid :nodes id]) - from (node/source n)] - (if-let [why (or (when-not from "select a cel to duplicate") - (when-not (clip/symbol clip from) "the drawing it places is missing") - (placeable clip sid (:parent n) new-id at))] - {:refused why} - (let [{c :clip copy :id} (copied clip from deep?)] - (place c sid (:parent n) new-id copy at extent true))))) - -(defn overwrite-drawing - "Put a fresh one-frame drawing at lane frame `at`, replacing whatever was - there and leaving every other cel where it was. - - This is `blank` and placement composed in ONE command and therefore one undo - step. `remainder-id` is used only when clearing the frame cuts one cel into - two; ids still come from the caller because this namespace is pure." - [clip sid lane-id id drawing-id at {:keys [extent remainder-id] - :or {extent :keep}}] - (let [nodes (get-in clip [:symbols sid :nodes])] - (if-let [why (cond - (not (and (integer? at) (not (neg? at)))) - "a position is a nonnegative whole lane frame" - (contains? nodes id) "the new cel ID is already used" - (or (= id remainder-id) (contains? nodes remainder-id)) - "the remainder cel needs a free ID different from the new cel" - (clip/symbol clip drawing-id) "the new drawing ID is already used" - (nil? (symbol/frame-map nodes lane-id)) - "drawing creation through a stepped or looping lane is not supported")] - {:refused why} - (let [cleared (blank clip sid lane-id [at (inc at)] {:id remainder-id})] - (if (:refused cleared) - cleared - (place (assoc-in (:clip cleared) [:symbols drawing-id] - {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) - sid lane-id id drawing-id at extent false)))))) - -(defn make-unique - "Point cel `id` at a private copy of its content, leaving every other - cel of that drawing sharing the original. - - Refused when nothing else uses it: a drawing with one cel is already - unique, and answering with a silent copy would leave a second identical symbol - in the library for no reason a person could see." - [clip sid id {:keys [deep?]}] - (let [n (get-in clip [:symbols sid :nodes id]) - from (node/source n) - elsewhere (for [[osid osym] (:symbols clip) - [oid on] (:nodes osym) - :when (and (= from (node/source on)) (not= [sid id] [osid oid]))] - [osid oid])] - (if-let [why (or (when-not from "select a cel to make unique") - (when-not (clip/symbol clip from) "the drawing it places is missing") - (when (empty? elsewhere) "nothing else uses this drawing"))] - {:refused why} - (let [{c :clip copy :id} (copied clip from deep?) - c (assoc-in c [:symbols sid :nodes id :source :symbol] copy) - ps (clip/problems c)] - (if (seq ps) {:refused (first ps)} {:clip c :selection id}))))) diff --git a/frontend/src/arthur/domain/leaf.cljs b/frontend/src/arthur/domain/leaf.cljs index eb48d3f..8fe84f1 100644 --- a/frontend/src/arthur/domain/leaf.cljs +++ b/frontend/src/arthur/domain/leaf.cljs @@ -144,7 +144,7 @@ ;; disagree with itself about; `clip` puts it back. (for [[sid sym] (:symbols clip)] {(at "symbol" (segment sid)) - (select-keys sym [:name :frames :fps :width :height :palette])}) + (select-keys sym [:name :frames :fps :width :height :palette :display])}) (for [[sid sym] (:symbols clip) [id n] (:nodes sym)] {(at "symbol" (segment sid) "node" (segment id)) diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index fb6940f..9936314 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -21,6 +21,7 @@ (:require [arthur.domain.clip :as clip] [arthur.domain.node :as node] [arthur.domain.palette :as pal] + [arthur.domain.span :as span] [arthur.domain.symbol :as symbol])) (defn- resolved @@ -71,7 +72,7 @@ inner (:symbol shown) lf (if shown (:frame shown) local)] (if (and m (number? local) - ;; A lane over a gap has no inside to be in. + ;; A clip over a gap has no inside to be in. (or (not inst?) shown) (or (nil? inner) (< -1 lf (clip/frames clip inner)))) {:sid inner :frame (js/Math.floor lf) @@ -271,6 +272,39 @@ (clip/update-symbol target update :nodes (fnil into {}) (map (juxt :id identity)) moved))})))) +(defn move-refusal + "Why `move-node` would refuse to move `from` into `to` at frame `f`, or nil. + + SAID BEFORE THE DROP, not after it. A drag that reparents has to tell the + person what it would do while they can still change their mind, and the only + honest source for that is the check the command itself makes. Hence one + function, asked by the gesture on the way past and by `move-node` on the way + in. + + The one that surprises: BOTH have to be on screen at this frame, because the + move keeps the picture and there is no common frame to keep it at otherwise. + Two clips of one lane never overlap, so nesting one into another there can + never be done — it is a thing to do between symbols, with the playhead + somewhere both of them are showing. + + The deeper refusals — generated parts, a stencil parted from what it clips — + belong to the transplant and are only known when it runs." + [clip store open from to f] + (let [here (inside clip store open (pop from) f) + there (inside clip store open to f) + n (get-in clip [:symbols (:sid here) :nodes (peek from)])] + (cond + (nil? n) "nothing to move" + (or (nil? here) (nil? there)) "both have to be on screen at this frame" + (nil? (:sid there)) "only a symbol can take it" + (not (and (:time here) (:time there))) + "a held or looping clip has no clock to move through" + (nil? (some-> there :matrix node/invert)) "the target is scaled to nothing" + (= (:sid here) (:sid there)) "it is already there" + (and (= :instance (:kind n)) + (some #(clip/contains-symbol? clip % (:sid there)) (node/sources n))) + "a symbol cannot go inside itself"))) + (defn move-node "Move the node at row path `from` — its last id is the node, the rest the instances down to where it lives — into the symbol placed by the instance at @@ -284,16 +318,11 @@ a (:time here) b (:time there) inv (some-> there :matrix node/invert)] - (cond - (nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) - {:refused "nothing to move"} - (or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"} - (nil? (:sid there)) {:refused "only a symbol can take it"} - (not (and a b)) {:refused "a looping instance is in the way"} - (nil? inv) {:refused "the target is scaled to nothing"} - :else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there) - (node/mul! (node/mat) inv (:matrix here)) - (node/then-time (node/invert-time b) a))))) + (if-let [why (move-refusal clip store open from to f)] + {:refused why} + (transplant clip store (:sid here) (:frame here) (peek from) (:sid there) + (node/mul! (node/mat) inv (:matrix here)) + (node/then-time (node/invert-time b) a))))) (defn- down "Walk row path `path` down from symbol `sid` by structure alone: `{:sid @@ -305,8 +334,8 @@ only a move that keeps the PICTURE needs a frame, for the matrix." [clip 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 + ;; a clip does, and a group holding one does not, so the walk stops at + ;; the group 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])))) @@ -342,13 +371,82 @@ (nil? (:time here)) {:refused "a looping instance is in the way"} :else (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) - d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))] - {:clip (clip/update-symbol - clip (:sid here) update-in [:nodes id] - (fn [n] - (if (= :map (get-in n [:time :mode])) - (update-in n [:time :at] (fnil + 0) d) - (assoc n :time {:mode :map :at d :rate 1}))))})))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + shift (fn [n] + (if (= :map (get-in n [:time :mode])) + (update-in n [:time :at] (fnil + 0) d) + (assoc n :time {:mode :map :at d :rate 1}))) + moved (assoc nodes id (shift (get nodes id))) + ;; An editorial audio link follows a moved picture. Moving or + ;; trimming the audio itself remains independent. + moved (if (= :audio (:kind (get nodes id))) + moved + (reduce (fn [ns [audio-id n]] + (if (and (= :audio (:kind n)) (= id (:linked-to n))) + (assoc ns audio-id (shift n)) + ns)) + moved nodes)) + ps (symbol/problems (assoc (clip/symbol clip (:sid here)) :nodes moved))] + (if (seq ps) + {:refused (first ps)} + {:clip (assoc-in clip [:symbols (:sid here) :nodes] moved)}))))) + +(defn resize-out + "Move the right edge of the node at `path` by `df` frames of `open`. + + One command either way: in a symbol drawn as a lane `span/resize-out` claims + the time it grows into, and in a composition it is one write to one span. The + mode says which, and nothing here has to ask." + [clip open path df ripple?] + (let [here (down clip open (pop path)) + sid (:sid here) + id (peek path) + nodes (:nodes (clip/symbol clip sid)) + n (get nodes id)] + (cond + (nil? n) {:refused "nothing to resize"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + to (+ (second (node/placed-span n)) d)] + (span/resize-out clip sid id to {:ripple? ripple? :extent :grow-symbol}))))) + +(defn resize-in + "Move the left edge of the node at `path` by `df` frames of `open`." + [clip open path df] + (let [here (down clip open (pop path)) + sid (:sid here) + id (peek path) + nodes (:nodes (clip/symbol clip sid)) + n (get nodes id)] + (cond + (nil? n) {:refused "nothing to resize"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + to (+ (first (node/placed-span n)) d)] + (span/resize-in clip sid id to))))) + +(defn roll + "Move the shared boundary at `right-path` and the adjacent `left-path`." + [clip open left-path right-path df] + (let [here (down clip open (pop right-path)) + sid (:sid here) + left-id (peek left-path) + right-id (peek right-path) + nodes (:nodes (clip/symbol clip sid)) + right (get nodes right-id)] + (cond + (or (not= (pop left-path) (pop right-path)) (nil? right)) + {:refused "a rolling edit needs adjacent clips in one sequence"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes right-id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + to (+ (first (node/placed-span right)) d)] + (span/roll clip sid left-id right-id to))))) (defn restack "Put the node at row path `from` just in front of the one at `to` when diff --git a/frontend/src/arthur/domain/node.cljs b/frontend/src/arthur/domain/node.cljs index 1d5a474..3bb5be5 100644 --- a/frontend/src/arthur/domain/node.cljs +++ b/frontend/src/arthur/domain/node.cljs @@ -244,16 +244,6 @@ (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 @@ -415,8 +405,8 @@ (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") + (:layout n) + (conj ":layout is not a node field — a lane is how the timeline DRAWS a symbol, not a thing in the document") (and (= k :audio) (not (some (:source n) [:footage :sound]))) (conj "an audio node needs a :source :footage or :sound") (and (some? (get-in n [:time :rate])) diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index 49bc43a..735f2e8 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -1,28 +1,51 @@ (ns arthur.domain.span - "The commands over ONE node's place in time: split it, trim an edge, move it. + "The commands over a node's place in time: split it, trim an edge, move it — + and, where the symbol holding it is drawn as a lane, re-span its siblings to + make room. A `:span` is in the node's OWN frames and its `:time` says where those land in - its parent, and that is true of EVERY node — which is why these three are not - lane commands, though a lane of cels is where they were first needed. A cel in - a lane, a symbol placed straight into a shot, a shape that exists for part of - one: each is a span in a parent's frame space, and a span in a parent's frame - space is the whole of what these commands touch. They were gated on a lane for - as long as a lane was the only thing anybody had timed. + its parent, and that is true of EVERY node. A clip in a sequence, a symbol + placed straight into a shot, a shape that exists for part of one: each is a + span in a parent's frame space, and a span in a parent's frame space is the + whole of what these commands touch. - THE COORDINATE IS ALWAYS THE PARENT'S. For a cel the parent is its lane, so - `host-frame` reads lane time exactly as the lane commands always did; for a - node sitting straight in the symbol it reads the symbol's own frames. One rule, - so a caller holding a node does not branch on what it sits in. + THE COORDINATE IS ALWAYS THE PARENT'S. `host-frame` reads the frame space the + node is positioned in, whatever that is, so a caller holding a node does not + branch on what it sits in. - A GROUP IS REFUSED. Dividing a group means deciding what becomes of its - children, and nothing in a span says: the right half of a split lane would - reference none of its cels, and a span that narrows past a child hides it - without saying so. `domain/lane` holds the commands for a sequence, which are - the ones that ripple siblings or leave a gap. + A GROUP IS REFUSED where one node is being divided. Dividing a group means + deciding what becomes of its children, and nothing in a span says: a span that + narrows past a child hides it without saying so. - `finish` lives here because every command in this namespace and every one in - `domain/lane` commits through it." - (:require [arthur.domain.clip :as clip] + WHY THE SEQUENCE COMMANDS ARE HERE TOO. They used to be `domain/lane`, gated on + a group with `:layout :sequence`, because a lane was the only thing anybody had + timed. There is no such group any more — the SYMBOL is the container and a lane + is how the timeline draws one, `symbol/lane?` — so their subject is a symbol and + its children, which is the same subject as everything else here: one write to + one node's span, with the siblings re-spanned around it. See + `docs/lane-is-a-view-plan.md`. + + THE CLAIM-TIME RULE FOLLOWS THE MODE. In lane mode, placing, moving or growing + over occupied frames TRIMS what it lands on — trimming the incumbent, removing + one wholly covered, splitting one it lands inside — so the result has no overlap + because the operation that could have made one did not. Outside lane mode + nothing is enforced, because overlapping children are what compositing IS. + + EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or + `{:refused reason}` — never a half-applied edit, and never a document that + `clip/problems` would reject. A command that cannot say what the person meant + refuses and says why, rather than picking for them: the overflow policy is a + caller's `:extent`, and decoupling shared content is its own command instead of + something an ordinary edit does silently. + + IDS COME FROM THE CALLER, because a clip's identity is a uuid and this namespace + is pure. Ids for new CONTENT are derived from the drawing being copied — + `clip/free-id` is pure too, and `drawing-a-2` says what it came from in a way + `symbol-7` does not. + + `finish` lives here because every command in this namespace commits through it." + (:require [arthur.domain.bring :as bring] + [arthur.domain.clip :as clip] [arthur.domain.node :as node] [arthur.domain.symbol :as symbol])) @@ -30,32 +53,43 @@ "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. + shot IS — and where its clips reach is a different fact derived from them. 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 reach 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. + the clips reach, `:frames` is what was authored, and the only way the second + follows the first is a caller asking. - Only LANES are measured for reach. A node placed straight in a shot may hang - off the end of it — that is an ordinary thing to author and the window is - what crops it — whereas a lane's cels are a sequence whose length is the - thing being edited." + Only a symbol drawn AS A LANE is measured for reach. A node placed into a + composition may hang off the end of it — that is an ordinary thing to author and + the window is what crops it — whereas a lane's clips are a sequence whose length + is the thing being edited. + + THE OVERLAP INVARIANT IS ENFORCED HERE, and here is the only place it needs to + be: this is the single commit path for every sequence command, it validates + before it returns, and it refuses rather than half-applying. So no command can + commit an overlap in lane mode, and `symbol/overlaps` turning up anything is a + bug in a command rather than a state to design around." [clip sid nodes selection extent] (let [sym (clip/symbol clip sid) - reach (for [[id n] nodes :when (node/lane? n) - child (symbol/lane-cels nodes id) - :let [m (symbol/frame-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))] + lane? (symbol/lane? sym) + after (assoc sym :nodes nodes) + needed (if-not lane? + 0 + (js/Math.ceil (apply max 0 (keep #(second (node/placed-span %)) + (symbol/children nodes))))) + ps (symbol/problems after) + clashing (when lane? (symbol/overlaps after))] (cond (seq ps) {:refused (first ps)} + (seq clashing) + {:refused (str "that would put " (pr-str (ffirst clashing)) " and " + (pr-str (second (first clashing))) + " on screen over the same frames of a lane")} (not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"} (and (> needed (:frames sym)) (= :keep extent)) {:refused (str "the edit needs " needed " frames; extend the shot to continue") @@ -73,7 +107,7 @@ ;; and `:playback` are untouched — which is why trimming the front of a playing ;; insert starts it later in its source instead of resetting it, and why the two ;; halves of a split go on meaning what the one node meant. -;; Trim, split and `lane/blank` are all this one operation, applied differently. +;; Trim, split and `blank` are all this one operation, applied differently. (defn local "Parent frame `f` as one of `n`'s own frames." @@ -89,8 +123,10 @@ (defn host-frame "Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its parent's — which is the frame space every command here takes its coordinate - in. Nil through a stepped or looping ancestor, where one frame of the symbol - is not one frame of the parent and there is no single answer to give." + in. For a clip of a lane that is the symbol's own frames, because the symbol is + the container and the clip has no parent. Nil through a stepped or looping + ancestor, where one frame of the symbol is not one frame of the parent and there + is no single answer to give." [clip sid id f] (let [nodes (get-in clip [:symbols sid :nodes])] (when-let [{:keys [at rate]} (symbol/frame-map nodes (:parent (get nodes id)))] @@ -98,7 +134,7 @@ (defn- subject "The node `id` names, as `{:node n}`, or `{:refused why}` where these commands - have nothing to act on. The one guard all three share." + have nothing to act on. The one guard they share." [nodes id] (let [n (get nodes id)] (cond @@ -109,6 +145,13 @@ {:refused "this is on screen for the whole shot, so it has no edges to cut"} :else {:node n}))) +(defn- siblings + "The other clips of `sid`'s sequence, or nil where `sid` is not drawn as a lane + and so has no sequence to re-span." + [clip sid nodes id] + (when (symbol/lane? (clip/symbol clip sid)) + (remove #(= id (:id %)) (symbol/children nodes)))) + (defn split "Cut node `id` in two at parent frame `cut`. The left piece keeps its identity; the right gets `new-id`. @@ -125,8 +168,8 @@ THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at one depth; nothing orders them against each other, because they are never on - screen on the same frame. Cels in a lane do not consult `:z` at all — - `symbol/lane-cels` sorts them by where they start. + screen on the same frame. A lane's clips do not consult `:z` at all — + `symbol/children` sorts them by where they start. The right piece is the selection, because it is the piece that was made." [clip sid id cut new-id] @@ -148,10 +191,10 @@ "Move one edge of node `id` to parent frame `to`, without disturbing anything else at all. - TRIM NARROWS. Lengthening a cel is `lane/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`. + TRIM NARROWS. Lengthening is `resize-out`, 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 @@ -170,15 +213,16 @@ (defn move "Put node `id` at parent frame `to`, leaving its own length, source and - corrections alone — and, in a lane, every other cel. + corrections alone — and, in a lane, every other clip. One write to `:time :at`. A destination that would overlap a neighbour IN A LANE is refused rather than rippled or overwritten: moving a drawing and re-timing the ones around it are different intentions, and a move that silently pushed the rest would be the second one wearing the first one's name. - Clear the room first — `lane/blank` makes a gap, `trim` shortens a neighbour. - Outside a lane there is no such rule to break: things placed in a composition - are allowed to be on screen together, so the move simply happens." + Clear the room first — `blank` makes a gap, `trim` shortens a neighbour — or + say you meant to claim it, which is `adopt`, what a body drag does. + Outside lane mode there is no such rule to break: things placed in a + composition are allowed to be on screen together, so the move simply happens." [clip sid id to] (let [nodes (get-in clip [:symbols sid :nodes]) {:keys [node refused]} (subject nodes id)] @@ -190,3 +234,520 @@ (if (not= to (first (node/placed-span moved))) {:refused "timing through a stepped or looping parent is not supported"} (finish clip sid (assoc nodes id moved) id :keep)))))) + +;; --------------------------------------------------------------------------- +;; the sequence: one edge edit, with the siblings re-spanned around it + +(defn- trimmed-into-a-sequence + "`nodes` with every clip's right edge pulled back to where the next one starts, + and any clip the next one wholly covers removed. + + THE SAME CLAIM-TIME RULE, APPLIED ALL AT ONCE. Later claims from earlier + everywhere it has to, which is the rule every other command here follows one + edit at a time; doing it as a pass is only what makes the answer to \"make this + a lane\" one undo step." + [nodes] + (reduce + (fn [ns [earlier later]] + (let [[lo hi] (node/placed-span (get ns (:id earlier))) + [next-lo _] (node/placed-span later)] + (cond + (nil? lo) ns + (<= hi next-lo) ns + (<= next-lo lo) (dissoc ns (:id earlier)) + :else (assoc ns (:id earlier) (edged (get ns (:id earlier)) :out next-lo))))) + nodes + (partition 2 1 (symbol/children nodes)))) + +(defn draw-as-lane + "Turn symbol `sid`'s lane mode on or off. `{:clip c}` or `{:refused why}`. + + OFF IS ALWAYS POSSIBLE: a composition has no invariant to break, so dropping + the hint drops the rules with it and nothing in the document moves. + + ON IS THE ONE PLACE A PERSON CAN ASK FOR THE IMPOSSIBLE. Every other command + maintains the sequence; this one asks a symbol whose clips may already be on + screen together to start being one, and there is no answer that does not throw + frames away. So it refuses and says how many clips it would have to trim, + carrying `:required-trim` for the retry the UI offers as one button — the same + shape as `finish`'s `:required-frames`. With `trim?` it does it: later claims + from earlier, which is the rule everything else here already follows." + [clip sid on? {:keys [trim?]}] + (let [sym (clip/symbol clip sid)] + (cond + (nil? sym) {:refused "there is no such symbol"} + (not on?) {:clip (update-in clip [:symbols sid] dissoc :display)} + :else + (let [clashing (symbol/overlaps sym)] + (cond + (empty? clashing) {:clip (assoc-in clip [:symbols sid :display] :lane)} + (not trim?) + {:refused (str "drawing this as a lane means trimming " + (count clashing) " clip" + (when (< 1 (count clashing)) "s") + " that overlap a neighbour") + :required-trim (count clashing)} + :else + (let [nodes (trimmed-into-a-sequence (:nodes sym)) + after (assoc sym :nodes nodes :display :lane)] + (if (seq (symbol/overlaps after)) + {:refused "these clips cannot be trimmed into a sequence"} + {:clip (assoc-in clip [:symbols sid] after)}))))))) + +(defn resize-out + "Put clip `id`'s right edge at parent frame `to`, allowing it to grow. + + IN A LANE this claims time. Without `ripple?`, growing consumes the starts of + the clips it reaches: wholly covered clips disappear and the last partially + covered one is trimmed. Shrinking leaves a gap. With `ripple?`, every clip + beginning at or after the old edge moves by the same delta, in either + direction, so their contents are preserved. Either way there is no overlap, + because the operation that could have made one did not. + + OUTSIDE A LANE it is one write to one span and nothing else moves, because + things placed in a composition are allowed to be on screen together. One + gesture, and the mode says which rule it plays by." + [clip sid id to {:keys [extent ripple?] :or {extent :keep ripple? false}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [lo old-out] (when node (node/placed-span node)) + later (when node + (filter #(>= (first (node/placed-span %)) old-out) + (siblings clip sid nodes id)))] + (cond + refused {:refused refused} + (not (integer? to)) {:refused "an edge goes to a whole frame"} + (not (< lo to)) {:refused "a clip must keep at least one frame"} + (= to old-out) {:clip clip :selection id} + :else + (let [delta (- to old-out) + resized (assoc nodes id (edged node :out to)) + changed + (if ripple? + (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) + resized later) + (if (pos? delta) + (reduce + (fn [ns sibling] + (let [[s e] (node/placed-span sibling)] + (cond + (>= s to) ns + (<= e to) (dissoc ns (:id sibling)) + :else (assoc ns (:id sibling) (edged sibling :in to))))) + resized later) + resized))] + (finish clip sid changed id extent))))) + +(defn resize-in + "Put clip `id`'s left edge at parent frame `to`. Shrinking leaves a gap; + in a lane, growing left consumes earlier clips symmetrically with `resize-out`." + [clip sid id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [old-in hi] (when node (node/placed-span node)) + earlier (when node + (filter #(<= (second (node/placed-span %)) old-in) + (siblings clip sid nodes id)))] + (cond + refused {:refused refused} + (not (integer? to)) {:refused "an edge goes to a whole frame"} + (not (< to hi)) {:refused "a clip must keep at least one frame"} + (neg? to) {:refused "a clip cannot begin before the shot"} + (= to old-in) {:clip clip :selection id} + :else + (let [resized (assoc nodes id (edged node :in to)) + changed (if (< to old-in) + (reduce + (fn [ns sibling] + (let [[s e] (node/placed-span sibling)] + (cond + (<= e to) ns + (>= s to) (dissoc ns (:id sibling)) + :else (assoc ns (:id sibling) (edged sibling :out to))))) + resized earlier) + resized)] + (finish clip sid changed id :keep))))) + +(defn roll + "Move the shared boundary between adjacent clips `left-id` and `right-id`. + This is deliberately only the composition of the two ordinary edge edits." + [clip sid left-id right-id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + left (get nodes left-id) + right (get nodes right-id) + [llo lhi] (when left (node/placed-span left)) + [rlo rhi] (when right (node/placed-span right))] + (cond + (not (symbol/lane? (clip/symbol clip sid))) + {:refused "a rolling edit needs a symbol drawn as a lane"} + (not (and llo rlo (nil? (:parent left)) (nil? (:parent right)))) + {:refused "a rolling edit needs two clips of one sequence"} + (not= lhi rlo) {:refused "a rolling edit needs one shared boundary"} + (not (integer? to)) {:refused "a clip edge goes to a whole frame"} + (not (< llo to rhi)) {:refused "both clips must keep at least one frame"} + :else + (let [left-result (resize-out clip sid left-id to {})] + (if (:refused left-result) + left-result + (resize-in (:clip left-result) sid right-id to)))))) + +(defn blank + "Clear frames `[a b)` of symbol `sid`, leaving a GAP. + + A gap is not a drawing. Nothing is invented to cover those frames and nothing + closes the hole — the clips after it stay where they are, because emptying + frames and re-timing a performance are different intentions. + + What it does to each clip it meets is `edged`, applied three ways: one wholly + inside is removed, one overlapping an end is trimmed to it, and the one that + spans the whole range is split, which is the only case that needs `id`. Their + drawings stay in the library — a symbol does not own its content, and a drawing + whose last clip is gone is still a drawing somebody made." + [clip sid [a b] {:keys [id]}] + (let [nodes (get-in clip [:symbols sid :nodes]) + lane? (symbol/lane? (clip/symbol clip sid)) + members (when lane? (symbol/children nodes)) + spanning (when members + (first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b))) + members)))] + (cond + (not lane?) {:refused "clearing a range of frames needs a symbol drawn as a lane"} + (not (and (integer? a) (integer? b) (< a b))) + {:refused "a range to blank is whole frames, and not empty"} + (and spanning (or (nil? id) (contains? nodes id))) + {:refused "blanking inside one clip splits it, which needs a free ID for the remainder"} + :else + (let [nodes (reduce + (fn [ns n] + (let [[lo hi] (node/placed-span n)] + (cond + (or (<= hi a) (>= lo b)) ns + (and (< lo a) (> hi b)) + (-> ns + (assoc (:id n) (edged n :out a)) + (assoc id (assoc (edged n :in b) :id id :z (str "a-" id)))) + (and (>= lo a) (<= hi b)) (dissoc ns (:id n)) + (< lo a) (assoc ns (:id n) (edged n :out a)) + :else (assoc ns (:id n) (edged n :in b))))) + nodes members)] + ;; NOTHING SENSIBLE IS SELECTED by emptying frames, so nothing is: a + ;; split names its remainder, and otherwise the caller keeps whatever was + ;; selected rather than being handed a clip it did not ask for. + (finish clip sid nodes (when spanning id) :keep))))) + +(defn- cleared + "`clip` with frames `[at (+ at duration))` of `sid` emptied where `sid` is drawn + as a lane, and untouched where it is not: outside lane mode a placement does not + claim time, because being on screen together is what compositing IS. + + `{:clip c}` or `{:refused why}`, so one `if-let` covers both." + [clip sid at duration remainder-id] + (if-not (symbol/lane? (clip/symbol clip sid)) + {:clip clip} + (blank clip sid [at (+ at duration)] {:id remainder-id}))) + +(defn extend-hold + "Change one held clip's duration by `delta` frames and ripple its later + siblings. Keys, source clocks and the clips' own channels stay put. + Returns {:clip :selection} or {:refused :required-frames?}; never partially edits." + [clip sid id delta {:keys [extent] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + n (get nodes id) + rate (:rate (node/time-of n)) + span (:span n)] + (cond + (not (symbol/lane? (clip/symbol clip sid))) + {:refused "a hold is lengthened in a symbol drawn as a lane"} + (nil? (node/placed-span n)) {:refused "select a clip in the lane"} + (some? (:parent n)) {:refused "select a clip of the lane itself"} + (not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of frames"} + (not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"} + (<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive exposure"} + :else + (let [[_ boundary] (node/placed-span n) + later (filter #(>= (first (node/placed-span %)) boundary) + (siblings clip sid nodes id)) + nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta))) + nodes (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) + nodes later)] + (finish clip sid nodes id extent))))) + +(defn place-node + "Place the already-materialized, direct child `n` into symbol `sid` at `at`. + + THIS IS THE PLACEMENT RULE. Materializing a symbol instance, an audio node, or + imported content is deliberately somebody else's job; once it is a node, its + origin no longer matters. The destination alone decides the edit: + + - an ordinary symbol attaches it and permits overlap; + - a lane symbol first clears the interval it claims. + + The caller hands this function a node not currently present in the destination. + Its duration, channels, source clock and identity are preserved; only its + parent-space start changes. Returns the ordinary command result shape." + [clip sid n at {:keys [extent remainder-id] :or {extent :keep}}] + (let [sym (clip/symbol clip sid) + nodes (:nodes sym) + id (:id n) + [lo hi] (when n (node/placed-span n)) + duration (when (and lo hi) (- hi lo))] + (cond + (nil? sym) {:refused "there is no destination symbol"} + (nil? n) {:refused "there is no clip to place"} + (contains? nodes id) {:refused "the destination already uses that clip ID"} + (some? (:parent n)) {:refused "only a direct child can be placed in a symbol"} + (not (and (integer? at) (not (neg? at)))) + {:refused "a position is a nonnegative whole frame"} + (not (pos? duration)) {:refused "the clip has no frames to place"} + (and remainder-id (contains? nodes remainder-id)) + {:refused "the remainder clip needs a free ID"} + :else + (let [room (cleared clip sid at duration remainder-id)] + (if (:refused room) + room + (let [placed (update-in n [:time :at] (fnil + 0) (- at lo)) + nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id placed)] + (finish (:clip room) sid nodes id extent))))))) + +(defn place-symbol + "Materialize an instance of `source-id`, then place it into `sid` at `at`. + + IN A LANE the new clip claims its interval: existing clips under it are + trimmed, removed, or split, so the sequence stays a partition rather than + storing an overlap. Outside one it is simply placed. This is the generic + operation behind dropping a library symbol into the timeline; one-frame held + drawing creation remains a policy of `append-drawing`/`overwrite-drawing`, + not a different kind of container." + [clip store sid id source-id at + {:keys [extent point remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + seeded (clip/place-symbol clip store sid source-id 0 id point) + n (get-in seeded [:symbols sid :nodes id])] + (cond + (contains? nodes id) {:refused "the new clip ID is already used"} + (nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"} + (nil? n) {:refused "a symbol cannot go inside itself"} + :else + (place-node clip sid n at {:extent extent :remainder-id remainder-id})))) + +(defn adopt + "Move an existing clip of `sid` to frame `at`, CLAIMING the time it lands on. + + Its source, span, transforms, corrections, and identity come with it; in a lane + the destination interval is claimed with the same trimming as a pool drop. This + is what a body drag does, and it is why `move` and this are two commands: + `move` refuses to disturb a neighbour, and a drag onto occupied time has + already said it means to." + [clip sid id at opts] + (let [nodes (get-in clip [:symbols sid :nodes]) + n (get nodes id)] + (cond + (nil? n) {:refused "select a clip to move"} + (some? (:parent n)) {:refused "only a clip of the symbol itself is placed in its sequence"} + :else + (place-node (assoc-in clip [:symbols sid :nodes] (dissoc nodes id)) + sid n at opts)))) + +(defn transfer + "Move direct child `id` from `from-sid` into `to-sid` at `at`. + + Cross-symbol and same-symbol moves are deliberately the same composition: + detach, then `place-node`. The destination's mode—not the gesture, source, or + payload kind—decides whether occupied time is claimed." + [clip from-sid id to-sid at opts] + (let [from-nodes (get-in clip [:symbols from-sid :nodes]) + n (get from-nodes id)] + (cond + (nil? n) {:refused "select a clip to move"} + (some? (:parent n)) {:refused "only a direct child can move between symbols"} + :else + (let [detached (assoc-in clip [:symbols from-sid :nodes] (dissoc from-nodes id)) + result (place-node detached to-sid n at opts)] + (if-let [made (:clip result)] + (if-let [why (first (clip/problems made))] + {:refused why} + result) + result))))) + +;; --------------------------------------------------------------------------- +;; putting drawings in a sequence + +(defn- held + "A one-frame held clip of `drawing-id`, starting at frame `at`. + + Held rather than playing, and one frame rather than the length of what it + places: a clip's duration is the sequence's business — `extend-hold` and + `resize-out` are how it changes — and reading it off the content would make + placing a ten-frame animation and holding its first drawing the same gesture." + [id drawing-id at] + {:id id :kind :instance :z (str "a-" id) + :span [0 1] :time {:at at :rate 1} + :source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}}) + +(defn- sequence-end + "Where `sid`'s occupied frames stop." + [nodes] + (apply max 0 (map #(second (node/placed-span %)) (symbol/children nodes)))) + +(defn- place + "Put a held clip of `drawing-id` into `sid` at frame `at`, and RIPPLE: + everything starting at or after it moves later by its duration. + + There is one placement function and `:end` is a position like any other, so + appending is not a different operation from inserting — the end is just where + nothing has to move. Overwriting is the other policy and is NOT this: taking + frames away from the clip already there is trimming, which is its own command + and not something placing a drawing should do on the quiet. + + `:frame` in the result is where it landed, in the symbol's own frames, for a + caller that wants to look at what it just made." + [clip sid id drawing-id at extent ripple?] + (let [nodes (get-in clip [:symbols sid :nodes]) + at (if (= :end at) (sequence-end nodes) at) + n (held id drawing-id at) + [lo hi] (node/placed-span n) + ;; RIPPLE FOLLOWS THE MODE. Pushing later siblings is what inserting + ;; into a sequence means; in a composition there is no "later sibling" + ;; to push, because being on screen together is the point. + later (when (and ripple? (symbol/lane? (clip/symbol clip sid))) + (filter #(>= (first (node/placed-span %)) lo) (symbol/children nodes))) + nodes (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) + (assoc nodes id n) later) + result (finish clip sid nodes id extent)] + (cond-> result + (:clip result) (assoc :frame at)))) + +(defn- placeable + "Why a held clip cannot go into `sid` at `at`, or nil." + [clip sid id at] + (let [nodes (get-in clip [:symbols sid :nodes]) + ;; INSIDE a clip is not a position for another one, IN A LANE. Splitting + ;; that clip is what makes it two, and doing it here would be one command + ;; quietly performing two: the caller asks for `split` and then places. + ;; In a composition landing inside something is not a collision at all. + inside (when (and (number? at) (symbol/lane? (clip/symbol clip sid))) + (some (fn [n] (let [[lo hi] (node/placed-span n)] + (when (< lo at hi) n))) + (symbol/children nodes)))] + (cond + (contains? nodes id) "the new clip ID is already used" + (not (or (= :end at) (and (integer? at) (not (neg? at))))) + "a position is :end or a whole frame" + inside (str "frame " at " is inside a clip; split it first")))) + +(defn append-drawing + "Append fresh empty content and a held clip of it. IDs come from the + caller so a command is deterministic and replayable. + + Fresh content, not a blank range: a sequence with no clip over a frame shows + nothing there already, and a drawing nobody has drawn in is a different thing + from a gap." + [clip sid id drawing-id {:keys [at extent] :or {extent :keep at :end}}] + (if-let [why (or (placeable clip sid id at) + (when (clip/symbol clip drawing-id) "the new drawing ID is already used"))] + {:refused why} + (place (assoc-in clip [:symbols drawing-id] + {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) + sid id drawing-id at extent true))) + +(defn reuse-drawing + "Append a held clip of content the document ALREADY has, so the same + drawing is exposed twice and editing it changes both clips. + + This is the command `make-unique` is the undo of, and the reason they are two + commands: reuse is a decision to share, and sharing is not something to + discover later when an edit turns up somewhere else." + [clip sid id drawing-id {:keys [at extent] :or {extent :keep at :end}}] + (if-let [why (or (placeable clip sid id at) + (when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse") + ;; Placing something that contains this symbol would close a + ;; loop, and a sequence is no different from any other placement. + (when (clip/contains-symbol? clip drawing-id sid) + "a symbol cannot go inside itself"))] + {:refused why} + (place clip sid id drawing-id at extent true))) + +(defn- copied + "A copy of symbol `from`, as `{:clip :id}`. + + SHALLOW by default: its own nodes and channels are copied, and its references + to other symbols are kept, so a head built out of reusable eyes still uses + those eyes. `deep?` copies everything it places as well, with new ids + throughout, for a drawing that must share nothing — the distinction the + shallow copy cannot make on its own, and a promise of independence that only + the deep one keeps." + [clip from deep?] + (if deep? + (let [{c :clip ids :ids} (bring/symbols clip clip [from] {})] + {:clip c :id (ids from)}) + (let [id (clip/free-id (:symbols clip) from)] + {:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id)) + :id id}))) + +(defn duplicate-drawing + "Append a held clip of a COPY of what clip `id` places, for when + the drawing on screen is the starting point for the next one. + + The copy is of the content only. The new clip is a plain one-frame hold + rather than a copy of `id`'s own transform or corrections: those belong to + that clip, and carrying them over would make duplicating a drawing quietly + duplicate the treatment of one use of it." + [clip sid id new-id {:keys [at extent deep?] :or {extent :keep at :end}}] + (let [n (get-in clip [:symbols sid :nodes id]) + from (node/source n)] + (if-let [why (or (when-not from "select a clip to duplicate") + (when-not (clip/symbol clip from) "the drawing it places is missing") + (placeable clip sid new-id at))] + {:refused why} + (let [{c :clip copy :id} (copied clip from deep?)] + (place c sid new-id copy at extent true))))) + +(defn overwrite-drawing + "Put a fresh one-frame drawing at frame `at`, replacing whatever was there and + leaving every other clip where it was. + + This is `blank` and placement composed in ONE command and therefore one undo + step. `remainder-id` is used only when clearing the frame cuts one clip into + two; ids still come from the caller because this namespace is pure." + [clip sid id drawing-id at {:keys [extent remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes])] + (if-let [why (cond + (not (and (integer? at) (not (neg? at)))) + "a position is a nonnegative whole frame" + (contains? nodes id) "the new clip ID is already used" + (or (= id remainder-id) (contains? nodes remainder-id)) + "the remainder clip needs a free ID different from the new clip" + (clip/symbol clip drawing-id) "the new drawing ID is already used")] + {:refused why} + (let [room (cleared clip sid at 1 remainder-id)] + (if (:refused room) + room + (place (assoc-in (:clip room) [:symbols drawing-id] + {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) + sid id drawing-id at extent false)))))) + +(defn make-unique + "Point clip `id` at a private copy of its content, leaving every other + clip of that drawing sharing the original. + + Refused when nothing else uses it: a drawing with one clip is already + unique, and answering with a silent copy would leave a second identical symbol + in the library for no reason a person could see." + [clip sid id {:keys [deep?]}] + (let [n (get-in clip [:symbols sid :nodes id]) + from (node/source n) + elsewhere (for [[osid osym] (:symbols clip) + [oid on] (:nodes osym) + :when (and (= from (node/source on)) (not= [sid id] [osid oid]))] + [osid oid])] + (if-let [why (or (when-not from "select a clip to make unique") + (when-not (clip/symbol clip from) "the drawing it places is missing") + (when (empty? elsewhere) "nothing else uses this drawing"))] + {:refused why} + (let [{c :clip copy :id} (copied clip from deep?) + c (assoc-in c [:symbols sid :nodes id :source :symbol] copy) + ps (clip/problems c)] + (if (seq ps) {:refused (first ps)} {:clip c :selection id}))))) diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index cda5d5d..d0c1a31 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -71,7 +71,13 @@ repeat cannot be longer than the number of nodes, so one step past that is proof of a loop and needs no bookkeeping. Caught rather than hung — a cycle is reachable from one bad `:node/set-parent`, and a hung tab is a far worse - diagnostic than a stack trace naming the nodes." + diagnostic than a stack trace naming the nodes. + + THE PROOF ONLY HOLDS FOR A NODE THIS SYMBOL HAS. An id that is not in `nodes` + contributes a step the count knows nothing about, and its lineage is just + itself; in an EMPTY symbol that one step used to be read as a loop, so asking + where a node of another symbol sits threw `parent cycle` instead of answering + that it sits nowhere." [nodes id] (let [up (fn [i] (when-let [p (:parent (get nodes i))] @@ -81,7 +87,7 @@ {:node i :parent p}))))) chain (into [] (comp (take-while some?) (take (inc (count nodes)))) (iterate up id))] - (when (> (count chain) (count nodes)) + (when (and (contains? nodes id) (> (count chain) (count nodes))) (throw (ex-info "parent cycle in symbol" {:node id :chain chain}))) chain)) @@ -90,16 +96,25 @@ [nodes id] (dec (count (lineage nodes id)))) -(defn lane-cels - "The cels of lane `lane`, in the order they are exposed. +(defn children + "The symbol's own clips — the nodes placed directly in it — in timeline order. - Sorted by where they START, not by `:z`: a lane's blocks follow one another in - 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] + THE SYMBOL IS THE CONTAINER. There is no lane node to ask for its members: a + symbol drawn as a lane draws THESE, and the sequence commands re-span THESE. + See `docs/lane-is-a-view-plan.md`. + + Sorted by where they START, not by `:z`: blocks in a sequence follow one + another in time, and two of them cannot be in the same place for `:z` to + decide between. Ties go to the id so the order is the same on every run. + + A NODE WITH NO SPAN IS NOT IN THE SEQUENCE. A shape on screen for the whole + shot has no `[in out)` to follow anything else, so it is not something an edge + edit can trim or ripple, and a command that destructured its nil span would + fail on the most ordinary node there is." + [nodes] (->> (vals nodes) - (filter #(= lane (:parent %))) - (sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %)))) + (filter #(and (nil? (:parent %)) (node/placed-span %))) + (sort-by (juxt #(first (node/placed-span %)) #(str (:id %)))) vec)) (defn frame-map @@ -107,10 +122,10 @@ `{:at a :rate r}`, meaning symbol frame `p` is frame `r·(p − a)` of `id`. Identity for `nil`, which is a node sitting directly in the symbol. - THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A cel's parent is its - lane, so a lane command composing this for the lane reads lane time; a node - with no parent reads the symbol's own frames. One rule either way, so a caller - holding a node does not have to ask what it is sitting in. + THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A direct child reads + the symbol's own frames. A node grouped beneath another composes through that + parent chain. One rule either way, so a caller holding a node does not have to + ask what it is sitting in or how the timeline happens to draw the symbol. Refuses floors and loops rather than pretend an affine map preserves them: through either, one frame of the symbol is not one frame of `id` and a command @@ -125,51 +140,47 @@ (<= (or (:expose t) 1) 1)) (recur (:parent n) (conj seen id) (conj chain n))))))) -(defn lanes - "The symbol's lanes, front-most first. +(defn lane? + "Whether symbol `sym` is EDITED AND DRAWN as a lane: its clips as blocks on + one row, following one another in time and claiming it from each other. - SAME ORDER THE TIMELINE DRAWS ITS ROWS IN — `:z` descending, the id breaking - ties so it is stable across runs — because the cel sheet's columns are those - rows stood on end, and \"the first lane\" has to mean the same thing to the view - that shows them and to the command that defaults to one. + A DISPLAY HINT AND NOT A TYPE. Nothing in evaluation reads it, `problems` does + not check it, and a symbol carrying it behaves identically on the stage — it + says how the timeline draws the symbol and, because the editing rules follow + the mode, which rules an edge drag inside it plays by. It is on the symbol + rather than in editor state so that those rules are reproducible between two + people looking at one document, and it is a field rather than something derived + from \"the clips do not currently overlap\" because a symbol must not stop being + a lane the moment something overlaps — that is when the rules are needed. - Only this symbol's own: a lane inside a nested instance belongs to that - symbol, and aiming a drawing at it is entering it first." - [nodes] - (->> (vals nodes) - (filter node/lane?) - (sort-by (fn [n] [(or (:z n) "") (str (:id n))])) - reverse - vec)) + Editing and presentation may read it; evaluation may not. See + `docs/lane-is-a-view-plan.md`." + [sym] + (= :lane (:display sym))) -(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. +(defn overlaps + "The pairs of `sym`'s clips that are on screen over the same frames, as + `[[a b] ...]` of ids. Empty for a symbol whose clips form a sequence. - 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))) + A BUG REPORT, NOT A CONDITION TO DESIGN AROUND. In lane mode this cannot + happen: placing claims time, so anything placed, moved or grown over occupied + frames TRIMS what it lands on, and `span/finish` — the one commit path for + every sequence command — refuses rather than committing one. So an overlap that + appears anyway is a defect in a command. + + Which is why it is NOT `clip/problems`, which means the document will not load: + a display hint must never be able to stop a document loading, and a document + that somehow arrives holding an overlap still opens and is drawn visibly wrong. + Nor `clip/conflicts`, which means a person has a decision to make. This is + neither." + [sym] + (let [spans (for [n (children (:nodes sym)) + :let [[lo hi] (node/placed-span n)] + :when (and (node/finite-number? lo) (node/finite-number? hi))] + [lo hi (:id n)])] + (vec (for [[[_ b x] [c _ y]] (partition 2 1 (sort-by (juxt first second str) spans)) + :when (> b c)] + [x y])))) (defn order "Node ids in topological order: every node after its parent. @@ -692,8 +703,12 @@ and saved leaves point at, so renaming a symbol must not change it. `:width` and `:height` are the symbol's own stage, and are absent until someone - sets them: a symbol without them uses the clip's — see `clip/stage`." - #{:id :name :frames :fps :width :height :nodes :palette}) + sets them: a symbol without them uses the clip's — see `clip/stage`. + + `:display` is how the TIMELINE draws the symbol — `:lane` for its clips as + blocks on one row — and is saved because two people editing one document must + play by the same editing rules. See `lane?`." + #{:id :name :frames :fps :width :height :nodes :palette :display}) (defn problems "Human-readable reasons this symbol will not evaluate. Empty means it will. @@ -711,7 +726,6 @@ (if-not (map? nodes) [":nodes must be a map of id -> node"] (-> [] - (into (lane-problems nodes)) (into (for [[id n] nodes :when (not= id (:id n))] (str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index 2966576..f1d2e39 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -6,7 +6,9 @@ address of every block this produces." (:require [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] + [arthur.domain.span :as span] [arthur.events.edit :as edit] + [arthur.events.ui :as ui] [arthur.events.playback :as pb] [arthur.flow.detect :as detect] [arthur.flow.ingest :as ingest] @@ -466,12 +468,13 @@ (rf/reg-event-db ::ask-convert - (fn [db [_ {:keys [frames label] :as footage} frame point]] + (fn [db [_ {:keys [frames label] :as footage} frame point target]] (assoc-in db [:ui :convert] (merge (select-keys footage [:id :label :frames :fps :video]) {:range [0 frames] :name (string/replace (str label) #"\.[^.]*$" "") - :host (get-in db [:ui :open]) :frame frame :point point})))) + :host (get-in db [:ui :open]) :frame frame :point point + :target target})))) (rf/reg-event-db ::convert-set @@ -494,28 +497,43 @@ (rf/reg-event-fx ::converted - (fn [{:keys [db]} [_ {{:keys [name host frame point range]} :request footage-id :footage-id} + ;; A TAKE IS A CLIP LIKE ANY OTHER, placed into whichever symbol the drop names + ;; — see `ui/drop-destination` — rather than into a container invented for it. + (fn [{:keys [db]} [_ {{:keys [name frame point range target]} :request footage-id :footage-id} built]] - (let [uuid (random-uuid) + (let [entry (store/entry (:clip/current db)) + uuid (random-uuid) fps (get-in db [:clip :fps]) {:keys [clip sid tracked?]} - (bring/take (:clip (store/entry (:clip/current db))) (:clip built) - name footage-id range) + (bring/take (:clip entry) (:clip built) name footage-id range) + st (merge (:store entry) (:store built)) imported-frames (clip/output-frames clip sid) source-fps (get-in built [:clip :fps]) - db (edit/edit-entry - db - #(cond-> (bring/placed % clip (:store built) sid host frame uuid point) - tracked? (merge (select-keys built [:footage-id :source-blocks - :source-inputs]))))] - {:db (-> db - (update :ui dissoc :convert) - (assoc-in [:ui :selection] [:node host uuid [uuid]]) - (update :footage merge - {:loading? false - :status (str "made " name " · " imported-frames " frames at " fps " fps" - (when (not= fps source-fps) - (str " · sampled from " source-fps " fps")) - (when-not tracked? - " · as drawings: this project already tracks other footage"))})) - :dispatch [::pb/refresh-clock]}))) + where (ui/drop-destination db clip st frame target) + result (if (:refused where) + where + (span/place-symbol (:clip where) st (:sid where) + uuid sid (:at where) + {:extent :grow-symbol :point point + :remainder-id (random-uuid)}))] + (if-let [why (or (:refused where) (:refused result))] + {:db (-> db + (update :ui dissoc :convert) + (update :footage merge {:loading? false :status why}))} + (let [db (edit/edit-entry + db + #(cond-> (assoc % :clip (:clip result) :store st) + tracked? (merge (select-keys built [:footage-id :source-blocks + :source-inputs]))))] + {:db (-> db + (update :ui dissoc :convert) + (assoc-in [:ui :selection] + [:node (:sid where) uuid (conj (vec (:path where)) uuid)]) + (update :footage merge + {:loading? false + :status (str "made " name " · " imported-frames " frames at " fps " fps" + (when (not= fps source-fps) + (str " · sampled from " source-fps " fps")) + (when-not tracked? + " · as drawings: this project already tracks other footage"))})) + :dispatch [::pb/refresh-clock]}))))) diff --git a/frontend/src/arthur/events/playback.cljs b/frontend/src/arthur/events/playback.cljs index c79e5e2..ce74ca5 100644 --- a/frontend/src/arthur/events/playback.cljs +++ b/frontend/src/arthur/events/playback.cljs @@ -190,6 +190,18 @@ {:db (-> db (update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid))) (assoc-in [:ui :open] sid) + ;; WHAT WAS SELECTED IS NOT IN HERE. A node selection and an + ;; aimed target are paths in the symbol being left, and every + ;; bar that reads one — the breadcrumb, the inspector, where a + ;; new symbol would land — reads it against the open one. So + ;; opening a symbol arrives with nothing selected, which is the + ;; state the root crumb already means. A `[:symbol _]` + ;; selection names a symbol rather than a place inside one and + ;; survives. + (update :ui (fn [ui] + (cond-> (dissoc ui :target) + (= :node (first (:selection ui))) + (dissoc :selection)))) (update-in [:ui :trace :faces] #(trace/showing-for clip sid %)) (assoc-in [:playback :frame] 0) (assoc-in [:playback :playing?] false)) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index ab6b630..d4ada08 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -24,6 +24,7 @@ (:require [arthur.db :as db] [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] + [arthur.domain.span :as span] [arthur.domain.leaf :as leaf] [arthur.domain.node :as node] [arthur.events.edit :as edit] @@ -34,6 +35,7 @@ [arthur.domain.wire :as wire] [arthur.events.footage :as footage] [arthur.events.playback :as pb] + [arthur.events.ui :as ui] [arthur.footage.store :as store] [arthur.flow.address :as address] [arthur.flow.ingest :as ingest] @@ -153,26 +155,38 @@ ::import ;; A symbol out of another saved project, dropped at `frame` of the open symbol ;; and, from the stage, with its middle on `point`. - (fn [{:keys [db]} [_ carried frame point]] + (fn [{:keys [db]} [_ carried frame point target]] {:db (update db :project merge {:status (str "fetching " (:label carried) "…")}) ::import! (assoc (select-keys carried [:project :cid :symbol :label]) - :host (get-in db [:ui :open]) :frame frame :point point)})) + :host (get-in db [:ui :open]) :frame frame :point point + :target target)})) (rf/reg-event-fx ::imported ;; As drawing: its tracking stays with the analysis that measured it. See ;; `arthur.domain.bring`. - (fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]] - (let [sid (leaf/unsegment symbol) + (fn [{:keys [db]} [_ {:keys [symbol frame point label target]} other]] + (let [entry (store/entry (:clip/current db)) + sid (leaf/unsegment symbol) uuid (random-uuid) - {:keys [clip ids]} (bring/symbols (:clip (store/entry (:clip/current db))) - (:clip other) [sid] {}) - db (edit/edit-entry db #(bring/placed % clip (:store other) (ids sid) - host frame uuid point))] - {:db (-> db - (assoc-in [:ui :selection] [:node host uuid [uuid]]) - (update :project merge {:status (str "brought in " label)})) - :dispatch [::pb/refresh-clock]}))) + {:keys [clip ids]} (bring/symbols (:clip entry) (:clip other) [sid] {}) + st (merge (:store entry) (:store other)) + ;; A symbol from another project arrives as an ordinary clip, the same + ;; as one from this project's pool. + where (ui/drop-destination db clip st frame target) + result (if (:refused where) + where + (span/place-symbol (:clip where) st (:sid where) + uuid (ids sid) (:at where) + {:extent :grow-symbol :point point + :remainder-id (random-uuid)}))] + (if-let [why (or (:refused where) (:refused result))] + {:db (update db :project merge {:status why})} + {:db (-> (edit/edit-entry db #(assoc % :clip (:clip result) :store st)) + (assoc-in [:ui :selection] + [:node (:sid where) uuid (conj (vec (:path where)) uuid)]) + (update :project merge {:status (str "brought in " label)})) + :dispatch [::pb/refresh-clock]})))) (defn- clip-payload "One clip of a save. With `base` — the seq the open document last caught up diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 0658e0d..14516ce 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -9,8 +9,8 @@ `lane-model.md` forbids in so many words: \"Selection does not secretly change where a new symbol goes.\" - THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label, - a cel-sheet column, or a breadcrumb is aiming — each names a place in the + THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label + or a breadcrumb is aiming — each names a place in the document and nothing else. A click on the stage, or on a timeline bar, is not: it says look at this. So `::select` never writes the target, and `::aim` always writes both. @@ -18,12 +18,12 @@ All of it is `assoc-in` under `:ui`. There is no effect in this namespace and there should not be one: an editor's own state is the cheapest thing in the app to change and the most expensive to have two copies of." - (:require [arthur.domain.clip :as clip] + (:require [clojure.string :as str] + [arthur.domain.clip :as clip] [arthur.domain.correction :as correction] [arthur.domain.gesture :as gesture] [arthur.domain.nest :as nest] [arthur.domain.node :as node] - [arthur.domain.lane :as lane] [arthur.domain.span :as span] [arthur.domain.symbol :as symbol] [arthur.events.edit :as edit] @@ -32,6 +32,17 @@ [arthur.footage.store :as store] [re-frame.core :as rf])) +(rf/reg-event-db + ::rename-node + (fn [db [_ sid id value]] + (let [document (:clip (store/entry (:clip/current db))) + value (not-empty (str/trim (str value)))] + (if-not (get-in document [:symbols sid :nodes id]) + db + (edit/transaction db #(if value + (assoc-in % [:symbols sid :nodes id :name] value) + (update-in % [:symbols sid :nodes id] dissoc :name))))))) + (defn selected "`db` with `selection` selected, and nothing aimed. @@ -44,7 +55,7 @@ [:clip :symbols sid :nodes id :kind]))] (cond-> (-> db (assoc-in [:ui :selection] selection) - (update :ui dissoc :points :lane-retry)) + (update :ui dissoc :points :retry)) (and (= :node kind) path (not sound?)) (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))) @@ -72,74 +83,39 @@ (rf/reg-event-db ::aim ;; The gestures that name a PLACE in the document rather than a thing on - ;; screen: a timeline row label, a cel-sheet column, a breadcrumb. + ;; screen: a timeline row label or a breadcrumb. (fn [db [_ selection]] (aimed db selection))) (rf/reg-event-db ::aim-at - ;; Aiming without selecting, for the cel sheet: the lane becomes where drawings - ;; go, and what is SELECTED stays whatever cel the sheet picked in it. + ;; Aiming without selecting: the lane becomes where drawings go while the + ;; inspector selection remains independent. (fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection)))) (rf/reg-event-db ::set-tone (fn [db [_ tone]] (assoc-in db [:ui :tone] tone))) -(defn- aimed-lane - "The lane the target names, or nil — including nil for a target aimed at a cel - INSIDE a lane, which is the lane's business and not a lane itself." - [clip db] - (let [{:keys [sid id path]} (get-in db [:ui :target]) - n (when id (get-in clip [:symbols sid :nodes id]))] - (when (and n (node/lane? n) (= 1 (count path)) - (= sid (get-in db [:ui :open]))) - n))) - -(defn aim-a-lane - "`db` with a lane of the open symbol aimed, if one is not aimed already. - - THE CEL SHEET IS A DRAWING-LANE MODE, so being in it with nothing aimed is not - a state it has anything to say in: every cell belongs to a lane and every new - drawing goes in one. A symbol with no lane at all is the one honest exception, - and the view asks for one to be made rather than this inventing it." - [db] - (let [clip (:clip (store/entry (:clip/current db))) - open (get-in db [:ui :open])] - (if (aimed-lane clip db) - db - (if-let [lane (first (symbol/lanes (get-in clip [:symbols open :nodes])))] - (assoc-in db [:ui :target] {:sid open :id (:id lane) :path [(:id lane)]}) - (update db :ui dissoc :target))))) - -(rf/reg-event-db - ::set-time-view - (fn [db [_ view]] - (if (#{:timeline :cel-sheet} view) - (cond-> (assoc-in db [:ui :time-view] view) - (= :cel-sheet view) aim-a-lane) - db))) - -(rf/reg-event-db - ::aim-a-lane - ;; The cel sheet asks for this when what it had aimed has gone — the lane - ;; deleted under it, or the open symbol changed beneath the view. - (fn [db _] (aim-a-lane db))) - -(defn apply-lane-command +(defn apply-command "Commit a successful domain command as one history step. A refused command - leaves the document and history untouched; an overflow offers an explicit retry." + leaves the document and history untouched; an overflow offers an explicit retry. + + A COMMAND NEED NOT NAME A SELECTION. Emptying frames deletes what was selected + and has nothing sensible to put in its place, so a nil `:selection` leaves the + selection alone rather than pointing it at a clip nobody asked for." [db sid result retry] (if-let [why (:refused result)] (-> db (assoc-in [:project :status] why) - (assoc-in [:ui :lane-retry] - (when (:required-frames result) retry))) + (assoc-in [:ui :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))))) + (cond-> (-> db + (edit/transaction (constantly (:clip result))) + (update :ui dissoc :retry)) + (:selection result) + (assoc-in [:ui :selection] + [:node sid (:selection result) (conj prefix (:selection result))]))))) (defn apply-correction-command "Commit one correction command while keeping the complete row address that @@ -173,17 +149,19 @@ db (correction/retry-layer clip sid id path layer-id))))) (rf/reg-event-db - ::new-lane - ;; AND AIMED AT, because the reason to make a lane is to draw in it: `add-lane` - ;; returns the new lane as its selection, and `apply-lane-command` has already - ;; worked out the row path that addresses it. - (fn [db _] + ::draw-as-lane + ;; THE ONE PLACE A PERSON CAN ASK FOR THE IMPOSSIBLE. Everything else maintains + ;; the sequence; this asks a symbol whose clips may already overlap to start + ;; being one. `span/draw-as-lane` refuses and says what it would have to trim, + ;; and `::retry` is the one button that says do it. + (fn [db [_ sid on? trim?]] (let [clip (:clip (store/entry (:clip/current db))) - sid (get-in db [:ui :open]) - after (apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil)] - (cond-> after - (not= (get-in after [:ui :selection]) (get-in db [:ui :selection])) - (assoc-in [:ui :target] (target-of (get-in after [:ui :selection]))))))) + result (span/draw-as-lane clip sid on? {:trim? trim?})] + (if-let [why (:refused result)] + (-> db (assoc-in [:project :status] why) + (assoc-in [:ui :retry] (when (:required-trim result) [::draw-as-lane sid on? true]))) + (-> db (edit/transaction (constantly (:clip result))) + (update :ui dissoc :retry)))))) (defn- committed "One appending command, as effects: commit it, and look at what it made. @@ -198,23 +176,17 @@ {:keys [at rate]} (:time (nest/inside clip st (get-in db [:ui :open]) (if (seq path) (pop path) []) (get-in db [:playback :frame])))] - (cond-> {:db (apply-lane-command db sid result retry)} + (cond-> {:db (apply-command db sid result retry)} (and (:clip result) (:frame result) rate) (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." + parent of the selected node crosses every enclosing instance clock, and that + is the whole of it: a clip of a lane has no parent, so the symbol's own frames + ARE the sequence's. One clock where there used to be two." [clip st open selection frame] (let [[_ sid _ path] selection] (if (or (= sid open) (not (seq path))) @@ -226,9 +198,8 @@ (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)})] + result (span/append-drawing clip sid (random-uuid) (clip/fresh-id clip) + {:extent (or extent :keep)})] (committed db sid result [::append-drawing :grow-symbol])))) (rf/reg-event-fx @@ -236,9 +207,9 @@ (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)})] + result (span/reuse-drawing clip sid (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 @@ -246,27 +217,26 @@ (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?})] + result (span/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. + ;; The playhead is the position: you scrub to where the drawing goes. The + ;; symbol's own frames are the sequence's, so there is nothing to convert — + ;; only an enclosing stepped or looping instance can leave the playhead on no + ;; single frame of it, which `selection-frame` says by answering nil. (fn [{:keys [db]} [_ extent]] (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"})] + [_ sid] selection + at (selection-frame clip st (get-in db [:ui :open]) selection + (get-in db [:playback :frame])) + result (if (integer? at) + (span/append-drawing clip sid (random-uuid) (clip/fresh-id clip) + {:at at :extent (or extent :keep)}) + {:refused "the playhead is not on one frame of this symbol"})] (committed db sid result [::insert-drawing :grow-symbol])))) (defn- at-playhead @@ -295,7 +265,7 @@ ::split (fn [db _] (let [{:keys [clip sid id at]} (at-playhead db)] - (apply-lane-command + (apply-command db sid (if at (span/split clip sid id at (random-uuid)) no-frame) nil)))) (rf/reg-event-fx @@ -303,30 +273,28 @@ (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)) + [_ sid] selection + at (selection-frame clip st (get-in db [:ui :open]) selection + (get-in db [:playback :frame])) result (if (integer? at) - (lane/overwrite-drawing clip sid lane-id (random-uuid) (clip/fresh-id clip) at + (span/overwrite-drawing clip sid (random-uuid) (clip/fresh-id clip) at {:extent (or extent :keep) :remainder-id (random-uuid)}) - {:refused "this lane's frames are not the open symbol's"})] + {:refused "the playhead is not on one frame of this symbol"})] (committed db sid result [::overwrite-drawing :grow-symbol])))) (rf/reg-event-db ::trim (fn [db [_ edge]] (let [{:keys [clip sid id at]} (at-playhead db)] - (apply-lane-command + (apply-command db sid (if at (span/trim clip sid id edge at) no-frame) nil)))) (rf/reg-event-db ::move (fn [db _] (let [{:keys [clip sid id at]} (at-playhead db)] - (apply-lane-command + (apply-command db sid (if at (span/move clip sid id at) no-frame) nil)))) (rf/reg-event-db @@ -336,10 +304,10 @@ (fn [db _] (let [{:keys [clip sid node]} (at-playhead db) span (node/placed-span node)] - (apply-lane-command + (apply-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"}) + (span/blank clip sid span {}) + {:refused "select a clip that starts and ends on whole frames"}) nil)))) (rf/reg-event-db @@ -347,43 +315,23 @@ (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)))) + (apply-command db sid (span/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])))) + result (span/extend-hold clip sid id delta {:extent (or extent :keep)})] + (apply-command db sid result [::extend-hold delta :grow-symbol])))) (rf/reg-event-fx - ::lane-retry + ::retry (fn [{:keys [db]} _] - (if-let [event (get-in db [:ui :lane-retry])] - {:db (update db :ui dissoc :lane-retry) :dispatch event} + (if-let [event (get-in db [:ui :retry])] + {:db (update db :ui dissoc :retry) :dispatch event} {}))) -(rf/reg-event-db - ::sheet-paste - (fn [db [_ sid lanes at payload]] - (let [clip (:clip (store/entry (:clip/current db)))] - (apply-lane-command db sid - (lane/paste-range clip sid lanes at payload random-uuid) nil)))) - -(rf/reg-event-db - ::sheet-hold - (fn [db [_ sid id end extent]] - (let [clip (:clip (store/entry (:clip/current db))) - n (get-in clip [:symbols sid :nodes id]) - at (lane/lane-frame clip sid (:parent n) end) - delta (when at (- at (second (node/placed-span n))))] - (if (= 0 delta) db - (apply-lane-command db sid - (if delta - (lane/extend-hold clip sid id delta {:extent (or extent :keep)}) - {:refused "this lane's frames are not the open symbol's"}) - [::sheet-hold sid id end :grow-symbol]))))) (rf/reg-event-db ::toggle-row @@ -459,6 +407,19 @@ (= :instance (get-in clip [:symbols sid :nodes id :kind])) path :else (vec (butlast path))))) +(defn aimed-symbol + "The symbol a command acts in and the path of rows down to it: `{:sid :path}`. + + INSIDE the aimed instance, beside an aimed node of any other kind, the open + symbol when nothing is aimed — which is `where-new-goes`, resolved. There is + no lane to aim at any more: a lane is how a symbol is DRAWN, so what a gesture + names is a symbol, and whether that symbol is drawn as a lane is a separate + question `symbol/lane?` answers." + [clip st db frame] + (let [open (get-in db [:ui :open]) + down (where-new-goes clip db)] + (assoc (nest/inside clip st open down frame) :path down))) + ;; --------------------------------------------------------------------------- ;; drawing a polygon ;; @@ -479,63 +440,57 @@ (update-in db [:ui :draft] into [x y]) db))) -(defn into-the-lane - "Where a polygon drawn in the CEL SHEET goes: the row path of the cel the - aimed lane exposes at the playhead, and the clip that cel is in. `{:clip - :path}`, or `{:refused why}`. +(defn into-the-sequence + "Where a polygon drawn into a symbol DRAWN AS A LANE goes: the path of the held + clip that symbol exposes at the playhead, and the document containing it. + `{:clip :path}`, or `{:refused why}`. - A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The sheet is a drawing-lane mode - and the frame under the playhead is where the drawing belongs, so drawing on - an empty frame makes the drawing that was missing — which is the whole reason - there is no `new drawing` button any more: the gesture already says it. + A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The frame under the playhead is + where the drawing belongs, so drawing on an empty frame makes the one-frame + held clip that was missing. The gesture already says what the removed drawing + controls used to say. `overwrite-drawing` rather than `append-drawing`, because a gap already has - the room. Appending RIPPLES everything after it later by the new cel's + the room. Appending RIPPLES everything after it later by the new clip's duration — that is what `insert` means, and it is a different intention. Placed into a gap, overwrite clears nothing and moves nobody. - A CEL'S PATH IS ONE STEP. `[cel]` and not `[lane cel]`: within one symbol the - rows are flat and a cel is not a row at all, which is the same addressing - `rows` hands the timeline and `trail` reads back." - [clip st db lane] - (let [open (get-in db [:ui :open]) - lane-id (:id lane) - owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) - at (when (number? owner) (lane/lane-frame clip open lane-id owner)) - cel (when (integer? at) + THE CLIP'S PATH IS THE SYMBOL'S PATH PLUS ONE STEP, because a clip of a lane + is an ordinary row of the symbol holding it — which is the addressing `rows` + hands the timeline and `trail` reads back." + [clip db {:keys [sid frame path]}] + (let [exposed (when (integer? frame) (some (fn [c] (let [[lo hi] (node/placed-span c)] - (when (and (<= lo at) (< at hi)) c))) - (symbol/lane-cels (get-in clip [:symbols open :nodes]) lane-id)))] + (when (and (<= lo frame) (< frame hi)) c))) + (symbol/children (get-in clip [:symbols sid :nodes]))))] (cond - (not (integer? at)) - {:refused "the playhead is not on one frame of this lane"} - cel {:clip clip :path [(:id cel)]} + (not (integer? frame)) + {:refused "the playhead is not on one frame of this symbol"} + exposed {:clip clip :path (conj (vec path) (:id exposed))} :else (let [cel-id (random-uuid) - made (lane/overwrite-drawing clip open lane-id cel-id (clip/fresh-id clip) at + made (span/overwrite-drawing clip sid cel-id (clip/fresh-id clip) frame {:extent :grow-symbol :remainder-id (random-uuid)})] - (if (:refused made) made {:clip (:clip made) :path [cel-id]}))))) + (if (:refused made) made {:clip (:clip made) :path (conj (vec path) cel-id)}))))) (defn polygon-landing "Choose the document and row path a finished polygon is drawn into. - In the timeline this follows the explicit target. In the cel sheet the aimed - lane wins, regardless of what is selected on the stage: an occupied frame - lands in its cel and a gap first becomes a drawing. Keeping this decision out - of the event handler makes the selection/target boundary a rule we can assert - without driving re-frame." + WHERE IT GOES IS A SYMBOL, and what happens there follows how that symbol is + DRAWN: in one drawn as a lane an occupied frame lands in its clip and a gap + first becomes a one-frame drawing, because the sequence is what says which + drawing the playhead is on. In an ordinary composition the polygon goes + straight into the symbol, as it always did." [clip st db] - (if (= :cel-sheet (get-in db [:ui :time-view] :timeline)) - (if-let [lane (aimed-lane clip db)] - (assoc (into-the-lane clip st db lane) :lane? true) - {:refused "make a drawing lane to draw in — the cel sheet has none" - :lane? true}) - {:clip clip :path (where-new-goes clip db) :lane? false})) + (let [into (aimed-symbol clip st db (get-in db [:playback :frame]))] + (if (and (:sid into) (symbol/lane? (clip/symbol clip (:sid into)))) + (assoc (into-the-sequence clip db into) :lane? true) + {:clip clip :path (:path into) :lane? false}))) (defn beginning-polygon - "Enter polygon mode, first materializing the cel-sheet lane and drawing when - either is missing. In the timeline this is editor state only. + "Enter polygon mode, first materializing a drawing at the playhead when the + symbol it lands in is drawn as a lane and that frame is empty. Creating here, rather than when the polygon is finished, means the drawing is already the current cel while points are being placed. Cancelling the polygon @@ -543,20 +498,7 @@ [db] (let [{clip :clip st :store} (store/entry (:clip/current db)) open (get-in db [:ui :open]) - sheet? (= :cel-sheet (get-in db [:ui :time-view] :timeline)) - no-lanes? (and sheet? - (empty? (symbol/lanes (get-in clip [:symbols open :nodes])))) - lane-id (when no-lanes? (random-uuid)) - lane-result (if no-lanes? - (lane/add-lane clip open lane-id) - {:clip clip}) - aimed-db (if (and no-lanes? (not (:refused lane-result))) - (assoc-in db [:ui :target] - {:sid open :id lane-id :path [lane-id]}) - db) - landing (if-let [why (:refused lane-result)] - {:refused why :lane? true} - (polygon-landing (:clip lane-result) st aimed-db)) + landing (polygon-landing clip st db) source (:clip landing) made? (and source (not (identical? clip source))) db' (cond @@ -564,13 +506,13 @@ (update db :project merge {:status (:refused landing)}) made? - (-> aimed-db + (-> db (edit/transaction (constantly source)) (assoc-in [:ui :selection] [:node open (peek (:path landing)) (:path landing)])) - :else aimed-db)] + :else db)] (if (:refused landing) db' (update db' :ui merge {:tool :polygon :draft []})))) @@ -599,7 +541,7 @@ (nil? sid) (update db :project merge {:status (if (:lane? landing) - "this lane is not on screen at this frame" + "this sequence is not on screen at this frame" "what you are drawing into is not on screen at this frame")}) ;; `random-uuid` is the one impurity in this namespace, and it is here ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells @@ -629,36 +571,61 @@ (declare record-auto-frame) ;; --------------------------------------------------------------------------- -;; a new symbol +;; a new symbol or lane + +(defn- create-container + "Create and place one empty symbol. Lane creation is explicit: `lane?` marks + the new symbol for linear timeline display; ordinary symbol creation never + does. Both operations place the new symbol through the same span command, so + an explicitly aimed lane still applies its claim-time rule." + [db where lane?] + (let [{document :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + frame (get-in db [:playback :frame]) + into (if (= :top where) + (assoc (nest/inside document st open [] frame) :path []) + (aimed-symbol document st db frame)) + {host :sid at :frame down :path} into + sid (clip/fresh-id document) + instance-id (random-uuid) + end (clip/frames document host) + result (cond + (nil? host) + {:refused "what you are adding to is not on screen at this frame"} + (not (integer? at)) + {:refused "the playhead is not on one frame of this symbol"} + (or (nil? end) (>= at end)) + {:refused "the playhead is past the end of this symbol"} + :else + (let [new-symbol (cond-> {:id sid :name (name sid) + :fps (clip/fps document host) + :frames (- end at) :nodes {}} + lane? (assoc :display :lane)) + seeded (assoc-in document [:symbols sid] new-symbol)] + (span/place-symbol seeded st host instance-id sid at + {:extent :grow-symbol + :remainder-id (random-uuid)})))] + (if-let [why (:refused result)] + (update db :project merge {:status why}) + (let [selection [:node host instance-id (conj (vec down) instance-id)]] + (cond-> (-> db + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] selection) + (update-in [:ui :expanded] (fnil into #{}) + (rest (reductions conj [] down)))) + lane? (assoc-in [:ui :target] (target-of selection))))))) (rf/reg-event-db ::new-symbol - ;; `where` is `:inside` — in whatever the target names — or `:top`, in the open - ;; symbol regardless of it. Two items on one menu rather than a rule nobody can - ;; see: `lane-model.md` asks that "creation controls next to the breadcrumb act - ;; in that explicit location", and the honest way to offer the other location is - ;; to offer it. (fn [db [_ where]] - (let [{clip :clip st :store} (store/entry (:clip/current db)) - down (if (= :top where) [] (where-new-goes clip db)) - {host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down - (get-in db [:playback :frame])) - sid (clip/fresh-id clip) - uuid (random-uuid)] - (if-not host - (update db :project merge - {:status "what you are adding to is not on screen at this frame"}) - (let [made [:node host uuid (conj down uuid)]] - (-> db - (edit/transaction #(clip/new-symbol % host sid frame uuid)) - ;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the - ;; next thing made goes in it; the outline says so before anybody - ;; has to find out by drawing. - (aimed made) - ;; Open every row down to it, or the new row is inside a closed one - ;; and the button looks like it did nothing. - (update-in [:ui :expanded] (fnil into #{}) - (rest (reductions conj [] down))))))))) + (create-container db where false))) + +(rf/reg-event-db + ::new-lane + (fn [db _] + ;; A lane is an explicit top-level track of the open symbol. It must not + ;; become nested merely because the previously created lane is still aimed. + (create-container db :top true))) ;; --------------------------------------------------------------------------- ;; a drop in flight @@ -679,27 +646,101 @@ ::drop-clear (fn [db _] (update db :ui dissoc :drop))) +(defn drop-destination + "Which symbol a drop lands in and on which of its frames: `{:clip :sid :at + :path}`, or `{:refused why}`. + + ONE RULE AND EVERY DROP ASKS IT — a symbol from the pool, a sound, and a video + brought in as a take alike. The pointer names a ROW, `target`, and a row leads + into a symbol exactly where it names an instance, which is what `nest/inside` + already answers; with nothing under the pointer it is the open symbol. Nothing + is created to receive the drop: the symbol IS the container, so the first drop + into one is the same operation as the second. + + `:clip` is handed back unchanged and is in the result only so the callers that + used to be given a document with a freshly made lane in it go on reading one + thing." + [db document st frame target] + (let [target (if (vector? target) + (let [[_ sid id path] target] + {:sid sid :id id :path path}) + target) + open (get-in db [:ui :open]) + path (cond + (nil? target) [] + (= :instance (get-in document [:symbols (:sid target) + :nodes (:id target) :kind])) + (vec (:path target)) + :else (vec (butlast (:path target)))) + {:keys [sid] at :frame} (nest/inside document st open path frame)] + (cond + (nil? sid) {:refused "what you are dropping into is not on screen at this frame"} + (not (integer? at)) {:refused "the drop is not on one frame of that symbol"} + :else {:clip document :sid sid :at at :path path}))) + +(defn landed + "`db` after a drop that produced `result`, with `uuid` selected." + [db {:keys [sid path]} uuid result] + (if-let [why (:refused result)] + (-> db (update :ui dissoc :drop) (update :project merge {:status why})) + (-> db + (update :ui dissoc :drop) + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node sid uuid (conj (vec path) uuid)])))) + (rf/reg-event-db ::drop-symbol - ;; `point` is the stage pixel it was dropped on, or nil from the timeline. - (fn [db [_ sid frame point]] - (let [uuid (random-uuid) - host (get-in db [:ui :open])] - (-> db - (update :ui dissoc :drop) - (edit/edit-entry #(update % :clip clip/place-symbol (:store %) - host sid (* frame (:rate (clip/grid-time (:clip %) host))) uuid point)) - (assoc-in [:ui :selection] [:node host uuid [uuid]]))))) + ;; A symbol dropped on a row becomes a naturally playing clip in the symbol that + ;; row leads into. Whether it claims the time it lands on is `span/place-symbol`'s + ;; question and it answers it from the destination's display mode, so a drop onto + ;; a lane trims its neighbour and a drop into a composition does not. + (fn [db [_ source-id frame point target]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + where (drop-destination db document st frame target) + uuid (random-uuid)] + (if (:refused where) + (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) + (landed db where uuid + (span/place-symbol (:clip where) st (:sid where) + uuid source-id (:at where) + {:extent :grow-symbol :point point + :remainder-id (random-uuid)})))))) (rf/reg-event-db ::drop-sound - (fn [db [_ {:keys [source label length rate]} frame]] - (let [uuid (random-uuid) - host (get-in db [:ui :open])] - (-> db - (update :ui dissoc :drop) - (edit/edit #(clip/place-sound % host source label length rate (* frame (:rate (clip/grid-time % host))) uuid)) - (assoc-in [:ui :selection] [:node host uuid [uuid]]))))) + ;; A SOUND IS A CLIP TOO. It is placed and then adopted rather than written + ;; straight in, so one command owns where a sound's frames are — + ;; `clip/place-sound` — and one owns what claiming time means. + (fn [db [_ {:keys [source label length rate]} frame target]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + where (drop-destination db document st frame target) + uuid (random-uuid)] + (if (:refused where) + (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) + (let [sid (:sid where) + seeded (clip/place-sound (:clip where) sid source label length rate + (* (:at where) + (:rate (clip/grid-time (:clip where) sid))) + uuid)] + (landed db where uuid + (span/adopt seeded sid uuid (:at where) + {:extent :grow-symbol :remainder-id (random-uuid)}))))))) + +(rf/reg-event-db + ::drop-clip + ;; A clip body is already materialized, so its whole drop is: resolve the + ;; destination, then transfer it. `span/transfer` asks the destination whether + ;; it claims time; this event does not know or care whether that is a lane. + (fn [db [_ [_ from-sid id _] target frame]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + where (drop-destination db document st frame target) + result (when-not (:refused where) + (span/transfer document from-sid id (:sid where) (:at where) + {:extent :grow-symbol + :remainder-id (random-uuid)}))] + (if-let [why (or (:refused where) (:refused result))] + (update db :project merge {:status why}) + (landed db where id result))))) ;; --------------------------------------------------------------------------- ;; moving rows between symbols @@ -729,16 +770,23 @@ ::sliding ;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the ;; drag is abandoned. - (fn [db [_ path df]] + (fn [db [_ path df kind ripple? other]] (if path - (assoc-in db [:ui :sliding] {:path path :df df}) + (assoc-in db [:ui :sliding] {:path path :df df :kind (or kind :slide) + :ripple? (boolean ripple?) :other other}) (update db :ui dissoc :sliding)))) (rf/reg-event-db ::slide - (fn [db [_ path df]] + (fn [db [_ path df kind ripple? other]] (let [db (update db :ui dissoc :sliding) - r (nest/slide (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]) path df)] + clip (:clip (store/entry (:clip/current db))) + open (get-in db [:ui :open]) + r (case kind + :out (nest/resize-out clip open path df ripple?) + :in (nest/resize-in clip open path df) + :roll (nest/roll clip open other path df) + (nest/slide clip open path df))] (cond (zero? df) db (:refused r) (refused db (:refused r)) diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index f6716df..fabeb39 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -44,8 +44,12 @@ ;; lets go, so the stage and the rows follow the pointer. Nothing is written ;; until then: one drag is one undo step and one write to collaborators. (let [c (:clip (footage/entry id))] - (or (when-let [{:keys [path df]} sliding] - (:clip (nest/slide c open path df))) + (or (when-let [{:keys [path df kind ripple? other]} sliding] + (:clip (case kind + :out (nest/resize-out c open path df ripple?) + :in (nest/resize-in c open path df) + :roll (nest/roll c open other path df) + (nest/slide c open path df)))) (when-let [{:keys [sid id frame values]} gesture] ;; A held stage control owns the touched parameters completely. Make ;; them temporary static channels for the preview, so their existing diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index 4086778..38a4c33 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -13,8 +13,7 @@ (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) (rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) -(rf/reg-sub ::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 ::retry (fn [db _] (get-in db [:ui :retry]))) (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 ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?])))) diff --git a/frontend/src/arthur/ui/drag.cljs b/frontend/src/arthur/ui/drag.cljs index cb4463f..3161c0f 100644 --- a/frontend/src/arthur/ui/drag.cljs +++ b/frontend/src/arthur/ui/drag.cljs @@ -57,8 +57,9 @@ (defn row! "Start carrying the timeline row at `path` — a node of kind `node-kind`, to be moved into another symbol or grouped with another node." - [path node-kind] - (reset! carrying {:kind :row :path path :node-kind node-kind})) + [path node-kind selection] + (reset! carrying {:kind :row :path path :node-kind node-kind + :selection selection})) (defn row "The path of the row being carried, or nil when it is not a row." @@ -70,6 +71,9 @@ [] (:node-kind @carrying)) +(defn row-selection [] + (when (= :row (:kind @carrying)) (:selection @carrying))) + (defn other! "Start carrying something that is not yet in the document: `:kind` says what, and the rest is what a preview can show of it before it is fetched." @@ -85,11 +89,13 @@ (defn hover! "Say where the drag would land, for the previews. `point` is nil over the timeline." - [where frame point] + ([where frame point] (hover! where frame point nil)) + ([where frame point target] (when-let [{:keys [kind label frames]} @carrying] (rf/dispatch [::ui/drop-hover {:where where :frame frame :point point :label label :frames frames - :sound? (= :sound kind)}]))) + :target target + :sound? (= :sound kind)}])))) (defn pos-for "Where the preview goes so the symbol's middle is under `point` — what @@ -100,15 +106,17 @@ (defn land! "Drop what is being carried at `frame` of the open symbol: with its middle on stage pixel `point`, or, with no point — the timeline — where it was drawn." - [frame point] + ([frame point] (land! frame point nil)) + ([frame point target] (when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)] (case kind - :symbol (rf/dispatch [::ui/drop-symbol sid frame point]) + :symbol (rf/dispatch [::ui/drop-symbol sid frame point target]) ;; Video is asked about before anything happens: which frames, and what - ;; the symbol they become is called. - :footage (rf/dispatch [::footage/ask-convert c frame point]) - :import (rf/dispatch [::project/import c frame point]) + ;; the symbol they become is called. The lane it was aimed at travels + ;; with the question, so the answer lands where the drop pointed. + :footage (rf/dispatch [::footage/ask-convert c frame point target]) + :import (rf/dispatch [::project/import c frame point target]) ;; Where it is dropped in time; a sound has no place in space. - :sound (rf/dispatch [::ui/drop-sound c frame]) + :sound (rf/dispatch [::ui/drop-sound c frame target]) nil)) - (done!)) + (done!))) diff --git a/frontend/src/arthur/ui/location.cljs b/frontend/src/arthur/ui/location.cljs index cb29e29..9e68fb4 100644 --- a/frontend/src/arthur/ui/location.cljs +++ b/frontend/src/arthur/ui/location.cljs @@ -76,7 +76,8 @@ (map (fn [a] (let [m (get nodes a)] {:kind (:kind m) - :lane? (node/lane? m) + :lane? (and (= :instance (:kind m)) + (symbol/lane? (clip/symbol clip (node/source m)))) :sid in :id a :of (node/source m) :label (crumb-label clip a m) :select [:node in a (conj so-far a)]}))) @@ -199,5 +200,5 @@ ", ignoring what is aimed") :on-click #(rf/dispatch [::ui/new-symbol :top])} {:label "lane" - :sub (str "a row of drawings in " (clip/symbol-name clip open)) + :sub (str "a row for symbol clips in " (clip/symbol-name clip open)) :on-click #(rf/dispatch [::ui/new-lane])}]}]])) diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index cc67730..6a58b05 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -14,6 +14,7 @@ [arthur.domain.paint :as paint] [arthur.domain.params :as params] [arthur.domain.pose :as pose] + [arthur.domain.symbol :as symbol] [arthur.domain.trace :as trace] [arthur.events.history :as history] [arthur.events.paint :as paint-events] @@ -281,11 +282,10 @@ (defn- correction-section [[sid selected-id selected]] (let [clip @(rf/subscribe [::render/clip]) - parent (get-in clip [:symbols sid :nodes (:parent selected)]) - targets (cond - (node/lane? selected) [selected-id] - (node/lane? parent) [selected-id (:id parent)] - :else [])] + lane-context? (or (symbol/lane? (clip-domain/symbol clip sid)) + (and (= :instance (:kind selected)) + (symbol/lane? (clip-domain/symbol clip (node/source selected))))) + targets (if lane-context? [selected-id] [])] (when (seq targets) (r/with-let [draft (r/atom (correction-initial clip sid selected-id))] (let [target (:target @draft) @@ -303,7 +303,7 @@ (doall (for [[i id] (map-indexed vector targets)] ^{:key (str id)} [:option {:value i} - (str (if (= id selected-id) "selected · " "lane · ") (brief id))]))]] + (str "selected · " (brief id))]))]] [:label.inspector-field "property" [:select {:value (if (= [:xform :rot] (:path @draft)) "rotation" "position") :on-change #(swap! draft assoc :path diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 79689a2..867d8a2 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -24,7 +24,6 @@ [arthur.domain.node :as node] [arthur.domain.clip :as clip] [arthur.domain.nest :as nest] - [arthur.domain.lane :as lane] [arthur.domain.span :as span] [arthur.domain.symbol :as symbol] [arthur.domain.trace :as trace] @@ -32,7 +31,6 @@ [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.render :as render] [arthur.subs.ui :as sub] @@ -96,10 +94,86 @@ (defn rows "The visible rows of symbol `sid`, outermost first. `expanded` is a set of row - paths." - [clip sid expanded] - (letfn [(walk [sid path depth ->open] + paths, and `chosen` is the selected row's PATH, which is what an expanded + lane opens as its portal. + + AN EXPANDED LANE OPENS ONE CLIP, NOT ALL OF THEM. A lane of twelve clips that + grew twelve branches when it opened is the vertical growth the single-row + lane exists to prevent, so expanding a lane reveals exactly the clip that is + selected in it: its own keys, and — expanded in turn — the lanes and nodes of + the symbol it places, all the way down and all mapped into this ruler. + Selecting another clip swaps the portal in place rather than adding to it, so + the whole document stays editable from the root timeline at constant cost. + See `docs/lane-nesting-notes.md`. + + THE WHOLE LINEAGE CHOOSES THE PORTAL, not the selected node alone. Selecting + something nested — a shape inside the drawing the clip places, or the end of + its span — is still working inside that clip, so the portal that revealed it + must stay open. A lane therefore opens the clip whose path the selection is + under, which for a clip selected directly is the clip itself." + ([clip sid expanded] (rows clip sid expanded nil)) + ([clip sid expanded chosen] + (let [under? (fn [path] + (and chosen + (<= (count path) (count chosen)) + (= path (subvec (vec chosen) 0 (count path)))))] + (letfn [(inside-rows [sid n path depth self span] + ;; The rows of the symbol a clip places, mapped into this ruler. + ;; + ;; A HELD CLIP HAS NO INVERTIBLE CLOCK. `clip/source-time` is nil + ;; for a hold, a loop and an endpoint policy: one source frame is + ;; shown for the whole span, so no frame inside it has a place on + ;; this ruler. That used to mean the contents were not shown at + ;; all, which hid the inside of every drawing — the most ordinary + ;; thing in the document. So the structure is shown and stays + ;; selectable, and what is withheld is only what cannot be known: + ;; the key positions, and the bars that would imply them. Refuse + ;; rather than guess, without refusing the whole subtree. + (when-let [source (and (= :instance (:kind n)) (node/source n))] + (if-let [{:keys [at rate]} (clip/source-time clip sid n)] + (walk source path depth (comp self #(+ at (/ % rate)))) + (mapv (fn [row] + (-> row + (assoc :keys [] :unmapped? true) + (assoc :span (when (= :node (:kind row)) span)))) + (walk source path depth (constantly (first span))))))) + (portal [sid path depth self child] + ;; `self` maps the LANE's frames into the open symbol's; `child` is + ;; the clip selected in that lane, whose own frames are one more + ;; step in. Its row carries the clip's path — the same one its + ;; block in the lane selects with — so expanding here and selecting + ;; there are the same place. + (let [cpath (conj path (:id child)) + open? (contains? expanded cpath) + channels (node/channels child) + cself (comp self (local->parent child)) + cspan (mapv self (node/placed-span child)) + row {:path cpath + :depth depth + :label (node-label (:id child) child) + :kind :node + :node-kind (:kind child) + :of (node/source child) + :portal? true + :select [:node sid (:id child) cpath] + :expandable? true + :expanded? open? + :span cspan + :keys (into [] (comp (mapcat keyed-frames) + (map cself) + (distinct)) + (vals channels)) + :dense? (boolean (some :dense (vals channels)))}] + (if-not open? + [row] + (-> [row] + (into (channel-rows child cpath (inc depth) cself cspan)) + (into (inside-rows sid child cpath (inc depth) cself cspan)))))) + (walk [sid path depth ->open] (let [sym (get-in clip [:symbols sid]) + root-lane? (and (empty? path) (symbol/lane? sym)) + root-clips (when root-lane? (symbol/children (:nodes sym))) + root-ids (into #{} (map :id) root-clips) ordered (->> (:nodes sym) ;; Front-most at the top, as a layer list is drawn ;; everywhere. `:z` is the lexicographic draw key; @@ -108,8 +182,49 @@ reverse ;; Sounds are listed below the picture, by ;; `sound-rows`, wherever they are. - (remove #(= :audio (:kind (val %)))))] - (into [] + (remove #(= :audio (:kind (val %)))) + ;; In an open lane symbol, its clips are blocks + ;; on the symbol's own row. Span-less decoration + ;; remains an ordinary row beside it. + (remove #(contains? root-ids (key %)))) + root-row (when root-lane? + (let [open? (contains? expanded [::lane]) + row {:path [::lane] + :depth depth + :label (or (:name sym) (name sid)) + :kind :symbol + :lane? true + :select [:node sid nil []] + :expandable? true + :expanded? open? + :span [0 (:frames sym)] + :keys [] + :cels (mapv (fn [child] + {:id (:id child) + :label (or (get-in clip [:symbols (node/source child) :name]) + (some-> (node/source child) name) + (node-label (:id child) child)) + :source (node/source child) + :span (mapv ->open (node/placed-span child)) + :keys (into [] + (comp (mapcat keyed-frames) + (map (comp ->open (local->parent child))) + (distinct)) + (vals (node/channels child))) + :select [:node sid (:id child) + (conj path (:id child))]}) + root-clips)}] + (cond-> [row] + open? + (into (if-let [child (first (filter #(under? (conj path (:id %))) + root-clips))] + (portal sid path (inc depth) ->open child) + [{:path [::lane ::portal] + :depth (inc depth) :kind :hint + :label (if (seq root-clips) + "select a clip to inspect" + "empty lane")}])))))] + (into (vec root-row) (mapcat (fn [[id n]] (let [rpath (conj path id) @@ -126,6 +241,10 @@ (map #(local->parent (get-in sym [:nodes %])) (reverse ancestors))) self (comp parent-map (local->parent n)) + source-sym (when (= :instance (:kind n)) + (clip/symbol clip (node/source n))) + lane? (symbol/lane? source-sym) + clips (when lane? (symbol/children (:nodes source-sym))) span (mapv parent-map (or (node/placed-span (cond-> n @@ -137,6 +256,7 @@ :label (node-label id n) :kind :node :node-kind (:kind n) + :lane? lane? :of (node/source n) :select [:node sid id rpath] :expandable? true @@ -147,16 +267,15 @@ (distinct)) (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) + (let [;; A lane of sounds is a lane like any other — + ;; same blocks, same edges, same portal — and + ;; is listed under the audio heading because + ;; that is where somebody looks for a sound, + ;; not because it is a different kind of row. + sound-lane? (and (seq clips) + (every? #(= :audio (:kind %)) clips)) + row (cond-> row + lane? (assoc :cels (mapv (fn [child] {:id (:id child) @@ -164,27 +283,51 @@ (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? - [row] - (-> [row] - (into (channel-rows n rpath (inc depth) self span)) - (into (when-let [{:keys [at rate]} (and (= :instance (:kind n)) - (clip/source-time clip sid n))] - (when-let [child (node/source n)] - (walk child rpath (inc depth) - (comp self #(+ at (/ % rate))))))))))))) + ;; The clip's own keys, on the + ;; block, so a collapsed lane + ;; still says where it changes. + :keys (into [] + (comp (mapcat keyed-frames) + (map (comp self (local->parent child))) + (distinct)) + (vals (node/channels child))) + :select [:node (node/source n) (:id child) + (conj rpath (:id child))]}) + clips)))] + (cond->> (if-not open? + [row] + (-> [row] + (into (channel-rows n rpath (inc depth) self span)) + ;; The one clip an expanded lane opens. + (into (when lane? + (if-let [child (first (filter #(under? (conj rpath (:id %))) clips))] + (portal (node/source n) rpath (inc depth) self child) + [{:path (conj rpath ::portal) + :depth (inc depth) + :kind :hint + :label (if (seq clips) + "select a clip to inspect" + "empty lane")}]))) + (into (when-not lane? + (inside-rows sid n rpath (inc depth) self span))))) + sound-lane? (mapv #(assoc % :sound? true)))))) ordered))))] (if (get-in clip [:symbols sid]) (walk sid [] 0 #(/ % (:rate (clip/grid-time clip sid)))) - []))) + []))))) (defn sound-rows "Audio rows use the same flattened intervals as the mixer, including source - in-points, cel speeds, parent timing, and silence beneath visual holds." + in-points, cel speeds, parent timing, and silence beneath visual holds. + + WHAT IS IN A LANE SYMBOL IS NOT FLATTENED HERE. A sound in a lane is + a clip somebody placed and can move, trim and open, and `rows` draws it as + one; flattening it as well would show the same sound on two rows, only one of + which could be edited. What remains is what this view is for: audio nested + inside the symbols this one places, mapped into this ruler." [clip sid expanded] (if-not (get-in clip [:symbols sid]) [] + (let [lane? (symbol/lane? (clip/symbol clip sid))] (vec (mapcat (fn [[path tracks]] @@ -205,7 +348,10 @@ :span (node/placed-span track) :select select}) (range) tracks))) (when open? (channel-rows n path 1 identity span))))) - (sort-by (comp str key) (group-by :path (nest/audio-tracks clip sid))))))) + (sort-by (comp str key) + (group-by :path + (remove #(and lane? (= 1 (count (:path %)))) + (nest/audio-tracks clip sid))))))))) ;; --------------------------------------------------------------------------- ;; geometry @@ -223,6 +369,33 @@ x (- (.-clientX event) (.-left box))] (-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames))))) +(defn- frame-at-element [^js event frames ^js element] + (let [box (.getBoundingClientRect element) + x (- (.-clientX event) (.-left box))] + (-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames))))) + +(defn- lane-under + "The lane track geometrically under a captured pointer, and its selection." + [^js event] + (some (fn [^js el] + (when-let [track (.closest el ".tl-track")] + (when-let [selection (aget track "arthurLane")] + [track selection]))) + (array-seq (.elementsFromPoint js/document (.-clientX event) (.-clientY event))))) + +(defn- clip-under + "What the clip block under the pointer places, or nil where there is none. + + The track holds the pointer while a bar slides, and a captured pointer takes + the CLICK with it: press a clip block and the click and double-click that + follow are delivered to the track, never to the block. So the track resolves + them itself, by asking what is geometrically under the pointer." + [^js event] + (some (fn [^js el] + (when-let [cel (.closest el ".tl-cel")] + (aget cel "arthurCel"))) + (array-seq (.elementsFromPoint js/document (.-clientX event) (.-clientY event))))) + ;; --------------------------------------------------------------------------- ;; the panes @@ -231,7 +404,6 @@ 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]) frames @(rf/subscribe [::render/frames]) {:keys [fps drop]} @player/meter @@ -241,12 +413,7 @@ [_ sid id] selection open @(rf/subscribe [::render/open]) st (:store (store/entry clip-id)) - sheet? (= :cel-sheet view) 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)))) ;; A SPAN IS A SPAN WHEREVER IT SITS. What `span/split`, `trim` and ;; `move` need is one node with a place in time, which a symbol dropped ;; straight into a shot has as surely as a cel does — so these are @@ -265,10 +432,6 @@ host (when (number? owner-frame) (span/host-frame clip sid id owner-frame)) cuttable? (and span? (integer? host) (let [[lo hi] (node/placed-span n)] (< lo host hi))) - movable? (and span? (integer? host)) - at (when (and lane? (number? owner-frame)) - (lane/lane-frame clip sid (:id lane) owner-frame)) - insertable? (and lane? (integer? at)) act (fn [event] #(rf/dispatch event))] [:div.pane-head ;; ----------------------------------------------------------------- time @@ -308,103 +471,24 @@ (doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]] ^{: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 - ;; GROUPED BY WHAT THEY NEED, not by which view they were built in. - ;; - ;; `timing` is always here. Split, trim and move are one write to one - ;; node's span or position, and that is a fact every placement has: a - ;; symbol laid out in a shot is cut and trimmed exactly as a cel is, and - ;; the lane gate they used to carry was a leftover from a lane being the - ;; only thing anybody had timed. Judging a cut against the other rows is - ;; also the timeline's whole shape, so hiding them here would have cost - ;; the view the one thing it is best at. - ;; - ;; `drawing` and `hold` are the CEL SHEET's and appear only there. Each one - ;; needs a SEQUENCE — a ripple needs later siblings, a gap needs a row to - ;; be a hole in — and a sequence is what a lane is. Choosing how many - ;; frames a drawing is exposed for is plate-side work; the timeline is the - ;; performance side. - ;; - ;; `new drawing` is NOT here, in either view. Drawing a polygon on an empty - ;; frame of the aimed lane makes the drawing that was missing, so the - ;; button said what the gesture already says. `N` still does it from the - ;; sheet, for the draw-N-draw-N rhythm that wants a key and not a menu. - ;; - ;; `make unique` is NOT here either. It is offered on the location bar, - ;; beside the count of how many places share the drawing — which is the - ;; fact somebody needs before deciding to decouple one, and is why that row - ;; exists at all. `ui/location`. - ;; - ;; `new` is on the location bar for the same kind of reason: creating a - ;; symbol acts at the location the breadcrumb names, not on a cel. - [menu/view - {:label "timing" :title "where this sits and how long it lasts" - :note "select a cel, or anything else placed in time" - :items [{:label "split" :disabled? (not cuttable?) - :sub "cut this in two at the playhead; the picture does not change" - :on-click (act [::ui/split])} - {:label "trim in" :disabled? (not cuttable?) - :sub "start this at the playhead; nothing else moves" - :on-click (act [::ui/trim :in])} - {:label "trim out" :disabled? (not cuttable?) - :sub "end this at the playhead; nothing else moves" - :on-click (act [::ui/trim :out])} - {:label "move here" :disabled? (not movable?) - :sub "put this at the playhead; in a lane, refused if something is there" - :on-click (act [::ui/move])}]}] - (when sheet? - [:<> - [menu/view - {:label "drawing" :title "what the aimed lane exposes" - :note "select a cel in the sheet" - :items [{: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 "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])} "+"]]]]) + ;; The same direct timing operations apply to any selected symbol clip, + ;; whether it is still a legacy root node or lives in a lane. + [:div.group.timing-controls {:aria-label "timing"} + [:button {:disabled (not cuttable?) :aria-label "split" + :title "split the selected clip at the playhead" + :on-click (act [::ui/split])} "split"] + [:button {:disabled (not cuttable?) :aria-label "trim in" + :title "move the selected clip's start to the playhead" + :on-click (act [::ui/trim :in])} "in"] + [:button {:disabled (not cuttable?) :aria-label "trim out" + :title "move the selected clip's end to the playhead" + :on-click (act [::ui/trim :out])} "out"]] [:span.spacer] ;; 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]) + (when @(rf/subscribe [::sub/retry]) [:button.retry {:title "the command was refused because the shot is too short" - :on-click (act [::ui/lane-retry])} "extend shot and apply"]) + :on-click (act [::ui/retry])} "extend shot and apply"]) ;; 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 ;; number computed FROM the clock would answer itself. Shown only while it @@ -443,14 +527,21 @@ on every render after, which would fight a person scrolling away." (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]} - selection target over solo tracing] +(defn- label-cell [{:keys [path depth label kind node-kind lane? select expandable? expanded? of via]} + selection target over solo tracing renaming draft] (let [node? (= :node kind) ;; AIMED IS NOT SELECTED, so it does not wear the selected class. The ;; target is where a new thing would go; the selection is what the ;; inspector is showing. One row is often both and must still say which ;; of the two it is being. aimed? (and node? (= path (:path target))) + editing? (and lane? (= select @renaming)) + begin-rename! (fn [] (reset! draft label) (reset! renaming select)) + commit-rename! (fn [] + (when (= select @renaming) + (reset! renaming nil) + (let [[_ sid id] select] + (rf/dispatch [::ui/rename-node sid id @draft])))) [over-path where] @over] [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") (when aimed? " aimed") @@ -462,6 +553,7 @@ (if (= :instance node-kind) " drop-into" " drop-group")))) :style {:padding-left (str (+ 4 (* 11 depth)) "px")} :title label + :tab-index (when lane? 0) :ref (when (and select (= select selection)) (reveal selection)) ;; A LABEL AIMS. Clicking a row's name says "I am working ;; here", which is a statement about a place in the document; @@ -470,7 +562,14 @@ ;; the first moves where new drawings and symbols go. :on-click #(when select (rf/dispatch [::ui/aim select])) ;; An instance's row opens the symbol it places, as a tab. - :on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))} + :on-double-click (fn [^js e] + (cond lane? (do (.stopPropagation e) (begin-rename!)) + of (rf/dispatch [::pb/open-symbol of]))) + :on-key-down (when lane? + (fn [^js e] + (when (= "F2" (.-key e)) + (.preventDefault e) + (begin-rename!))))} ;; A node's row can be dragged onto another: onto an instance's, to ;; go inside the symbol it places; onto any other node's, to be ;; grouped with it into a new one; onto an edge of either, to be @@ -481,7 +580,7 @@ (.stopPropagation e) (.setData (.-dataTransfer e) "text/plain" "row") (set! (.. e -dataTransfer -effectAllowed) "move") - (drag/row! path node-kind)) + (drag/row! path node-kind select)) :on-drag-end (fn [_] (reset! over nil) (drag/done!)) :on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e))) :on-drag-over (fn [^js e] @@ -510,8 +609,25 @@ (.stopPropagation e) (rf/dispatch [::ui/toggle-row path]))} (when expandable? (if expanded? "▾" "▸"))] - [:span.name label] + (if editing? + [:input.tl-name-input + {:value @draft :auto-focus true :aria-label "lane name" + :on-click #(.stopPropagation %) + :on-double-click #(.stopPropagation %) + :on-change #(reset! draft (.. % -target -value)) + :on-blur commit-rename! + :on-key-down (fn [^js e] + (case (.-key e) + "Enter" (do (.preventDefault e) (commit-rename!)) + "Escape" (do (.preventDefault e) (reset! renaming nil)) + nil))}] + [:span.name label]) (when node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))]) + (when lane? + [:button.tl-rename + {:title "rename lane (F2)" + :on-click (fn [^js e] (.stopPropagation e) (begin-rename!))} + "✎"]) ;; 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 inspector's footage section does @@ -541,78 +657,273 @@ "`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 row and the stage are drawn from already has in it." - [{:keys [path span keys dense? kind node-kind select slides cels]} frames sliding] - (let [{from :path x0 :x width :width} @sliding + [{:keys [path span keys dense? kind node-kind select slides cels lane? of unmapped?]} + frames sliding hint {:keys [clip store open frame]}] + (let [active-row (:row @sliding) slide (fn [^js e] - (when (= path from) - (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))] - (when (not= df (:df @sliding)) - (swap! sliding assoc :df df) - (rf/dispatch [::ui/sliding (or slides path) df]))))) + (let [{from :row x0 :x width :width} @sliding] + (when (= path from) + (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width))) + drag (:drag @sliding) + ;; TWO INTENTIONS, SAID BY A MODIFIER. An ordinary + ;; body drag moves a clip in TIME, within its lane + ;; or into another. Holding shift means something + ;; else entirely: put this node INSIDE the symbol + ;; the clip under the pointer places, keeping where + ;; it looks and when it happens. Overlap cannot say + ;; which is meant — dropping on occupied time + ;; already means claiming it — so the person says. + shift? (.-shiftKey e) + under (when (and drag shift?) (clip-under e)) + ;; Asked of the command itself, so the hint cannot + ;; promise what the drop would refuse. + why (when (and under (not= (:select under) (:selection drag))) + (nest/move-refusal clip store open + (nth (:selection drag) 3) + (nth (:select under) 3) + frame)) + nest (when (and under (nil? why) + (not= (:select under) (:selection drag))) + under) + [target-el target] (when (and drag (not shift?)) (lane-under e)) + landing? (some? target) + target-frame (when landing? + (max 0 (- (frame-at-element e frames target-el) + (:grab drag))))] + (when (and drag hint) + (reset! hint + {:x (.-clientX e) :y (.-clientY e) + :nest? (boolean nest) + :no? (boolean why) + :text (cond + nest (str "nest into " (:label nest)) + why (str "can't nest here · " why) + shift? "shift: nest into a clip" + :else "drop to place · shift to nest")})) + (cond + nest + (do + (swap! sliding #(-> % (assoc :nest nest) + (dissoc :target-lane :target-frame))) + (rf/dispatch [::ui/sliding nil])) + landing? + (do + (swap! sliding #(-> % (assoc :target-lane target + :target-frame target-frame) + (dissoc :nest))) + (rf/dispatch [::ui/sliding nil])) + :else + (do + (swap! sliding dissoc :target-lane :target-frame :nest) + (when (not= df (:df @sliding)) + (swap! sliding assoc :df df) + (rf/dispatch [::ui/sliding (:path @sliding) df + (:kind @sliding) (:ripple? @sliding) + (:other @sliding)])))))))) done (fn [commit?] - (when (= path from) - (let [df (:df @sliding)] + (when (= path (:row @sliding)) + (let [{:keys [path df kind ripple? other target-lane target-frame + drag nest on-click]} @sliding] (reset! sliding nil) - (rf/dispatch (if commit? [::ui/slide (or slides path) df] [::ui/sliding nil])))))] + (when hint (reset! hint nil)) + (cond + (and commit? nest drag) + (do (rf/dispatch [::ui/sliding nil]) + ;; `nest/move-node`, which is what keeps the world + ;; transform and the root timing across the move. + (rf/dispatch [::ui/move-node (nth (:selection drag) 3) + (nth (:select nest) 3)])) + (and commit? target-lane drag) + (do (rf/dispatch [::ui/sliding nil]) + (rf/dispatch [::ui/drop-clip (:selection drag) + target-lane target-frame])) + commit? + ;; A press that moved nothing is a click, and a drag + ;; that only moved in time leaves what it moved + ;; selected. The two structural cases above select what + ;; they landed, so neither needs this. + (do (when on-click (rf/dispatch [::ui/select on-click])) + (rf/dispatch [::ui/slide path df kind ripple? other])) + :else (rf/dispatch [::ui/sliding nil]))))) + begin! (fn [^js e actual-path gesture-kind actual-select other drag] + (let [track (.closest (.-currentTarget e) ".tl-track")] + (.stopPropagation e) + ;; SELECTING WAITS FOR THE RELEASE. Selecting on the press + ;; changed what the timeline was showing before the gesture + ;; had said anything: an expanded lane follows the + ;; selection, so pressing a clip to drag it somewhere shut + ;; the portal holding the lane being dragged INTO, out from + ;; under the pointer. The press now only starts the + ;; gesture; what it meant is known on release. + (reset! sliding {:row path :path actual-path :kind gesture-kind + :other other + :on-click actual-select + :drag (when drag + (assoc drag + :grab (- (frame-at-element e frames track) + (:in drag)))) + :ripple? (and (= :out gesture-kind) (.-shiftKey e)) + :x (.-clientX e) :df 0 + :width (.-width (.getBoundingClientRect track))}) + (try (.setPointerCapture track (.-pointerId e)) + (catch :default _ nil))))] [:div.tl-track ;; The track, not the bar, holds the pointer while a bar slides, so the drag ;; goes on when the bar has slid off the ruler and is no longer drawn. {:on-pointer-move slide :on-pointer-up (fn [e] (slide e) (done true)) - :on-pointer-cancel (fn [_] (done false))} + :on-pointer-cancel (fn [_] (done false)) + ;; THE CLICK ARRIVES HERE, not on the block it started on, because the + ;; track captured the pointer. Opening what was double-clicked is + ;; therefore the track's job: the block under the pointer if there is + ;; one, else this row's own instance. It opens as a tab, which is what + ;; double-clicking the same symbol in the pool does. + :on-double-click (fn [^js e] + (when-let [source (or (:source (clip-under e)) of)] + (.stopPropagation e) + (rf/dispatch [::pb/open-symbol source]))) + :ref (when lane? (fn [el] (when el (aset el "arthurLane" select)))) + :on-drag-enter (fn [^js e] + (when (and lane? (or (drag/accepts?) (drag/row))) + (.preventDefault e) + (.stopPropagation e) + (when (drag/accepts?) + (drag/hover! :timeline (frame-at e frames) nil select)))) + :on-drag-over (fn [^js e] + (when (and lane? (or (drag/accepts?) (drag/row))) + (.preventDefault e) + (.stopPropagation e) + (set! (.. e -dataTransfer -dropEffect) + (if (drag/row) "move" "copy")) + (when (drag/accepts?) + (drag/hover! :timeline (frame-at e frames) nil select)))) + :on-drop (fn [^js e] + (when (and lane? (or (drag/accepts?) (drag/row))) + (.preventDefault e) + (.stopPropagation e) + (if-let [from (drag/row-selection)] + (do (drag/done!) + (rf/dispatch [::ui/drop-clip from select + (frame-at e frames)])) + (drag/land! (frame-at e frames) nil select))))} ;; 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. (when-let [[in out] (when (and span (nil? cels)) [(max 0 (first span)) (min frames (second span))])] (when (< in out) + ;; AN UNMAPPED BAR IS NOT DRAGGABLE. Inside a held clip a nested row + ;; is shown across the whole hold because that is when it is on + ;; screen, not because its frames are this ruler's: there is no + ;; mapping to edit through, so the bar selects and does not slide. [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") (when (= :audio node-kind) " sound") - (when select " movable") (when (= path from) " sliding")) + (when unmapped? " unmapped") + (when (and select (not unmapped?)) " movable") + (when (= path active-row) " sliding")) + :title (when unmapped? + "inside a held clip · its own frames have no place on this ruler") :style {:left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%")} + :on-click (when (and select unmapped?) + (fn [^js e] (.stopPropagation e) + (rf/dispatch [::ui/select select]))) :on-pointer-down - (when select - (fn [^js e] - (let [track (.. e -currentTarget -parentElement)] - (.stopPropagation e) - (rf/dispatch [::ui/select select]) - (reset! sliding {:path path :x (.-clientX e) :df 0 - :width (.-width (.getBoundingClientRect track))}) - ;; As on the ruler: an enhancement that throws on a pointer - ;; the browser has no record of. - (try (.setPointerCapture track (.-pointerId e)) - (catch :default _ nil)))))}])) + (when (and select (not unmapped?)) + #(begin! % (or slides path) :slide select nil nil))} + (when (and select (not unmapped?)) + [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" + :on-pointer-down #(begin! % path :out select nil nil)}])])) (doall - (for [{:keys [id label source span select]} cels - :let [in (max 0 (first span)) out (min frames (second span))] + (for [[i {:keys [id label source span select ghost?]}] + (map-indexed vector + (cond-> (vec cels) + (= select (:target-lane @sliding)) + (conj {:id ::moving :label (get-in @sliding [:drag :label]) + :span [(:target-frame @sliding) + (+ (:target-frame @sliding) + (get-in @sliding [:drag :duration]))] + :ghost? true}))) + :let [prev (when (pos? i) (nth cels (dec i))) + joined? (and (not ghost?) prev (= (second (:span prev)) (first span))) + 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") + {:title (str label " · select clip; double-click to edit its symbol" + " · shift-drag another clip onto it to nest that clip inside") + :class (str (when ghost? "ghost") + (when (and select (= select (get-in @sliding [:nest :select]))) + " nest-target")) :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])) + :top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"} + ;; What this block is, for the track to read back: the click that + ;; selects it and the double-click that opens it are both delivered + ;; to the track, which holds the pointer. See `clip-under`. + :ref (when select + (fn [^js el] + (when el (aset el "arthurCel" {:select select :source source + :label label + :in (js/Math.floor in)})))) + :on-pointer-down (when select + #(begin! % (nth select 3) :slide select nil + {:selection select :label label :in in + :duration (- out in)}))} + [:span.tl-cel-label label] + (when select + (if joined? + [:span.tl-junction + {:title "Left: trim left · center: roll cut · right: trim right" + :on-pointer-down + (fn [^js e] + (let [box (.getBoundingClientRect (.-currentTarget e)) + x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box))) + left-path (nth (:select prev) 3) + right-path (nth select 3)] + (cond + (< x 0.34) (begin! e left-path :out (:select prev) nil nil) + (> x 0.66) (begin! e right-path :in select nil nil) + :else (begin! e right-path :roll select left-path nil))))}] + [:span.tl-edge.in {:title "Drag start" + :on-pointer-down #(begin! % (nth select 3) :in select nil nil)}])) + (when select + [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" + :on-pointer-down #(begin! % (nth select 3) :out select nil nil)}])])) ;; 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. + ;; The lane's own keys, and those of the clips on it drawn after the + ;; blocks so they land ON the block they belong to: a collapsed lane still + ;; says where the thing in it changes, without opening anything. (when-not dense? (doall - (for [f keys :when (and (<= 0 f) (< f frames))] + (for [f (distinct (concat keys (mapcat :keys cels))) + :when (and (<= 0 f) (< f frames))] ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])) +(defn- cursor-hint + "What the drag in flight would do, beside the pointer. + + ITS OWN COMPONENT, deref'ing its own atom: the pointer moves many times a + second and every row of the timeline reads `sliding`, so putting the pointer + position in there would repaint the whole pane to move a label two pixels." + [hint] + (when-let [{:keys [x y text nest? no?]} @hint] + [:div.tl-hint {:class (str (when nest? "nesting") (when no? "refusing")) + :style {:left (str (+ x 16) "px") :top (str (+ y 18) "px")}} + text])) + (defn- timeline-view [] (r/with-let [scrubbing (r/atom false) ;; The row a carried row is over and which part of it, for the ;; highlight. over (r/atom nil) - sliding (r/atom nil)] + sliding (r/atom nil) + hint (r/atom nil) + renaming (r/atom nil) + draft (r/atom "")] (let [clip @(rf/subscribe [::render/clip]) frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frame @(rf/subscribe [::playback/frame]) + store @(rf/subscribe [::render/store]) selection @(rf/subscribe [::sub/selection]) target @(rf/subscribe [::sub/target]) expanded @(rf/subscribe [::sub/expanded]) @@ -627,15 +938,27 @@ ;; 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 ;; start on. The stage's drop shows it too, at the playhead. - ghost (when drop + drop-lane (:target drop) + ghost (when (and drop (nil? drop-lane)) {:path [::drop] :depth 0 :kind :ghost :label (str "+ " (:label drop)) :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))] :keys []}) - picture (cond->> (rows clip open expanded) + lane-ghost (when (and drop drop-lane (not (:sound? drop))) + {:id ::drop :label (str "+ " (:label drop)) :ghost? true + :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]}) + chosen (when (= :node (first selection)) (nth selection 3)) + picture (cond->> (cond->> (rows clip open expanded chosen) + lane-ghost + (mapv (fn [row] + (if (= drop-lane (:select row)) + (update row :cels (fnil conj []) lane-ghost) + row)))) (and ghost (not (:sound? drop))) (cons ghost)) - sounds (cond->> (sound-rows clip open expanded) + sounds (cond->> (into (vec (filter :sound? picture)) + (sound-rows clip open expanded)) (and ghost (:sound? drop)) (cons ghost)) + picture (remove :sound? picture) ;; The audio section's heading is a row like the others, so the two ;; columns stay aligned without measuring anything. visible (cond-> (vec picture) @@ -663,7 +986,7 @@ (doall (for [row visible] (with-meta (if (= :section (:kind row)) [:div.tl-label.tl-section (:label row)] - [label-cell row selection target over solo tracing]) + [label-cell row selection target over solo tracing renaming draft]) {:key (str (:path row))})))] [:div.tl-tracks {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) @@ -672,8 +995,17 @@ (.preventDefault e) (drag/hover! :timeline (frame-at e frames) nil))) :on-drag-leave (fn [^js e] - (when-not (.contains (.-currentTarget e) (.-relatedTarget e)) - (rf/dispatch [::ui/drop-clear]))) + (let [box (.getBoundingClientRect (.-currentTarget e)) + inside? (and (<= (.-left box) (.-clientX e) (.-right box)) + (<= (.-top box) (.-clientY e) (.-bottom box)))] + ;; Adding the inline ghost changes the element below + ;; the pointer and Chromium reports a leave with no + ;; related target. Keep the preview while the pointer + ;; is still geometrically inside the tracks. + (when (and (not inside?) + (not (.contains (.-currentTarget e) + (.-relatedTarget e)))) + (rf/dispatch [::ui/drop-clear])))) ;; In its own coordinates: dropped in time, nowhere in particular in ;; space, so what was drawn at a place stays at that place. :on-drop (fn [^js e] @@ -712,215 +1044,12 @@ (doall (for [row visible] (with-meta (if (= :section (:kind row)) [:div.tl-track.tl-section] - [track-cell row frames sliding]) + [track-cell row frames sliding hint + {:clip clip :store store :open open :frame frame}]) {:key (str (:path row))}))) [:div.tl-empty "nothing in this symbol"]) - [: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 select]}] - {:id (peek path) - :path path - :select select - :label label - :cells (mapv (fn [f] - (let [cel (some (fn [{[in out] :span :as cel}] - (when (and (<= in f) (< f out)) cel)) - cels)] - {:frame f :lane (peek path) :lane-select select :cel cel})) - (range frames))}) - (filter :cels (rows clip sid #{})))) - -(defn- cel-sheet-view [] - (r/with-let [range-state (r/atom nil) - clipboard (atom nil) - gesture (r/atom nil)] - (let [clip @(rf/subscribe [::render/clip]) - clip-id @(rf/subscribe [::render/clip-id]) - sid @(rf/subscribe [::render/open]) - frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) - frame @(rf/subscribe [::playback/frame]) - selection @(rf/subscribe [::sub/selection]) - target @(rf/subscribe [::sub/target]) - columns (cel-sheet clip sid frames) - ;; THE AIMED LANE, and there is always one while this view is up. The - ;; sheet is a drawing-lane mode: every cell belongs to a lane and every - ;; new drawing goes in one, so "nothing aimed" is a state it has nothing - ;; to say in. Enforced HERE rather than in the event that switches view, - ;; because the lane can also go stale under it — deleted, or the open - ;; symbol changed — and this is the only place that notices. - aimed (when (some #(= (:id %) (:id target)) columns) (:id target)) - _ (when (and (nil? aimed) (seq columns)) (rf/dispatch [::ui/aim-a-lane])) - active (when (and (= sid (:sid @range-state)) - (= clip-id (:clip-id @range-state))) @range-state) - [ac af] (:anchor active) - [bc bf] (:focus active) - left (when active (min ac bc)) - right (when active (max ac bc)) - top (when active (min af bf)) - bottom (when active (max af bf)) - lanes (when (and active (< right (count columns))) - (mapv :id (subvec columns left (inc right)))) - ;; TWO DISPATCHES, BECAUSE THEY ARE TWO FACTS. Clicking a cell AIMS at - ;; the column's lane — that is where the next drawing goes — and SELECTS - ;; whatever is in the cell, which is what the inspector then shows. A - ;; gap selects the lane itself, there being nothing in it to inspect. - choose! (fn [c f extend?] - (reset! range-state {:sid sid :clip-id clip-id - :anchor (if (and extend? active) (:anchor active) [c f]) - :focus [c f]}) - (rf/dispatch [::pb/seek f]) - (rf/dispatch [::ui/aim-at (:select (nth columns c))]) - (rf/dispatch [::ui/select (or (get-in columns [c :cells f :cel :select]) - (:select (nth columns c)))])) - clear! #(when lanes - (rf/dispatch [::ui/sheet-paste sid lanes top - {:duration (inc (- bottom top)) - :columns (mapv (constantly []) lanes)}])) - style {:grid-template-columns - (str "52px repeat(" (max 1 (count columns)) ", 140px)")}] - [:div.cel-sheet - {:style style :tab-index 0 - :aria-label "Cel sheet. Drag to select; Shift extends selection. Copy and paste reuse drawings." - :on-pointer-move - (fn [e] - (when @gesture - (when-let [cell (some-> (.elementFromPoint js/document (.-clientX e) (.-clientY e)) - (.closest "[data-cs-col]"))] - (let [c (js/Number (.getAttribute cell "data-cs-col")) - f (js/Number (.getAttribute cell "data-cs-frame"))] - (if (= :hold (:kind @gesture)) - (swap! gesture assoc :end (inc f)) - (swap! range-state assoc :focus [c f])))))) - :on-pointer-up - (fn [_] - (when (= :hold (:kind @gesture)) - (rf/dispatch [::ui/sheet-hold sid (:id @gesture) (:end @gesture)])) - (reset! gesture nil)) - :on-pointer-cancel #(reset! gesture nil) - :on-lost-pointer-capture #(reset! gesture nil) - :on-key-down - (fn [e] - (let [k (.toLowerCase (.-key e)) - cmd? (or (.-metaKey e) (.-ctrlKey e)) - arrow (get {"arrowup" [0 -1] "arrowdown" [0 1] - "arrowleft" [-1 0] "arrowright" [1 0]} k)] - (when (and (= "n" k) (not cmd?) aimed) - ;; THE ONE THING THE DELETED BUTTON DID THAT DRAWING CANNOT SAY. - ;; Drawing on an empty frame makes the drawing there, which covers - ;; every case but one: wanting the NEXT drawing when the playhead is - ;; not yet on an empty frame. `append-drawing` puts it past the end - ;; of the lane and seeks to it, so draw-N-draw-N keeps its rhythm - ;; without a trip to a menu. `lane-model.md` calls this one `N` too. - (.preventDefault e) - (.stopPropagation e) - (rf/dispatch [::ui/append-drawing])) - (when (and lanes (or arrow (#{"delete" "backspace" "escape"} k) - (and cmd? (#{"c" "x" "v"} k)))) - (.preventDefault e) - (.stopPropagation e) - (cond - (= k "escape") (do (reset! gesture nil) (reset! range-state nil)) - arrow (let [[dc df] arrow] - (choose! (max 0 (min (dec (count columns)) (+ bc dc))) - (max 0 (min (dec frames) (+ bf df))) (.-shiftKey e))) - (#{"delete" "backspace"} k) (clear!) - (#{"c" "x"} k) - (let [payload (lane/sheet-range clip sid lanes [top (inc bottom)])] - (if (:refused payload) - (rf/dispatch [::ui/sheet-paste sid lanes top payload]) - (do (reset! clipboard {:clip-id clip-id :payload payload}) - (when (= k "x") (clear!))))) - (= k "v") - (let [payload (when (= clip-id (:clip-id @clipboard)) (:payload @clipboard)) - targets (mapv :id (take (count (:columns payload)) (drop left columns)))] - (rf/dispatch [::ui/sheet-paste sid targets top payload]))))))} - [:div.cs-help {:style {:grid-column "1 / -1"}} - (if (= :hold (:kind @gesture)) - (str "Extend hold to frame " (dec (:end @gesture)) " · later cels move with it") - "Drag to select · Shift extends · ⌘/Ctrl C/X/V · Delete clears · drag a hold’s corner to resize")] - [:div.cs-head.cs-frame "frame"] - (doall (for [{:keys [path label select id]} columns] - ^{:key (str "head-" path)} - ;; A HEAD AIMS AND DOES NOT SELECT. Clicking a column's name says - ;; "drawings go here"; it is not a claim about anything to inspect, - ;; so the inspector keeps whatever cel it was showing. - [:button.cs-head {:class (str (when (= select selection) " selected") - (when (= id aimed) " aimed")) - :title (if (= id aimed) - (str label " · new drawings go here") - (str label " · aim new drawings here")) - :on-click #(rf/dispatch [::ui/aim-at select])} - ;; No name tag here, unlike the stage's outline: the thing the - ;; outline is around IS the name. A tag would repeat it. - label])) - (doall - (for [f (range frames) - item (cons {:frame-label? true} - (map-indexed #(assoc (get-in %2 [:cells f]) :column %1) 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 span]} (:cel item) - c (:column item) - selected? (and lanes (<= left c right) (<= top f bottom)) - held? (and id (zero? (get-in clip [:symbols sid :nodes id :playback :speed] 1))) - handle? (and held? (= select selection) (= (inc f) (second span)))] - ^{:key (str f "-" (:lane item))} - [:button.cs-cell - {:class (str (when (= f frame) " current") - (when selected? " selected") - (when (and (= c (:column @gesture)) (= :hold (:kind @gesture)) - (<= (:start @gesture) f) (< f (:end @gesture))) " cs-preview")) - :data-cs-col c :data-cs-frame f - :title (if id (str label " · frame " f) (str "gap · frame " f)) - :on-pointer-down - (fn [e] - (when (= 0 (.-button e)) - (.preventDefault e) - (.focus (.-currentTarget e)) - (.setPointerCapture (.-currentTarget e) (.-pointerId e)) - (choose! c f (.-shiftKey e)) - (reset! gesture {:kind :select}))) - :on-click #(when (zero? (.-detail %)) (choose! c f (.-shiftKey %)))} - (or label "—") - (when handle? - [:span.cs-fill-handle - {:title "Drag to resize hold (ripples later cels)" - :on-pointer-down - (fn [e] - (when (= 0 (.-button e)) - (.preventDefault e) - (.stopPropagation e) - (.setPointerCapture (.-currentTarget e) (.-pointerId e)) - (reset! gesture {:kind :hold :id id :column c - :start (first span) :end (second span)})))}])]))))]))) - -(defn- no-lanes - "What the cel sheet has to say about a symbol with nothing to show frames of. - - AN EMPTY GRID IS NOT AN ANSWER. The sheet is one column per lane, so a symbol - with no lane renders as a frame ruler and nothing beside it — which looks like - the view is broken rather than like the document is empty. The one thing - anybody can do from here is the one thing offered." - [] - [:div.cs-empty - [:p "This symbol has no drawing lanes."] - [:p.dim "The cel sheet shows one column per lane: frames down, drawings across."] - [:button {:on-click #(rf/dispatch [::ui/new-lane])} "make a drawing lane"]]) + [:div.tl-playhead {:style {:left (at% frame frames)}}]]] + [cursor-hint hint]]))) (defn view [] - (if (= :cel-sheet @(rf/subscribe [::sub/time-view])) - (let [clip @(rf/subscribe [::render/clip]) - open @(rf/subscribe [::render/open])] - [:section.pane.time - [transport] - (if (seq (symbol/lanes (get-in clip [:symbols open :nodes]))) - [cel-sheet-view] - [no-lanes])]) - [timeline-view])) + [timeline-view]) diff --git a/frontend/test/arthur/domain/bring_test.cljs b/frontend/test/arthur/domain/bring_test.cljs index d0ddbcc..50cb809 100644 --- a/frontend/test/arthur/domain/bring_test.cljs +++ b/frontend/test/arthur/domain/bring_test.cljs @@ -22,6 +22,7 @@ (is (= {:main :take :inner :inner-2} ids) "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 (= #{:inner-2} (node/sources (first (vals (get-in clip [:symbols :take :nodes]))))) + (is (= #{:inner-2} (node/sources (first (filter #(= :instance (:kind %)) + (vals (get-in clip [:symbols :take :nodes])))))) "and the copy's instance follows its renamed symbol") (is (empty? (clip/problems clip))))) diff --git a/frontend/test/arthur/domain/correction_test.cljs b/frontend/test/arthur/domain/correction_test.cljs index fdefb3b..c71d470 100644 --- a/frontend/test/arthur/domain/correction_test.cljs +++ b/frontend/test/arthur/domain/correction_test.cljs @@ -4,22 +4,22 @@ [arthur.domain.clip :as clip] [arthur.domain.correction :as correction] [arthur.domain.leaf :as leaf] - [arthur.domain.lane-test :as fixture])) + [arthur.domain.sequence-test :as fixture])) (defn- channel [doc id path] (get-in doc [:symbols :main :nodes id :channels path])) (deftest authors-the-three-motions-as-ordinary-layer-channels (let [doc (fixture/document) - constant (correction/add doc :main :girl [:xform :rot] + constant (correction/add doc :main :a [:xform :rot] {:id :flat :support [2 5] :motion :constant :delta 1}) - ramp (correction/add (:clip constant) :main :girl [:xform :rot] + ramp (correction/add (:clip constant) :main :a [:xform :rot] {:id :ramp :support [6 9] :motion :ramp :start 0 :end 2}) - returned (correction/add (:clip ramp) :main :girl [:xform :rot] + returned (correction/add (:clip ramp) :main :a [:xform :rot] {:id :return :support [9 12] :motion :return :start 0 :peak 3 :peak-frame 10}) - c (channel (:clip returned) :girl [:xform :rot])] - (is (= :girl (:selection returned))) + c (channel (:clip returned) :a [:xform :rot])] + (is (= :a (:selection returned))) (is (= [:flat :ramp :return] (mapv :id (:over c)))) (is (= [0 0 1 1 1 0 0 1 2 0 3 0] (mapv #(ch/value-at c % nil) (range 12)))) @@ -47,19 +47,19 @@ put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3])) add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1])) stacked (assoc base :over [put3 add3]) - doc (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos]] stacked)] - (is (:refused (correction/remove-layer doc :main :girl [:xform :pos] :put3)) + doc (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos]] stacked)] + (is (:refused (correction/remove-layer doc :main :a [:xform :pos] :put3)) "removing the replacement would expose a wrong-shaped base") - (let [conflicted (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict] + (let [conflicted (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict] "old topology") - retried (correction/retry-layer conflicted :main :girl [:xform :pos] :add3)] + retried (correction/retry-layer conflicted :main :a [:xform :pos] :add3)] (is (:clip retried)) (is (nil? (get-in (:clip retried) - [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict])))) + [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict])))) (let [without-replacement (-> doc - (assoc-in [:symbols :main :nodes :girl :channels [:xform :pos] :over] + (assoc-in [:symbols :main :nodes :a :channels [:xform :pos] :over] [(assoc add3 :conflict "old topology")]))] - (is (:refused (correction/retry-layer without-replacement :main :girl + (is (:refused (correction/retry-layer without-replacement :main :a [:xform :pos] :add3)) "retry refuses when the current effective base still has the wrong shape")))) @@ -74,13 +74,13 @@ (deftest corrections-round-trip-with-identity-support-and-order (let [doc (fixture/document) - one (:clip (correction/add doc :main :girl [:xform :rot] + one (:clip (correction/add doc :main :a [:xform :rot] {:id :one :support [0 3] :motion :constant :delta 1})) - two (:clip (correction/add one :main :girl [:xform :rot] + two (:clip (correction/add one :main :a [:xform :rot] {:id :two :support [3 6] :motion :ramp :start 0 :end 2})) back (leaf/clip "u" (leaf/leaves "u" two))] (is (= two back)) (is (= [:one :two] - (mapv :id (get-in back [:symbols :main :nodes :girl + (mapv :id (get-in back [:symbols :main :nodes :a :channels [:xform :rot] :over])))))) diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 5f7572e..80c5a29 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -243,7 +243,7 @@ (is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide") (is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}} (clip/symbol made :symbol-1)) - "empty, and as long as the rest of what it was placed in") + "empty, ordinary, and as long as the rest of what it was placed in") (is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}} (select-keys (get-in made [:symbols :outer :nodes u]) [:span :time]))) (is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u]))) diff --git a/frontend/test/arthur/domain/lane_test.cljs b/frontend/test/arthur/domain/lane_test.cljs deleted file mode 100644 index b8290de..0000000 --- a/frontend/test/arthur/domain/lane_test.cljs +++ /dev/null @@ -1,561 +0,0 @@ -(ns arthur.domain.lane-test - (:require [cljs.test :refer [deftest is testing]] - [arthur.domain.bring :as bring] - [arthur.domain.channel :as ch] - [arthur.domain.clip :as clip] - [arthur.domain.history :as history] - [arthur.domain.leaf :as leaf] - [arthur.domain.nest :as nest] - [arthur.domain.node :as node] - [arthur.domain.palette :as pal] - [arthur.domain.pick :as pick] - [arthur.domain.lane :as lane] - [arthur.domain.span :as span] - [arthur.domain.symbol :as symbol])) - -(defn drawing [id x frames] - {:id id :frames frames - :nodes {:mark {:id :mark :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 4) - [:xform :pos] (ch/framed [x 0])}}}}) - -(defn cel [id source at duration speed] - {:id id :kind :instance :parent :girl :z (name id) - :source {:symbol source} :playback {:in 0 :speed speed :end :stop} - :time {:at at :rate 1} :span [0 duration]}) - -(defn document [] - (let [a (cel :a :drawing-a 0 4 0) - b (assoc-in (cel :b :drawing-b 4 4 0) - [:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold)) - insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] - {:name "cels" :fps 24 :width 320 :height 200 - :symbols - {:main {:id :main :frames 12 - :nodes {:girl {:id :girl :kind :group :layout :sequence :z "b" - :channels {[:xform :pos] (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}} - :a a :b b :insert insert - :plate {:id :plate :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 10) - [:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}} - :drawing-a (drawing :drawing-a 10 1) - :drawing-b (drawing :drawing-b 20 1) - :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]] - (ch/keyed {0 [0 0] 9 [900 0]} :linear))}})) - -(deftest sheet-copy-clips-without-resetting-source-or-local-keys - (let [doc (document) - payload (lane/sheet-range doc :main [:girl] [9 11]) - copied (first (first (:columns payload))) - result (lane/paste-range doc :main [:girl] 1 payload random-uuid) - nodes (get-in (:clip result) [:symbols :main :nodes]) - pasted (first (filter #(and (= :wave (node/source %)) - (= [1 3] (node/placed-span %))) (vals nodes)))] - (is (= 2 (:duration payload))) - (is (= [1 3] (:span copied))) - (is (= (:playback copied) (:playback pasted))) - (is (= [1 3] (:span pasted))) - (is (= :wave (node/source pasted))) - (is (empty? (clip/problems (:clip result)))) - (is (= [0 1] (node/placed-span (:a nodes)))) - (is (some #(= [3 4] (node/placed-span %)) (vals nodes))))) - -(deftest sheet-paste-preserves-gaps-and-refuses-overflow-and-incompatible-clocks - (let [doc (document) - gap (:clip (lane/blank doc :main :girl [1 3] {:id :remainder})) - payload (lane/sheet-range gap :main [:girl] [0 4]) - result (lane/paste-range gap :main [:girl] 4 payload random-uuid) - cels (symbol/lane-cels (get-in (:clip result) [:symbols :main :nodes]) :girl)] - (is (empty? (clip/problems (:clip result)))) - (is (not-any? #(let [[a b] (node/placed-span %)] (and (< a 7) (> b 5))) cels)) - (is (:refused (lane/paste-range doc :main [:girl] 10 payload random-uuid))) - (is (:refused (lane/paste-range doc :main [] 0 payload random-uuid))) - (is (:refused (lane/sheet-range - (assoc-in doc [:symbols :main :nodes :girl :time] {:rate 2}) - :main [:girl] [0 4]))))) - -(defn sample [doc fs] - (let [r (clip/resolver doc :main nil pal/index-of nil)] - (into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs))) - -(deftest one-lane-mixes-held-drawings-and-playing-content - (let [doc (document) at (sample doc (range 12))] - (is (empty? (clip/problems doc))) - (is (= 40 (get-in at [3 [:a :mark]]))) - (is (= 60 (get-in at [4 [:b :mark]]))) - (is (= 72 (get-in at [5 [:b :mark]]))) - (is (= 340 (get-in at [8 [:insert :mark]]))) - (is (= 610 (get-in at [11 [:insert :mark]]))) - (is (= (zipmap (range 12) (range -40 80 10)) - (into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at))) - (is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner"))) - -(deftest cel-ripple-keeps-lane-keys-and-moves-cel-corrections - (let [doc (document) - result (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}) - after (:clip result) - nodes (get-in after [:symbols :main :nodes])] - (is (= :a (:selection result))) - (is (= 14 (get-in after [:symbols :main :frames]))) - (is (= [0 6] (node/placed-span (:a nodes)))) - (is (= [6 10] (node/placed-span (:b nodes)))) - (is (= [10 14] (node/placed-span (:insert nodes)))) - (doseq [id [:girl :a :b :insert :plate]] - (is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id)))) - (is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id))))) - (let [at (sample after [5 6 7 10])] - (is (= 60 (get-in at [5 [:a :mark]]))) - (is (= 80 (get-in at [6 [:b :mark]]))) - (is (= 72 (get-in at [7 [:b :mark]])) "B's correction follows B") - (is (= 320 (get-in at [10 [:insert :mark]])) "insert starts on source frame 3")) - (is (empty? (clip/problems after))) - (is (= (assoc-in doc [:symbols :main :frames] 14) - (:clip (lane/extend-hold after :main :a -2 {}))) - "shrinking restores content, except the explicitly grown shot"))) - -(deftest overflow-and-invalid-edits-are-atomic - (let [doc (document) - result (lane/extend-hold doc :main :a 2 {})] - (is (:refused result)) - (is (= 14 (:required-frames result))) - (is (not (contains? result :clip))) - (doseq [delta [0 -4 0.5 js/NaN]] - (is (:refused (lane/extend-hold doc :main :a delta {})))) - (is (:refused (lane/extend-hold doc :main :insert 1 {}))) - (is (:refused (lane/extend-hold doc :main :missing 1 {}))))) - -(deftest a-gap-is-an-uncovered-interval - (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) - at (sample doc [3 4 7 8])] - (is (= #{:plate} (set (keys (at 4))))) - (is (= #{:plate} (set (keys (at 7))))) - (is (get-in at [8 [:insert :mark]])) - (is (empty? (clip/problems doc))))) - -(deftest validation-rejects-overlap-but-allows-empty-lanes - (is (some #(re-find #"overlap" %) - (clip/problems (assoc-in (document) [:symbols :main :nodes :b :time :at] 3)))) - (is (empty? (clip/problems - (update-in (document) [:symbols :main :nodes] dissoc :a :b :insert)))) - (is (seq (clip/problems - (assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf])))) - (is (seq (clip/problems - (assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1)))) - (is (seq (node/problems {:id :old :kind :instance :z "a" - :channels {[:source] (ch/framed {:of :wave :in 0})}})) - "the obsolete format is rejected")) - -(deftest playback-is-independent-of-property-channel-shape - (let [doc (document) - n (get-in doc [:symbols :main :nodes :a]) - keyed (node/toggle-key n [:xform :rot] 0 nil) - unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)] - (doseq [n [n keyed unkeyed]] - (is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1)))) - (let [n (get-in doc [:symbols :main :nodes :insert])] - (is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10))) - (is (nil? (node/placed-frame n 7 10))) - (is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10)))) - (is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10))))))) - -(deftest navigation-and-hit-testing-use-the-same-source-time - (let [doc (document) - n (get-in doc [:symbols :main :nodes :insert])] - (is (= 5 (:frame (nest/inside doc nil :main [:insert] 10)))) - (is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10)))) - (is (= 0 (:frame (nest/inside doc nil :main [:a] 3)))) - (is (nil? (:time (nest/inside doc nil :main [:a] 3)))) - (is (nil? (nest/inside doc nil :main [:a] 4))) - (is (= ((pick/bounds-of doc nil :main n) 2) - ((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0))))) - -(deftest seeking-and-source-reuse-do-not-share-cursors - (let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a) - fs [11 0 5 3 8 4 10 1 6 2 9 7] - at (sample doc fs)] - (is (= at (sample doc (reverse fs)))) - (is (= at (sample doc (range 12)))) - (let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]] - (ch/framed [99 0]))] - (is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]]))) - (is (= 139 (get-in (sample edited [0 4]) [4 [:b :mark]])))))) - -(deftest cel-identities-and-playback-round-trip - (let [doc (:clip (lane/extend-hold (document) :main :a 2 {:extent :grow-symbol})) - leaves (leaf/leaves :project doc)] - (is (= doc (leaf/clip :project leaves))) - (is (contains? leaves "clip/project/symbol/main/node/a")) - (is (not (contains? leaves "clip/project/symbol/main/channel/girl/source"))) - (let [{copied :clip ids :ids} - (bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1)) - doc [:main] {})] - (is (= :drawing-a-2 (:drawing-a ids))) - (is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids)))) - (is (empty? (clip/problems copied)))))) - -(deftest one-transaction-undoes-the-ripple-and-shot-extension - (let [doc (document) - after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})) - before-leaves (leaf/leaves :p doc) - after-leaves (leaf/leaves :p after) - h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle) - undo (history/undo h after-leaves) - redo (history/redo (:history undo) (:leaves undo))] - (is (= 1 (count (:done h)))) - (is (= before-leaves (:leaves undo))) - (is (= after-leaves (:leaves redo))))) - -(deftest create-lane-and-append-drawings - (let [doc (:clip (lane/add-lane (clip/blank) :main :girl)) - a (:clip (lane/append-drawing doc :main :girl :a :drawing-a {})) - b (:clip (lane/append-drawing a :main :girl :b :drawing-b {}))] - (is (empty? (clip/problems b))) - (is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b])))) - (is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed]))) - (is (:refused (lane/append-drawing b :main :girl :a :new {}))))) - -(deftest fractional-placement-rates-convert-the-hold-delta - (let [doc (-> (document) - (assoc-in [:symbols :main :nodes :a :time :rate] 2) - (assoc-in [:symbols :main :nodes :a :span] [0 8])) - after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))] - (is (= [0 12] (get-in after [:symbols :main :nodes :a :span]))) - (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b])))))) - -(deftest bare-shapes-agree-in-reference-and-playback - (let [sym (drawing :bare 12 1)] - (is (= (symbol/eval-frame sym 0 nil pal/index-of nil) - ((symbol/resolver sym nil pal/index-of nil) 0)) - "omitted style colour must not crash a missing cursor"))) - -(deftest audio-follows-only-the-playing-cel - (let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"} - :span [0 10] - :channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}} - doc (-> (document) - (assoc-in [:symbols :wave :nodes :voice] voice) - (assoc-in [:symbols :drawing-a :nodes :voice] voice)) - [track :as tracks] (nest/audio-tracks doc :main)] - (is (= 1 (count tracks)) "the frozen drawing contributes no audio") - (is (= [8 12] (node/placed-span track))) - (is (= [3 7] (:span track)) "the source in-point trims the audio too") - (is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys]))) - (let [moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})) - [track] (nest/audio-tracks moved :main)] - (is (= [10 14] (node/placed-span track))) - (is (= [3 7] (:span track)))) - (let [fast (-> doc - (assoc-in [:symbols :main :nodes :girl :time] {:at 2 :rate 2}) - (assoc-in [:symbols :main :nodes :insert :playback :speed] 2)) - [track] (nest/audio-tracks fast :main)] - (is (= [6 7.75] (node/placed-span track))) - (is (= [3 10] (:span track))) - (is (= 4 (get-in track [:time :rate])))))) - -(deftest a-looped-insert-schedules-distinct-audio-intervals - (let [doc (-> (document) - (assoc-in [:symbols :wave :frames] 4) - (assoc-in [:symbols :wave :nodes :voice] - {:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]}) - (assoc-in [:symbols :main :nodes :insert :playback] - {:in 3 :speed 1 :end :loop}))] - (is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main)))))) - -(deftest enclosing-retiming-is-respected-when-extending-the-shot - (let [doc (assoc-in (document) [:symbols :main :nodes :girl :time] {:at 8 :rate 2}) - result (lane/extend-hold doc :main :a 2 {})] - (is (= 15 (:required-frames result))) - (is (nil? (:clip result))) - (is (= 15 (get-in (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}) - [:clip :symbols :main :frames]))))) - -(deftest reuse-shares-content-and-make-unique-decouples-one-cel - (let [doc (document) - shared (:clip (lane/reuse-drawing doc :main :girl :c :drawing-a - {:extent :grow-symbol})) - edit (fn [c sym x] - (assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]] - (ch/framed [x 0])))] - (is (:refused (lane/reuse-drawing doc :main :girl :c :drawing-a {})) - "the shot has to be extended on purpose") - (is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c])))) - (is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c])))) - (is (empty? (clip/problems shared))) - ;; One drawing, two cels: the edit arrives at both. - (let [at (sample (edit shared :drawing-a 99) [0 12])] - (is (= 99 (get-in at [0 [:a :mark]]))) - (is (= 99 (get-in at [12 [:c :mark]])))) - (let [unique (:clip (lane/make-unique shared :main :c {}))] - (is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c])))) - (is (= (:nodes (get-in shared [:symbols :drawing-a])) - (:nodes (get-in unique [:symbols :drawing-a-2]))) - "a copy of the same drawing, not an empty one") - (is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a]))) - "the other cel keeps the original") - (let [at (sample (edit unique :drawing-a 99) [0 12])] - (is (= 99 (get-in at [0 [:a :mark]]))) - (is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched")) - (let [at (sample (edit unique :drawing-a-2 99) [0 12])] - (is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back")) - (is (empty? (clip/problems unique)))) - ;; Nothing else places drawing-b, so there is nothing to decouple from. - (is (:refused (lane/make-unique doc :main :b {}))) - (is (:refused (lane/make-unique doc :main :girl {})) - "a lane places nothing itself"))) - -(deftest duplicate-copies-the-drawing-and-not-the-cel - (let [doc (document) - made (:clip (lane/duplicate-drawing doc :main :b :d {:extent :grow-symbol})) - n (get-in made [:symbols :main :nodes :d])] - (is (= :drawing-b-2 (node/source n))) - (is (= (:nodes (get-in doc [:symbols :drawing-b])) - (:nodes (get-in made [:symbols :drawing-b-2])))) - (is (= [12 13] (node/placed-span n))) - (is (= {:in 0 :speed 0 :end :stop} (:playback n))) - (is (nil? (:channels n)) "B's own position correction belongs to B's cel") - (is (= (get-in doc [:symbols :main :nodes :b]) - (get-in made [:symbols :main :nodes :b])) - "the drawing duplicated is left as it was") - (is (empty? (clip/problems made))))) - -(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them - ;; A drawing assembled from another symbol: copying it shallowly must keep - ;; using that part, and only an explicit deep copy may promise independence. - (let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part] - {:id :part :kind :instance :z "b" :span [0 1] - :time {:at 0 :rate 1} :source {:symbol :wave} - :playback {:in 0 :speed 0 :end :stop}}) - copy (fn [opts] (:clip (lane/duplicate-drawing - doc :main :a :d (merge {:extent :grow-symbol} opts)))) - shallow (copy {}) - deep (copy {:deep? true})] - (is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part])))) - (is (nil? (get-in shallow [:symbols :wave-2]))) - (is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part])))) - (is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2])))) - (is (empty? (clip/problems shallow))) - (is (empty? (clip/problems deep))))) - -(deftest reuse-refuses-what-would-not-be-a-document - (let [doc (document)] - (is (:refused (lane/reuse-drawing doc :main :girl :c :nothing-here {}))) - (is (:refused (lane/reuse-drawing doc :main :girl :c :main {:extent :grow-symbol})) - "a symbol cannot go inside itself") - (is (:refused (lane/reuse-drawing doc :main :girl :a :drawing-a {:extent :grow-symbol})) - "a cel ID in use is not free") - (is (:refused (lane/reuse-drawing doc :main :plate :c :drawing-a {}))) - (is (:refused (lane/duplicate-drawing doc :main :girl :d {}))))) - -(deftest drawing-on-twos-does-not-quantize-the-lane-transform - ;; Cel length IS the drawing cadence, and it is the only thing on twos - ;; here: the lane's transform has its own clock and keeps moving every frame. - ;; Stepping it would be the cel cadence leaking into continuous motion. - (let [cel (fn [id source at] (cel id source at 2 0)) - doc (-> (document) - (update-in [:symbols :main :nodes] dissoc :a :b :insert) - (update-in [:symbols :main :nodes] merge - {:c0 (cel :c0 :drawing-a 0) - :c1 (cel :c1 :drawing-b 2) - :c2 (cel :c2 :drawing-a 4)})) - xs {:c0 10 :c1 20 :c2 10} - at (sample doc (range 6)) - showing (fn [f] (first (dissoc (at f) :plate)))] - (is (empty? (clip/problems doc))) - (is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(first (key (showing %))) (range 6))) - "the drawing showing changes every second frame") - (is (= [0 10 20 30 40 50] - (mapv (fn [f] (let [[[id _] cx] (showing f)] (- cx (xs id)))) (range 6))) - "and the lane moves on every frame, odd ones included"))) - -(defn- drawn - "What every frame draws, as sorted values, so a picture can be compared - without naming the cels that produced it." - [doc fs] - (let [at (sample doc fs)] - (mapv #(sort (vals (get at %))) fs))) - -(deftest a-drawing-goes-anywhere-in-the-lane-and-ripples-what-follows - (let [doc (document) - keys-of #(get-in % [:symbols :main :nodes :girl :channels [:xform :pos] :keys]) - spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id]))) - [:a :n :b :insert]) - r (lane/append-drawing doc :main :girl :n :drawing-n - {:at 4 :extent :grow-symbol})] - (is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r)))) - (is (= 13 (get-in r [:clip :symbols :main :frames]))) - (is (= (keys-of doc) (keys-of (:clip r))) "lane keys stay where they were authored") - (is (= :n (:selection r))) - (is (= 4 (:frame r))) - (is (empty? (clip/problems (:clip r)))) - ;; The same command with no room refuses, and says how much it needs. - (is (= 13 (:required-frames (lane/append-drawing doc :main :girl :n :drawing-n {:at 4})))) - ;; At the very front everything moves. - (is (= [[1 5] [0 1] [5 9] [9 13]] - (spans (:clip (lane/append-drawing doc :main :girl :n :drawing-n - {:at 0 :extent :grow-symbol}))))) - ;; Inside a cel is not a position for another one. - (is (re-find #"split it first" - (:refused (lane/append-drawing doc :main :girl :n :drawing-n - {:at 2 :extent :grow-symbol})))) - (is (:refused (lane/append-drawing doc :main :girl :n :drawing-n - {:at -1 :extent :grow-symbol}))) - (is (:refused (lane/append-drawing doc :main :girl :n :drawing-n - {:at ##Inf :extent :grow-symbol}))) - ;; Reuse and duplicate take a position too; it is one placement rule. - (is (= [4 5] (node/placed-span - (get-in (lane/reuse-drawing doc :main :girl :n :drawing-b - {:at 4 :extent :grow-symbol}) - [:clip :symbols :main :nodes :n])))) - (is (= [4 5] (node/placed-span - (get-in (lane/duplicate-drawing doc :main :b :n - {:at 4 :extent :grow-symbol}) - [:clip :symbols :main :nodes :n])))))) - -(deftest split-then-place-puts-a-drawing-inside-a-hold - ;; The two commands the doc asks for, composed: neither one guesses. - (let [doc (document) - cut (:clip (span/split doc :main :a 2 :right)) - r (lane/append-drawing cut :main :girl :n :drawing-n - {:at 2 :extent :grow-symbol}) - after (:clip r)] - (is (= [[0 2] [2 3] [3 5] [5 9] [9 13]] - (mapv #(node/placed-span (get-in after [:symbols :main :nodes %])) - [:a :n :right :b :insert]))) - (is (= (get-in doc [:symbols :main :nodes :girl :channels]) - (get-in after [:symbols :main :nodes :girl :channels])) - "the performance is still timed the way it was authored") - (is (empty? (clip/problems after))))) - -(deftest a-three-frame-correction-crosses-a-drawing-boundary - ;; The lane model's worked example. The correction belongs to the GIRL, so it - ;; applies across whichever drawings are showing under it, and outside its - ;; three frames the animation evaluates exactly as it did before. - (let [doc (document) - fs (range 12) - before (drawn doc fs) - beat (ch/layer :beat [3 6] :offset (ch/framed [30 0])) - c (update-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over] - (fnil conj []) beat) - after (drawn c fs) - outside [0 1 2 6 7 8 9 10 11]] - (is (empty? (clip/problems c))) - (is (= (mapv before outside) (mapv after outside)) - "outside the support, frame for frame identical") - (let [at (sample c [3 4 5])] - ;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one - ;; correction, reaching across the cut between them. - (is (= 70 (get-in at [3 [:a :mark]]))) - (is (= 90 (get-in at [4 [:b :mark]]))) - (is (= 102 (get-in at [5 [:b :mark]])) "and B's own correction still applies under it") - (is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5])) - "while the background, which is not in the lane, does not move")) - ;; One document change: one step, and it persists in the channel's own leaf. - (let [b (leaf/leaves :p doc) - a (leaf/leaves :p c) - h (-> nil history/hold (history/record b a 0) history/settle)] - (is (= 1 (count (:done h)))) - (is (= b (:leaves (history/undo h a)))) - (is (= c (leaf/clip :p a)) "a correction needs no codec of its own")))) - -(deftest a-correction-on-one-cel-travels-with-it - ;; The other half of ownership: a layer on a cel is in that - ;; cel's own frames, so moving the cel moves the correction and - ;; nothing has to say so. - (let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0])) - doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over] - (fnil conj []) beat) - moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))] - ;; Stated as the difference from the same document without the correction, - ;; so the claim is about WHERE the layer applies and not about arithmetic. - (let [nudge (fn [with without f] - (- (get-in (sample with [f]) [f [:b :mark]]) - (get-in (sample without [f]) [f [:b :mark]])))] - (is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7])) - "B's first two frames, which are lane frames 4 and 5") - (is (= [7 7 0 0] - (mapv #(nudge moved (:clip (lane/extend-hold (document) :main :a 2 - {:extent :grow-symbol})) - %) - [6 7 8 9])) - "and after A's hold grows, B's first two frames, which are now 6 and 7")) - (is (= (get-in doc [:symbols :main :nodes :b :channels]) - (get-in moved [:symbols :main :nodes :b :channels])) - "the layer itself was not touched by the retiming") - (is (empty? (clip/problems moved))))) - -(defn- spans [clip ids] - (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) - -(deftest blanking-leaves-a-gap-and-does-not-close-it - (let [doc (document) - r (lane/blank doc :main :girl [5 7] {:id :rest}) - after (:clip r)] - ;; B spanned the range, so it became two cels with a hole between them. - (is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert]))) - (is (= :rest (:selection r))) - (let [at (sample after [4 5 6 7])] - (is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame") - (is (= #{:plate} (set (keys (at 6))))) - (is (get-in at [4 [:b :mark]])) - (is (get-in at [7 [:rest :mark]]))) - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after))))) - -(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing - (let [doc (document) - after (:clip (lane/blank doc :main :girl [4 8] {}))] - (is (nil? (get-in after [:symbols :main :nodes :b]))) - (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing") - (is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b])) - "a lane does not own its content") - (is (empty? (clip/problems after))))) - -(deftest blanking-a-range-trims-what-it-only-partly-covers - (let [doc (document) - after (:clip (lane/blank doc :main :girl [3 9] {}))] - (is (= [[0 3] [9 12]] (spans after [:a :insert]))) - (is (nil? (get-in after [:symbols :main :nodes :b]))) - (is (= (get-in (sample doc [9]) [9 [:insert :mark]]) - (get-in (sample after [9]) [9 [:insert :mark]])) - "the insert kept its own frames, so frame 9 shows what it showed") - (is (empty? (clip/problems after))))) - -(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows - (let [r (lane/overwrite-drawing (document) :main :girl :n :drawing-n 5 - {:extent :keep :remainder-id :right}) - after (:clip r) - nodes (get-in after [:symbols :main :nodes])] - (is (= :n (:selection r))) - (is (= [[0 4] [4 5] [5 6] [6 8] [8 12]] - (mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert]))) - (is (= :drawing-b (node/source (:right nodes)))) - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after))))) - -(deftest blank-refuses-what-it-cannot-do-in-one-piece - (let [doc (document)] - (is (re-find #"free ID" (:refused (lane/blank doc :main :girl [5 7] {}))) - "splitting a cel needs an ID for the remainder") - (is (:refused (lane/blank doc :main :girl [5 7] {:id :a})) "and a free one") - (is (:refused (lane/blank doc :main :girl [7 5] {}))) - (is (:refused (lane/blank doc :main :girl [5 5] {}))) - (is (:refused (lane/blank doc :main :girl [5 6.5] {}))) - (is (:refused (lane/blank doc :main :plate [0 2] {}))))) - -(deftest the-shot-length-is-authored-and-emptying-a-lane-does-not-shorten-it - ;; The window and the occupied extent are two facts. A shot with nothing in - ;; the last half is a shot somebody authored that long, and deleting the last - ;; drawing must not quietly shorten the film. - (let [doc (document) - empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))] - (is (empty? (symbol/lane-cels (get-in empty-lane [:symbols :main :nodes]) :girl))) - (is (= 12 (get-in empty-lane [:symbols :main :frames]))) - (is (empty? (clip/problems empty-lane))) - ;; Growing is still the caller's word, and only ever grows. - (is (:refused (lane/append-drawing empty-lane :main :girl :n :drawing-n {:at 20}))) - (is (= 21 (get-in (lane/append-drawing empty-lane :main :girl :n :drawing-n - {:at 20 :extent :grow-symbol}) - [:clip :symbols :main :frames]))) - (is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9)) - [:symbols :main :frames])) - "and trimming the last cel leaves the window where it was"))) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs index 0fafeca..4dd04d9 100644 --- a/frontend/test/arthur/domain/nest_test.cljs +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -170,7 +170,8 @@ inst (get-in grouped [:symbols :main :nodes b-uuid])] (is (nil? (:refused r)) (:refused r)) (is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes]))))) - (is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were") + (is (= [b-uuid] (keys (dissoc (get-in grouped [:symbols :main :nodes]) :lane))) + "one instance where they were") (is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts") (is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends") (is (= (picture c :main fs) (picture grouped :main fs))) @@ -222,6 +223,25 @@ :main [a-uuid :inner] 3)) "but through a loop one frame outside is many inside"))) +(deftest linked-audio-follows-picture-moves-but-keeps-independent-edges + (let [c (-> (clip/blank) + (assoc-in [:symbols :drawing] {:id :drawing :frames 8 :nodes {}}) + (clip/place-symbol nil :main :drawing 2 :picture nil) + (clip/place-sound :main {:sound "voice"} "voice" 8 1 2 :voice) + (assoc-in [:symbols :main :nodes :voice :linked-to] :picture)) + moved (:clip (nest/slide c :main [:picture] 3)) + audio-only (:clip (nest/slide c :main [:voice] 1)) + trimmed (:clip (nest/resize-out c :main [:voice] -2 false))] + (is (= [5 13] (node/placed-span (get-in moved [:symbols :main :nodes :picture])))) + (is (= [5 13] (node/placed-span (get-in moved [:symbols :main :nodes :voice]))) + "moving picture carries its linked audio") + (is (= [2 10] (node/placed-span (get-in audio-only [:symbols :main :nodes :picture])))) + (is (= [3 11] (node/placed-span (get-in audio-only [:symbols :main :nodes :voice]))) + "moving audio itself does not carry picture") + (is (= [2 8] (node/placed-span (get-in trimmed [:symbols :main :nodes :voice]))) + "an audio endpoint trims independently") + (is (= [2 10] (node/placed-span (get-in trimmed [:symbols :main :nodes :picture])))))) + (deftest restacking-is-one-write-to-z (let [shape (fn [z] {:kind :poly :z z :channels {}}) c (-> (clip/blank) diff --git a/frontend/test/arthur/domain/sequence_test.cljs b/frontend/test/arthur/domain/sequence_test.cljs new file mode 100644 index 0000000..8a9160e --- /dev/null +++ b/frontend/test/arthur/domain/sequence_test.cljs @@ -0,0 +1,859 @@ +(ns arthur.domain.sequence-test + "The commands that need a SEQUENCE, which is now a symbol drawn as a lane and + its own children rather than a group with `:layout :sequence`. Was + `lane_test`; the fixtures changed and the assertions did not, except where + they are called out below as behaviour that changed on purpose." + (:require [cljs.test :refer [deftest is testing]] + [arthur.domain.bring :as bring] + [arthur.domain.channel :as ch] + [arthur.domain.clip :as clip] + [arthur.domain.history :as history] + [arthur.domain.leaf :as leaf] + [arthur.domain.nest :as nest] + [arthur.domain.node :as node] + [arthur.domain.palette :as pal] + [arthur.domain.pick :as pick] + [arthur.domain.span :as span] + [arthur.domain.symbol :as symbol])) + +(defn drawing [id x frames] + {:id id :frames frames + :nodes {:mark {:id :mark :kind :rect :z "a" + :channels {[:geom :size] (ch/framed 4) + [:xform :pos] (ch/framed [x 0])}}}}) + +(defn cel + "A clip of the sequence. PARENTLESS, because the symbol is the container." + [id source at duration speed] + {:id id :kind :instance :z (name id) + :source {:symbol source} :playback {:in 0 :speed speed :end :stop} + :time {:at at :rate 1} :span [0 duration]}) + +(defn document + "`:main`, drawn as a lane, holding three clips and a background shape. + + `:plate` HAS NO SPAN, so it is on screen for the whole shot and is not in the + sequence at all — which is what `symbol/children` skips, and the reason an + ordinary shape sitting in a lane symbol is not something an edge edit can trim." + [] + (let [a (cel :a :drawing-a 0 4 0) + b (assoc-in (cel :b :drawing-b 4 4 0) + [:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold)) + insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] + {:name "cels" :fps 24 :width 320 :height 200 + :symbols + {:main {:id :main :frames 12 :display :lane + :nodes {:a a :b b :insert insert + :plate {:id :plate :kind :rect :z "a" + :channels {[:geom :size] (ch/framed 10) + [:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}} + :drawing-a (drawing :drawing-a 10 1) + :drawing-b (drawing :drawing-b 20 1) + :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]] + (ch/keyed {0 [0 0] 9 [900 0]} :linear))}})) + +(defn shot + "`doc` with `:main` placed in a containing symbol as the instance `:girl`, + carrying the keyed transform the LANE GROUP used to carry, and the plate moved + out to be the background that is not in the sequence. + + THE PLACING INSTANCE IS WHERE THE LANE'S TRANSFORM WENT. A lane was a group + and could be animated; a symbol cannot, so what moves a whole sequence is now + the instance that places it. These are the tests that used to animate `:girl` + the group and now animate `:girl` the instance — the same six keys, and the + same answer frame for frame." + [doc] + (-> doc + (update-in [:symbols :main :nodes] dissoc :plate) + (assoc-in [:symbols :shot] + {:id :shot :frames 12 :fps 24 + :nodes {:girl {:id :girl :kind :instance :z "b" :span [0 12] + :time {:mode :map :at 0 :rate 1} + :source {:symbol :main} + :playback {:in 0 :speed 1 :end :stop} + :channels {[:xform :pos] + (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}} + :plate (get-in doc [:symbols :main :nodes :plate])}}))) + +(defn sample-in [doc sid fs] + (let [r (clip/resolver doc sid nil pal/index-of nil)] + (into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs))) + +(defn sample [doc fs] (sample-in doc :main fs)) + +(deftest one-sequence-mixes-held-drawings-and-playing-content + (let [doc (document) at (sample doc (range 12))] + (is (empty? (clip/problems doc))) + (is (= 10 (get-in at [3 [:a :mark]]))) + (is (= 20 (get-in at [4 [:b :mark]]))) + (is (= 22 (get-in at [5 [:b :mark]]))) + (is (= 300 (get-in at [8 [:insert :mark]]))) + (is (= 600 (get-in at [11 [:insert :mark]]))) + (is (= (zipmap (range 12) (range -40 80 10)) + (into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at))) + (is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner"))) + +(deftest the-placing-instance-animates-the-whole-sequence + ;; What `:girl` the lane group used to do, `:girl` the instance does: one + ;; transform over whichever drawing is showing under it, every frame. + (let [doc (shot (document)) at (sample-in doc :shot (range 12))] + (is (empty? (clip/problems doc))) + (is (= 40 (get-in at [3 [:girl :a :mark]]))) + (is (= 60 (get-in at [4 [:girl :b :mark]]))) + (is (= 72 (get-in at [5 [:girl :b :mark]]))) + (is (= 340 (get-in at [8 [:girl :insert :mark]]))) + (is (= 610 (get-in at [11 [:girl :insert :mark]]))) + (is (= (zipmap (range 12) (range -40 80 10)) + (into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)) + "and the background, which is not in the sequence, does not move with it"))) + +(deftest cel-ripple-keeps-the-containers-keys-and-moves-cel-corrections + (let [doc (shot (document)) + result (span/extend-hold doc :main :a 2 {:extent :grow-symbol}) + after (:clip result) + nodes (get-in after [:symbols :main :nodes])] + (is (= :a (:selection result))) + (is (= 14 (get-in after [:symbols :main :frames]))) + (is (= [0 6] (node/placed-span (:a nodes)))) + (is (= [6 10] (node/placed-span (:b nodes)))) + (is (= [10 14] (node/placed-span (:insert nodes)))) + (doseq [id [:a :b :insert]] + (is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id)))) + (is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id))))) + (is (= (get-in doc [:symbols :shot :nodes :girl]) + (get-in after [:symbols :shot :nodes :girl])) + "re-spanning a sequence does not touch what places it") + (let [at (sample-in after :shot [5 6 7 10])] + (is (= 60 (get-in at [5 [:girl :a :mark]]))) + (is (= 80 (get-in at [6 [:girl :b :mark]]))) + (is (= 72 (get-in at [7 [:girl :b :mark]])) "B's correction follows B") + (is (= 320 (get-in at [10 [:girl :insert :mark]])) "insert starts on source frame 3")) + (is (empty? (clip/problems after))) + (is (= (assoc-in doc [:symbols :main :frames] 14) + (:clip (span/extend-hold after :main :a -2 {}))) + "shrinking restores content, except the explicitly grown shot"))) + +(deftest overflow-and-invalid-edits-are-atomic + (let [doc (document) + result (span/extend-hold doc :main :a 2 {})] + (is (:refused result)) + (is (= 14 (:required-frames result))) + (is (not (contains? result :clip))) + (doseq [delta [0 -4 0.5 js/NaN]] + (is (:refused (span/extend-hold doc :main :a delta {})))) + (is (:refused (span/extend-hold doc :main :insert 1 {}))) + (is (:refused (span/extend-hold doc :main :missing 1 {}))) + (is (:refused (span/extend-hold (update-in doc [:symbols :main] dissoc :display) + :main :a 2 {:extent :grow-symbol})) + "lengthening a hold is a sequence edit, so it needs a symbol drawn as one"))) + +(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them + (let [doc (document) + clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes]))) + plain (:clip (span/resize-out doc :main :a 6 {})) + across (:clip (span/resize-out doc :main :a 9 {})) + ripple (:clip (span/resize-out doc :main :a 6 {:ripple? true + :extent :grow-symbol})) + shrink (:clip (span/resize-out doc :main :a 2 {:ripple? true}))] + (is (= [[0 6] [6 8] [8 12]] (clips plain)) + "a normal grow eats the beginning of the adjacent cel") + (is (= [[0 9] [9 12]] (clips across)) + "a long grow removes wholly consumed cels and trims the survivor") + (is (= [[0 6] [6 10] [10 14]] (clips ripple)) + "shift-grow moves every later cel") + (is (= [[0 2] [2 6] [6 10]] (clips shrink)) + "shift-shrink pulls every later cel left") + (is (:refused (span/resize-out doc :main :a 0 {}))) + (is (:refused (span/resize-out doc :main :a 2.5 {}))))) + +(deftest outside-lane-mode-an-edge-edit-disturbs-nothing + ;; The claim-time rule FOLLOWS THE MODE. The same document not drawn as a lane + ;; is a composition, and things in a composition are allowed to be on screen + ;; together — so growing one clip over another simply does that. + (let [doc (update-in (document) [:symbols :main] dissoc :display) + after (:clip (span/resize-out doc :main :a 6 {})) + nodes (get-in after [:symbols :main :nodes])] + (is (= [0 6] (node/placed-span (:a nodes)))) + (is (= [4 8] (node/placed-span (:b nodes))) "the neighbour is left exactly as it was") + (is (= 1 (count (symbol/overlaps (get-in after [:symbols :main]))))) + (is (empty? (clip/problems after)) "and an overlap is not a reason a document will not load"))) + +(deftest the-middle-of-a-cut-rolls-both-edges + (let [doc (document) + clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes]))) + rolled (:clip (span/roll doc :main :a :b 6)) + right-only (:clip (span/resize-in doc :main :b 6)) + grown-left (:clip (span/resize-in doc :main :b 2))] + (is (= [[0 6] [6 8] [8 12]] (clips rolled)) + "the shared cut moves without moving either clip") + (is (= [[0 4] [6 8] [8 12]] (clips right-only)) + "the right side of the junction trims only the right clip") + (is (= [[0 2] [2 8] [8 12]] (clips grown-left)) + "growing the right clip left trims the neighbour instead of overlapping") + (is (:refused (span/roll doc :main :a :b 0))) + (is (:refused (span/roll doc :main :a :insert 6))) + (is (:refused (span/roll (update-in doc [:symbols :main] dissoc :display) :main :a :b 6)) + "a roll is a sequence edit"))) + +(deftest a-gap-is-an-uncovered-interval + (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) + at (sample doc [3 4 7 8])] + (is (= #{:plate} (set (keys (at 4))))) + (is (= #{:plate} (set (keys (at 7))))) + (is (get-in at [8 [:insert :mark]])) + (is (empty? (clip/problems doc))))) + +(deftest an-overlap-is-a-bug-report-and-not-a-reason-not-to-load + ;; It used to be `clip/problems`, which means the document will not load. A + ;; display hint must never be able to do that, so it is its own diagnostic. + (let [clashing (assoc-in (document) [:symbols :main :nodes :b :time :at] 3)] + (is (= [[:a :b]] (symbol/overlaps (get-in clashing [:symbols :main])))) + (is (empty? (clip/problems clashing)) + "and the document still loads, to be drawn visibly wrong") + (is (empty? (symbol/overlaps (get-in (document) [:symbols :main])))) + (is (empty? (clip/problems + (update-in (document) [:symbols :main :nodes] dissoc :a :b :insert))) + "an empty sequence is valid — a shot is authored before it is filled") + (is (seq (clip/problems + (assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf])))) + (is (seq (clip/problems + (assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1)))) + (is (seq (clip/problems + (assoc-in (document) [:symbols :main :nodes :a :layout] :sequence))) + ":layout is not a node field any more") + (is (seq (node/problems {:id :old :kind :instance :z "a" + :channels {[:source] (ch/framed {:of :wave :in 0})}})) + "the obsolete format is rejected"))) + +(deftest no-command-can-commit-an-overlap + ;; THE INVARIANT, ASSERTED OVER THE COMMANDS rather than reasoned about: every + ;; one of them commits through `span/finish`, so sampling them is enough. + ;; Sampled, in the style of `drawn`, rather than computing expected spans by + ;; hand — what is being claimed is that no result holds an overlap, whatever + ;; the numbers are. + (let [doc (document) + every-command + (concat + (for [to (range -1 15)] #(span/resize-out % :main :a to {:extent :grow-symbol})) + (for [to (range -1 15)] #(span/resize-out % :main :b to {:ripple? true :extent :grow-symbol})) + (for [to (range -1 15)] #(span/resize-in % :main :b to)) + (for [to (range -1 15)] #(span/roll % :main :a :b to)) + (for [cut (range -1 15)] #(span/split % :main :insert cut :piece)) + (for [to (range -1 15)] #(span/trim % :main :insert :out to)) + (for [to (range -1 15)] #(span/move % :main :insert to)) + (for [d (range -5 6)] #(span/extend-hold % :main :a d {:extent :grow-symbol})) + (for [a (range 0 13) b (range 0 13)] #(span/blank % :main [a b] {:id :rest})) + (for [at (range -1 15)] #(span/append-drawing % :main :n :drawing-n + {:at at :extent :grow-symbol})) + (for [at (range -1 15)] #(span/reuse-drawing % :main :n :drawing-b + {:at at :extent :grow-symbol})) + (for [at (range -1 15)] #(span/duplicate-drawing % :main :b :n + {:at at :extent :grow-symbol})) + (for [at (range -1 15)] #(span/overwrite-drawing % :main :n :drawing-n at + {:extent :grow-symbol + :remainder-id :rest})) + (for [at (range -1 15)] #(span/place-symbol % nil :main :n :wave at + {:extent :grow-symbol + :remainder-id :rest})) + (for [at (range -1 15)] #(span/adopt % :main :b at {:extent :grow-symbol + :remainder-id :rest})) + [#(span/make-unique (:clip (span/reuse-drawing % :main :n :drawing-a + {:extent :grow-symbol})) + :main :n {})]) + results (keep (fn [command] (:clip (command doc))) every-command)] + (is (< 190 (count results)) "the sample is of commands that actually did something") + (doseq [after results] + (is (empty? (symbol/overlaps (get-in after [:symbols :main]))) + (str "a command committed an overlap: " + (pr-str (mapv (juxt :id node/placed-span) + (symbol/children (get-in after [:symbols :main :nodes])))))) + (is (empty? (clip/problems after)))))) + +(deftest turning-lane-mode-on-is-the-one-thing-that-can-be-refused + (let [composed (-> (document) + (update-in [:symbols :main] dissoc :display) + (assoc-in [:symbols :main :nodes :b :time :at] 3)) + refused (span/draw-as-lane composed :main true {}) + trimmed (:clip (span/draw-as-lane composed :main true {:trim? true}))] + (is (:refused refused)) + (is (= 1 (:required-trim refused))) + (is (nil? (:clip refused)) "and nothing moved") + (is (= :lane (get-in trimmed [:symbols :main :display]))) + (is (= [[0 3] [3 7] [8 12]] + (mapv node/placed-span (symbol/children (get-in trimmed [:symbols :main :nodes])))) + "the retry trims later-claims-from-earlier, the rule everything else follows") + (is (empty? (symbol/overlaps (get-in trimmed [:symbols :main])))) + (is (empty? (clip/problems trimmed))) + ;; A clip the next one wholly covers has nothing left to be. + (let [buried (assoc-in composed [:symbols :main :nodes :b :time :at] 0) + after (:clip (span/draw-as-lane buried :main true {:trim? true}))] + (is (nil? (get-in after [:symbols :main :nodes :a]))) + (is (empty? (symbol/overlaps (get-in after [:symbols :main]))))) + ;; Off is always possible, and changes nothing but the hint. + (let [off (:clip (span/draw-as-lane (document) :main false {}))] + (is (nil? (get-in off [:symbols :main :display]))) + (is (= (get-in (document) [:symbols :main :nodes]) + (get-in off [:symbols :main :nodes])))) + (is (:refused (span/draw-as-lane (document) :nothing-here true {}))) + (is (= :lane (get-in (:clip (span/draw-as-lane (document) :main true {})) + [:symbols :main :display])) + "a sequence that is already one turns on with nothing to trim"))) + +(deftest playback-is-independent-of-property-channel-shape + (let [doc (document) + n (get-in doc [:symbols :main :nodes :a]) + keyed (node/toggle-key n [:xform :rot] 0 nil) + unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)] + (doseq [n [n keyed unkeyed]] + (is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1)))) + (let [n (get-in doc [:symbols :main :nodes :insert])] + (is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10))) + (is (nil? (node/placed-frame n 7 10))) + (is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10)))) + (is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10))))))) + +(deftest navigation-and-hit-testing-use-the-same-source-time + (let [doc (document) + n (get-in doc [:symbols :main :nodes :insert])] + (is (= 5 (:frame (nest/inside doc nil :main [:insert] 10)))) + (is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10)))) + (is (= 0 (:frame (nest/inside doc nil :main [:a] 3)))) + (is (nil? (:time (nest/inside doc nil :main [:a] 3)))) + (is (nil? (nest/inside doc nil :main [:a] 4))) + (is (= ((pick/bounds-of doc nil :main n) 2) + ((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0))))) + +(deftest seeking-and-source-reuse-do-not-share-cursors + (let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a) + fs [11 0 5 3 8 4 10 1 6 2 9 7] + at (sample doc fs)] + (is (= at (sample doc (reverse fs)))) + (is (= at (sample doc (range 12)))) + (let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]] + (ch/framed [99 0]))] + (is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]]))) + (is (= 99 (get-in (sample edited [0 4]) [4 [:b :mark]])))))) + +(deftest cel-identities-and-playback-round-trip + (let [doc (:clip (span/extend-hold (document) :main :a 2 {:extent :grow-symbol})) + leaves (leaf/leaves :project doc)] + (is (= doc (leaf/clip :project leaves))) + (is (contains? leaves "clip/project/symbol/main/node/a")) + (is (= :lane (get-in (leaf/clip :project leaves) [:symbols :main :display])) + "lane mode is saved like any other field of a symbol") + (let [{copied :clip ids :ids} + (bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1)) + doc [:main] {})] + (is (= :drawing-a-2 (:drawing-a ids))) + (is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids)))) + (is (empty? (clip/problems copied)))))) + +(deftest one-transaction-undoes-the-ripple-and-shot-extension + (let [doc (document) + after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol})) + before-leaves (leaf/leaves :p doc) + after-leaves (leaf/leaves :p after) + h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle) + undo (history/undo h after-leaves) + redo (history/redo (:history undo) (:leaves undo))] + (is (= 1 (count (:done h)))) + (is (= before-leaves (:leaves undo))) + (is (= after-leaves (:leaves redo))))) + +(deftest a-new-document-is-ordinary-and-a-lane-is-created-explicitly + (let [doc (clip/blank) + lane (:clip (span/draw-as-lane doc :main true {})) + a (:clip (span/append-drawing lane :main :a :drawing-a {})) + b (:clip (span/append-drawing a :main :b :drawing-b {}))] + (is (= {} (get-in doc [:symbols :main :nodes]))) + (is (nil? (get-in doc [:symbols :main :display]))) + (is (= :lane (get-in lane [:symbols :main :display]))) + (is (empty? (clip/problems b))) + (is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b])))) + (is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed]))) + (is (:refused (span/append-drawing b :main :a :new {}))))) + +(deftest arbitrary-symbols-drop-into-the-sequence-and-claim-their-time + (let [doc (document) + dropped (span/place-symbol doc nil :main :clip :wave 2 + {:extent :grow-symbol :remainder-id :tail}) + after (:clip dropped) + clips (symbol/children (get-in after [:symbols :main :nodes]))] + (is (= :clip (:selection dropped))) + (is (= [[0 2] [2 12]] (mapv node/placed-span clips)) + "the natural ten-frame symbol claims [2,12), trimming/removing incumbents") + (is (= :wave (node/source (second clips)))) + (is (= 1 (:speed (node/playback-of (second clips)))) + "a dropped symbol plays; it is not converted into a drawing hold") + (is (empty? (clip/problems after))) + ;; Outside lane mode the same drop claims nothing. + (let [composed (update-in doc [:symbols :main] dissoc :display) + after (:clip (span/place-symbol composed nil :main :clip :wave 2 + {:extent :grow-symbol :remainder-id :tail}))] + (is (= [[0 4] [2 12] [4 8] [8 12]] + (mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes])))) + "it is simply placed, on screen with what was already there")))) + +(deftest repeated-symbol-drops-keep-the-symbols-natural-duration + (let [empty-lane (assoc-in (document) [:symbols :main] + {:id :main :frames 40 :display :lane :nodes {}}) + once (:clip (span/place-symbol empty-lane nil :main :one :wave 0 + {:extent :grow-symbol :remainder-id :r1})) + twice (:clip (span/place-symbol once nil :main :two :wave 10 + {:extent :grow-symbol :remainder-id :r2})) + thrice (:clip (span/place-symbol twice nil :main :three :wave 20 + {:extent :grow-symbol :remainder-id :r3}))] + (is (= [[:one [0 10]] [:two [10 20]] [:three [20 30]]] + (mapv (juxt :id node/placed-span) + (symbol/children (get-in thrice [:symbols :main :nodes])))) + "materializing the same source repeatedly does not collapse later instances") + (is (every? #(= [0 10] (:span %)) + (symbol/children (get-in thrice [:symbols :main :nodes])))) + (let [resolve (clip/resolver thrice :main nil pal/index-of nil)] + (doseq [[id at] [[:one 0] [:two 10] [:three 20]]] + (is (= [0 300 600 900] + (mapv (fn [f] + (let [op (first (filter #(= [id :mark] (:node %)) + (resolve (+ at f))))] + (js/Math.round (:cx op)))) + [0 3 6 9])) + (str id " gets its own complete source clock")))) + (is (empty? (clip/problems thrice))))) + +(deftest transfer-is-one-placement-rule-with-two-destination-modes + (let [doc (document) + moved (:clip (span/transfer doc :main :insert :main 2 + {:extent :grow-symbol :remainder-id :rest})) + clips (symbol/children (get-in moved [:symbols :main :nodes]))] + (is (= [[0 2] [2 6] [6 8]] (mapv node/placed-span clips)) + "moving within a lane claims the landing interval from both neighbours") + (is (= :insert (:id (second clips)))) + (is (empty? (symbol/overlaps (get-in moved [:symbols :main])))) + ;; The identical transfer into an ordinary symbol simply composites. + (let [ordinary (assoc-in doc [:symbols :other] + {:id :other :frames 12 + :nodes {:existing (cel :existing :drawing-a 0 4 0)}}) + free (:clip (span/transfer ordinary :main :b :other 1 + {:extent :grow-symbol :remainder-id :rest}))] + (is (= #{:existing :b} (set (keys (get-in free [:symbols :other :nodes]))))) + (is (= 1 (count (symbol/overlaps (get-in free [:symbols :other])))) + "overlap is ordinary composition outside lane mode") + (is (nil? (get-in free [:symbols :main :nodes :b]))) + (is (empty? (clip/problems free)))))) + +(deftest an-existing-clip-can-be-moved-and-claim-where-it-lands + (let [doc (assoc-in (document) [:symbols :main :nodes :badge] + {:id :badge :kind :instance :z "z" + :source {:symbol :wave} :span [0 3] + :time {:at 1 :rate 1} + :playback {:in 2 :speed 1 :end :stop}}) + result (span/adopt doc :main :badge 5 + {:extent :grow-symbol :remainder-id :tail}) + after (:clip result) + n (get-in after [:symbols :main :nodes :badge])] + (is (= [5 8] (node/placed-span n))) + (is (= {:in 2 :speed 1 :end :stop} (:playback n)) + "a move changes placement, not source timing") + (is (= [[0 4] [4 5] [5 8] [8 12]] + (mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes]))))) + (is (empty? (clip/problems after))) + (is (:refused (span/adopt doc :main :plate 5 {})) "and a shape has no frames to place"))) + +(deftest fractional-placement-rates-convert-the-hold-delta + (let [doc (-> (document) + (assoc-in [:symbols :main :nodes :a :time :rate] 2) + (assoc-in [:symbols :main :nodes :a :span] [0 8])) + after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))] + (is (= [0 12] (get-in after [:symbols :main :nodes :a :span]))) + (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b])))))) + +(deftest bare-shapes-agree-in-reference-and-playback + (let [sym (drawing :bare 12 1)] + (is (= (symbol/eval-frame sym 0 nil pal/index-of nil) + ((symbol/resolver sym nil pal/index-of nil) 0)) + "omitted style colour must not crash a missing cursor"))) + +(deftest audio-follows-only-the-playing-cel + (let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"} + :span [0 10] + :channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}} + doc (-> (document) + (assoc-in [:symbols :wave :nodes :voice] voice) + (assoc-in [:symbols :drawing-a :nodes :voice] voice)) + [track :as tracks] (nest/audio-tracks doc :main)] + (is (= 1 (count tracks)) "the frozen drawing contributes no audio") + (is (= [8 12] (node/placed-span track))) + (is (= [3 7] (:span track)) "the source in-point trims the audio too") + (is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys]))) + (let [moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol})) + [track] (nest/audio-tracks moved :main)] + (is (= [10 14] (node/placed-span track))) + (is (= [3 7] (:span track)))) + ;; The retime that used to be the lane group's is the placing instance's. + (let [fast (-> (shot doc) + (assoc-in [:symbols :shot :nodes :girl :time] {:mode :map :at 2 :rate 2}) + (assoc-in [:symbols :main :nodes :insert :playback :speed] 2)) + [track] (nest/audio-tracks fast :shot)] + (is (= [6 7.75] (node/placed-span track))) + (is (= [3 10] (:span track))) + (is (= 4 (get-in track [:time :rate])))))) + +(deftest a-looped-insert-schedules-distinct-audio-intervals + (let [doc (-> (document) + (assoc-in [:symbols :wave :frames] 4) + (assoc-in [:symbols :wave :nodes :voice] + {:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]}) + (assoc-in [:symbols :main :nodes :insert :playback] + {:in 3 :speed 1 :end :loop}))] + (is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main)))))) + +(deftest the-shot-a-sequence-needs-is-in-its-own-frames + ;; CHANGED ON PURPOSE. It used to be that an enclosing retime changed how many + ;; frames an edit needed, because the lane was INSIDE the symbol being measured + ;; and its clock sat between them. The symbol is now the container, so its + ;; `:frames` is its own authored window and how fast some instance plays it is + ;; not a fact about it. + (let [doc (shot (document)) + slow (assoc-in doc [:symbols :shot :nodes :girl :time] {:mode :map :at 8 :rate 2})] + (is (= 14 (:required-frames (span/extend-hold slow :main :a 2 {})))) + (is (= 14 (:required-frames (span/extend-hold doc :main :a 2 {})))) + (is (= 14 (get-in (span/extend-hold slow :main :a 2 {:extent :grow-symbol}) + [:clip :symbols :main :frames]))))) + +(deftest reuse-shares-content-and-make-unique-decouples-one-cel + (let [doc (document) + shared (:clip (span/reuse-drawing doc :main :c :drawing-a {:extent :grow-symbol})) + edit (fn [c sym x] + (assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]] + (ch/framed [x 0])))] + (is (:refused (span/reuse-drawing doc :main :c :drawing-a {})) + "the shot has to be extended on purpose") + (is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c])))) + (is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c])))) + (is (empty? (clip/problems shared))) + ;; One drawing, two cels: the edit arrives at both. + (let [at (sample (edit shared :drawing-a 99) [0 12])] + (is (= 99 (get-in at [0 [:a :mark]]))) + (is (= 99 (get-in at [12 [:c :mark]])))) + (let [unique (:clip (span/make-unique shared :main :c {}))] + (is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c])))) + (is (= (:nodes (get-in shared [:symbols :drawing-a])) + (:nodes (get-in unique [:symbols :drawing-a-2]))) + "a copy of the same drawing, not an empty one") + (is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a]))) + "the other cel keeps the original") + (let [at (sample (edit unique :drawing-a 99) [0 12])] + (is (= 99 (get-in at [0 [:a :mark]]))) + (is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched")) + (let [at (sample (edit unique :drawing-a-2 99) [0 12])] + (is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back")) + (is (empty? (clip/problems unique)))) + ;; Nothing else places drawing-b, so there is nothing to decouple from. + (is (:refused (span/make-unique doc :main :b {}))) + (is (:refused (span/make-unique doc :main :plate {})) + "a shape places nothing itself"))) + +(deftest duplicate-copies-the-drawing-and-not-the-cel + (let [doc (document) + made (:clip (span/duplicate-drawing doc :main :b :d {:extent :grow-symbol})) + n (get-in made [:symbols :main :nodes :d])] + (is (= :drawing-b-2 (node/source n))) + (is (= (:nodes (get-in doc [:symbols :drawing-b])) + (:nodes (get-in made [:symbols :drawing-b-2])))) + (is (= [12 13] (node/placed-span n))) + (is (= {:in 0 :speed 0 :end :stop} (:playback n))) + (is (nil? (:channels n)) "B's own position correction belongs to B's cel") + (is (= (get-in doc [:symbols :main :nodes :b]) + (get-in made [:symbols :main :nodes :b])) + "the drawing duplicated is left as it was") + (is (empty? (clip/problems made))))) + +(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them + ;; A drawing assembled from another symbol: copying it shallowly must keep + ;; using that part, and only an explicit deep copy may promise independence. + (let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part] + {:id :part :kind :instance :z "b" :span [0 1] + :time {:at 0 :rate 1} :source {:symbol :wave} + :playback {:in 0 :speed 0 :end :stop}}) + copy (fn [opts] (:clip (span/duplicate-drawing + doc :main :a :d (merge {:extent :grow-symbol} opts)))) + shallow (copy {}) + deep (copy {:deep? true})] + (is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part])))) + (is (nil? (get-in shallow [:symbols :wave-2]))) + (is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part])))) + (is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2])))) + (is (empty? (clip/problems shallow))) + (is (empty? (clip/problems deep))))) + +(deftest reuse-refuses-what-would-not-be-a-document + (let [doc (document)] + (is (:refused (span/reuse-drawing doc :main :c :nothing-here {}))) + (is (:refused (span/reuse-drawing doc :main :c :main {:extent :grow-symbol})) + "a symbol cannot go inside itself") + (is (:refused (span/reuse-drawing doc :main :a :drawing-a {:extent :grow-symbol})) + "a cel ID in use is not free") + (is (:refused (span/duplicate-drawing doc :main :plate :d {}))))) + +(deftest drawing-on-twos-does-not-quantize-the-containers-transform + ;; Cel length IS the drawing cadence, and it is the only thing on twos here: + ;; the instance placing the sequence has its own clock and keeps moving every + ;; frame. Stepping it would be the cel cadence leaking into continuous motion. + (let [cel (fn [id source at] (cel id source at 2 0)) + doc (-> (shot (document)) + (update-in [:symbols :main :nodes] dissoc :a :b :insert) + (update-in [:symbols :main :nodes] merge + {:c0 (cel :c0 :drawing-a 0) + :c1 (cel :c1 :drawing-b 2) + :c2 (cel :c2 :drawing-a 4)})) + xs {:c0 10 :c1 20 :c2 10} + at (sample-in doc :shot (range 6)) + showing (fn [f] (first (dissoc (at f) :plate)))] + (is (empty? (clip/problems doc))) + (is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(second (key (showing %))) (range 6))) + "the drawing showing changes every second frame") + (is (= [0 10 20 30 40 50] + (mapv (fn [f] (let [[[_ id _] cx] (showing f)] (- cx (xs id)))) (range 6))) + "and the sequence moves on every frame, odd ones included"))) + +(defn- drawn + "What every frame draws, as sorted values, so a picture can be compared + without naming the cels that produced it." + [doc sid fs] + (let [at (sample-in doc sid fs)] + (mapv #(sort (vals (get at %))) fs))) + +(deftest a-drawing-goes-anywhere-in-the-sequence-and-ripples-what-follows + (let [doc (shot (document)) + keys-of #(get-in % [:symbols :shot :nodes :girl :channels [:xform :pos] :keys]) + spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id]))) + [:a :n :b :insert]) + r (span/append-drawing doc :main :n :drawing-n {:at 4 :extent :grow-symbol})] + (is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r)))) + (is (= 13 (get-in r [:clip :symbols :main :frames]))) + (is (= (keys-of doc) (keys-of (:clip r))) + "the container's keys stay where they were authored") + (is (= :n (:selection r))) + (is (= 4 (:frame r))) + (is (empty? (clip/problems (:clip r)))) + ;; The same command with no room refuses, and says how much it needs. + (is (= 13 (:required-frames (span/append-drawing doc :main :n :drawing-n {:at 4})))) + ;; At the very front everything moves. + (is (= [[1 5] [0 1] [5 9] [9 13]] + (spans (:clip (span/append-drawing doc :main :n :drawing-n + {:at 0 :extent :grow-symbol}))))) + ;; Inside a cel is not a position for another one. + (is (re-find #"split it first" + (:refused (span/append-drawing doc :main :n :drawing-n + {:at 2 :extent :grow-symbol})))) + (is (:refused (span/append-drawing doc :main :n :drawing-n + {:at -1 :extent :grow-symbol}))) + (is (:refused (span/append-drawing doc :main :n :drawing-n + {:at ##Inf :extent :grow-symbol}))) + ;; Reuse and duplicate take a position too; it is one placement rule. + (is (= [4 5] (node/placed-span + (get-in (span/reuse-drawing doc :main :n :drawing-b + {:at 4 :extent :grow-symbol}) + [:clip :symbols :main :nodes :n])))) + (is (= [4 5] (node/placed-span + (get-in (span/duplicate-drawing doc :main :b :n + {:at 4 :extent :grow-symbol}) + [:clip :symbols :main :nodes :n])))))) + +(deftest split-then-place-puts-a-drawing-inside-a-hold + ;; The two commands the doc asks for, composed: neither one guesses. + (let [doc (shot (document)) + cut (:clip (span/split doc :main :a 2 :right)) + r (span/append-drawing cut :main :n :drawing-n {:at 2 :extent :grow-symbol}) + after (:clip r)] + (is (= [[0 2] [2 3] [3 5] [5 9] [9 13]] + (mapv #(node/placed-span (get-in after [:symbols :main :nodes %])) + [:a :n :right :b :insert]))) + (is (= (get-in doc [:symbols :shot :nodes :girl :channels]) + (get-in after [:symbols :shot :nodes :girl :channels])) + "the performance is still timed the way it was authored") + (is (empty? (clip/problems after))))) + +(deftest a-three-frame-correction-crosses-a-drawing-boundary + ;; The lane model's worked example, with the correction on the INSTANCE that + ;; places the sequence: it applies across whichever drawings are showing under + ;; it, and outside its three frames the animation evaluates exactly as before. + (let [doc (shot (document)) + fs (range 12) + before (drawn doc :shot fs) + beat (ch/layer :beat [3 6] :offset (ch/framed [30 0])) + c (update-in doc [:symbols :shot :nodes :girl :channels [:xform :pos] :over] + (fnil conj []) beat) + after (drawn c :shot fs) + outside [0 1 2 6 7 8 9 10 11]] + (is (empty? (clip/problems c))) + (is (= (mapv before outside) (mapv after outside)) + "outside the support, frame for frame identical") + (let [at (sample-in c :shot [3 4 5])] + ;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one + ;; correction, reaching across the cut between them. + (is (= 70 (get-in at [3 [:girl :a :mark]]))) + (is (= 90 (get-in at [4 [:girl :b :mark]]))) + (is (= 102 (get-in at [5 [:girl :b :mark]])) + "and B's own correction still applies under it") + (is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5])) + "while the background, which is not in the sequence, does not move")) + ;; One document change: one step, and it persists in the channel's own leaf. + (let [b (leaf/leaves :p doc) + a (leaf/leaves :p c) + h (-> nil history/hold (history/record b a 0) history/settle)] + (is (= 1 (count (:done h)))) + (is (= b (:leaves (history/undo h a)))) + (is (= c (leaf/clip :p a)) "a correction needs no codec of its own")))) + +(deftest a-correction-on-one-cel-travels-with-it + ;; The other half of ownership: a layer on a cel is in that cel's own frames, + ;; so moving the cel moves the correction and nothing has to say so. + (let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0])) + doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over] + (fnil conj []) beat) + moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))] + ;; Stated as the difference from the same document without the correction, + ;; so the claim is about WHERE the layer applies and not about arithmetic. + (let [nudge (fn [with without f] + (- (get-in (sample with [f]) [f [:b :mark]]) + (get-in (sample without [f]) [f [:b :mark]])))] + (is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7])) + "B's first two frames, 4 and 5") + (is (= [7 7 0 0] + (mapv #(nudge moved (:clip (span/extend-hold (document) :main :a 2 + {:extent :grow-symbol})) + %) + [6 7 8 9])) + "and after A's hold grows, B's first two frames, which are now 6 and 7")) + (is (= (get-in doc [:symbols :main :nodes :b :channels]) + (get-in moved [:symbols :main :nodes :b :channels])) + "the layer itself was not touched by the retiming") + (is (empty? (clip/problems moved))))) + +(defn- spans [clip ids] + (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) + +(deftest blanking-leaves-a-gap-and-does-not-close-it + (let [doc (document) + r (span/blank doc :main [5 7] {:id :rest}) + after (:clip r)] + ;; B spanned the range, so it became two cels with a hole between them. + (is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert]))) + (is (= :rest (:selection r))) + (let [at (sample after [4 5 6 7])] + (is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame") + (is (= #{:plate} (set (keys (at 6))))) + (is (get-in at [4 [:b :mark]])) + (is (get-in at [7 [:rest :mark]]))) + (is (= 12 (get-in after [:symbols :main :frames]))) + (is (empty? (clip/problems after))))) + +(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing + (let [doc (document) + r (span/blank doc :main [4 8] {}) + after (:clip r)] + (is (nil? (get-in after [:symbols :main :nodes :b]))) + (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing") + (is (nil? (:selection r)) + "and names nothing, because emptying frames selects nothing sensible") + (is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b])) + "a symbol does not own its content") + (is (empty? (clip/problems after))))) + +(deftest blanking-a-range-trims-what-it-only-partly-covers + (let [doc (document) + after (:clip (span/blank doc :main [3 9] {}))] + (is (= [[0 3] [9 12]] (spans after [:a :insert]))) + (is (nil? (get-in after [:symbols :main :nodes :b]))) + (is (= (get-in (sample doc [9]) [9 [:insert :mark]]) + (get-in (sample after [9]) [9 [:insert :mark]])) + "the insert kept its own frames, so frame 9 shows what it showed") + (is (empty? (clip/problems after))))) + +(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows + (let [r (span/overwrite-drawing (document) :main :n :drawing-n 5 + {:extent :keep :remainder-id :right}) + after (:clip r) + nodes (get-in after [:symbols :main :nodes])] + (is (= :n (:selection r))) + (is (= [[0 4] [4 5] [5 6] [6 8] [8 12]] + (mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert]))) + (is (= :drawing-b (node/source (:right nodes)))) + (is (= 12 (get-in after [:symbols :main :frames]))) + (is (empty? (clip/problems after))))) + +(deftest blank-refuses-what-it-cannot-do-in-one-piece + (let [doc (document)] + (is (re-find #"free ID" (:refused (span/blank doc :main [5 7] {}))) + "splitting a cel needs an ID for the remainder") + (is (:refused (span/blank doc :main [5 7] {:id :a})) "and a free one") + (is (:refused (span/blank doc :main [7 5] {}))) + (is (:refused (span/blank doc :main [5 5] {}))) + (is (:refused (span/blank doc :main [5 6.5] {}))) + (is (:refused (span/blank (update-in doc [:symbols :main] dissoc :display) + :main [0 2] {})) + "and a composition has no sequence to leave a hole in"))) + +(deftest the-shot-length-is-authored-and-emptying-it-does-not-shorten-it + ;; The window and the occupied extent are two facts. A shot with nothing in + ;; the last half is a shot somebody authored that long, and deleting the last + ;; drawing must not quietly shorten the film. + (let [doc (document) + emptied (:clip (span/blank doc :main [0 12] {}))] + (is (empty? (symbol/children (get-in emptied [:symbols :main :nodes])))) + (is (= 12 (get-in emptied [:symbols :main :frames]))) + (is (empty? (clip/problems emptied))) + ;; Growing is still the caller's word, and only ever grows. + (is (:refused (span/append-drawing emptied :main :n :drawing-n {:at 20}))) + (is (= 21 (get-in (span/append-drawing emptied :main :n :drawing-n + {:at 20 :extent :grow-symbol}) + [:clip :symbols :main :frames]))) + (is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9)) + [:symbols :main :frames])) + "and trimming the last cel leaves the window where it was"))) + +(deftest a-take-placed-in-a-sequence-is-still-heard + ;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that + ;; "wherever the symbol is placed it is heard". A sequence is one of the places + ;; it can be placed, and must not be the one place that goes silent. + (let [doc (assoc-in (document) [:symbols :take] + {:id :take :frames 10 :fps 24 + :nodes {:pic {:id :pic :kind :instance :z "a" + :source {:symbol :wave} :span [0 10] + :time {:mode :map :at 0 :rate 1} + :playback {:in 0 :speed 1 :end :stop}} + :sound {:id :sound :name "sound" :kind :audio + :parent nil :z "z-sound" + :source {:footage "f1"} :span [0 10] + :time {:mode :map :at 0 :rate 1}}}}) + at-root (clip/place-symbol doc nil :main :take 0 :root nil) + placed (:clip (span/place-symbol doc nil :main :drop :take 0 + {:extent :grow-symbol :remainder-id :tail}))] + (is (= 1 (count (nest/audio-tracks at-root :main))) + "a take placed at the root is heard") + (is (some? placed) "the take goes into the sequence") + (is (= 1 (count (nest/audio-tracks placed :main))) + "and is still heard from inside one"))) + +(deftest a-sound-is-a-clip-of-a-sequence-like-any-other + ;; A sound claims time by the same rule as a picture, and THERE IS NO MIXTURE + ;; RULE ANY MORE: a symbol whose clips are sounds is an audio lane, and that is + ;; the whole of it. The refusal that used to say "picture or sound, not both" + ;; was a property of a lane node, and there is no lane node. + (let [seeded (clip/place-sound (document) :main {:sound "s1"} "voice" 6 1 2 :vo) + result (span/adopt seeded :main :vo 2 {:extent :grow-symbol}) + after (:clip result) + n (get-in after [:symbols :main :nodes :vo])] + (is (nil? (:refused result)) (str (:refused result))) + (is (= [2 8] (node/placed-span n))) + (is (empty? (clip/problems after))) + (is (= 1 (count (nest/audio-tracks after :main))) + "a sound in a sequence is still heard") + (is (contains? (set (map :id (symbol/children (get-in after [:symbols :main :nodes])))) + :vo)) + ;; Picture over sound is picture claiming the frames, like anything else. + (let [mixed (:clip (span/place-symbol after nil :main :also :wave 2 + {:extent :grow-symbol :remainder-id :rest}))] + (is (empty? (symbol/overlaps (get-in mixed [:symbols :main])))) + (is (empty? (clip/problems mixed)))))) diff --git a/frontend/test/arthur/domain/span_test.cljs b/frontend/test/arthur/domain/span_test.cljs index b9c8c32..625a285 100644 --- a/frontend/test/arthur/domain/span_test.cljs +++ b/frontend/test/arthur/domain/span_test.cljs @@ -1,53 +1,22 @@ (ns arthur.domain.span-test - "Split, trim and move, over the two things they have to work on alike: a cel - inside a lane, and a symbol placed straight into a shot. The fixture carries - both on purpose — the commands were lane-gated for as long as a lane was the - only thing anybody had timed, and the point of these tests is that nothing in - them reads a lane." + "Generic span edits in an explicit lane and an ordinary compositing symbol." (:require [cljs.test :refer [deftest is testing]] - [arthur.domain.channel :as ch] [arthur.domain.clip :as clip] - [arthur.domain.lane :as lane] [arthur.domain.node :as node] [arthur.domain.palette :as pal] + [arthur.domain.sequence-test :as fixture] [arthur.domain.span :as span])) -(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 document [] (fixture/document)) -(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 - "A lane of three cels, and — the part lane_test's fixture has no equivalent of - — `:badge`, an instance of an animated symbol placed straight into `:main` - with a span of its own and no parent at all. Its frames are the SYMBOL's, so - it is the case where the coordinate a command takes is not lane time." - [] - (let [a (cel :a :drawing-a 0 4 0) - b (cel :b :drawing-b 4 4 0) - insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] - {:name "spans" :fps 24 :width 320 :height 200 - :symbols - {:main {:id :main :frames 12 - :nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"} - :a a :b b :insert insert - :badge {:id :badge :kind :instance :z "c" - :source {:symbol :wave} - :playback {:in 0 :speed 1 :end :stop} - :time {:at 2 :rate 1} :span [0 8]} - :plate {:id :plate :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 10) - [:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}} - :drawing-a (drawing :drawing-a 10 1) - :drawing-b (drawing :drawing-b 20 1) - :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]] - (ch/keyed {0 [0 0] 9 [900 0]} :linear))}})) +(defn- ordinary-document [] + (-> (document) + (update-in [:symbols :main] dissoc :display) + (assoc-in [:symbols :main :nodes :badge] + {:id :badge :kind :instance :z "z" + :source {:symbol :wave} + :playback {:in 0 :speed 1 :end :stop} + :time {:at 2 :rate 1} :span [0 8]}))) (defn- sample [doc fs] (let [r (clip/resolver doc :main nil pal/index-of nil)] @@ -57,167 +26,67 @@ (let [at (sample doc fs)] (mapv #(sort (vals (get at %))) fs))) -(defn- spans [clip ids] - (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) +(deftest fixtures-state-the-mode-explicitly + (is (= :lane (get-in (document) [:symbols :main :display]))) + (is (nil? (get-in (ordinary-document) [:symbols :main :display]))) + (is (empty? (clip/problems (document)))) + (is (empty? (clip/problems (ordinary-document))))) -(deftest the-fixture-places-one-thing-outside-the-lane +(deftest splitting-preserves-the-picture-in-both-modes + (doseq [[label doc id cut] [["lane clip" (document) :a 2] + ["ordinary placement" (ordinary-document) :badge 6]]] + (testing label + (let [before (drawn doc (range 12)) + r (span/split doc :main id cut :right) + after (:clip r)] + (is (= :right (:selection r))) + (is (= before (drawn after (range 12)))) + (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 (empty? (clip/problems after))))))) + +(deftest split-refuses-an-edge-a-missing-node-and-a-spanless-node (let [doc (document)] - (is (empty? (clip/problems doc))) - (is (nil? (:parent (get-in doc [:symbols :main :nodes :badge]))) - "so a command acting on it has only the symbol's frames to go by") - (is (= [2 10] (node/placed-span (get-in doc [:symbols :main :nodes :badge])))))) - -;; --------------------------------------------------------------------------- -;; split - -(deftest splitting-changes-nothing-that-is-drawn - (let [doc (document) - fs (range 12) - before (drawn doc fs)] - (doseq [[label id cut] [["a held drawing in a lane" :a 2] - ["a playing insert in a lane" :insert 10] - ["a placement with no lane at all" :badge 6]]] - (testing label - (let [r (span/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 one node did") - (is (= cut (second (node/placed-span (get-in after [:symbols :main :nodes id]))) - (first (node/placed-span (get-in after [:symbols :main :nodes :right]))))) - (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 :parent :z]) - (select-keys (get-in after [:symbols :main :nodes :right]) - [:source :playback :channels :parent :z])) - "and it keeps its parent and its depth, so it draws where it drew") - (is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question") - (is (empty? (clip/problems after)))))))) - -(deftest split-refuses-anything-but-one-cut-inside-one-thing - (let [doc (document)] - (doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]] - (is (:refused (span/split doc :main :b cut :right)) (str "cut at " (pr-str cut)))) - (is (:refused (span/split doc :main :a 2 :b)) "the new ID has to be free") + (doseq [cut [0 4 -1 2.5 ##NaN nil]] + (is (:refused (span/split doc :main :a cut :right)))) (is (:refused (span/split doc :main :missing 2 :right))) - (is (re-find #"group" (:refused (span/split doc :main :girl 2 :right))) - "a group is divided by its children, not by its span") - (is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right))) - "and a node with no span has no edges to cut"))) + (is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right)))))) -;; --------------------------------------------------------------------------- -;; trim +(deftest trimming-only-narrows-the-selected-placement + (doseq [[doc id edge to kept] [[(document) :b :out 6 [4 6]] + [(ordinary-document) :badge :in 5 [5 10]]]] + (let [before (get-in doc [:symbols :main :nodes id]) + r (span/trim doc :main id edge to) + after (:clip r)] + (is (= id (:selection r))) + (is (= kept (node/placed-span (get-in after [:symbols :main :nodes id])))) + (is (= (dissoc before :span) + (dissoc (get-in after [:symbols :main :nodes id]) :span))) + (is (empty? (clip/problems after)))))) -(deftest trimming-narrows-one-thing-and-moves-nothing-else - (let [doc (document)] - (doseq [[label id edge to kept] [["a cel in a lane" :b :out 6 [4 6]] - ["a placement outside one" :badge :out 7 [2 7]] - ["the front of one outside a lane" :badge :in 5 [5 10]]]] - (testing label - (let [r (span/trim doc :main id edge to) - after (:clip r)] - (is (= kept (node/placed-span (get-in after [:symbols :main :nodes id])))) - (is (= id (:selection r))) - (is (= (select-keys (get-in doc [:symbols :main :nodes id]) - [:time :playback :channels :source]) - (select-keys (get-in after [:symbols :main :nodes id]) - [:time :playback :channels :source])) - "only :span changed") - (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and no neighbour moved") - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after)))))))) +(deftest resizing-an-ordinary-placement-may-overlap + (let [doc (ordinary-document) + after (:clip (span/resize-out doc :main :badge 11 {}))] + (is (= [2 11] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) + (is (:refused (span/resize-out doc :main :badge 2 {}))))) -(deftest trimming-the-front-does-not-restart-what-is-playing - ;; The difference between trimming and slipping, asserted on the node that has - ;; no lane: its own frames are where they were, so the frames that survive - ;; show exactly what they showed. +(deftest moving-follows-the-symbol-mode + (let [lane (document) + ordinary (ordinary-document)] + (is (:refused (span/move lane :main :insert 6)) "a lane clip cannot overlap B") + (let [after (:clip (span/move ordinary :main :badge 0))] + (is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge]))) + "an ordinary symbol is free to composite over occupied frames") + (is (empty? (clip/problems after)))))) + +(deftest clearing-room-then-moving-is-explicit-composition (let [doc (document) - before (sample doc [6 7]) - after (:clip (span/trim doc :main :badge :in 6))] - (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) - (is (= (:playback (get-in doc [:symbols :main :nodes :badge])) - (:playback (get-in after [:symbols :main :nodes :badge])))) - (is (= (get-in before [6 [:badge :mark]]) - (get-in (sample after [6]) [6 [:badge :mark]])) - "the same animation on the frames it kept") - (is (nil? (get-in (sample after [5]) [5 [:badge :mark]])) - "and the frames it gave up show nothing of it"))) - -(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge - (let [doc (document)] - (doseq [[label id edge to] [["at its own start" :b :in 4] - ["at its own end" :b :out 8] - ["past its end" :b :out 9] - ["before its start" :b :in 2] - ["off a whole frame" :b :out 5.5] - ["past the end of one outside a lane" :badge :out 11] - ["before the start of one outside a lane" :badge :in 1]]] - (is (:refused (span/trim doc :main id edge to)) label)) - (is (:refused (span/trim doc :main :b :middle 6))) - (is (re-find #"group" (:refused (span/trim doc :main :girl :out 6)))))) - -;; --------------------------------------------------------------------------- -;; move - -(deftest moving-keeps-its-length-and-its-source-origin - (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) - r (span/move doc :main :insert 4) - after (:clip r)] - (is (= [[0 4] [4 8]] (spans after [:a :insert]))) - (is (= :insert (:selection r))) - (is (= (:playback (get-in doc [:symbols :main :nodes :insert])) - (:playback (get-in after [:symbols :main :nodes :insert])))) - ;; It began on source frame 3 at lane 8; it begins on source frame 3 at lane 4. - (is (= (get-in (sample doc [8]) [8 [:insert :mark]]) - (get-in (sample after [4]) [4 [:insert :mark]]))) + cleared (:clip (span/blank doc :main [4 8] {})) + after (:clip (span/move cleared :main :insert 4))] + (is (= [4 8] (node/placed-span (get-in after [:symbols :main :nodes :insert])))) (is (empty? (clip/problems after))))) -(deftest a-move-outside-a-lane-is-free-to-land-on-an-occupied-frame - ;; The non-overlap rule is the LANE's, and `:badge` is not in one. Things - ;; placed in a composition are allowed to be on screen together, so there is - ;; nothing here for a move to refuse. - (let [doc (document) - r (span/move doc :main :badge 0) - after (:clip r)] - (is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) - (is (= [[0 4] [4 8] [8 12]] (spans after [:a :b :insert])) - "and the lane beside it did not notice") - (is (= (get-in (sample doc [2]) [2 [:badge :mark]]) - (get-in (sample after [0]) [0 [:badge :mark]])) - "its source origin came with it") - (is (empty? (clip/problems after))))) - -(deftest a-move-onto-an-occupied-frame-of-a-lane-is-refused-rather-than-rippled - (let [doc (document)] - (is (:refused (span/move doc :main :insert 6)) "it would overlap B") - (is (:refused (span/move doc :main :insert 4.5))) - (is (re-find #"group" (:refused (span/move doc :main :girl 2)))) - (is (re-find #"whole shot" (:refused (span/move doc :main :plate 2)))) - ;; Clearing the room first is the composition, and then it goes. - (let [cleared (:clip (lane/blank doc :main :girl [4 8] {}))] - (is (= [[0 4] [4 8]] (spans (:clip (span/move cleared :main :insert 4)) - [:a :insert])))))) - -;; --------------------------------------------------------------------------- -;; the coordinate - -(deftest host-frame-reads-lane-time-for-a-cel-and-symbol-time-for-everything-else - (let [doc (document) - retimed (assoc-in doc [:symbols :main :nodes :girl :time] {:at 4 :rate 2})] - (is (= 6 (span/host-frame doc :main :b 6)) - "an untimed lane reads the symbol's frames as its own") - (is (= 6 (span/host-frame doc :main :badge 6)) - "and so does a node with no parent, always") - (is (= 4 (span/host-frame retimed :main :b 6)) - "through a lane at :at 4 :rate 2, symbol frame 6 is lane frame 4") - (is (= 6 (span/host-frame retimed :main :badge 6)) - "which is the lane's business and not the badge's") - (is (nil? (span/host-frame (assoc-in doc [:symbols :main :nodes :girl :time] - {:loop? true}) - :main :b 6)) - "and a looping parent has no single answer to give"))) +(deftest host-frame-of-a-parentless-clip-is-the-symbol-frame + (is (= 6 (span/host-frame (document) :main :b 6))) + (is (= 6 (span/host-frame (ordinary-document) :main :badge 6)))) diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index f751f78..9d5601a 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -1,43 +1,53 @@ (ns arthur.events.lane-test (:require [cljs.test :refer [deftest is]] - [arthur.domain.lane-test :as fixture] [arthur.domain.clip :as clip] - [arthur.domain.correction :as correction] - [arthur.domain.lane :as lane] - [arthur.events.ui :as ui] [arthur.domain.history :as history] [arthur.domain.leaf :as leaf] - [arthur.domain.symbol :as symbol] + [arthur.domain.sequence-test :as fixture] + [arthur.domain.span :as span] + [arthur.events.ui :as ui] [arthur.footage.store :as store] - [arthur.ui.timeline :as timeline])) + [arthur.ui.timeline :as timeline] + [re-frame.core :as rf] + [re-frame.db :as rf-db])) -(deftest one-row-projects-all-cels-and-keeps-selection-addresses +(deftest symbol-and-lane-creation-are-distinct-explicit-commands + (letfn [(run [event key] + (let [doc (clip/blank) + id (store/install! {:clip doc :store {}} key)] + (reset! rf-db/app-db {:clip/current id :paint/revision 0 + :ui {:open :main} :playback {:frame 0}}) + (rf/dispatch-sync event) + (let [db @rf-db/app-db + saved (:clip (store/entry id)) + [_ _ instance-id] (get-in db [:ui :selection]) + sid (get-in saved [:symbols :main :nodes instance-id :source :symbol])] + {:db db :symbol (clip/symbol saved sid)})))] + (let [{ordinary :symbol} (run [::ui/new-symbol :inside] "explicit-symbol") + {lane :symbol lane-db :db} (run [::ui/new-lane] "explicit-lane")] + (is (nil? (:display ordinary)) "new symbol means ordinary symbol") + (is (= :lane (:display lane)) "only the lane command creates a lane") + (is (some? (get-in lane-db [:ui :target])) + "the new lane is aimed so drawing and pool drops can go into it")))) + +(deftest an-explicit-lane-is-one-row-of-clips (let [doc (fixture/document) rows (timeline/rows doc :main #{}) - lane (first (filter :cels rows))] - (is (= 2 (count rows))) + lane (first (filter :lane? rows))] + (is (= 2 (count rows)) "the lane row plus the span-less plate") (is (= [[0 4] [4 8] [8 12]] (mapv :span (:cels lane)))) - (is (= [[:node :main :a [:a]] [:node :main :b [:b]] [:node :main :insert [:insert]]] - (mapv :select (:cels lane)))) - (is (= [0 6 12] (:keys lane))) - (is (= 1 (count (filter :cels (timeline/rows doc :main #{[:girl]}))))))) - -(deftest the-cel-sheet-is-the-same-cels-with-the-axes-turned - (let [doc (fixture/document) - column (first (timeline/cel-sheet doc :main 12)) - cells (:cells column)] - (is (= :girl (:id column))) - (is (= [:node :main :girl [:girl]] (:select column))) - (is (every? #(= (:select column) (:lane-select %)) cells)) - (is (= [:a :b :insert] (mapv #(get-in cells [% :cel :id]) [0 4 8]))) (is (= [[:node :main :a [:a]] [: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]))))) + (mapv :select (:cels lane)))))) -(deftest a-nested-selection-converts-the-open-playhead-to-its-owning-symbol +(deftest an-ordinary-symbol-keeps-a-row-per-node + (let [doc (update-in (fixture/document) [:symbols :main] dissoc :display) + rows (timeline/rows doc :main #{})] + (is (empty? (filter :lane? rows))) + (is (= #{[:a] [:b] [:insert] [:plate]} (set (map :path rows)))))) + +(deftest a-nested-selection-converts-the-open-playhead-to-its-owner (let [doc (assoc-in (fixture/document) [:symbols :outer] {:id :outer :frames 30 :nodes {:take {:id :take :kind :instance :z "a" @@ -49,133 +59,59 @@ (is (= 12 (ui/selection-frame doc nil :main [:node :main :a [:a]] 12))))) -(deftest polygon-landing-follows-the-target-not-the-selection - (let [doc (fixture/document) - db {:ui {:open :main - :time-view :timeline - :selection [:node :main :plate [:plate]] - :target {:sid :main :id :insert :path [:insert]}} - :playback {:frame 5}} - landing (ui/polygon-landing doc {} db)] - (is (= doc (:clip landing))) - (is (= [:insert] (:path landing)) - "looking at another shape does not silently move the creation target") - (is (false? (:lane? landing))))) +(deftest polygon-landing-obeys-the-destination-symbol-mode + (let [lane (fixture/document) + ordinary (update-in lane [:symbols :main] dissoc :display) + db {:ui {:open :main :target {:sid :main :id :plate :path [:plate]}} + :playback {:frame 5}}] + (is (true? (:lane? (ui/polygon-landing lane {} db)))) + (is (false? (:lane? (ui/polygon-landing ordinary {} db)))))) -(deftest cel-sheet-polygon-landing-is-decided-by-the-aimed-lane - (let [doc (fixture/document) - base {:ui {:open :main - :time-view :cel-sheet - :selection [:node :main :plate [:plate]] - :target {:sid :main :id :girl :path [:girl]}} - :playback {:frame 5}} - occupied (ui/polygon-landing doc {} base) - with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) - gap (ui/polygon-landing with-gap {} (assoc-in base [:playback :frame] 6))] - (is (= [:b] (:path occupied)) - "the cel on screen wins even while an unrelated stage node is selected") - (is (= doc (:clip occupied)) "an existing cel needs no document edit") - (is (true? (:lane? occupied))) - (is (= 1 (count (:path gap)))) - (is (not (contains? (get-in with-gap [:symbols :main :nodes]) - (first (:path gap)))) - "a gap receives a fresh drawing") - (is (contains? (get-in (:clip gap) [:symbols :main :nodes]) - (first (:path gap)))) - (is (empty? (clip/problems (:clip gap)))))) - -(deftest cel-sheet-polygon-landing-refuses-without-an-aimed-lane - (let [doc (fixture/document) - db {:ui {:open :main :time-view :cel-sheet - :target {:sid :main :id :plate :path [:plate]}} - :playback {:frame 5}} - landing (ui/polygon-landing doc {} db)] - (is (re-find #"drawing lane" (:refused landing))) - (is (true? (:lane? landing))) - (is (nil? (:clip landing))))) - -(deftest beginning-a-polygon-materializes-a-missing-cel-sheet-drawing - (let [doc (fixture/document) - with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) - id (store/install! {:clip with-gap :store {}} "polygon-start-test") - db {:clip/current id :paint/revision 0 - :ui {:open :main :time-view :cel-sheet - :target {:sid :main :id :girl :path [:girl]}} - :playback {:frame 6}} - after (ui/beginning-polygon db) - saved (:clip (store/entry (:clip/current after))) - [_ sid cel-id path] (get-in after [:ui :selection])] - (is (= :polygon (get-in after [:ui :tool]))) - (is (= [] (get-in after [:ui :draft]))) - (is (= :main sid)) - (is (= [cel-id] path)) - (is (contains? (get-in saved [:symbols :main :nodes]) cel-id) - "the drawing exists before the first draft point is added") - (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) - (is (empty? (clip/problems saved))))) - -(deftest beginning-a-polygon-materializes-a-lane-before-its-drawing +(deftest beginning-a-polygon-does-not-invent-a-lane (let [doc (clip/blank) - id (store/install! {:clip doc :store {}} "polygon-lane-start-test") + id (store/install! {:clip doc :store {}} "polygon-no-implicit-lane") db {:clip/current id :paint/revision 0 - :ui {:open :main :time-view :cel-sheet} + :ui {:open :main} :playback {:frame 6}} after (ui/beginning-polygon db) - saved (:clip (store/entry (:clip/current after))) - lanes (symbol/lanes (get-in saved [:symbols :main :nodes])) - lane-id (:id (first lanes)) - [_ sid cel-id path] (get-in after [:ui :selection])] + saved (:clip (store/entry (:clip/current after)))] (is (= :polygon (get-in after [:ui :tool]))) - (is (= 1 (count lanes))) - (is (= {:sid :main :id lane-id :path [lane-id]} - (get-in after [:ui :target]))) - (is (= :main sid)) - (is (= [cel-id] path)) - (is (= lane-id (get-in saved [:symbols :main :nodes cel-id :parent]))) - (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) - (is (= 1 (count (get-in (store/entry (:clip/current after)) - [:history :done]))) - "the lane and drawing are one start-polygon undo step") - (is (empty? (clip/problems saved))))) + (is (= {} (get-in saved [:symbols :main :nodes]))) + (is (nil? (get-in saved [:symbols :main :display]))) + (is (nil? (get-in (store/entry (:clip/current after)) [:history :done]))))) (deftest sequence-commands-use-isolated-history-transactions (let [doc (fixture/document) - id (store/install! {:clip doc :store {}} "sequence-test") + id (store/install! {:clip doc :store {}} "sequence-command-test") db {:clip/current id :paint/revision 0 :ui {:open :main :selection [:node :main :a [:a]]}} - refused (ui/apply-lane-command db :main - (lane/extend-hold doc :main :a 1 {}) [:retry])] + refused (ui/apply-command db :main + (span/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) + (is (= [:retry] (get-in refused [:ui :retry]))) + (let [r1 (span/extend-hold doc :main :a 1 {:extent :grow-symbol}) + db1 (ui/apply-command db :main r1 nil) + r2 (span/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol}) + db2 (ui/apply-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 (= 2 (count (:done h)))) (is (= (:clip r1) (leaf/clip "u" (:leaves undo)))) (is (= doc (leaf/clip "u" (:leaves undo2)))) (is (= [:node :main :a [:a]] (get-in db2 [:ui :selection])))))) -(deftest a-correction-is-one-step-and-keeps-the-full-selection-address +(deftest an-expanded-lane-opens-the-selected-clip (let [doc (fixture/document) - id (store/install! {:clip doc :store {}} "correction-event-test") - selection [:node :main :a [:outer :a]] - db {:clip/current id :paint/revision 0 - :ui {:open :outer :selection selection}} - result (correction/add doc :main :a [:xform :rot] - {:id :nudge :support [0 3] :motion :return - :start 0 :peak 0.5 :peak-frame 1}) - after (ui/apply-correction-command db result) - entry (store/entry id)] - (is (= selection (get-in after [:ui :selection]))) - (is (= 1 (count (get-in entry [:history :done])))) - (is (= 0.5 (get-in (:clip entry) - [:symbols :main :nodes :a :channels [:xform :rot] - :over 0 :values :keys 1]))) - (let [refused (ui/apply-correction-command after {:refused "nope"})] - (is (= "nope" (get-in refused [:project :status]))) - (is (= 1 (count (get-in (store/entry id) [:history :done]))))))) + rows (timeline/rows doc :main #{[:arthur.ui.timeline/lane] [:insert]} [:insert]) + portal (first (filter :portal? rows))] + (is (= [:insert] (:path portal))) + (is (= [:node :main :insert [:insert]] (:select portal))) + (is (some #{"mark"} (map :label rows))))) + +(deftest a-lane-of-sounds-is-not-flattened-twice + (let [base (:clip (span/draw-as-lane (clip/blank) :main true {})) + doc (clip/place-sound base :main {:sound "s1"} "voice" 6 1 2 :vo) + lane (first (filter :lane? (timeline/rows doc :main #{} nil)))] + (is (= [:vo] (mapv :id (:cels lane)))) + (is (empty? (timeline/sound-rows doc :main #{}))))) diff --git a/frontend/test/browser/lane.mjs b/frontend/test/browser/lane.mjs index 17be6b5..10cdf44 100644 --- a/frontend/test/browser/lane.mjs +++ b/frontend/test/browser/lane.mjs @@ -1,5 +1,5 @@ -// 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. +// Browser smoke test for the explicit-lane workflow. It uses the in-memory +// document and disables project routing, so it performs no server-side write. import { spawn } from 'node:child_process'; import { mkdtempSync, rmSync } from 'node:fs'; import { tmpdir } from 'node:os'; @@ -7,7 +7,7 @@ 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 profile = mkdtempSync(join(tmpdir(), 'arthur-explicit-lane-')); const port = 9335; const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [ '--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run', @@ -16,6 +16,7 @@ const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [ ], { stdio: 'ignore' }); const sleep = ms => new Promise(resolve => setTimeout(resolve, ms)); let ws; + try { let target; for (let i = 0; i < 100 && !target; i++) { @@ -23,11 +24,12 @@ try { 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 */ } + } catch { /* Chromium is still 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 = []; @@ -35,10 +37,10 @@ try { 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); + const waiting = pending.get(msg.id); pending.delete(msg.id); - if (msg.error) reject(new Error(JSON.stringify(msg.error))); - else resolve(msg.result); + if (msg.error) waiting.reject(new Error(JSON.stringify(msg.error))); + else waiting.resolve(msg.result); } }; const send = (method, params = {}) => new Promise((resolve, reject) => { @@ -47,13 +49,16 @@ try { 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; + const result = await send('Runtime.evaluate', { + expression, returnByValue: true, awaitPromise: true, + }); + if (result.exceptionDetails) throw new Error(JSON.stringify(result.exceptionDetails)); + return result.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; + if (await evaluate('typeof arthur !== "undefined" && !!document.querySelector("canvas.stage")')) break; await sleep(100); } await evaluate(`(() => { @@ -61,332 +66,145 @@ try { cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test'))); 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 cljs.core.clj__GT_js(arthur.footage.store.entry(cljs.core.get(db, k('clip/current')))); }; 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', '.section']; - const within = (suffix) => bars.map((b) => `${b} ${suffix}`).join(', '); - const named = label => - `(b => b.textContent.trim() === ${JSON.stringify(label)}` + - ` || b.getAttribute('aria-label') === ${JSON.stringify(label)})`; - const shut = async () => { - await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(s => s.click()); return true })()`); - await sleep(120); + + const named = label => `(b => b.getAttribute('aria-label') === ${JSON.stringify(label)}` + + ` || b.textContent.trim() === ${JSON.stringify(label)})`; + const closeMenus = async () => { + await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(x => x.click()); return true })()`); + await sleep(80); }; - // 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); + const clickNew = async label => { + await closeMenus(); 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 menu = document.querySelector('.loc .menu-wrap > button'); + if (!menu) return false; + menu.click(); return true; + })()`), 'new menu exists'); + await sleep(100); + assert(await evaluate(`(() => { + const item = [...document.querySelectorAll('.menu-item')].find(${named(label)}); + if (!item || item.disabled) return false; + item.click(); return true; + })()`), `enabled creation command: ${label}`); + await sleep(220); + await closeMenus(); }; - // UUIDs expose a mutable hash cache through clj->js; compare their identity, - // not that implementation detail, when asserting exact undo restoration. const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'), (_key, value) => value?.uuid ?? value)); - 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'); + const mainInstances = s => Object.values(s.clip.symbols.main.nodes) + .filter(n => n.kind === 'instance'); + const laneSymbols = s => Object.values(s.clip.symbols).filter(sym => sym.display === 'lane'); + + assert.equal((await shot()).clip.symbols.main.display, undefined, + 'a blank document starts as an ordinary symbol'); + + await clickNew('inside'); 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'); + let placed = mainInstances(s); + assert.equal(placed.length, 1, 'new symbol places one instance'); + assert.equal(s.clip.symbols[placed[0].source.symbol].display, undefined, + 'new symbol remains ordinary'); + assert.equal(await evaluate('document.querySelectorAll(".tl-track").length'), 1, + 'an ordinary symbol is an ordinary timeline row'); - // 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 +'); + await clickNew('lane'); 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'); + placed = mainInstances(s); + assert.equal(placed.length, 2, 'explicit lane places a second symbol'); + assert.equal(laneSymbols(s).length, 1, 'only the lane command marks a symbol as a lane'); + assert.equal(await evaluate('[...document.querySelectorAll(".tl-track")].filter(t => t.arthurLane).length'), 1, + 'the explicit lane is drawn as one linear track'); - // 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); - - // Correction authoring is reachable from the same selection. The range is - // in this cel's own frames and Apply is one isolated history transaction. + assert.equal(await evaluate('document.querySelectorAll(".tl-rename").length'), 1, + 'the lane exposes its rename control'); + await evaluate('document.querySelector(".tl-rename").click()'); + await sleep(80); assert(await evaluate(`(() => { - const section = [...document.querySelectorAll('.section')] - .find(s => s.querySelector('h2')?.textContent.trim() === 'corrections'); - const label = [...section.querySelectorAll('label')] - .find(l => l.textContent.trim().startsWith('offset (degrees)')); - const input = label?.querySelector('input'); + const input = document.querySelector('.tl-name-input'); if (!input) return false; - const set = Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set; - set.call(input, '15'); - input.dispatchEvent(new Event('input', {bubbles: true})); - input.dispatchEvent(new Event('change', {bubbles: true})); - return true; - })()`), 'rotation correction value is editable'); - await sleep(100); - await click('apply correction'); + Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value') + .set.call(input, 'Foreground'); + input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText'})); + input.blur(); return true; + })()`), 'lane rename editor opens'); + await sleep(180); s = await shot(); - const selectedCel = instances(s).find(n => n.time.at === 0); - const rot = Object.values(selectedCel.channels).find(c => c.over?.length); - assert.equal(rot.over.length, 1); - assert(Math.abs(rot.over[0].values.value - Math.PI / 12) < 1e-9, - 'the inspector converts the authored degree offset to radians'); - assert.equal(s.history.done.length, before.history.done.length + 10); + assert(mainInstances(s).some(n => n.name === 'Foreground'), 'lane name persists'); - // A gap targets its column's lane. This catches the stale-selection bug that - // only appears once a sheet has more than one lane. - await click('timeline'); - assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 5); - await click('lane'); - await click('cel sheet'); - assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 2); - await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2) - .find(c => c.textContent.trim() !== '—')).click()`); - await sleep(100); - await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2) - .find(c => c.textContent.trim() === '—')).click()`); - await sleep(100); - await click('overwrite'); - s = await shot(); - assert(Object.values(s.clip.symbols.main.nodes) - .some(n => n.kind === 'instance' && n.parent !== 'girl' && n.time.at === 0), - 'clicking a gap selects that column before overwrite'); - assert.equal(s.history.done.length, before.history.done.length + 12, - 'correction, lane creation, and overwrite are separate undo steps'); - // Real pointer capture and keyboard events exercise the spreadsheet surface. - const cellAt = async (c, f) => evaluate(`(() => { - const el = document.querySelector('[data-cs-col="${c}"][data-cs-frame="${f}"]'); - el.scrollIntoView({block: 'center'}); - const r = el.getBoundingClientRect(); - return {x: r.x + r.width / 2, y: r.y + r.height / 2}; + // Drag a library symbol into the explicit lane. The row itself is the target; + // no temporary lane is previewed or created. + const drop = await evaluate(`(() => { + const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]'); + const track = [...document.querySelectorAll('.tl-track')].find(t => t.arthurLane); + if (!source || !track) return null; + source.scrollIntoView({block: 'center'}); + const a = source.getBoundingClientRect(), b = track.getBoundingClientRect(); + return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, + tx: b.left + b.width * .085, ty: b.top + b.height / 2}; })()`); - const mouse = (type, p) => send('Input.dispatchMouseEvent', { - type, ...p, button: 'left', buttons: type === 'mouseReleased' ? 0 : 1, clickCount: 1, - }); - const key = async (key, extra = {}) => { - await send('Input.dispatchKeyEvent', {type: 'keyDown', key, ...extra}); - await send('Input.dispatchKeyEvent', {type: 'keyUp', key, ...extra}); - await sleep(120); - }; - const start = await cellAt(0, 0); - await mouse('mousePressed', start); - await mouse('mouseMoved', await cellAt(1, 2)); - await mouse('mouseReleased', await cellAt(1, 2)); - await sleep(150); - assert.equal(await evaluate('document.querySelectorAll(".cs-cell.selected").length'), 6); - await key('c', {modifiers: 2}); - const dest = await cellAt(0, 10); - await mouse('mousePressed', dest); - await mouse('mouseReleased', dest); + assert(drop, 'a pool symbol and explicit lane are available'); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx, y: drop.sy}); + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: drop.sx, y: drop.sy, + button: 'left', buttons: 1, clickCount: 1}); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 12, y: drop.sy, + button: 'left', buttons: 1}); + await sleep(100); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.tx, y: drop.ty, + button: 'left', buttons: 1}); await sleep(120); - const beforePaste = await shot(); - await key('v', {modifiers: 2}); - const pasted = await shot(); - assert.equal(pasted.history.done.length, beforePaste.history.done.length + 1, - 'multi-lane paste is one undo step'); - assert.deepEqual(Object.keys(pasted.clip.symbols), Object.keys(beforePaste.clip.symbols), - 'copy reuses the drawings'); - await key('z', {modifiers: 2}); - assert.deepEqual((await shot()).clip, beforePaste.clip, 'undo restores the entire rectangle'); - await key('ArrowDown', {modifiers: 8}); - assert.equal(await evaluate('document.querySelectorAll(".cs-cell.selected").length'), 2); - const first = await cellAt(0, 0); - await mouse('mousePressed', first); - await mouse('mouseReleased', first); - await sleep(150); - const handle = await evaluate(`(() => { - const r = document.querySelector('.cs-fill-handle').getBoundingClientRect(); - return {x: r.x + r.width / 2, y: r.y + r.height / 2}; + assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0, + 'pool drop does not preview an invented lane'); + assert.equal(await evaluate('document.querySelectorAll(".tl-cel.ghost").length'), 1, + 'pool drop previews inside the existing lane'); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: drop.tx, y: drop.ty, + button: 'left', buttons: 0, clickCount: 1}); + await sleep(300); + s = await shot(); + assert.equal(Object.keys(laneSymbols(s)[0].nodes).length, 1, + `the dropped clip remains in the explicit lane: ${JSON.stringify(s)}`); + assert.equal(laneSymbols(s).length, 1, 'the drop creates no extra lane'); + + // A second explicit lane is a sibling in the open symbol even though the + // first remains aimed. Move the clip between their linear tracks. + await clickNew('lane'); + s = await shot(); + assert.equal(laneSymbols(s).length, 2, 'a second explicit command creates a second lane'); + const move = await evaluate(`(() => { + const tracks = [...document.querySelectorAll('.tl-track')].filter(t => t.arthurLane); + const from = tracks.find(t => t.querySelector('.tl-cel')); + const to = tracks.find(t => t !== from); + const cel = from?.querySelector('.tl-cel'); + if (!cel || !to) return null; + const a = cel.getBoundingClientRect(), b = to.getBoundingClientRect(); + return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, + tx: b.left + b.width * .12, ty: b.top + b.height / 2}; })()`); - const beforeHold = await shot(); - await mouse('mousePressed', handle); - await mouse('mouseMoved', await cellAt(0, 4)); - await mouse('mouseReleased', await cellAt(0, 4)); + assert(move, 'two explicit lanes and a source clip are available'); + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: move.sx, y: move.sy, + button: 'left', buttons: 1, clickCount: 1}); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: move.tx, y: move.ty, + button: 'left', buttons: 1}); await sleep(150); - const afterHold = await shot(); - assert.equal(afterHold.history.done.length, beforeHold.history.done.length + 1, - 'a hold drag commits once'); - assert.equal(instances(afterHold).filter(n => { - const old = instances(beforeHold).find(o => o.id === n.id); - return old && n.span[1] !== old.span[1] && n.time.at + n.span[1] === 5; - }).length, 1, 'the dragged hold ends at the previewed boundary'); - await key('z', {modifiers: 2}); - assert.deepEqual((await shot()).clip, beforeHold.clip); - await key('Delete'); - const cleared = await shot(); - assert.equal(cleared.history.done.length, beforeHold.history.done.length + 1, - 'Delete clears selected frames in one step, without the global node-delete handler'); - assert.equal(cleared.clip.symbols.main.frames, beforeHold.clip.symbols.main.frames); - await key('z', {modifiers: 2}); - assert.deepEqual((await shot()).clip, beforeHold.clip); - await key('x', {modifiers: 2}); - assert.equal((await shot()).history.done.length, beforeHold.history.done.length + 1); - await key('z', {modifiers: 2}); - assert.deepEqual((await shot()).clip, beforeHold.clip, 'cut is independently undoable'); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: move.tx, y: move.ty, + button: 'left', buttons: 0, clickCount: 1}); + await sleep(300); + s = await shot(); + assert.deepEqual(laneSymbols(s).map(x => Object.keys(x.nodes).length).sort(), [0, 1], + 'a clip body moves from one explicit lane to the other'); assert.equal(errors.length, 0, JSON.stringify(errors)); - console.log('PASS: lane commands and corrections agree from timeline and cel sheet; no server writes'); + console.log('PASS: symbols are ordinary; explicit lanes rename, accept drops, and exchange clips'); } finally { - 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); }); + if (ws?.readyState === WebSocket.OPEN) ws.close(); + chrome.kill('SIGTERM'); + await new Promise(resolve => 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}`); + if (error.code !== 'ENOTEMPTY') throw error; } } diff --git a/static/arthur/app.css b/static/arthur/app.css index 3adc3c1..05db3d5 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -228,8 +228,7 @@ input[type="range"] { width: 100%; accent-color: var(--sel); } /* Buttons that are one control: a transport, a stepper, a mode picker. They 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 + a segmented control makes. `.seg` is `.group` with that meaning; both are drawn because the difference is what the buttons do, not how they look. The negative margin collapses the doubled border between two buttons into @@ -252,12 +251,6 @@ button.ico > svg { display: block; width: 11px; height: 11px; } /* Play is the one control in the strip you aim at without looking. */ 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; } @@ -1003,9 +996,13 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } } .tl-label.on { background: var(--sel-bg); } +.tl-label.aimed { box-shadow: inset 0 0 0 2px var(--aim); } .tl-label:hover:not(.on) { background: #fff; } .tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; } .tl-label .kind { color: var(--dim); } +.tl-name-input { min-width: 0; flex: 1; font: inherit; } +.tl-rename { margin-left: auto; padding: 0 3px; border: 0; background: none; color: var(--dim); } +.tl-rename:hover { color: var(--fg); } /* A fixed-width cell whether or not there is a triangle in it, so names at the same depth line up down the column. */ @@ -1087,7 +1084,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } } /* The preview row of a drop in flight: its own length, where it would start. */ -.tl-span.ghost, .tl-label.ghost { pointer-events: none; } +.tl-span.ghost, .tl-label.ghost, .tl-cel.ghost { pointer-events: none; } +.tl-cel.ghost { background: transparent; border: 1px dashed var(--sel); color: var(--sel); } /* A row being dragged over another: into an instance, or grouped with a node, by its middle; in front of it or behind it, by its top or bottom edge. */ @@ -1099,6 +1097,29 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } /* A node's bar slides it along its symbol's time. */ .tl-span.movable { cursor: ew-resize; touch-action: none; } .tl-span.movable.sliding { border-color: var(--sel); } +.tl-edge { + position: absolute; + top: -1px; + bottom: -1px; + width: 7px; + cursor: e-resize; + touch-action: none; + z-index: 2; +} +.tl-edge.out { right: -3px; } +.tl-edge.in { left: -3px; } +.tl-junction { + position: absolute; + top: -1px; + left: 0; + bottom: -1px; + width: 12px; + transform: translateX(-50%); + cursor: col-resize; + touch-action: none; + z-index: 3; +} +.tl-cel-label { display: block; overflow: hidden; text-overflow: ellipsis; pointer-events: none; } .tl-span.ghost { background: transparent; border: 1px dashed var(--sel); @@ -1143,79 +1164,6 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .tl-empty { padding: 9px; color: var(--dim); } -/* The second temporal view. Its cells carry the same selection addresses as - the cel blocks above; only the axes change. */ -.cel-sheet { - flex: 1; - min-height: 0; - overflow: auto; - display: grid; - align-content: start; - background: var(--line); - gap: 1px; -} - -.cs-head, -.cs-frame, -.cs-cell { - min-width: 0; - height: 24px; - border: 0; - border-radius: 0; - padding: 0 6px; - background: #fff; - color: var(--fg); - overflow: hidden; - text-overflow: ellipsis; - white-space: nowrap; -} - -.cs-head { - position: sticky; - top: 0; - z-index: 2; - display: flex; - align-items: center; - background: var(--chrome); - font-weight: 600; - cursor: pointer; -} - -.cs-head.cs-frame { z-index: 3; } -.cs-frame { position: sticky; left: 0; z-index: 1; color: var(--dim); text-align: right; } -.cs-frame.on, .cs-cell.current { box-shadow: inset 3px 0 0 var(--playhead); } -.cs-cell { text-align: left; cursor: pointer; } -.cs-cell:hover { background: var(--sel-bg); } -.cs-cell.selected { background: var(--sel-bg); color: var(--sel); font-weight: 600; } -.cs-head.selected { background: var(--sel-bg); color: var(--sel); } - -/* AIMED COMPOSES WITH SELECTED rather than replacing it: the ring is the aim, - the tint is the selection, and a row that is both wears both. No name tag in - the chrome — the thing the ring is around is already the name. */ -.tl-label.aimed, -.cs-head.aimed { box-shadow: inset 0 0 0 2px var(--aim); } -.cs-head.aimed { color: var(--aim); } - -.cs-empty { - display: grid; - justify-items: center; - align-content: center; - gap: 6px; - padding: 28px 16px; - background: var(--pane); - text-align: center; -} -.cs-empty p { margin: 0; } -.cs-empty .dim { color: var(--dim); font-size: 11px; } -.cs-empty button { margin-top: 4px; } -.cel-sheet { user-select: none; touch-action: none; } -.cs-cell { position: relative; } -.cs-cell:focus-visible { outline: 2px solid var(--sel); outline-offset: -2px; } -.cs-help { padding: 6px 10px; color: var(--dim); font-size: 11px; - white-space: nowrap; overflow: hidden; text-overflow: ellipsis; } -.cs-fill-handle { position: absolute; right: 0; bottom: 0; width: 9px; height: 9px; - background: var(--sel); border: 1px solid white; cursor: ns-resize; z-index: 2; } -.cs-preview { outline: 1px dashed var(--sel); outline-offset: -1px; } /* -------------------------------------------------------------------------- the video -> symbol dialog */ @@ -1323,3 +1271,28 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } letter-spacing: 0.04px; } .paint-overlay:focus { outline: none; } + +/* What a drag in flight would do, beside the pointer: a clip body moves in + time, and with shift it goes inside the clip under the pointer. Said next to + the cursor because that is where the eye already is mid-gesture. */ +.tl-hint { + position: fixed; + z-index: 60; + padding: 2px 6px; + border-radius: 3px; + background: var(--fg); + color: var(--bg); + font-size: 11px; + white-space: nowrap; + pointer-events: none; +} +.tl-hint.nesting { background: var(--sel); color: #fff; } + +/* The clip a shift-drag would nest into. Inset, so it reads as "into this" + rather than as a boundary between rows. */ +.tl-cel.nest-target { outline: 2px solid var(--sel); outline-offset: -2px; } + +/* A row inside a held clip: shown because the node is on screen for the whole + hold, dimmed because its own frames have no place on this ruler. */ +.tl-span.unmapped { opacity: 0.45; cursor: pointer; } +.tl-hint.refusing { background: var(--bad, #b00); color: #fff; }