Compare commits

..

19 commits

Author SHA1 Message Date
Olive Vaughn
eca1a96b82 correction things 2026-10-04 02:47:29 -04:00
Olive Vaughn
064a3d7c19 Cover large timeline keyframe selections in the browser suite 2026-10-04 02:14:02 -04:00
Olive Vaughn
6de71c4c66 Align stage multi-selection modifiers with the timeline 2026-10-04 02:12:06 -04:00
Olive Vaughn
9bc406f413 Show project settings only when the root is selected 2026-10-04 02:12:06 -04:00
Olive Vaughn
1c520e6a68 Add instance playback controls to the inspector 2026-10-04 02:12:06 -04:00
Olive Vaughn
52f25e0bb1 Fix inspector automation clock for looped symbol instances 2026-10-04 02:11:17 -04:00
Olive Vaughn
4d441ae606 Keep overview keyframes passive and edit expanded automation lanes 2026-10-04 02:05:22 -04:00
Olive Vaughn
606055382b Add per-symbol onion skinning controls and cel ghosts 2026-10-04 02:04:00 -04:00
Olive Vaughn
f2fc261221 Fix stage zoom anchoring and continuous passepartout shading 2026-10-04 00:59:08 -04:00
Olive Vaughn
e5b61bfcdd Fix playback stopping when fallback audio ends 2026-10-04 00:58:51 -04:00
Olive Vaughn
ee603a351b Simplify stage passepartout control 2026-10-04 00:49:28 -04:00
Olive Vaughn
981bef98f9 Start playback at the playhead 2026-10-04 00:48:43 -04:00
Olive Vaughn
6df315b73d Pan with trackpad scrolling and zoom with pinch gestures 2026-10-04 00:44:47 -04:00
Olive Vaughn
484b4f1698 Move palette controls to sidebar and expand stage navigation 2026-10-04 00:40:20 -04:00
Olive Vaughn
1ae49a4015 Group tracing layers in the pool and fit new drops to the stage 2026-10-04 00:16:03 -04:00
Olive Vaughn
f4dd047642 Merge master drawing tools with tracing layers 2026-10-04 00:05:16 -04:00
Olive Vaughn
17e1b4f403 Represent tracing media as symbols and add pool thumbnails 2026-10-04 00:02:12 -04:00
Olive Vaughn
353cb6e050 Add remap ink, eraser cuts, and improved brush geometry 2026-10-04 00:00:09 -04:00
Olive Vaughn
1f0b4d9918 Draw with tools: a pen, a brush that makes polygons, and knockouts
One tool at a time, picked from a strip down the left of the stage or by its
letter, as in Photoshop, Illustrator and Flash: V selects and transforms, P is
the pen, B the brush, E the eraser. The options bar above the stage holds the
tool's settings, and the palette is a grid under the tools with the colour a
new shape gets above it, as Deluxe Paint's was.

The pen's draft is filled into the picture as it is drawn, so the edge on
screen is the pixels the shape will be. Click the first point, Enter, Esc or
leaving the pen closes it; the pen stays the tool. Editing a shape's points is
the pen ON that shape — Figma's vector edit mode — so the separate points mode
is gone: click an edge to add a point, ⌥-click one to delete it, on every key
at once so tweens keep meaning something.

The brush paints a mask, and what it will be is shown while painting: the
stroke is traced round its pixel edges, holes and all, and simplified to a
point every so many pixels of outline by the same function the saved shapes
come from. A hole is bridged into the one ring along a whole-pixel row, which
the fill never samples. Blender's Adjust Last Operation re-traces the last
stroke from what it was made of.

A shape coloured CLEAR is a knockout: its symbol is drawn into a layer of its
own and the knockout clears it, every colour or one. The eraser makes one in
the symbol it starts on, of the colour it starts on, or of every colour with
⌥. A click goes through a knockout to what shows. Previews are drawn in the
stacking context of what they will land in.

The polygon's points no longer stay behind when the shape is moved: they were
read off the saved document while the box handles read the one mid-drag.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-03 22:43:28 -04:00
83 changed files with 5789 additions and 1272 deletions

View file

@ -161,6 +161,17 @@ def _extract_stills(job, proxy_path, frames_dir, frames, root):
MAX_RATE = 120 # a capture rate; past this the container is describing something else MAX_RATE = 120 # a capture rate; past this the container is describing something else
def probe_image(path):
"""An uploaded still's pixel size as (width, height), refusing anything that
is not one picture."""
data = json.loads(_command(["ffprobe", "-v", "error", "-show_streams",
"-of", "json", str(path)]))
video = [s for s in data.get("streams", []) if s.get("codec_type") == "video"]
if len(video) != 1 or not (video[0].get("width") and video[0].get("height")):
raise ValueError("the uploaded file is not an image")
return int(video[0]["width"]), int(video[0]["height"])
def probe_audio(path): def probe_audio(path):
"""The length of an uploaded sound in seconds, refusing a file with no audio.""" """The length of an uploaded sound in seconds, refusing a file with no audio."""
data = json.loads(_command(["ffprobe", "-v", "error", "-show_streams", data = json.loads(_command(["ffprobe", "-v", "error", "-show_streams",

View file

@ -0,0 +1,48 @@
"""Schema 6: tracing is a symbol.
A face's `:head :trace` is gone: its footage is a placement of a `:type :trace`
symbol under the head, the trace keys are that placement's `:time :holds`, and the
head follows them with `:reads`. Nothing is converted. Every project is marked 6,
and one that still carries a `:trace` is refused when it is opened, by name and
with what to do about it; the rest open as they did.
Images are stills to trace over, stored like sounds.
"""
import uuid
from django.db import migrations, models
import django.db.models.deletion
def forwards(apps, schema_editor):
apps.get_model("clips", "Project").objects.update(schema_version=6)
class Migration(migrations.Migration):
dependencies = [("clips", "0014_multiple_analyses")]
operations = [
migrations.CreateModel(
name="Image",
fields=[
("id", models.UUIDField(default=uuid.uuid4, editable=False,
primary_key=True, serialize=False)),
("filename", models.CharField(max_length=255)),
("label", models.CharField(
blank=True, max_length=200,
help_text="what a person called it; the filename when empty")),
("width", models.PositiveIntegerField(help_text="pixels, as ffprobe reports them")),
("height", models.PositiveIntegerField()),
("created", models.DateTimeField(auto_now_add=True)),
("blob", models.ForeignKey(on_delete=django.db.models.deletion.PROTECT,
related_name="image_for", to="clips.blob")),
],
),
migrations.AlterField(
model_name="project",
name="schema_version",
field=models.PositiveIntegerField(default=6),
),
migrations.RunPython(forwards, migrations.RunPython.noop),
]

View file

@ -70,6 +70,21 @@ class Sound(models.Model):
created = models.DateTimeField(auto_now_add=True) created = models.DateTimeField(auto_now_add=True)
class Image(models.Model):
"""An uploaded still — a drawing, a photo, a model sheet — kept as uploaded, to
be traced over. Never part of the picture: a document names its blob as a
tracing symbol's `:media`, and the page draws it over the stage."""
id = models.UUIDField(primary_key=True, default=uuid.uuid4, editable=False)
blob = models.ForeignKey(Blob, on_delete=models.PROTECT, related_name="image_for")
filename = models.CharField(max_length=255)
label = models.CharField(max_length=200, blank=True,
help_text="what a person called it; the filename when empty")
width = models.PositiveIntegerField(help_text="pixels, as ffprobe reports them")
height = models.PositiveIntegerField()
created = models.DateTimeField(auto_now_add=True)
class Extraction(models.Model): class Extraction(models.Model):
"""One requested decode of a source into immutable footage.""" """One requested decode of a source into immutable footage."""
@ -235,7 +250,7 @@ class Project(models.Model):
settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects", settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects",
) )
name = models.CharField(max_length=200, default="untitled") name = models.CharField(max_length=200, default="untitled")
schema_version = models.PositiveIntegerField(default=5) schema_version = models.PositiveIntegerField(default=6)
seq = models.PositiveBigIntegerField(default=0) seq = models.PositiveBigIntegerField(default=0)
palette = models.CharField(max_length=64, default="arthur/default") palette = models.CharField(max_length=64, default="arthur/default")
created = models.DateTimeField(auto_now_add=True) created = models.DateTimeField(auto_now_add=True)

View file

@ -34,7 +34,7 @@ from django.core.management import call_command
from django.test import TestCase, override_settings from django.test import TestCase, override_settings
from clips import blobs, extraction from clips import blobs, extraction
from clips.models import Analysis, Block, Blob, Clip, Footage, Leaf, Project, Revision, Sound, Source from clips.models import Analysis, Block, Blob, Clip, Footage, Image, Leaf, Project, Revision, Sound, Source
BLOB_DIR = tempfile.mkdtemp(prefix="arthur-test-blobs-") BLOB_DIR = tempfile.mkdtemp(prefix="arthur-test-blobs-")
@ -446,7 +446,7 @@ class DocumentTests(TestCase):
self.assertEqual(5, len(response.json()["written"])) self.assertEqual(5, len(response.json()["written"]))
loaded = self.client.get(f"/api/projects/{self.project.id}").json() loaded = self.client.get(f"/api/projects/{self.project.id}").json()
self.assertEqual(5, loaded["schema_version"]) self.assertEqual(6, loaded["schema_version"])
self.assertEqual(1, len(loaded["clips"])) self.assertEqual(1, len(loaded["clips"]))
clip = loaded["clips"][0] clip = loaded["clips"][0]
self.assertEqual("c1", clip["cid"]) self.assertEqual("c1", clip["cid"])
@ -828,6 +828,32 @@ class UploadTests(TestCase):
self.assertEqual(200, again.status_code) self.assertEqual(200, again.status_code)
self.assertEqual(1, Sound.objects.count()) self.assertEqual(1, Sound.objects.count())
def test_an_uploaded_still_is_an_image_named_by_its_bytes(self):
payload = png(17, 5)
uploaded = self.client.post("/api/images", {
"file": SimpleUploadedFile("sheet.png", payload, content_type="image/png")})
self.assertEqual(201, uploaded.status_code, uploaded.content)
image = uploaded.json()
self.assertEqual(("sheet.png", 17, 5), (image["label"], image["width"], image["height"]))
self.assertEqual(f"/blob/{image['digest']}", image["url"])
self.assertEqual(payload, b"".join(self.client.get(image["url"]).streaming_content))
self.assertEqual([image], self.client.get("/api/images").json()["images"])
again = self.client.post("/api/images", {
"file": SimpleUploadedFile("again.png", payload, content_type="image/png")})
self.assertEqual(200, again.status_code)
self.assertEqual(1, Image.objects.count())
renamed = self.client.patch(f"/api/images/{image['id']}",
json.dumps({"label": "model sheet"}),
content_type="application/json")
self.assertEqual("model sheet", renamed.json()["label"])
def test_a_file_that_is_not_a_picture_is_not_an_image(self):
refused = self.client.post("/api/images", {
"file": SimpleUploadedFile("notes.txt", b"not a picture", content_type="text/plain")})
self.assertEqual(400, refused.status_code)
def test_a_file_without_audio_is_not_a_sound(self): def test_a_file_without_audio_is_not_a_sound(self):
refused = self.client.post("/api/sounds", { refused = self.client.post("/api/sounds", {
"file": SimpleUploadedFile("notes.txt", b"not audio", content_type="text/plain")}) "file": SimpleUploadedFile("notes.txt", b"not audio", content_type="text/plain")})

View file

@ -24,6 +24,8 @@ urlpatterns = [
path("sources", views.sources), path("sources", views.sources),
path("sounds", views.sounds), path("sounds", views.sounds),
path("sounds/<uuid:sound_id>", views.sound_detail), path("sounds/<uuid:sound_id>", views.sound_detail),
path("images", views.images),
path("images/<uuid:image_id>", views.image_detail),
path("extractions", views.extractions), path("extractions", views.extractions),
path("extractions/<str:key>", views.extraction_detail), path("extractions/<str:key>", views.extraction_detail),
path("footage", views.footage_list), path("footage", views.footage_list),

View file

@ -43,7 +43,7 @@ from django.views.decorators.http import require_http_methods
from . import blobs, extraction from . import blobs, extraction
from .consumers import broadcast from .consumers import broadcast
from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Sound, Source from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Image, Leaf, Project, Revision, Sound, Source
KEY_LENGTH = 71 # "sha256:" + 64 hex KEY_LENGTH = 71 # "sha256:" + 64 hex
@ -287,6 +287,50 @@ def sound_detail(request, sound_id):
return JsonResponse(_sound_json(row)) return JsonResponse(_sound_json(row))
def _image_json(row):
return {"id": str(row.id), "label": row.label or row.filename,
"filename": row.filename, "width": row.width, "height": row.height,
"digest": row.blob_id, "url": f"/blob/{row.blob_id}"}
@require_http_methods(["GET", "POST"])
def images(request):
"""Stills to trace over. The document names one by its blob digest, so an
image is the same picture in every project that uses it."""
if request.method == "GET":
return JsonResponse({"images": [_image_json(row)
for row in Image.objects.order_by("-created")]})
upload = request.FILES.get("file")
if upload is None:
return JsonResponse({"error": "upload an image as the file field"}, status=400)
try:
digest, size = blobs.write_stream(upload.chunks())
width, height = extraction.probe_image(blobs.path_for(digest))
blob, _ = Blob.objects.get_or_create(
digest=digest, defaults={"size": size,
"media_type": upload.content_type or "image/png"})
row, created = Image.objects.get_or_create(
blob=blob, defaults={"filename": Path(upload.name).name[:255],
"width": width, "height": height})
return JsonResponse(_image_json(row), status=201 if created else 200)
except (ValueError, OSError) as exc:
return JsonResponse({"error": str(exc)}, status=400)
@require_http_methods(["GET", "PATCH"])
def image_detail(request, image_id):
try:
row = Image.objects.get(id=image_id)
except Image.DoesNotExist:
return JsonResponse({"error": "no such image"}, status=404)
try:
if request.method == "PATCH":
row = _relabel(request, row)
except Bad as exc:
return _error(exc)
return JsonResponse(_image_json(row))
def _extraction_json(row): def _extraction_json(row):
return {"key": row.key, "source": str(row.source_id), "state": row.state, return {"key": row.key, "source": str(row.source_id), "state": row.state,
"progress": row.progress, "error": row.error, "progress": row.progress, "error": row.error,

View file

@ -605,28 +605,26 @@ dense geometry. A topology setting cannot be treated as a per-frame gain curve.
The op list is the boundary with stage 7 in `docs/architecture.md`: the The op list is the boundary with stage 7 in `docs/architecture.md`: the
rasteriser takes ops and knows nothing about nodes, channels or time. rasteriser takes ops and knows nothing about nodes, channels or time.
**A photographic underlay is not an op.** The registered source frame that an **A tracing layer is an op that never reaches the raster.** Footage or a still
animator traces over is a reference, not output, and it may not enter the indexed to draw over is a symbol with `:type :trace` and a `:media`, placed by an ordinary
buffer — the same rule `docs/architecture.md` already sets for handles and instance — so it is moved, scaled, trimmed, held and put in a lane like anything
vertex boxes. It is a `drawImage` at an affine on a separate canvas, which clips else — and it resolves to one `:trace` op: `{:kind :trace :node :layer :media
at the canvas edge for free, and the only thing it needs from the model is the :frame :size :m}`. The raster refuses that kind, the player hands it to a
world transform of the node it rides: `drawImage` on a separate canvas over the picture, and `clip/resolver` makes one
only when asked with `:tracing?`, which only the stage does. An export, a
symbol's centre and a thumbnail never ask, so a reference cannot reach the
picture by any path that forgets to filter it. See `docs/tracing-symbol-plan.md`.
```clojure A face's footage is one of these, placed as `:plate` under `:head` with the
(world-of resolver :head) ;; -> Float64Array[6] anchor fit itself as its measured transform — the inverse of the head's, over
``` image height. Its world is `head · fit · 1/H`, so on a frame where the head and
the plate read the same measured frame the two cancel and the photo sits where
the face was filmed; on any other frame it rides the head. Registration is the
ordinary walk, not a matrix built beside it.
Composed with image-pixels-to-local — **both axes divided by `imgH`**, never by Which frame it shows is the placement's: `:time {:holds [...]}` holds it on
their own dimension — the photo is registered with the shapes by construction, chosen frames, and a head with `:reads {:holds-of :plate}` jumps to the same
and an unregistered underlay is merely decorative. The tracing editor chooses ones. Whether it is showing at all is the editor's, `[:ui :tracing]`.
which source frame to show under a cel. That reference choice is independent of
the finished picture fps and does not change the dense analysis track. A cel can
therefore use any useful source frame as its drawing reference, even when that
frame is not one of the displayed picture poses.
A photo that has to sit *between* two drawn layers is the case that would make it
a `:bitmap` node with an op of its own. Nothing wants that yet: a reference is
either under everything or over everything at low alpha.
### Making it fast in CLJS ### Making it fast in CLJS
@ -680,8 +678,8 @@ Proof that it covers what exists, not just what is wanted:
| brow ring + quantised raise | node `:brow-r`, `[:geom :pts]` dense (the traced ring with height removed), `[:xform :pos]` dense (the quantised raise). **The decomposition design.md insists on is two channels.** | | brow ring + quantised raise | node `:brow-r`, `[:geom :pts]` dense (the traced ring with height removed), `[:xform :pos]` dense (the quantised raise). **The decomposition design.md insists on is two channels.** |
| head plate, kept frames | node `:head`, `:symbol` per instance, keys on `[:symbol]` at kept frames | | head plate, kept frames | node `:head`, `:symbol` per instance, keys on `[:symbol]` at kept frames |
| `makeXform` face-oval crop | **gone.** Placement is `[:xform :*]` on the face's own `:place`; the stage clips | | `makeXform` face-oval crop | **gone.** Placement is `[:xform :*]` on the face's own `:place`; the stage clips |
| `stabilize` transforms | dense `[:xform :*]` on `:head`, read through its optional `:anchors` map | | `stabilize` transforms | dense `[:xform :*]` on `:head` (the inverse fit) and on its `:plate` (the fit), read where `:reads` and `:time :holds` say |
| registered underlay | not data — a UI layer riding `(world-of resolver :head)` | | registered underlay | the face's `:plate`, an instance of the footage's tracing symbol under `:head`; a `:trace` op the raster never sees |
| painted background cel | node per layer, `[:geom :pts]` **framed**, `[:style :color]` framed | | painted background cel | node per layer, `[:geom :pts]` **framed**, `[:style :color]` framed |
| `mouth lead` | `:time {:offset k}` on performance nodes only | | `mouth lead` | `:time {:offset k}` on performance nodes only |
| `exposure` | `:time {:expose n}` on the clip root, inherited | | `exposure` | `:time {:expose n}` on the clip root, inherited |

View file

@ -1,5 +1,11 @@
# Frame selection # Frame selection
> Since `docs/tracing-symbol-plan.md`: `domain/trace` is gone. Trace keys are
> the face's `:plate` placement's `:time :holds`, the origin is the head's
> `:reads`, and the photo's registration is the plate's own measured channels.
> Where this document names `trace/measured-local` or `trace/prepare`, read the
> plate's or the head's measured channels and `node/hold`.
Two mechanisms. One vocabulary. An earlier draft of this document claimed they Two mechanisms. One vocabulary. An earlier draft of this document claimed they
were one component used twice — because `suggestPlateFrames` in the old were one component used twice — because `suggestPlateFrames` in the old
`js/pipeline.js` and the never-built "performance poses" of `js/pipeline.js` and the never-built "performance poses" of
@ -21,7 +27,7 @@ This document is how the picture gets an opinion.
holding the latest one at or before now.** holding the latest one at or before now.**
The holding half already exists and is already shared: `pose/held-frame` is called The holding half already exists and is already shared: `pose/held-frame` is called
by `trace/held-frame` and by `pose/source-frame`, which is the two sites agreeing by `node/hold` (a placement's `:time :holds`) and by `pose/source-frame`, which is the two sites agreeing
about reading. The hand half is shared too — see *Three layers* below. Choosing is about reading. The hand half is shared too — see *Three layers* below. Choosing is
what differs. what differs.
@ -32,9 +38,9 @@ what differs.
| signal | the measured head's motion | — none; a stored cut | | signal | the measured head's motion | — none; a stored cut |
| the baseline it improves on | drawing on 2s | the cadence, or the exposure grid | | the baseline it improves on | drawing on 2s | the cadence, or the exposure grid |
| the shape of the answer | a non-uniform set out of dense | the same grid, nudged | | the shape of the answer | a non-uniform set out of dense | the same grid, nudged |
| lives on | the face's `:head` `:trace` | the instance's `:playback :tracks` | | lives on | the face's `:plate` `:time :holds` | the instance's `:playback :tracks` |
| hand edit today | `trace/toggle-frame` | `pose/put-cut` / `pose/remove-cut` | | hand edit today | `::project/toggle-hold` | `pose/put-cut` / `pose/remove-cut` |
| UI today | `params/trace-keys` | **none** | | UI today | `params/layer-section` | **none** |
| proposes today | **nothing** | **nothing** | | proposes today | **nothing** | **nothing** |
## Why they are not one function ## Why they are not one function
@ -97,7 +103,7 @@ implementation for both. A preserve mark *is* a keep.
### Materialise the result, do not derive it on the render path ### Materialise the result, do not derive it on the render path
The effective set is written back to where each site already reads it — The effective set is written back to where each site already reads it —
`:trace :frames`, or the pose track — so that every existing reader is untouched the plate's `:time :holds`, or the pose track — so that every existing reader is untouched
and nothing on the per-frame path has to open a dense block. Proposing is a and nothing on the per-frame path has to open a dense block. Proposing is a
command, not a subscription. `ch/value-at` allocates per call and says so; that command, not a subscription. `ch/value-at` allocates per call and says so; that
is fine for a button press over a few hundred frames and would not be fine at is fine for a button press over a few hundred frames and would not be fine at
@ -349,7 +355,7 @@ against anything.
### Between the kept frames is a third shared field ### Between the kept frames is a third shared field
`:trace :origin` is not a tracing setting. It is the answer to *what happens The head's `:reads` (once `:trace :origin`) is not a tracing setting. It is the answer to *what happens
between kept frames*, and the plate selection has to answer it: between kept frames*, and the plate selection has to answer it:
- `:continuous` — ignore the selection for this purpose and read the frame you - `:continuous` — ignore the selection for this purpose and read the frame you
@ -430,7 +436,7 @@ Render it in two sections:
invariant from *The upgrade path* here, since this is the first place a real invariant from *The upgrade path* here, since this is the first place a real
signal exists to assert it over. signal exists to assert it over.
4. **Storage for the plate selection.** `:policy`/`:keep`/`:drop` beside 4. **Storage for the plate selection.** `:policy`/`:keep`/`:drop` beside
`:trace :frames`. Extend `leaf/leaves` and the key whitelists in the same the plate's `:time :holds`. Extend `leaf/leaves` and the key whitelists in the same
commit — a field without a leaf saves silently and comes back missing, which commit — a field without a leaf saves silently and comes back missing, which
is the one bug persistence must not be able to have. Round-trip test. is the one bug persistence must not be able to have. Round-trip test.
5. **Re-suggest preserves hand decisions.** Propose at one tolerance, pin a frame, 5. **Re-suggest preserves hand decisions.** Propose at one tolerance, pin a frame,

View file

@ -84,8 +84,8 @@ candidate poses so stage cuts can still select any of them.
| --- | --- | --- | | --- | --- | --- |
| Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work | | Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work |
| Head anchor map | `:head` node | Implemented, stored with the node | | Head anchor map | `:head` node | Implemented, stored with the node |
| Trace frames (photo address) and origin | Face symbol's `:head` `:trace`, written through `:anchors` | Implemented, see `domain/trace` | | Trace frames (photo address) and origin | The face's `:plate` `:time :holds`, and its `:head` `:reads` | Implemented, see `docs/tracing-symbol-plan.md` |
| Showing the tracing photo, and its opacity | Face instance's `:underlay` | Implemented; a drawing aid, not keyed | | Showing a tracing layer, and its opacity | Editor state, `[:ui :tracing]` | Implemented; a drawing aid, never saved or keyed |
| Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work | | Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work |
| Stage pose cuts | Symbol instance | Implemented, stored with the instance | | Stage pose cuts | Symbol instance | Implemented, stored with the instance |

411
docs/tracing-symbol-plan.md Normal file
View file

@ -0,0 +1,411 @@
# Plan: tracing is a symbol
Status: built, 2026-10-03, on branch `worktree-tracing-layers`. Where the build
differs from the plan below, the build wins:
- The head's field is `:reads` (`{:holds [...]}` or `{:holds-of :plate}`), not
`:follow`.
- A still is not one frame. It gets as many frames as remain in the symbol it is
dropped into, at that symbol's rate, and is trimmed like any clip.
- An image's `:media` is `{:image <blob sha256>}`, served at `/blob/<sha>`. The
server's `Image` row exists for the pool's list and labels, not for identity.
- Dropping media that a tracing symbol in the document already shows reuses that
symbol.
- Nothing can be created or dropped inside a tracing symbol (`creation/target`,
`drop-destination-at`, `nest/move-refusal`), and one cannot be opened in a tab.
- Schema 6. Every project is marked 6. One that still carries `:trace` on a
node is refused when opened, with what to do about it, rather than all old
projects being refused.
No backward compatibility (see `lane-model.md`, "Goal and compatibility policy").
## What is wrong today
Tracing is not a thing in the document. It is three mechanisms that each know
about faces:
- **`:trace {:frames :origin}` on a face's `:head`.** It decides which measured
frame the head reads (`symbol/base-channel-frame` → `trace/held-frame`), and
the underlay also reads it to decide which photo to show (`trace/photo-frame`).
- **`ui/underlay`**, a painter that walks `trace/shown` → `trace/faces` (a
separate instance walk), looks up each face's subject → analysis → footage,
asks the resolver where `[...path :head]` went, and builds the photo's matrix
by hand: `world(head) · M(p)⁻¹ · 1/imageH` (`trace/photo-matrix`).
- **`[:ui :trace {:faces #{} :opacity}]`**, a per-face switch in editor state,
plus the special "opening a face shows its footage, opening a take does not"
rule (`trace/showing-for`).
What you cannot do: place footage or a still as a reference where you like, move
it, scale it, turn it, trim it, hold it, put it in a lane, or trace something
that is not a tracked face. The photo is not selectable and has no row. The one
case that works (a face over its own footage) runs on code that nothing else
uses.
## The model in one paragraph
A **tracing symbol** is a symbol with `:type :trace`. It has no nodes. It names
media (a footage range or a still image) and has that media's frame count, fps and
pixel size. It is **placed by an ordinary instance**, so lanes, spans, trim,
split, move, playback (`:in :speed :end`), transform, nesting, selection, picking
and gestures all work on it with no new code. It is evaluated to a single
**`:trace` op**, which never reaches the raster or an export. A face's footage is
not a special case. It is one of these instances, placed inside the face as a
child of `:head` and carrying the measured registration transform. The trace keys
become **holds on that instance's time**. The head's "origin" becomes the head
saying **which node's frames it follows**.
This follows the precedent of `:type :palette` symbols (no nodes, they name an
asset, and they are placed by instances in a lane), so the uniformity rule holds
(see the `model-uniformity` memory). Nothing new holds nodes, and no special
instance kind is added.
## Data model
### The tracing symbol
```clojure
:footage-8625 ; a symbol id like any other
{:id :footage-8625 :name "8625.mov"
:type :trace
:media {:footage #uuid "f8ca…" :range [12 241]} ; or {:image "sha256:…"}
:frames 229 ; the range's length; 1 for a still
:fps 30 ; the footage's own rate, so cadence handles 30→12 for free
:width 1440 :height 1920 ; pixel size = the symbol's own stage
:audio {:footage #uuid "f8ca…"} ; optional, the existing "a symbol says what it sounds like"
:nodes {}}
```
- `:media` is the one new symbol key. Add it to `symbol/symbol-keys` and to the
symbol leaf's `select-keys` in `leaf/leaves`.
- The symbol's local space is **pixels of the media**: `[0 w) × [0 h)`.
`clip/center` of a node-less symbol already returns its stage middle, which here
is `[w/2 h/2]`. So `place-symbol` puts the anchor at the image centre with no
new code.
- `symbol/problems`: `:type :trace` needs `:media` with exactly one of
`:footage`/`:image`, needs `(empty? nodes)`, and for footage needs
`(= frames (- end start))`.
- **One tracing symbol per footage range, shared.** Two faces from one take
place the same symbol, and so does a hand-placed reference. Like any symbol it
is reused by reference, and `bring/symbols` copies it like any other.
### Placing it
It is an ordinary `:kind :instance` with `:source {:symbol :footage-8625}`:
- **Start and end** are `:span` (in its own frames) and `:time :at`. You get
these from the existing trim, split, move and roll.
- **Which frame shows** comes from `:playback {:in :speed :end}`. Footage plays
with speed 1, a frozen frame has speed 0, and a still is 1 frame with `:end :hold`.
- **Placement in space** is `[:xform …]`, the same as every node: gestures,
inspector and keys.
- **In a lane, or on its own**: it is a parent-less spanned node, so a `:display
:lane` symbol draws it as a block like any cel. It can also sit as a free node
or under a group. To have a reference with its own tab, wrap it in an ordinary
symbol.
**Default on creation** (in the drop event, not in `place-symbol`): scale so the
image's height fits the stage height, centred on the drop point. This is a
creation default like "use center anchor when dropping", and nothing updates it
afterwards.
### Holds: the one new time feature
`:time {:holds [0 12 30]}` floors a node's local frame to the last hold at or
before it. Before the first hold, the first hold applies. This is `:expose`
generalized from a regular grid to authored frames. It is applied in
`node/local-frame` at the same point as `:expose`, and is inherited in the same
way. It is in the node's **own** frames. On a tracing instance with
`:in 0 :speed 1`, own frames are source frames, so the hold list is the set of
traced frames.
It is general on purpose. Holding a playing symbol on chosen drawings is the
same feature. It costs about three lines in `local-frame`, one `problems` clause
(sorted, distinct, finite), and the timeline drawing hold frames as marks on the
row.
`symbol/frame-map` refuses floors (`:expose > 1`). It must also refuse a
non-empty `:holds`, for the same reason.
## The face: "a child symbol that represents the trace"
The face symbol after a freeze:
```
:place group authored source→stage mapping (image heights → stage px)
:head group measured M(p) :reads — see below
:mouth … parts generated, every frame
:plate instance of :footage-8625 ← the trace
measured channels: fit(p) = M(p)⁻¹ · S(1/imageH)
:time {:holds [0 12 30]} ← the trace keys
```
### Registration comes from the parent
The plate is a child of `:head`. Its own measured channels are the
**stabilizing fit** at frame p: the inverse of the head's measured transform,
with pixels → image heights folded into the scale (it stays a similarity, so it
decomposes into `pos`/`rot`/`scale`). Freeze already computes the fit; the
head's measured channels are its inverse (`freeze/invert`). The plate gets a
second dense block, which is three small channels.
Because holds are a **time** floor, the plate's channels and the frame its
content shows are read at the **same** held frame q. Its world transform is:
```
world(plate) = place · M(p_head) · M(q)⁻¹ · S(1/H)
```
That is exactly `trace/photo-matrix`, but now it falls out of the ordinary walk.
It is registered to whatever the head is doing, by construction:
| head reads (p_head) | plate shows (q) | result |
| --- | --- | --- |
| f (continuous) | f (no holds) | footage where filmed |
| f (continuous) | held key | held photo rides the moving head (today's behaviour) |
| held key (same as plate) | held key | `M(q)·M(q)⁻¹ = I`: photo sits where filmed |
| 0 (start) | f or held | stabilized footage under a still head |
If a frame has no measurement, the plate's dense channel has nothing there, so
`xform-at` gives nil, so the plate is not placed and no photo shows. That is what
happens today too.
### Trace keys versus origin: who owns what
The two decisions are separate and stay separate:
- **Trace keys** are which footage frames get drawn over (the "plate drawings"
in `frame-selection.md`). They belong to the **plate**, as `:time :holds`. A
hand-placed tracing layer with holds is the *same thing*: the face's plate is
an ordinary tracing placement and nothing more.
- **Origin** is how the head moves between kept frames. `frame-selection.md`
already says `:origin` "is not a tracing setting" but a performance one, so it
belongs to the **head**:
```clojure
:head {…} ; continuous — reads its own frame
:head {… :reads {:holds [0]}} ; start
:head {… :reads {:holds-of :plate}} ; at keys — reads its measured channels at
; the frames :plate's holds select
```
`{:holds [...]}` is also what a face with no footage uses for "at keys", since it
has no plate to follow.
`:reads` changes only the **head's own channel reads**, not its children's
frames. The parts must keep running every frame, which is why this cannot be a
`:time` hold on the head. It is today's `traces` branch of
`base-channel-frame` with the hold list read from the named node. A node
reference has precedent (`:stencil`, `:pose-group`). It points from the follower
to the thing followed, so there is still one stored list of frames and nothing to
keep in sync. Validate it in `symbol/problems` the way `:stencil` is validated:
the target exists in the symbol, and it is not the head itself or an ancestor of
the head.
Rejected alternatives, so they are not re-proposed:
- **Keys on the head, and the plate reads them.** This is today's direction. It
makes the plate special: a free tracing layer could not have keys that a face's
plate also understands.
- **Hold `:time` on `:head`.** Exposure inherits strictly, so the mouth and eyes
would freeze along with the head.
- **A wrapper "registered footage" symbol holding the fit.** It is correct but
adds a symbol per face. The time-floor holds already put the fit read and the
content read on the same frame, so the wrapper buys nothing.
- **Plate as a sibling of `:head` at identity.** It is only registered when the
head and the photo read the same frame, so it breaks the continuous-plus-holds
and start rows above.
## Evaluation: an op that is never rendered
- **`clip/resolver`**, in the instance branch: when the source symbol has
`:type :trace`, it does not recurse. If `(:tracing? opts)` is set, it emits one op:
```clojure
{:kind :trace :node [id] :m <copy of world> :media … :frame shown-frame :size [w h]}
```
The frame comes from the same `placed-frame` path as any instance, so playback,
holds and the fps cadence apply. Do not build a child resolver for a trace
symbol.
- **`transform-op`** gets a `:trace` case that composes the matrix. Row paths,
solo filtering and nesting at any depth then work for free.
- **The output guarantee is structural.** `:tracing?` defaults to false. Only the
stage's `::render/resolver` passes true. Export, `clip/center` (a big photo
must not pull a symbol's pivot), thumbnails and the bench never ask for trace
ops. `raster/draw-ops!` keeps throwing on unknown kinds, so a leak fails loudly.
- **`ui/player`** sends picture ops to the raster and `:trace` ops to the
painter.
- **`ui/underlay` becomes `ui/tracing`.** It paints `:trace` ops in draw order
with `drawImage` at `op.m` and the global opacity. The media URL is the footage
manifest's `urls[range-start + frame]`, or the image blob URL. The three
steadiness fixes stay: LRU cache, hold the last still per op `:node`, and read
ahead while playing. Everything that walked faces is deleted.
- **`pick`**: a `:trace` op is hit when the point, mapped through `m⁻¹`, falls in
`[0 w) × [0 h)`. Picture ops are tested first and trace ops only if nothing
drawn is under the pointer, so a full-frame photo does not steal every click.
When the global switch is off, traces are neither painted nor picked.
- **Gestures**: no change. The face's plate is measured, so `gesture/refusal`
already says "place the instance it is in". A hand-placed layer is authored and
moves, turns and scales like anything else.
## On and off
All of it is EDITOR STATE, as ed88c5e decided for the per-face switch: showing
a reference is a way of looking at the stage, so it is not an undo step, does not
travel to collaborators, and cannot reach an export.
```clojure
[:ui :tracing {:on? true :opacity 0.5 :hidden #{[sid node-id] …}}]
```
- **One layer** is an entry in `:hidden`, keyed by the symbol the tracing
instance is in and its node id. The symbol id is needed because every face's
plate is called `:plate`. Keyed this way, hiding a face's plate hides it in
every placement of that face, which is what the per-face switch did. Shown is
the default, so opening a face shows its footage with no setup.
- **How it's applied**: `clip/resolver` already knows which symbol and node a
trace op comes from, so the op carries `:layer [sid id]`. The painter and
`pick` skip ops whose layer is hidden. The resolver does not change when you
toggle a layer, so nothing is rebuilt.
- **Global**: `:on?` and `:opacity`, a toggle plus an opacity slider in
`ui/palette/bar` next to the palette controls. When it is off, traces are
neither painted nor picked.
- **Switching one layer on also switches the global setting on.** This applies
from the tracing instance's inspector, from its timeline row, and from the
face/roto section. A layer you just enabled must not stay invisible behind a
switch you forgot. Turning one layer off never touches the global switch. It is
one event (`::ui/show-trace layer on?`) that updates `:hidden` and, when
turning on, sets `:on? true` in the same handler, so the three places cannot
behave differently.
- **`[:vis]`** still works on a tracing instance like on any node: key it to
show a reference only over part of the shot. It is not the on/off switch.
- **Deleted**: `[:ui :trace :faces]`, `::trace-face`, `::trace-faces`,
`trace/showing-for`, `traceable-faces`, `shown`, `faces`, and the "a take shows
nothing by default" rule.
## UI
- **Timeline.** A tracing instance is an ordinary row or clip block, styled to
read as reference-only (hatched block, an eye icon in place of the colour
chip). Hold frames are marks on the row. The row's eye button dispatches
`::ui/show-trace`, which replaces the face row's `tl-trace` button.
- **Inspector, tracing instance.** Show the media (footage name and range, or
image), an on/off control (which goes through `::ui/show-trace`), and the hold
list ("hold here" / "remove hold" plus seek buttons, which is `trace-keys`
re-aimed at `:time :holds`). Playback, transform and span use the existing
sections.
- **Inspector, face/roto section.** The same hold controls, aimed at the face's
`:plate`. Origin buttons write `:head :reads`. The section is found by "this
face has a `:plate`", not by `trace/traceable?`.
- **Palette bar.** The global toggle and opacity slider.
- **Making one.**
- Footage: the convert dialog gets a choice between "animate faces" (today's
flow) and "tracing layer" (no detection). The tracing-layer choice makes the
`:type :trace` symbol for the chosen range and places it where the video was
dropped.
- Footage can also be dragged from the pool with a modifier or as a second
drag kind.
- A still image: drop it on the pool and it uploads; drop it on the stage or
timeline and it is placed with `:end :hold` and a span of the host's
remaining frames.
## Freeze, bring, regenerate
- **`freeze/subject-part`** emits the `:plate` instance under `:head`, with fit
measured channels and `:time {:holds []}`, and emits one `:type :trace` symbol
for the analysed footage range. `bring/take` already copies every symbol the
take reaches and rewrites `:source :symbol` references, so the tracing symbol
comes along. It gets the footage's `:audio` too, so a dropped tracing layer
can bring its sound through the existing link.
- **`head-mode`** writes `:reads` on the head and `:holds` on the plate, in
place of `:trace`. The `frame-selection.md` plate proposal materializes into the
plate's `:time :holds` in place of `:trace :frames`.
- **Regenerate** replaces both measured blocks (head and plate) and keeps
`:holds` and `:reads`. Check that `regenerate-head`'s measured/authored
comparison handles a second measured node.
## Server
- `Image` endpoints mirroring `Sound`: `POST /api/images` stores a `Blob` and
returns `{id, width, height, url}`, and `GET /api/images` lists them. The
migration is a model only. Bump `schema_version` and refuse older documents
clearly. Do not convert them.
## Deleted outright
`trace/of`, `prepare`, `held-frame`, `problems`, `toggle-frame`, `photo-frame`,
`measured-local`, `photo-matrix`, `traceable?`, `faces`, `traceable-faces`,
`showing-for`, `shown`, `opacity-default`. `domain/trace.cljs` probably goes
away entirely; if anything is left, it is a hold helper that belongs in `node`.
Also deleted: `symbol/prepared-traces` and the `traces` arm of
`base-channel-frame`, which becomes the `:reads` lookup. `:trace` on nodes (and
`symbol/problems` reports it as removed). `::project/set-trace`.
`::render/underlay` and `::render/tracing` become one `::render/tracing` that
returns `[:ui :tracing]`. The face lookup in `params/view`.
Expected effect on code size: net negative. One time-floor clause, one op kind,
one resolver branch, one pick case and a `:reads` lookup replace the face walk,
the hand-built photo matrix, per-face showing state and the underlay's face
bookkeeping. Measure the change and report the number honestly (see the
`cljs-style` memory).
## Tests
**Domain (node).**
- `:holds` in `local-frame`, with eval-frame and resolver agreeing forward,
backward and in random order.
- A trace op appears only with `:tracing?`, and `export/run!` output contains no
`:trace` op.
- `transform-op` composes the matrix through two nesting levels.
- `clip/center` ignores traces, and is `[w/2 h/2]` for a tracing symbol.
- `pick` returns picture ops before traces and inverse-maps through a rotated
layer.
- `symbol/problems` covers `:type :trace`, `:reads` targets and cycles, and
`:holds` shape.
- Registration: port `trace_test`'s photo-matrix assertions onto the walk.
For every row of the registration table, the plate's world transform equals
the expected matrix. At a held key with `:reads {:holds-of :plate}`, it equals
`world(:place) · S(1/H)`.
- Freeze emits the plate and the tracing symbol. Regeneration keeps the holds.
- The `::ui/show-trace` event sets the global switch on when turning a layer on
and leaves it alone when turning one off.
**Browser** (CDP, see the `arthur-verify-dont-guess` memory):
- Drop a still, then drag, turn and scale it.
- Toggle a layer on with the global switch off, and confirm both are on and the
photo paints.
- Export a frame and check it has no photo pixels.
- Open a face: the plate is registered at a hold with origin "at keys", and
stabilized with origin "start".
## Order of work, each step green
1. `:time :holds` in `node/local-frame`, `problems`, `frame-map`, and timeline
marks.
2. `:type :trace` symbol, `:media`, the `:trace` op behind `:tracing?`,
`transform-op`, the player split, `ui/tracing` painter and `pick`. Footage
media only, placed by hand from a REPL or test document.
3. The face: freeze and bring emit the plate and tracing symbol, `:reads`
replaces `:trace`, delete the old trace and underlay paths, and re-aim the
inspector's face section.
4. On/off: the `:hidden` set and `:layer` on trace ops, the row eye, the
`::ui/show-trace` rule, the global toggle and opacity in the palette bar, and
delete `[:ui :trace :faces]`.
5. Creation: "tracing layer" in the convert dialog, pool drag, then the image
endpoint, pool images and image drops.
6. Docs: `animation-model.md` "A photographic underlay is not an op" becomes "a
trace is an op that never reaches the raster". Update `frame-selection.md`
(where plate keys live) and `lane-model.md` (tracing clips in lanes).
## Open questions
1. **"A take shows its faces' footage."** Dropping the old "only in a face's own
tab" default means opening a take shows every face's plate if the global
switch is on. The recommendation is to accept that, since the switch is one
click.
2. **Lane-model audio rule.** `lane-problems` requires visual cels. A tracing cel
is visual for this purpose, but say so explicitly when a lane may hold both
tracing and drawing cels.

View file

@ -9,6 +9,7 @@
"version": "0.0.1", "version": "0.0.1",
"dependencies": { "dependencies": {
"@mediapipe/tasks-vision": "1.0.1", "@mediapipe/tasks-vision": "1.0.1",
"polygon-clipping": "^0.15.7",
"react": "^18.3.1", "react": "^18.3.1",
"react-dom": "^18.3.1" "react-dom": "^18.3.1"
}, },
@ -1015,6 +1016,16 @@
"node": ">= 0.10" "node": ">= 0.10"
} }
}, },
"node_modules/polygon-clipping": {
"version": "0.15.7",
"resolved": "https://registry.npmjs.org/polygon-clipping/-/polygon-clipping-0.15.7.tgz",
"integrity": "sha512-nhfdr83ECBg6xtqOAJab1tbksbBAOMUltN60bU+llHVOL0e5Onm1WpAXXWXVB39L8AJFssoIhEVuy/S90MmotA==",
"license": "MIT",
"dependencies": {
"robust-predicates": "^3.0.2",
"splaytree": "^3.1.0"
}
},
"node_modules/possible-typed-array-names": { "node_modules/possible-typed-array-names": {
"version": "1.1.0", "version": "1.1.0",
"resolved": "https://registry.npmjs.org/possible-typed-array-names/-/possible-typed-array-names-1.1.0.tgz", "resolved": "https://registry.npmjs.org/possible-typed-array-names/-/possible-typed-array-names-1.1.0.tgz",
@ -1216,6 +1227,12 @@
"node": ">= 0.8" "node": ">= 0.8"
} }
}, },
"node_modules/robust-predicates": {
"version": "3.0.3",
"resolved": "https://registry.npmjs.org/robust-predicates/-/robust-predicates-3.0.3.tgz",
"integrity": "sha512-NS3levdsRIUOmiJ8FZWCP7LG3QpJyrs/TE0Zpf1yvZu8cAJJ6QMW92H1c7kWpdIHo8RvmLxN/o2JXTKHp74lUA==",
"license": "Unlicense"
},
"node_modules/safe-buffer": { "node_modules/safe-buffer": {
"version": "5.2.1", "version": "5.2.1",
"resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz", "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz",
@ -1416,6 +1433,15 @@
"source-map": "^0.5.6" "source-map": "^0.5.6"
} }
}, },
"node_modules/splaytree": {
"version": "3.2.3",
"resolved": "https://registry.npmjs.org/splaytree/-/splaytree-3.2.3.tgz",
"integrity": "sha512-7OXrNWzy6CK+r7Ch9OLPBDTKfB6XlWHjX4P0RU5B3IgFuWPeYN0XtRtlexGRjgbQxpfaUve6jTAwBGWuGntz/w==",
"license": "MIT",
"engines": {
"node": ">=18.20 || >=20"
}
},
"node_modules/stream-browserify": { "node_modules/stream-browserify": {
"version": "2.0.2", "version": "2.0.2",
"resolved": "https://registry.npmjs.org/stream-browserify/-/stream-browserify-2.0.2.tgz", "resolved": "https://registry.npmjs.org/stream-browserify/-/stream-browserify-2.0.2.tgz",

View file

@ -10,6 +10,7 @@
}, },
"dependencies": { "dependencies": {
"@mediapipe/tasks-vision": "1.0.1", "@mediapipe/tasks-vision": "1.0.1",
"polygon-clipping": "^0.15.7",
"react": "^18.3.1", "react": "^18.3.1",
"react-dom": "^18.3.1" "react-dom": "^18.3.1"
}, },

View file

@ -192,6 +192,23 @@
(.arrayBuffer response))) (.arrayBuffer response)))
(.then decode-bytes!))) (.then decode-bytes!)))
(defn fit-buffer
"Fit fallback audio to the open timeline, padding with silence or trimming.
The buffer and clock must share a duration so looping wraps at the timeline's
end rather than repeating a short soundtrack underneath a longer animation."
[^js buffer seconds]
(let [rate (.-sampleRate buffer)
frames (max 1 (js/Math.ceil (* seconds rate)))]
(if (= frames (.-length buffer))
buffer
(let [channels (.-numberOfChannels buffer)
fitted (.createBuffer (js/OfflineAudioContext. channels 1 rate)
channels frames rate)]
(dotimes [c channels]
(.set (.getChannelData fitted c)
(.subarray (.getChannelData buffer c) 0 (min frames (.-length buffer)))))
fitted))))
(defn clock-source! (defn clock-source!
"Promise of `{:buffer :seconds}` — the audio the transport runs its clock on "Promise of `{:buffer :seconds}` — the audio the transport runs its clock on
while symbol `sid` is open, and how long that clock is. while symbol `sid` is open, and how long that clock is.
@ -216,7 +233,9 @@
(and fallback-url (= sid (clip/opens-on document))) (and fallback-url (= sid (clip/opens-on document)))
(-> (decode! fallback-url) (-> (decode! fallback-url)
(.then (fn [^js b] {:buffer b :seconds (.-duration b)}))) (.then (fn [b]
(let [seconds (/ (clip/output-frames document sid) (:fps document))]
{:buffer (fit-buffer b seconds) :seconds seconds}))))
:else :else
{:buffer nil {:buffer nil
@ -236,12 +255,8 @@
symbol played against the whole take's soundtrack would run ten frames and then symbol played against the whole take's soundtrack would run ten frames and then
keep the clock going for minutes." keep the clock going for minutes."
[document sid fallback-url store] [document sid fallback-url store]
(-> (buffer! document sid store) (-> (clock-source! document sid fallback-url store)
(.then (fn [buffer] (.then (fn [{:keys [buffer seconds]}]
(cond (wav-url (or buffer
buffer (wav-url buffer) (.createBuffer (js/OfflineAudioContext. 1 1 44100)
(and fallback-url (= sid (clip/opens-on document))) fallback-url 1 (max 1 (js/Math.ceil (* 44100 seconds))) 44100)))))))
:else (let [rate 44100
n (max 1 (js/Math.ceil (* rate (/ (clip/output-frames document sid)
(:fps document)))))]
(wav-url (.createBuffer (js/OfflineAudioContext. 1 1 rate) 1 n rate))))))))

View file

@ -17,6 +17,7 @@
[arthur.ui.index :as index] [arthur.ui.index :as index]
[arthur.ui.player :as player] [arthur.ui.player :as player]
[arthur.ui.shell :as shell] [arthur.ui.shell :as shell]
[arthur.ui.tools :as tools]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.dom.client :as rdc])) [reagent.dom.client :as rdc]))
@ -46,6 +47,7 @@
;; the blank one, and the blank one is what a bad address leaves on screen. ;; the blank one, and the blank one is what a bad address leaves on screen.
(collab/start!) (collab/start!)
(history/install-keys!) (history/install-keys!)
(tools/install-keys!)
(reset! root (rdc/create-root (js/document.getElementById "app"))) (reset! root (rdc/create-root (js/document.getElementById "app")))
(mount) (mount)
(player/start!)) (player/start!))

View file

@ -12,7 +12,6 @@
are entirely dense." are entirely dense."
(:require [arthur.demo :as demo] (:require [arthur.demo :as demo]
[arthur.domain.clip :as domain-clip] [arthur.domain.clip :as domain-clip]
[arthur.domain.trace :as trace]
[arthur.demo.swarm :as swarm] [arthur.demo.swarm :as swarm]
[arthur.demo.take :as take])) [arthur.demo.take :as take]))
@ -49,6 +48,18 @@
(defn clip-entry [id] (defn clip-entry [id]
(some-> (get-in clips [id :entry]) deref)) (some-> (get-in clips [id :entry]) deref))
(def tracing
"How tracing layers show on the stage: all of them or none, how strongly, and
which ones are switched off, as `[symbol-id node-id]` — the symbol a tracing
placement is in and its id, so a face's footage is one layer wherever the face
is placed.
THE EDITOR'S, NOT THE DOCUMENT'S. Showing a reference is a way of looking at
the stage, like solo and zoom: not an undo step, not sent to collaborators,
and it cannot reach an export. A layer is shown unless it is in `:hidden`, so
footage brought in shows without being found and switched on first."
{:on? true :opacity 0.5 :hidden #{}})
(def default (def default
{;; --- the document --- {;; --- the document ---
;; ;;
@ -161,11 +172,12 @@
:selection nil :selection nil
:selections [] :selections []
:tone 1 :tone 1
:tool nil :tool :select
:brush 6
:auto-key? false :auto-key? false
:draft [] :draft []
:knobs {} :knobs {}
:trace {:faces #{} :opacity trace/opacity-default} :tracing tracing
:expanded #{}}}) :expanded #{}}})
(def rates (def rates

View file

@ -87,7 +87,8 @@
(keys (:subjects frozen))))) (keys (:subjects frozen)))))
(symbol-id label)) (symbol-id label))
scoped (partial scope root) scoped (partial scope root)
wanted (into {:main root} (map (fn [subject] [subject (scoped subject)])) wanted (into {:main root :footage (scoped :footage)}
(map (fn [subject] [subject (scoped subject)]))
(keys (:subjects frozen))) (keys (:subjects frozen)))
{c :clip ids :ids} (symbols clip frozen [:main] wanted) {c :clip ids :ids} (symbols clip frozen [:main] wanted)
sid (ids :main) sid (ids :main)

View file

@ -261,6 +261,14 @@
(throw (ex-info "a correction cannot offset a value of a different shape" (throw (ex-info "a correction cannot offset a value of a different shape"
{:base wb :correction wv :channel (dissoc ch :dense)}))))) {:base wb :correction wv :channel (dissoc ch :dense)})))))
(defn- eye-opening-onto [points amount]
(let [n (width points)
ys (map #(component points %) (range 1 n 2))
center (/ (+ (reduce min ys) (reduce max ys)) 2)]
(mapv (fn [i] (let [v (component points i)]
(if (odd? i) (+ center (* amount (- v center))) v)))
(range n))))
(defn- over-at (defn- over-at
"Fold `ch`'s layers onto `base` at frame f. `read` samples one layer's values "Fold `ch`'s layers onto `base` at frame f. `read` samples one layer's values
and is the only thing that differs between the specification and the cursor." and is the only thing that differs between the specification and the cursor."
@ -279,6 +287,7 @@
;; `replace` can supply a value over an absent base; `offset` has ;; `replace` can supply a value over an absent base; `offset` has
;; nothing to add to and says so rather than inventing a pose. ;; nothing to add to and says so rather than inventing a pose.
(nothing? v) absent (nothing? v) absent
(= :eye-opening op) (eye-opening-onto v x)
:else (offset-onto v x ch))))) :else (offset-onto v x ch)))))
base base
(vec (:over ch)))) (vec (:over ch))))
@ -389,6 +398,14 @@
right (first (drop-while #(<= % f) fr))] right (first (drop-while #(<= % f) fr))]
(interpolate ch f left right))) (interpolate ch f left right)))
(defn repair-frame
"Map a damaged frame to a donor in the current base. Latest interval wins;
donors are sampled directly, never recursively through other repairs."
[ch f]
(reduce (fn [frame {:keys [from through donor]}]
(if (<= from f through) donor frame))
f (:repairs ch)))
(defn value-at (defn value-at
"Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and "Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and
O(n) in the keys. `cursor`/`sample!` is what playback uses. O(n) in the keys. `cursor`/`sample!` is what playback uses.
@ -401,7 +418,8 @@
says `nil` and means it." says `nil` and means it."
([ch f store] (value-at ch f f store)) ([ch f store] (value-at ch f f store))
([ch base-f correction-f store] ([ch base-f correction-f store]
(let [base (cond (let [base-f (repair-frame ch base-f)
base (cond
(not (:animated? ch)) (:value ch) (not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) base-f store nil) (:dense ch) (dense-at (:dense ch) base-f store nil)
(:keys ch) (let [ks (:keys ch)] (:keys ch) (let [ks (:keys ch)]
@ -502,7 +520,7 @@
([cur f] (sample! cur f f)) ([cur f] (sample! cur f f))
([^Cursor cur base-f correction-f] ([^Cursor cur base-f correction-f]
(let [ch (.-ch cur) (let [ch (.-ch cur)
base (base-sample! cur ch (.-ks cur) base-f)] base (base-sample! cur ch (.-ks cur) (repair-frame ch base-f))]
(if (seq (:over ch)) (if (seq (:over ch))
(over-at ch correction-f base (over-at ch correction-f base
(fn [i _ f] (sample! (nth (.-overs cur) i) f))) (fn [i _ f] (sample! (nth (.-overs cur) i) f)))
@ -534,6 +552,14 @@
linear? (or (= :linear (:interp ch)) linear? (or (= :linear (:interp ch))
(some #{:linear} (vals (:segments ch))))] (some #{:linear} (vals (:segments ch))))]
(cond-> [] (cond-> []
(and (contains? ch :repairs)
(not (and (vector? (:repairs ch))
(every? (fn [{:keys [id from through donor]}]
(and id (every? integer? [from through donor])
(<= 0 from through) (<= 0 donor)))
(:repairs ch)))))
(conj "repairs require an ID and nonnegative whole donor and interval frames")
(not (map? ch)) (not (map? ch))
(conj "not a map") (conj "not a map")
@ -582,8 +608,8 @@
(conj (str ":support " (pr-str support) (conj (str ":support " (pr-str support)
" must be a finite, increasing [in out)")) " must be a finite, increasing [in out)"))
(not (#{:offset :replace} op)) (not (#{:offset :replace :eye-opening} op))
(conj (str ":op " (pr-str op) " is not :offset or :replace")) (conj (str ":op " (pr-str op) " is not :offset, :replace or :eye-opening"))
;; One level. A layer over a layer is an ordering mechanism ;; One level. A layer over a layer is an ordering mechanism
;; the stack already is, and it would make the read ;; the stack already is, and it would make the read

View file

@ -59,6 +59,12 @@
[clip sid] [clip sid]
(get-in clip [:symbols sid])) (get-in clip [:symbols sid]))
(defn trace?
"Is `sym` a tracing symbol: footage or a still to draw over, which is placed and
moved like any symbol and never drawn into the picture? See `trace-op`."
[sym]
(= :trace (:type sym)))
(defn symbol-name (defn symbol-name
"What to call a symbol: its `:name`, or its id when it has none." "What to call a symbol: its `:name`, or its id when it has none."
[clip sid] [clip sid]
@ -199,10 +205,13 @@
"The symbol a document opens on: the longest one nothing else places, ties "The symbol a document opens on: the longest one nothing else places, ties
broken by id. The symbol that contains everything else is the longest of the broken by id. The symbol that contains everything else is the longest of the
unplaced ones in every document made so far, and a reserved name is what this unplaced ones in every document made so far, and a reserved name is what this
replaces." replaces.
Never a tracing symbol: it is footage nobody has placed yet, and as long as
the take it came from, so it would otherwise win."
[clip] [clip]
(first (sort-by (fn [sid] [(- (or (frames clip sid) 0)) (str sid)]) (first (sort-by (fn [sid] [(- (or (frames clip sid) 0)) (str sid)])
(unplaced clip)))) (remove #(trace? (symbol clip %)) (unplaced clip)))))
(defn set-root-fps (defn set-root-fps
"Set the document/output rate and the root symbol's editing rate together. "Set the document/output rate and the root symbol's editing rate together.
@ -245,6 +254,53 @@
;; and generated symbols carry their own rate explicitly. ;; and generated symbols carry their own rate explicitly.
:symbols {:main {:id :main :frames blank-frames :nodes {}}}}) :symbols {:main {:id :main :frames blank-frames :nodes {}}}})
(defn- op-path [op] (let [n (:node op)] (if (vector? n) n [n])))
(defn- own-span
"Where in `ops` the symbol at row path `path` is drawn: the end of its layer
when it has one, and the first and last of its own ops."
[ops path]
(let [own? #(and (< (count path) (count (op-path %)))
(= path (subvec (op-path %) 0 (count path))))
begin (first (keep-indexed #(when (and (= :begin (:kind %2)) (= path (op-path %2))) %1) ops))
end (when begin
(reduce (fn [depth i]
(case (:kind (ops i))
:begin (inc depth)
:end (if (= 1 depth) (reduced i) (dec depth))
depth))
0 (range begin (count ops))))
mine (keep-indexed #(when (own? %2) %1) ops)]
{:end (when (integer? end) end) :from (first mine) :to (last mine)}))
(defn- insert-at [ops i & more] (into (into (subvec ops 0 i) more) (subvec ops i)))
(defn atop
"`ops` with `op` drawn on top of what the symbol at row path `path` draws —
in ITS stacking context, where a shape added to it would land, so what is
above that symbol stays above. At the end when it drew nothing."
[ops path op]
(let [ops (vec ops)
{:keys [end to]} (own-span ops path)]
(cond end (insert-at ops end op)
to (insert-at ops (inc to) op)
:else (conj ops op))))
(defn in-layer
"`ops` with `op` drawn last INSIDE the symbol at row path `path` — in its
layer, so a knockout clears only what that symbol drew, as one saved there
would. A symbol that has no layer yet is given one around its ops. `ops`
unchanged when that symbol drew nothing."
[ops path op]
(let [ops (vec ops)
{:keys [end from to]} (own-span ops path)]
(cond
end (insert-at ops end op)
from (-> ops
(insert-at (inc to) op {:kind :end :node path})
(insert-at from {:kind :begin :node path}))
:else ops)))
(defn- transform-op (defn- transform-op
"Put a symbol's already resolved mark into its instance's parent space. Its "Put a symbol's already resolved mark into its instance's parent space. Its
name becomes its path of instances down to it, the path its timeline row has." name becomes its path of instances down to it, the path its timeline row has."
@ -266,8 +322,31 @@
(assoc op :cx x :cy y :r (* scale (:r op)))) (assoc op :cx x :cy y :r (* scale (:r op))))
:rect (let [[x y] (at (:cx op) (:cy op))] :rect (let [[x y] (at (:cx op) (:cy op))]
(assoc op :cx x :cy y :size (* scale (:size op)))) (assoc op :cx x :cy y :size (* scale (:size op))))
:trace (assoc op :m (node/mul! (node/mat) m (:m op)))
op))) op)))
(defn- trace-op
"The one op an instance of tracing symbol `sym` makes, showing its frame `frame`
at world `m`, from node `id` of symbol `sid`.
NOT A PICTURE OP. Nothing indexed can show a photo, so the raster refuses this
kind and the player hands it to `ui/tracing` instead; and the resolver makes one
only when asked with `:tracing?`, which only the stage does. An export, a
symbol's centre and a thumbnail never ask, so a reference cannot reach the
picture by any path that forgets to filter it.
`:layer` is what the on/off switch for one layer is keyed by: the symbol the
placement is in and its id, so a face's plate is one layer wherever the face
is placed."
[sym frame m sid id]
{:kind :trace
:node id
:layer [sid id]
:media (:media sym)
:frame frame
:size [(:width sym) (:height sym)]
:m (js/Float64Array.from m)})
(defprotocol IActivePalette (defprotocol IActivePalette
(active-palette [this] (active-palette [this]
"The palette selected by this resolver's most recently resolved frame.")) "The palette selected by this resolver's most recently resolved frame."))
@ -345,11 +424,13 @@
#(pal/render-index palette @active %) #(pal/render-index palette @active %)
palette) palette)
(assoc opts :pose-tracks pose-tracks)) (assoc opts :pose-tracks pose-tracks))
;; Each cel owns its source resolver and mutable buffers. ;; Each cel owns its source resolver and mutable buffers. A
;; tracing symbol has nothing to resolve: it is one op.
children (into {} children (into {}
(for [[id n] nodes (for [[id n] nodes
:when (= :instance (:kind n)) :when (= :instance (:kind n))
child (sort-by str (node/sources n))] child (sort-by str (node/sources n))
:when (not (trace? (symbol clip child)))]
[[id child] (build child (conj chain sid) [[id child] (build child (conj chain sid)
(get-in n [:playback :tracks]) false)])) (get-in n [:playback :tracks]) false)]))
;; The instances that were on the last frame, and WHICH ;; The instances that were on the last frame, and WHICH
@ -358,6 +439,9 @@
;; there used to be. Their resolvers still hold the frame ;; there used to be. Their resolvers still hold the frame
;; before whenever they were not on. ;; before whenever they were not on.
entered (volatile! {}) entered (volatile! {})
;; A symbol that knocks out is drawn into a layer of its own,
;; so what it clears is only ever its own.
layered? (symbol/knocks? nodes)
step (fn [f pre inherited forced] step (fn [f pre inherited forced]
(when context? (when context?
(vreset! active (or forced (vreset! active (or forced
@ -371,7 +455,7 @@
(vreset! entered {}) (vreset! entered {})
(let [by-id (into {} (map (juxt :node identity)) (let [by-id (into {} (map (juxt :node identity))
(own (js/Math.floor f) (js/Math.floor pre)))] (own (js/Math.floor f) (js/Math.floor pre)))]
(into [] (cond-> (into (if layered? [{:kind :begin :node []}] [])
(mapcat (mapcat
(fn [id] (fn [id]
(let [n (get nodes id)] (let [n (get nodes id)]
@ -383,7 +467,15 @@
shown (when (and m (number? local)) shown (when (and m (number? local))
(placed-frame clip sid n local)) (placed-frame clip sid n local))
frame (:frame shown)] frame (:frame shown)]
(if (and frame (<= 0 frame) (< frame length)) (cond
(not (and frame (<= 0 frame) (< frame length)))
[]
(trace? (symbol clip (:symbol shown)))
(when (:tracing? opts)
[(trace-op (symbol clip (:symbol shown)) frame m sid id)])
:else
(do (vswap! entered assoc id (:symbol shown)) (do (vswap! entered assoc id (:symbol shown))
(map #(transform-op % m [id]) (map #(transform-op % m [id])
((get children [id (:symbol shown)]) ((get children [id (:symbol shown)])
@ -403,10 +495,10 @@
(dec frame)) (dec frame))
@active @active
(when (and context? (:palette n)) (when (and context? (:palette n))
(selection-at n frame nil))))) (selection-at n frame nil)))))))
[]))
(when-let [op (get by-id id)] [op])))) (when-let [op (get by-id id)] [op]))))
ids))))] ids))
layered? (conj {:kind :end :node []}))))]
(reify (reify
IFn IFn
(-invoke [_ f] (step f (dec f) nil nil)) (-invoke [_ f] (step f (dec f) nil nil))

View file

@ -285,3 +285,37 @@
{:sid source-sid :id root {:sid source-sid :id root
:path (conj (vec (butlast path)) root)}) :path (conj (vec (butlast path)) root)})
items)})))) items)}))))
(defn move-many
"Reparent the selected roots atomically, preserving their world transforms and
clocks. Optional delta places the forest later on the open ruler."
[document store open selections to frame delta]
(let [roots (canonical document selections)
under? (fn [path] (prefix? path (vec to)))]
(cond
(empty? roots) {:refused "select something to move"}
(some #(under? (:path %)) roots) {:refused "a selection cannot go inside itself"}
:else
(let [moved
(reduce (fn [result {:keys [path]}]
(if (:refused result) (reduced result)
(let [r (nest/move-node (:clip result) store open path to frame)]
(if (:refused r) (reduced r)
{:clip (:clip r)
:selections (conj (:selections result)
[:node (:sid r) (:id r) (conj (vec to) (:id r))])}))))
{:clip document :selections []} roots)]
(if (:refused moved) moved
(let [shifted (nest/slide-many (:clip moved) open
(mapv #(nth % 3) (:selections moved)) (or delta 0))
checked (if (:refused shifted) shifted
(reduce (fn [result sid]
(if (:refused result) (reduced result)
(span/finish (:clip result) sid
(get-in (:clip result) [:symbols sid :nodes])
nil :grow-symbol)))
shifted (distinct (map :sid roots))))]
(if (:refused checked) checked
(if-let [why (first (clip/problems (:clip checked)))]
{:refused why}
(assoc checked :selections (:selections moved))))))))))

View file

@ -112,3 +112,82 @@
(fn [layers] (fn [layers]
(mapv #(if (= layer-id (:id %)) (dissoc % :conflict) %) layers))) (mapv #(if (= layer-id (:id %)) (dissoc % :conflict) %) layers)))
node-id)))) node-id))))
(defn borrow-pose [document sid {:keys [from through donor head?] :as spec} store]
(let [frames (get-in document [:symbols sid :frames])
ids (into #{} (mapcat :nodes)
(filter #(= sid (:symbol %)) (vals (:features document))))
ids (cond-> ids head? (conj :head))
paths (for [id ids [path c] (get-in document [:symbols sid :nodes id :channels])]
[id path c])]
(cond
(not (and (integer? frames) (every? integer? [from through donor])
(<= 0 from through (dec frames)) (<= 0 donor (dec frames))))
{:refused "choose whole face frames within this symbol"}
(<= from donor through) {:refused "choose a clean donor outside the repair interval"}
(empty? paths) {:refused "this symbol has no tracked face features"}
(not-any? (fn [[_ path c]]
(and (= path [:geom :pts])
(not (ch/nothing? (ch/value-at (dissoc c :repairs :over) donor store)))))
paths)
{:refused "the donor has no face pose; choose another frame"}
:else
(finish (reduce (fn [doc [node path _]]
(update-in doc [:symbols sid :nodes node :channels path :repairs]
(fnil conj []) (select-keys spec [:id :from :through :donor])))
document paths) nil))))
(declare remove-eye-keys)
(defn remove-repair [document sid repair-id]
{:clip (reduce (fn [doc [id path]]
(update-in doc [:symbols sid :nodes id :channels path :repairs]
#(vec (remove (fn [r] (= repair-id (:id r))) %))))
(-> document
(remove-eye-keys sid repair-id :l) :clip
(remove-eye-keys sid repair-id :r) :clip)
(for [[id n] (get-in document [:symbols sid :nodes])
[path c] (:channels n) :when (:repairs c)] [id path]))})
(defn eye-key
"Key a procedural lid adjustment and gaze offset over one repair interval."
[document sid repair-id side frame {:keys [opening gaze-x gaze-y]}]
(let [outer (keyword (str "eye-" (name side)))
inner (keyword (str "eye-" (name side) "-in"))
iris (keyword (str "iris-" (name side)))
repair (some #(when (= repair-id (:id %)) %)
(get-in document [:symbols sid :nodes outer :channels [:geom :pts] :repairs]))
{:keys [from through]} repair
layer-id (str repair-id "/eye/" (name side))
edits [[outer [:geom :pts] :eye-opening opening 1]
[inner [:geom :pts] :eye-opening opening 1]
[iris [:xform :pos] :offset [gaze-x gaze-y] [0 0]]]]
(cond
(nil? repair) {:refused "this eye has no such repair interval"}
(not (and (integer? frame) (<= from frame through)))
{:refused "move the playhead inside this repair interval"}
(not (and (every? finite? [opening gaze-x gaze-y]) (<= 0 opening 3)))
{:refused "eye opening must be between 0 and 3; gaze offsets must be finite"}
:else
(finish
(reduce
(fn [doc [id path op value neutral]]
(update-in doc [:symbols sid :nodes id :channels path :over]
(fn [layers]
(let [existing (some #(when (= layer-id (:id %)) %) layers)
values (or (:values existing)
(ch/keyed {from neutral through neutral} :linear))
layer (ch/layer layer-id [from (inc through)] op
(assoc-in values [:keys frame] value))]
(conj (vec (remove #(= layer-id (:id %)) layers)) layer)))))
document edits)
nil))))
(defn remove-eye-keys [document sid repair-id side]
(let [layer-id (str repair-id "/eye/" (name side))]
{:clip (reduce (fn [doc [id path]]
(update-in doc [:symbols sid :nodes id :channels path :over]
#(vec (remove (fn [l] (= layer-id (:id l))) %))))
document
(for [[id n] (get-in document [:symbols sid :nodes])
[path c] (:channels n) :when (:over c)] [id path]))}))

View file

@ -50,12 +50,17 @@
but the occurrence chain that reaches the lane must still be valid. The empty but the occurrence chain that reaches the lane must still be valid. The empty
path always resolves to the open symbol. path always resolves to the open symbol.
A tracing symbol is never one: it holds a picture to draw over and no nodes,
so selecting a tracing layer creates beside it, as selecting a shape does.
Returns `{:kind :lane|:symbol :sid :path :frame :matrix :time}`." Returns `{:kind :lane|:symbol :sid :path :frame :matrix :time}`."
[document store open selection frame] [document store open selection frame]
(let [preferred (preferred-path document open selection)] (let [preferred (preferred-path document open selection)]
(some (fn [path] (some (fn [path]
(when-let [inside (nest/inside document store open path frame)] (when-let [inside (nest/inside document store open path frame)]
(when-let [sid (:sid inside)] (when-let [sid (and (:sid inside)
(not (clip/trace? (clip/symbol document (:sid inside))))
(:sid inside))]
(assoc inside :path path (assoc inside :path path
:kind (if (symbol/lane? (clip/symbol document sid)) :kind (if (symbol/lane? (clip/symbol document sid))
:lane :symbol))))) :lane :symbol)))))

View file

@ -0,0 +1,74 @@
(ns arthur.domain.cut
"The eraser's cut: a shape's ring with a stroke taken out of it.
Illustrator's and Flash's eraser, not a raster one: what is left is the
SHAPE, with the cut edge made of its own points — points the pen moves, keys
and tweens like any others. A cut through the middle leaves two pieces, and
a cut inside it leaves a hole, which is bridged into the one ring as a brush
stroke's is (see `outline`).
In stage pixels, on both sides: the preview cuts the rings it is about to
draw, and the saved cut cuts the same rings and takes the answer back into
the shape's own coordinates — one function, so the preview is the result."
(:require ["polygon-clipping" :as clipping]
[arthur.domain.channel :as channel]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.outline :as outline]
[arthur.domain.paint :as paint]))
(defn- area [ring]
(let [ps (vec (partition 2 ring)) n (count ps)]
(js/Math.abs (/ (reduce + (map (fn [i] (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))]
(- (* ax by) (* bx ay))))
(range n)))
2))))
(defn cut
"Ring `ring` with `cutters` — each `[outer & holes]` — taken out of it: one
ring per piece left, biggest first, an empty vector when nothing is left, or
nil when the cut does not touch it."
[ring cutters]
(let [shape #js [(outline/->js ring)]
knife (into-array (map #(into-array (map outline/->js %)) cutters))]
(when (seq (array-seq (clipping/intersection shape knife)))
(->> (array-seq (clipping/difference shape knife))
(map (fn [^js poly] (mapv outline/->ring (array-seq poly))))
(sort-by (comp - area first))
(mapv outline/join)))))
(defn- through [m pts]
(let [out (js/Float64Array. 2)]
(into [] (mapcat (fn [[x y]] (node/apply-pt! out 0 m x y) [(aget out 0) (aget out 1)]))
(partition 2 pts))))
(defn erase
"`clip` with `cutters`, in the stage pixels of symbol `open` at frame `f`,
cut out of each shape at row path in `paths`, on the frame each is showing.
The shape keeps the biggest piece, on a key at that frame — made there if
the frame had none, so the keys either side keep their points. Every other
piece is a new shape of the same colour, its id the next of `ids`. A shape
cut away entirely is deleted."
[clip store open f paths cutters ids]
(first
(reduce
(fn [[clip ids] path]
(let [{:keys [sid id frame world]} (nest/placement clip store open path f)
n (get-in clip [:symbols sid :nodes id])
geom (get-in n [:channels paint/geometry])
inv (when world (node/invert world))
left (when (and inv geom)
(cut (through world (channel/value-at geom frame store)) cutters))]
(cond
(nil? left) [clip ids]
(empty? left) [(nest/delete-node clip sid id) ids]
:else
(let [[keep & more] (map #(through inv %) left)
colour (channel/value-at (get-in n [:channels [:style :color]]) frame store)
kept (-> (if (contains? (:keys geom) frame) clip (paint/add-key clip sid id frame))
(paint/set-points sid id frame keep))]
[(reduce (fn [c [nid pts]] (paint/new-shape c sid nid frame pts colour))
kept (map vector ids more))
(drop (count more) ids)]))))
[clip ids] paths)))

View file

@ -0,0 +1,37 @@
(ns arthur.domain.keyframes
(:require [arthur.domain.channel :as ch]))
(defn identity-of [k] (select-keys k [:sid :id :channel :frame]))
(defn shifted [items delta]
(let [delta (max delta (reduce max js/Number.NEGATIVE_INFINITY (map #(max (- (:at %)) (- (* (:frame %) (:scale %)))) items)))]
(mapv (fn [k]
(let [f (max 0 (js/Math.round (+ (:frame k) (/ delta (:scale k)))))]
(assoc k :frame f :at (+ (:at k) (* (:scale k) (- f (:frame k))))))) items)))
(defn edit-keys [document items delta]
(let [targets-by-id (when (some? delta)
(into {} (map vector (map identity-of items) (shifted items delta))))]
(reduce
(fn [doc [[sid id channel] selected]]
(let [path [:symbols sid :nodes id :channels channel]
c (get-in doc path)
selected (filter #(contains? (:keys c) (:frame %)) selected)
targets (when (some? delta) (mapv #(get targets-by-id (identity-of %)) selected))
remaining (apply dissoc (:keys c) (map :frame selected))
ks (if targets
(reduce (fn [ks [old new]] (assoc ks (:frame new) (get (:keys c) (:frame old))))
remaining (map vector selected targets))
remaining)
segments (apply dissoc (:segments c) (concat (map :frame selected) (map :frame targets)))
segments (if targets
(reduce (fn [s [old new]]
(if (contains? (:segments c) (:frame old))
(assoc s (:frame new) (get (:segments c) (:frame old))) s))
segments (map vector selected targets)) segments)]
(if (empty? selected) doc
(assoc-in doc path
(if (seq ks)
(cond-> (assoc c :keys ks) (:segments c) (assoc :segments segments))
(ch/framed (get (:keys c) (:frame (last selected)))))))))
document (group-by (juxt :sid :id :channel) (vals (into {} (map (juxt identity-of identity) items)))))))

View file

@ -45,9 +45,10 @@
WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are
not authored: they are written together by a freeze and replaced together by a not authored: they are written together by a freeze and replaced together by a
re-freeze, and `head-mode` exposes them through `:channels`. The optional re-freeze, and `head-mode` exposes them through `:channels`. The same is true
`:trace` on the head node chooses which measured frame those channels read. of a face's `:plate`, whose measured channels register its footage. Which
A leaf per measured measured frame they read is the node's `:reads` and `:time :holds`, which
save with the node. A leaf per measured
channel would offer a write nobody can make. The authored channels beside them channel would offer a write nobody can make. The authored channels beside them
are one leaf each, because a hand writes one at a time. are one leaf each, because a hand writes one at a time.
@ -149,7 +150,8 @@
(for [[sid sym] (:symbols clip)] (for [[sid sym] (:symbols clip)]
{(at "symbol" (segment sid)) {(at "symbol" (segment sid))
(select-keys sym [:name :frames :fps :width :height :palette (select-keys sym [:name :frames :fps :width :height :palette
:palette-track :palette-channel :type :palette-ref :display])}) :palette-track :palette-channel :type :palette-ref :display
:media])})
(for [[sid sym] (:symbols clip) (for [[sid sym] (:symbols clip)
[id n] (:nodes sym)] [id n] (:nodes sym)]
{(at "symbol" (segment sid) "node" (segment id)) {(at "symbol" (segment sid) "node" (segment id))

View file

@ -95,6 +95,23 @@
:matrix (node/mat) :time node/same-time} :matrix (node/mat) :time node/same-time}
path)) path))
(defn own-time
"The time map from symbol `sid`'s frames to the OWN frames of the node at row
path `path` from it, with `sid` showing frame `f`: the frames its keys and
holds are written in. Nil where no affine map exists — through a loop or a
floor above the node, or where it is not on screen.
It STOPS AT THE NODE, where `inside` goes into what the node places, and it
leaves out the node's own floors: a hold is added on a frame the node's holds
would otherwise floor away."
[clip store sid path f]
(when-let [{inner :sid t :time} (inside clip store sid (pop path) f)]
(let [nodes (:nodes (clip/symbol clip inner))
n (get nodes (peek path))
up (symbol/frame-map nodes (:parent n))]
(when (and n t up)
(-> t (node/then-time up) (node/then-time (node/time-of n)))))))
(defn placement (defn placement
"Where the node at row path `path` is, from symbol `sid` showing frame `f`, as "Where the node at row path `path` is, from symbol `sid` showing frame `f`, as
a transform would change it: `{:sid :id :frame :parent :world}` — the symbol it a transform would change it: `{:sid :id :frame :parent :world}` — the symbol it
@ -319,6 +336,8 @@
(nil? n) "nothing to move" (nil? n) "nothing to move"
(or (nil? here) (nil? there)) "both have to be on screen at this frame" (or (nil? here) (nil? there)) "both have to be on screen at this frame"
(nil? (:sid there)) "only a symbol can take it" (nil? (:sid there)) "only a symbol can take it"
(clip/trace? (clip/symbol clip (:sid there)))
"a tracing layer is a picture to draw over — nothing goes inside it"
(span/placement-refusal clip (:sid there) n) (span/placement-refusal clip (:sid there) n)
(span/placement-refusal clip (:sid there) n) (span/placement-refusal clip (:sid there) n)
(not (and (:time here) (:time there))) (not (and (:time here) (:time there)))
@ -458,6 +477,42 @@
;; too, so this is less code and one fewer invariant to remember. ;; too, so this is less code and one fewer invariant to remember.
(span/claim clip (:sid here) moved id :grow-symbol (random-uuid)))))) (span/claim clip (:sid here) moved id :grow-symbol (random-uuid))))))
(defn slide-many
"Move a selection simultaneously. Lane collisions refuse the entire edit."
[document open paths df]
(let [paths (vec (distinct (filter seq paths)))
entries (mapv (fn [path]
(let [here (down document open (pop path))
id (peek path)
nodes (get-in document [:symbols (:sid here) :nodes])]
{:path path :here here :sid (:sid here) :id id
:nodes nodes :node (get nodes id)})) paths)
roots (remove
(fn [{:keys [path sid id nodes]}]
(some (fn [other]
(or (and (< (count (:path other)) (count path))
(= (:path other) (subvec path 0 (count (:path other)))))
(and (= sid (:sid other)) (not= id (:id other))
(some #{(:id other)} (rest (symbol/lineage nodes id))))))
entries)) entries)]
(if (some #(or (nil? (:node %)) (nil? (get-in % [:here :time]))) roots)
{:refused "selection includes a node without an editable clock"}
(let [changes
(reduce (fn [changes {:keys [here sid id nodes node]}]
(let [from (or (first (node/placed-span node)) (get-in node [:time :at] 0))
d (- (dragged here nodes id from df) from)
shift (fn [n] (update-in n [:time :at] (fnil + 0) d))
ids (cons id (when (not= :audio (:kind node))
(for [[aid n] nodes :when (= id (:linked-to n))] aid)))]
(reduce (fn [out nid] (assoc-in out [sid nid] (shift (get nodes nid)))) changes ids)))
{} roots)]
(reduce (fn [result [sid changed]]
(if (:refused result) (reduced result)
(span/finish (:clip result) sid
(merge (get-in (:clip result) [:symbols sid :nodes]) changed)
nil :grow-symbol)))
{:clip document} changes)))))
(defn resize-out (defn resize-out
"Move the right edge of the node at `path` by `df` frames of `open`. "Move the right edge of the node at `path` by `df` frames of `open`.

View file

@ -295,15 +295,32 @@
(defn finite-number? [v] (and (number? v) (js/Number.isFinite v))) (defn finite-number? [v] (and (number? v) (js/Number.isFinite v)))
(defn hold
"Floor `f` onto the last of `holds` at or before it, and before the first onto
the first. Exposure on authored frames rather than on a grid: `[0 12 30]` shows
frame 12 from 12 until 30. What a tracing layer's held photos and a face's
trace keys are.
A `reduce` that stops at the first hold past `f`, because this runs per node
per frame and the list is sorted."
[f holds]
(if (seq holds)
(reduce (fn [held h] (if (<= h f) h (reduced held))) (first holds) holds)
f))
(defn local-frame (defn local-frame
"Apply an artistic time map within one frame space: expose, then offset. "Apply an artistic time map within one frame space: expose, hold, then offset.
Frame-rate selection happens at symbol boundaries in domain/clip." Frame-rate selection happens at symbol boundaries in domain/clip.
Holds come after exposure and inherit the same way, strictly: they are a floor
of this node's own frame, and its children are handed the floored frame."
[n f] [n f]
(let [{:keys [mode at rate offset] ex :expose :or {mode :map at 0 rate 1}} (:time n)] (let [{:keys [mode at rate offset holds] ex :expose :or {mode :map at 0 rate 1}} (:time n)]
(if (= mode :inherit) (if (= mode :inherit)
f f
(cond-> (* rate (- f at)) (cond-> (* rate (- f at))
ex (expose ex) ex (expose ex)
(seq holds) (hold holds)
offset (+ offset))))) offset (+ offset)))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -468,7 +485,11 @@
(apply < (:span n))))) (apply < (:span n)))))
(conj ":span must be a finite, increasing [in out]") (conj ":span must be a finite, increasing [in out]")
(some? (get-in n [:time :in])) (some? (get-in n [:time :in]))
(conj ":time has an :in — an instance's first frame is the start of its own :span")) (conj ":time has an :in — an instance's first frame is the start of its own :span")
(let [hs (get-in n [:time :holds])]
(and (some? hs) (not (and (vector? hs) (every? finite-number? hs)
(or (empty? hs) (apply < hs))))))
(conj ":time :holds must be a vector of increasing frames"))
(into (when valid (into (when valid
(for [[path _] (:channels n) (for [[path _] (:channels n)

View file

@ -0,0 +1,54 @@
(ns arthur.domain.onion
"Editor-only neighboring cel events, in output frames."
(:require [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.symbol :as symbol]))
(def defaults {:on? false :before 1 :after 1 :opacity 0.25 :scope :selected})
(defn neighbors [events f before after]
(concat
(map #(assoc % :direction :before)
(take before (reverse (sort-by :start (filter #(<= (:end %) f) events)))))
(map #(assoc % :direction :after)
(take after (sort-by :start (filter #(> (:start %) f) events))))))
(defn samples [document store open selection f settings]
(let [own (clip/shown-frame document open f)
path (if (= :node (first selection)) (or (nth selection 3 nil) [(nth selection 2)]) [])
locations (for [n (range (inc (count path)))
:let [p (vec (take n path))
sid (if (empty? p) open (:sid (nest/inside document store open p own)))]
:when (symbol/lane? (clip/symbol document sid))]
{:sid sid :path p})
selected (last locations)
;; Whole-symbol scope includes visible lane placements, recursively.
walk (fn walk [sid p seen]
(when-not (contains? seen sid)
(let [sym (clip/symbol document sid)]
(if (symbol/lane? sym)
[{:sid sid :path p}]
(mapcat (fn [[id n]]
(when (node/source n)
(let [q (conj p id)
at (nest/inside document store open q own)]
(when (:sid at) (walk (:sid at) q (conj seen sid))))))
(:nodes sym))))))
lanes (if (= :symbol (:scope settings)) (walk open [] #{}) (when selected [selected]))]
(mapcat
(fn [{:keys [sid path]}]
(let [events (keep (fn [n]
(let [id (:id n)
q (conj path id)
t (nest/own-time document store open q own)]
(when (and (node/source n) (:span n) t (pos? (:rate t)))
(let [[lo hi] (:span n)
start (+ (:at t) (/ lo (:rate t)))
end (+ (:at t) (/ hi (:rate t)))]
{:start start :end end :path q
:frame (clip/first-output-frame document open (js/Math.ceil start))}))))
(symbol/children (:nodes (clip/symbol document sid))))]
(filter #(< -1 (:frame %) (clip/output-frames document open))
(neighbors events own (:before settings) (:after settings)))))
lanes)))

View file

@ -0,0 +1,303 @@
(ns arthur.domain.outline
"A brush stroke, as pixels and then as polygons.
Flash's brush: what you paint becomes filled shapes the moment you let go, and
the stroke is not kept. Here the stroke is first a MASK — a byte per stage
pixel, stamped with the brush's disc as the pointer moves, so what is on screen
while painting is exactly the pixels — and on letting go each piece of it is
traced round its pixel edges and simplified to as many points as are asked for,
as the mouth's ring is.
The trace walks pixel CORNERS, so before simplifying, a traced ring filled by
`raster/fill-poly-buf!` is the mask again exactly.
A HOLE STAYS A HOLE, and a shape is still one ring. A loop painted round a gap
is a piece with a hole in it; the hole is traced as well, and joined to the
outside by a HORIZONTAL bridge along a whole-pixel row — out and back along
the same line. The fill samples at pixel centres (y + 0.5) and an edge with no
height crosses no scanline, so the bridge draws nothing, the even-odd fill
leaves the hole empty, and nothing downstream has to know a ring can have
one. It is how earcut and the TrueType rasterisers take holes too.
`pieces` keeps the trace — outside and holes, at full resolution — so the
fit can change after the stroke, and `polygon` is the one place it is fitted
and bridged: the preview and the saved shape are the same function's output,
so what is on screen while painting is what is kept.
FITTED TO A TOLERANCE, not cut to a count: every point of the traced edge is
within so many pixels of the polygon (Douglas-Peucker), so points go where
the shape bends and none are spent on a straight run."
(:require ["polygon-clipping" :as clipping]
[arthur.domain.raster :as raster]))
(defn mask [w h] {:w w :h h :buf (js/Uint8Array. (* w h))})
(defn stamp!
"The brush, `size` pixels across, from `[ax ay]` to `[bx by]`: a disc every
half radius along the way, so a fast stroke is still one stroke."
[m [ax ay] [bx by] size]
(let [[ox oy] (or (:origin m) [0 0])
ax (- ax ox) ay (- ay oy) bx (- bx ox) by (- by oy)
r (max 0.5 (/ size 2))
steps (max 1 (js/Math.ceil (/ (js/Math.hypot (- bx ax) (- by ay)) (max 0.5 (/ r 2)))))]
(dotimes [i (inc steps)]
(let [t (/ i steps)]
(raster/fill-disc! m (+ ax (* t (- bx ax))) (+ ay (* t (- by ay))) r 1))))
m)
(defn- flood!
"Label the 4-connected region of pixels whose ink is `ink` from pixel `start`
with `id` in `lab`, inside the box `[x0 y0 x1 y1]`. Its size, and whether it
reaches the box's edge — a gap that does is outside, not a hole.
A typed stack and no allocation per pixel: this runs on every pointer move."
[^js lab ^js buf w [x0 y0 x1 y1] ink start id ^js stack]
(aset lab start id)
(aset stack 0 start)
(let [top (volatile! 1) size (volatile! 0) edge? (volatile! false)
visit! (fn [q] (when (and (zero? (aget lab q)) (== ink (aget buf q)))
(aset lab q id)
(aset stack @top q)
(vswap! top inc)))]
(while (pos? @top)
(let [p (aget stack (vswap! top dec))
x (mod p w) y (quot p w)]
(vswap! size inc)
(when (or (== x x0) (== x x1) (== y y0) (== y y1)) (vreset! edge? true))
(when (< x0 x) (visit! (dec p)))
(when (< x x1) (visit! (inc p)))
(when (< y0 y) (visit! (- p w)))
(when (< y y1) (visit! (+ p w)))))
{:size @size :edge? @edge?}))
(def ^:private dirs [[1 0] [0 1] [-1 0] [0 -1]])
(defn- ring
"The edge of the region `in?` that starts at pixel `start`, the first of it in
raster order, as flat corner points: walked with the region on the right and a
point only where the walk turns. Round a piece, that is its outside; round a
hole, the inside edge of the piece around it."
[w in? start]
(let [x0 (mod start w) y0 (quot start w)]
;; Heading east along the start pixel's top edge, the region is below: on the
;; right. At each corner the two pixels ahead decide: the one ahead on the
;; right empty turns right, the one ahead on the left full turns left, and
;; otherwise straight on. Turning right first keeps two regions that touch
;; only at a corner apart, as the 4-connected fill did.
;; The start corner is always a turn — the walk arrives at it heading
;; north up the start pixel's left edge — and is passed only once, because
;; the three pixels round it other than the start are all outside.
(loop [x x0 y y0 d 0 out [x0 y0]]
(let [[l r] (case d
0 [[x (dec y)] [x y]]
1 [[x y] [(dec x) y]]
2 [[(dec x) y] [(dec x) (dec y)]]
3 [[(dec x) (dec y)] [x (dec y)]])
nd (cond (not (apply in? r)) (mod (inc d) 4)
(apply in? l) (mod (+ d 3) 4)
:else d)
out (if (or (= nd d) (and (= x x0) (= y y0))) out (conj out x y))
[dx dy] (dirs nd)
nx (+ x dx) ny (+ y dy)]
(if (and (= nx x0) (= ny y0))
out
(recur nx ny nd out))))))
(defn- bounds
"`[x0 y0 x1 y1]` round what the mask holds, a pixel wider each way so a gap
open to the outside reaches the edge of it — or nil for an empty mask."
[{:keys [w h ^js buf]}]
(let [b #js [w h -1 -1]]
(dotimes [o (* w h)]
(when (== 1 (aget buf o))
(let [x (mod o w) y (quot o w)]
(aset b 0 (min (aget b 0) x)) (aset b 1 (min (aget b 1) y))
(aset b 2 (max (aget b 2) x)) (aset b 3 (max (aget b 3) y)))))
(when (<= 0 (aget b 2))
[(max 0 (dec (aget b 0))) (max 0 (dec (aget b 1)))
(min (dec w) (inc (aget b 2))) (min (dec h) (inc (aget b 3)))])))
(defn- buffer-pieces
"Each piece of the mask bigger than `smallest` pixels, biggest first, as
`{:outer ring :holes [ring …]}` at full resolution: a hole is a gap inside a
piece that does not reach the outside, of more than `smallest` pixels."
([m] (buffer-pieces m 2))
([{:keys [w h ^js buf] :as m} smallest]
(when-let [[x0 y0 x1 y1 :as box] (bounds m)]
(let [lab (js/Int32Array. (* w h))
stack (js/Int32Array. (* w h))
;; Pieces get positive labels and gaps negative ones, in raster
;; order, so each is labelled from its own first pixel.
found (let [acc (array)]
(doseq [y (range y0 (inc y1))]
(dotimes [i (inc (- x1 x0))]
(let [o (+ x0 i (* y w))]
(when (zero? (aget lab o))
(let [ink (aget buf o)
id (cond-> (inc (.-length acc)) (zero? ink) -)]
(.push acc (assoc (flood! lab buf w box ink o id stack)
:id id :start o)))))))
(vec acc))
in (fn [id] (fn [x y] (and (< -1 x w) (< -1 y h) (== id (aget lab (+ x (* y w)))))))
;; A hole's first pixel has a pixel of its piece directly above it:
;; anything else above would be the hole itself, and earlier.
holes (group-by #(aget lab (- (:start %) w))
(filter #(and (neg? (:id %)) (not (:edge? %)) (< smallest (:size %))) found))]
(->> found
(filter #(and (pos? (:id %)) (< smallest (:size %))))
(sort-by (comp - :size))
(mapv (fn [{:keys [id start]}]
{:outer (ring w (in id) start)
:holes (mapv #(ring w (in (:id %)) (:start %)) (get holes id))})))))))
(defn pieces
([m] (pieces m 2))
([m smallest]
(let [[ox oy] (or (:origin m) [0 0])
shift (fn [ring] (mapv (fn [i v] (+ v (if (even? i) ox oy))) (range) ring))]
(mapv (fn [p] (-> p (update :outer shift) (update :holes #(mapv shift %))))
(buffer-pieces m smallest)))))
(defn rings
"The outside of every piece of the mask, as flat corner points, biggest
first."
([m] (rings m 2))
([m smallest] (mapv :outer (pieces m smallest))))
(defn- area
"The area inside ring `pts`, by the shoelace."
[pts]
(let [ps (vec (partition 2 pts)) n (count ps)]
(js/Math.abs (/ (reduce + (map (fn [i] (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))]
(- (* ax by) (* bx ay))))
(range n)))
2))))
(defn- bridge
"Ring `outer` with `hole` joined into it: from the hole's leftmost point,
along its row to the nearest edge of `outer` on the left, round the hole, and
back. Both are on a whole-pixel row, so the bridge is never filled. See the
namespace docstring."
[outer hole]
(let [hs (vec (partition 2 hole))
k (apply min-key (comp first hs) (range (count hs)))
[hx hy] (hs k)
os (vec (partition 2 outer))
n (count os)
;; The edge the row meets nearest on the left. A level edge is skipped:
;; running along one draws nothing either.
[i qx] (->> (range n)
(keep (fn [i]
(let [[ax ay] (os i) [bx by] (os (mod (inc i) n))]
(when (and (not= ay by) (<= (min ay by) hy (max ay by)))
(let [x (+ ax (* (/ (- hy ay) (- by ay)) (- bx ax)))]
(when (< x hx) [i x]))))))
(reduce (fn [best c] (if (or (nil? best) (< (second best) (second c))) c best))
nil))]
(if i
(vec (concat (apply concat (subvec os 0 (inc i)))
[qx hy]
(apply concat (subvec hs k)) (apply concat (subvec hs 0 k))
[hx hy qx hy]
(apply concat (subvec os (inc i)))))
outer)))
(defn- dp
"Douglas-Peucker over the open run of points `i`..`j` of `xs`/`ys`: the
indices kept so that no point between is further than `tol` from the line."
[^js xs ^js ys i j tol]
(let [ax (aget xs i) ay (aget ys i) bx (aget xs j) by (aget ys j)
dx (- bx ax) dy (- by ay) l (js/Math.hypot dx dy)
[k d] (reduce (fn [[_ best :as acc] k]
(let [px (- (aget xs k) ax) py (- (aget ys k) ay)
e (if (zero? l) (js/Math.hypot px py) (/ (js/Math.abs (- (* dx py) (* dy px))) l))]
(if (< best e) [k e] acc)))
[nil 0] (range (inc i) j))]
(if (and k (< tol d))
(into (dp xs ys i k tol) (rest (dp xs ys k j tol)))
[i j])))
(defn fit
"Ring `pts` with as few points as keep every point of it within `tol` pixels
of the result: Douglas-Peucker, closed by splitting at the point furthest from
the first. A pixel staircase within a pixel of a diagonal becomes the
diagonal, and a square corner stays — the points go where the shape bends."
[pts tol]
(let [c (quot (count pts) 2)]
(if (<= c 3)
(vec pts)
(let [xs (js/Float64Array. (take-nth 2 pts)) ys (js/Float64Array. (take-nth 2 (rest pts)))
far (apply max-key #(js/Math.hypot (- (aget xs %) (aget xs 0)) (- (aget ys %) (aget ys 0)))
(range c))
xs2 (js/Float64Array. (inc c)) ys2 (js/Float64Array. (inc c))
_ (dotimes [k c] (aset xs2 k (aget xs k)) (aset ys2 k (aget ys k)))
_ (do (aset xs2 c (aget xs 0)) (aset ys2 c (aget ys 0)))
keep (into (dp xs2 ys2 0 far tol) (rest (butlast (dp xs2 ys2 far c tol))))]
(if (< (count keep) 3)
(vec pts)
(into [] (mapcat (fn [k] [(aget xs k) (aget ys k)])) keep))))))
(defn- crosses?
"Does any edge of ring `a` cross any edge of ring `b`?"
[a b]
(let [edges (fn [r] (let [ps (vec (partition 2 r)) n (count ps)]
(map (fn [i] [(ps i) (ps (mod (inc i) n))]) (range n))))
side (fn [[ax ay] [bx by] [px py]] (- (* (- bx ax) (- py ay)) (* (- by ay) (- px ax))))]
(some (fn [[p q]]
(some (fn [[r s]]
(and (neg? (* (side p q r) (side p q s)))
(neg? (* (side r s p) (side r s q)))))
(edges b)))
(edges a))))
(defn- perimeter [pts]
(let [ps (vec (partition 2 pts)) n (count ps)]
(reduce + (map (fn [i] (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))]
(js/Math.hypot (- bx ax) (- by ay))))
(range n)))))
(defn ->js
"Flat ring `ring` as `polygon-clipping` takes one."
[ring]
(into-array (map into-array (partition 2 ring))))
(defn ->ring
"A ring back from `polygon-clipping`, flat, without the point it repeats to
close."
[^js r]
(into [] (mapcat identity) (butlast (map vec (array-seq r)))))
(defn rings-of
"Piece `p` of `pieces` fitted to within `tol` pixels, outside first, holes
after.
EVERY HOLE IS KEPT, and kept simple: fitted like the outside, then clipped to
the inside of it and clear of the holes before it. Fitting each ring on its
own can push a hole's edge across the outside's, and a crossing is what makes
the even-odd fill cut through the body; clipping takes exactly that part off
and leaves the few points the fit chose. Fitting closer until nothing crossed
was tried, and spent hundreds of points on what is plainly a straight line."
[{:keys [outer holes]} tol]
(let [outer (fit outer tol)]
(reduce (fn [rs hole]
(let [h (fit hole tol)]
(if (not-any? #(crosses? h %) rs)
(conj rs h)
(let [inside (clipping/intersection #js [(->js h)] #js [(->js outer)])
clear (if (next rs)
(clipping/difference inside (into-array (map #(array (->js %)) (rest rs))))
inside)]
(into rs (comp (map #(->ring (aget % 0))) (filter #(< 2 (area %))))
(array-seq clear))))))
[outer]
(sort-by (comp - area) holes))))
(defn join
"Rings `[outer & holes]` as one ring, each hole bridged in, leftmost first."
[[outer & holes]]
(reduce bridge outer (sort-by #(apply min (take-nth 2 %)) holes)))
(defn polygon
"Piece `p` of `pieces` as the one ring a shape is made of. See `rings-of`."
[p tol]
(join (rings-of p tol)))

View file

@ -53,3 +53,48 @@
(if (and points (< (inc i) (count points))) (if (and points (< (inc i) (count points)))
(assoc-in clip path (-> points (assoc i x) (assoc (inc i) y))) (assoc-in clip path (-> points (assoc i x) (assoc (inc i) y)))
clip))) clip)))
(defn- every-key
"`f` over the points of every key of the shape's geometry."
[clip sid id f]
(let [path [:symbols sid :nodes id :channels geometry :keys]]
(if (and (:paint? (get-in clip [:symbols sid :nodes id])) (map? (get-in clip path)))
(update-in clip path update-vals f)
clip)))
(defn insert-vertex
"A new point after point `i`, a fraction `t` of the way along the edge to the
next, on EVERY key: a point's index is what it is across keys, so a tween
between two keys only means anything while they have the same points. The
shape does not change on any key."
[clip sid id i t]
(every-key clip sid id
(fn [pts]
(let [n (quot (count pts) 2)
j (mod (inc i) n)
at #(+ (nth pts (+ (* 2 i) %))
(* t (- (nth pts (+ (* 2 j) %)) (nth pts (+ (* 2 i) %)))))]
(if (< i n)
(-> (subvec pts 0 (* 2 (inc i)))
(conj (at 0) (at 1))
(into (subvec pts (* 2 (inc i)))))
pts)))))
(defn delete-vertex
"Point `i` gone from every key, as `insert-vertex` adds one. A triangle keeps
its three."
[clip sid id i]
(every-key clip sid id
(fn [pts]
(if (and (< 6 (count pts)) (< (* 2 i) (count pts)))
(into (subvec pts 0 (* 2 i)) (subvec pts (* 2 (inc i))))
pts))))
(defn set-points
"Key `key-frame` of the shape is `points`, whatever it held: a stroke being
re-simplified to another count."
[clip sid id key-frame points]
(let [path [:symbols sid :nodes id :channels geometry :keys key-frame]]
(if (get-in clip path)
(assoc-in clip path points)
clip)))

View file

@ -7,7 +7,7 @@
WHICH LEVEL a click selects is Figma's and Illustrator's rule, and Flash's WHICH LEVEL a click selects is Figma's and Illustrator's rule, and Flash's
without its edit mode: a click selects the thing in the open symbol, a without its edit mode: a click selects the thing in the open symbol, a
double-click goes one level into what is selected, ⌘-click goes straight to the double-click goes one level into what is selected, ⌥-click goes straight to the
shape itself. A click inside what is selected keeps it, so a deep selection can shape itself. A click inside what is selected keeps it, so a deep selection can
be dragged; one elsewhere selects at the same depth, beside it." be dragged; one elsewhere selects at the same depth, beside it."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
@ -41,22 +41,33 @@
(range n)))) (range n))))
(some #(near-segment? x y (px %) (py %) (px (inc %)) (py (inc %))) (range n))))) (some #(near-segment? x y (px %) (py %) (px (inc %)) (py (inc %))) (range n)))))
(defn- on? [{:keys [kind pts n cx cy r size]} x y] (defn- trace-corners
"A trace op's image rectangle on the stage, as four [x y] corners."
[{[w h] :size m :m}]
(for [[x y] [[0 0] [w 0] [w h] [0 h]]]
[(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4))
(+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))]))
(defn- on? [{:keys [kind pts n cx cy r size m]} x y]
(case kind (case kind
:poly (on-poly? pts n x y) :poly (on-poly? pts n x y)
:disc (<= (js/Math.hypot (- x cx) (- y cy)) (+ r slop)) :disc (<= (js/Math.hypot (- x cx) (- y cy)) (+ r slop))
:rect (let [h (+ slop (/ size 2))] :rect (let [h (+ slop (/ size 2))]
(and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h))) (and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h)))
;; Into the image's own pixels, where the test is a rectangle however the
;; layer is turned or scaled.
:trace (when-let [inv (node/invert m)]
(let [[w h] size
u (+ (* (aget inv 0) x) (* (aget inv 2) y) (aget inv 4))
v (+ (* (aget inv 1) x) (* (aget inv 3) y) (aget inv 5))]
(and (<= 0 u) (< u w) (<= 0 v) (< v h))))
false)) false))
(defn hit (defn- op-bounds [{:keys [kind pts n cx cy r size knock lut] :as op}]
"The row path of the topmost op in `ops`, in draw order, at stage point `[x y]`, (case (when-not (or knock lut) kind)
or nil." :trace (let [cs (trace-corners op)]
[ops [x y]] [(apply min (map first cs)) (apply min (map second cs))
(some #(when (on? % x y) (path-of %)) (rseq (vec ops)))) (apply max (map first cs)) (apply max (map second cs))])
(defn- op-bounds [{:keys [kind pts n cx cy r size]}]
(case kind
:poly (reduce (fn [b i] :poly (reduce (fn [b i]
(let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))] (let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))]
(if b (let [[x0 y0 x1 y1] b] (if b (let [[x0 y0 x1 y1] b]
@ -83,6 +94,29 @@
(defn- prefix? [a b] (defn- prefix? [a b]
(and (<= (count a) (count b)) (= a (subvec b 0 (count a))))) (and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
(defn hit-op
"The topmost op in `ops`, in draw order, that SHOWS at stage point `[x y]`, or
nil. A knockout is never hit: it is a hole, and a click in it is a click on
whatever shows through — so it hides the ops beneath it in its own symbol, of
the colour it clears."
[ops [x y]]
(:op (reduce (fn [holes op]
(cond
;; A remap is light on what is under it, not a thing.
(or (:lut op) (not (on? op x y))) holes
(:knock op) (conj holes [(pop (path-of op)) (:knock op)])
(some (fn [[in k]] (and (prefix? in (path-of op))
(or (neg? k) (== k (:color op)))))
holes) holes
:else (reduced {:op op})))
[] (let [{traces true drawn false} (group-by #(= :trace (:kind %)) (rseq (vec ops)))]
(concat drawn traces)))))
(defn hit
"The row path of the topmost op that shows at stage point `[x y]`, or nil."
[ops point]
(some-> (hit-op ops point) path-of))
(defn choose (defn choose
"The row path a click on `hit` selects, with `selected` the one selected now." "The row path a click on `hit` selects, with `selected` the one selected now."
[selected hit deep?] [selected hit deep?]
@ -121,7 +155,13 @@
(let [grow (fn [[x0 y0 x1 y1 :as b] x y] (let [grow (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y])) (if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
at (fn [f p] (ch/value-at (get (node/channels n) p) f store))] at (fn [f p] (ch/value-at (get (node/channels n) p) f store))]
(case (:kind n) (case (if (some->> (node/source n) (clip/symbol document) clip/trace?) :trace (:kind n))
;; A tracing symbol draws nothing to resolve: what it covers is its media's
;; pixels, in its own coordinates, on every frame it shows one.
:trace
(let [{:keys [width height]} (clip/symbol document (node/source n))]
(fn [f] (when (clip/placed-frame document sid n f) [0 0 width height])))
:instance :instance
;; ONE RESOLVER PER DRAWING THE LANE CAN SHOW, built once for the reason ;; ONE RESOLVER PER DRAWING THE LANE CAN SHOW, built once for the reason
;; the single one used to be: a resolver costs the symbol to build and a ;; the single one used to be: a resolver costs the symbol to build and a

View file

@ -65,7 +65,7 @@
"Frames worth landing on, per pose group: `{group -> ascending frames}`, or nil "Frames worth landing on, per pose group: `{group -> ascending frames}`, or nil
where nothing is marked. where nothing is marked.
PRECOMPUTED WHEN THE RESOLVER IS BUILT, beside `prepare` and `trace/prepare`, PRECOMPUTED WHEN THE RESOLVER IS BUILT, beside `prepare`,
and this is the reason it is a function rather than a line inside the snap. A and this is the reason it is a function rather than a line inside the snap. A
`[:vis]` channel is keys and not dense, so reading one per node per frame would `[:vis]` channel is keys and not dense, so reading one per node per frame would
be cheap — but the snap needs the marks SORTED for a backward lookup, and be cheap — but the snap needs the marks SORTED for a backward lookup, and

View file

@ -29,7 +29,7 @@
(:require [arthur.domain.leaf :as leaf] (:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire])) [arthur.domain.wire :as wire]))
(def schema-version 5) (def schema-version 6)
(defn block-keys (defn block-keys
"Every tier-2 key a leaf map names, in a stable order." "Every tier-2 key a leaf map names, in a stable order."

View file

@ -24,6 +24,53 @@
(.fill buf index) (.fill buf index)
r) r)
;; ---------------------------------------------------------------------------
;; layers and knockouts
;;
;; A symbol holding a KNOCKOUT shape is drawn into a layer of its own first —
;; Flash's Erase blend inside a symbol set to Layer. A layer is a raster with a
;; `:cov` byte per pixel saying whether anything is there; a knockout clears
;; coverage, of every colour or of one, and the layer lands on the one under it
;; only where it is covered. The main raster has no `:cov` and is always
;; covered.
;;
;; THE INK is how a shape marks the pixels it covers, and there are three, as
;; Deluxe Paint and Animator Pro had inks:
;;
;; nil an ordinary fill: write the shape's index
;; a number a knockout: clear coverage — of every colour at -1, or of
;; that index only
;; a Uint8Array a REMAP, index -> index: what is already there is drawn
;; in another slot. A flashlight is a circle of this.
(defn- plot! [^js buf cov o index ink]
(cond
(nil? ink) (do (aset buf o index)
(when cov (aset cov o 1)))
(number? ink) (when (and cov (or (neg? ink) (== (aget buf o) ink)))
(aset cov o 0))
:else (aset buf o (aget ink (aget buf o)))))
(defn- shows?
"Does pixel `o` hold `over`? A stencil only matches what is really there, so
an uncovered pixel of a layer holds nothing."
[^js buf cov o over]
(or (nil? over)
(and (or (nil? cov) (== 1 (aget cov o))) (== (aget buf o) over))))
(defn layer [w h]
{:w w :h h :buf (js/Uint8Array. (* w h)) :cov (js/Uint8Array. (* w h))})
(defn composite!
"Land layer `l` on raster `r` wherever `l` is covered."
[{:keys [buf cov] :as r} l]
(let [^js lb (:buf l) ^js lc (:cov l)]
(dotimes [o (.-length lb)]
(when (== 1 (aget lc o))
(aset buf o (aget lb o))
(when cov (aset cov o 1)))))
r)
(defn fill-poly-buf! (defn fill-poly-buf!
"Even-odd scanline fill of a polygon held FLAT in `pts` as [x0 y0 x1 y1 …], "Even-odd scanline fill of a polygon held FLAT in `pts` as [x0 y0 x1 y1 …],
using the first `n` points. Samples at pixel centres (y + 0.5), so a polygon using the first `n` points. Samples at pixel centres (y + 0.5), so a polygon
@ -35,8 +82,9 @@
allocation is the only thing that will make this stutter. allocation is the only thing that will make this stutter.
`pts` may be a CLJS vector or any typed array; scanline crossings are collected `pts` may be a CLJS vector or any typed array; scanline crossings are collected
into a plain JS array and sorted in place." into a plain JS array and sorted in place. `ink` is as `plot!`'s."
[{:keys [w h buf] :as r} pts n index] ([r pts n index] (fill-poly-buf! r pts n index nil))
([{:keys [w h buf cov] :as r} pts n index ink]
(when (>= n 3) (when (>= n 3)
(let [px (fn [i] (if (vector? pts) (-nth pts (* 2 i)) (aget pts (* 2 i)))) (let [px (fn [i] (if (vector? pts) (-nth pts (* 2 i)) (aget pts (* 2 i))))
py (fn [i] (if (vector? pts) (-nth pts (inc (* 2 i))) (aget pts (inc (* 2 i))))) py (fn [i] (if (vector? pts) (-nth pts (inc (* 2 i))) (aget pts (inc (* 2 i)))))
@ -78,8 +126,8 @@
x-to (min (dec w) (js/Math.floor (- xb 0.5))) x-to (min (dec w) (js/Math.floor (- xb 0.5)))
row (* y w)] row (* y w)]
(dotimes [dx (inc (- x-to x-from))] (dotimes [dx (inc (- x-to x-from))]
(aset buf (+ row x-from dx) index))))))))) (plot! buf cov (+ row x-from dx) index ink)))))))))
r) r))
(defn fill-poly! (defn fill-poly!
"`fill-poly-buf!` over a seq of {:x :y} points. "`fill-poly-buf!` over a seq of {:x :y} points.
@ -99,8 +147,9 @@
any radius, including mid-blink when the opening is a two-pixel sliver, so any radius, including mid-blink when the opening is a two-pixel sliver, so
the lid crops the iris for free instead of the gaze range needing a the lid crops the iris for free instead of the gaze range needing a
clamp that would flatten the performance at the extremes." clamp that would flatten the performance at the extremes."
([r cx cy rad index] (fill-disc! r cx cy rad index nil)) ([r cx cy rad index] (fill-disc! r cx cy rad index nil nil))
([{:keys [w h buf] :as r} cx cy rad index over] ([r cx cy rad index over] (fill-disc! r cx cy rad index over nil))
([{:keys [w h buf cov] :as r} cx cy rad index over ink]
(let [rr (* rad rad) (let [rr (* rad rad)
y0 (max 0 (js/Math.floor (- cy rad))) y0 (max 0 (js/Math.floor (- cy rad)))
y1 (min (dec h) (js/Math.ceil (+ cy rad))) y1 (min (dec h) (js/Math.ceil (+ cy rad)))
@ -114,8 +163,8 @@
dy (- (+ y 0.5) cy)] dy (- (+ y 0.5) cy)]
(when (<= (+ (* dx dx) (* dy dy)) rr) (when (<= (+ (* dx dx) (* dy dy)) rr)
(let [o (+ (* y w) x)] (let [o (+ (* y w) x)]
(when (or (nil? over) (= (aget buf o) over)) (when (shows? buf cov o over)
(aset buf o index))))))) (plot! buf cov o index ink)))))))
r))) r)))
(defn fill-rect! (defn fill-rect!
@ -132,8 +181,9 @@
on every frame. Round the extents instead and a fractional centre gives you on every frame. Round the extents instead and a fractional centre gives you
three pixels on one frame and four on the next, which reads as the pupil three pixels on one frame and four on the next, which reads as the pupil
breathing." breathing."
([r cx cy size index] (fill-rect! r cx cy size index nil)) ([r cx cy size index] (fill-rect! r cx cy size index nil nil))
([{:keys [w h buf] :as r} cx cy size index over] ([r cx cy size index over] (fill-rect! r cx cy size index over nil))
([{:keys [w h buf cov] :as r} cx cy size index over ink]
(let [size (js/Math.round size)] (let [size (js/Math.round size)]
(when (>= size 1) (when (>= size 1)
(let [x0 (js/Math.round (- cx (/ size 2))) (let [x0 (js/Math.round (- cx (/ size 2)))
@ -143,8 +193,8 @@
(dotimes [iy (- yb ya)] (dotimes [iy (- yb ya)]
(dotimes [ix (- xb xa)] (dotimes [ix (- xb xa)]
(let [o (+ (* (+ ya iy) w) xa ix)] (let [o (+ (* (+ ya iy) w) xa ix)]
(when (or (nil? over) (= (aget buf o) over)) (when (shows? buf cov o over)
(aset buf o index)))))))) (plot! buf cov o index ink))))))))
r)) r))
(def ^:private little-endian? (def ^:private little-endian?
@ -223,6 +273,27 @@
(aset d (+ o 3) 255)))))) (aset d (+ o 3) 255))))))
{:width W :height H :data d}))) {:width W :height H :data d})))
(defn- fill-mask!
"Every pixel set in `mask`, a byte per stage pixel: a brush stroke as it is
being painted, before it is a polygon."
[{:keys [buf cov] :as r} ^js mask index ink]
(dotimes [o (.-length mask)]
(when (== 1 (aget mask o))
(plot! buf cov o index ink)))
r)
;; One layer per depth of nesting, reused from frame to frame, as the resolver
;; reuses its point buffers.
(defonce ^:private layers (atom {}))
(defn- layer-at [depth w h]
(let [l (get @layers depth)]
(if (and l (= w (:w l)) (= h (:h l)))
l
(let [l (layer w h)]
(swap! layers assoc depth l)
l))))
(defn draw-ops! (defn draw-ops!
"Paint a list of draw ops, in the order given, into the raster. Stage 7. "Paint a list of draw ops, in the order given, into the raster. Stage 7.
@ -230,12 +301,26 @@
space points and a PALETTE INDEX, and the rasteriser knows nothing about nodes, space points and a PALETTE INDEX, and the rasteriser knows nothing about nodes,
channels, time maps or provenance. Everything above here can be rearranged channels, time maps or provenance. Everything above here can be rearranged
without touching a scanline, and a painted cel and a rotoscoped mouth arrive without touching a scanline, and a painted cel and a rotoscoped mouth arrive
here indistinguishable from each other, which is the point." here indistinguishable from each other, which is the point.
[r ops]
(doseq [{:keys [kind pts n color stencil cx cy size] :as op} ops] `:begin` and `:end` bracket the ops of a symbol drawn into a layer of its own;
`:knock` on an op makes it a knockout and `:lut` a remap. See `plot!`."
[{:keys [w h] :as r} ops]
(reduce
(fn [stack {:keys [kind pts n color stencil cx cy size] :as op}]
(let [top (peek stack)
ink (or (:knock op) (:lut op))]
(case kind (case kind
:poly (fill-poly-buf! r pts n color) :begin (let [l (layer-at (count stack) w h)]
:disc (fill-disc! r cx cy (:r op) color stencil) (.fill (:cov l) 0)
:rect (fill-rect! r cx cy size color stencil) (conj stack l))
(throw (ex-info "draw op kind is not rasterisable" {:op (dissoc op :pts)})))) :end (if (< 1 (count stack))
(let [s (pop stack)] (composite! (peek s) top) s)
stack)
:poly (do (fill-poly-buf! top pts n color ink) stack)
:disc (do (fill-disc! top cx cy (:r op) color stencil ink) stack)
:rect (do (fill-rect! top cx cy size color stencil ink) stack)
:mask (do (fill-mask! top (:mask op) color ink) stack)
(throw (ex-info "draw op kind is not rasterisable" {:op (dissoc op :pts)})))))
[r] ops)
r) r)

View file

@ -56,7 +56,6 @@
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.trace :as trace]
[arthur.domain.palette :as pal])) [arthur.domain.palette :as pal]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -137,7 +136,8 @@
(let [n (get nodes id) t (:time n)] (let [n (get nodes id) t (:time n)]
(when (and n (not (contains? seen id)) (when (and n (not (contains? seen id))
(not (:loop? t)) (not (:loop? t))
(<= (or (:expose t) 1) 1)) (<= (or (:expose t) 1) 1)
(empty? (:holds t)))
(recur (:parent n) (conj seen id) (conj chain n))))))) (recur (:parent n) (conj seen id) (conj chain n)))))))
(defn lane? (defn lane?
@ -280,6 +280,41 @@
(nil? k) 255 (nil? k) 255
:else (get palette k 255))) :else (get palette k 255)))
(defn knockout?
"Is colour `c` a KNOCKOUT rather than a tone? `:clear` clears every colour
beneath it in its symbol, `[:clear tone]` clears that tone only. See
`raster/plot!`."
[c]
(or (= :clear c) (and (vector? c) (= :clear (first c)))))
(defn remap?
"Is colour `c` a REMAP: `[:remap {from to …}]`, slots of the palette in
scope? It draws nothing of its own; what is already under it is drawn in
other slots — a flashlight is a circle of this. See `raster/plot!`."
[c]
(and (vector? c) (= :remap (first c))))
(defn- knock-index [palette c]
(if (= :clear c) -1 (colour-index palette (second c))))
(defn lut
"Remap `[:remap m]` as a raster index -> index table in `palette`. Slots of
any other palette are left as they are."
[palette [_ m]]
(let [t (js/Uint8Array. 256)]
(dotimes [i 256] (aset t i i))
(doseq [[a b] m] (aset t (colour-index palette a) (colour-index palette b)))
t))
(defn knocks?
"Does any node in `nodes` knock out, on any frame? Such a symbol is drawn into
a layer of its own."
[nodes]
(some (fn [[_ n]]
(let [c (get-in n [:channels [:style :color]])]
(some knockout? (cons (:value c) (vals (:keys c))))))
nodes))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the walk ;; the walk
@ -401,7 +436,14 @@
"Emit geometry in the symbol's space. Rect sizes stay fractional until "Emit geometry in the symbol's space. Rect sizes stay fractional until
rasterization, so enclosing symbol transforms can still scale them." rasterization, so enclosing symbol transforms can still scale them."
[{:keys [palette buf-for]} n {:keys [m rd]} base] [{:keys [palette buf-for]} n {:keys [m rd]} base]
(let [colour #(colour-index palette (rd [:style :color]))] ;; Read only by the kinds that have a colour: a group or an instance has no
;; `[:style :color]` to read.
(let [paint (fn [op]
(let [c (rd [:style :color])]
(cond
(knockout? c) (assoc op :knock (knock-index palette c) :color 0)
(remap? c) (assoc op :lut (lut palette c) :color 0)
:else (assoc op :color (colour-index palette c)))))]
(case (:kind n) (case (:kind n)
:group nil :group nil
:instance nil :instance nil
@ -415,23 +457,21 @@
(node/apply-pt! out k m (node/apply-pt! out k m
(ch/component pts (* 2 k)) (ch/component pts (* 2 k))
(ch/component pts (inc (* 2 k))))) (ch/component pts (inc (* 2 k)))))
(assoc base :kind :poly :pts out :n np :color (colour))))) (paint (assoc base :kind :poly :pts out :n np)))))
:disc :disc
(let [rad (rd [:geom :radius])] (let [rad (rd [:geom :radius])]
(when-not (ch/nothing? rad) (when-not (ch/nothing? rad)
(assoc base :kind :disc (paint (assoc base :kind :disc
:cx (aget m 4) :cy (aget m 5) :cx (aget m 4) :cy (aget m 5)
:r (* rad (node/mean-scale m)) :r (* rad (node/mean-scale m))))))
:color (colour))))
:rect :rect
(let [size (rd [:geom :size])] (let [size (rd [:geom :size])]
(when-not (ch/nothing? size) (when-not (ch/nothing? size)
(assoc base :kind :rect (paint (assoc base :kind :rect
:cx (aget m 4) :cy (aget m 5) :cx (aget m 4) :cy (aget m 5)
:size (* size (node/mean-scale m)) :size (* size (node/mean-scale m))))))
:color (colour))))
(throw (ex-info "node kind is not implemented" (throw (ex-info "node kind is not implemented"
{:node (:id n) :kind (:kind n)}))))) {:node (:id n) :kind (:kind n)})))))
@ -457,7 +497,7 @@
(into {} (remove #(= :audio (:kind (val %)))) nodes))) (into {} (remove #(= :audio (:kind (val %)))) nodes)))
(defn- base-channel-frame (defn- base-channel-frame
"A trace selects the measured frames its node reads; marked channels read "`:reads` holds the frames a node's own channels read; marked channels read
instance pose choices, and the preserve-snap where nobody has made one. instance pose choices, and the preserve-snap where nobody has made one.
`lf` is this slot's local frame and `plf` the PREVIOUS slot's, both already `lf` is this slot's local frame and `plf` the PREVIOUS slot's, both already
@ -466,10 +506,10 @@
snap needs from the grid, and it is why the pair is threaded this far down snap needs from the grid, and it is why the pair is threaded this far down
instead of the snap happening where the grid becomes a native frame: the snap is instead of the snap happening where the grid becomes a native frame: the snap is
per pose group, and a group is a fact that only exists here." per pose group, and a group is a fact that only exists here."
[choices marks traces nodes id c lf plf] [choices marks reads nodes id c lf plf]
(cond (cond
(contains? traces id) (contains? reads id)
(trace/held-frame (get traces id) lf) (node/hold (js/Math.floor lf) (get reads id))
(:pose-sampled? c) (:pose-sampled? c)
(let [group (or (:pose-group (get nodes id)) id)] (let [group (or (:pose-group (get nodes id)) id)]
@ -487,12 +527,19 @@
:else (js/Math.floor lf))) :else (js/Math.floor lf)))
(defn- prepared-traces [nodes] (defn- holds-read
(into {} "The frames node `n` reads its OWN channels at, held — not its children's,
(for [[id n] nodes which is what makes this different from `:time :holds` — or nil for every
:let [p (trace/prepare (:trace n))] frame. `{:holds [0]}` is a face's head at its start, and `{:holds-of :plate}`
:when p] is the head holding wherever its footage holds, which is one list of frames
[id p]))) read by two nodes rather than two lists kept in step."
[nodes n]
(let [{:keys [holds holds-of]} (:reads n)
hs (if holds-of (get-in nodes [holds-of :time :holds]) holds)]
(when (seq hs) hs)))
(defn- prepared-reads [nodes]
(into {} (keep (fn [[id n]] (some->> (holds-read nodes n) (vector id)))) nodes))
(defn- eval-into (defn- eval-into
"One frame, as a fold over the nodes in topological order. "One frame, as a fold over the nodes in topological order.
@ -550,10 +597,10 @@
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
marks (when (and snap (snap (:id sym))) marks (when (and snap (snap (:id sym)))
(pose/marks nodes (:frames sym) store)) (pose/marks nodes (:frames sym) store))
traces (prepared-traces nodes) reads (prepared-reads nodes)
ord (order nodes)] ord (order nodes)]
(eval-into {:read (fn [id path c lf plf] (eval-into {:read (fn [id path c lf plf]
(ch/value-at c (base-channel-frame choices marks traces (ch/value-at c (base-channel-frame choices marks reads
nodes id c lf plf) nodes id c lf plf)
lf store)) lf store))
:palette palette :palette palette
@ -636,11 +683,11 @@
;; argument, and any predicate on one will do. ;; argument, and any predicate on one will do.
;; ;;
;; One option, and it is the snap's alone. The plate side will never want ;; One option, and it is the snap's alone. The plate side will never want
;; one — its proposal is materialised into `:trace :frames` rather than ;; one — its proposal is materialised into the plate's `:time :holds` rather than
;; computed on the render path — so this is not half of a pair. ;; computed on the render path — so this is not half of a pair.
marks (when (and snap (snap (:id sym))) marks (when (and snap (snap (:id sym)))
(pose/marks nodes (:frames sym) store)) (pose/marks nodes (:frames sym) store))
traces (prepared-traces nodes) reads (prepared-reads nodes)
ord (order nodes) ord (order nodes)
rank (draw-rank nodes ord) rank (draw-rank nodes ord)
cursors (into {} cursors (into {}
@ -665,7 +712,7 @@
ctx {:read (fn [id path c lf plf] ctx {:read (fn [id path c lf plf]
(when-let [cursor (get-in cursors [id path])] (when-let [cursor (get-in cursors [id path])]
(ch/sample! cursor (ch/sample! cursor
(base-channel-frame choices marks traces (base-channel-frame choices marks reads
nodes id c lf plf) nodes id c lf plf)
lf))) lf)))
:palette palette :palette palette
@ -708,9 +755,34 @@
`:display` is how the TIMELINE draws the symbol — `:lane` for its clips as `: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 blocks on one row — and is saved because two people editing one document must
play by the same editing rules. See `lane?`." play by the same editing rules. See `lane?`.
`:media` is what a `:type :trace` symbol shows — `{:footage id :range [in
out]}` or `{:image sha256}` — and such a symbol has no nodes: its frames are
the footage's, its `:fps` the footage's own and its `:width`/`:height` its
pixels. A still shows the same picture on every one of its frames, so how many
it has is only how long it was made to last, and trimming its placement is
how that changes. See `clip/trace-op`."
#{:id :name :frames :fps :width :height :nodes :palette :palette-track #{:id :name :frames :fps :width :height :nodes :palette :palette-track
:palette-channel :type :palette-ref :display}) :palette-channel :type :palette-ref :display :media})
(defn- media-problems
"Why `sym`, a tracing symbol, does not say what it shows. Empty when it does."
[{:keys [media frames width height nodes]}]
(let [{:keys [footage image range]} media]
(cond-> []
(seq nodes)
(conj "a tracing symbol cannot contain nodes")
(not (= 1 (count (filter some? [footage image]))))
(conj ":media must name exactly one of :footage or :image")
(and footage (not (and (vector? range) (= 2 (count range))
(every? integer? range) (apply < range)
(= frames (- (second range) (first range))))))
(conj "a footage :media needs a [in out) :range as long as the symbol's :frames")
(not (and (integer? frames) (pos? frames)))
(conj "a tracing symbol is a positive whole number of frames")
(not (and (pos? width) (pos? height)))
(conj "a tracing symbol needs its media's pixel :width and :height"))))
(defn problems (defn problems
"Human-readable reasons this symbol will not evaluate. Empty means it will. "Human-readable reasons this symbol will not evaluate. Empty means it will.
@ -731,6 +803,7 @@
(cond-> (cond->
(and (= :palette (:type sym)) (seq nodes)) (and (= :palette (:type sym)) (seq nodes))
(conj "a palette symbol cannot contain nodes")) (conj "a palette symbol cannot contain nodes"))
(into (when (= :trace (:type sym)) (media-problems sym)))
(into (for [[id n] nodes (into (for [[id n] nodes
:when (not= id (:id n))] :when (not= id (:id n))]
(str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) (str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))
@ -745,13 +818,30 @@
(into (for [[id n] nodes (into (for [[id n] nodes
p (node/problems n)] p (node/problems n)]
(str "node " (pr-str id) ": " p))) (str "node " (pr-str id) ": " p)))
;; A trace re-addresses the node's measurement, regardless of its name.
(into (for [[id n] nodes (into (for [[id n] nodes
:when (some? (:trace n)) :when (some? (:trace n))]
p (if (and (integer? (:frames sym)) (seq (:measured n)) (str "node " (pr-str id) ": :trace is gone — trace keys are the "
(= (:channels n) (:measured n))) "footage placement's :time :holds, and a head follows them "
(trace/problems (:trace n) (:frames sym)) "with :reads {:holds-of …}; make the face again from its footage")))
["a trace reads the node's own measured channels"])] ;; `:reads` names its holds or another node's, the way `:stencil` names
;; a node: one that is here, and never one whose frame depends on the
;; reader's own channels being read first.
(into (for [[id n] nodes
:let [{:keys [holds holds-of] :as r} (:reads n)]
:when (some? r)
p (cond
(and holds holds-of)
[":reads names its own :holds or a node's, not both"]
holds-of
(cond
(not (contains? nodes holds-of))
[(str ":reads :holds-of " (pr-str holds-of) " is not in the symbol")]
(some #{holds-of} (lineage nodes id))
[":reads :holds-of names the node itself or one above it"])
:else
(when-not (and (vector? holds) (every? node/finite-number? holds)
(or (empty? holds) (apply < holds)))
[":reads :holds must be a vector of increasing frames"]))]
(str "node " (pr-str id) ": " p))) (str "node " (pr-str id) ": " p)))
(into (for [k (remove symbol-keys (keys sym))] (into (for [k (remove symbol-keys (keys sym))]
(str "symbol has a field with no leaf to save it in: " (pr-str k)))) (str "symbol has a field with no leaf to save it in: " (pr-str k))))

View file

@ -1,164 +0,0 @@
(ns arthur.domain.trace
"Tracing a face over its footage: which source frame the photo shows, where the
face's origin goes between those frames, and where the photo sits on stage.
TWO OWNERS, because they are two different kinds of decision. The trace frames
and the origin are the face's — they say how its drawings were made and how it
moves, so they live on its symbol's `:head`, and every instance of that face
shares them:
:trace {:frames [0 12 30] :origin :keys}
Whether the photo is showing, and how strongly, is not the document's at all.
It is a viewing aid, like soloing a row, so it lives in the editor's own state
— `[:ui :trace]`, a set of face symbols switched on and one opacity — and is
never keyed, saved or exported. A face is the same face wherever it is placed,
so one switch shows it in the take it is placed in AND in its own tab, which is
where it is drawn over; nothing has to be switched on twice or per placement.
THE TRACE IS THE ONE FACT about which measured frame a head reads. `:continuous`
reads the frame it is on, `:keys` jumps to each trace frame's measured head and
holds it — a hold, not a tween — and `:start` holds frame 0's forever. Before
the first trace frame, the first holds. `domain/symbol` reads the head through
`held-frame`, so nothing is derived from the trace and stored beside it.
Normalisation is per face because each face symbol has its own head."
(:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]))
(def origins [:continuous :keys :start])
(def ^:const opacity-default
"How strongly a switched-on photo draws until someone moves the slider."
0.5)
(defn of
"The head's trace, a head that has none being one that moves freely."
[head]
(merge {:frames [] :origin :continuous} (:trace head)))
(defn prepare
"Trace `t` ready to be read every frame without allocating, or nil for a head
that reads the frame it is on."
[t]
(let [{:keys [frames origin]} (merge {:frames []} t)]
(case origin
:start {:entries [] :before 0}
:keys {:entries (mapv #(vector % %) frames) :before (or (first frames) 0)}
nil)))
(defn held-frame
"The measured frame a head with prepared trace `p` reads at its frame `f`."
[p f]
(pose/held-frame (:entries p) f (:before p)))
(defn problems
"Why `t` is not a trace for a symbol `frames` long. Empty when it is one."
[t frames]
(let [fs (:frames t)]
(cond-> []
(not (some #{(:origin t)} origins))
(conj (str ":origin is " (pr-str (:origin t)) ", not one of " (pr-str origins)))
(not (and (vector? fs) (= fs (vec (sort (distinct fs))))
(every? #(and (integer? %) (<= 0 %) (< % frames)) fs)))
(conj (str ":frames must be distinct frames of the symbol, in order: " (pr-str fs))))))
(defn toggle-frame
"A trace frame at `f`, or none there if there was one."
[t f]
(update t :frames
#(vec (sort (if (some #{f} %) (remove #{f} %) (conj % f))))))
(defn photo-frame
"Which of the face's own frames the photo shows at frame `f`: the last trace
frame at or before it, held, and before the first the first. With none, every
frame is its own."
[{:keys [frames]} f]
(if (seq frames)
(or (last (take-while #(<= % f) frames)) (first frames))
f))
(defn- measured-local
"The head's own measured transform at frame `p`, or nil where the face was not
found and there is none."
[head store p]
(let [[pos rot scale] (map #(ch/value-at (get (:measured head) %) p store)
[[:xform :pos] [:xform :rot] [:xform :scale]])]
(when-not (some ch/nothing? [pos rot scale])
(node/local! (node/mat) pos rot scale [0 0] [0 0]))))
(defn photo-matrix
"From the pixels of source frame `p`'s still, `image-h` pixels tall, to where
the head at world `world` puts them.
The landmarks were measured in image heights, so a pixel is 1/image-h of one;
the head's measured transform at `p` takes that frame's image space into the
head's; `world` takes the head's to the stage. When the head is showing frame
`p` itself the middle two cancel, and the photo sits exactly where the face
was filmed."
[world head store p image-h]
(when-let [inv (some-> (measured-local head store p) node/invert)]
(let [px (js/Float64Array. #js [(/ 1 image-h) 0 0 (/ 1 image-h) 0 0])]
(node/mul! (node/mat) (node/mul! (node/mat) world inv) px))))
(defn traceable?
"Does symbol `sid` have a measured head to trace over?"
[clip sid]
(seq (get-in clip [:symbols sid :nodes :head :measured])))
(defn faces
"The instances of faces inside symbol `sid`, at any depth, as `{:path :in
:face}`: the row path from `sid`, the symbol the instance is in, and the face
symbol it places."
[clip sid]
(letfn [(walk [sid path]
(mapcat (fn [[id n]]
(when (= :instance (:kind n))
;; Every drawing the lane can show, not only the one it
;; happens to be on: a face traced in one cel is the same
;; face when the lane cuts to another.
(let [p (conj path id)]
(mapcat (fn [child]
(cond->> (walk child p)
(traceable? clip child)
(cons {:path p :in sid :face child})))
(sort-by str (node/sources n))))))
(sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))]
(vec (walk sid []))))
(defn traceable-faces
"Every face that can be traced while symbol `sid` is open, each once: `sid`
itself when it is a face — open in its own tab, to be drawn over — and the
faces placed inside it at any depth."
[clip sid]
(into [] (distinct)
(cond->> (map :face (faces clip sid))
(traceable? clip sid) (cons sid))))
(defn showing-for
"The faces showing their footage once `sid` is the open symbol, given the ones
`on` already showing.
OPENING A FACE IS ASKING TO DRAW OVER IT: a symbol has measured footage behind
it only because it was traced from that footage, so its own tab starts with the
footage showing rather than with a switch to be found first. A take or a scene
is the picture itself, and a reference drawn over one would read as part of it,
so nothing is switched on for those. Either way it is switched by hand
afterwards, from the inspector's footage section or from a face's own timeline
row."
[clip sid on]
(cond-> (set on) (traceable? clip sid) (conj sid)))
(defn shown
"The faces whose footage is showing while symbol `sid` is open, as `faces` lists
them — the row path of the face's instance from `sid`, and the face — filtered
to the `showing` set.
The open symbol itself is in the list, at the EMPTY path, when it is a face:
that is a face open in its own tab to be drawn over, and the one place tracing
matters most. There is no inheritance to work out and no opacity to carry
because the switch is the face's, not a placement's."
[clip sid showing]
(into [] (filter (comp (set showing) :face))
(cond->> (faces clip sid)
(traceable? clip sid) (cons {:path [] :in sid :face sid}))))

View file

@ -315,8 +315,10 @@
(fn [_] (fn [_]
(-> (js/Promise.all #js [(ingest/available!) (-> (js/Promise.all #js [(ingest/available!)
(.then (http/GET "/api/sounds") (.then (http/GET "/api/sounds")
#(:sounds (js->clj % :keywordize-keys true)))]) #(:sounds (js->clj % :keywordize-keys true)))
(.then (fn [[footage sounds]] (rf/dispatch [::listed footage sounds]))) (.then (http/GET "/api/images")
#(:images (js->clj % :keywordize-keys true)))])
(.then (fn [[footage sounds images]] (rf/dispatch [::listed footage sounds images])))
(.catch (fn [error] (.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))])))))) (rf/dispatch [::failed (or (ex-message error) (str error))]))))))
@ -356,17 +358,34 @@
(.catch (fn [error] (.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))) (rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(rf/reg-fx
::upload-image!
(fn [file]
(let [form (js/FormData.)]
(.append form "file" file)
(-> (http/POST-form "/api/images" form)
(.then (fn [^js image] (rf/dispatch [::uploaded (.-id image) "image imported"])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(rf/reg-event-fx (rf/reg-event-fx
::upload ::upload
(fn [{:keys [db]} [_ ^js file]] (fn [{:keys [db]} [_ ^js file]]
;; By type, and by name for a browser that leaves the type empty. ;; By type, and by name for a browser that leaves the type empty.
(let [sound? (and file (or (string/starts-with? (.-type file) "audio/") (let [kind (when file
(re-find #"(?i)\.(mp3|wav|aiff?|flac|ogg|m4a|aac)$" (.-name file))))] (cond
(or (string/starts-with? (.-type file) "audio/")
(re-find #"(?i)\.(mp3|wav|aiff?|flac|ogg|m4a|aac)$" (.-name file)))
:sound
(or (string/starts-with? (.-type file) "image/")
(re-find #"(?i)\.(png|jpe?g|gif|webp)$" (.-name file)))
:image
:else :video))]
(if (or (nil? file) (get-in db [:footage :loading?])) (if (or (nil? file) (get-in db [:footage :loading?]))
{} {}
{:db (update db :footage merge {:loading? true {:db (update db :footage merge {:loading? true
:status (if sound? "uploading sound…" "uploading video…")}) :status (str "uploading " (name kind) "…")})
(if sound? ::upload-sound! ::upload!) file})))) (case kind :sound ::upload-sound! :image ::upload-image! ::upload!) file}))))
(rf/reg-event-fx (rf/reg-event-fx
::uploaded ::uploaded
@ -386,10 +405,11 @@
(rf/reg-event-db (rf/reg-event-db
::listed ::listed
(fn [db [_ footage sounds]] (fn [db [_ footage sounds images]]
(update db :footage merge (update db :footage merge
(cond-> {:available (vec footage) (cond-> {:available (vec footage)
:sounds (vec sounds) :sounds (vec sounds)
:images (vec images)
:chosen (or (:chosen (:footage db)) (:id (first footage)))} :chosen (or (:chosen (:footage db)) (:id (first footage)))}
(empty? footage) (assoc :status "upload a video to begin"))))) (empty? footage) (assoc :status "upload a video to begin")))))
@ -438,12 +458,13 @@
(rf/reg-event-fx (rf/reg-event-fx
::relabel ::relabel
(fn [{:keys [db]} [_ kind id value]] (fn [{:keys [db]} [_ kind id value]]
;; `kind` is `:footage` or `:sound`: two resources with one field between ;; `kind` is `:footage`, `:sound` or `:image`: resources with one field between
;; them, and one event rather than two that differ by a path and a URL. ;; them, and one event rather than two that differ by a path and a URL.
(let [label (string/trim (str value)) (let [label (string/trim (str value))
[key url] (case kind [key url] (case kind
:footage [:available (str "/api/footage/" id)] :footage [:available (str "/api/footage/" id)]
:sound [:sounds (str "/api/sounds/" id)] :sound [:sounds (str "/api/sounds/" id)]
:image [:images (str "/api/images/" id)]
[nil nil])] [nil nil])]
(if (or (nil? id) (nil? key)) (if (or (nil? id) (nil? key))
{} {}
@ -474,7 +495,7 @@
::ask-convert ::ask-convert
(fn [db [_ {:keys [frames label] :as footage} frame point target]] (fn [db [_ {:keys [frames label] :as footage} frame point target]]
(assoc-in db [:ui :convert] (assoc-in db [:ui :convert]
(merge (select-keys footage [:id :label :frames :fps :video]) (merge (select-keys footage [:id :label :frames :fps :video :width :height])
{:range [0 frames] {:range [0 frames]
:name (string/replace (str label) #"\.[^.]*$" "") :name (string/replace (str label) #"\.[^.]*$" "")
:host (get-in db [:ui :open]) :frame frame :point point :host (get-in db [:ui :open]) :frame frame :point point
@ -499,6 +520,25 @@
::pb/pause! nil ::pb/pause! nil
::convert! {:footage-id id :range range :request request}})))) ::convert! {:footage-id id :range range :request request}}))))
(rf/reg-event-fx
::convert-tracing
;; The same question answered the other way: the chosen frames become a tracing
;; layer to draw over, with nothing detected and nothing measured. Its frames
;; are the footage's own and its rate the footage's, so it plays at the speed it
;; was filmed in a project at any rate.
(fn [{:keys [db]} _]
(let [{:keys [id range fps width height name frame point target] :as request}
(get-in db [:ui :convert])]
(if (or (nil? request) (get-in db [:footage :loading?]))
{}
{:db (update db :ui dissoc :convert)
:dispatch [::ui/drop-tracing
{:name name :type :trace
:media {:footage id :range range}
:frames (- (second range) (first range)) :fps fps
:width width :height height :nodes {}}
frame point target]}))))
(rf/reg-event-fx (rf/reg-event-fx
::converted ::converted
;; A TAKE IS A CLIP LIKE ANY OTHER, placed into whichever symbol the drop names ;; A TAKE IS A CLIP LIKE ANY OTHER, placed into whichever symbol the drop names

View file

@ -13,7 +13,7 @@
(:require [arthur.audio.mix :as mix] (:require [arthur.audio.mix :as mix]
[arthur.clock :as clock] [arthur.clock :as clock]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.trace :as trace] [arthur.db :as app-db]
[arthur.footage.store :as footage] [arthur.footage.store :as footage]
[re-frame.core :as rf])) [re-frame.core :as rf]))
@ -39,11 +39,10 @@
:clip (select-keys entry [:fps :width :height :audio])) :clip (select-keys entry [:fps :width :height :audio]))
(update :ui merge (update :ui merge
{:open sid :tabs (if sid [sid] []) {:open sid :tabs (if sid [sid] [])
;; From scratch, not merged: the faces switched on were another ;; The layers switched off were another document's, and their
;; document's, and a face id means nothing in this one. ;; ids mean nothing in this one. Whether tracing shows at all,
:trace {:faces (trace/showing-for (:clip entry) sid #{}) ;; and how strongly, is the person's and carries over.
:opacity (or (get-in db [:ui :trace :opacity]) :tracing (assoc (get-in db [:ui :tracing] app-db/tracing) :hidden #{})})
trace/opacity-default)}})
;; Occurrence addresses belong to the document being left. Creation is ;; Occurrence addresses belong to the document being left. Creation is
;; derived from the primary selection, so carrying one across documents ;; derived from the primary selection, so carrying one across documents
;; could otherwise make a coincidentally equal id a nested destination. ;; could otherwise make a coincidentally equal id a nested destination.
@ -68,7 +67,7 @@
::play ::play
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
{:db (assoc-in db [:playback :playing?] true) {:db (assoc-in db [:playback :playing?] true)
::play! nil})) ::play-from! [(fps db) (frames db) (get-in db [:playback :frame] 0)]}))
(rf/reg-event-fx (rf/reg-event-fx
::pause ::pause
@ -81,7 +80,8 @@
(fn [{:keys [db]} _] (fn [{:keys [db]} _]
(if (get-in db [:playback :playing?]) (if (get-in db [:playback :playing?])
{:db (assoc-in db [:playback :playing?] false) ::pause! nil} {:db (assoc-in db [:playback :playing?] false) ::pause! nil}
{:db (assoc-in db [:playback :playing?] true) ::play! nil}))) {:db (assoc-in db [:playback :playing?] true)
::play-from! [(fps db) (frames db) (get-in db [:playback :frame] 0)]})))
(rf/reg-event-fx (rf/reg-event-fx
::seek ::seek
@ -104,6 +104,13 @@
;; --- effects: every DOM touch on the audio element is one of these --- ;; --- effects: every DOM touch on the audio element is one of these ---
(rf/reg-fx ::play! (fn [_] (clock/play!))) (rf/reg-fx ::play! (fn [_] (clock/play!)))
(rf/reg-fx ::play-from!
(fn [[fps frames f]]
;; The transport is the audio clock; app-db's frame is the visible
;; playhead. Re-anchor before starting so Play always honors the frame
;; currently shown, including after the clock has reached the clip end.
(clock/seek! fps frames f)
(clock/play!)))
(rf/reg-fx ::pause! (fn [_] (clock/pause!))) (rf/reg-fx ::pause! (fn [_] (clock/pause!)))
(rf/reg-fx ::rate! (fn [r] (clock/set-rate! r))) (rf/reg-fx ::rate! (fn [r] (clock/set-rate! r)))
(rf/reg-fx ::seek! (fn [[fps frames f]] (clock/seek! fps frames f))) (rf/reg-fx ::seek! (fn [[fps frames f]] (clock/seek! fps frames f)))
@ -212,7 +219,10 @@
::open-symbol ::open-symbol
(fn [{:keys [db]} [_ sid]] (fn [{:keys [db]} [_ sid]]
(let [clip (:clip (footage/entry (:clip/current db)))] (let [clip (:clip (footage/entry (:clip/current db)))]
(if (or (nil? (clip/symbol clip sid)) (= sid (get-in db [:ui :open]))) ;; A tracing symbol has no inside to open: it is footage, which is seen by
;; placing it.
(if (or (nil? (clip/symbol clip sid)) (= sid (get-in db [:ui :open]))
(clip/trace? (clip/symbol clip sid)))
{} {}
{:db (-> db {:db (-> db
(update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid))) (update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid)))
@ -224,7 +234,6 @@
(cond-> ui (cond-> ui
(= :node (first (:selection ui))) (= :node (first (:selection ui)))
(dissoc :selection :selections)))) (dissoc :selection :selections))))
(update-in [:ui :trace :faces] #(trace/showing-for clip sid %))
(assoc-in [:playback :frame] 0) (assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false)) (assoc-in [:playback :playing?] false))
::pause! nil ::pause! nil

View file

@ -757,6 +757,32 @@
(let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)] (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)]
(edit/edit db #(update-in % [:symbols sid :nodes id] put path frame value))))) (edit/edit db #(update-in % [:symbols sid :nodes id] put path frame value)))))
(rf/reg-event-db
::instance-playback
(fn [db [_ sid id field value]]
(let [valid? (case field
:mode (#{:once :loop :frame} value)
(:in :speed) (and (node/finite-number? value) (<= 0 value))
false)]
(if-not valid?
db
(edit/edit
db
(fn [document]
(let [path [:symbols sid :nodes id]
n (get-in document path)]
(if-not (= :instance (:kind n))
document
(let [{:keys [speed]} (node/playback-of n)
updated (if (= :mode field)
(-> n
(update :time dissoc :loop?)
(assoc-in [:playback :end] (if (= :loop value) :loop :stop))
(assoc-in [:playback :speed]
(if (= :frame value) 0 (if (pos? speed) speed 1))))
(assoc-in n [:playback field] value))]
(assoc-in document path updated))))))))))
(defn- seed-palette-choice [document sid id] (defn- seed-palette-choice [document sid id]
(if (get-in document [:symbols sid :nodes id :channels [:palette]]) (if (get-in document [:symbols sid :nodes id :channels [:palette]])
document document
@ -801,11 +827,28 @@
(let [st (:store (store/entry (:clip/current db)))] (let [st (:store (store/entry (:clip/current db)))]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame st))))) (edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame st)))))
;; A face's trace frames and origin, on its symbol — see `domain/trace`. ;; A hold on node `id`'s own frame `frame`, or none there if there was one: the
;; frames a tracing layer holds its picture on — a face's trace keys are its
;; plate's — and, for any node, `node/hold`. Taking the last one off removes the
;; floor rather than leaving an empty list behind.
(rf/reg-event-db (rf/reg-event-db
::set-trace ::toggle-hold
(fn [db [_ sid value]] (fn [db [_ sid id frame]]
(edit/edit db #(assoc-in % [:symbols sid :nodes :head :trace] value)))) (edit/edit db #(update-in % [:symbols sid :nodes id :time]
(fn [t]
(let [hs (get t :holds [])
hs (vec (sort (if (some #{frame} hs)
(remove #{frame} hs)
(conj hs frame))))]
(if (seq hs) (assoc t :holds hs) (dissoc t :holds))))))))
;; How a face's head moves between its footage's holds — `symbol`'s `:reads`.
;; Nil reads every frame.
(rf/reg-event-db
::set-reads
(fn [db [_ sid reads]]
(edit/edit db #(update-in % [:symbols sid :nodes :head]
(fn [n] (if reads (assoc n :reads reads) (dissoc n :reads)))))))
(rf/reg-event-db (rf/reg-event-db

View file

@ -17,12 +17,15 @@
app to change and the most expensive to have two copies of." app to change and the most expensive to have two copies of."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.keyframes :as keyframes]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clipboard :as clipboard] [arthur.domain.clipboard :as clipboard]
[arthur.domain.correction :as correction] [arthur.domain.correction :as correction]
[arthur.domain.cut :as cut]
[arthur.domain.creation :as creation] [arthur.domain.creation :as creation]
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.outline :as outline]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.span :as span] [arthur.domain.span :as span]
@ -70,7 +73,7 @@
(-> db (-> db
(assoc-in [:ui :selection] selection) (assoc-in [:ui :selection] selection)
(assoc-in [:ui :selections] (if selection [selection] [])) (assoc-in [:ui :selections] (if selection [selection] []))
(update :ui dissoc :points :retry))) (update :ui dissoc :retry)))
(rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection))) (rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection)))
@ -132,6 +135,34 @@
(edit/transaction (constantly (:clip result))) (edit/transaction (constantly (:clip result)))
(update :project merge {:status "edited · unsaved"})))) (update :project merge {:status "edited · unsaved"}))))
(rf/reg-event-db
::eye-key
(fn [db [_ sid repair-id side frame values]]
(apply-correction-command
db (correction/eye-key (:clip (store/entry (:clip/current db)))
sid repair-id side frame values))))
(rf/reg-event-db
::remove-eye-keys
(fn [db [_ sid repair-id side]]
(apply-correction-command
db (correction/remove-eye-keys (:clip (store/entry (:clip/current db)))
sid repair-id side))))
(rf/reg-event-db
::borrow-pose
(fn [db [_ sid spec]]
(let [entry (store/entry (:clip/current db))]
(apply-correction-command
db (correction/borrow-pose (:clip entry) sid
(assoc spec :id (random-uuid)) (:store entry))))))
(rf/reg-event-db
::remove-repair
(fn [db [_ sid id]]
(apply-correction-command
db (correction/remove-repair (:clip (store/entry (:clip/current db))) sid id))))
(rf/reg-event-db (rf/reg-event-db
::add-correction ::add-correction
(fn [db [_ sid id path spec]] (fn [db [_ sid id path spec]]
@ -369,30 +400,28 @@
:else #{path}))))) :else #{path})))))
(rf/reg-event-db (rf/reg-event-db
::trace-face ::show-trace
;; Showing the footage under a face is a viewing aid, like solo: editor state ;; One tracing layer on or off — `layer` is `[symbol-id node-id]`, see
;; rather than the document, so it is not an undo step, does not travel to a ;; `arthur.db/tracing`. Editor state, like solo: not an undo step, not sent to
;; collaborator and cannot reach an export. Per FACE and not per placement — a ;; a collaborator, and it cannot reach an export.
;; face is the same face wherever it is placed, and it is the face being traced ;;
;; — so one switch shows it in the take and in its own tab both. ;; SWITCHING ONE ON SWITCHES TRACING ON. A layer just asked for must not stay
(fn [db [_ face]] ;; invisible behind the global switch somebody forgot was off; switching one
(update-in db [:ui :trace :faces] ;; off leaves the global switch alone. One event, so the inspector, a timeline
#(if (contains? % face) (disj % face) (conj (set %) face))))) ;; row and a face's section cannot disagree about it.
(fn [db [_ layer on?]]
(update-in db [:ui :tracing]
#(cond-> (update % :hidden (fnil (if on? disj conj) #{}) layer)
on? (assoc :on? true)))))
(rf/reg-event-db (rf/reg-event-db
::trace-faces ::tracing-on
;; Every face the open symbol has, from the inspector's footage section: ;; Every tracing layer at once, from the bar above the stage.
;; switched on unless they all already are, which is the one gesture a person (fn [db [_ on?]] (assoc-in db [:ui :tracing :on?] (boolean on?))))
;; wants when there is exactly one face and when there are five.
(fn [db [_ faces]]
(let [faces (set faces)
on (set (get-in db [:ui :trace :faces]))]
(assoc-in db [:ui :trace :faces]
(if (every? on faces) (reduce disj on faces) (into on faces))))))
(rf/reg-event-db (rf/reg-event-db
::trace-opacity ::tracing-opacity
(fn [db [_ opacity]] (assoc-in db [:ui :trace :opacity] opacity))) (fn [db [_ opacity]] (assoc-in db [:ui :tracing :opacity] opacity)))
(rf/reg-event-db (rf/reg-event-db
::smart-picking ::smart-picking
@ -427,7 +456,7 @@
(-> db (-> db
(assoc-in [:ui :selection] primary) (assoc-in [:ui :selection] primary)
(assoc-in [:ui :selections] addresses) (assoc-in [:ui :selections] addresses)
(update :ui dissoc :points :retry)) (update :ui dissoc :retry))
(-> db (-> db
(assoc-in [:ui :selection] nil) (assoc-in [:ui :selection] nil)
(assoc-in [:ui :selections] []))))) (assoc-in [:ui :selections] [])))))
@ -500,24 +529,71 @@
(rf/reg-event-db ::duplicate-unique (fn [db _] (duplicate-selected db true))) (rf/reg-event-db ::duplicate-unique (fn [db _] (duplicate-selected db true)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; drawing a polygon ;; drawing
;; ;;
;; Three events and a vector of numbers. The draft is in app-db rather than in a ;; THE TOOL IS WHAT A DRAG ON THE STAGE DOES; the selection is what it does it
;; ratom because the stage draws it, the palette colours it and the params pane ;; to. One tool at a time, each with a key, as in Photoshop, Illustrator and
;; reports its vertex count — and because a half-drawn shape surviving a hot ;; Flash: V selects and transforms, P is the pen, B the brush, E the eraser.
;; reload is worth more than the handful of dispatches it costs. Clicks are rare; ;; Editing a shape's points is the pen ON that shape — Figma's vector edit
;; this is not the drag path. ;; mode — so there is no separate points mode to be in.
;;
;; The pen's draft is in app-db rather than in a ratom because the stage draws
;; it, the canvas fills it and the options bar counts it — and because a
;; half-drawn shape surviving a hot reload is worth more than the handful of
;; dispatches it costs. Clicks are rare; this is not the drag path. `:hover` is
;; where the pointer is while a draft is open, so the canvas can fill the shape
;; the next click would make.
(def tools #{:select :pen :brush :eraser})
(declare finishing-polygon)
(rf/reg-event-db
::set-tool
;; Leaving the pen commits what it was drawing, as Esc does: an unfinished
;; polygon is not a thing the document can hold.
(fn [db [_ tool]]
(if (contains? tools tool)
(-> (if (= tool (get-in db [:ui :tool])) db (finishing-polygon db))
(update :ui merge {:tool tool :draft []})
(update :ui dissoc :hover))
db)))
(rf/reg-event-db (rf/reg-event-db
::cancel-polygon ::cancel-polygon
(fn [db _] (update db :ui merge {:tool nil :draft []}))) (fn [db _] (update (assoc-in db [:ui :draft] []) :ui dissoc :hover)))
(rf/reg-event-db (rf/reg-event-db
::add-draft-point ::hover
(fn [db [_ x y]] (fn [db [_ p]] (if p (assoc-in db [:ui :hover] p) (update db :ui dissoc :hover))))
(if (= :polygon (get-in db [:ui :tool]))
(update-in db [:ui :draft] into [x y]) (def tool-keys #{"v" "p" "b" "e" "[" "]" "enter" "escape"})
db)))
(rf/reg-event-fx
::tool-key
;; A key from `ui/tools`, decided here against the state it changes, and
;; passed on as the event the button for it would send.
(fn [{:keys [db]} [_ k]]
(let [{:keys [tool draft brush]} (:ui db)
size (or brush 6)
by (if (< size 10) 1 2)
ev (case k
"v" [::set-tool :select]
"p" [::set-tool :pen]
"b" [::set-tool :brush]
"e" [::set-tool :eraser]
"[" [::brush-size (- size by)]
"]" [::brush-size (+ size by)]
"enter" (cond (seq draft) [::finish-polygon]
(#{:select nil} tool) [::set-tool :pen])
"escape" (when (= :pen tool)
(if (seq draft) [::finish-polygon] [::set-tool :select]))
nil)]
(if ev {:fx [[:dispatch ev]]} {}))))
(rf/reg-event-db
::brush-size
(fn [db [_ size]] (assoc-in db [:ui :brush] (-> size js/Math.round (max 1) (min 64)))))
(defn new-lane-drawing (defn new-lane-drawing
"Create the one-frame drawing cel implied by drawing with a lane row active. "Create the one-frame drawing cel implied by drawing with a lane row active.
@ -585,56 +661,153 @@
(peek (:path landing)) (:path landing)])) (peek (:path landing)) (:path landing)]))
:else db)] :else db)]
(if (:refused landing) (if (:refused landing) db' (assoc-in db' [:ui :draft] []))))
db'
(update db' :ui merge {:tool :polygon :draft []}))))
(rf/reg-event-db (rf/reg-event-db
::begin-polygon ::add-draft-point
(fn [db _] (beginning-polygon db))) ;; The first point is where the drawing begins: a lane gets its new cel then,
;; so it is the current one while the rest are placed.
(fn [db [_ x y]]
(if (= :pen (get-in db [:ui :tool]))
(update-in (if (seq (get-in db [:ui :draft])) db (beginning-polygon db))
[:ui :draft] (fnil into []) [x y])
db)))
(rf/reg-event-db (defn- landing-into
::finish-polygon "Where shapes drawn on the stage go, and their points re-expressed there:
;; The drawing already exists from `::begin-polygon`; finishing commits only `{:clip :sid :frame :down :rings}` with each of `rings` in that symbol's
;; the shape, so cancelling a draft does not undo the drawing that was started. coordinates, or `{:refused why}`. `down` is the row path to draw inside, or
(fn [db _] nil for the creation target, which a lane makes a new cel for."
(let [draft (get-in db [:ui :draft]) [db down rings]
open (get-in db [:ui :open]) (let [open (get-in db [:ui :open])
{clip :clip st :store} (store/entry (:clip/current db)) {clip :clip st :store} (store/entry (:clip/current db))
landing (polygon-landing clip st db) landing (if down {:clip clip :path down} (polygon-landing clip st db))
source (:clip landing) source (:clip landing)
down (:path landing) inside #(nest/drawn-inside source st open (:path landing) (editing-frame db source) %)
{:keys [sid frame pts]} at (when-not (:refused landing) (inside []))]
(when-not (:refused landing)
(nest/drawn-inside source st open down (editing-frame db source) draft))]
(cond (cond
(< (count draft) 6) db (:refused landing) landing
(:refused landing) (update db :project merge {:status (:refused landing)}) (nil? (:sid at)) {:refused (if (:lane? landing)
(nil? sid)
(update db :project merge
{:status (if (:lane? landing)
"this sequence is not on screen at this frame" "this sequence is not on screen at this frame"
"what you are drawing into is not on screen at this frame")}) "what you are drawing into is not on screen at this frame")}
:else {:clip source :sid (:sid at) :frame (:frame at) :down (:path landing)
:rings (mapv (comp :pts inside) rings)})))
(defn- finishing-polygon
"`db` with the pen's draft committed as a shape, when it has three points."
[db]
(let [draft (get-in db [:ui :draft])
{:keys [refused clip sid frame down rings]} (when (<= 6 (count draft))
(landing-into db nil [draft]))]
(cond
(< (count draft) 6) (update (assoc-in db [:ui :draft] []) :ui dissoc :hover)
refused (update db :project merge {:status refused})
;; `random-uuid` is the one impurity in this namespace, and it is here ;; `random-uuid` is the one impurity in this namespace, and it is here
;; rather than in `domain/paint` for the reason `clip/place-symbol` spells ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
;; out: a node's id is its identity in the saved document, so the pure ;; out: a node's id is its identity in the saved document, so the pure
;; layer must be handed one rather than invent one. If replaying the event ;; layer must be handed one rather than invent one. If replaying the event
;; log ever has to reproduce a document exactly, this becomes a cofx. ;; log ever has to reproduce a document exactly, this becomes a cofx.
;;
;; NOTHING IS OPENED HERE. Expansion is the twist triangle's business; the
;; shape is selected and on the stage, which is where you were looking.
:else :else
(let [id (keyword (str "paint-" (random-uuid)))] (let [id (keyword (str "paint-" (random-uuid)))]
;; NOTHING IS OPENED HERE. Finishing a shape used to expand every row
;; between the open symbol and the new shape, which inside a lane meant
;; tearing the lane's one row open into its portal, that clip's
;; channels and every shape already in the drawing — a dozen rows, in
;; answer to a gesture that said nothing about the outline. Expansion
;; is the twist triangle's business and nobody else's; the shape is
;; selected and on the stage with handles on it, which is where you
;; were looking.
(-> db (-> db
(edit/transaction (edit/transaction
(fn [_] (paint/new-shape source sid id frame pts (get-in db [:ui :tone])))) (fn [_] (paint/new-shape clip sid id frame (first rings) (get-in db [:ui :tone]))))
(update :ui merge {:tool nil :draft []}) (assoc-in [:ui :draft] [])
(selected [:node sid id (conj down id)]))))))) (update :ui dissoc :hover :last)
(selected [:node sid id (conj down id)]))))))
;; Closing on the first point, Enter, Esc and leaving the pen all commit, as in
;; Figma; the pen stays the tool, as it does in Photoshop.
(rf/reg-event-db ::finish-polygon (fn [db _] (finishing-polygon db)))
;; ---------------------------------------------------------------------------
;; brush and eraser
;;
;; A stroke arrives as the pieces `domain/outline` traced off its mask, in stage
;; pixels, holes and all. Each becomes a shape fitted to within `:fit` pixels
;; of what was painted — points where it bends, none on a straight run. What
;; it was made from is kept in `[:ui :last]`, Blender's Adjust Last Operation,
;; so the fit can be changed afterwards from the trace rather than from the
;; points already thrown away, until something else is done.
(def default-fit 1)
(defn- stroke-points [pieces fit]
(mapv #(outline/polygon % fit) pieces))
(rf/reg-event-db
::fit
(fn [db [_ fit]] (assoc-in db [:ui :fit] (-> fit (max 0.5) (min 8)))))
(defn- saved [db] (:clip (store/entry (:clip/current db))))
(defn- fresh-ids [] (repeatedly #(keyword (str "paint-" (random-uuid)))))
(defn- erasing
"`db` with `pieces` cut out of the shapes at `paths`. See `cut/erase`."
[db before pieces fit paths ids]
(let [{st :store} (store/entry (:clip/current db))
cutters (mapv #(outline/rings-of % fit) pieces)]
(edit/transaction db (fn [_] (cut/erase before st (get-in db [:ui :open])
(editing-frame db before) paths cutters ids)))))
(rf/reg-event-db
::stroke
;; The brush draws in the tone, into the creation target, as the pen does.
;; With `paths` it is the eraser's, and cuts the shapes they lead to.
(fn [db [_ {:keys [pieces paths]}]]
(let [fit (get-in db [:ui :fit] default-fit)
before (saved db)]
(if paths
(let [ids (vec (take 64 (fresh-ids)))
db (erasing db before pieces fit paths ids)]
(assoc-in db [:ui :last] {:kind :eraser :pieces pieces :paths paths :ids ids
:fit fit :before before :after (saved db)}))
(let [{:keys [refused clip sid frame] :as at} (when (seq pieces)
(landing-into db nil (stroke-points pieces fit)))
ids (vec (take (count pieces) (fresh-ids)))]
(cond
(empty? pieces) db
refused (update db :project merge {:status refused})
:else
(let [db (-> db
(edit/transaction
(fn [_] (reduce (fn [c [id pts]]
(paint/new-shape c sid id frame pts (get-in db [:ui :tone])))
clip (map vector ids (:rings at)))))
(selected [:node sid (peek ids) (conj (:down at) (peek ids))]))]
(assoc-in db [:ui :last] {:kind :brush :pieces pieces :fit fit
:down (:down at) :sid sid :frame frame :ids ids
:after (saved db)}))))))))
(rf/reg-event-db
::adjust-last
;; The last stroke's fit, and the next one's: one setting, in the options
;; bar and in the panel, as Blender's redo panel writes back to the tool.
(fn [db [_ fit]]
(let [{:keys [kind pieces paths ids down sid frame before after]} (get-in db [:ui :last])
;; Only while the document is still what the stroke left it as.
db (assoc-in db [:ui :fit] fit)]
(if-not (and pieces (identical? after (saved db)))
db
(let [db (if (= :eraser kind)
(erasing db before pieces fit paths ids)
(let [at (landing-into db down (stroke-points pieces fit))]
(edit/transaction
db (fn [c] (reduce (fn [c [id pts]] (paint/set-points c sid id frame pts))
c (map vector ids (:rings at)))))))]
(update-in db [:ui :last] assoc :fit fit :after (saved db)))))))
(rf/reg-event-db
::insert-vertex
(fn [db [_ sid id i t]] (edit/transaction db #(paint/insert-vertex % sid id i t))))
(rf/reg-event-db
::delete-vertex
(fn [db [_ sid id i]] (edit/transaction db #(paint/delete-vertex % sid id i))))
(rf/reg-event-db (rf/reg-event-db
::set-knob ::set-knob
@ -769,6 +942,8 @@
(nest/inside document st from path frame)] (nest/inside document st from path frame)]
(cond (cond
(nil? destination) {:refused "what you are dropping into is not on screen at this frame"} (nil? destination) {:refused "what you are dropping into is not on screen at this frame"}
(clip/trace? (clip/symbol document destination))
{:refused "a tracing layer is a picture to draw over — nothing goes inside it"}
(not (integer? at)) {:refused "the drop is not on one frame of that symbol"} (not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
:else {:clip document :sid destination :at at :path path :matrix matrix}))) :else {:clip document :sid destination :at at :path path :matrix matrix})))
@ -867,6 +1042,24 @@
result)] result)]
(landed db where uuid result)))))) (landed db where uuid result))))))
(defn- fitted
"Tracing placement `uuid` in symbol `sid` of `document`, sized so its picture
fits within `sid`'s stage, and — dropped on the timeline, with no point to
land on — middled on that stage rather than wherever the picture's own middle
happens to fall. A 1920px still is otherwise six stages tall.
A DEFAULT, set once, as the anchor is: nothing keeps it fitted afterwards."
[document sid uuid {:keys [width height]} point?]
(let [[w h] (clip/stage document sid)
k (min (/ w width) (/ h height))]
(update-in document [:symbols sid :nodes uuid :channels]
(fn [chs]
(cond-> (assoc chs [:xform :scale] (ch/framed [k k]))
(not point?)
(assoc [:xform :pos]
(ch/framed (mapv - [(/ w 2) (/ h 2)]
(:value (get chs [:xform :anchor]))))))))))
(rf/reg-event-db (rf/reg-event-db
::drop-symbol ::drop-symbol
;; A symbol dropped on a row becomes a naturally playing clip in the symbol that ;; A symbol dropped on a row becomes a naturally playing clip in the symbol that
@ -882,11 +1075,51 @@
uuid (random-uuid)] uuid (random-uuid)]
(if (:refused where) (if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
(landed db where uuid (let [sym (clip/symbol document source-id)
(span/place-symbol (:clip where) st (:sid where) result (span/place-symbol (:clip where) st (:sid where)
uuid source-id (:at where) uuid source-id (:at where)
{:extent :grow-symbol :point point {:extent :grow-symbol :point point
:remainder-id (random-uuid)})))))) :remainder-id (random-uuid)})]
(landed db where uuid
(cond-> result
(and (:clip result) (clip/trace? sym))
(update :clip fitted (:sid where) uuid sym (some? point)))))))))
(rf/reg-event-db
::drop-tracing
;; Footage or a still to draw over, as a tracing symbol — see `clip/trace?` —
;; placed by the same rule as any symbol dropped from the pool. One that shows
;; the same media already in the document is reused rather than copied: it is
;; the same picture, and a second symbol would only be a second name for it.
;;
;; A STILL ARRIVES WITH NO LENGTH, and is made as long as what is left of the
;; symbol it lands in, at that symbol's rate: it shows the same picture on every
;; frame, so its length is only how long it lasts, and trimming is how that
;; changes afterwards.
(fn [db [_ sym frame point target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
where (if point
(creation-destination db document st frame)
(drop-destination db document st frame target))]
(if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
(let [{host :sid at :at document :clip} where
same (some (fn [[id s]] (when (= (:media s) (:media sym)) id)) (:symbols document))
sid (or same (clip/free-id #(contains? (:symbols document) %) :tracing))
sym (if same
(clip/symbol document same)
(cond-> (assoc sym :id sid)
(nil? (:frames sym)) (assoc :frames (max 1 (- (clip/frames document host) at))
:fps (clip/fps document host))))
uuid (random-uuid)
result (span/place-symbol (assoc-in document [:symbols sid] sym) st host
uuid sid at
{:extent :grow-symbol
:point (destination-point where point)
:remainder-id (random-uuid)})]
(landed db where uuid
(cond-> result
(:clip result) (update :clip fitted host uuid sym (some? point)))))))))
(rf/reg-event-db (rf/reg-event-db
::drop-sound ::drop-sound
@ -955,15 +1188,15 @@
::sliding ::sliding
;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the ;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the
;; drag is abandoned. ;; drag is abandoned.
(fn [db [_ path df kind ripple? other owner]] (fn [db [_ path df kind ripple? other owner paths]]
(if path (if path
(assoc-in db [:ui :sliding] {:path path :df df :kind (or kind :slide) (assoc-in db [:ui :sliding] {:path path :df df :kind (or kind :slide)
:ripple? (boolean ripple?) :other other :owner owner}) :ripple? (boolean ripple?) :other other :owner owner :paths paths})
(update db :ui dissoc :sliding)))) (update db :ui dissoc :sliding))))
(rf/reg-event-db (rf/reg-event-db
::slide ::slide
(fn [db [_ path df kind ripple? other owner]] (fn [db [_ path df kind ripple? other owner paths]]
(let [db (update db :ui dissoc :sliding) (let [db (update db :ui dissoc :sliding)
clip (:clip (store/entry (:clip/current db))) clip (:clip (store/entry (:clip/current db)))
open (or owner (get-in db [:ui :open])) open (or owner (get-in db [:ui :open]))
@ -971,19 +1204,11 @@
:out (nest/resize-out clip open path df ripple?) :out (nest/resize-out clip open path df ripple?)
:in (nest/resize-in clip open path df) :in (nest/resize-in clip open path df)
:roll (nest/roll clip open other path df) :roll (nest/roll clip open other path df)
(nest/slide clip open path df))] (if (seq paths) (nest/slide-many clip open paths df) (nest/slide clip open path df)))]
(cond (cond
(zero? df) db (zero? df) db
(:refused r) (refused db (:refused r)) (:refused r) (refused db (:refused r))
:else (edit/edit db (constantly (:clip r))))))) :else (edit/transaction db (constantly (:clip r)))))))
(rf/reg-event-db
::points
;; Editing the selected shape's points rather than transforming it — a
;; double-click on the shape, as Figma's, which is one level further in. Any
;; new selection leaves it.
(fn [db [_ on?]]
(if on? (assoc-in db [:ui :points] true) (update db :ui dissoc :points))))
(rf/reg-event-db (rf/reg-event-db
::refuse ::refuse
@ -1067,7 +1292,10 @@
(rf/reg-event-db (rf/reg-event-db
::delete-selected ::delete-selected
;; Backspace while drawing takes the last point back, as in Illustrator.
(fn [db _] (fn [db _]
(if (seq (get-in db [:ui :draft]))
(update-in db [:ui :draft] #(subvec % 0 (- (count %) 2)))
(let [primary (get-in db [:ui :selection]) (let [primary (get-in db [:ui :selection])
many (vec (get-in db [:ui :selections])) many (vec (get-in db [:ui :selections]))
selections (if (some #{primary} many) many (if primary [primary] [])) selections (if (some #{primary} many) many (if primary [primary] []))
@ -1077,7 +1305,7 @@
(edit/transaction #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes)) (edit/transaction #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes))
(assoc-in [:ui :selection] nil) (assoc-in [:ui :selection] nil)
(assoc-in [:ui :selections] [])) (assoc-in [:ui :selections] []))
db)))) db)))))
(rf/reg-event-db (rf/reg-event-db
::restack ::restack
@ -1117,3 +1345,48 @@
(assoc-in [:ui :selection] [:node (:sid (nest/inside clip st open host f)) (assoc-in [:ui :selection] [:node (:sid (nest/inside clip st open host f))
uuid (conj host uuid)]) uuid (conj host uuid)])
(update-in [:ui :expanded] conj (conj host uuid))))))) (update-in [:ui :expanded] conj (conj host uuid)))))))
(rf/reg-event-db
::edit-keyframes
(fn [db [_ items delta]]
(edit/transaction db #(keyframes/edit-keys % items delta))))
(rf/reg-event-db
::move-nodes
(fn [db [_ selections to frame delta]]
(let [{document :clip st :store} (store/entry (:clip/current db))
result (clipboard/move-many document st (get-in db [:ui :open]) selections to
(or frame (editing-frame db document)) delta)]
(if-let [why (:refused result)]
(refused db why)
(-> db
(update :ui dissoc :sliding :drop)
(edit/transaction (constantly (:clip result)))
(selected (peek (:selections result)))
(assoc-in [:ui :selections] (:selections result))
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] to))))))))
(rf/reg-event-db
::restack-nodes
(fn [db [_ selections to front?]]
(let [{document :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
host (pop to)
roots (clipboard/canonical document selections)
foreign (mapv :address (remove #(= host (pop (:path %))) roots))
moved (if (seq foreign)
(clipboard/move-many document st open foreign host (editing-frame db document) 0)
{:clip document :selections []})
addresses (vec (concat (map :address (filter #(= host (pop (:path %))) roots))
(:selections moved)))
result (reduce (fn [r address]
(if (:refused r) (reduced r)
(nest/restack (:clip r) open (nth address 3) to front?)))
moved (if front? (reverse addresses) addresses))]
(if-let [why (:refused result)]
(refused db why)
(-> db
(edit/transaction (constantly (:clip result)))
(selected (peek addresses))
(assoc-in [:ui :selections] addresses)
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] host))))))))

View file

@ -158,6 +158,12 @@
"head-pos" [:anchor-avg] "head-pos" [:anchor-avg]
"head-rot" [:anchor-avg] "head-rot" [:anchor-avg]
"head-scale" [:anchor-avg] "head-scale" [:anchor-avg]
;; The head's fit itself, registering the footage under it — see
;; `freeze/plate-part`. The image height it divides by is the footage's, which
;; the analysis already names.
"plate-pos" [:anchor-avg]
"plate-rot" [:anchor-avg]
"plate-scale" [:anchor-avg]
"eyes" [:anchor-avg :contour-avg :eye-verts :lash-weight] "eyes" [:anchor-avg :contour-avg :eye-verts :lash-weight]
"iris-pos" [:anchor-avg :contour-avg :gaze-gain :gaze-step] "iris-pos" [:anchor-avg :contour-avg :gaze-gain :gaze-step]
"brows" [:anchor-avg :contour-avg :brow-verts :brow-gain :brow-step :brow-weight] "brows" [:anchor-avg :contour-avg :brow-verts :brow-gain :brow-step :brow-weight]

View file

@ -40,7 +40,6 @@
[arthur.domain.pick :as pick] [arthur.domain.pick :as pick]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.ring :as ring] [arthur.domain.ring :as ring]
[arthur.domain.trace :as trace]
[arthur.flow.address :as address])) [arthur.flow.address :as address]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -250,37 +249,57 @@
:tx (* (- s') (+ (* c tx) (* sn ty))) :tx (* (- s') (+ (* c tx) (* sn ty)))
:ty (* (- s') (+ (* (- sn) tx) (* c ty)))})) :ty (* (- s') (+ (* (- sn) tx) (* c ty)))}))
(defn head-mode (defn reads-for
"Keep a subject's measured transform dense; optionally trace it. "What a head with face `nodes` reads at, for trace keys `frames` and an
`origin` of `:continuous`, `:keys` or `:start` — see `domain/symbol`'s
`:reads`. At keys it holds where the face's footage holds, when it has footage
to follow; with none it holds at `frames` itself."
[nodes frames origin]
(case origin
:continuous nil
:start {:holds [0]}
:keys (if (contains? nodes :plate) {:holds-of :plate} {:holds (vec frames)})))
With no trace the head reads measured frame f at frame f (free movement). (defn head-mode
`{:frames [12] :origin :keys}` holds the measured transform of source frame "Keep a subject's measured transform dense; optionally hold it at trace keys.
12, `{:frames [12 42] :origin :keys}` jumps to 42's at 42, and `{:origin
:start}` holds frame 0's. See `domain/trace`. The trace selects position, `{:frames [12 42] :origin :keys}`: the face's footage holds on frames 12 and
rotation and scale together, so the head and registered photo cannot drift 42 — its plate's `:time :holds` — and the head jumps to 12's measured
apart. No analysis block or authored face placement changes. transform and then 42's, because it reads where the plate holds. `:start`
holds frame 0's forever, and `:continuous` reads every frame. The keys and the
origin are two facts with two owners: the plate's are which frames are drawn
over, and the head's is how it moves between them. No analysis block or
authored face placement changes.
ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is
not. Two faces in one shot were filmed together and are posed apart: choosing not. Two faces in one shot were filmed together and are posed apart: choosing
frame 12 for the second face must leave the first one running, and it does, frame 12 for the second face must leave the first one running."
because a trace lives on that subject's own head node and `domain/symbol`
reads it off whatever node carries it."
[{:keys [subject] t :trace} {:keys [clip]}] [{:keys [subject] t :trace} {:keys [clip]}]
(when (and subject (not (contains? (:subjects clip) subject))) (when (and subject (not (contains? (:subjects clip) subject)))
(throw (ex-info "head mode names a subject this clip did not track" (throw (ex-info "head mode names a subject this clip did not track"
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))}))) {:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
(let [t (some->> t (merge {:frames []}))] (let [{:keys [frames origin] :as t} (merge {:frames []} (or t {:origin :continuous}))]
(reduce (reduce
(fn [c sid] (fn [c sid]
(let [frames (get-in c [:symbols sid :frames])] (let [nodes (get-in c [:symbols sid :nodes])
(when-let [why (some-> t (trace/problems frames) first)] length (get-in c [:symbols sid :frames])
why (cond
(not (#{:continuous :keys :start} origin))
(str ":origin is " (pr-str origin) ", not :continuous, :keys or :start")
(not (and (vector? frames) (every? integer? frames)
(or (empty? frames) (apply < frames))
(every? #(< -1 % length) frames)))
(str "trace keys must be increasing frames of the face: " (pr-str frames)))
_ (when why
(throw (ex-info (str "a head's trace is not one this take can hold: " why) (throw (ex-info (str "a head's trace is not one this take can hold: " why)
{:subject sid :trace t :frames frames}))) {:subject sid :trace t :frames length})))
(update-in c [:symbols sid :nodes :head] reads (reads-for nodes frames origin)]
(fn [n] (cond-> (update-in c [:symbols sid :nodes :head]
(cond-> (assoc n :channels (:measured n)) #(cond-> (assoc % :channels (:measured %))
t (assoc :trace t) reads (assoc :reads reads)
(nil? t) (dissoc :trace)))))) (nil? reads) (dissoc :reads)))
(contains? nodes :plate)
(assoc-in [:symbols sid :nodes :plate :time :holds] (vec frames)))))
clip (if subject [subject] (sort-by str (keys (:subjects clip))))))) clip (if subject [subject] (sort-by str (keys (:subjects clip)))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -656,6 +675,53 @@
[:xform :scale] (dense scale 0 prov)} [:xform :scale] (dense scale 0 prov)}
:store (stored pos rot scale)})) :store (stored pos rot scale)}))
(defn plate-part
"Freeze one subject's footage registration: the anchor fit itself, which is the
inverse of the head's, with the image's pixels taken into image heights.
This is what puts a face's footage UNDER ITS HEAD and keeps it there. The plate
is a child of `:head`, so its world is `head · fit · 1/H`; on a frame where the
head and the plate read the same measured frame, `head · fit` is the identity
and the footage sits exactly where the face was filmed. On any other frame it
rides the head — held photo on a moving head, or live footage under a head
held at frame 0 — registered either way, because the fit and the photo are read
on the same held frame. Nothing in the evaluator knows it is a face.
`fit · S(1/H)` is still a similarity — the scale divides by H and nothing else
moves — so it lands on the same three decomposed channels as the head's."
[subject {:keys [analysis anchor-avg footage] :as params}
{:keys [transforms detected presence]}]
(let [h (:height footage)
absent? (when (or detected presence)
(fn [_ f] (and detected (not (nth detected f true)))))
xf (fn [role f]
(block {:role role :analysis (:id analysis) :params params
:tracks [role]}
{:type "float32" :features [subject] :absent? absent?}
{:detected detected}
[(mapv f transforms)]))
pos (xf "plate-pos" (fn [t] [(:tx t) (:ty t)]))
rot (xf "plate-rot" (fn [t] [(:theta t)]))
scale (xf "plate-scale" (fn [t] [(/ (:s t) h) (/ (:s t) h)]))
prov {:by :anchor/similarity :analysis (:id analysis)
:params {:anchor-avg anchor-avg}}]
{:measured {[:xform :pos] (dense pos 0 prov)
[:xform :rot] (dense rot 0 prov)
[:xform :scale] (dense scale 0 prov)}
:store (stored pos rot scale)}))
(defn footage-symbol
"The tracing symbol for `:footage` — `{:id :range :width :height}`, the
footage measured and which of its frames — or nil when the measurement came
from no footage: a synthetic take has nothing to show. See `clip/trace?`."
[{:keys [analysis fps footage]}]
(when-let [{:keys [id range width height]} footage]
{:id :footage :name (or (:source analysis) "footage")
:type :trace
:media {:footage id :range range}
:frames (- (second range) (first range)) :fps fps :width width :height height
:nodes {}}))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the clip ;; the clip
@ -677,6 +743,9 @@
areas (cond-> [:mouth] (and eyes brows) (into [:eye :brow]) teeth (conj :teeth)) areas (cond-> [:mouth] (and eyes brows) (into [:eye :brow]) teeth (conj :teeth))
parts (mapv #(part subject % params inputs) areas) parts (mapv #(part subject % params inputs) areas)
head (head-part subject params inputs) head (head-part subject params inputs)
;; THE FACE'S FOOTAGE IS A PLACEMENT LIKE ANY OTHER, of the footage's
;; tracing symbol, under the head — see `plate-part`.
plate (when (:footage params) (plate-part subject params inputs))
features (cond-> {:mouth [:mouth [:mouth :mouth-in]]} features (cond-> {:mouth [:mouth [:mouth :mouth-in]]}
(and eyes brows) (and eyes brows)
(merge {:eye-r [:eye [:eye-r :eye-r-in :iris-r :pupil-r]] (merge {:eye-r [:eye [:eye-r :eye-r-in :iris-r :pupil-r]]
@ -684,9 +753,14 @@
:brow-r [:brow [:brow-r]] :brow-l [:brow [:brow-l]]}) :brow-r [:brow [:brow-r]] :brow-l [:brow [:brow-l]]})
teeth (assoc :teeth [:teeth [:teeth]]))] teeth (assoc :teeth [:teeth [:teeth]]))]
{:symbol {:id subject :frames (count outer) {:symbol {:id subject :frames (count outer)
:nodes (into {:head {:id :head :name "head" :kind :group :z "a1" :nodes (cond-> (into {:head {:id :head :name "head" :kind :group :z "a1"
:measured (:measured head)}} :measured (:measured head)}}
(mapcat :nodes) parts)} (mapcat :nodes) parts)
plate (assoc :plate {:id :plate :name "footage" :kind :instance
:parent :head :z "a0"
:source {:symbol :footage}
:measured (:measured plate)
:channels (:measured plate)}))}
:features (into {} (map (fn [[role [area nodes]]] :features (into {} (map (fn [[role [area nodes]]]
[(own role) {:id (own role) :subject subject [(own role) {:id (own role) :subject subject
:symbol subject :area area :symbol subject :area area
@ -695,7 +769,7 @@
{(own :eyes) {:id (own :eyes) :kind :eye-pair :subject subject {(own :eyes) {:id (own :eyes) :kind :eye-pair :subject subject
:members [(own :eye-r) (own :eye-l)] :params {}}} :members [(own :eye-r) (own :eye-l)] :params {}}}
{}) {})
:store (into (:store head) (mapcat :store) parts)})) :store (into (merge (:store head) (:store plate)) (mapcat :store) parts)}))
(defn pivoted (defn pivoted
"Every node a freeze makes that a hand can transform, pivoting about the "Every node a freeze makes that a hand can transform, pivoting about the
@ -751,8 +825,8 @@
[{:keys [name fps stage expose] :as params} subjects] [{:keys [name fps stage expose] :as params} subjects]
(when-not (and (map? subjects) (seq subjects) (when-not (and (map? subjects) (seq subjects)
(every? keyword? (keys subjects)) (every? keyword? (keys subjects))
(not-any? #{:main :root :place} (keys subjects))) (not-any? #{:main :root :place :footage} (keys subjects)))
(throw (ex-info "a freeze needs subjects with ids distinct from :main, :root and :place" {}))) (throw (ex-info "a freeze needs subjects with ids distinct from :main, :root, :place and :footage" {})))
(let [ordered (sort-by (comp str key) subjects) (let [ordered (sort-by (comp str key) subjects)
parts (mapv (fn [[id inputs]] [id (subject-part params id inputs)]) ordered) parts (mapv (fn [[id inputs]] [id (subject-part params id inputs)]) ordered)
placement (face-placement params subjects) placement (face-placement params subjects)
@ -783,9 +857,12 @@
:z (str "a" i) :z (str "a" i)
:source {:symbol id}}])) :source {:symbol id}}]))
ordered)}} ordered)}}
(concat
(map (fn [[id part]] (map (fn [[id part]]
[id (assoc (place-in (:symbol part) placement) :fps fps)])) [id (assoc (place-in (:symbol part) placement) :fps fps)])
parts)}] parts)
(when-let [footage (footage-symbol params)]
[[:footage footage]])))}]
(doseq [[subject inputs] ordered (doseq [[subject inputs] ordered
[id track] (:presence inputs)] [id track] (:presence inputs)]
(when-not (and (= nf (count track)) (when-not (and (= nf (count track))

View file

@ -2,7 +2,9 @@
"Recompute a changed feature from retained source tracks, then replace only "Recompute a changed feature from retained source tracks, then replace only
channels owned by that feature. Upload remains project/save's ordinary job." channels owned by that feature. Upload remains project/save's ordinary job."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.feature :as feature] [arthur.domain.feature :as feature]
[arthur.domain.node :as node]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.flow.address :as address] [arthur.flow.address :as address]
[arthur.flow.freeze :as freeze] [arthur.flow.freeze :as freeze]
@ -44,9 +46,10 @@
that fits again has its mark cleared, because a regeneration that restores the that fits again has its mark cleared, because a regeneration that restores the
topology has resolved it." topology has resolved it."
[old fresh] [old fresh]
(let [fresh (cond-> fresh (:repairs old) (assoc :repairs (:repairs old)))]
(if-let [over (seq (:over old))] (if-let [over (seq (:over old))]
(assoc fresh :over (ch/reconcile (assoc fresh :over (vec over)))) (assoc fresh :over (ch/reconcile (assoc fresh :over (vec over))))
fresh)) fresh)))
(defn- bases (defn- bases
"A node's channels without their corrections. "A node's channels without their corrections.
@ -56,7 +59,7 @@
re-measurement, or the first correction anyone makes would freeze the part it re-measurement, or the first correction anyone makes would freeze the part it
was meant to adjust." was meant to adjust."
[channels] [channels]
(into {} (map (fn [[p c]] [p (dissoc c :over)])) channels)) (into {} (map (fn [[p c]] [p (dissoc c :over :repairs)])) channels))
(defn- replace-feature [entry fragment fid] (defn- replace-feature [entry fragment fid]
(let [paths (for [id (get-in entry [:clip :features fid :nodes]) (let [paths (for [id (get-in entry [:clip :features fid :nodes])
@ -125,8 +128,16 @@
still ARE the measurement, and are left alone once somebody has placed the head still ARE the measurement, and are left alone once somebody has placed the head
by hand." by hand."
[entry params base subject] [entry params base subject]
(let [baked (freeze/head-part subject params @base) ;; The face's footage is registered by the same fit, inverted, so it is
at [:clip :symbols subject :nodes :head] ;; re-frozen with the head whenever the face has one — see `freeze/plate-part`.
(let [plate (get-in entry [:clip :symbols subject :nodes :plate])
footage (some->> plate node/source (clip/symbol (:clip entry)))
params (cond-> params
plate (assoc :footage {:height (:height footage)}))]
(reduce
(fn [entry [id bake]]
(let [baked (bake subject params @base)
at [:clip :symbols subject :nodes id]
old (get-in entry at) old (get-in entry at)
measured (:measured baked)] measured (:measured baked)]
(cond-> (-> entry (cond-> (-> entry
@ -136,6 +147,9 @@
(assoc-in (conj at :channels) (assoc-in (conj at :channels)
(into {} (map (fn [[p c]] [p (rebased (get-in old [:channels p]) c)])) (into {} (map (fn [[p c]] [p (rebased (get-in old [:channels p]) c)]))
measured))))) measured)))))
entry
(cond-> [[:head freeze/head-part]]
plate (conj [:plate freeze/plate-part])))))
(defn change (defn change
"One scoped static edit. `source-inputs` holds dense landmarks and, when the "One scoped static edit. `source-inputs` holds dense landmarks and, when the

View file

@ -134,5 +134,12 @@
;; `flow/address`: a model upgrade that silently reused ;; `flow/address`: a model upgrade that silently reused
;; these landmarks is the failure this prevents. ;; these landmarks is the failure this prevents.
:analysis (analysis-for (assoc manifest :width w :height h) :analysis (analysis-for (assoc manifest :width w :height h)
detector)})] detector)
;; What the faces are traced over: these frames of this
;; footage, at the pixel size its stills are. See
;; `freeze/footage-symbol`.
:footage {:id (:id manifest)
:range (or (:range manifest) [0 (:frames manifest)])
:width (or (:width manifest) w)
:height (or (:height manifest) h)}})]
(build params subjects))) (build params subjects)))

View file

@ -13,7 +13,6 @@
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.footage.store :as footage] [arthur.footage.store :as footage]
[arthur.subs.playback :as playback] [arthur.subs.playback :as playback]
[re-frame.core :as rf])) [re-frame.core :as rf]))
@ -25,7 +24,7 @@
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding]))) (rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
(rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture]))) (rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture])))
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])]))) (rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
(rf/reg-sub ::tracing (fn [db _] (get-in db [:ui :trace]))) (rf/reg-sub ::tracing (fn [db _] (get-in db [:ui :tracing])))
;; The faces with smart frame picking on, as a PREVIEW switch. The setting ;; The faces with smart frame picking on, as a PREVIEW switch. The setting
;; docs/frame-selection.md specifies is the document's and is not built; this is ;; docs/frame-selection.md specifies is the document's and is not built; this is
;; the editor's own, so it moves what the stage shows and not what exports. ;; the editor's own, so it moves what the stage shows and not what exports.
@ -44,13 +43,13 @@
;; lets go, so the stage and the rows follow the pointer. Nothing is written ;; lets go, so the stage and the rows follow the pointer. Nothing is written
;; until then: one drag is one undo step and one write to collaborators. ;; until then: one drag is one undo step and one write to collaborators.
(let [{c :clip st :store} (footage/entry id)] (let [{c :clip st :store} (footage/entry id)]
(or (when-let [{:keys [path df kind ripple? other owner]} sliding] (or (when-let [{:keys [path df kind ripple? other owner paths]} sliding]
(let [root (or owner open)] (let [root (or owner open)]
(:clip (case kind (:clip (case kind
:out (nest/resize-out c root path df ripple?) :out (nest/resize-out c root path df ripple?)
:in (nest/resize-in c root path df) :in (nest/resize-in c root path df)
:roll (nest/roll c root other path df) :roll (nest/roll c root other path df)
(nest/slide c root path df))))) (if (seq paths) (nest/slide-many c root paths df) (nest/slide c root path df))))))
(when-let [{:keys [sid id frame values edits]} gesture] (when-let [{:keys [sid id frame values edits]} gesture]
;; A held stage control owns the touched parameters completely. Make ;; A held stage control owns the touched parameters completely. Make
;; them temporary static channels for the preview, so their existing ;; them temporary static channels for the preview, so their existing
@ -170,7 +169,9 @@
:<- [::smart] :<- [::smart]
(fn [[document sid store palette smart] _] (fn [[document sid store palette smart] _]
(when (and document (clip/symbol document sid)) (when (and document (clip/symbol document sid))
(clip/resolver document sid store palette {:snap smart})))) ;; The only resolver that asks for tracing layers: the stage shows them and
;; nothing else may. See `clip/trace-op`.
(clip/resolver document sid store palette {:snap smart :tracing? true}))))
(rf/reg-sub (rf/reg-sub
::shown ::shown
@ -203,26 +204,3 @@
(pre-frame-of [_ path] (symbol/pre-frame-of resolve path)) (pre-frame-of [_ path] (symbol/pre-frame-of resolve path))
clip/IActivePalette clip/IActivePalette
(active-palette [_] (clip/active-palette resolve))))))) (active-palette [_] (clip/active-palette resolve)))))))
(rf/reg-sub
::underlay
:<- [::clip-id]
:<- [::clip]
:<- [::store]
:<- [::open]
:<- [::solo]
:<- [::tracing]
(fn [[id document store open solo {:keys [faces opacity]}] _]
;; What `ui/underlay` needs to paint the footage of the faces being traced,
;; besides the resolver that says where they went. A face outside every soloed
;; row is not on stage, so neither is its footage.
(let [solo (filter #(placed? document open %) solo)]
{:document document :store store
:opacity (or opacity trace/opacity-default)
:traces (cond->> (when document (trace/shown document open faces))
(seq solo) (filterv (fn [{:keys [path]}]
;; The open symbol's own face is at the
;; empty path: it is not under any row, so
;; soloing a row cannot hide it.
(or (empty? path)
(some #(= % (take (count %) path)) solo)))))})))

View file

@ -29,15 +29,29 @@
(rf/reg-sub ::clipboard (fn [db _] (get-in db [:ui :clipboard]))) (rf/reg-sub ::clipboard (fn [db _] (get-in db [:ui :clipboard])))
(rf/reg-sub ::retry (fn [db _] (get-in db [:ui :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 ::tone (fn [db _] (get-in db [:ui :tone])))
(rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool]))) (rf/reg-sub ::tool (fn [db _] (or (get-in db [:ui :tool]) :select)))
(rf/reg-sub ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?])))) (rf/reg-sub ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?]))))
(rf/reg-sub ::draft (fn [db _] (get-in db [:ui :draft]))) (rf/reg-sub ::draft (fn [db _] (get-in db [:ui :draft])))
(rf/reg-sub ::hover (fn [db _] (get-in db [:ui :hover])))
(rf/reg-sub ::brush (fn [db _] (get-in db [:ui :brush] 6)))
(rf/reg-sub ::fit (fn [db _] (get-in db [:ui :fit] 1)))
(rf/reg-sub ::last-op (fn [db _] (get-in db [:ui :last])))
(rf/reg-sub ::convert (fn [db _] (get-in db [:ui :convert]))) (rf/reg-sub ::convert (fn [db _] (get-in db [:ui :convert])))
(rf/reg-sub ::drop (fn [db _] (get-in db [:ui :drop]))) (rf/reg-sub ::drop (fn [db _] (get-in db [:ui :drop])))
(rf/reg-sub ::tabs (fn [db _] (get-in db [:ui :tabs]))) (rf/reg-sub ::tabs (fn [db _] (get-in db [:ui :tabs])))
(rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded]))) (rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded])))
(rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs]))) (rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs])))
(rf/reg-sub ::points (fn [db _] (get-in db [:ui :points])))
(rf/reg-sub
::last
:<- [::last-op]
:<- [::render/clip-id]
:<- [::render/paint-revision]
;; The last stroke while the document is still what it left: any other edit,
;; or an undo, takes the panel away, as Blender's goes with the next operation.
(fn [[op id _] _]
(when (and op (identical? (:after op) (:clip (store/entry id)))) op)))
(rf/reg-sub (rf/reg-sub
::selected-node ::selected-node
@ -56,17 +70,30 @@
::selected-local ::selected-local
:<- [::selected-node] :<- [::selected-node]
:<- [::selection] :<- [::selection]
:<- [::render/clip]
:<- [::render/clip-id] :<- [::render/clip-id]
:<- [::render/open] :<- [::render/open]
:<- [::render/open-frame] :<- [::render/open-frame]
(fn [[[_ id n] [_ _ _ path] clip-id open f] _] (fn [[[_ id n] [_ _ _ path] clip clip-id open f] _]
;; `nest/inside` the selected node, from the open symbol: its own frame, the ;; `nest/inside` the selected node, from the open symbol: its own frame, the
;; matrix from its coordinates to the stage's, and the time map from the open ;; matrix from its coordinates to the stage's, and the time map from the open
;; symbol's frames to its own. A selection made on the stage has no path and ;; symbol's frames to its own. A selection made on the stage has no path and
;; names a node in the open symbol. ;; names a node in the open symbol. From the clip as it is mid-drag, as
;; `::selected-placement` is, so the points go with the shape they belong to.
(when n (when n
(nest/inside clip (:store (store/entry clip-id)) open (or path [id]) f))))
(rf/reg-sub
::own-time
:<- [::render/clip-id]
:<- [::render/open]
:<- [::render/open-frame]
(fn [[clip-id open f] [_ path]]
;; Row `path`'s own clock from the open symbol — `nest/own-time` — and the
;; frame of it the playhead is over.
(let [{clip :clip st :store} (store/entry clip-id)] (let [{clip :clip st :store} (store/entry clip-id)]
(nest/inside clip st open (or path [id]) f))))) (when-let [t (and clip (seq path) (nest/own-time clip st open (vec path) f))]
{:time t :frame (js/Math.floor (* (:rate t) (- f (:at t))))}))))
(rf/reg-sub (rf/reg-sub
::creation-target ::creation-target
@ -172,7 +199,10 @@
[_ n] (:nodes sym) [_ n] (:nodes sym)
:let [f (get-in n [:source :footage])] :let [f (get-in n [:source :footage])]
:when f] :when f]
f))] f))
;; And what a tracing layer shows.
used (into used (keep #(get-in % [:media :footage]))
(vals (get-in entry [:clip :symbols])))]
(filterv #(contains? used (:id %)) available)))) (filterv #(contains? used (:id %)) available))))
(rf/reg-sub (rf/reg-sub

View file

@ -74,3 +74,30 @@
(raster/->rgba r palette-rgb 1 (.-data img)) (raster/->rgba r palette-rgb 1 (.-data img))
(.putImageData ctx img 0 0)) (.putImageData ctx img 0 0))
(.toDataURL el "image/png"))) (.toDataURL el "image/png")))
(defonce ^:private onion-surface (atom nil))
(defn clear-overlay! [el]
(when el
(.clearRect (.getContext el "2d") 0 0 (.-width el) (.-height el))))
(defn tint-layer!
"Composite a covered raster in one editor tint, keeping uncovered pixels clear."
[el {:keys [w h cov]} [red green blue] opacity]
(when el
(let [scratch (or @onion-surface
(reset! onion-surface (js/document.createElement "canvas")))
_ (when (not= w (.-width scratch)) (set! (.-width scratch) w))
_ (when (not= h (.-height scratch)) (set! (.-height scratch) h))
ctx (.getContext scratch "2d")
img (image-data-for ctx scratch w h)
data (.-data img)]
(dotimes [i (* w h)]
(let [p (* i 4)]
(aset data p red)
(aset data (+ p 1) green)
(aset data (+ p 2) blue)
(aset data (+ p 3) (if (pos? (aget cov i)) (js/Math.round (* 255 opacity)) 0))))
(.putImageData ctx img 0 0)
(.drawImage (.getContext el "2d") scratch 0 0))))

View file

@ -85,6 +85,10 @@
[:div.convert-actions [:div.convert-actions
[:button {:disabled loading? [:button {:disabled loading?
:on-click #(rf/dispatch [::footage/convert-cancel])} "cancel"] :on-click #(rf/dispatch [::footage/convert-cancel])} "cancel"]
[:button {:disabled (or loading? (< n 1) (empty? name))
:title "draw over these frames · nothing is detected, and it is never exported"
:on-click #(rf/dispatch [::footage/convert-tracing])}
"tracing layer"]
[:button.on {:disabled (or loading? (< n 1) (empty? name)) [:button.on {:disabled (or loading? (< n 1) (empty? name))
:on-click #(rf/dispatch [::footage/convert])} :on-click #(rf/dispatch [::footage/convert])}
(if loading? "working…" "make symbol")]]]])))) (if loading? "working…" "make symbol")]]]]))))

View file

@ -52,14 +52,14 @@
out of the pool, and not one that would make a cycle." out of the pool, and not one that would make a cycle."
[] []
(let [c @carrying] (let [c @carrying]
(and c (#{:symbol :footage :import :sound} (:kind c)) (not (:refused? c))))) (and c (#{:symbol :footage :import :sound :tracing} (:kind c)) (not (:refused? c)))))
(defn row! (defn row!
"Start carrying the timeline row at `path` — a node of kind `node-kind`, to be "Start carrying the timeline row at `path` — a node of kind `node-kind`, to be
moved into another symbol or grouped with another node." moved into another symbol or grouped with another node."
[path node-kind selection] [path node-kind selection & [selections in]]
(reset! carrying {:kind :row :path path :node-kind node-kind (reset! carrying {:kind :row :path path :node-kind node-kind
:selection selection})) :selection selection :selections selections :in in}))
(defn row (defn row
"The path of the row being carried, or nil when it is not a row." "The path of the row being carried, or nil when it is not a row."
@ -74,6 +74,11 @@
(defn row-selection [] (defn row-selection []
(when (= :row (:kind @carrying)) (:selection @carrying))) (when (= :row (:kind @carrying)) (:selection @carrying)))
(defn row-selections []
(when (= :row (:kind @carrying)) (:selections @carrying)))
(defn row-in [] (:in @carrying))
(defn other! (defn other!
"Start carrying something that is not yet in the document: `:kind` says what, "Start carrying something that is not yet in the document: `:kind` says what,
and the rest is what a preview can show of it before it is fetched." and the rest is what a preview can show of it before it is fetched."
@ -118,5 +123,7 @@
:import (rf/dispatch [::project/import c frame point target]) :import (rf/dispatch [::project/import c frame point target])
;; Where it is dropped in time; a sound has no place in space. ;; Where it is dropped in time; a sound has no place in space.
:sound (rf/dispatch [::ui/drop-sound c frame target]) :sound (rf/dispatch [::ui/drop-sound c frame target])
;; A still to trace over, made into a tracing symbol where it lands.
:tracing (rf/dispatch [::ui/drop-tracing (:symbol c) frame point target])
nil)) nil))
(done!))) (done!)))

View file

@ -20,7 +20,8 @@
drawers over the stage rather than columns beside it, which is the stylesheet's drawers over the stage rather than columns beside it, which is the stylesheet's
half of this (see `@media` in app.css), and a drawer that is shut should not be half of this (see `@media` in app.css), and a drawer that is shut should not be
holding video thumbnails live." holding video thumbnails live."
(:require [re-frame.core :as rf])) (:require [arthur.domain.onion :as onion]
[re-frame.core :as rf]))
(def ^:private narrow? (def ^:private narrow?
"A phone-shaped window, read ONCE at load. It decides what the layout opens "A phone-shaped window, read ONCE at load. It decides what the layout opens
@ -43,7 +44,7 @@
"[lo hi] per key — pixels for a pane, a multiplier for a zoom. The low end of "[lo hi] per key — pixels for a pane, a multiplier for a zoom. The low end of
`:time` is the transport strip plus a row, so dragging the timeline shut and `:time` is the transport strip plus a row, so dragging the timeline shut and
shutting it are the same shape of window." shutting it are the same shape of window."
{:pool [120 480] :params [150 560] :time [44 660] :stage [1 8] :tl [1 24]}) {:pool [120 480] :params [150 560] :time [44 660] :stage [0.1 16] :tl [1 24]})
(defn- clamp [k v] (defn- clamp [k v]
(let [[lo hi] (limits k)] (max lo (min hi v)))) (let [[lo hi] (limits k)] (max lo (min hi v))))
@ -136,12 +137,9 @@
label])))])) label])))]))
(defn- stepped [k z out?] (defn- stepped [k z out?]
;; The stage steps by WHOLE pixels. A fractional scale under ;; Geometric steps work below 100% as well as above it.
;; `image-rendering: pixelated` draws some rows of the raster thicker than
;; others, which misrepresents the one thing the preview exists to judge. The
;; timeline has no pixel grid to honour, so it steps geometrically.
(if (= :stage k) (if (= :stage k)
(+ z (if out? -1 1)) (* z (if out? (/ 1 1.25) 1.25))
(* z (if out? (/ 1 1.5) 1.5)))) (* z (if out? (/ 1 1.5) 1.5))))
(defn zoomer (defn zoomer
@ -165,3 +163,60 @@
[:button {:disabled (>= z hi) :aria-label (str label " zoom in") [:button {:disabled (>= z hi) :aria-label (str label " zoom in")
:title (str "zoom " label " in") :title (str "zoom " label " in")
:on-click #(rf/dispatch [::set k (stepped k z false)])} "+"]])) :on-click #(rf/dispatch [::set k (stepped k z false)])} "+"]]))
(rf/reg-sub ::mat (fn [db _] (merge {:opacity 0.55} (get-in db [:ui :passepartout]))))
(rf/reg-event-db ::mat (fn [db [_ k v]] (assoc-in db [:ui :passepartout k] v)))
(rf/reg-sub ::onion
(fn [db _]
(merge onion/defaults (get-in db [:ui :onion (:clip/current db) (get-in db [:ui :open])]))))
(rf/reg-event-db ::onion
(fn [db [_ k v]]
(assoc-in db [:ui :onion (:clip/current db) (get-in db [:ui :open]) k] v)))
(defn onion-controls []
(let [{:keys [on? before after opacity scope]} @(rf/subscribe [::onion])]
[:div.group.onion-controls
[:button {:class (when on? "on") :aria-pressed (boolean on?)
:title "Onion skin — neighboring cels of the selected lane"
:on-click #(rf/dispatch [::onion :on? (not on?)])} "onion"]
[:details
[:summary {:aria-label "Onion skin settings" :title "Onion skin settings"} "▾"]
[:div.view-popout
[:label "Scope"
[:select {:value (name scope)
:on-change #(rf/dispatch [::onion :scope (keyword (.. % -target -value))])}
[:option {:value "selected"} "Selected lane"]
[:option {:value "symbol"} "Whole symbol"]]]
(for [[k label v] [[:before "Previous cels" before] [:after "Next cels" after]]]
^{:key k} [:label label
[:input {:type "number" :min 0 :max 5 :value v
:on-change #(let [n (js/parseInt (.. % -target -value) 10)]
(when-not (js/isNaN n)
(rf/dispatch [::onion k (max 0 (min 5 n))])))}]])
[:label "Opacity"
[:input {:type "range" :min 0.05 :max 0.6 :step 0.05 :value opacity
:on-change #(rf/dispatch [::onion :opacity (js/parseFloat (.. % -target -value))])}]]
[:small "Previous: red · Next: blue. Select a lane or one of its cels. Hidden during playback."]]]]))
(defn fit-stage! []
(when-let [area (.querySelector js/document ".stage-area")]
(when-let [wrap (.querySelector area ".stage-wrap")]
(let [w (js/parseFloat (.getAttribute wrap "data-width"))
h (js/parseFloat (.getAttribute wrap "data-height"))]
(rf/dispatch-sync [::set :stage (min (/ (- (.-clientWidth area) 32) w)
(/ (- (.-clientHeight area) 32) h))])
(js/requestAnimationFrame #(do (set! (.-scrollLeft area) 0) (set! (.-scrollTop area) 0)))))))
(defn stage-controls []
(let [{:keys [opacity]} @(rf/subscribe [::mat])]
[:<>
[onion-controls]
[:button {:on-click fit-stage! :title "Fit stage in view"} "fit"]
[:details.passepartout-controls
[:summary "passepartout"]
[:div.view-popout
[:label "Passepartout"
[:input {:type "range" :min 0 :max 1 :step 0.05 :value opacity
:on-change #(rf/dispatch [::mat :opacity (js/parseFloat (.. % -target -value))])}]]]]]))

View file

@ -1,88 +1,203 @@
(ns arthur.ui.palette (ns arthur.ui.palette
"The bar above the stage: the tone a new shape gets, and the tool that makes "The palette: a grid of the open palette's slots under the tools, and the
one. palette asset it is, beside that grid.
A GRID BESIDE THE TOOLS, as Deluxe Paint and Animator Pro put theirs — the
indexed tools this one descends from — rather than a strip of dots across the
top: a palette is a fixed table of slots, and a grid shows it as one. Over the
grid sits the colour a new shape gets, big, as Photoshop's foreground chip.
Shapes store only the selected local slot number. Palette identity is supplied Shapes store only the selected local slot number. Palette identity is supplied
by the symbol tree, and the colour input edits the project palette asset. by the symbol tree, and the colour input edits the project palette asset.
Picking a slot also recolours whatever is selected; picking CLEAR makes it a
knockout — select a lens, pick clear, and it is a hole.
The footage switch is NOT here. It is a viewing aid rather than something you The footage switch is NOT here. It is a viewing aid rather than something you
set before you draw, so it is a section of the inspector — one that is there set before you draw, so it is a section of the inspector. See `ui/params`."
for whatever the open symbol has faces of, so it still does not come and go (:require [arthur.domain.channel :as channel]
with the selection. See `ui/params`."
(:require [arthur.domain.palette :as pal]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.events.ui :as ui] [arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]
[arthur.events.project :as project] [arthur.events.project :as project]
[arthur.events.ui :as ui]
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.subs.ui :as sub] [arthur.subs.ui :as sub]
[arthur.ui.layout :as layout] [re-frame.core :as rf]
[re-frame.core :as rf])) [reagent.core :as r]))
(rf/reg-sub ::chosen (fn [db _] (get-in db [:ui :palette]))) (rf/reg-sub ::chosen (fn [db _] (get-in db [:ui :palette])))
(defn- swatch [pid i {:keys [name hex]} tone placements] (rf/reg-event-db ::select (fn [db [_ id]] (assoc-in db [:ui :palette] id)))
(let [picker-id (str "palette-picker-" pid "-" i)]
[:div {:key i :class "palette-slot"} (defn- shown
[:button {:class (str "swatch" (when (= i tone) " on")) "The palette asset the grid shows: the one chosen, or the project's default."
:style {:background hex} []
:title (str i (when name (str " · " (clojure.core/name name))) (let [clip @(rf/subscribe [::render/clip])
" · " hex " · double-click to edit") chosen @(rf/subscribe [::chosen])
:on-click #(do (rf/dispatch [::ui/set-tone i]) pid (if (contains? (:palettes clip) chosen) chosen (pal/default-palette-id clip))]
[clip pid (get (pal/palettes clip) pid)]))
(defn- pick!
"Make `tone` the colour new shapes get, and recolour what is selected."
[tone placements]
(rf/dispatch [::ui/set-tone tone])
(let [edits (into [] (keep (fn [{:keys [sid id node frame]}] (let [edits (into [] (keep (fn [{:keys [sid id node frame]}]
(when (contains? (get node/valid-paths (:kind node)) (when (contains? (get node/valid-paths (:kind node)) [:style :color])
[:style :color]) {:sid sid :id id :path [:style :color] :frame frame :value tone})))
{:sid sid :id id :path [:style :color]
:frame frame :value i})))
placements)] placements)]
(when (seq edits) (when (seq edits)
(rf/dispatch [::project/set-channels edits])))) (rf/dispatch [::project/set-channels edits]))))
;; ---------------------------------------------------------------------------
;; remap: a shape that lights what is under it
;;
;; A shape coloured `[:remap {from to …}]` draws nothing of its own: whatever is
;; already under it is drawn in other slots of the same palette, as Deluxe
;; Paint's and Animator Pro's shade inks did. A flashlight is a circle of it.
;; Pick MAP from the strip and draw one; its map is set in the inspector, or by
;; dragging one swatch of the strip onto another while it is selected.
(defn- remap
"The selected node when it is a remap shape, with its map at the frame shown:
`{:sid :id :frame :keys :map}`, or nil."
[]
(let [[sid id n] @(rf/subscribe [::sub/selected-node])
frame (:frame @(rf/subscribe [::sub/selected-local]))
ch (get-in n [:channels [:style :color]])
c (when ch (channel/value-at ch (or frame 0) nil))]
(when (symbol/remap? c)
{:sid sid :id id :frame frame :keys (:keys ch) :map (second c)})))
(defn- map-slot!
"Light `from` as `to` under the selected remap shape; as itself, not at all."
[{:keys [sid id frame map]} from to]
(rf/dispatch [::project/set-channel sid id [:style :color] frame
[:remap (if (= from to) (dissoc map from) (assoc map from to))]]))
(defn remap-section
"The inspector's map for a selected remap shape: each slot as what is under
the shape will be drawn in, the original in its corner where it is changed.
A slot opens a choice of what to draw it as."
[]
(r/with-let [open (r/atom nil)]
(let [[_ _ palette] (shown)
{:keys [sid id frame keys] m :map :as rm} (remap)
slots (:slots palette)
hex #(:hex (get slots %))]
(when rm
[:section.section
[:h2 "remap"]
[:div.remap-head
[:button.key {:class (cond (contains? keys frame) "on" keys "keyed")
:disabled (nil? frame)
:title (if keys (str (count keys) " held keys") "key the map here")
:on-click #(rf/dispatch [::project/toggle-key sid id [:style :color] frame])}
"◆"]
[:span.dim (if (seq m)
(str "what is under it: " (count m) " slot" (when (< 1 (count m)) "s") " changed")
"changes nothing yet — pick a slot")]
[:span {:style {:flex 1}}]
(when (seq m)
[:button {:on-click #(rf/dispatch [::project/set-channel sid id [:style :color] frame [:remap {}]])}
"reset"])]
[:div.remap
(doall
(for [i (range (count slots))]
^{:key i}
[:button {:class (str "cell" (when (contains? m i) " mapped") (when (= i @open) " on"))
:style {:background (hex (get m i i))}
:title (str "slot " i (when (contains? m i) (str " → " (m i))))
:on-click #(swap! open (fn [o] (when-not (= o i) i)))}
(when (contains? m i) [:i {:style {:background (hex i)}}])]))]
(when-let [from @open]
[:div.remap-pick
[:span.dim (str "under it, draw " from " as")]
(doall
(for [i (range (count slots))]
^{:key i}
[:button {:class (str "cell" (when (= i (get m from from)) " on"))
:style {:background (hex i)}
:title (if (= i from) (str i " — as it is") (str "slot " i))
:on-click #(do (map-slot! rm from i) (reset! open nil))}]))])]))))
(defn- swatch [pid i {:keys [name hex]} tone placements rm hex-of]
(let [picker-id (str "palette-picker-" pid "-" i)
to (get (:map rm) i)]
[:div.slot {:key i}
[:button {:class (str "cell" (when (= i tone) " on"))
:style {:background hex}
:title (str "slot " i (when name (str " · " (clojure.core/name name)))
" · " hex
(when to (str " · lit as " to " under the selected remap"))
" — double-click to edit"
(when rm ", drag onto another to remap it under the selected remap"))
:draggable (some? rm)
:on-drag-start #(.setData (.-dataTransfer %) "application/x-arthur-slot" (str i))
:on-drag-over (fn [^js e] (when rm (.preventDefault e)))
:on-drop (fn [^js e]
(.preventDefault e)
(let [from (js/parseInt (.getData (.-dataTransfer e) "application/x-arthur-slot"))]
(when (and rm (not (js/isNaN from))) (map-slot! rm from i))))
:on-click #(pick! i placements)
:on-double-click (fn [e] :on-double-click (fn [e]
(.preventDefault e) (.preventDefault e)
(some-> (js/document.getElementById picker-id) (.click)))}] (some-> (js/document.getElementById picker-id) (.click)))}
(when to [:i.badge {:style {:background (hex-of to)}}])]
[:input {:id picker-id :class "palette-picker" :type "color" :value hex [:input {:id picker-id :class "palette-picker" :type "color" :value hex
:aria-label (str "edit palette slot " i) :aria-label (str "edit palette slot " i)
:on-change #(rf/dispatch [::project/palette-color pid i (.. % -target -value)])}]])) :on-change #(rf/dispatch [::project/palette-color pid i (.. % -target -value)])}]]))
(defn bar [] (defn grid
(let [tone @(rf/subscribe [::sub/tone]) "The colour chip and the slots, for the tool strip."
clip @(rf/subscribe [::render/clip]) []
chosen @(rf/subscribe [::chosen]) (let [[_ pid palette] (shown)
pid (if (contains? (:palettes clip) chosen) chosen (pal/default-palette-id clip)) tone @(rf/subscribe [::sub/tone])
palette (get (pal/palettes clip) pid)
placements @(rf/subscribe [::sub/selected-placements]) placements @(rf/subscribe [::sub/selected-placements])
selections @(rf/subscribe [::sub/selections]) hex (when (number? tone) (:hex (get (:slots palette) tone)))]
tool @(rf/subscribe [::sub/tool]) [:div.palette
draft @(rf/subscribe [::sub/draft])] [:div {:class (str "chip" (cond (= :clear tone) " clear" (symbol/remap? tone) " map"))
[:div.palette-bar :style (when hex {:background hex})
:title (cond (= :clear tone) "clear: what is drawn knocks out what is under it in its symbol"
(symbol/remap? tone) "remap: what is drawn lights what is under it"
:else (str "slot " tone " · " hex))}
[:span (cond (= :clear tone) "×" (symbol/remap? tone) "⇄" :else tone)]]
[:div.cells
(let [rm (remap) hex-of #(:hex (get (:slots palette) %))]
(doall (map-indexed #(swatch pid %1 %2 tone placements rm hex-of) (:slots palette))))
[:div.slot
[:button {:class (str "cell clear" (when (= :clear tone) " on"))
:title "clear — draws a knockout: a hole in its symbol"
:on-click #(pick! :clear placements)}]]
[:div.slot
[:button {:class (str "cell map" (when (symbol/remap? tone) " on"))
:title "remap — draws light: what is under it is drawn in other slots of the palette. Set which in the inspector."
:on-click #(pick! [:remap {}] placements)}
"⇄"]]]]))
(defn assets
"Which palette asset the grid shows, and a new or duplicated one, for the
tool strip, with a popout for the full asset controls."
[]
(let [[clip pid palette] (shown)]
[:details.palette-assets
{:on-toggle (fn [e]
(let [el (.-currentTarget e)
box (.getBoundingClientRect el)
pop (.querySelector el ".palette-popout")]
(set! (.. pop -style -left) (str (+ 4 (.-right box)) "px"))
(set! (.. pop -style -top) (str (max 8 (min (.-top box) (- (.-innerHeight js/window) 160))) "px"))))}
[:summary {:title (:name palette)} [:span (:name palette)]]
[:div.palette-popout
[:strong (:name palette)]
[:select {:value (str pid) [:select {:value (str pid)
:title "palette asset" :title "palette asset"
:on-change (fn [e] :on-change (fn [e]
(let [v (.. e -target -value) (let [v (.. e -target -value)
id (first (filter #(= v (str %)) (keys (pal/palettes clip))))] id (first (filter #(= v (str %)) (keys (pal/palettes clip))))]
(rf/dispatch [::ui/set-tone 0]) (rf/dispatch [::ui/set-tone 0])
(rf/dispatch [:arthur.ui.palette/select id])))} (rf/dispatch [::select id])))}
(for [[id p] (sort-by (comp str :name val) (pal/palettes clip))] (for [[id p] (sort-by (comp str :name val) (pal/palettes clip))]
^{:key (str id)} [:option {:value (str id)} (:name p)])] ^{:key (str id)} [:option {:value (str id)} (:name p)])]
[:button {:title "new 16-slot palette" :on-click #(rf/dispatch [::project/new-palette])} "+"] [:button {:title "new 16-slot palette" :on-click #(rf/dispatch [::project/new-palette])} "+"]
[:button {:title (str "duplicate " (:name palette) " — a copy you can retone") [:button {:title (str "duplicate " (:name palette) " — a copy you can retone")
:on-click #(rf/dispatch [::project/duplicate-palette pid])} "⧉"] :on-click #(rf/dispatch [::project/duplicate-palette pid])} "clone"]]]))
[:div.swatches (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette)))]
[:span.dim (str tone)]
(when (> (count selections) 1)
[:span.dim (str (count selections) " selected")])
[:span {:style {:flex 1}}]
(if (= :polygon tool)
[:<>
[:span.dim (str (quot (count draft) 2) " points")]
[:button {:disabled (< (count draft) 6)
:on-click #(rf/dispatch [::ui/finish-polygon])} "finish"]
[:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "cancel"]]
[:button {:title "pen tool — click points on the stage"
:on-click #(rf/dispatch [::ui/begin-polygon])} "pen"])
;; The stage's zoom, at the right end of the bar above the stage: it is a
;; property of the view and not of the document, so it sits in the view's
;; own chrome rather than in the inspector.
[layout/zoomer :stage "the stage"]]))
(rf/reg-event-db :arthur.ui.palette/select
(fn [db [_ id]] (assoc-in db [:ui :palette] id)))

View file

@ -10,12 +10,12 @@
[arthur.domain.channel :as channel] [arthur.domain.channel :as channel]
[arthur.domain.feature :as feature] [arthur.domain.feature :as feature]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.nest :as nest]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.events.history :as history] [arthur.events.history :as history]
[arthur.events.paint :as paint-events] [arthur.events.paint :as paint-events]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
@ -24,6 +24,7 @@
[arthur.subs.playback :as playback] [arthur.subs.playback :as playback]
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.subs.ui :as sub] [arthur.subs.ui :as sub]
[arthur.ui.palette :as palette]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.core :as r])) [reagent.core :as r]))
@ -210,9 +211,10 @@
(defn- color-control [sid id ch frame auto-key? palette] (defn- color-control [sid id ch frame auto-key? palette]
(let [keyed? (some? (:keys ch)) (let [keyed? (some? (:keys ch))
value (channel/value-at ch (or frame 0) nil) value (channel/value-at ch (or frame 0) nil)
value (if (integer? value) ;; A knockout or a remap is no slot, and none is marked.
value value (cond
(or (first (keep-indexed #(when (= value (:name %2)) %1) (integer? value) value
(keyword? value) (or (first (keep-indexed #(when (= value (:name %2)) %1)
(:slots palette))) 0)) (:slots palette))) 0))
off? (and keyed? (nil? frame))] off? (and keyed? (nil? frame))]
[:dd.channel {:class (when auto-key? "live")} [:dd.channel {:class (when auto-key? "live")}
@ -235,12 +237,40 @@
:on-click #(rf/dispatch [::project/set-channel sid id [:style :color] frame i])}]))] :on-click #(rf/dispatch [::project/set-channel sid id [:style :color] frame i])}]))]
(when keyed? [:span.dim "hold"])])) (when keyed? [:span.dim "hold"])]))
(defn- instance-playback [[sid id n]]
(let [{:keys [in speed end]} (node/playback-of n)
mode (cond (zero? speed) :frame
(or (= :loop end) (get-in n [:time :loop?])) :loop
:else :once)
change! (fn [field value]
(rf/dispatch [::project/instance-playback sid id field value]))]
[section "playback"
[:div.inspector-form
[:label.inspector-field "mode"
[:select {:value (name mode)
:aria-label "instance playback mode"
:on-change #(change! :mode (keyword (.. % -target -value)))}
[:option {:value "once"} "play once"]
[:option {:value "loop"} "loop"]
[:option {:value "frame"} "hold frame"]]]
[:label.inspector-field "start frame"
[number-input {:min 0 :step 1 :value in
:aria-label "instance start frame"
:parse #(js/parseInt % 10)
:on-number #(change! :in %)}]]
[:label.inspector-field "speed"
[number-input {:min 0 :step 0.1 :value speed
:disabled (= :frame mode)
:aria-label "instance playback speed"
:parse js/parseFloat
:on-number #(change! :speed %)}]]]]))
(defn- node-section [[sid id n]] (defn- node-section [[sid id n]]
(let [[start end] (:span n) (let [[start end] (:span n)
auto-key? @(rf/subscribe [::sub/auto-key?]) auto-key? @(rf/subscribe [::sub/auto-key?])
clip @(rf/subscribe [::render/clip]) clip @(rf/subscribe [::render/clip])
local @(rf/subscribe [::sub/selected-local]) placement @(rf/subscribe [::sub/selected-placement])
frame (:frame local) frame (:frame placement)
palette-id (or (get-in clip [:symbols sid :palette]) (pal/default-palette-id clip)) palette-id (or (get-in clip [:symbols sid :palette]) (pal/default-palette-id clip))
palette (get (pal/palettes clip) palette-id)] palette (get (pal/palettes clip) palette-id)]
[section (str (name (:kind n)) " · in " (name sid)) [section (str (name (:kind n)) " · in " (name sid))
@ -258,7 +288,9 @@
#(rf/dispatch [::ui/rename-node sid id %])]] #(rf/dispatch [::ui/rename-node sid id %])]]
(when (:paint? n) [drawing-keys sid id n @(rf/subscribe [::sub/selected-local])]) (when (:paint? n) [drawing-keys sid id n @(rf/subscribe [::sub/selected-local])])
[:div.row {:style {:margin-top "6px"}} [:span.dim "channels"]] [:div.row {:style {:margin-top "6px"}} [:span.dim "channels"]]
(let [{:keys [frame]} local] ;; Channels belong to the placement, before its source playback clock.
;; Entering the source would wrap keys on loops and pin them on holds.
(let [{:keys [frame]} placement]
[:dl.facts [:dl.facts
(doall (doall
(for [[path ch] (sort-by (fn [[path]] (for [[path ch] (sort-by (fn [[path]]
@ -468,91 +500,71 @@
(str/join " " (map name channel)) " · " why)]))])]))))) (str/join " " (map name channel)) " · " why)]))])])))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the footage showing under the picture ;; tracing layers
;;
;; A tracing layer is a placement of a tracing symbol, and a face's footage is
;; one of them — its `:plate`, under its head — so one section serves both:
;; whether it is showing, and which of its frames it holds on. Showing is the
;; editor's (`arthur.db/tracing`); the holds are the document's, on the
;; placement's own `:time`. A face adds one fact of its own below them: whether
;; its head follows those holds.
(defn- footage-section (defn- layer-section
"The footage under the explicitly selected face or footage asset, on or off "Tracing layer `id` of symbol `sid`, at row `path` from the open symbol, under
and how strongly. `here` is exactly those faces. `title`, with `more` appended."
[title sid id path & more]
ONE SWITCH FOR THE FACES THAT ARE HERE. A face's footage is the face's, not a (let [n (get-in @(rf/subscribe [::render/clip]) [:symbols sid :nodes id])
placement's, so there is nothing to inherit and nothing to set twice; with {:keys [on? hidden]} @(rf/subscribe [::render/tracing])
several faces in a take the box says how many are showing and switches the rest shown? (and on? (not (contains? hidden [sid id])))
on, and one face alone is switched from its own timeline row. {:keys [frame time]} @(rf/subscribe [::sub/own-time path])
holds (get-in n [:time :holds] [])
This is editor state, but the inspector still obeys selection scope: selecting seek! #(rf/dispatch [::pb/seek (js/Math.round (+ (:at time) (/ % (:rate time))))])]
an unrelated shape must neither expose nor mutate a face's viewing aid." (into
[here] [section title
(let [{:keys [faces opacity]} @(rf/subscribe [::render/tracing])
on (filterv (set faces) here)]
[section "footage"
[:div.row [:div.row
[:label.dim {:title (str "show the footage these faces were traced from, over the " [:label.dim {:title "show it over the picture · a reference, never exported"}
"picture \u00b7 a reference, never exported")} [:input {:type "checkbox" :checked (boolean shown?)
[:input {:type "checkbox" :checked (= (count on) (count here)) :on-change #(rf/dispatch [::ui/show-trace [sid id] (not shown?)])}]
:on-change #(rf/dispatch [::ui/trace-faces here])}] " show"]]
(str " show" (when (< 1 (count here)) (str " " (count on) "/" (count here))))]]
[:div.row {:style {:margin-top "5px"}}
[:span.dim "opacity"]
[:input.trace-opacity
{:type "range" :min 0 :max 1 :step 0.05 :title "how strongly the footage draws"
:value (or opacity trace/opacity-default) :disabled (empty? on)
:on-change #(rf/dispatch [::ui/trace-opacity (js/parseFloat (.. % -target -value))])}]]]))
;; ---------------------------------------------------------------------------
;; tracing a face
;;
;; THE FACE'S OWN FACTS ONLY, and both of them are keyed to the face rather than
;; to an instance of it: which of its frames its drawings were made over, and
;; what its origin does between those frames. See `domain/trace`.
;;
;; `performance-section` below it is the face's too, for a third reason of the
;; same kind: the closure cuts the preserve-snap reads are stored on the face's
;; own nodes, so every placement of one face has the same marks, and a
;; per-placement switch would be a setting with nothing in it.
;;
;; Whether the footage is SHOWING is `footage-section` above, and not part of this
;; section. It is a viewing aid rather than a fact about a face, and it must not
;; come and go with the selection — so it is keyed to the OPEN symbol's faces,
;; which is a different question from the one this section answers.
(defn- trace-keys
"The face's trace keys and origin. `frame` is the frame of the FACE that the
playhead is over, and `seek!` goes to one of its frames — both of which depend
on whether the face is open in its own tab or placed in what is."
[face frame seek!]
(let [t (trace/of (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head]))
put #(rf/dispatch [::project/set-trace face %])
key? (boolean (some #{frame} (:frames t)))]
[:<>
[:div.row {:style {:margin "5px 0"}} [:div.row {:style {:margin "5px 0"}}
;; A DEAD BUTTON WITH NO REASON GIVEN is what reads as the feature not ;; A DEAD BUTTON WITH NO REASON GIVEN is what reads as the feature not
;; working. There is no frame of this face under the playhead, so say that ;; working, so say why there is nothing to hold.
;; rather than greying out the one control in the section.
(if (nil? frame) (if (nil? frame)
[:span.dim "move the playhead over this face to key it"] [:span.dim "move the playhead over this layer to hold a frame"]
[:button {:on-click #(put (trace/toggle-frame t frame))} [:button {:title "hold the picture on this frame until the next hold"
(if key? (str "remove trace key at " frame) (str "trace key at " frame))])] :on-click #(rf/dispatch [::project/toggle-hold sid id frame])}
(when (seq (:frames t)) (if (some #{frame} holds) (str "remove hold at " frame) (str "hold at " frame))])]
(when (seq holds)
[:div.row [:div.row
[:span.dim "keys"] [:span.dim "holds"]
(doall (doall
(for [f (:frames t)] (for [f holds]
^{:key f} ^{:key f}
[:button {:class (when (= frame f) "on") [:button {:class (when (= frame f) "on")
:disabled (nil? seek!) :disabled (nil? time)
:on-click #(seek! f)} :on-click #(seek! f)}
(str f)]))]) (str f)]))])]
more)))
(def ^:private origins
"How a face's head moves between its footage's holds, as the head's `:reads`."
[["continuous" nil "the head reads the frame it is on"]
["at holds" {:holds-of :plate} "the head jumps to each hold and stays there"]
["start" {:holds [0]} "the head holds frame 0 forever"]])
(defn- face-section
"Face `face`'s footage, at row `path` from the open symbol: its plate as a
tracing layer, and how its head follows the plate's holds."
[face path]
(let [reads (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head :reads])]
[layer-section (str "tracing · " (name face)) face :plate (conj path :plate)
[:div.row {:style {:margin-top "5px"}} [:div.row {:style {:margin-top "5px"}}
[:span.dim "origin"] [:span.dim "head"]
(doall (doall
(for [[o label] (map vector trace/origins ["continuous" "at keys" "start"])] (for [[label r title] origins]
^{:key o} ^{:key label}
[:button {:class (when (= o (:origin t)) "on") [:button {:class (when (= r reads) "on") :title title
:title (case o :on-click #(rf/dispatch [::project/set-reads face r])}
:continuous "the head reads the frame it is on"
:keys "the head jumps to each trace key and holds it"
:start "the head holds frame 0 forever")
:on-click #(put (assoc t :origin o))}
label]))]])) label]))]]))
(defn- performance-section (defn- performance-section
@ -601,32 +613,6 @@
[:div.row [:div.row
[:span.dim "the stage only \u00b7 an export is unaffected until this is a saved setting"]]])) [:span.dim "the stage only \u00b7 an export is unaffected until this is a saved setting"]]]))
(defn- tracing-section
"`face` is the face these facts belong to, `faces` the faces placed inside it
to offer as somewhere to go next, and `path` the row path `faces` are under."
[face faces path]
(let [clip @(rf/subscribe [::render/clip])
own? (= face @(rf/subscribe [::render/open]))
;; The face's OWN frame, which is the playhead itself when the face is
;; the open symbol, and the selected placement's local frame when it is
;; placed in it. `time` maps the open symbol's frames to that
;; placement's, so seeking to one of the face's frames is a conversion.
{:keys [frame time]} (when-not own? @(rf/subscribe [::sub/selected-local]))
frame (if own? @(rf/subscribe [::playback/frame]) frame)
seek! (cond own? #(rf/dispatch [::pb/seek %])
time #(rf/dispatch [::pb/seek (js/Math.round
(+ (:at time) (/ % (:rate time))))]))]
[section (str "tracing · " (name face))
(when (trace/traceable? clip face) [trace-keys face frame seek!])
(when (seq faces)
[:div.row {:style {:margin-top "5px"}}
[:span.dim "faces"]
(doall
(for [{p :path in :in f :face} faces]
^{:key (str p)}
[:button {:on-click #(rf/dispatch [::ui/select [:node in (peek p) (into path p)]])}
(name f)]))])]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; a symbol ;; a symbol
@ -701,6 +687,11 @@
:group (get-in clip [:groups id :subject]) :group (get-in clip [:groups id :subject])
nil)) nil))
(defn- face?
"Is symbol `sid` a face: does it have a measured head?"
[clip sid]
(boolean (seq (get-in clip [:symbols sid :nodes :head :measured]))))
(defn- face-selection (defn- face-selection
"The one face explicitly named by a face symbol, its placement, or a tracking "The one face explicitly named by a face symbol, its placement, or a tracking
owner. A shape merely living inside an open face is deliberately not one." owner. A shape merely living inside an open face is deliberately not one."
@ -711,7 +702,7 @@
(= :symbol kind) id (= :symbol kind) id
(#{:subject :feature :group} kind) (subject-of-owner clip selection) (#{:subject :feature :group} kind) (subject-of-owner clip selection)
(= :node kind) placed)] (= :node kind) placed)]
(when (and candidate (trace/traceable? clip candidate)) candidate))) (when (and candidate (face? clip candidate)) candidate)))
(defn- footage-faces [clip selection selected-node] (defn- footage-faces [clip selection selected-node]
(if (= :footage (first selection)) (if (= :footage (first selection))
@ -791,10 +782,97 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
(defn- eye-repair-controls [sid {:keys [id from through]} current]
(let [clip @(rf/subscribe [::render/clip])
in-range? (and (integer? current) (<= from current through))]
(r/with-let [draft (r/atom {:side :l :opening 1 :gaze-x 0 :gaze-y 0})]
(let [side (:side @draft)
layer-id (str id "/eye/" (name side))
eye (keyword (str "eye-" (name side)))
iris (keyword (str "iris-" (name side)))
find-layer (fn [node path]
(some #(when (= layer-id (:id %)) %)
(get-in clip [:symbols sid :nodes node :channels path :over])))
lids (find-layer eye [:geom :pts])
gaze (find-layer iris [:xform :pos])
load! (fn []
(when in-range?
(let [opening (if lids (channel/value-at (:values lids) current nil) 1)
offset (if gaze (channel/value-at (:values gaze) current nil) [0 0])]
(swap! draft assoc :opening opening
:gaze-x (* 100 (first offset)) :gaze-y (* 100 (second offset))))))]
[:div {:style {:margin-top "8px"}}
[:div.dim "Eye adjustments · key a pose, then scrub and key another. Adjustments tween within this interval."]
[:label.inspector-field "eye"
[:select {:value (name side)
:on-change #(swap! draft assoc :side (keyword (.. % -target -value)))}
[:option {:value "l"} "left eye"]
[:option {:value "r"} "right eye"]]]
[draft-number draft :opening "lid opening (1 = donor, 0 = closed)" false]
[draft-number draft :gaze-x "gaze x (% of image height)" false]
[draft-number draft :gaze-y "gaze y (% of image height)" false]
[:div.row
[:button {:disabled (not in-range?) :on-click load!} "load current adjustment"]
[:button {:disabled (not in-range?)
:on-click #(rf/dispatch
[::ui/eye-key sid id side current
{:opening (:opening @draft)
:gaze-x (when (number? (:gaze-x @draft)) (/ (:gaze-x @draft) 100))
:gaze-y (when (number? (:gaze-y @draft)) (/ (:gaze-y @draft) 100))}])}
(if in-range? (str "key eye at frame " current) "scrub inside interval to key eye")]]
(when lids
[:div.row
[:span.dim (str "eye keys: " (str/join ", " (sort (keys (get-in lids [:values :keys])))))]
[:button {:on-click #(rf/dispatch [::ui/remove-eye-keys sid id side])} "reset eye adjustments"]])]))))
(defn- repair-section [sid path]
(let [status (:status @(rf/subscribe [::playback/project]))
clip @(rf/subscribe [::render/clip])
store @(rf/subscribe [::render/store])
open @(rf/subscribe [::render/open])
frame @(rf/subscribe [::render/open-frame])
inside (nest/inside clip store open path frame)
current (when (= sid (:sid inside)) (:frame inside))
usable? (and (integer? current)
(<= 0 current (dec (get-in clip [:symbols sid :frames]))))
repairs (distinct (for [[_ n] (get-in clip [:symbols sid :nodes])
[_ c] (:channels n) r (:repairs c)] r))]
(r/with-let [draft (r/atom {:from 0 :through 1 :donor 2 :head? false})]
[section "repair intervals"
[:div.dim "Hold a clean pose across damaged frames. Face settings still apply. Frame numbers are local to this face, starting at 0."]
(for [[field label] [[:from "from face frame"]
[:through "through face frame"]
[:donor "clean donor frame"]]]
^{:key field}
[:div.row
[draft-number draft field label true]
[:button {:disabled (not usable?)
:title (if usable? (str "use face frame " current)
"move the playhead over this face")
:on-click #(swap! draft assoc field current)}
"use current frame"]])
[:div.dim (if usable? (str "current face frame: " current)
"Move the playhead over this face to pick its current frame.")]
[:label [:input {:type "checkbox" :checked (:head? @draft)
:on-change #(swap! draft assoc :head? (.. % -target -checked))}]
" borrow head movement too"]
[:button {:on-click #(rf/dispatch [::ui/borrow-pose sid @draft])} "borrow pose"]
(when status [:div.dim {:role "status"} status])
(for [{:keys [id from through donor] :as repair} repairs]
^{:key (str id)}
[:div {:style {:margin-top "10px"}}
[:div.row
[:span (str from "–" through " ← frame " donor)]
[:button {:on-click #(rf/dispatch [::ui/remove-repair sid id])} "remove"]]
[eye-repair-controls sid repair current]])])))
(defn view [] (defn view []
(let [clip @(rf/subscribe [::render/clip]) (let [clip @(rf/subscribe [::render/clip])
open @(rf/subscribe [::render/open]) open @(rf/subscribe [::render/open])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
;; Nothing selected inspects the symbol that is open, as clicking its
;; tab would.
inspected (or selection [:symbol open])
node @(rf/subscribe [::sub/selected-node]) node @(rf/subscribe [::sub/selected-node])
;; The face the tracing section is about: the SELECTED PLACEMENT's symbol, ;; The face the tracing section is about: the SELECTED PLACEMENT's symbol,
;; or, when the selection is not an instance or there is none, the OPEN ;; or, when the selection is not an instance or there is none, the OPEN
@ -810,32 +888,35 @@
palette-placement? (and node palette-placement? (and node
(= :palette-track (= :palette-track
(get-in clip [:symbols (first node) :type]))) (get-in clip [:symbols (first node) :type])))
palette-symbol? (and (= :symbol (first selection)) palette-symbol? (and (= :symbol (first inspected))
(= :palette (get-in clip [:symbols (second selection) :type]))) (= :palette (get-in clip [:symbols (second inspected) :type])))
face (or placed (when (trace/traceable? clip open) open)) face (or placed (when (face? clip open) open))
faces (when face (trace/faces clip face)) layer? (and placed (clip-domain/trace? (clip-domain/symbol clip placed)))
;; Where that face sits, as a row path from the open symbol, so the faces ;; Where that face or layer sits, as a row path from the open symbol. A
;; inside it can be selected by their own rows. A selection made on the ;; selection made on the stage has no path and names a node directly in
;; stage has no path and names a node directly in the open symbol; the ;; the open symbol; the open symbol itself is at no path at all.
;; open symbol itself is at no path at all.
path (if placed (or (nth selection 3 nil) [(second node)]) [])] path (if placed (or (nth selection 3 nil) [(second node)]) [])]
[:section.pane.params [:section.pane.params
[:div.pane-head "inspector"] [:div.pane-head "inspector"]
[:div {:style {:min-height 0}} [:div {:style {:min-height 0}}
(if palette-placement? (when palette-placement? [palette-placement-section node])
[palette-placement-section node] (when (= [:symbol (clip-domain/opens-on clip)] inspected)
[clip-section]) [clip-section])
(when (and node (not palette-placement?)) [node-section node]) (when (and node (not palette-placement?)) [node-section node])
(when (and placed (not palette-placement?)) [instance-playback node])
(when (and node (not palette-placement?)) [palette/remap-section])
(when (and placed (not palette-placement?)) [symbol-section placed "source symbol"]) (when (and placed (not palette-placement?)) [symbol-section placed "source symbol"])
(when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))} (when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))}
[correction-section node]) [correction-section node])
(when (and (not palette-placement?) (seq footage-faces)) (when layer?
[footage-section footage-faces]) [layer-section (str "tracing · " (clip-domain/symbol-name clip placed))
(when (and face (or (trace/traceable? clip face) (seq faces))) (first node) (second node) path])
[tracing-section face faces path]) (when (get-in clip [:symbols face :nodes :plate])
(when face ^{:key (str "perf/" face)} [performance-section face]) [face-section face path])
(when palette-symbol? [palette-symbol-section (second selection)]) (when (and face (face? clip face) (not layer?)) ^{:key (str "repair/" face)} [repair-section face path])
(when (and (= :symbol (first selection)) (not palette-symbol?)) (when (and face (not layer?)) ^{:key (str "perf/" face)} [performance-section face])
[symbol-section (second selection)]) (when palette-symbol? [palette-symbol-section (second inspected)])
(when (and (= :symbol (first inspected)) (not palette-symbol?))
[symbol-section (second inspected)])
(when (and (seq tracking-owners) (not palette-placement?) (not palette-symbol?)) (when (and (seq tracking-owners) (not palette-placement?) (not palette-symbol?))
[tracking-section tracking-owners])]])) [tracking-section tracking-owners])]]))

View file

@ -20,14 +20,20 @@
no global interceptors." no global interceptors."
(:require [arthur.clock :as clock] (:require [arthur.clock :as clock]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.cut :as cut]
[arthur.domain.outline :as outline]
[arthur.domain.onion :as onion]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.pick :as pick] [arthur.domain.pick :as pick]
[arthur.domain.raster :as raster] [arthur.domain.raster :as raster]
[arthur.domain.symbol :as symbol]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.subs.playback :as sub] [arthur.subs.playback :as sub]
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.subs.ui :as ui-sub]
[arthur.ui.canvas :as canvas] [arthur.ui.canvas :as canvas]
[arthur.ui.underlay :as underlay] [arthur.ui.tracing :as tracing]
[arthur.ui.layout :as layout]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.ratom :as ratom])) [reagent.ratom :as ratom]))
@ -103,9 +109,19 @@
(some-> @tracker ratom/dispose!) (some-> @tracker ratom/dispose!)
(reset! tracker (reset! tracker
(ratom/run! (ratom/run!
(let [{was :resolver was-u :underlay} @snapshot (let [{was :resolver was-t :tracing :as before} @snapshot
now @(rf/subscribe [::render/shown]) now @(rf/subscribe [::render/shown])
u @(rf/subscribe [::render/underlay])] t @(rf/subscribe [::render/tracing])
;; The pen's draft is drawn INTO the picture, filled, so what
;; is on screen while placing points is the pixels a finished
;; shape will be.
pen {:draft @(rf/subscribe [::ui-sub/draft])
:hover @(rf/subscribe [::ui-sub/hover])
:tone @(rf/subscribe [::ui-sub/tone])
:fit @(rf/subscribe [::ui-sub/fit])
;; Where a new shape would land, so what is being drawn
;; is drawn in that symbol's stacking context.
:target (:path @(rf/subscribe [::ui-sub/creation-target]))}]
(reset! snapshot (reset! snapshot
{:resolver now {:resolver now
:palette @(rf/subscribe [::render/palette]) :palette @(rf/subscribe [::render/palette])
@ -114,13 +130,20 @@
:frames @(rf/subscribe [::render/frames]) :frames @(rf/subscribe [::render/frames])
:width @(rf/subscribe [::sub/width]) :width @(rf/subscribe [::sub/width])
:height @(rf/subscribe [::sub/height]) :height @(rf/subscribe [::sub/height])
:underlay u :mat @(rf/subscribe [::layout/mat])
:tracing t
:frame @(rf/subscribe [::sub/frame]) :frame @(rf/subscribe [::sub/frame])
:playing? @(rf/subscribe [::sub/playing?])}) :playing? @(rf/subscribe [::sub/playing?])
:pen pen
:onion @(rf/subscribe [::layout/onion])
:document @(rf/subscribe [::render/clip])
:store @(rf/subscribe [::render/store])
:open @(rf/subscribe [::render/open])
:selection @(rf/subscribe [::ui-sub/selection])})
;; A new resolver means a new scene or a new palette, and neither ;; A new resolver means a new scene or a new palette, and neither
;; moves the playhead — so nothing else would ask for a redraw. ;; moves the playhead — so nothing else would ask for a redraw.
;; ;;
;; Switching a face's footage on wants the same redraw for the same ;; Switching tracing on or off wants the same redraw for the same
;; reason, and it needs asking for SEPARATELY: it is a viewing aid ;; reason, and it needs asking for SEPARATELY: it is a viewing aid
;; in the editor's own state, so it changes what the canvases should ;; in the editor's own state, so it changes what the canvases should
;; show without touching the frame number OR the resolver. The ;; show without touching the frame number OR the resolver. The
@ -129,9 +152,25 @@
;; Comparing the whole map is as cheap as picking fields out of it: ;; Comparing the whole map is as cheap as picking fields out of it:
;; the document and the store it carries are the same OBJECTS unless ;; the document and the store it carries are the same OBJECTS unless
;; the resolver changed too, and that is tested first. ;; the resolver changed too, and that is tested first.
(when-not (and (identical? was now) (= was-u u)) (when-not (and (identical? was now) (= was-t t) (= pen (:pen before)) (= (:mat before) (:mat @snapshot))
(= (:onion before) (:onion @snapshot))
(= (:selection before) (:selection @snapshot))
(= (:playing? before) (:playing? @snapshot)))
(repaint!)))))) (repaint!))))))
;; The brush or eraser stroke being painted: its mask, mutated in place as the
;; pointer moves, which is why it is an atom the stage pokes rather than state
;; anything renders from. `{:mask :version :slot :knock :paths}`, `:mask` being an
;; `outline/mask`.
(defonce ^:private stroke (atom nil))
(defonce ^:private trace-cache (atom nil))
(defn stroke!
"Show stroke `s` in the picture until it is replaced or nil, and redraw."
[s]
(reset! stroke s)
(repaint!))
(defn set-canvas! [el] (defn set-canvas! [el]
(swap! state assoc :canvas el) (swap! state assoc :canvas el)
;; The :ref fires AFTER the loop has started, so the first tick or two run ;; The :ref fires AFTER the loop has started, so the first tick or two run
@ -140,6 +179,30 @@
;; — a blank canvas under a transport reading perfectly correct. ;; — a blank canvas under a transport reading perfectly correct.
(when el (repaint!))) (when el (repaint!)))
(defn set-onion-canvas! [el]
(swap! state assoc :onion-canvas el)
(when el (repaint!)))
(declare op-path)
(defn- paint-onions! [f]
(let [{:keys [onion-canvas]} @state
{:keys [onion playing? resolver document store open selection width height]} @snapshot]
(canvas/clear-overlay! onion-canvas)
(when (and onion-canvas (:on? onion) (not playing?))
(doseq [{:keys [frame path direction]} (onion/samples document store open selection f onion)]
;; Consume each result before asking the resolver for another frame:
;; its geometry buffers are shared with the current picture.
(let [ops (filter (fn [op]
(and (not= :trace (:kind op))
(= path (vec (take (count path) (op-path op))))))
(resolver frame))
layer (raster/layer width height)]
(raster/draw-ops! layer ops)
(canvas/tint-layer! onion-canvas layer
(if (= :before direction) [235 75 75] [65 145 245])
(:opacity onion)))))))
(defn- raster-for [w h] (defn- raster-for [w h]
(let [{:keys [raster]} @state] (let [{:keys [raster]} @state]
(if (and raster (= w (:w raster)) (= h (:h raster))) (if (and raster (= w (:w raster)) (= h (:h raster)))
@ -154,16 +217,90 @@
[point] [point]
(pick/hit (:ops @state) point)) (pick/hit (:ops @state) point))
(defn hit-op
"The topmost op that shows at `point`, as `at` picks it: what the eraser
starts on."
[point]
(pick/hit-op (:ops @state) point))
(defn in-rect [rect depth] (defn in-rect [rect depth]
(pick/in-rect (:ops @state) rect depth)) (pick/in-rect (:ops @state) rect depth))
(defn- index-of-slot [palette active slot]
(if (and (:palettes palette) (:offsets palette))
(pal/render-index palette active slot)
slot))
(defn- traced
"Stroke `s` as the rings letting go would make of it, `[outer & holes]` per
piece: traced and simplified by the same function the saved shapes are, so
the preview IS them. Once per version of the mask and fit, not per paint."
[{:keys [mask version]} fit]
(let [key [mask version fit]]
(if (= key (:key @trace-cache))
(:rings @trace-cache)
(:rings (reset! trace-cache
{:key key
:rings (mapv #(outline/rings-of % fit) (outline/pieces mask))})))))
(defn- op-path [op] (let [n (:node op)] (if (vector? n) n [n])))
(defn- poly [ring op]
(assoc op :kind :poly :pts (into-array ring) :n (quot (count ring) 2)))
(defn- cut-ops
"`ops` with each op of a shape at one of `paths` cut by `cutters`, as the
eraser will cut it."
[ops paths cutters]
(into []
(mapcat (fn [{:keys [pts n] :as op}]
(or (when (and (= :poly (:kind op)) (contains? paths (op-path op)))
(some->> (cut/cut (vec (take (* 2 n) (array-seq pts))) cutters)
(map #(poly % (dissoc op :pts :n)))))
[op])))
ops))
(defn- inked
"Op `op` drawn in tone `tone`: a slot's colour, or — for a remap — light on
what is under it, through the same table the saved shape gets."
[op tone palette active]
(if (symbol/remap? tone)
(assoc op :lut (symbol/lut #(index-of-slot palette active %) tone) :color 0)
(assoc op :color (index-of-slot palette active tone))))
(defn- with-previews
"What is being drawn and is not in the document yet, added to `ops` in the
stacking context of the symbol it will land in: the pen's draft as far as the
pointer, a brush stroke as the polygons it will be, and an eraser's cut as
the shapes it will leave."
[ops palette active]
(let [{:keys [draft hover tone fit target]} (:pen @snapshot)
target (or target [])
pts (cond-> (vec draft) (and (seq draft) hover) (into hover))
{:keys [slot knock paths] :as s} @stroke
rings (when (:mask s) (traced s fit))]
(cond-> ops
(and (<= 6 (count pts)) (or (number? tone) (symbol/remap? tone)))
(clip/atop target (inked (poly pts {}) tone palette active))
paths
(cut-ops paths rings)
(and rings (not paths) (nil? knock))
(as-> ops (reduce #(clip/atop %1 target (inked (poly (outline/join %2) {}) slot palette active))
ops rings))
(and rings (not paths) knock)
(as-> ops (reduce #(clip/in-layer %1 target (poly (outline/join %2) {:color 0 :knock knock}))
ops rings)))))
(defn paint! (defn paint!
"Resolve `f` and put it on the canvas. `ops` are consumed here and only here — "Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
the resolver reuses its point buffers between frames, so they have to be the resolver reuses its point buffers between frames, so they have to be
rasterised before the next frame is asked for." rasterised before the next frame is asked for."
[f] [f]
(let [{:keys [canvas]} @state (let [{:keys [canvas]} @state
{:keys [resolver palette ramp width height underlay playing?]} @snapshot] {:keys [resolver palette ramp width height tracing playing? mat]} @snapshot]
(when (and canvas resolver width height) (when (and canvas resolver width height)
;; User Timing, so a profile in the DevTools performance panel has named ;; User Timing, so a profile in the DevTools performance panel has named
;; spans in the Timings track instead of a wall of anonymous frames. Three ;; spans in the Timings track instead of a wall of anonymous frames. Three
@ -172,18 +309,22 @@
;; THE STAGE IS THE CLIP'S, not a constant. Project dimensions are ;; THE STAGE IS THE CLIP'S, not a constant. Project dimensions are
;; independent of the footage, so the size the frame is rasterised at comes ;; independent of the footage, so the size the frame is rasterised at comes
;; out of the document like everything else. ;; out of the document like everything else.
(paint-onions! f)
(let [ras (raster-for width height) (let [ras (raster-for width height)
ops (resolver f) {traces true picture false} (group-by #(= :trace (:kind %)) (resolver f))
;; A layer switched off, or all of them, is not on the stage at all:
;; not painted and not there to be clicked.
traces (when (:on? tracing)
(into [] (remove #(contains? (:hidden tracing) (:layer %))) traces))
active (clip/active-palette resolver) active (clip/active-palette resolver)
bg (pal/background-index palette active)] bg (pal/background-index palette active)]
(swap! state assoc :ops ops) (swap! state assoc :ops (into (vec picture) traces))
(-> ras (-> ras
(raster/clear! bg) (raster/clear! bg)
(raster/draw-ops! ops)) (raster/draw-ops! (with-previews picture palette active)))
(js/performance.mark "arthur/blit:start") (js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras (pal/effective-ramp palette active)) (canvas/blit! canvas ras (pal/effective-ramp palette active))
(underlay/paint! (assoc underlay :width width :playing? playing?) (tracing/paint! traces (assoc tracing :width width :origin 0 :playing? playing?) repaint!))
resolver repaint!))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start") (js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start") (js/performance.measure "arthur/paint" "arthur/paint:start")
;; User Timing entries otherwise accumulate forever in the browser's ;; User Timing entries otherwise accumulate forever in the browser's

View file

@ -56,6 +56,7 @@
[arthur.subs.ui :as sub] [arthur.subs.ui :as sub]
[arthur.ui.canvas :as canvas] [arthur.ui.canvas :as canvas]
[arthur.ui.drag :as drag] [arthur.ui.drag :as drag]
[arthur.ui.tracing :as tracing]
[clojure.string :as str] [clojure.string :as str]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.core :as r])) [reagent.core :as r]))
@ -141,6 +142,13 @@
:style {:width 32 :height 20 :max-width 32 :max-height 20}}] :style {:width 32 :height 20 :max-width 32 :max-height 20}}]
[:span.thumb])) [:span.thumb]))
(defn- tracing-thumb
"The first source frame, using the stage's media URL cache."
[media]
(r/with-let [ready (r/atom 0)]
@ready
[picture (tracing/url-of media 0 #(swap! ready inc))]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the row ;; the row
@ -254,8 +262,12 @@
:title (str label " · " (:frames sym) " frames · " nodes :title (str label " · " (:frames sym) " frames · " nodes
(if (= 1 nodes) " node" " nodes") (if (= 1 nodes) " node" " nodes")
(when (= sid open) " · open") (when (= sid open) " · open")
" — double-click to open, drag to place") (if (= :trace (:type sym))
:thumb [picture (symbol-thumb document sid store palette ramp)] " — drag to place"
" — double-click to open, drag to place"))
:thumb (if (= :trace (:type sym))
[tracing-thumb (:media sym)]
[picture (symbol-thumb document sid store palette ramp)])
:sub2 (str (:frames sym) "f · " nodes (if (= 1 nodes) " node" " nodes")) :sub2 (str (:frames sym) "f · " nodes (if (= 1 nodes) " node" " nodes"))
:on? (= selection [:symbol sid]) :on? (= selection [:symbol sid])
:open? (= sid open) :open? (= sid open)
@ -287,7 +299,7 @@
(rf/dispatch [::project/rename-symbol sid value]))) (rf/dispatch [::project/rename-symbol sid value])))
:on-click #(rf/dispatch [::ui/select [:symbol sid]])}])) :on-click #(rf/dispatch [::ui/select [:symbol sid]])}]))
(defn- footage-row [{:keys [id label frames fps video] :as f} chosen rename] (defn- footage-row [{:keys [id label frames fps video width height] :as f} chosen rename]
^{:key id} ^{:key id}
[row (merge {:label label [row (merge {:label label
:sub (str frames "f") :sub (str frames "f")
@ -304,7 +316,8 @@
:on-click #(rf/dispatch [::footage/choose id])} :on-click #(rf/dispatch [::footage/choose id])}
(carrying (str "footage:" id) (carrying (str "footage:" id)
#(drag/other! {:kind :footage :id id :label label #(drag/other! {:kind :footage :id id :label label
:frames frames :fps fps :video video})))]) :frames frames :fps fps :video video
:width width :height height})))])
(defn- sound-row (defn- sound-row
"An uploaded sound, or with `:footage?` a video's own — which is how a take's "An uploaded sound, or with `:footage?` a video's own — which is how a take's
@ -335,6 +348,30 @@
#(drag/other! {:kind :sound :source source :label label #(drag/other! {:kind :sound :source source :label label
:length length :rate rate :frames frames})))])) :length length :rate rate :frames frames})))]))
(defn- image-row
"An uploaded still, to be traced over: dropped, it becomes a tracing layer —
see `events/ui ::drop-tracing`."
[{:keys [id label width height digest url]} rename]
^{:key id}
[row (merge {:label label
:sub (str width "×" height)
:title (str label " · " width "×" height
" — drag onto the stage or the timeline to trace over it")
:thumb [:img.thumb {:src url :alt ""
:style {:width 32 :height 20 :object-fit "cover"}}]
:rename (assoc rename
:key [:image id]
:value label
:commit! (fn [value]
((:begin! rename) nil)
(rf/dispatch [::footage/relabel :image id value])))}
(carrying (str "image:" id)
#(drag/other! {:kind :tracing :label label :frames 1
:center [(/ width 2) (/ height 2)]
:symbol {:name label :type :trace
:media {:image digest}
:width width :height height :nodes {}}})))])
(defn- import-row [{:keys [cid symbol name frames]} pid] (defn- import-row [{:keys [cid symbol name frames]} pid]
^{:key (str cid symbol)} ^{:key (str cid symbol)}
[row (merge {:label name [row (merge {:label name
@ -400,7 +437,7 @@
Still not `:main` being special. The document says which symbol that is by its Still not `:main` being special. The document says which symbol that is by its
structure; rename it, place it inside something else, and the pool follows." structure; rename it, place it inside something else, and the pool follows."
[{:keys [document query searching? media sounds chosen rename main palette-choice selection] :as ctx}] [{:keys [document query searching? media sounds images chosen rename main palette-choice selection] :as ctx}]
(let [named? #(hit? query (clip/symbol-name document %)) (let [named? #(hit? query (clip/symbol-name document %))
top (when (and main (named? main)) main) top (when (and main (named? main)) main)
symbol-ids (sort-by str (keys (:symbols document))) symbol-ids (sort-by str (keys (:symbols document)))
@ -411,22 +448,27 @@
transition? #(or (= :palette (:type (clip/symbol document %))) transition? #(or (= :palette (:type (clip/symbol document %)))
(contains? transition-ids %)) (contains? transition-ids %))
transitions (filterv #(and (named? %) (transition? %)) symbol-ids) transitions (filterv #(and (named? %) (transition? %)) symbol-ids)
tracing (filterv #(and (named? %) (clip/trace? (clip/symbol document %)))
symbol-ids)
rest (filterv #(and (named? %) (not= main %) rest (filterv #(and (named? %) (not= main %)
(not (#{:palette :palette-track} (not (#{:palette :palette-track :trace}
(:type (clip/symbol document %))))) (:type (clip/symbol document %)))))
symbol-ids) symbol-ids)
media (filterv #(hit? query (:label %)) media) media (filterv #(hit? query (:label %)) media)
sounds (filterv #(hit? query (:label %)) sounds) sounds (filterv #(hit? query (:label %)) sounds)
] images (filterv #(hit? query (:label %)) images)]
[sections searching? [sections searching?
(+ (if top 1 0) (count rest) (count transitions) (+ (if top 1 0) (count rest) (count transitions) (count tracing)
(count media) (count sounds)) (count media) (count sounds) (count images))
[{:title "project" :searching? searching? [{:title "project" :searching? searching?
:blank "nothing to open yet" :blank "nothing to open yet"
:rows (when top [(symbol-row document top ctx)])} :rows (when top [(symbol-row document top ctx)])}
{:title "symbols" :searching? searching? {:title "symbols" :searching? searching?
:blank "nothing else in the library" :blank "nothing else in the library"
:rows (mapv #(symbol-row document % ctx) rest)} :rows (mapv #(symbol-row document % ctx) rest)}
{:title "tracing layers" :searching? searching?
:blank "no tracing layers yet"
:rows (mapv #(symbol-row document % ctx) tracing)}
{:title "palette transitions" :searching? searching? {:title "palette transitions" :searching? searching?
:blank "no palette transitions" :blank "no palette transitions"
:rows (mapv #(palette-transition-row document % selection rename) transitions)} :rows (mapv #(palette-transition-row document % selection rename) transitions)}
@ -435,28 +477,35 @@
:rows (mapv #(footage-row % chosen rename) media)} :rows (mapv #(footage-row % chosen rename) media)}
{:title "sounds" :searching? searching? {:title "sounds" :searching? searching?
:blank "drop an mp3 or wav here" :blank "drop an mp3 or wav here"
:rows (mapv #(sound-row % (:fps document) rename) sounds)}]])) :rows (mapv #(sound-row % (:fps document) rename) sounds)}
{:title "images" :searching? searching?
:blank "drop a png or jpeg here to trace over"
:rows (mapv #(image-row % rename) images)}]]))
(defn- all-assets (defn- all-assets
"Everything the server holds. Other projects' symbols stay grouped by project "Everything the server holds. Other projects' symbols stay grouped by project
and closed: a server holds many, and a wall of every symbol in every one buries and closed: a server holds many, and a wall of every symbol in every one buries
the one you want." the one you want."
[{:keys [document query searching? rename chosen available all-sounds symbols palettes [{:keys [document query searching? rename chosen available all-sounds all-images symbols
project-id]}] palettes project-id]}]
(let [media (filterv #(hit? query (:label %)) available) (let [media (filterv #(hit? query (:label %)) available)
sounds (filterv #(hit? query (:label %)) all-sounds) sounds (filterv #(hit? query (:label %)) all-sounds)
images (filterv #(hit? query (:label %)) all-images)
others (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) others (filterv #(and (not= project-id (:project %)) (hit? query (:name %)))
symbols) symbols)
grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others)) grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others))
palettes (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) palettes)] palettes (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) palettes)]
[sections searching? [sections searching?
(+ (count media) (count sounds) (count others) (count palettes)) (+ (count media) (count sounds) (count images) (count others) (count palettes))
[{:title "media" :searching? searching? [{:title "media" :searching? searching?
:blank "nothing uploaded yet" :blank "nothing uploaded yet"
:rows (mapv #(footage-row % chosen rename) media)} :rows (mapv #(footage-row % chosen rename) media)}
{:title "sounds" :searching? searching? {:title "sounds" :searching? searching?
:blank "no sounds uploaded yet" :blank "no sounds uploaded yet"
:rows (mapv #(sound-row % (:fps document) rename) sounds)} :rows (mapv #(sound-row % (:fps document) rename) sounds)}
{:title "images" :searching? searching?
:blank "no images uploaded yet"
:rows (mapv #(image-row % rename) images)}
{:title "palettes" :searching? searching? {:title "palettes" :searching? searching?
:blank "no palettes in other saved projects" :blank "no palettes in other saved projects"
:rows (mapv import-palette-row palettes)} :rows (mapv import-palette-row palettes)}
@ -481,14 +530,17 @@
one cost of collapsing two folders into two tabs — that a hit could be behind one cost of collapsing two folders into two tabs — that a hit could be behind
the tab you did not pick — is paid off by a number, counted over the same the tab you did not pick — is paid off by a number, counted over the same
labels the rows are filtered by." labels the rows are filtered by."
[{:keys [document query media sounds available all-sounds symbols palettes project-id]}] [{:keys [document query media sounds images available all-sounds all-images symbols
palettes project-id]}]
(let [n (fn [labels] (count (filter #(hit? query %) labels)))] (let [n (fn [labels] (count (filter #(hit? query %) labels)))]
{:project (+ (n (map #(clip/symbol-name document %) (keys (:symbols document)))) {:project (+ (n (map #(clip/symbol-name document %) (keys (:symbols document))))
(n (map :name (vals (pal/palettes document)))) (n (map :name (vals (pal/palettes document))))
(n (map :label media)) (n (map :label media))
(n (map :label sounds))) (n (map :label sounds))
(n (map :label images)))
:assets (+ (n (map :label available)) :assets (+ (n (map :label available))
(n (map :label all-sounds)) (n (map :label all-sounds))
(n (map :label all-images))
(n (map :name (remove #(= project-id (:project %)) palettes))) (n (map :name (remove #(= project-id (:project %)) palettes)))
(n (map :name (remove #(= project-id (:project %)) symbols))))})) (n (map :name (remove #(= project-id (:project %)) symbols))))}))
@ -504,7 +556,8 @@
;; than a flag per row: exactly one name is ever being edited, and ;; than a flag per row: exactly one name is ever being edited, and
;; opening a second input has to close the first. ;; opening a second input has to close the first.
editing (r/atom nil)] editing (r/atom nil)]
(let [{:keys [loading? status available sounds chosen]} @(rf/subscribe [::playback/footage]) (let [{:keys [loading? status available sounds images uploaded chosen]}
@(rf/subscribe [::playback/footage])
document @(rf/subscribe [::sub/settled-clip]) document @(rf/subscribe [::sub/settled-clip])
clip-id @(rf/subscribe [::render/clip-id]) clip-id @(rf/subscribe [::render/clip-id])
store @(rf/subscribe [::render/store]) store @(rf/subscribe [::render/store])
@ -522,12 +575,19 @@
:duration (/ frames fps)}) :duration (/ frames fps)})
media) media)
@(rf/subscribe [::sub/project-sounds])) @(rf/subscribe [::sub/project-sounds]))
;; The stills this document traces over, and those uploaded while it
;; was open — as `::sub/project-sounds` decides for sounds.
traced (into #{} (keep #(get-in % [:media :image])) (vals (:symbols document)))
own-images (filterv #(or (contains? traced (:digest %))
(contains? (set uploaded) (:id %)))
images)
needle (str/lower-case (str/trim @query)) needle (str/lower-case (str/trim @query))
searching? (boolean (seq needle)) searching? (boolean (seq needle))
ctx {:document document :clip-id clip-id :store store :palette palette ctx {:document document :clip-id clip-id :store store :palette palette
:ramp ramp :selection selection :open open :ramp ramp :selection selection :open open
:media media :sounds own-sounds :chosen chosen :media media :sounds own-sounds :images own-images :chosen chosen
:available (vec available) :all-sounds (vec sounds) :available (vec available) :all-sounds (vec sounds)
:all-images (vec images)
:symbols symbols :palettes palettes :project-id project-id :symbols symbols :palettes palettes :project-id project-id
:palette-choice palette-choice :palette-choice palette-choice
:query needle :searching? searching? :query needle :searching? searching?
@ -553,11 +613,11 @@
[:div.pane-head [:div.pane-head
"media pool" "media pool"
[:span.spacer] [:span.spacer]
[:button {:title "add a video or a sound" [:button {:title "add a video, a sound or an image"
:disabled loading? :disabled loading?
:on-click #(.click (js/document.getElementById "pool-file"))} :on-click #(.click (js/document.getElementById "pool-file"))}
"+"]] "+"]]
[:input {:id "pool-file" :type "file" :accept "video/*,audio/*" [:input {:id "pool-file" :type "file" :accept "video/*,audio/*,image/*"
:style {:display "none"} :style {:display "none"}
:on-change (fn [^js event] :on-change (fn [^js event]
(when-let [file (aget (.. event -target -files) 0)] (when-let [file (aget (.. event -target -files) 0)]

View file

@ -14,12 +14,12 @@
[arthur.subs.render :as render] [arthur.subs.render :as render]
[arthur.ui.layout :as layout] [arthur.ui.layout :as layout]
[arthur.ui.location :as location] [arthur.ui.location :as location]
[arthur.ui.palette :as palette]
[arthur.ui.params :as params] [arthur.ui.params :as params]
[arthur.ui.pool :as pool] [arthur.ui.pool :as pool]
[arthur.ui.stage :as stage] [arthur.ui.stage :as stage]
[arthur.ui.tabs :as tabs] [arthur.ui.tabs :as tabs]
[arthur.ui.timeline :as timeline] [arthur.ui.timeline :as timeline]
[arthur.ui.tools :as tools]
[arthur.ui.topbar :as topbar] [arthur.ui.topbar :as topbar]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.core :as r])) [reagent.core :as r]))
@ -74,8 +74,10 @@
(when-not (gone? :pool) [layout/grip :pool pool :col 1]) (when-not (gone? :pool) [layout/grip :pool pool :col 1])
[:section.view [:section.view
[tabs/view] [tabs/view]
[palette/bar] [tools/options]
[stage/view]] [:div.workspace
[tools/toolbox]
[stage/view]]]
(when-not (gone? :params) [layout/grip :params params :col -1]) (when-not (gone? :params) [layout/grip :params params :col -1])
(when-not (gone? :params) [params/view]) (when-not (gone? :params) [params/view])
;; Above the timeline rather than inside it: the bar says where an edit would ;; Above the timeline rather than inside it: the bar says where an edit would

View file

@ -14,8 +14,10 @@
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.outline :as outline]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.pick :as pick] [arthur.domain.pick :as pick]
[arthur.domain.symbol :as symbol]
[arthur.events.paint :as paint-events] [arthur.events.paint :as paint-events]
[arthur.events.ui :as ui] [arthur.events.ui :as ui]
[arthur.footage.store :as store] [arthur.footage.store :as store]
@ -25,24 +27,23 @@
[arthur.ui.drag :as drag] [arthur.ui.drag :as drag]
[arthur.ui.layout :as layout] [arthur.ui.layout :as layout]
[arthur.ui.player :as player] [arthur.ui.player :as player]
[arthur.ui.underlay :as underlay] [arthur.ui.tracing :as tracing]
[arthur.ui.tools :as tools]
[arthur.ui.timeline :as timeline]
[re-frame.core :as rf] [re-frame.core :as rf]
[reagent.core :as r])) [reagent.core :as r]))
;; THE ZOOM IS NOT A CONSTANT ANY MORE — it is `ui/layout`'s, an integer in ;; Pointer coordinates come from the SVG transform, in stage pixels.
;; [1 8], 2 to begin with. It scales the canvas with CSS and never its backing
;; store, so the browser suite still reads 320x200 of real pixels off
;; `canvas.stage` whatever the view is zoomed to; see `ui/canvas`.
(defn stage-point (defn- event-point [element event]
"Where a pointer event landed, in stage pixels. Shared by the vertex editor and (let [svg (if (= "svg" (.-tagName element)) element (.querySelector element "svg.paint-overlay"))
by a drop out of the media pool, which is the whole reason it is public." pt (.createSVGPoint svg)]
[event w h] (set! (.-x pt) (.-clientX event))
(let [box (.getBoundingClientRect (.-currentTarget event))] (set! (.-y pt) (.-clientY event))
[(-> (/ (* (- (.-clientX event) (.-left box)) w) (.-width box)) (let [p (.matrixTransform pt (.inverse (.getScreenCTM svg)))] [(.-x p) (.-y p)])))
js/Math.round (max 0) (min (dec w)))
(-> (/ (* (- (.-clientY event) (.-top box)) h) (.-height box)) (defn stage-point [event _w _h]
js/Math.round (max 0) (min (dec h)))])) (mapv js/Math.round (event-point (.-currentTarget event) event)))
(defn- pairs [pts] (mapv vec (partition 2 pts))) (defn- pairs [pts] (mapv vec (partition 2 pts)))
@ -55,6 +56,7 @@
;; produces go straight out as `::set-vertex`, which is where the document ;; produces go straight out as `::set-vertex`, which is where the document
;; changes and where re-frame belongs. ;; changes and where re-frame belongs.
(defonce ^:private dragging (atom nil)) (defonce ^:private dragging (atom nil))
(defonce ^:private selection-anchor (atom nil))
(defn- editing (defn- editing
"The selected node when it is a polygon on screen, however deep it is nested, "The selected node when it is a polygon on screen, however deep it is nested,
@ -112,9 +114,7 @@
"Where a pointer event is, in stage pixels, unrounded and unclamped: a drag "Where a pointer event is, in stage pixels, unrounded and unclamped: a drag
holding the pointer may leave the stage and still be moving something." holding the pointer may leave the stage and still be moving something."
[^js svg event w h] [^js svg event w h]
(let [box (.getBoundingClientRect svg)] (event-point svg event))
[(/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
(/ (* (- (.-clientY event) (.-top box)) h) (.-height box))]))
;; The move, turn or scale being dragged, as `dragging` is for a vertex: the ;; The move, turn or scale being dragged, as `dragging` is for a vertex: the
;; placement and transform it started from, and where. What it makes of the ;; placement and transform it started from, and where. What it makes of the
@ -344,10 +344,168 @@
:width (+ 2 (* 2.1 (count label))) :height 5}] :width (+ 2 (* 2.1 (count label))) :height 5}]
[:text.creation-target-tag {:x 1 :y 3.8} label]])])))) [:text.creation-target-tag {:x 1 :y 3.8} label]])]))))
(defn- overlay [w h zoom] ;; ---------------------------------------------------------------------------
;; the drawing tools
;; Where the pointer is over the stage, in stage pixels: the brush's footprint
;; and the pen's edge marker follow it. A ratom, read only by `cursor` and
;; `points`, so a move re-renders those and not the overlay.
(defonce ^:private pointer (r/atom nil))
;; The brush or eraser stroke under the pointer, as `dragging` is for a vertex.
(defonce ^:private painting (atom nil))
(def ^:private close-by
"Stage pixels from the first point at which a click closes the polygon."
3)
(defn- snapped
"`p` from the draft's last point, at the nearest 45° when ⇧ is held."
[draft [x y :as p] ^js event]
(if (and (.-shiftKey event) (<= 2 (count draft)))
(let [ax (nth draft (- (count draft) 2)) ay (peek draft)
a (* (/ js/Math.PI 4) (js/Math.round (/ (js/Math.atan2 (- y ay) (- x ax)) (/ js/Math.PI 4))))
d (js/Math.hypot (- x ax) (- y ay))]
[(js/Math.round (+ ax (* d (js/Math.cos a)))) (js/Math.round (+ ay (* d (js/Math.sin a))))])
p))
(defn- closes? [draft [x y]]
(and (<= 6 (count draft))
(<= (js/Math.hypot (- x (first draft)) (- y (second draft))) close-by)))
(defn- on-edge
"`[i t]`: the edge of ring `pts` that stage point `p` is on, from point `i`
a fraction `t` of the way to the next — or nil."
[pts [x y]]
(let [ps (pairs pts) n (count ps)
;; Not a bridge: a point there would open the hole. See `outline-path`.
there (set (map (fn [i] [(ps i) (ps (mod (inc i) n))]) (range n)))]
(some (fn [i]
(let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))
dx (- bx ax) dy (- by ay)
l2 (+ (* dx dx) (* dy dy))
t (if (zero? l2) 0 (/ (+ (* (- x ax) dx) (* (- y ay) dy)) l2))]
(when (and (< 0.05 t 0.95) (not (contains? there [[bx by] [ax ay]]))
(<= (js/Math.hypot (- x (+ ax (* t dx))) (- y (+ ay (* t dy)))) 1.5))
[i t])))
(range n))))
(defn- stroke-begin!
"Start painting with the brush, or erasing, at stage point `p`.
The eraser cuts the shapes in the symbol holding what the stroke STARTS on,
of the colour it starts on — Photoshop's background eraser, Flash's erase
fills — or, with ⌥, every one of them. Starting on nothing with ⌥ cuts in
the open symbol."
[{:keys [open f] :as ctx} tool p size tone ^js event]
(let [eraser? (= :eraser tool)
all? (.-altKey event)
op (when eraser? (player/hit-op p))
path (when op (let [n (:node op)] (if (vector? n) n [n])))
within (if path (pop path) [])
{document :clip st :store} (loaded ctx)
colour #(when-let [{:keys [sid id frame]} (nest/placement document st open % f)]
(when (get-in document [:symbols sid :nodes id :paint?])
(channel/value-at (get-in document [:symbols sid :nodes id :channels [:style :color]])
frame st)))
start (when path (colour path))
paths (when (and eraser? (or all? path))
(when-let [{:keys [sid]} (nest/inside document st open within f)]
(into #{}
(keep (fn [[id n]]
(let [q (conj within id) c (when (= :poly (:kind n)) (colour q))]
(when (and (some? c) (not (symbol/knockout? c)) (or all? (= c start)))
q))))
(get-in document [:symbols sid :nodes]))))
m (outline/stamp! (outline/mask (:w ctx) (:h ctx)) p p size)
s (cond
;; The brush's target is the creation target, which the player
;; reads for itself.
(not eraser?) {:mask m :slot tone :knock (when (= :clear tone) -1)}
(seq paths) {:mask m :paths paths})]
(if s
(do (reset! painting (assoc s :last p :size size :version 0))
(player/stroke! (assoc s :version 0)))
(rf/dispatch [::ui/refuse "nothing to erase there — ⌥ erases every colour"]))))
(defn- stroke-move! [p]
(when-let [{:keys [mask last size]} @painting]
(outline/stamp! mask last p size)
;; The version says the mask changed under the same object, so the player
;; traces it again — once a frame at most, however fast the pointer moves.
(player/stroke! (swap! painting #(-> % (assoc :last p) (update :version inc))))))
(defn- stroke-end! []
(when-let [{:keys [mask paths]} @painting]
(reset! painting nil)
;; Synchronously, so the shapes are in the document before the preview of
;; them goes: otherwise the stroke blinks out for a frame in between.
(rf/dispatch-sync [::ui/stroke {:pieces (outline/pieces mask) :paths paths}])
(player/stroke! nil)))
(defn- cursor
"The brush's footprint under the pointer, the size it paints."
[tool]
(let [size @(rf/subscribe [::sub/brush])]
(when-let [[x y] @pointer]
[:circle {:class (str "footprint " (name tool)) :cx x :cy y :r (/ size 2)}])))
(defn- outline-path
"Ring `pts` as an SVG path, without its bridges: an edge the ring runs along
both ways is where a hole is joined to the outside (see `domain/outline`),
which the fill never draws and the outline should not either."
[pts]
(let [ps (pairs pts) n (count ps)
edges (map (fn [i] [(ps i) (ps (mod (inc i) n))]) (range n))
there (set edges)]
(apply str (for [[a b] edges :when (not (contains? there [b a]))]
(str "M" (first a) "," (second a) "L" (first b) "," (second b))))))
(defn- points
"The pen on the selected shape: its points to drag, ⌥-click to delete, and a
marker where a click on an edge would add one."
[ctx draft]
(let [[sid id geom active editable? frame matrix] (editing)
pts (when geom (through matrix (channel/value-at geom frame (:store (loaded ctx)))))
edge (when (and editable? (empty? draft) (not (channel/nothing? pts)) @pointer)
(on-edge pts @pointer))]
(when (and pts (not (channel/nothing? pts)))
[:g.points
[:path.outline {:d (outline-path pts)}]
(when-let [[i t] edge]
(let [[ax ay] (nth (pairs pts) i) [bx by] (nth (pairs pts) (mod (inc i) (quot (count pts) 2)))]
[:circle.insert {:cx (+ ax (* t (- bx ax))) :cy (+ ay (* t (- by ay))) :r 1.6}]))
(when-let [inv (when editable? (node/invert matrix))]
(doall
(for [[i [x y]] (map-indexed vector (pairs pts))]
^{:key i}
[:circle.vertex {:cx x :cy y :r 1.8
:on-pointer-down
(fn [^js event]
(.stopPropagation event)
(.preventDefault event)
(if (.-altKey event)
(rf/dispatch [::ui/delete-vertex sid id i])
(do (.setPointerCapture (.-currentTarget event) (.-pointerId event))
(reset! dragging [sid id active i inv]))))}])))])))
(defn- draft-lines
"The pen's draft as hairlines — the fill is in the picture — with the segment
to the pointer, and a ring on the first point when a click there closes it."
[draft hover]
(when (seq draft)
(let [[fx fy] draft]
[:g.draft
[:polyline {:points (points-text (cond-> draft hover (into hover)))}]
[:circle {:class (str "first" (when (and hover (closes? draft hover)) " closing"))
:cx fx :cy fy :r 1.8}]])))
(defn- overlay [w h zoom opacity]
(let [tool @(rf/subscribe [::sub/tool]) (let [tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft]) draft @(rf/subscribe [::sub/draft])
drawing? (= :polygon tool) hover @(rf/subscribe [::sub/hover])
tone @(rf/subscribe [::sub/tone])
size @(rf/subscribe [::sub/brush])
[_ _ _ selected] @(rf/subscribe [::sub/selection]) [_ _ _ selected] @(rf/subscribe [::sub/selection])
selections @(rf/subscribe [::sub/selections]) selections @(rf/subscribe [::sub/selections])
placements @(rf/subscribe [::sub/selected-placements]) placements @(rf/subscribe [::sub/selected-placements])
@ -359,68 +517,107 @@
;; edit's coordinate is the document's. ;; edit's coordinate is the document's.
:open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::render/open-frame]) :open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::render/open-frame])
:w w :h h} :w w :h h}
points? @(rf/subscribe [::sub/points]) pen? (= :pen tool)
[sid id geom active editable? frame matrix] (when points? (editing)) ;; The shape the pen is on, read while rendering: a click handler is
pts (when geom (through matrix (channel/value-at geom frame ;; not a reactive context to subscribe from.
(:store (store/entry clip-id))))) [esid eid egeom _ editable? eframe matrix] (editing)
selected-pts (when (and egeom matrix)
(let [pts (channel/value-at egeom eframe (:store (loaded ctx)))]
(when-not (channel/nothing? pts)
(through matrix pts))))
paints? (#{:brush :eraser} tool)
mark @marquee] mark @marquee]
[:svg {:class (str "paint-overlay" (when drawing? " drawing")) [:svg {:class (str "paint-overlay tool-" (name tool)
:width (* zoom w) :height (* zoom h) (when (and pen? hover (closes? draft hover)) " closing"))
:view-box (str "0 0 " w " " h) :width (* zoom 3 w) :height (* zoom 3 h)
:view-box (str (- w) " " (- h) " " (* 3 w) " " (* 3 h))
:tab-index -1 :tab-index -1
:on-pointer-down (fn [^js event] :on-pointer-down
(if drawing? (fn [^js event]
(let [[x y] (stage-point event w h)]
(rf/dispatch [::ui/add-draft-point x y]))
(let [svg (.-currentTarget event) (let [svg (.-currentTarget event)
p (xy svg event w h) p (xy svg event w h)]
path (pick/choose selected (player/at p)
(or (.-metaKey event) (.-ctrlKey event)))]
(.focus svg) (.focus svg)
(case tool
:pen
(let [q (snapped draft (stage-point event w h) event)
pts (when (and egeom editable? (empty? draft))
(through matrix (channel/value-at egeom eframe (:store (loaded ctx)))))
edge (when (and pts (not (channel/nothing? pts))) (on-edge pts p))]
(cond (cond
(and (.-shiftKey event) path) (closes? draft q) (rf/dispatch [::ui/finish-polygon])
edge (rf/dispatch [::ui/insert-vertex esid eid (first edge) (second edge)])
:else (rf/dispatch [::ui/add-draft-point (first q) (second q)])))
(:brush :eraser)
(do (.setPointerCapture svg (.-pointerId event))
(stroke-begin! ctx tool p size tone event))
(let [path (pick/choose selected (player/at p) (.-altKey event))]
(when (and path (not (.-shiftKey event)))
(reset! selection-anchor {:clip-id clip-id :open (:open ctx) :path path}))
(cond
(and (or (.-metaKey event) (.-ctrlKey event)) path)
(when-let [address (address-for ctx path)] (when-let [address (address-for ctx path)]
(rf/dispatch [::ui/toggle-selection address])) (rf/dispatch [::ui/toggle-selection address]))
(and (.-shiftKey event) path)
(when-let [address (address-for ctx path)]
(let [document (:clip (loaded ctx))
expanded @(rf/subscribe [::sub/expanded])
xs (vec (keep :select (timeline/rows document (:open ctx) expanded selected)))
origin (if (and (= clip-id (:clip-id @selection-anchor))
(= (:open ctx) (:open @selection-anchor)))
(:path @selection-anchor) selected)
anchor (when origin (address-for ctx origin))
a (.indexOf xs anchor) b (.indexOf xs address)]
(rf/dispatch (if (and (<= 0 a) (<= 0 b))
[::ui/select-many (subvec xs (min a b) (inc (max a b)))]
[::ui/select address]))))
path path
(when-not (contains? selected-paths path) (select! ctx path)) (when-not (contains? selected-paths path) (select! ctx path))
:else :else
(do (.setPointerCapture svg (.-pointerId event)) (do (.setPointerCapture svg (.-pointerId event))
(reset! marquee {:p0 p :p p :more? (.-shiftKey event)}))) (reset! marquee {:p0 p :p p :more? (or (.-metaKey event) (.-ctrlKey event) (.-shiftKey event))})))
(when (and path (not (.-shiftKey event))) (when (and path (not (or (.-shiftKey event) (.-metaKey event) (.-ctrlKey event))))
(.setPointerCapture svg (.-pointerId event)) (.setPointerCapture svg (.-pointerId event))
(if (and (> (count placements) 1) (contains? selected-paths path)) (if (and (> (count placements) 1) (contains? selected-paths path))
(begin-many! ctx :move placements p) (begin-many! ctx :move placements p)
(begin! ctx :move path p)))))) (begin! ctx :move path p)))))))
:on-double-click (fn [^js event] :on-double-click (fn [^js event]
(when-not drawing? (when (= :select tool)
(let [p (xy (.-currentTarget event) event w h) (let [p (xy (.-currentTarget event) event w h)
hit (player/at p) hit (player/at p)
path (pick/deeper selected hit)] path (pick/deeper selected hit)]
(cond (cond
(not= path selected) (select! ctx path) (not= path selected) (select! ctx path)
(= hit selected) (rf/dispatch [::ui/points true]))))) ;; Into the shape: the pen, on its points.
(= hit selected) (rf/dispatch [::ui/set-tool :pen])))))
:on-key-down (fn [^js event] :on-key-down (fn [^js event]
;; Out a level, as Figma's Esc: the instance that ;; Out a level, as Figma's Esc: the instance that
;; holds what is selected, then nothing. ;; holds what is selected, then nothing.
(when (and (= "Escape" (.-key event)) selected (not drawing?)) (when (and (= "Escape" (.-key event)) selected (= :select tool))
(if points? (select! ctx (pop selected))))
(rf/dispatch [::ui/points false]) :on-pointer-leave (fn [_] (reset! pointer nil))
(select! ctx (pop selected))))) :on-pointer-move
:on-pointer-move (fn [event] (fn [^js event]
;; Back through the inverse of what the handle was
;; drawn through, into the shape's own coordinates.
(if-let [[sid node key-frame vertex inv] @dragging]
(rf/dispatch [::paint-events/set-vertex
sid node key-frame vertex
(through inv (stage-point event w h))])
(let [p (xy (.-currentTarget event) event w h)] (let [p (xy (.-currentTarget event) event w h)]
(if @marquee (reset! pointer p)
(swap! marquee assoc :p p) (cond
(when @gesture (drag! p event)))))) ;; Back through the inverse of what the handle was drawn
;; through, into the shape's own coordinates.
@dragging (let [[sid node key-frame vertex inv] @dragging]
(rf/dispatch [::paint-events/set-vertex sid node key-frame vertex
(through inv (stage-point event w h))]))
@painting (stroke-move! p)
(and pen? (seq draft)) (let [q (snapped draft (stage-point event w h) event)]
(when (not= q hover) (rf/dispatch [::ui/hover q])))
@marquee (swap! marquee assoc :p p)
@gesture (drag! p event))))
:on-pointer-up (fn [_] :on-pointer-up (fn [_]
(reset! dragging nil) (reset! dragging nil)
(stroke-end!)
(if-let [{:keys [p0 p more?]} @marquee] (if-let [{:keys [p0 p more?]} @marquee]
(let [depth (or (some-> selected count) 1) (let [depth (or (some-> selected count) 1)
paths (player/in-rect [(first p0) (second p0) paths (player/in-rect [(first p0) (second p0)
@ -431,11 +628,13 @@
(rf/dispatch [::ui/select-many (into old addresses)])) (rf/dispatch [::ui/select-many (into old addresses)]))
(let-go! true))) (let-go! true)))
:on-pointer-cancel (fn [_] :on-pointer-cancel (fn [_]
(reset! dragging nil) (reset! marquee nil) (let-go! false))} (reset! dragging nil) (reset! marquee nil)
(reset! painting nil) (player/stroke! nil)
(let-go! false))}
[ghost] [ghost]
(when (seq draft) (when (seq selected-pts)
[:polyline {:points (points-text draft) :fill "none" [:polygon.selected-paint-outline
:stroke "#d0ba86" :stroke-width 1}]) {:points (points-text selected-pts) :pointer-events "none"}])
(when mark (when mark
(let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]] (let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]]
[:rect.marquee {:x (min x0 x1) :y (min y0 y1) [:rect.marquee {:x (min x0 x1) :y (min y0 y1)
@ -444,26 +643,103 @@
;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land" ;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land"
;; is the question the outline exists to answer, and the moment it is being ;; is the question the outline exists to answer, and the moment it is being
;; asked is mid-draft. ;; asked is mid-draft.
(when-not points? [creation-box]) [creation-box]
(when-not (or drawing? points?) (when (= :select tool)
(if (> (count placements) 1) [group-handles ctx placements] [handles ctx])) (if (> (count placements) 1) [group-handles ctx placements] [handles ctx]))
(when (and id pts (not drawing?) (not (channel/nothing? pts))) (when pen? [points ctx draft])
[:g (when pen? [draft-lines draft hover])
[:polygon {:points (points-text pts) :fill "none" (when paints? [cursor tool])]))
:stroke "#e6ca8b" :stroke-width 1}]
(when-let [inv (when editable? (node/invert matrix))] (defonce space-held? (atom false))
(doall (defonce pan (atom nil))
(for [[i [x y]] (map-indexed vector (pairs pts))] (defn- stage-key-target? [target]
^{:key i} (and (.closest target ".stage-area")
[:circle.vertex {:cx x :cy y :r 2.6 :fill "#fff1be" (not (.closest target "input, textarea, select, button, a, summary, [role='button']"))
:stroke "#161820" :stroke-width 0.7 (not (.-isContentEditable target))))
:on-pointer-down
(fn [event] (defonce navigation-keys
(.stopPropagation event) (when (exists? js/window)
(.preventDefault event) (.addEventListener js/window "keydown"
(.setPointerCapture (.-currentTarget event) (fn [e]
(.-pointerId event)) (when (and (= "Space" (.-code e))
(reset! dragging [sid id active i inv]))}])))])])) (not (or (.-ctrlKey e) (.-metaKey e) (.-altKey e)))
(stage-key-target? (.-target e)))
(.preventDefault e)
(reset! space-held? true))))
(.addEventListener js/window "keyup" #(when (= "Space" (.-code %)) (reset! space-held? false)))
(.addEventListener js/window "blur" #(do (reset! space-held? false) (reset! pan nil)))))
(defonce pinch-start-zoom (atom nil))
(defonce pending-zoom (atom nil))
(defn- zoom-at! [el client-x client-y scale]
(let [wrap (.querySelector el ".stage-wrap")
next (max 0.1 (min 16 scale))
pending @pending-zoom]
;; Retain the anchor from the layout before this batch of events. React
;; may not have committed the new dimensions until the animation frame.
(when-not pending
(let [z @(rf/subscribe [::layout/zoom :stage])
box (.getBoundingClientRect wrap)]
(reset! pending-zoom {:x (/ (- client-x (.-left box)) z)
:y (/ (- client-y (.-top box)) z)})))
(swap! pending-zoom assoc :scale next :client-x client-x :client-y client-y)
(rf/dispatch-sync [::layout/set :stage next])
(when-not pending
(js/requestAnimationFrame
(fn []
(r/flush)
(let [{:keys [x y scale client-x client-y]} @pending-zoom
box (.getBoundingClientRect wrap)]
(reset! pending-zoom nil)
(set! (.-scrollLeft el) (+ (.-scrollLeft el) (- (+ (.-left box) (* x scale)) client-x)))
(set! (.-scrollTop el) (+ (.-scrollTop el) (- (+ (.-top box) (* y scale)) client-y)))))))))
(defn- navigation []
{:title "Two-finger scroll to pan · Pinch or ⌘/Ctrl-wheel to zoom · Space-drag or middle-drag to pan"
:ref (fn [el]
(when el
(set! (.-onwheel el)
(fn [e]
(.preventDefault e)
;; Chromium and Firefox deliver trackpad pinch as Ctrl-wheel.
;; Ordinary scrolling pans without guessing the input device.
(when-not @pinch-start-zoom
(let [unit (case (.-deltaMode e) 1 16 2 (.-clientHeight el) 1)
dx (* unit (.-deltaX e)) dy (* unit (.-deltaY e))]
(if (or (.-ctrlKey e) (.-metaKey e))
(zoom-at! el (.-clientX e) (.-clientY e)
(* @(rf/subscribe [::layout/zoom :stage])
(js/Math.exp (* (if (.-ctrlKey e) -0.01 -0.002) dy))))
(do
(set! (.-scrollLeft el) (+ (.-scrollLeft el) dx))
(set! (.-scrollTop el) (+ (.-scrollTop el) dy))))))))
;; Safari exposes pinch as GestureEvents, with cumulative scale.
(set! (.-ongesturestart el)
(fn [e]
(.preventDefault e)
(reset! pinch-start-zoom @(rf/subscribe [::layout/zoom :stage]))))
(set! (.-ongesturechange el)
(fn [e]
(.preventDefault e)
(when-let [z @pinch-start-zoom]
(zoom-at! el (.-clientX e) (.-clientY e) (* z (.-scale e))))))
(set! (.-ongestureend el)
(fn [e] (.preventDefault e) (reset! pinch-start-zoom nil))))
nil)
:on-pointer-down-capture
(fn [e] (when (or (= 1 (.-button e)) (and (= 0 (.-button e)) @space-held?))
(.preventDefault e) (.stopPropagation e)
(let [el (.-currentTarget e)]
(reset! pan [(.-clientX e) (.-clientY e) (.-scrollLeft el) (.-scrollTop el)])
(.setPointerCapture el (.-pointerId e)))))
:on-pointer-move-capture
(fn [e] (when-let [[x y sx sy] @pan]
(.stopPropagation e)
(set! (.-scrollLeft (.-currentTarget e)) (+ sx (- x (.-clientX e))))
(set! (.-scrollTop (.-currentTarget e)) (+ sy (- y (.-clientY e))))))
:on-pointer-up-capture (fn [e] (when @pan (.stopPropagation e) (reset! pan nil)))
:on-pointer-cancel-capture (fn [_] (reset! pan nil))})
(defn view [] (defn view []
;; Reactive on the clip's dimensions, so selecting a clip of another size ;; Reactive on the clip's dimensions, so selecting a clip of another size
@ -478,15 +754,18 @@
destination @(rf/subscribe [::sub/creation-target]) destination @(rf/subscribe [::sub/creation-target])
destination-name (when-let [sid (:sid destination)] destination-name (when-let [sid (:sid destination)]
(clip/symbol-name clip sid)) (clip/symbol-name clip sid))
zoom @(rf/subscribe [::layout/zoom :stage])] zoom @(rf/subscribe [::layout/zoom :stage])
{:keys [opacity]} @(rf/subscribe [::layout/mat])]
[:div.stage-area [:div.stage-area
(navigation)
[:div.stage-wrap [:div.stage-wrap
;; A drop on the stage lands at the PLAYHEAD, where the pointer is in space; ;; A drop on the stage lands at the PLAYHEAD, where the pointer is in space;
;; a drop on the timeline lands where the pointer is in time. ;; a drop on the timeline lands where the pointer is in time.
;; `dragenter` is cancelled as well as `dragover`: a drop target has to ;; `dragenter` is cancelled as well as `dragover`: a drop target has to
;; accept on BOTH, and the element under the pointer changes whenever the ;; accept on BOTH, and the element under the pointer changes whenever the
;; preview re-renders beneath it, which fires a fresh `dragenter`. ;; preview re-renders beneath it, which fires a fresh `dragenter`.
{:on-drag-enter (fn [^js event] (when (drag/accepts?) (.preventDefault event))) {:data-width w :data-height h
:on-drag-enter (fn [^js event] (when (drag/accepts?) (.preventDefault event)))
:on-drag-over (fn [^js event] :on-drag-over (fn [^js event]
(when (drag/accepts?) (when (drag/accepts?)
(.preventDefault event) (.preventDefault event)
@ -501,8 +780,14 @@
:width w :height h :width w :height h
:style {:width (str (* zoom w) "px") :style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}] :height (str (* zoom h) "px")}}]
[:canvas.underlay {:ref #(underlay/set-canvas! %) [:canvas.onion-skin {:ref #(player/set-onion-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}]
[:canvas.tracing {:ref #(tracing/set-canvas! %)
:width (* zoom w) :height (* zoom h)}] :width (* zoom w) :height (* zoom h)}]
[overlay w h zoom]] [:div.stage-shade {:style {:box-shadow (str "0 0 0 100vmax rgba(0,0,0," opacity ")")}}]
[:div.stage-overlay-wrap [overlay w h zoom opacity]]]
(when destination-name (when destination-name
[:div.stage-target "creating in " [:strong destination-name]])])) [:div.stage-target "creating in " [:strong destination-name]])
[tools/adjust-last]]))

View file

@ -22,11 +22,12 @@
happen and not where they happen again." happen and not where they happen again."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.keyframes :as keyframes]
[arthur.domain.clipboard :as clipboard]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.span :as span] [arthur.domain.span :as span]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.events.ui :as ui] [arthur.events.ui :as ui]
[arthur.footage.store :as store] [arthur.footage.store :as store]
@ -83,7 +84,12 @@
[clip id n] [clip id n]
(clip/node-label clip id n)) (clip/node-label clip id n))
(defn- channel-rows [n path depth ->open span] (defn- key-items [n sid ->open]
(vec (for [[channel ch] (node/channels n) f (keyed-frames ch)]
{:sid sid :id (:id n) :channel channel :frame f
:at (->open f) :scale (- (->open 1) (->open 0))})))
(defn- channel-rows [n sid path depth ->open span]
(let [keyed (filter (comp seq :keys val) (let [keyed (filter (comp seq :keys val)
(sort-by (comp str key) (node/channels n)))] (sort-by (comp str key) (node/channels n)))]
(if (seq keyed) (if (seq keyed)
@ -95,6 +101,7 @@
:select nil :select nil
:span span :span span
:keys (mapv ->open (keyed-frames ch)) :keys (mapv ->open (keyed-frames ch))
:key-items (filterv #(= cpath (:channel %)) (key-items n sid ->open))
:dense? (boolean (:dense ch))}) :dense? (boolean (:dense ch))})
[{:path (conj path ::automation-hint) [{:path (conj path ::automation-hint)
:depth depth :depth depth
@ -143,7 +150,8 @@
(walk source path depth (comp self (time->parent source-time))) (walk source path depth (comp self (time->parent source-time)))
(mapv (fn [row] (mapv (fn [row]
(-> row (-> row
(assoc :keys [] :unmapped? true) (assoc :keys [] :key-items [] :unmapped? true)
(update :cels #(when % (mapv (fn [cel] (assoc cel :keys [] :key-items [])) %)))
(assoc :span (when (= :node (:kind row)) span)))) (assoc :span (when (= :node (:kind row)) span))))
(walk source path depth (constantly (first span))))))) (walk source path depth (constantly (first span)))))))
(portal [sid path depth self child] (portal [sid path depth self child]
@ -168,6 +176,7 @@
:expandable? true :expandable? true
:expanded? open? :expanded? open?
:span cspan :span cspan
:key-items (key-items child sid cself)
:keys (into [] (comp (mapcat keyed-frames) :keys (into [] (comp (mapcat keyed-frames)
(map cself) (map cself)
(distinct)) (distinct))
@ -176,7 +185,7 @@
(if-not open? (if-not open?
[row] [row]
(-> [row] (-> [row]
(into (channel-rows child cpath (inc depth) cself cspan)) (into (channel-rows child sid cpath (inc depth) cself cspan))
(into (inside-rows sid child cpath (inc depth) cself cspan)))))) (into (inside-rows sid child cpath (inc depth) cself cspan))))))
(walk [sid path depth ->open] (walk [sid path depth ->open]
(let [sym (get-in clip [:symbols sid]) (let [sym (get-in clip [:symbols sid])
@ -215,6 +224,7 @@
(node-label clip (:id child) child)) (node-label clip (:id child) child))
:source (node/source child) :source (node/source child)
:span (mapv ->open (node/placed-span child)) :span (mapv ->open (node/placed-span child))
:key-items (key-items child sid (comp ->open (local->parent child)))
:keys (into [] :keys (into []
(comp (mapcat keyed-frames) (comp (mapcat keyed-frames)
(map (comp ->open (local->parent child))) (map (comp ->open (local->parent child)))
@ -278,6 +288,7 @@
:expandable? true :expandable? true
:expanded? open? :expanded? open?
:span span :span span
:key-items (key-items n sid self)
:keys (into [] (comp (mapcat keyed-frames) :keys (into [] (comp (mapcat keyed-frames)
(map self) (map self)
(distinct)) (distinct))
@ -302,6 +313,7 @@
;; The clip's own keys, on the ;; The clip's own keys, on the
;; block, so a collapsed lane ;; block, so a collapsed lane
;; still says where it changes. ;; still says where it changes.
:key-items (key-items child (node/source n) (comp source-self (local->parent child)))
:keys (into [] :keys (into []
(comp (mapcat keyed-frames) (comp (mapcat keyed-frames)
(map (comp source-self (local->parent child))) (map (comp source-self (local->parent child)))
@ -313,7 +325,7 @@
(cond->> (if-not open? (cond->> (if-not open?
[row] [row]
(-> [row] (-> [row]
(into (channel-rows n rpath (inc depth) self span)) (into (channel-rows n sid rpath (inc depth) self span))
;; The one clip an expanded lane opens. ;; The one clip an expanded lane opens.
(into (when lane? (into (when lane?
(if-let [child (first (filter #(under? (conj rpath (:id %))) clips))] (if-let [child (first (filter #(under? (conj rpath (:id %))) clips))]
@ -381,12 +393,15 @@
(mapcat (mapcat
(fn [[path tracks]] (fn [[path tracks]]
(let [n (first tracks) (let [n (first tracks)
authored (get-in clip [:symbols (:owner n) :nodes (:id n)])
authored->open (comp own (local->parent n))
span (own-span (node/placed-span n)) span (own-span (node/placed-span n))
select [:node (:owner n) (:id n) path] select [:node (:owner n) (:id n) path]
open? (contains? expanded path) open? (contains? expanded path)
via (when (< 1 (count path)) (str (first path))) via (when (< 1 (count path)) (str (first path)))
row {:path path :depth 0 :label (node-label clip (:id n) n) row {:path path :depth 0 :label (node-label clip (:id n) n)
:kind :node :node-kind :audio :via via :kind :node :node-kind :audio :via via
:key-items (key-items authored (:owner n) authored->open)
:slides (if via (subvec path 0 1) path) :slides (if via (subvec path 0 1) path)
:select select :expandable? true :expanded? open? :span span :select select :expandable? true :expanded? open? :span span
:keys (mapv own (distinct (mapcat keyed-frames (vals (:channels n)))))}] :keys (mapv own (distinct (mapcat keyed-frames (vals (:channels n)))))}]
@ -397,7 +412,7 @@
:span (own-span (node/placed-span track)) :span (own-span (node/placed-span track))
:select select}) :select select})
(range) tracks))) (range) tracks)))
(when open? (channel-rows n path 1 own span))))) (when open? (channel-rows authored (:owner n) path 1 authored->open span)))))
(sort-by (comp str key) (sort-by (comp str key)
(group-by :path (group-by :path
(remove #(and lane? (= 1 (count (:path %)))) (remove #(and lane? (= 1 (count (:path %))))
@ -589,7 +604,10 @@
placement or beside another sound, and only a sound goes beside a sound." placement or beside another sound, and only a sound goes beside a sound."
[target target-kind] [target target-kind]
(when-let [from (drag/row)] (when-let [from (drag/row)]
(and (not= from (subvec target 0 (min (count from) (count target)))) (and (every? (fn [source]
(not= source (subvec target 0 (min (count source) (count target)))))
(if-let [many (seq (drag/row-selections))]
(map #(nth % 3) many) [from]))
(if (= :audio (drag/row-kind)) (if (= :audio (drag/row-kind))
(#{:audio :instance} target-kind) (#{:audio :instance} target-kind)
(not= :audio target-kind))))) (not= :audio target-kind)))))
@ -612,8 +630,8 @@
on every render after, which would fight a person scrolling away." on every render after, which would fight a person scrolling away."
(memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"})))))) (memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"}))))))
(defn- label-cell [{:keys [path depth label kind node-kind lane? select expandable? expanded? of via]} (defn- label-cell [{:keys [path depth label kind node-kind lane? span select expandable? expanded? of via]}
selection selections target-path over solo tracing renaming draft] selection selections target-path over solo tracing renaming draft choose-row!]
(let [node? (= :node kind) (let [node? (= :node kind)
selected? (contains? selections select) selected? (contains? selections select)
editing? (and lane? (= select @renaming)) editing? (and lane? (= select @renaming))
@ -641,10 +659,7 @@
;; The primary row plus playhead resolves creation. ;; The primary row plus playhead resolves creation.
:on-click (fn [^js e] :on-click (fn [^js e]
(when select (when select
(rf/dispatch [(if (.-shiftKey e) (choose-row! e select)))
::ui/toggle-selection
::ui/select)
select])))
;; An instance's row opens the symbol it places, as a tab. ;; An instance's row opens the symbol it places, as a tab.
:on-double-click (fn [^js e] :on-double-click (fn [^js e]
(when of (when of
@ -659,7 +674,8 @@
(.stopPropagation e) (.stopPropagation e)
(.setData (.-dataTransfer e) "text/plain" "row") (.setData (.-dataTransfer e) "text/plain" "row")
(set! (.. e -dataTransfer -effectAllowed) "move") (set! (.. e -dataTransfer -effectAllowed) "move")
(drag/row! path node-kind select)) (drag/row! path node-kind select
(when selected? @(rf/subscribe [::sub/selections])) (first span)))
:on-drag-end (fn [_] (reset! over nil) (drag/done!)) :on-drag-end (fn [_] (reset! over nil) (drag/done!))
:on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e))) :on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e)))
:on-drag-over (fn [^js e] :on-drag-over (fn [^js e]
@ -673,15 +689,20 @@
(.preventDefault e) (.preventDefault e)
(.stopPropagation e) (.stopPropagation e)
(let [from (when (takes? path node-kind) (drag/row)) (let [from (when (takes? path node-kind) (drag/row))
where (zone e node-kind)] where (zone e node-kind)
many (drag/row-selections)]
(reset! over nil) (reset! over nil)
(drag/done!) (drag/done!)
(when from (when from
(rf/dispatch (rf/dispatch
(cond (cond
(not= :into where) [::ui/restack from path (= :front where)] (not= :into where) (if (< 1 (count many))
(= :instance node-kind) [::ui/move-node from path] [::ui/restack-nodes many path (= :front where)]
:else [::ui/group [from path]])))))})) [::ui/restack from path (= :front where)])
(= :instance node-kind) (if (< 1 (count many))
[::ui/move-nodes many path]
[::ui/move-node from path])
:else [::ui/group (vec (distinct (concat (if (< 1 (count many)) (map #(nth % 3) many) [from]) [path])))])))))}))
[:button.tl-twist [:button.tl-twist
{:disabled (not expandable?) {:disabled (not expandable?)
;; This button lives inside a draggable row label. Do not let a tiny ;; This button lives inside a draggable row label. Do not let a tiny
@ -720,17 +741,22 @@
{:title "rename lane" {:title "rename lane"
:on-click (fn [^js e] (.stopPropagation e) (begin-rename!))} :on-click (fn [^js e] (.stopPropagation e) (begin-rename!))}
"✎"]) "✎"])
;; A face's row is where its own footage is switched on, next to solo ;; A tracing layer's row switches it on and off, next to solo because the
;; because the two are the same kind of thing: what this row shows, here, ;; two are the same kind of thing: what this row shows, here, now, and
;; now, and nothing the picture keeps. The inspector's footage section does ;; nothing the picture keeps. A face's row switches its footage — its
;; all of them at once; this is how one face out of a take is singled out. ;; plate — which is the same switch wherever the face is placed.
(when (contains? (:faces tracing) of) (when-let [layer (cond (contains? (:traces tracing) of) [(second select) (nth select 2)]
[:button {:class (str "tl-trace" (when (contains? (:on tracing) of) " on")) (contains? (:plated tracing) of) [of :plate])]
:title "show the footage this face was traced from" (let [{:keys [on? hidden]} (:state tracing)
shown? (and on? (not (contains? hidden layer)))]
[:button {:class (str "tl-trace" (when shown? " on"))
:title (if (contains? (:traces tracing) of)
"show this tracing layer · never exported"
"show the footage this face was traced from")
:on-click (fn [^js e] :on-click (fn [^js e]
(.stopPropagation e) (.stopPropagation e)
(rf/dispatch [::ui/trace-face of]))} (rf/dispatch [::ui/show-trace layer (not shown?)]))}
"T"]) "T"]))
(when (= :instance node-kind) (when (= :instance node-kind)
[:button {:class (str "tl-solo" (when (contains? solo path) " on")) [:button {:class (str "tl-solo" (when (contains? solo path) " on"))
:title "show only this on the stage (⇧ for more than one)" :title "show only this on the stage (⇧ for more than one)"
@ -745,13 +771,119 @@
(rf/dispatch [::ui/delete-selected]))} (rf/dispatch [::ui/delete-selected]))}
"×"])])) "×"])]))
(defn- paint-key-selection!
"Selection and preview are transient DOM state. Update them in one pass,
without scheduling a React render for every marker on every pointer move."
[elements {:keys [ids positions]}]
(let [widths (js/Map.)]
(.forEach elements
(fn [el]
(let [items (aget el "arthurKeys")
selected? (boolean (some ids (aget el "arthurKeyIds")))
item (first items)
moved (when selected? (get positions (aget el "arthurKeyId")))]
(.toggle (.-classList el) "selected" selected?)
(if moved
(let [row (.-parentElement el)
width (if (.has widths row) (.get widths row)
(let [w (.-width (.getBoundingClientRect row))]
(.set widths row w) w))
dx (* width (/ (- (:at moved) (:at item)) (aget el "arthurFrames")))]
(set! (.. el -style -transform) (str "translateX(" dx "px)")))
(set! (.. el -style -transform) "")))))))
(defn- key-dot [items frames chosen preview anchor key-state key-elements]
(r/with-let [gesture (atom nil) element (atom nil)]
(let [{:keys [ids]} @key-state
selected? (some ids (map keyframes/identity-of items))]
[:button.tl-key
{:type "button" :class (when selected? "selected")
:title "Drag to move · Shift-click for a range · Command/Ctrl-click to toggle · Command/Ctrl-A selects all visible keys · arrows to shift · Delete to remove"
:style {:left (at% (:at (first items)) frames)}
:ref (fn [el]
(when @element (.delete key-elements @element))
(reset! element el)
(when el
(aset el "arthurKeys" items) (aset el "arthurFrames" frames)
(aset el "arthurKeyIds" (mapv keyframes/identity-of items))
(aset el "arthurKeyId" (keyframes/identity-of (first items)))
(.add key-elements el)
(paint-key-selection! (js/Set. #js [el]) @key-state)))
:on-click #(.stopPropagation %)
:on-double-click #(.stopPropagation %)
:on-key-down
(fn [e]
(let [k (.-key e)]
(when (#{"Delete" "Backspace" "ArrowLeft" "ArrowRight" "Escape"} k)
(.preventDefault e) (.stopPropagation e)
(cond
(= k "Escape") (reset! chosen [])
(#{"Delete" "Backspace"} k)
(do (.focus (.closest (.-currentTarget e) "section.time"))
(rf/dispatch [::ui/edit-keyframes @chosen nil]) (reset! chosen []))
:else (let [df (* (if (= k "ArrowLeft") -1 1) (if (.-shiftKey e) 10 1))
xs @chosen]
(rf/dispatch [::ui/edit-keyframes xs df])
(reset! chosen (keyframes/shifted xs df)))))))
:on-pointer-down
(fn [e]
(.stopPropagation e)
(.focus (.-currentTarget e))
(let [ids (set (map keyframes/identity-of items))
selected? (some (:ids @key-state) (map keyframes/identity-of items))]
(cond
(or (.-metaKey e) (.-ctrlKey e))
(reset! chosen (if selected?
(vec (remove #(contains? ids (keyframes/identity-of %)) @chosen))
(into @chosen items)))
(and (.-shiftKey e) @anchor)
(let [buttons (vec (array-seq (.querySelectorAll (.closest (.-currentTarget e) ".tl-tracks") "button.tl-key")))
origin (some #(when (some #{(:id @anchor)} (map keyframes/identity-of (aget % "arthurKeys"))) %) buttons)
boxes (js/Map.)
box (.getBoundingClientRect (.-currentTarget e))
start (when origin (.getBoundingClientRect origin))]
(when start
(reset! chosen
(vec (distinct (mapcat #(aget % "arthurKeys")
(filter (fn [el]
(let [row (.-parentElement el)
b (if (.has boxes row) (.get boxes row)
(let [b (.getBoundingClientRect row)] (.set boxes row b) b))
x (- (+ (.-left b) (* (.-width b) (/ (+ (:at (first (aget el "arthurKeys"))) 0.5) frames))) 5.5)
y (- (+ (.-top b) (/ (.-clientHeight row) 2)) 5.5)]
(and (<= (- (min (.-left start) (.-left box)) 0.1) x (+ (max (.-left start) (.-left box)) 0.1))
(<= (- (min (.-top start) (.-top box)) 0.1) y (+ (max (.-top start) (.-top box)) 0.1))))) buttons)))))))
(not selected?) (reset! chosen items))
(when-not (.-shiftKey e)
(reset! anchor {:id (keyframes/identity-of (first items))})))
(reset! gesture {:x (.-clientX e) :items @chosen
:width (.-width (.getBoundingClientRect (.-parentElement (.-currentTarget e))))})
(try (.setPointerCapture (.-currentTarget e) (.-pointerId e)) (catch :default _ nil)))
:on-pointer-move
(fn [e]
(.stopPropagation e)
(when @gesture
(let [df (js/Math.round (* frames (/ (- (.-clientX e) (:x @gesture)) (max 1 (:width @gesture)))))]
(when (not= df (:delta @gesture))
(swap! gesture assoc :delta df)
(reset! preview {:delta df})))))
:on-pointer-up
(fn [e]
(.stopPropagation e)
(when-let [g @gesture]
(when (and (seq (:items g)) (not (zero? (or (:delta g) 0))))
(rf/dispatch-sync [::ui/edit-keyframes (:items g) (:delta g)])
(reset! chosen (keyframes/shifted (:items g) (:delta g)))))
(reset! gesture nil) (when @preview (reset! preview nil)))
:on-pointer-cancel (fn [e] (.stopPropagation e) (reset! gesture nil) (reset! preview nil))}])))
(defn- track-cell (defn- track-cell
"`sliding` is the gesture in flight: `{:row :path :kind :from :df}`, where "`sliding` is the gesture in flight: `{:row :path :kind :from :df}`, where
`:from` is the frame the press was on and `:df` how many frames the pointer has `:from` is the frame the press was on and `:df` how many frames the pointer has
moved since. What it looks like mid-drag is `[:ui :sliding]`, which the clip moved since. What it looks like mid-drag is `[:ui :sliding]`, which the clip
every row and the stage are drawn from already has in it." every row and the stage are drawn from already has in it."
[{:keys [path span keys dense? kind node-kind select slides cels lane? of unmapped? owner]} [{:keys [path span keys key-items dense? kind node-kind select slides cels lane? of unmapped? owner]}
frames sliding hint {:keys [clip store open selection selections target-path]}] frames sliding hint {:keys [clip store open selection selections target-path key-selection key-preview key-anchor key-state key-elements choose-row!]}]
(let [selected-set (set selections) (let [selected-set (set selections)
active-row (:row @sliding) active-row (:row @sliding)
slide (fn [^js e] slide (fn [^js e]
@ -789,10 +921,14 @@
;; on it, and on this rare a path an uncached sub ;; on it, and on this rare a path an uncached sub
;; costs nothing. ;; costs nothing.
why (when (and under (not= (:select under) (:selection drag))) why (when (and under (not= (:select under) (:selection drag)))
(if (seq (:paths @sliding))
(:refused (clipboard/move-many clip store open selections
(nth (:select under) 3)
@(rf/subscribe [::render/open-frame]) 0))
(nest/move-refusal clip store open (nest/move-refusal clip store open
(nth (:selection drag) 3) (nth (:selection drag) 3)
(nth (:select under) 3) (nth (:select under) 3)
@(rf/subscribe [::render/open-frame]))) @(rf/subscribe [::render/open-frame]))))
nest (when (and under (nil? why) nest (when (and under (nil? why)
(not= (:select under) (:selection drag))) (not= (:select under) (:selection drag)))
under) under)
@ -849,11 +985,11 @@
(swap! sliding assoc :df df) (swap! sliding assoc :df df)
(rf/dispatch [::ui/sliding (:path @sliding) df (rf/dispatch [::ui/sliding (:path @sliding) df
(:kind @sliding) (:ripple? @sliding) (:kind @sliding) (:ripple? @sliding)
(:other @sliding) owner])))))))) (:other @sliding) owner (:paths @sliding)]))))))))
done (fn [commit?] done (fn [commit?]
(when @sliding (when @sliding
(let [{:keys [path df kind ripple? other target-lane target-frame (let [{:keys [path df kind ripple? other target-lane target-frame
drag nest on-click more?]} @sliding] drag nest on-click more? range? paths]} @sliding]
(reset! sliding nil) (reset! sliding nil)
(when hint (reset! hint nil)) (when hint (reset! hint nil))
(cond (cond
@ -861,25 +997,30 @@
(do (rf/dispatch [::ui/sliding nil]) (do (rf/dispatch [::ui/sliding nil])
;; `nest/move-node`, which is what keeps the world ;; `nest/move-node`, which is what keeps the world
;; transform and the root timing across the move. ;; transform and the root timing across the move.
(rf/dispatch [::ui/move-node (nth (:selection drag) 3) (rf/dispatch (if (seq paths)
(nth (:select nest) 3)])) [::ui/move-nodes selections (nth (:select nest) 3)]
[::ui/move-node (nth (:selection drag) 3)
(nth (:select nest) 3)])))
(and commit? target-lane drag) (and commit? target-lane drag)
(do (rf/dispatch [::ui/sliding nil]) (do (rf/dispatch [::ui/sliding nil])
(rf/dispatch [::ui/drop-clip (:selection drag) (rf/dispatch (if (seq paths)
target-lane target-frame])) [::ui/move-nodes selections (nth target-lane 3)
target-frame (- target-frame (:in drag))]
[::ui/drop-clip (:selection drag)
target-lane target-frame])))
commit? commit?
;; A press that moved nothing is a click, and a drag ;; A press that moved nothing is a click, and a drag
;; that only moved in time leaves what it moved ;; that only moved in time leaves what it moved
;; selected. The two structural cases above select what ;; selected. The two structural cases above select what
;; they landed, so neither needs this. ;; they landed, so neither needs this.
(do (when on-click (do (when (and on-click (or (zero? df) (not (seq paths))))
(rf/dispatch [(if more? ::ui/toggle-selection ::ui/select) (choose-row! #js {:metaKey more? :shiftKey range?} on-click))
on-click])) (rf/dispatch [::ui/slide path df kind ripple? other owner paths]))
(rf/dispatch [::ui/slide path df kind ripple? other owner]))
:else (rf/dispatch [::ui/sliding nil]))))) :else (rf/dispatch [::ui/sliding nil])))))
begin! (fn [^js e actual-path gesture-kind actual-select other drag] begin! (fn [^js e actual-path gesture-kind actual-select other drag]
(let [track (.closest (.-currentTarget e) ".tl-track")] (let [track (.closest (.-currentTarget e) ".tl-track")]
(.stopPropagation e) (.stopPropagation e)
(.focus track)
;; SELECTING WAITS FOR THE RELEASE. Selecting on the press ;; SELECTING WAITS FOR THE RELEASE. Selecting on the press
;; changed what the timeline was showing before the gesture ;; changed what the timeline was showing before the gesture
;; had said anything: an expanded lane follows the ;; had said anything: an expanded lane follows the
@ -889,8 +1030,13 @@
;; gesture; what it meant is known on release. ;; gesture; what it meant is known on release.
(reset! sliding {:row path :path actual-path :kind gesture-kind (reset! sliding {:row path :path actual-path :kind gesture-kind
:other other :other other
:paths (when (and (= :slide gesture-kind) (not owner)
(contains? selected-set actual-select)
(< 1 (count selections)))
(mapv #(nth % 3) (filter #(= :node (first %)) selections)))
:on-click actual-select :on-click actual-select
:more? (.-shiftKey e) :more? (or (.-metaKey e) (.-ctrlKey e))
:range? (.-shiftKey e)
:drag (when drag :drag (when drag
(assoc drag (assoc drag
:grab (- (frame-under e frames track) :grab (- (frame-under e frames track)
@ -908,7 +1054,18 @@
;; The track, not the bar, holds the pointer while a bar slides, so the drag ;; 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. ;; goes on when the bar has slid off the ruler and is no longer drawn.
{:class (str (when lane? "lane") (when (= :palette kind) " palette") {:class (str (when lane? "lane") (when (= :palette kind) " palette")
(when (= :channel kind) " automation")
(when (= path target-path) " target")) (when (= path target-path) " target"))
:tab-index 0
:on-key-down (fn [e]
(when (and (empty? @key-selection) (= (.-target e) (.-currentTarget e))
(#{"ArrowLeft" "ArrowRight"} (.-key e)))
(.preventDefault e) (.stopPropagation e)
(let [paths (mapv #(nth % 3) (filter #(= :node (first %)) selections))
df (* (if (= "ArrowLeft" (.-key e)) -1 1)
(if (.-shiftKey e) 10 1))]
(when (seq paths)
(rf/dispatch [::ui/slide (first paths) df :slide false nil nil paths])))))
:on-pointer-move slide :on-pointer-move slide
:on-pointer-up (fn [e] (slide e) (done true)) :on-pointer-up (fn [e] (slide e) (done true))
:on-pointer-cancel (fn [_] (done false)) :on-pointer-cancel (fn [_] (done false))
@ -951,9 +1108,13 @@
(do (.preventDefault e) (do (.preventDefault e)
(.stopPropagation e) (.stopPropagation e)
(if-let [from (drag/row-selection)] (if-let [from (drag/row-selection)]
(do (drag/done!) (let [many (drag/row-selections)
(rf/dispatch [::ui/drop-clip from select in (drag/row-in)
(frame-at e frames)])) at (frame-at e frames)]
(drag/done!)
(rf/dispatch (if (and (< 1 (count many)) (number? in))
[::ui/move-nodes many (nth select 3) at (- at in)]
[::ui/drop-clip from select at])))
(drag/land! (frame-at e frames) nil select)))))} (drag/land! (frame-at e frames) nil select)))))}
;; Clipped to the ruler: an instance longer than the room left in its ;; Clipped to the ruler: an instance longer than the room left in its
;; symbol still plays its own frames from 0, it is just cut off at the end. ;; symbol still plays its own frames from 0, it is just cut off at the end.
@ -965,6 +1126,7 @@
;; mapping to edit through, so the bar selects and does not slide. ;; mapping to edit through, so the bar selects and does not slide.
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
(when (= :audio node-kind) " sound") (when (= :audio node-kind) " sound")
(when (= :trace (get-in clip [:symbols of :type])) " trace")
(when unmapped? " unmapped") (when unmapped? " unmapped")
(when (and select (not unmapped?)) " movable") (when (and select (not unmapped?)) " movable")
(when (and select (contains? selected-set select)) " on") (when (and select (contains? selected-set select)) " on")
@ -976,10 +1138,7 @@
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")} :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
:on-click (when (and select unmapped?) :on-click (when (and select unmapped?)
(fn [^js e] (.stopPropagation e) (fn [^js e] (.stopPropagation e)
(rf/dispatch [(if (.-shiftKey e) (choose-row! e select)))
::ui/toggle-selection
::ui/select)
select])))
:on-pointer-down :on-pointer-down
(when (and select (not unmapped?)) (when (and select (not unmapped?))
#(begin! % (or slides path) :slide select nil nil))} #(begin! % (or slides path) :slide select nil nil))}
@ -1015,6 +1174,9 @@
;; unexplained. It wears the pick colour rather than the accent every ;; unexplained. It wears the pick colour rather than the accent every
;; span and drop already uses — see `--pick` in app.css. ;; span and drop already uses — see `--pick` in app.css.
:class (str (when ghost? "ghost") :class (str (when ghost? "ghost")
;; A reference, not the picture: drawn so it cannot be
;; mistaken for a drawing that will be exported.
(when (= :trace (get-in clip [:symbols source :type])) " trace")
(when (and select (contains? selected-set select)) " on") (when (and select (contains? selected-set select)) " on")
(when (and select (= select selection)) " primary") (when (and select (= select selection)) " primary")
(when (= (nth select 3 nil) target-path) " target") (when (= (nth select 3 nil) target-path) " target")
@ -1074,11 +1236,15 @@
;; The lane's own keys, and those of the clips on it drawn after the ;; 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 ;; blocks so they land ON the block they belong to: a collapsed lane still
;; says where the thing in it changes, without opening anything. ;; says where the thing in it changes, without opening anything.
(when-not dense? (when (or (not dense?) (seq key-items) (some (comp seq :key-items) cels))
(doall (doall
(for [f (distinct (concat keys (mapcat :keys cels))) (let [by-frame (group-by :at (concat key-items (mapcat :key-items cels)))]
(for [[index f] (map-indexed vector (sort (distinct (concat keys (mapcat :keys cels)))))
:when (and (<= 0 f) (< f frames))] :when (and (<= 0 f) (< f frames))]
^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])) ^{:key index}
(if-let [items (and (= :channel kind) (seq (get by-frame f)))]
[key-dot (vec items) frames key-selection key-preview key-anchor key-state key-elements]
[:div.tl-key {:aria-hidden true :style {:left (at% f frames)}}])))))]))
(defn- cursor-hint (defn- cursor-hint
"What the drag in flight would do, beside the pointer. "What the drag in flight would do, beside the pointer.
@ -1105,6 +1271,14 @@
[tag frames] [tag frames]
[tag {:style {:left (at% @(rf/subscribe [::render/open-frame]) frames)}}]) [tag {:style {:left (at% @(rf/subscribe [::render/open-frame]) frames)}}])
(defn- key-marquee [marquee]
(when-let [{:keys [x y x2 y2]} @marquee]
(when (and x2 y2)
[:div.tl-key-marquee {:style {:position "fixed" :pointer-events "none" :z-index 20
:left (str (min x x2) "px") :top (str (min y y2) "px")
:width (str (abs (- x2 x)) "px") :height (str (abs (- y2 y)) "px")
:border "1px solid var(--pick)" :background "color-mix(in srgb, var(--pick) 15%, transparent)"}}])))
(defn- timeline-view [] (defn- timeline-view []
(r/with-let [scrubbing (r/atom false) (r/with-let [scrubbing (r/atom false)
;; The row a carried row is over and which part of it, for the ;; The row a carried row is over and which part of it, for the
@ -1113,8 +1287,31 @@
sliding (r/atom nil) sliding (r/atom nil)
hint (r/atom nil) hint (r/atom nil)
renaming (r/atom nil) renaming (r/atom nil)
draft (r/atom "")] draft (r/atom "")
(let [clip @(rf/subscribe [::render/clip]) key-selection (atom [])
key-preview (atom nil)
key-elements (js/Set.)
key-state (atom {:ids #{} :positions nil})
selection-watch
(add-watch key-selection ::selection
(fn [_ _ _ items]
(reset! key-state {:ids (into #{} (map keyframes/identity-of) items) :positions nil})
(paint-key-selection! key-elements @key-state)))
preview-watch
(add-watch key-preview ::preview
(fn [_ _ _ preview]
(let [items @key-selection delta (or (:delta preview) 0)]
(swap! key-state assoc :positions
(when-not (zero? delta)
(into {} (map vector (map keyframes/identity-of items)
(keyframes/shifted items delta)))))
(paint-key-selection! key-elements @key-state))))
key-context (atom nil)
key-anchor (atom nil)
row-anchor (atom nil)
marquee (r/atom nil)]
(let [clip-id @(rf/subscribe [::render/clip-id])
clip @(rf/subscribe [::render/clip])
;; THE RULER IS THE OPEN SYMBOL'S OWN FRAME SPACE. Every span, key and ;; THE RULER IS THE OPEN SYMBOL'S OWN FRAME SPACE. Every span, key and
;; cut drawn here is stored in that space, so drawing them against the ;; cut drawn here is stored in that space, so drawing them against the
;; output grid put almost none of them on a mark and left every gesture ;; output grid put almost none of them on a mark and left every gesture
@ -1135,11 +1332,14 @@
drop @(rf/subscribe [::sub/drop]) drop @(rf/subscribe [::sub/drop])
solo (set @(rf/subscribe [::render/solo])) solo (set @(rf/subscribe [::render/solo]))
open @(rf/subscribe [::render/open]) open @(rf/subscribe [::render/open])
;; Which rows offer a footage switch, and which of them are switched ;; Which rows offer a tracing switch — placements of a tracing symbol,
;; on. A set rather than a lookup per row: the answer is the same for ;; and faces that have footage — and what is switched on. Sets rather
;; every placement of a face, because the switch is the face's. ;; than a lookup per row.
tracing {:faces (set (trace/traceable-faces clip open)) tracing {:traces (into #{} (comp (filter #(= :trace (:type (val %)))) (map key))
:on (set (:faces @(rf/subscribe [::render/tracing])))} (:symbols clip))
:plated (into #{} (comp (filter #(get-in (val %) [:nodes :plate])) (map key))
(:symbols clip))
:state @(rf/subscribe [::render/tracing])}
;; WHERE THE DROP WILL LAND IS WHERE THE PREVIEW GOES, and what is being ;; WHERE THE DROP WILL LAND IS WHERE THE PREVIEW GOES, and what is being
;; carried does not come into it. A row under the pointer takes the ;; carried does not come into it. A row under the pointer takes the
;; preview as a block in that row -- the same row `ui/drop-destination` ;; preview as a block in that row -- the same row `ui/drop-destination`
@ -1194,8 +1394,30 @@
;; first shows it. Several marks can share one output frame when the ;; first shows it. Several marks can share one output frame when the
;; symbol was authored on a finer grid; that is what playing it at this ;; symbol was authored on a finer grid; that is what playing it at this
;; project's rate means, and the playhead lands where it will really be. ;; project's rate means, and the playhead lands where it will really be.
seek-to (fn [^js e n] (clip/first-output-frame clip open (frame-at e n)))] seek-to (fn [^js e n] (clip/first-output-frame clip open (frame-at e n)))
choose-row! (fn [e target]
(let [xs (vec (keep :select visible))
anchor (or @row-anchor selection target)
a (.indexOf xs anchor) b (.indexOf xs target)]
(cond
(or (.-metaKey e) (.-ctrlKey e)) (rf/dispatch [::ui/toggle-selection target])
(and (.-shiftKey e) (<= 0 a) (<= 0 b))
(rf/dispatch [::ui/select-many (subvec xs (min a b) (inc (max a b)))])
:else (rf/dispatch [::ui/select target]))
(when-not (.-shiftKey e) (reset! row-anchor target))))]
(when (not= [clip-id open] @key-context)
(reset! key-context [clip-id open]) (reset! key-selection []) (reset! key-preview nil) (reset! key-anchor nil) (reset! row-anchor nil))
[:section.pane.time [:section.pane.time
{:tab-index -1
:on-key-down (fn [e]
(when (and (= (.-target e) (.-currentTarget e))
(#{"Delete" "Backspace"} (.-key e)))
(.preventDefault e) (.stopPropagation e)))
:on-pointer-down-capture (fn [e]
(when-not (or (.closest (.-target e) "button.tl-key")
(.closest (.-target e) ".tl-track")
(.-metaKey e) (.-ctrlKey e) (.-shiftKey e))
(reset! key-selection []) (reset! key-preview nil)))}
[transport] [transport]
[:div.tl-body [:div.tl-body
;; Blank timeline space means the open symbol. Child controls stop their ;; Blank timeline space means the open symbol. Child controls stop their
@ -1215,19 +1437,71 @@
:on-drop (fn [^js e] :on-drop (fn [^js e]
(.preventDefault e) (.preventDefault e)
(when-let [from (drag/row)] (when-let [from (drag/row)]
(let [many (drag/row-selections)]
(drag/done!) (drag/done!)
(reset! over nil) (reset! over nil)
(when (< 1 (count from)) (when (< 1 (count from))
(rf/dispatch [::ui/move-node from []]))))} (rf/dispatch (if (< 1 (count many)) [::ui/move-nodes many []] [::ui/move-node from []]))))))}
[:div.tl-corner] [:div.tl-corner]
(doall (for [row visible] (doall (for [row visible]
(with-meta (if (= :section (:kind row)) (with-meta (if (= :section (:kind row))
[:div.tl-label.tl-section (:label row)] [:div.tl-label.tl-section (:label row)]
[label-cell row selection selection-set target-path [label-cell row selection selection-set target-path
over solo tracing renaming draft]) over solo tracing renaming draft choose-row!])
{:key (str (:path row))})))] {:key (str (:path row))})))]
[:div.tl-tracks [:div.tl-tracks
{:on-click (fn [^js e] {:on-pointer-down-capture
(fn [e]
(when (and (= 0 (.-button e))
(.closest (.-target e) ".tl-track.automation")
(not (.closest (.-target e) "button, .movable, .unmapped, .tl-edge")))
(.stopPropagation e) (.preventDefault e)
(.focus (.-currentTarget e))
(reset! marquee {:x (.-clientX e) :y (.-clientY e)
:hits (let [container (.-currentTarget e)]
(vec (mapcat
(fn [row]
(let [b (.getBoundingClientRect row)]
(map (fn [el]
(let [items (aget el "arthurKeys")]
{:x (+ (.-left b) (* (.-width b) (/ (+ (:at (first items)) 0.5) frames)))
:y (+ (.-top b) (/ (.-height b) 2)) :items items}))
(array-seq (.querySelectorAll row "button.tl-key")))))
(array-seq (.querySelectorAll container ".tl-track")))))
:base (if (or (.-metaKey e) (.-ctrlKey e) (.-shiftKey e)) @key-selection [])})
(reset! key-selection (:base @marquee))
(try (.setPointerCapture (.-currentTarget e) (.-pointerId e)) (catch :default _ nil))))
:on-pointer-move
(fn [e]
(when-let [{:keys [x y base hits]} @marquee]
(.stopPropagation e)
(let [x2 (.-clientX e) y2 (.-clientY e)]
(swap! marquee assoc :x2 x2 :y2 y2)
(reset! key-selection
(vec (distinct (concat base
(mapcat (fn [{cx :x cy :y :keys [items]}]
(when (and (<= (min x x2) cx (max x x2))
(<= (min y y2) cy (max y y2))) items)) hits))))))))
:on-pointer-up (fn [e] (when @marquee (.stopPropagation e) (reset! marquee nil)))
:on-pointer-cancel (fn [_] (when @marquee (reset! key-selection (:base @marquee)) (reset! marquee nil)))
:tab-index 0
:on-key-down
(fn [e]
(cond
(and (or (.-metaKey e) (.-ctrlKey e)) (= "a" (.toLowerCase (.-key e))))
(do (.preventDefault e) (.stopPropagation e)
(reset! key-selection (vec (distinct (mapcat #(aget % "arthurKeys")
(array-seq (.querySelectorAll (.-currentTarget e) "button.tl-key")))))))
(and (seq @key-selection) (#{"ArrowLeft" "ArrowRight" "Delete" "Backspace" "Escape"} (.-key e)))
(do (.preventDefault e) (.stopPropagation e)
(let [k (.-key e) xs @key-selection]
(cond
(= k "Escape") (reset! key-selection [])
(#{"Delete" "Backspace"} k) (do (rf/dispatch [::ui/edit-keyframes xs nil]) (reset! key-selection []))
:else (let [df (* (if (= k "ArrowLeft") -1 1) (if (.-shiftKey e) 10 1))]
(rf/dispatch [::ui/edit-keyframes xs df])
(reset! key-selection (keyframes/shifted xs df))))))))
:on-click (fn [^js e]
(when (= (.-target e) (.-currentTarget e)) (when (= (.-target e) (.-currentTarget e))
(rf/dispatch [::ui/select nil]))) (rf/dispatch [::ui/select nil])))
:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) :on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
@ -1288,10 +1562,12 @@
[track-cell row frames sliding hint [track-cell row frames sliding hint
{:clip clip :store store :open open {:clip clip :store store :open open
:selection selection :selections selections :selection selection :selections selections
:target-path target-path}]) :target-path target-path :key-selection key-selection :key-preview key-preview
:key-anchor key-anchor :key-state key-state :key-elements key-elements :choose-row! choose-row!}])
{:key (str (:path row))}))) {:key (str (:path row))})))
[:div.tl-empty "nothing in this symbol"]) [:div.tl-empty "nothing in this symbol"])
[playhead :div.tl-playhead frames]]] [playhead :div.tl-playhead frames]
[key-marquee marquee]]]
[cursor-hint hint]]))) [cursor-hint hint]])))
(defn view [] (defn view []

View file

@ -0,0 +1,133 @@
(ns arthur.ui.tools
"The tools: a strip down the left of the stage, an options bar across the top
of it, and their keys.
PHOTOSHOP'S ARRANGEMENT, which Illustrator and Flash share: one tool at a
time, picked from a vertical strip or by its letter, and a bar above the
canvas holding that tool's options — the brush's size, the pen's point count.
The palette sits in the strip under the tools. See `events/ui` for what each
tool does to the selection."
(:require [arthur.events.ui :as ui]
[arthur.subs.ui :as sub]
[arthur.subs.render :as render]
[arthur.ui.layout :as layout]
[arthur.ui.palette :as palette]
[re-frame.core :as rf]))
(def ^:private kit
[{:tool :select :key "v" :name "Select"
:tip "click to select, drag to move · double-click a shape to edit its points"
:icon [:path {:d "M4 2 L4 14 L7 11 L9.5 16 L11.5 15 L9 10 L13 10 Z"}]}
{:tool :pen :key "p" :name "Pen"
:tip "click to place points · click the first to close · on a selected shape, click an edge to add a point and ⌥-click a point to delete it"
:icon [:<> [:path {:d "M9 1 L14 8 L11.5 13 L6.5 13 L4 8 Z"}]
[:path.cut {:d "M9 2 V8"}]
[:rect {:x 6.5 :y 14 :width 5 :height 2}]]}
{:tool :brush :key "b" :name "Brush"
:tip "paint, and each piece becomes a polygon when you let go"
:icon [:<> [:path {:d "M15 1.5 L16.5 3 L9 10.5 L7.5 9 Z"}]
[:path {:d "M6.5 10 C4 10 3 11.5 3 13.5 C3 15 1.5 16 1.5 16 C5 16 8 15 8 11.5 Z"}]]}
{:tool :eraser :key "e" :name "Eraser"
:tip "cuts the shapes of the colour you start on, in its symbol · ⌥ cuts every colour"
:icon [:<> [:path {:d "M10 2.5 L16 8.5 L10 14.5 L5.5 14.5 L2 11 Z"}]
[:path.cut {:d "M6 6.5 L12 12.5"}]]}])
(defn toolbox []
(let [tool @(rf/subscribe [::sub/tool])]
[:aside.toolbox
[:div.tools
(doall
(for [{t :tool :keys [key name tip icon]} kit]
^{:key t}
[:button {:class (str "tool" (when (= t tool) " on"))
:title (str name " (" (.toUpperCase key) ") — " tip)
:on-click #(rf/dispatch [::ui/set-tool t])}
[:svg {:view-box "0 0 18 18" :width 18 :height 18} icon]]))]
[palette/assets]
[palette/grid]]))
(defn- size-control []
(let [size @(rf/subscribe [::sub/brush])]
[:label.option {:title "[ and ]"} "size"
[:input {:type "range" :min 1 :max 64 :value size
:on-change #(rf/dispatch [::ui/brush-size (js/parseInt (.. % -target -value))])}]
[:span.value (str size "px")]]))
(defn- fit-control
"How closely a stroke's polygon follows what was painted: every point of the
painted edge within so many pixels of it. Closer is more points, and only
where the shape bends."
[fit event]
[:label.option {:title "how far the polygon may stray from what you painted — closer is more points, only where it bends"}
"fit within"
[:input {:type "range" :min 0.5 :max 8 :step 0.5 :value fit
:on-change #(rf/dispatch [event (js/parseFloat (.. % -target -value))])}]
[:span.value (str fit "px")]])
(defn options []
(let [tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])
selections @(rf/subscribe [::sub/selections])
{:keys [name tip]} (some #(when (= tool (:tool %)) %) kit)]
[:div.options-bar
[:strong.tool-name name]
(case tool
:pen (if (seq draft)
[:<>
[:span.dim (str (quot (count draft) 2) " points")]
[:button {:disabled (< (count draft) 6) :title "Enter"
:on-click #(rf/dispatch [::ui/finish-polygon])} "close"]
[:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "discard"]]
[:span.dim.hint tip])
(:brush :eraser) [:<> [size-control]
[fit-control @(rf/subscribe [::sub/fit]) ::ui/fit]
[:span.dim.hint tip]]
(if (< 1 (count selections))
[:span.dim (str (count selections) " selected")]
[:span.dim.hint tip]))
[:span.spacer]
(let [{:keys [on? opacity]} @(rf/subscribe [::render/tracing])]
[:<>
[:button {:class (when on? "on")
:title "show tracing layers over the picture · never exported"
:on-click #(rf/dispatch [::ui/tracing-on (not on?)])} "tracing"]
[:input.trace-opacity
{:type "range" :min 0 :max 1 :step 0.05 :value opacity :disabled (not on?)
:title "how strongly tracing layers draw" :style {:flex "0 0 64px"}
:on-change #(rf/dispatch [::ui/tracing-opacity (js/parseFloat (.. % -target -value))])}]])
;; The stage's zoom: a property of the view and not of the document, so it
;; sits in the view's own chrome rather than in the inspector.
[layout/zoomer :stage "the stage"]
[layout/stage-controls]]))
(defn adjust-last
"Blender's Adjust Last Operation, for a brush or eraser stroke: its fit,
changeable until something else is done."
[]
(when-let [{:keys [kind ids fit]} @(rf/subscribe [::sub/last])]
[:div.adjust-last
[:strong (if (= :eraser kind) "Erase" "Brush stroke")]
(when (and (= :brush kind) (< 1 (count ids))) [:span.dim (str (count ids) " pieces")])
[fit-control fit ::ui/adjust-last]]))
(defn- typing?
"Is a key going into a field? A slider or a checkbox has focus without
taking letters, and a tool's key still picks the tool there, as in Photoshop."
[^js target]
(or (#{"TEXTAREA" "SELECT"} (.-tagName target))
(and (= "INPUT" (.-tagName target))
(not (#{"range" "checkbox" "radio" "button" "color"} (.-type target))))
(.-isContentEditable target)))
(defn install-keys!
"V, P, B and E pick a tool. Enter closes the pen's polygon, or takes the pen
to the selected shape's points; Esc closes it too, and then leaves the pen.
[ and ] size the brush. Delete and undo are `events/history`'s."
[]
(.addEventListener
js/window "keydown"
(fn [^js e]
(when-not (or (typing? (.-target e)) (.-metaKey e) (.-ctrlKey e) (.-altKey e))
(when (contains? ui/tool-keys (.toLowerCase (.-key e)))
(.preventDefault e)
(rf/dispatch [::ui/tool-key (.toLowerCase (.-key e))]))))))

View file

@ -0,0 +1,154 @@
(ns arthur.ui.tracing
"Tracing layers — footage or a still to draw over — on their own canvas above
the stage.
A REFERENCE, NOT OUTPUT. A tracing symbol resolves to a `:trace` op, which the
raster refuses and only the stage's resolver asks for (see `clip/trace-op`), so
it cannot reach an export. It is drawn OVER the picture at one opacity rather
than under it, because the raster clears to an opaque ground. The canvas is the
stage's size on screen, not the raster's, so a 1280px still is not squeezed
through a 320px stage on its way to being seen.
The op says where the image goes and which of its frames to show, and nothing
else: a face's footage is registered to the face because it is placed inside
it, under the head, so there is nothing about faces in here.
THREE THINGS KEEP IT STEADY, because a still is decoded asynchronously and the
frame it belongs to is already on screen by the time it arrives: the cache drops
the stills used longest ago rather than emptying itself, a layer keeps showing
the still it last showed until its next one has decoded, and the stills a little
way ahead of the playhead are asked for before they are needed. Each is a
separate cause of the same symptom — the tracing blinking out for a frame or two
— and none of them covers the others: the hold is what survives a seek, the
reading ahead is what keeps playback from being a frame behind for good."
(:require [arthur.flow.ingest :as ingest]))
(defonce ^:private state (atom {:canvas nil :urls {} :images {} :order [] :last {}}))
(defn set-canvas! [el] (swap! state assoc :canvas el))
(defn- footage-urls
"The footage's still URLs, or nil until its manifest has come back."
[footage-id on-ready]
(let [u (get-in @state [:urls footage-id])]
(when (nil? u)
(swap! state assoc-in [:urls footage-id] :loading)
(-> (ingest/manifest! footage-id)
(.then (fn [m]
(swap! state assoc-in [:urls footage-id] (:urls m))
(on-ready)))
(.catch (fn [error]
(swap! state assoc-in [:urls footage-id] :failed)
(js/console.error "arthur: no stills for footage" footage-id error)))))
(when (vector? u) u)))
(defn url-of
"The URL of the still showing frame `frame` of `media`, or nil until it is
known. A footage symbol's frame 0 is the first frame of its range."
[{:keys [footage image range]} frame on-ready]
(cond
image (str "/blob/" image)
footage (some-> (footage-urls footage on-ready) (get (+ (first range) frame)))))
(def ^:private ^:const kept
"Decoded stills held at once. A 1280px still is about 5MB decoded, and
scrubbing footage with no holds asks for every frame of it."
48)
(def ^:private ^:const ahead
"Frames past the playhead whose stills are asked for while the current one is
drawn. A still cannot be decoded in the animation frame that wants it, so
playing footage would otherwise always be a frame or two behind itself."
8)
(defn- decoded
"`img` if the still has arrived and can be drawn."
[^js img]
(when (and (.-complete img) (pos? (.-naturalHeight img))) img))
(defn- touch!
"Hold `img` under `url` as the most recently used still, dropping the ones used
longest ago once there are more than `kept`.
LEAST RECENTLY USED, touched when it arrives and again on every frame it is
DRAWN, which is what makes it safe without a list of exceptions: the still on
screen is the newest thing in the cache and cannot be the one dropped — a still
held for a hundred frames included. Read-and-not-drawn does not touch, because
a still read only to be warmed was just inserted anyway."
[url img]
(swap! state
(fn [{:keys [images order] :as s}]
(let [images (assoc images url img)
order (conj (into [] (remove #{url}) order) url)
over (- (count order) kept)]
(if (pos? over)
(assoc s :images (apply dissoc images (subvec order 0 over))
:order (subvec order over))
(assoc s :images images :order order))))))
(defn- image
"The still at `url`, or nil until it has loaded. Asks for it the first time it
is wanted; `on-ready` paints again once it is there.
A still that fails is remembered as having failed, so a broken URL is one
console line and one request rather than one of each per animation frame."
[url on-ready]
(when url
(let [held (get-in @state [:images url])]
(cond
(= :failed held) nil
held (decoded held)
:else (let [img (js/Image.)]
(set! (.-onload img) on-ready)
(set! (.-onerror img)
(fn [_]
(swap! state assoc-in [:images url] :failed)
(js/console.error "arthur: a tracing still did not load" url)))
(set! (.-src img) url)
(touch! url img)
nil)))))
(defn- warm!
"Ask for the stills the next `ahead` frames of footage will want.
WHILE PLAYING ONLY, and only for a layer whose frame MOVED since it was last
painted. A scrub asks for a different `ahead` frames at every step, and a held
layer shows one still for as long as it is held, so reading ahead through
either would be requests for stills nobody is going to look at."
[{:keys [media frame]} on-ready]
(when (:footage media)
(doseq [p (range (inc frame) (+ frame 1 ahead))]
(image (url-of media p on-ready) on-ready))))
(defn paint!
"Draw trace ops `ops`, in draw order, at `opacity`, over a stage `width` wide.
`on-ready` is called when a still or a manifest that was missing arrives, to
paint again."
[ops {:keys [opacity width playing? origin]} on-ready]
(when-let [^js canvas (:canvas @state)]
(let [ctx (.getContext canvas "2d")
zoom (/ (.-width canvas) width)
was (:last @state)]
(.setTransform ctx 1 0 0 1 0 0)
(.clearRect ctx 0 0 (.-width canvas) (.-height canvas))
;; What each layer is showing, forgotten for the layers that are gone.
;; Before the draw, so switching them all off forgets all of them.
(swap! state update :last select-keys (map :node ops))
(set! (.-globalAlpha ctx) opacity)
(doseq [{:keys [node frame m] [w h] :size :as op} ops]
;; THE STILL IT HAS, not nothing. A frame whose still is still decoding
;; keeps the one before it rather than blinking off.
(let [want (url-of (:media op) frame on-ready)
[img url] (or (when-let [i (image want on-ready)] [i want])
(let [url (get-in was [node :url])]
(when-let [i (image url on-ready)] [i url])))]
(when img
(touch! url img)
(swap! state assoc-in [:last node] {:url url :frame frame})
(.setTransform ctx
(* zoom (aget m 0)) (* zoom (aget m 1))
(* zoom (aget m 2)) (* zoom (aget m 3))
(* zoom (+ (or origin 0) (aget m 4))) (* zoom (+ (or origin 0) (aget m 5))))
(.drawImage ctx img 0 0 w h))
(when (and playing? (not= frame (get-in was [node :frame])))
(warm! op on-ready)))))))

View file

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

View file

@ -0,0 +1,25 @@
(ns arthur.audio.mix-test
(:require [arthur.audio.mix :as mix]
[cljs.test :refer [deftest is]]))
(defn- buffer [samples]
(let [data (js/Float32Array. (clj->js samples))]
#js {:sampleRate 12 :length (count samples) :numberOfChannels 1
:getChannelData (fn [_] data)}))
(deftest fallback-audio-follows-the-timeline-length
(let [original (.-OfflineAudioContext js/globalThis)]
(set! (.-OfflineAudioContext js/globalThis)
(fn [_ _ _]
#js {:createBuffer (fn [_ frames _] (buffer (repeat frames 0)))}))
(try
(let [short (buffer (repeat 92 0.5))
fitted (mix/fit-buffer short (/ 5008 12))
data (.getChannelData fitted 0)]
(is (= 5008 (.-length fitted)))
(is (= 0.5 (aget data 91)))
(is (= 0 (aget data 92)))
(is (= 0 (aget data 5007)))
(is (identical? short (mix/fit-buffer short (/ 92 12))))
(is (= 20 (.-length (mix/fit-buffer short (/ 20 12))))))
(finally (set! (.-OfflineAudioContext js/globalThis) original)))))

View file

@ -474,3 +474,37 @@
(is (= 2 (ch/value-shape (ch/keyed {0 [1 2], 4 [3 4]} :linear)))) (is (= 2 (ch/value-shape (ch/keyed {0 [1 2], 4 [3 4]} :linear))))
(is (= :opaque (ch/value-shape (ch/keyed {0 :a} :hold)))) (is (= :opaque (ch/value-shape (ch/keyed {0 :a} :hold))))
(is (nil? (ch/value-shape (ch/keyed {} :hold))) "nothing to read it off")) (is (nil? (ch/value-shape (ch/keyed {} :hold))) "nothing to read it off"))
(deftest repair-borrows-current-base-and-keeps-target-corrections
(let [c (assoc (ch/keyed {0 10, 2 20, 4 40} :hold)
:repairs [{:id :repair :from 2 :through 3 :donor 0}]
:over [(ch/layer :nudge [2 4] :offset (ch/framed 5))])
cursor (ch/cursor c nil)]
(is (= [10 15 15 40 15]
(mapv #(ch/value-at c % nil) [0 2 3 4 2])))
(is (= [10 15 15 40 15]
(mapv #(ch/sample! cursor %) [0 2 3 4 2])))
(is (= 35 (ch/value-at (assoc c :keys {0 30, 2 20, 4 40}) 2 nil)))))
(deftest repair-fills-absent-base-without-recursing
(let [c (assoc (ch/keyed {0 10, 2 ch/absent, 4 40} :hold)
:repairs [{:from 2 :through 3 :donor 0}
{:from 0 :through 0 :donor 4}])]
(is (= 10 (ch/value-at c 2 nil)))
(is (= 40 (ch/value-at c 0 nil)))
(is (= 10 (ch/sample! (ch/cursor c nil) 3)))))
(deftest lid-adjustment-is-procedural-and-does-not-mutate-dense-geometry
(let [points [0 0, 2 2, 4 0, 2 -2]
c (assoc (ch/framed points)
:over [(ch/layer :lids [2 5] :eye-opening
(ch/keyed {2 1, 4 0} :linear))])
cur (ch/cursor c nil)]
(is (empty? (ch/problems c)))
(is (= points (ch/value-at c 1 nil)))
(is (= [0 0, 2 1, 4 0, 2 -1] (ch/value-at c 3 nil)))
(is (= [0 0, 2 0, 4 0, 2 0] (ch/sample! cur 4)))
(is (= [0 0, 2 1, 4 0, 2 -1] (ch/sample! cur 3)))
(is (= points (:value c)))
(is (= [0 0, 1 1, 2 0, 3 -1, 4 0]
(ch/value-at (assoc c :value [0 0, 1 2, 2 0, 3 -2, 4 0]) 3 nil)))))

View file

@ -161,3 +161,45 @@
(is (nil? (get-in made [:symbols :main :nodes :plate]))) (is (nil? (get-in made [:symbols :main :nodes :plate])))
(is (nil? (get-in made [:symbols :main :nodes :child]))) (is (nil? (get-in made [:symbols :main :nodes :child])))
(is (empty? (clip/problems made))))) (is (empty? (clip/problems made)))))
(defn- reparent-document []
(-> (fixture/document)
(update-in [:symbols :main] dissoc :display)
(assoc-in [:symbols :box] {:id :box :frames 40 :nodes {}})
(assoc-in [:symbols :main :nodes :target]
(fixture/cel :target :box 0 40 1))))
(deftest reparenting-a-forest-preserves-relative-times
(let [doc (reparent-document)
selections [(address :main :a [:a]) (address :main :b [:b])]
r (clipboard/move-many doc {} :main selections [:target] 6 0)]
(is (nil? (:refused r)))
(is (= [0 4] (mapv #(get-in r [:clip :symbols :box :nodes % :time :at]) [:a :b])))
(is (nil? (get-in r [:clip :symbols :main :nodes :a])))
(is (nil? (get-in r [:clip :symbols :main :nodes :b])))
(is (= [[:node :box :a [:target :a]] [:node :box :b [:target :b]]] (:selections r)))))
(deftest reparenting-refuses-the-entire-forest-on-a-cycle
(let [doc (reparent-document)
r (clipboard/move-many doc {} :main
[(address :main :a [:a]) (address :main :target [:target])]
[:target] 6 0)]
(is (:refused r))
(is (nil? (:clip r)))))
(deftest reparenting-into-a-lane-refuses-collision-atomically
(let [doc (-> (reparent-document)
(assoc-in [:symbols :box :display] :lane)
(assoc-in [:symbols :box :nodes :occupied] (fixture/cel :occupied :drawing-a 4 4 0)))
r (clipboard/move-many doc {} :main
[(address :main :a [:a]) (address :main :b [:b])]
[:target] 6 0)]
(is (:refused r))
(is (nil? (:clip r)))))
(deftest dropping-the-forest-shifts-it-as-a-unit
(let [r (clipboard/move-many (reparent-document) {} :main
[(address :main :a [:a]) (address :main :b [:b])]
[:target] 6 3)]
(is (nil? (:refused r)))
(is (= [3 7] (mapv #(get-in r [:clip :symbols :box :nodes % :time :at]) [:a :b])))))

View file

@ -0,0 +1,63 @@
(ns arthur.domain.cut-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.channel :as channel]
[arthur.domain.clip :as clip]
[arthur.domain.cut :as cut]
[arthur.domain.paint :as paint]
[arthur.domain.raster :as r]))
(def square [10 10 50 10 50 50 10 50])
(defn- ink [ring]
(let [b (:buf (r/fill-poly-buf! (r/make 60 60) ring (quot (count ring) 2) 1))]
(fn [x y] (aget b (+ x (* y 60))))))
(deftest a-cut-off-the-side-keeps-the-rest-with-the-cut-edge-as-its-points
(let [[left & more] (cut/cut square [[[40 0 60 0 60 60 40 60]]])]
(is (empty? more))
(is (= 1 ((ink left) 20 30)))
(is (= 0 ((ink left) 45 30)))
(is (some #{40} (take-nth 2 left)) "the cut edge is the shape's own points")))
(deftest a-cut-through-the-middle-leaves-two-pieces-biggest-first
(let [pieces (cut/cut square [[[25 0 30 0 30 60 25 60]]])]
(is (= 2 (count pieces)))
(is (= 1 ((ink (first pieces)) 40 30)) "the right side is the bigger")
(is (= 1 ((ink (second pieces)) 15 30)))))
(deftest a-cut-inside-leaves-a-hole-in-one-ring
(let [[ring & more] (cut/cut square [[[25 25 35 25 35 35 25 35]]])]
(is (empty? more))
(is (= 0 ((ink ring) 30 30)))
(is (= 1 ((ink ring) 15 30)))))
(deftest a-cut-that-misses-is-nil-and-one-that-takes-everything-is-empty
(is (nil? (cut/cut square [[[0 0 5 0 5 5 0 5]]])))
(is (= [] (cut/cut square [[[0 0 60 0 60 60 0 60]]]))))
(deftest a-ring-with-a-bridged-hole-cuts-like-the-shape-it-draws
(let [holed (first (cut/cut square [[[25 25 35 25 35 35 25 35]]]))
[ring] (cut/cut holed [[[0 0 20 0 20 60 0 60]]])]
(is (= 0 ((ink ring) 30 30)) "the hole is still a hole")
(is (= 0 ((ink ring) 15 30)))
(is (= 1 ((ink ring) 45 30)))))
(deftest erasing-keeps-the-big-piece-on-the-shape-and-makes-the-rest-new
(let [clip (-> (clip/blank) (paint/new-shape :main :s 0 square 3))
out (cut/erase clip nil :main 0 [[:s]] [[[25 0 30 0 30 60 25 60]]] [:t :u])
nodes (get-in out [:symbols :main :nodes])
pts #(channel/value-at (get-in nodes [% :channels paint/geometry]) 0 nil)]
(is (= #{:s :t} (set (keys nodes))))
(is (= 1 ((ink (pts :s)) 40 30)))
(is (= 1 ((ink (pts :t)) 15 30)))
(is (= 3 (channel/value-at (get-in nodes [:t :channels [:style :color]]) 0 nil)))
(is (= {} (get-in (cut/erase clip nil :main 0 [[:s]] [[[0 0 60 0 60 60 0 60]]] [])
[:symbols :main :nodes]))
"cut away entirely, it is gone")))
(deftest erasing-between-keys-keys-the-frame-and-leaves-the-others
(let [clip (-> (clip/blank) (paint/new-shape :main :s 0 square 3) (paint/add-key :main :s 10))
out (cut/erase clip nil :main 5 [[:s]] [[[40 0 60 0 60 60 40 60]]] [])
ks (get-in out [:symbols :main :nodes :s :channels paint/geometry :keys])]
(is (= #{0 5 10} (set (keys ks))))
(is (= square (ks 0) (ks 10)))))

View file

@ -7,6 +7,8 @@
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.pick :as pick]
[arthur.domain.raster :as raster]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
@ -480,3 +482,64 @@
(is (= [128 128 128] (is (= [128 128 128]
(nth (pal/effective-ramp context (clip/active-palette resolve)) (nth (pal/effective-ramp context (clip/active-palette resolve))
(pal/render-index context day 1)))))) (pal/render-index context day 1))))))
(deftest a-knockout-makes-a-hole-in-its-own-symbol-only
(let [sq (fn [x0 y0 x1 y1] [x0 y0 x1 y0 x1 y1 x0 y1])
document
(-> (clip/blank)
(assoc-in [:symbols :lens] {:id :lens :frames 4 :nodes {}})
(paint/new-shape :main :under 0 (sq 0 0 40 20) 4)
(paint/new-shape :lens :frame 0 (sq 0 0 40 20) 8)
(paint/new-shape :lens :glass 0 (sq 10 5 20 15) :clear)
(assoc-in [:symbols :main :nodes :glasses]
{:id :glasses :kind :instance :source {:symbol :lens} :z "zz" :span [0 4]}))
ops (vec ((clip/resolver document :main nil (pal/compile document) nil) 0))
ras (raster/draw-ops! (raster/clear! (raster/make 320 200) 0) ops)
at (fn [x y] (aget (:buf ras) (+ x (* y 320))))
colour (fn [path] (:color (first (filter #(= path (:node %)) ops))))]
(is (= [:begin :poly :poly :end]
(mapv :kind (filter #(and (vector? (:node %)) (= :glasses (first (:node %)))) ops))))
(is (= (colour :under) (at 15 10)) "the glass shows what is under the glasses")
(is (= (colour [:glasses :frame]) (at 5 10)) "and the frame is still there round it")
(is (not= (at 15 10) (at 5 10)))
(is (= [:under] (pick/hit ops [15 10])) "a click in the glass is a click on what shows")
(is (= [:glasses :frame] (pick/hit ops [5 10])))))
(deftest an-op-goes-into-the-layer-of-the-symbol-it-is-for
(let [a {:kind :poly :node :a} b {:kind :poly :node [:g :b]} c {:kind :poly :node [:g :c]}
k {:kind :mask :knock -1}]
(is (= [a {:kind :begin :node [:g]} b c k {:kind :end :node [:g]}]
(clip/in-layer [a b c] [:g] k)) "a layer is made round what it drew")
(is (= [a {:kind :begin :node [:g]} b k {:kind :end :node [:g]} c]
(clip/in-layer [a {:kind :begin :node [:g]} b {:kind :end :node [:g]} c] [:g] k))
"an existing one is used")
(is (= [{:kind :begin :node []} a b k {:kind :end :node []}]
(clip/in-layer [a b] [] k)) "the open symbol is every op")
(is (= [a] (clip/in-layer [a] [:nothing] k)))))
(deftest a-preview-goes-on-top-of-its-own-symbol-only
(let [a {:kind :poly :node :a} b {:kind :poly :node [:g :b]} c {:kind :poly :node :c}
p {:kind :poly :preview true}]
(is (= [a b p c] (clip/atop [a b c] [:g] p)) "under what is above the symbol")
(is (= [a b c p] (clip/atop [a b c] [] p)) "the open symbol is on top of everything")
(is (= [a b c p] (clip/atop [a b c] [:empty] p)))))
(deftest a-remap-shape-lights-what-is-under-it-and-nothing-else
;; A flashlight: a circle that draws nothing of its own, and draws what is
;; already under it in other slots of the palette.
(let [sq (fn [x0 y0 x1 y1] [x0 y0 x1 y0 x1 y1 x0 y1])
document (-> (clip/blank)
(paint/new-shape :main :wall 0 (sq 0 0 40 20) 2)
(paint/new-shape :main :door 0 (sq 10 0 20 20) 3)
(paint/new-shape :main :beam 0 (sq 5 5 15 15) [:remap {2 5}])
(assoc-in [:symbols :main :nodes :wall :z] "a")
(assoc-in [:symbols :main :nodes :door :z] "b")
(assoc-in [:symbols :main :nodes :beam :z] "c"))
context (pal/compile document)
ops (vec ((clip/resolver document :main nil context nil) 0))
ras (raster/draw-ops! (raster/clear! (raster/make 320 200) 0) ops)
at (fn [x y] (aget (:buf ras) (+ x (* y 320))))
slot #(pal/render-index context (pal/default-palette-id document) %)]
(is (= (slot 5) (at 7 10)) "the wall under the beam is lit")
(is (= (slot 3) (at 12 10)) "the door under it is a slot the map leaves alone")
(is (= (slot 2) (at 30 10)) "and the wall outside it is as it was")
(is (= [:wall] (pick/hit ops [7 10])) "a click goes through the light")))

View file

@ -0,0 +1,30 @@
(ns arthur.domain.keyframes-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.keyframes :as k]))
(def items [{:sid :main :id :a :channel [:xform :pos] :frame 2 :at 2 :scale 1}
{:sid :main :id :a :channel [:xform :pos] :frame 4 :at 4 :scale 1}])
(def document {:symbols {:main {:nodes {:a {:channels {[:xform :pos]
{:animated? true :interp :linear :keys {2 [2 0] 4 [4 0] 8 [8 0]}
:segments {2 :hold}}}}}}}})
(defn channel [d] (get-in d [:symbols :main :nodes :a :channels [:xform :pos]]))
(deftest simultaneous-moves-preserve-values-and-segments
(let [c (channel (k/edit-keys document items 2))]
(is (= {4 [2 0] 6 [4 0] 8 [8 0]} (:keys c)))
(is (= {4 :hold} (:segments c)))))
(deftest deleting-last-key-keeps-its-value
(let [d (k/edit-keys document items nil)
last-key (assoc (first items) :frame 8 :at 8)]
(is (= {8 [8 0]} (:keys (channel d))))
(is (= {:animated? false :value [8 0]} (channel (k/edit-keys d [last-key] nil))))))
(deftest moving-left-clamps-the-whole-selection
(is (= [0 2] (mapv :frame (k/shifted items -10))))
(is (= {0 [2 0] 2 [4 0] 8 [8 0]} (:keys (channel (k/edit-keys document items -10))))))
(deftest retimed-keys-snap-in-their-own-clock
(let [key (assoc (first items) :scale 2 :at 14)]
(is (= 3 (:frame (first (k/shifted [key] 2)))))
(is (= 16 (:at (first (k/shifted [key] 2)))))))

View file

@ -16,6 +16,21 @@
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}}) (assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil))) (clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
(deftest instance-channel-keys-use-placement-time-before-source-playback
(doseq [[speed end source-frame] [[2 :loop 3] [0 :stop 5]]]
(let [n {:id :insert :kind :instance :source {:symbol :inner}
:time {:at 5 :rate 1} :span [0 100]
:playback {:in 5 :speed speed :end end}}
c (-> (clip/blank)
(assoc-in [:symbols :inner] {:id :inner :frames 10 :fps 30 :nodes {}})
(assoc-in [:symbols :main :nodes :insert] n))
frame (:frame (nest/placement c nil :main [:insert] 29))
keyed (node/set-keyed-channel n [:xform :rot] frame 1)]
(is (= source-frame (:frame (nest/inside c nil :main [:insert] 29))))
(is (= 24 frame) "instance automation keeps advancing through loops and holds")
(is (= 1 (get-in keyed [:channels [:xform :rot] :keys 24])))
(is (not (contains? (get-in keyed [:channels [:xform :rot] :keys]) source-frame))))))
(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names (deftest a-frame-is-carried-down-through-the-instances-a-row-path-names
(let [c (nested) (let [c (nested)
[id] (keys (get-in c [:symbols :outer :nodes])) [id] (keys (get-in c [:symbols :outer :nodes]))

View file

@ -116,6 +116,20 @@
(is (= [0 0 0 3 3 3] (mapv #(node/expose % 3) (range 6)))) (is (= [0 0 0 3 3 3] (mapv #(node/expose % 3) (range 6))))
(is (= 4 (node/expose 5 2)) "frame 5 at exposure 2 reads frame 4, not 6")) (is (= 4 (node/expose 5 2)) "frame 5 at exposure 2 reads frame 4, not 6"))
(deftest a-hold-floors-onto-authored-frames
;; Exposure on frames somebody chose rather than on a grid: the last hold at or
;; before the frame, and before the first one the first.
(is (= [0 1 2 3] (mapv #(node/hold % []) (range 4))) "no holds is no floor")
(is (= [12 12 12 12 30 30] (mapv #(node/hold % [12 30]) [0 11 12 29 30 99])))
(is (= [0 0 12 12 30] (mapv #(node/hold % [0 12 30]) [0 11 12 29 30])))
(testing "after exposure, before the lead"
(is (= 13 (node/local-frame {:time {:holds [4 12] :expose 2 :offset 1}} 13))
"13 exposes to 12, holds at 12, and the lead adds 1"))
(testing "refused unless increasing"
(is (seq (node/problems {:id :n :kind :group :z "a" :time {:holds [3 1]}})))
(is (seq (node/problems {:id :n :kind :group :z "a" :time {:holds '(1 3)}})))
(is (empty? (node/problems {:id :n :kind :group :z "a" :time {:holds [1 3]}})))))
(deftest exposure-comes-before-offset-and-the-order-is-visible (deftest exposure-comes-before-offset-and-the-order-is-visible
;; THE INVARIANT: flooring onto a grid and shifting against the clock do not ;; THE INVARIANT: flooring onto a grid and shifting against the clock do not
;; commute. Shift first and the floor discards it on most frames, so the lead ;; commute. Shift first and the floor discards it on most frames, so the lead

View file

@ -0,0 +1,38 @@
(ns arthur.domain.onion-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.onion :as onion]))
(def events [{:start 0 :end 12 :drawing :a}
{:start 15 :end 17 :drawing :a}
{:start 17 :end 19 :drawing :b}
{:start 25 :end 30 :drawing :c}])
(deftest neighbors-count-events-and-skip-gaps
(is (= [[0 :before] [17 :after]]
(mapv (juxt :start :direction) (onion/neighbors events 16 1 1))))
(is (= [0 15] (mapv :start (onion/neighbors events 13 1 1))))
(is (= [15 0 25] (mapv :start (onion/neighbors events 18 2 1))))
(is (empty? (onion/neighbors events 18 0 0))))
(def document
{:fps 24 :stage [32 32]
:symbols {:main {:frames 40 :fps 24 :nodes
{:lane {:id :lane :kind :instance :source {:symbol :drawings}
:span [0 40]}}}
:drawings {:frames 40 :fps 24 :display :lane :nodes
{:a {:id :a :kind :instance :source {:symbol :ink}
:span [0 12]}
:b {:id :b :kind :instance :source {:symbol :ink}
:span [0 2] :time {:at 15 :rate 1}}
:c {:id :c :kind :instance :source {:symbol :ink}
:span [0 2] :time {:at 17 :rate 1}}}}
:ink {:frames 1 :nodes {}}}})
(deftest selected-lane-and-symbol-scopes
(let [settings (assoc onion/defaults :on? true)]
(is (= [[0 [:lane :a]] [17 [:lane :c]]]
(mapv (juxt :frame :path)
(onion/samples document {} :main [:node :drawings :b [:lane :b]] 16 settings))))
(is (empty? (onion/samples document {} :main nil 16 settings)))
(is (= [0 17]
(mapv :frame (onion/samples document {} :main nil 16 (assoc settings :scope :symbol)))))))

View file

@ -0,0 +1,107 @@
(ns arthur.domain.outline-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.outline :as outline]
[arthur.domain.raster :as r]))
(defn- covered [{:keys [buf]}] (count (filter #(= 1 %) (array-seq buf))))
(deftest a-traced-ring-fills-back-to-exactly-the-mask
(let [m (outline/stamp! (outline/mask 40 30) [8 8] [30 20] 6)
[ring & more] (outline/rings m)
back (r/fill-poly-buf! (r/make 40 30) ring (quot (count ring) 2) 1)]
(is (empty? more) "one stroke is one piece")
(is (= (vec (array-seq (:buf m))) (vec (array-seq (:buf back)))))))
(deftest a-single-pixel-is-a-square
(let [m (outline/mask 5 5)]
(aset (:buf m) 12 1)
(is (= [[2 2 3 2 3 3 2 3]] (outline/rings m 0)))))
(deftest pieces-are-traced-apart-biggest-first
(let [m (-> (outline/mask 40 20)
(outline/stamp! [5 10] [5 10] 4)
(outline/stamp! [20 10] [34 10] 6))]
(is (= 2 (count (outline/rings m))))
(is (< 8 (covered m)))
(is (< 15 (apply min (take-nth 2 (first (outline/rings m))))) "the long one first")))
(deftest a-fit-keeps-the-corners-and-straightens-the-stairs
(let [block (let [m (outline/mask 60 60)]
(doseq [y (range 10 40) x (range 10 50)] (aset (:buf m) (+ x (* y 60)) 1))
(first (outline/rings m)))
stairs (let [m (outline/mask 60 60)]
(doseq [y (range 5 55) x (range 5 (inc y))] (aset (:buf m) (+ x (* y 60)) 1))
(first (outline/rings m)))]
(is (= 8 (count (outline/fit block 1))) "a rectangle is its four corners")
(is (= 6 (count (outline/fit stairs 1))) "a pixel staircase is one diagonal: a triangle")
(is (< 6 (count (outline/fit stairs 0.25))) "unless asked to fit closer than the steps")))
(deftest a-loop-keeps-its-hole-in-one-ring
;; A ring of brush round a gap: one piece, one hole, and the one polygon it
;; makes fills back to the ring and leaves the gap empty.
(let [m (reduce (fn [m a]
(let [p #(vector (+ 30 (* 15 (js/Math.cos %))) (+ 30 (* 15 (js/Math.sin %))))]
(outline/stamp! m (p a) (p (+ a 0.3)) 5)))
(outline/mask 60 60) (range 0 6.6 0.3))
[piece & more] (outline/pieces m)
fill (fn [ring] (:buf (r/fill-poly-buf! (r/make 60 60) ring (quot (count ring) 2) 1)))
middle (+ 30 (* 30 60))]
(is (empty? more))
(is (= 1 (count (:holes piece))))
(is (= (vec (array-seq (:buf m))) (vec (array-seq (fill (outline/polygon piece 0.01)))))
"unsimplified, the bridged ring is the stroke exactly")
(is (zero? (aget (fill (outline/polygon piece 0.01)) middle)) "the middle is a hole")
(is (zero? (aget (fill (outline/polygon piece 8)) middle)) "and simplified, still a hole")))
(deftest overlapping-strokes-leave-no-slivers-and-nothing-crosses
;; A scribble back and forth over itself: the gaps between passes are not
;; holes anyone meant, and the one ring it makes fills back to the scribble
;; without a cut through it.
(let [m (reduce (fn [m i] (outline/stamp! m [10 (+ 10 (* 3 i))] [70 (+ 12 (* 3 i))] 5))
(outline/mask 80 60) (range 10))
[piece] (outline/pieces m)
ring (outline/polygon piece 1)
back (:buf (r/fill-poly-buf! (r/make 80 60) ring (quot (count ring) 2) 1))
miss (count (filter true? (map not= (array-seq (:buf m)) (array-seq back))))]
(is (< miss 80) (str miss " pixels differ — within a pixel of the edge, not a cut"))
(is (every? #(< (count %) 40) (outline/rings-of piece 1)) "and every ring is simple")))
(deftest a-gap-open-to-the-outside-is-not-a-hole
(let [m (-> (outline/mask 40 40)
(outline/stamp! [5 5] [30 5] 4)
(outline/stamp! [30 5] [30 30] 4)
(outline/stamp! [30 30] [5 30] 4))]
(is (= [] (:holes (first (outline/pieces m)))))))
(deftest a-small-hole-is-a-few-points-not-its-staircase
(let [m (outline/mask 60 60)]
(doseq [y (range 10 50) x (range 10 50)
:when (not (and (< 25 x 34) (< 25 y 34)))]
(aset (:buf m) (+ x (* y 60)) 1))
(let [[outer hole] (outline/rings-of (first (outline/pieces m)) 1)]
(is (= 8 (count outer)))
(is (= 8 (count hole)) "an 8×8 hole is its four corners"))))
(deftest a-hole-whose-fit-would-cross-the-outside-is-clipped-to-it
;; A wedge-shaped gap reaching to within a pixel of the outside: fitted on its
;; own, its edge can cross the outside's. It stays a hole, inside the body.
(let [m (outline/mask 60 60)]
(doseq [y (range 10 50) x (range 10 50)
:when (not (and (< 12 x 47) (< 12 y (- 47 (quot (- x 12) 3)))))]
(aset (:buf m) (+ x (* y 60)) 1))
(let [rs (outline/rings-of (first (outline/pieces m)) 3)
ring (outline/join rs)
back (:buf (r/fill-poly-buf! (r/make 60 60) ring (quot (count ring) 2) 1))]
(is (< 1 (count rs)) "the hole is kept")
(is (zero? (aget back (+ 25 (* 20 60)))) "and is a hole")
(is (every? #(< (count %) 30) rs) "and simple")
(is (zero? (aget back (+ 5 (* 5 60)))) "and nothing outside the body is filled"))))
(deftest a-brush-mask-can-live-outside-the-export-rectangle
(let [m (assoc (outline/mask 60 50) :origin [-20 -20])
normal (outline/stamp! (outline/mask 60 50) [10 12] [30 24] 6)
outside (outline/stamp! m [-10 -8] [10 4] 6)
shift (fn [ring] (mapv #(- % 20) ring))]
(is (= (vec (array-seq (:buf normal))) (vec (array-seq (:buf outside)))))
(is (= (mapv shift (outline/rings normal)) (outline/rings outside)))
(is (neg? (apply min (first (outline/rings outside)))))))

View file

@ -33,3 +33,14 @@
(is (some #(= :paint-test (:node %)) (is (some #(= :paint-test (:node %))
(symbol/eval-frame (get-in c2 [:symbols :main]) 3 nil pal/index-of nil))) (symbol/eval-frame (get-in c2 [:symbols :main]) 3 nil pal/index-of nil)))
(is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip)))))) (is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))
(deftest a-point-is-added-and-taken-away-on-every-key
(let [c0 (-> (paint/new-shape demo/clip :main :p 0 [0 0 10 0 10 10] :brow)
(paint/add-key :main :p 6)
(paint/set-vertex :main :p 6 1 [20 0]))
c1 (paint/insert-vertex c0 :main :p 0 0.5)
ks #(get-in % [:symbols :main :nodes :p :channels paint/geometry :keys])]
(is (= {0 [0 0 5 0 10 0 10 10] 6 [0 0 10 0 20 0 10 10]} (ks c1))
"half way along the same edge of each key")
(is (= (ks c0) (ks (paint/delete-vertex c1 :main :p 1))))
(is (= (ks c0) (ks (paint/delete-vertex c0 :main :p 0))) "a triangle keeps its three")))

View file

@ -219,3 +219,34 @@
(let [dest (js/Uint8ClampedArray. (* 23 17 4))] (let [dest (js/Uint8ClampedArray. (* 23 17 4))]
(is (= (naive ras pal/rgb 1) (is (= (naive ras pal/rgb 1)
(vec (array-seq (:data (r/->rgba ras pal/rgb 1 dest)))))))))) (vec (array-seq (:data (r/->rgba ras pal/rgb 1 dest))))))))))
(defn- sq [x0 y0 x1 y1] [x0 y0 x1 y0 x1 y1 x0 y1])
(deftest a-knockout-clears-its-own-layer-and-nothing-under-it
(let [ras (-> (r/make 20 10) (r/clear! 0)
(r/draw-ops! [{:kind :poly :pts (sq 0 0 20 10) :n 4 :color 1}
{:kind :begin}
{:kind :poly :pts (sq 0 0 10 10) :n 4 :color 2}
{:kind :poly :pts (sq 10 0 20 10) :n 4 :color 3}
{:kind :poly :pts (sq 5 0 15 10) :n 4 :color 0 :knock -1}
{:kind :end}]))]
(is (= 50 (count-index ras 2)) "0..5 of the left half is left")
(is (= 50 (count-index ras 3)) "15..20 of the right half is left")
(is (= 100 (count-index ras 1)) "the hole shows what was under the layer")))
(deftest a-knockout-of-one-colour-leaves-the-others
(let [ras (-> (r/make 20 10) (r/clear! 0)
(r/draw-ops! [{:kind :begin}
{:kind :poly :pts (sq 0 0 10 10) :n 4 :color 2}
{:kind :poly :pts (sq 10 0 20 10) :n 4 :color 3}
{:kind :poly :pts (sq 0 0 20 10) :n 4 :color 0 :knock 3}
{:kind :end}]))]
(is (= 100 (count-index ras 2)))
(is (zero? (count-index ras 3)))))
(deftest a-mask-op-paints-the-pixels-it-holds
(let [m (js/Uint8Array. 200)]
(aset m 3 1) (aset m 150 1)
(is (= 2 (count-index (-> (r/make 20 10) (r/clear! 0)
(r/draw-ops! [{:kind :mask :mask m :color 4}]))
4)))))

View file

@ -857,3 +857,25 @@
{:extent :grow-symbol :remainder-id :rest}))] {:extent :grow-symbol :remainder-id :rest}))]
(is (empty? (symbol/overlaps (get-in mixed [:symbols :main])))) (is (empty? (symbol/overlaps (get-in mixed [:symbols :main]))))
(is (empty? (clip/problems mixed)))))) (is (empty? (clip/problems mixed))))))
(deftest moving-a-selection-in-a-lane-is-simultaneous
(let [doc (document)
moved (:clip (nest/slide-many doc :main [[:a] [:b]] 1))]
(is (nil? moved))
(is (:refused (nest/slide-many doc :main [[:a] [:b]] 1))
"the whole group refuses collision with the unselected insert")))
(deftest moving-all-lane-clips-preserves-their-spans
(let [doc (document)
moved (:clip (nest/slide-many doc :main [[:a] [:b] [:insert]] 2))]
(is (some? moved))
(is (= [2 6 10] (mapv #(get-in moved [:symbols :main :nodes % :time :at]) [:a :b :insert])))
(is (= [0 4] (get-in moved [:symbols :main :nodes :a :span])))))
(deftest a-selected-instance-carries-its-selected-contents-once
(let [doc (document)
result (nest/slide-many doc :main [[:insert] [:insert :mark]] 2)]
(is (nil? (:refused result)))
(is (= 10 (get-in result [:clip :symbols :main :nodes :insert :time :at])))
(is (= (get-in doc [:symbols :wave :nodes])
(get-in result [:clip :symbols :wave :nodes])))))

View file

@ -167,6 +167,20 @@
x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))] x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12))))))) (is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest holds-are-inherited-like-exposure
(let [walk (ch/keyed (into {} (map (fn [f] [f [f 0]])) (range 12)) :hold)
s (assoc (sc {:id :g :kind :group :z "a1" :time {:holds [2 7]}
:channels {[:xform :pos] walk}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
:frames 12)
x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [2 2 2 2 2 2 2 7 7 7 7 7] (mapv x-at (range 12)))
"the group reads its held frame, before the first hold included")
(testing "and the playback path agrees"
(let [spec (ops/specified s nil) fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders 12) f fs]
(is (= (spec f) (fast f)) (str label " at frame " f)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead (deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
;; Lead applies to performance nodes and NOT to the plate. If it were a clip ;; Lead applies to performance nodes and NOT to the plate. If it were a clip
;; property the mouth would drag the whole head forward with it. ;; property the mouth would drag the whole head forward with it.

View file

@ -1,139 +0,0 @@
(ns arthur.domain.trace-test
(:require [cljs.test :refer [deftest is]]
[arthur.demo.take :as take]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.flow.freeze :as freeze]))
(def ^:private frozen (delay (freeze/head-mode {} @take/frozen)))
(def ^:private store (delay (:store @take/frozen)))
(defn- traced
"The synthetic take with face-1's trace set to `t`."
[t]
(assoc-in @frozen [:symbols :face-1 :nodes :head :trace] t))
(defn- head [c] (get-in c [:symbols :face-1 :nodes :head]))
(defn- near? [a b]
(every? #(< (js/Math.abs %) 1e-9) (map - a b)))
(deftest the-origin-picks-the-measured-frame-a-head-reads
(let [at (fn [t fs] (map #(trace/held-frame (trace/prepare t) %) fs))]
(is (nil? (trace/prepare {:frames [4 9] :origin :continuous})))
(is (nil? (trace/prepare nil)))
(is (= [0 0 0] (at {:frames [4 9] :origin :start} [0 5 50])))
(is (= [4 4 4 4 9 9] (at {:frames [4 9] :origin :keys} [0 3 4 8 9 50]))
"a jump at each key, and before the first the first")
(is (= [0 0] (at {:frames [] :origin :keys} [0 30])))))
(deftest every-origin-is-a-valid-document-that-saves
(doseq [origin trace/origins
:let [c (traced {:frames [0 12 40] :origin origin})]]
(is (empty? (clip/problems c)) (str origin ": " (pr-str (clip/problems c))))
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) (str origin " round-trips"))))
(deftest a-trace-the-take-cannot-hold-will-not-save
(doseq [t [{:frames [0] :origin :sideways} {:frames [9 3] :origin :keys}
{:frames [9999] :origin :keys}]]
(is (seq (clip/problems (traced t))) (pr-str t))))
(deftest the-photo-holds-each-trace-frame-until-the-next
(let [t {:frames [5 20]}]
(is (= [5 5 5 5 20 20] (map #(trace/photo-frame t %) [0 4 5 19 20 90]))))
(is (= 33 (trace/photo-frame {:frames []} 33)) "no keys: every frame is its own")
(is (= [3 7] (:frames (trace/toggle-frame {:frames [7]} 3))))
(is (= [] (:frames (trace/toggle-frame {:frames [7]} 7)))))
(defn- photo-at
"The photo matrix of face-1 alone at frame `f`, the still being 1000px tall."
[c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil)
h (head c)]
(r f)
(vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store
(trace/photo-frame (trace/of h) f) 1000)))))
(defn- filmed
"Where a photo sitting exactly where it was filmed must land: the face's OWN
placement, over image height, and nothing else.
`:place` carries the source-to-stage mapping now, above `:head` — so a face
opened in its own tab draws at the size it is on the stage, and its photo has
to come with it. That is the whole reason the mapping belongs to the face: the
head still cancels out, which is what these assertions are about, but it
cancels against a placement rather than against nothing."
[c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil)]
(r f)
(vec (array-seq (node/mul! (node/mat) (symbol/world-of r :place)
(js/Float64Array. #js [0.001 0 0 0.001 0 0]))))))
(deftest the-photo-registers-to-the-face-it-was-filmed-with
(let [a (traced {:frames [] :origin :continuous})
b (traced {:frames [12] :origin :keys})
d (traced {:frames [12] :origin :continuous})]
(is (near? (filmed a 30) (photo-at a 30))
"a head showing the photo's own frame cancels out")
(is (near? (filmed b 30) (photo-at b 30))
"held at the trace frame, face and photo both stand still")
(is (not (near? (filmed d 30) (photo-at d 30)))
"a continuous head carries the held photo along with it")))
(defn- wrapped
"Face-1's take placed, moved, inside a symbol :wrap."
[]
(assoc-in @frozen [:symbols :wrap]
{:id :wrap :frames 200
:nodes {:m {:id :m :kind :instance :z "a0"
:source {:symbol :main}
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}}))
(deftest a-face-switched-on-shows-wherever-it-is-placed
(let [c (wrapped)]
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/shown c :wrap #{:face-1}))
"a face inside a take inside a symbol, at the row path it is at")
(is (= [] (trace/shown c :wrap #{})) "and nothing when it is switched off")
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/shown c :main #{:face-1}))
"the same switch, one symbol down")
(is (= [{:path [] :in :face-1 :face :face-1}] (trace/shown c :face-1 #{:face-1}))
"the face open in its own tab is at no path at all — it IS the stage")
(is (= [] (trace/shown c :wrap #{:main}))
"a symbol that is not a face has no footage of its own to show")))
(deftest the-faces-that-can-be-traced-are-listed-once-each
(is (= [:face-1] (trace/traceable-faces (wrapped) :wrap)))
(is (= [:face-1] (trace/traceable-faces @frozen :main)) "the take it was frozen into")
(is (= [:face-1] (trace/traceable-faces @frozen :face-1)) "itself, open to draw over"))
(deftest a-face-opened-to-be-drawn-over-starts-with-its-footage-showing
(let [c (wrapped)]
(is (= #{:face-1} (trace/showing-for c :face-1 #{})) "the face's own tab")
(is (= #{} (trace/showing-for c :main #{}))
"and not the take it is placed in, which is the picture itself")
(is (= #{:face-1} (trace/showing-for c :main #{:face-1}))
"one already switched on stays on wherever you go")))
(deftest a-take-lists-the-faces-in-it
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/faces @frozen :main)))
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/faces (wrapped) :wrap)))
(is (= [] (trace/faces @frozen :face-1))))
(deftest the-resolver-says-where-a-nested-head-went-on-its-last-frame
;; The same answer as `nest/placement`, which walks and resolves the path all
;; over again — the resolver has it already, from drawing the frame.
(let [c (wrapped)
r (clip/resolver c :wrap @store pal/index-of nil)
path [:m :face-1 :head]]
(doseq [f [0 17 60]]
(r f)
(let [pl (nest/placement c @store :wrap path f)]
(is (near? (array-seq (:world pl)) (array-seq (symbol/world-of r path))) (str f))
(is (= (:frame pl) (js/Math.floor (symbol/frame-of r path))) (str f))))
(r 500)
(is (nil? (symbol/world-of r path)) "not on the frame, not anywhere")))

View file

@ -0,0 +1,244 @@
(ns arthur.domain.tracing-test
"Tracing symbols: footage or a still to draw over, placed like any symbol and
never part of the picture — and a face's footage as one of them, under its head."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take]
[arthur.domain.clip :as clip]
[arthur.domain.creation :as creation]
[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.symbol :as symbol]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[arthur.flow.freeze :as freeze]
[re-frame.core :as rf]
[re-frame.db :as rf-db]))
(def ^:private image-h 1000)
(def ^:private frozen
"The synthetic take frozen as though it had come from footage 1000px tall."
(delay (freeze/clip (assoc take/params :footage {:id "f00" :range [0 take/frames]
:width 1500 :height image-h})
{:face-1 @take/measured})))
(defn- traced
"The take with face-1's trace keys and origin set."
[t]
(freeze/head-mode {:trace t} @frozen))
(defn- near? [a b]
(every? #(< (js/Math.abs %) 1e-3) (map - a b)))
(defn- resolver [c sid opts]
(clip/resolver c sid (:store @frozen) pal/index-of opts))
(defn- traces-at [r f]
(filterv #(= :trace (:kind %)) (r f)))
;; ---------------------------------------------------------------------------
;; the document
(deftest a-freeze-from-footage-makes-a-tracing-symbol-and-places-it-under-the-head
(let [c (traced nil)
plate (get-in c [:symbols :face-1 :nodes :plate])]
(is (clip/trace? (clip/symbol c :footage)))
(is (= {:footage "f00" :range [0 take/frames]} (:media (clip/symbol c :footage))))
(is (= :head (:parent plate)) "the footage rides the head")
(is (= :footage (node/source plate)))
(is (node/measured? plate) "and is registered by the measurement, not by hand")
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) "it saves and comes back")))
(deftest the-origin-writes-the-heads-reads-and-the-keys-the-plates-holds
(is (nil? (get-in (traced {:origin :continuous :frames [12]}) [:symbols :face-1 :nodes :head :reads])))
(is (= {:holds-of :plate} (get-in (traced {:origin :keys :frames [12]}) [:symbols :face-1 :nodes :head :reads])))
(is (= {:holds [0]} (get-in (traced {:origin :start}) [:symbols :face-1 :nodes :head :reads])))
(is (= [12 40] (get-in (traced {:origin :continuous :frames [12 40]})
[:symbols :face-1 :nodes :plate :time :holds]))
"the keys are the footage's whatever the head does"))
(deftest a-tracing-symbol-that-does-not-say-what-it-shows-will-not-load
(doseq [[why sym] [["nodes" {:nodes {:x {:id :x :kind :group :z "a"}}}]
["no media" {:media {}}]
["both" {:media {:footage "f" :image "i" :range [0 10]}}]
["short range" {:media {:footage "f" :range [0 9]}}]
["no size" {:width nil}]]]
(let [c (update-in (traced nil) [:symbols :footage] merge sym)]
(is (seq (clip/problems c)) why))))
(deftest reads-must-name-a-node-that-can-be-followed
(doseq [reads [{:holds-of :nowhere} {:holds-of :head} {:holds [3 1]}
{:holds [0] :holds-of :plate}]]
(is (seq (clip/problems (assoc-in (traced nil) [:symbols :face-1 :nodes :head :reads] reads)))
(pr-str reads))))
;; ---------------------------------------------------------------------------
;; registration
(defn- plate-at
"Face-1's footage op at frame `f`, its world matrix as a vector."
[c f]
(let [[op] (traces-at (resolver c :face-1 {:tracing? true}) f)]
(vec (array-seq (:m op)))))
(defn- filmed
"Where footage sitting exactly where it was filmed lands: the face's own
placement, over image height, and nothing else."
[c f]
(let [r (resolver c :face-1 nil)]
(r f)
(vec (array-seq (node/mul! (node/mat) (symbol/world-of r [:place])
(js/Float64Array. #js [(/ 1 image-h) 0 0 (/ 1 image-h) 0 0]))))))
(deftest the-footage-registers-to-the-face-it-was-filmed-with
(let [free (traced {:origin :continuous})
keyed (traced {:origin :keys :frames [12]})
ride (traced {:origin :continuous :frames [12]})
start (traced {:origin :start})]
(is (near? (filmed free 30) (plate-at free 30))
"a head reading the footage's own frame cancels out")
(is (near? (filmed keyed 30) (plate-at keyed 30))
"held at the key, face and footage both stand still where it was filmed")
(is (not (near? (filmed ride 30) (plate-at ride 30)))
"a continuous head carries the held footage along with it")
(is (= 12 (:frame (first (traces-at (resolver ride :face-1 {:tracing? true}) 30))))
"showing the held frame")
(is (not (near? (filmed start 60) (plate-at start 60)))
"footage under a head held at its start is stabilised, not where it was filmed")))
;; ---------------------------------------------------------------------------
;; never in the picture
(deftest only-the-stage-asks-for-tracing
(let [c (traced nil)]
(doseq [f [0 30 100]]
(is (empty? (traces-at (resolver c :main nil) f)) "an export, a centre, a thumbnail")
(is (= 1 (count (traces-at (resolver c :main {:tracing? true}) f))) "the stage"))))
(deftest a-trace-op-comes-up-through-every-instance-above-it
(let [c (assoc-in (traced nil) [:symbols :wrap]
{:id :wrap :frames 200
:nodes {:m {:id :m :kind :instance :z "a0" :source {:symbol :main}
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}})
inner (first (traces-at (resolver c :main {:tracing? true}) 20))
outer (first (traces-at (resolver c :wrap {:tracing? true}) 20))
moved (fn [m] (let [v (vec (array-seq m))] (-> v (update 4 + 30) (update 5 - 10))))]
(is (= [:m :face-1 :plate] (:node outer)) "named by its row path, as anything drawn is")
(is (= [:face-1 :plate] (:layer outer)) "and switched by where it is, not where it is placed")
(is (near? (moved (:m inner)) (vec (array-seq (:m outer)))))))
;; ---------------------------------------------------------------------------
;; a tracing layer placed by hand
(def ^:private still
{:id :still :name "ref" :type :trace :media {:image "abc"}
:frames 1 :fps 30 :width 400 :height 200 :nodes {}})
(defn- with-still []
(-> (clip/blank)
(assoc-in [:symbols :still] still)
(clip/place-symbol {} :main :still 0 :layer [160 100])
(update-in [:symbols :main :nodes :layer] assoc
:playback {:in 0 :speed 0 :end :hold} :span [0 120])))
(deftest a-still-is-placed-about-its-middle-and-shows-on-every-frame
(let [c (with-still)
r (clip/resolver c :main {} pal/index-of {:tracing? true})]
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))
(is (= [200 100] (clip/center c {} :still)) "a tracing symbol's middle is its pixels'")
(doseq [f [0 50 119]]
(let [[op] (traces-at r f)]
(is (= 0 (:frame op)))
(is (= [-40 0] (vec (take 2 (drop 4 (array-seq (:m op))))))
(str "its middle on the drop point, frame " f))))))
(deftest nothing-is-created-inside-a-tracing-layer
(let [c (with-still)]
(is (= :main (:sid (creation/target c {} :main [:node :main :layer [:layer]] 10)))
"selecting a tracing layer creates beside it, as selecting a shape does")
(is (= "a tracing layer is a picture to draw over — nothing goes inside it"
(:refused (ui/drop-destination-at c {} :main 10 [:node :main :layer [:layer]]))))))
(deftest a-click-picks-what-is-drawn-before-a-reference
(let [trace {:kind :trace :node :layer :size [100 100]
:m (js/Float64Array. #js [0 1 -1 0 50 0])}
shape {:kind :rect :node :dot :cx 10 :cy 10 :size 4}]
(is (= [:dot] (pick/hit [shape trace] [10 10])) "drawn wins, though the photo is on top")
(is (= [:layer] (pick/hit [shape trace] [20 50])) "a reference where nothing is drawn")
(is (nil? (pick/hit [shape trace] [60 50])) "outside the turned image is outside it")))
(deftest a-held-layer-is-keyed-on-its-own-unfloored-frames
(let [c (assoc-in (traced {:origin :keys :frames [12]}) [:symbols :face-1 :nodes :plate :time :holds] [12])
t (nest/own-time c (:store @frozen) :face-1 [:plate] 30)]
(is (= 30 (* (:rate t) (- 30 (:at t)))) "frame 30 is 30, though it shows 12")))
(deftest a-dropped-still-lasts-the-rest-of-the-symbol-fits-it-and-is-reused
(let [id (store/install! {:clip (clip/blank) :store {}} "drop-tracing")
sym {:name "sheet" :type :trace :media {:image "abc"}
:width 400 :height 800 :nodes {}}
drop! (fn []
(rf/dispatch-sync [::ui/drop-tracing sym 30 nil nil])
(let [doc (:clip (store/entry id))
[_ _ uuid] (get-in @rf-db/app-db [:ui :selection])]
[doc (get-in doc [:symbols :main :nodes uuid])]))]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 30}})
(let [[doc n] (drop!)
sid (node/source n)
[w h] (clip/stage doc :main)
k (/ h 800)]
(is (empty? (clip/problems doc)) (pr-str (clip/problems doc)))
(is (clip/trace? (clip/symbol doc sid)))
(is (= (- (clip/frames doc :main) 30) (clip/frames doc sid))
"as long as what is left of the symbol it landed in")
(is (= [30 (clip/frames doc :main)] (node/placed-span n)))
(is (= [k k] (get-in n [:channels [:xform :scale] :value])) "as tall as the stage")
(is (= [(/ w 2) (/ h 2)] (mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value])))
"dropped on the timeline, it is middled on the stage")
(let [[doc2 n2] (drop!)]
(is (= sid (node/source n2)) "the same picture is the same symbol")
(is (= 1 (count (filter clip/trace? (vals (:symbols doc2))))))))))
;; ---------------------------------------------------------------------------
(deftest dropping-a-tracing-symbol-fits-only-the-new-placement
(doseq [point [nil [80 60]]]
(let [c (traced nil)
plate (get-in c [:symbols :face-1 :nodes :plate])
sid (node/source plate)
c (assoc-in c [:symbols sid :width] 3000)
id (store/install! {:clip c :store (:store @frozen)} "fit-pool-tracing")]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 0}})
(rf/dispatch-sync [::ui/drop-symbol sid 0 point nil])
(let [doc (:clip (store/entry id))
[_ host uuid] (get-in @rf-db/app-db [:ui :selection])
n (get-in doc [:symbols host :nodes uuid])
[w h] (clip/stage doc host)
k (min (/ w 3000) (/ h image-h))]
(is (= [k k] (get-in n [:channels [:xform :scale] :value])))
(is (= (or point [(/ w 2) (/ h 2)])
(mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value]))))
(is (= plate (get-in doc [:symbols :face-1 :nodes :plate]))
"the face's registered tracing placement is unchanged")
(is (= (clip/symbol c sid) (clip/symbol doc sid))
"the shared tracing symbol is unchanged")))))
;; on and off
(deftest switching-one-layer-on-switches-tracing-on
(reset! rf-db/app-db {:ui {:tracing {:on? false :opacity 0.5 :hidden #{[:face-1 :plate]}}}})
(rf/dispatch-sync [::ui/show-trace [:face-1 :plate] true])
(is (= {:on? true :opacity 0.5 :hidden #{}} (get-in @rf-db/app-db [:ui :tracing])))
(testing "and switching one off leaves the rest alone"
(rf/dispatch-sync [::ui/show-trace [:face-1 :plate] false])
(is (= {:on? true :opacity 0.5 :hidden #{[:face-1 :plate]}} (get-in @rf-db/app-db [:ui :tracing]))))
(testing "from nothing"
(reset! rf-db/app-db {:ui {:tracing {:on? true}}})
(rf/dispatch-sync [::ui/show-trace [:s :n] false])
(is (= #{[:s :n]} (get-in @rf-db/app-db [:ui :tracing :hidden])))))

View file

@ -0,0 +1,39 @@
(ns arthur.events.instance-playback-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.clip :as clip]
[arthur.events.project :as project]
[arthur.footage.store :as store]
[re-frame.core :as rf]
[re-frame.db :as rf-db]))
(deftest playback-controls-change-only-the-selected-instance
(let [n {:id :wheel :kind :instance :source {:symbol :spin}
:span [0 240] :playback {:in 0 :speed 2 :end :stop
:tracks {:mouth []}}}
document (-> (clip/blank)
(assoc-in [:symbols :spin] {:frames 24 :fps 30 :nodes {}})
(assoc-in [:symbols :main :nodes :wheel] n)
(assoc-in [:symbols :main :nodes :other] (assoc n :id :other)))
id (store/install! {:clip document :store {}} "instance-playback-controls")
current #(get-in (:clip (store/entry (:clip/current @rf-db/app-db)))
[:symbols :main :nodes :wheel])]
(reset! rf-db/app-db {:clip/current id :paint/revision 0})
(rf/dispatch-sync [::project/instance-playback :main :wheel :mode :loop])
(is (= 0 (:frame (clip/placed-frame document :main (current) 24))))
(is (= :loop (get-in (current) [:playback :end])))
(is (= 2 (get-in (current) [:playback :speed])))
(rf/dispatch-sync [::project/instance-playback :main :wheel :in 5])
(rf/dispatch-sync [::project/instance-playback :main :wheel :mode :frame])
(is (= 5 (:frame (clip/placed-frame document :main (current) 100))))
(rf/dispatch-sync [::project/instance-playback :main :wheel :mode :once])
(is (nil? (clip/placed-frame document :main (current) 100)))
(is (= [0 240] (:span (current))))
(is (= {:mouth []} (get-in (current) [:playback :tracks])))
(let [before (current)]
(doseq [[field value] [[:in -1] [:speed js/Infinity] [:mode :invalid]]]
(rf/dispatch-sync [::project/instance-playback :main :wheel field value]))
(is (= before (current))))
(is (= n (assoc (get-in (:clip (store/entry (:clip/current @rf-db/app-db)))
[:symbols :main :nodes :other]) :id :wheel)))
(is (= 24 (get-in (:clip (store/entry (:clip/current @rf-db/app-db)))
[:symbols :spin :frames])))))

View file

@ -335,7 +335,7 @@
:playback {:frame 6}} :playback {:frame 6}}
after (ui/beginning-polygon db) after (ui/beginning-polygon db)
saved (:clip (store/entry (:clip/current after)))] saved (:clip (store/entry (:clip/current after)))]
(is (= :polygon (get-in after [:ui :tool]))) (is (= [] (get-in after [:ui :draft])) "a draft is begun")
(is (= {} (get-in saved [:symbols :main :nodes]))) (is (= {} (get-in saved [:symbols :main :nodes])))
(is (nil? (get-in saved [:symbols :main :display]))) (is (nil? (get-in saved [:symbols :main :display])))
(is (nil? (get-in (store/entry (:clip/current after)) [:history :done]))))) (is (nil? (get-in (store/entry (:clip/current after)) [:history :done])))))
@ -353,7 +353,7 @@
(is (not= :a cel-id) "the occupied cel is not reused") (is (not= :a cel-id) "the occupied cel is not reused")
(is (= [1 2] (node/placed-span (get-in saved [:symbols sid :nodes cel-id])))) (is (= [1 2] (node/placed-span (get-in saved [:symbols sid :nodes cel-id]))))
(is (= 1 (clip/frames saved (node/source (get-in saved [:symbols sid :nodes cel-id]))))) (is (= 1 (clip/frames saved (node/source (get-in saved [:symbols sid :nodes cel-id])))))
(is (= :polygon (get-in after [:ui :tool]))))) (is (= [] (get-in after [:ui :draft])))))
(deftest sequence-commands-use-isolated-history-transactions (deftest sequence-commands-use-isolated-history-transactions
(let [doc (fixture/document) (let [doc (fixture/document)
@ -455,7 +455,7 @@
(is (= :drawing-a sid) "the shape went into the drawing the selected clip places") (is (= :drawing-a sid) "the shape went into the drawing the selected clip places")
(is (= [:a shape-id] path)) (is (= [:a shape-id] path))
(is (empty? (get-in after [:ui :expanded]))) (is (empty? (get-in after [:ui :expanded])))
(is (nil? (get-in after [:ui :tool])))))) (is (empty? (get-in after [:ui :draft])) "the pen stays the tool, with nothing drafted"))))
(deftest a-clip-made-for-a-drawing-is-selected-in-the-symbol-it-lives-in (deftest a-clip-made-for-a-drawing-is-selected-in-the-symbol-it-lives-in
;; The clip `beginning-polygon` materializes lives in the symbol the LANE ;; The clip `beginning-polygon` materializes lives in the symbol the LANE
@ -484,3 +484,18 @@
(is (= [:girl clip-id] path)) (is (= [:girl clip-id] path))
(is (some? (get-in saved [:symbols :main :nodes clip-id])) (is (some? (get-in saved [:symbols :main :nodes clip-id]))
"and that is where the node actually is"))) "and that is where the node actually is")))
(deftest restacking-a-selection-keeps-all-members-selected
(let [doc (update-in (fixture/document) [:symbols :main] dissoc :display)
id (store/install! {:clip doc :store {}} "restack-many-test")
selections [[:node :main :a [:a]] [:node :main :b [:b]]]]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main :selection (peek selections) :selections selections}
:playback {:frame 6}})
(rf/dispatch-sync [::ui/restack-nodes selections [:insert] true])
(let [after (:clip (store/entry (:clip/current @rf-db/app-db)))
z #(get-in after [:symbols :main :nodes % :z])]
(is (pos? (compare (z :a) (z :insert))))
(is (pos? (compare (z :b) (z :a))))
(is (= selections (get-in @rf-db/app-db [:ui :selections])))
(is (= [0 4] (mapv #(get-in after [:symbols :main :nodes % :time :at]) [:a :b]))))))

View file

@ -249,8 +249,9 @@
path [[:xform :pos] [:xform :rot] [:xform :scale]]] path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :dense (ch/describe (of c path)))) (is (= :dense (ch/describe (of c path))))
(is (= (of free path) (of c path)) "a trace does not copy measurements")) (is (= (of free path) (of c path)) "a trace does not copy measurements"))
(is (nil? (get-in (nodes free) [:head :trace]))) (is (nil? (get-in (nodes free) [:head :reads])))
(is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace]))) (is (= {:holds [12]} (get-in (nodes one) [:head :reads]))
"with no footage to follow, the head holds at the keys itself")
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed))) (is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
"the trace survives the document round trip"))) "the trace survives the document round trip")))

View file

@ -77,7 +77,7 @@
(channel after :face-2 :iris-r [:xform :pos]))) (channel after :face-2 :iris-r [:xform :pos])))
(is (= (channel before :face-2 :iris-l [:xform :pos]) (is (= (channel before :face-2 :iris-l [:xform :pos])
(channel after :face-2 :iris-l [:xform :pos]))) (channel after :face-2 :iris-l [:xform :pos])))
(is (= {:origin :keys :frames [12]} (get-in anchored [:symbols :face-2 :nodes :head :trace]))) (is (= {:holds [12]} (get-in anchored [:symbols :face-2 :nodes :head :reads])))
(is (empty? (clip/problems anchored))))) (is (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage (deftest the-second-subject-regenerates-inside-a-composed-stage

View file

@ -4,6 +4,7 @@
[arthur.demo.stage :as stage] [arthur.demo.stage :as stage]
[arthur.domain.bring :as bring] [arthur.domain.bring :as bring]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.correction :as correction]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.domain.project :as project] [arthur.domain.project :as project]
@ -381,3 +382,61 @@
(is (empty? (ch/conflicts (channel fine :mouth path)))) (is (empty? (ch/conflicts (channel fine :mouth path))))
(is (empty? (clip/conflicts (:clip fine)))) (is (empty? (clip/conflicts (:clip fine))))
(is (empty? (clip/problems (:clip fine))))))) (is (empty? (clip/problems (:clip fine)))))))
(deftest borrowed-pose-survives-parameter-regeneration
(let [result (correction/borrow-pose (:clip @initial) :face-1
{:id :repair :from 10 :through 15 :donor 5 :head? true}
(:store @initial))
repaired (assoc @initial :clip (:clip result))
changed (regenerate/change repaired
{:scope :subject :id :face-1 :knob :anchor-avg :value 3})
c (channel changed :head [:xform :pos])
base (dissoc c :repairs :over)]
(is (nil? (:refused result)))
(is (= 1 (count (:repairs c))))
(is (= (vec (ch/value-at base 5 (:store changed)))
(vec (ch/value-at c 12 (:store changed)))))
(is (empty? (:repairs (channel
(assoc changed :clip (-> (correction/remove-repair (:clip changed) :face-1 :repair) :clip))
:head [:xform :pos]))))))
(deftest borrow-allows-a-donor-with-no-teeth-contour
(let [doc (assoc-in (:clip @initial)
[:symbols :face-1 :nodes :teeth]
{:id :teeth :kind :poly :z "a9"
:channels {[:geom :pts] (ch/keyed {} :hold)}})
doc (assoc-in doc [:features :test-teeth]
{:id :test-teeth :subject :face-1 :symbol :face-1
:area :teeth :nodes [:teeth] :params {}})
result (correction/borrow-pose doc :face-1
{:id :repair :from 10 :through 15 :donor 5}
(:store @initial))]
(is (nil? (:refused result)))
(is (= 1 (count (get-in (:clip result)
[:symbols :face-1 :nodes :teeth :channels [:geom :pts] :repairs]))))))
(deftest eye-keys-tween-over-borrowed-pose-and-survive-regeneration
(let [repair (correction/borrow-pose (:clip @initial) :face-1
{:id :repair :from 10 :through 20 :donor 5}
(:store @initial))
key1 (correction/eye-key (:clip repair) :face-1 :repair :l 10
{:opening 1 :gaze-x 0 :gaze-y 0})
key2 (correction/eye-key (:clip key1) :face-1 :repair :l 20
{:opening 0 :gaze-x 0.02 :gaze-y -0.01})
entry (assoc @initial :clip (:clip key2))
changed (regenerate/change entry
{:scope :subject :id :face-1 :knob :contour-avg :value 3})
lids (channel changed :eye-l [:geom :pts])
iris (channel changed :iris-l [:xform :pos])
removed (:clip (correction/remove-repair (:clip changed) :face-1 :repair))]
(is (nil? (:refused key1)))
(is (nil? (:refused key2)))
(is (= 1 (count (:over lids))))
(is (= 0.5 (ch/value-at (:values (first (:over lids))) 15 nil)))
(is (= [0.01 -0.005] (ch/value-at (:values (first (:over iris))) 15 nil)))
(is (= (vec (ch/value-at lids 15 (:store changed)))
(vec (ch/sample! (ch/cursor lids (:store changed)) 15))))
(is (empty? (get-in removed [:symbols :face-1 :nodes :eye-l :channels [:geom :pts] :over])))
(is (:refused (correction/eye-key (:clip repair) :face-1 :repair :l 9
{:opening 1 :gaze-x 0 :gaze-y 0})))))

View file

@ -0,0 +1,304 @@
// Browser smoke test for timeline keyframes and group editing. 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';
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-timeline-'));
const port = 9336;
const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
'--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run',
'--no-default-browser-check', '--mute-audio', '--window-size=1440,1000',
`--user-data-dir=${profile}`, `--remote-debugging-port=${port}`, url,
], { stdio: 'ignore' });
const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));
let ws;
try {
let target;
for (let i = 0; i < 100 && !target; i++) {
await sleep(100);
try {
target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json()))
.find(t => t.type === 'page' && t.url.startsWith(url));
} catch { /* 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 = [];
ws.onmessage = ({ data }) => {
const msg = JSON.parse(data);
if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails);
if (msg.id && pending.has(msg.id)) {
const waiting = pending.get(msg.id);
pending.delete(msg.id);
if (msg.error) waiting.reject(new Error(JSON.stringify(msg.error)));
else waiting.resolve(msg.result);
}
};
const send = (method, params = {}) => new Promise((resolve, reject) => {
const id = ++serial;
pending.set(id, { resolve, reject });
ws.send(JSON.stringify({ id, method, params }));
});
const evaluate = async expression => {
const 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++) {
try {
if (await evaluate('typeof arthur !== "undefined" && !!document.querySelector("canvas.stage")')) break;
} catch (error) {
if (!error.message.includes("Cannot find default execution context")) throw error;
}
await sleep(100);
}
await evaluate(`(() => {
const k = cljs.core.keyword;
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test')));
window.laneSnapshot = () => {
const db = cljs.core.deref(re_frame.db.app_db);
return cljs.core.clj__GT_js(arthur.footage.store.entry(cljs.core.get(db, k('clip/current'))));
};
return true;
})()`);
await sleep(250);
await evaluate(`(() => {
const k = cljs.core.keyword, v = cljs.core.vector, m = cljs.core.hash_map;
let c = arthur.domain.clip.blank();
const rect = (id, at, keys) => m(k('id'), k(id), k('kind'), k('rect'), k('z'), id,
k('time'), m(k('at'), at, k('rate'), 1), k('span'), v(0, 20),
k('channels'), keys ? m(v(k('xform'), k('pos')), arthur.domain.channel.keyed(m(2, v(2,0), 4, v(4,0)), k('linear'))) : m());
const target = m(k('id'), k('target'), k('kind'), k('instance'), k('z'), 'z',
k('source'), m(k('symbol'), k('box')), k('span'), v(0, 60),
k('time'), m(k('at'), 0, k('rate'), 1),
k('playback'), m(k('in'), 0, k('speed'), 1, k('end'), k('stop')));
c = cljs.core.assoc_in(c, v(k('symbols'), k('box')), m(k('id'), k('box'), k('frames'), 60, k('nodes'), m()));
c = cljs.core.assoc_in(c, v(k('symbols'), k('main'), k('nodes')), m(k('a'), rect('a',0,true), k('b'), rect('b',4,false), k('target'), target));
const id = arthur.footage.store.install_BANG_(m(k('clip'), c, k('store'), m()), 'timeline-browser');
const a = v(k('node'),k('main'),k('a'),v(k('a'))), b = v(k('node'),k('main'),k('b'),v(k('b')));
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db,
k('clip/current'), id, k('paint/revision'), 100,
k('ui'), m(k('open'),k('main'),k('selection'), b,k('selections'),v(a,b),k('expanded'),cljs.core.hash_set(v(k('a')))),
k('playback'),m(k('frame'),0,k('playing?'),false)));
return true;
})()`);
await sleep(250);
const shot = async () => JSON.parse(JSON.stringify((await evaluate('laneSnapshot()')).clip,
(key, value) => key === 'channels' && Object.keys(value).length === 0 ? undefined : value));
assert.equal(await evaluate('document.querySelectorAll(".tl-track:not(.automation) button.tl-key").length'), 0,
'symbol overview keyframes are passive');
assert.equal(await evaluate('document.querySelectorAll(".tl-track:not(.automation) .tl-key").length'), 2,
'symbol overview still shows keyframe ticks');
const initial = await shot();
await evaluate(`(() => {
const track = document.querySelector('.tl-span.on').closest('.tl-track');
track.focus(); track.dispatchEvent(new KeyboardEvent('keydown', {key:'ArrowRight',bubbles:true})); return true;
})()`);
await sleep(100);
assert.equal((await shot()).symbols.main.nodes.a.time.at, 1);
assert.equal((await shot()).symbols.main.nodes.b.time.at, 5);
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(cljs.core.keyword('arthur.events.history/undo')))`);
await sleep(100);
assert.deepEqual(await shot(), initial, 'group shift undoes atomically');
await evaluate(`(() => {
const span=document.querySelector('.tl-span.on'), track=span.closest('.tl-track');
const box=track.getBoundingClientRect(), x=box.left+box.width*10/120, dx=box.width*2/120;
span.dispatchEvent(new PointerEvent('pointerdown',{bubbles:true,pointerId:20,clientX:x}));
track.dispatchEvent(new PointerEvent('pointermove',{bubbles:true,pointerId:20,clientX:x+dx}));
track.dispatchEvent(new PointerEvent('pointerup',{bubbles:true,pointerId:20,clientX:x+dx}));
return true;
})()`);
await sleep(150);
assert.equal((await shot()).symbols.main.nodes.a.time.at, 2, 'drag shifts the first selected node');
assert.equal((await shot()).symbols.main.nodes.b.time.at, 6, 'drag shifts the other selected node');
assert.equal(await evaluate('document.querySelectorAll(".tl-label.on").length'), 2,
'group dragging preserves selection');
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(cljs.core.keyword('arthur.events.history/undo')))`);
await sleep(100);
assert.deepEqual(await shot(), initial, 'group dragging undoes atomically');
assert.equal(await evaluate('document.querySelectorAll("button.tl-key").length'), 2);
await evaluate(`(() => {
const keys = [...document.querySelectorAll('button.tl-key')];
for (let i=0;i<2;i++) {
keys[i].dispatchEvent(new PointerEvent('pointerdown',{bubbles:true,pointerId:i+1,clientX:200+i*20,shiftKey:!!i}));
keys[i].dispatchEvent(new PointerEvent('pointerup',{bubbles:true,pointerId:i+1,clientX:200+i*20,shiftKey:!!i}));
} return true;
})()`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 2);
await evaluate(`(() => {
const key=document.querySelector('button.tl-key.selected');
const box=key.parentElement.getBoundingClientRect(), x=box.left+box.width*2/120;
key.dispatchEvent(new PointerEvent('pointerdown',{bubbles:true,pointerId:21,clientX:x}));
key.dispatchEvent(new PointerEvent('pointermove',{bubbles:true,pointerId:21,clientX:x+box.width*2/120}));
key.dispatchEvent(new PointerEvent('pointerup',{bubbles:true,pointerId:21,clientX:x+box.width*2/120}));
return true;
})()`);
await sleep(100);
assert.deepEqual(await evaluate(`(() => {
const k=cljs.core.keyword,v=cljs.core.vector;
const c=arthur.footage.store.entry(cljs.core.get(cljs.core.deref(re_frame.db.app_db),k('clip/current')));
return cljs.core.clj__GT_js(cljs.core.sort(cljs.core.keys(cljs.core.get_in(c,
v(k('clip'),k('symbols'),k('main'),k('nodes'),k('a'),k('channels'),v(k('xform'),k('pos')),k('keys'))))));
})()`), [4,6], 'drag moves both selected keys without losing colliding source frames');
await evaluate(`document.activeElement.dispatchEvent(new KeyboardEvent('keydown',{key:'ArrowRight',bubbles:true}))`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 2);
await evaluate(`document.activeElement.dispatchEvent(new KeyboardEvent('keydown',{key:'Delete',bubbles:true}))`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key").length'), 0);
assert((await shot()).symbols.main.nodes.a, 'deleting keys preserves their node');
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(cljs.core.keyword('arthur.events.history/undo')))`);
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(cljs.core.keyword('arthur.events.history/undo')))`);
await sleep(100);
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(cljs.core.keyword('arthur.events.history/undo')))`);
await sleep(100);
assert.deepEqual(await shot(), initial, 'key dragging, nudge and delete undo independently');
await evaluate(`(() => {
const k=cljs.core.keyword,v=cljs.core.vector;
const a=v(k('node'),k('main'),k('a'),v(k('a'))),b=v(k('node'),k('main'),k('b'),v(k('b')));
re_frame.core.dispatch_sync(v(k('arthur.events.ui/select-many'),v(a,b)));
arthur.ui.drag.row_BANG_(v(k('a')),k('rect'),a,v(a,b));
const row=[...document.querySelectorAll('.tl-label')].find(x=>x.textContent.includes('box'));
const r=row.getBoundingClientRect();
row.dispatchEvent(new DragEvent('drop',{bubbles:true,clientY:r.top+r.height/2,dataTransfer:new DataTransfer()}));
return true;
})()`);
await sleep(150);
const moved=await shot();
assert(moved.symbols.box.nodes.a && moved.symbols.box.nodes.b, 'row drop reparents the entire group');
assert.equal(moved.symbols.box.nodes.b.time.at, 4);
assert(!moved.symbols.main.nodes.a && !moved.symbols.main.nodes.b);
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(cljs.core.keyword('arthur.events.history/undo')))`);
await sleep(100);
assert.deepEqual(await shot(), initial, 'group reparenting is one undo step');
await evaluate(`(() => {
const rows=[...document.querySelectorAll('.tl-label')].filter(x=>x.querySelector('.tl-delete') || /box|rect/.test(x.textContent));
rows[0].dispatchEvent(new MouseEvent('click',{bubbles:true}));
rows.at(-1).dispatchEvent(new MouseEvent('click',{bubbles:true,shiftKey:true}));
})()`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.on").length'), 3, 'Shift selects the intervening row headers');
await evaluate(`document.querySelectorAll('.tl-label.on')[1].dispatchEvent(new MouseEvent('click',{bubbles:true,metaKey:true}))`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.on").length'), 2, 'Command toggles just one row');
await evaluate(`(() => {
const k=cljs.core.keyword,v=cljs.core.vector,m=cljs.core.hash_map;
let c=cljs.core.get(arthur.footage.store.entry(cljs.core.get(cljs.core.deref(re_frame.db.app_db),k('clip/current'))),k('clip'));
c=cljs.core.assoc_in(c,v(k('symbols'),k('main'),k('nodes'),k('a'),k('channels'),v(k('xform'),k('scale'))),
arthur.domain.channel.keyed(m(2,v(1,1),4,v(2,2)),k('linear')));
const id=arthur.footage.store.install_BANG_(m(k('clip'),c,k('store'),m()),'selection-browser');
cljs.core.swap_BANG_(re_frame.db.app_db,db=>cljs.core.assoc(db,k('clip/current'),id,k('ui'),
m(k('open'),k('main'),k('expanded'),cljs.core.hash_set(v(k('a'))))));
})()`);
await sleep(200);
await evaluate(`(() => {
const tracks=document.querySelector('.tl-tracks');
const rows=[...tracks.querySelectorAll('.tl-track')].filter(x=>x.querySelectorAll('button.tl-key').length===2);
const first=rows[0], last=rows[1], b=first.getBoundingClientRect(), end=last.getBoundingClientRect();
first.dispatchEvent(new PointerEvent('pointerdown',{bubbles:true,pointerId:50,clientX:b.left+1,clientY:b.top+1}));
tracks.dispatchEvent(new PointerEvent('pointermove',{bubbles:true,pointerId:50,clientX:b.left+b.width*6/120,clientY:end.bottom-1}));
tracks.dispatchEvent(new PointerEvent('pointerup',{bubbles:true,pointerId:50,clientX:b.left+b.width*6/120,clientY:end.bottom-1}));
})()`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 4, 'marquee selects keys across both automation rows');
await evaluate(`document.querySelector('.tl-tracks').dispatchEvent(new KeyboardEvent('keydown',{key:'ArrowRight',bubbles:true}))`);
await sleep(100);
assert.deepEqual(await evaluate(`(() => {
const k=cljs.core.keyword,v=cljs.core.vector;
const c=arthur.footage.store.entry(cljs.core.get(cljs.core.deref(re_frame.db.app_db),k('clip/current')));
return ['pos','scale'].map(channel=>cljs.core.clj__GT_js(cljs.core.sort(cljs.core.keys(cljs.core.get_in(c,
v(k('clip'),k('symbols'),k('main'),k('nodes'),k('a'),k('channels'),v(k('xform'),k(channel)),k('keys')))))));
})()`), [[3,5],[3,5]], 'marquee selection nudges keys in both automations together');
await evaluate(`document.querySelector('.tl-tracks').dispatchEvent(new KeyboardEvent('keydown',{key:'Escape',bubbles:true}))`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 0);
await evaluate(`(() => {
const rows=[...document.querySelectorAll('.tl-track')].filter(x=>x.querySelectorAll('button.tl-key').length===2);
const a=rows[0].querySelector('button.tl-key'), b=rows[1].querySelectorAll('button.tl-key')[1];
for (const [key,shift] of [[a,false],[b,true]]) {
const box=key.getBoundingClientRect();
for (const type of ['pointerdown','pointerup']) key.dispatchEvent(new PointerEvent(type,{bubbles:true,pointerId:70,clientX:box.left,clientY:box.top,shiftKey:shift}));
}
})()`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 4, 'Shift-click selects a range across automation rows');
await evaluate(`(() => {
const key=[...document.querySelectorAll('.tl-track')].filter(x=>x.querySelectorAll('button.tl-key').length===2)[1].querySelectorAll('button.tl-key')[1];
const box=key.getBoundingClientRect();
for (const type of ['pointerdown','pointerup']) key.dispatchEvent(new PointerEvent(type,{bubbles:true,pointerId:71,clientX:box.left,metaKey:true}));
})()`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 3, 'Command-click toggles one channel key');
await evaluate(`document.querySelector('.tl-tracks').dispatchEvent(new KeyboardEvent('keydown',{key:'a',metaKey:true,bubbles:true}))`);
await sleep(100);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'), 4, 'Command-A selects all visible keyframes');
await evaluate(`(() => {
const k=cljs.core.keyword,v=cljs.core.vector,m=cljs.core.hash_map;
let c=cljs.core.get(arthur.footage.store.entry(cljs.core.get(cljs.core.deref(re_frame.db.app_db),k('clip/current'))),k('clip'));
let keys=m();
for(let i=0;i<1000;i++) keys=cljs.core.assoc(keys,i,v(i,0));
for(const channel of ['pos','scale']) c=cljs.core.assoc_in(c,v(k('symbols'),k('main'),k('nodes'),k('a'),k('channels'),v(k('xform'),k(channel))),arthur.domain.channel.keyed(keys,k('linear')));
c=cljs.core.assoc_in(c,v(k('symbols'),k('main'),k('frames')),1200);
const id=arthur.footage.store.install_BANG_(m(k('clip'),c,k('store'),m()),'large-selection-browser');
cljs.core.swap_BANG_(re_frame.db.app_db,db=>cljs.core.assoc(db,k('clip/current'),id));
})()`);
await sleep(300);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key").length'),2000);
await evaluate(`(() => {
window.shiftCalls=0;
window.originalShifted=arthur.domain.keyframes.shifted;
arthur.domain.keyframes.shifted=(...args)=>{window.shiftCalls++;return window.originalShifted(...args);};
document.querySelector('.tl-tracks').dispatchEvent(new KeyboardEvent('keydown',{key:'a',metaKey:true,bubbles:true}));
})()`);
await sleep(150);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'),2000);
assert.equal(await evaluate('window.shiftCalls'),0,'selection performs no group shift calculations per marker');
await evaluate(`(() => {
const key=document.querySelector('button.tl-key'), b=key.parentElement.getBoundingClientRect();
key.dispatchEvent(new PointerEvent('pointerdown',{bubbles:true,pointerId:90,clientX:b.left}));
key.dispatchEvent(new PointerEvent('pointermove',{bubbles:true,pointerId:90,clientX:b.left+b.width*2/1200}));
})()`);
await sleep(150);
assert.equal(await evaluate('window.shiftCalls'),1,'large group drag computes shifted positions once for all 2000 markers');
await evaluate(`(() => {
const key=document.querySelector('button.tl-key');
key.dispatchEvent(new PointerEvent('pointerup',{bubbles:true,pointerId:90}));
arthur.domain.keyframes.shifted=window.originalShifted;
const k=cljs.core.keyword,v=cljs.core.vector;
const c=arthur.footage.store.entry(cljs.core.get(cljs.core.deref(re_frame.db.app_db),k('clip/current')));
return cljs.core.clj__GT_js(cljs.core.sort(cljs.core.keys(cljs.core.get_in(c,
v(k('clip'),k('symbols'),k('main'),k('nodes'),k('a'),k('channels'),v(k('xform'),k('pos')),k('keys'))))));
})()`).then(keys=>assert.equal(keys[0],2,'drop commits before the pointerup handler returns'));
await sleep(150);
assert.equal(await evaluate('document.querySelectorAll("button.tl-key.selected").length'),2000,'drop preserves the entire large selection');
assert.equal(await evaluate('[...document.querySelectorAll("button.tl-key")].filter(el=>el.style.transform).length'),0,'committed keys replace the preview without leftover transforms');
assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: passive overview ticks; automation editing, group edits, undo, and 2000-key selection performance');
} finally {
if (ws?.readyState === WebSocket.OPEN) ws.close();
chrome.kill('SIGTERM');
await Promise.race([
new Promise(resolve => chrome.once('exit', resolve)),
sleep(2000).then(() => { if (chrome.exitCode === null) chrome.kill('SIGKILL'); }),
]);
try {
rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 });
} catch (error) {
if (error.code !== 'ENOTEMPTY') throw error;
}
}

View file

@ -0,0 +1,148 @@
// Browser smoke test for onion controls and rendered ghost pixels.
// Uses an in-memory fixture and performs no server-side writes.
import { spawn } from 'node:child_process';
import { mkdtempSync, rmSync } from 'node:fs';
import { tmpdir } from 'node:os';
import { join } from 'node:path';
import assert from 'node:assert/strict';
const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/';
const profile = mkdtempSync(join(tmpdir(), 'arthur-onion-'));
const port = 9337;
const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
'--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run',
'--no-default-browser-check', '--mute-audio', '--window-size=1440,1000',
`--user-data-dir=${profile}`, `--remote-debugging-port=${port}`, url,
], { stdio: 'ignore' });
const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));
let ws;
try {
let target;
for (let i = 0; i < 100 && !target; i++) {
await sleep(100);
try {
target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json()))
.find(t => t.type === 'page' && t.url.startsWith(url));
} catch { /* 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 = [];
ws.onmessage = ({ data }) => {
const msg = JSON.parse(data);
if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails);
if (msg.id && pending.has(msg.id)) {
const waiting = pending.get(msg.id);
pending.delete(msg.id);
if (msg.error) waiting.reject(new Error(JSON.stringify(msg.error)));
else waiting.resolve(msg.result);
}
};
const send = (method, params = {}) => new Promise((resolve, reject) => {
const id = ++serial;
pending.set(id, { resolve, reject });
ws.send(JSON.stringify({ id, method, params }));
});
const evaluate = async expression => {
const 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" && !!document.querySelector("canvas.stage")')) break;
await sleep(100);
}
await evaluate(`(() => {
const k = cljs.core.keyword;
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test')));
window.laneSnapshot = () => {
const db = cljs.core.deref(re_frame.db.app_db);
return cljs.core.clj__GT_js(arthur.footage.store.entry(cljs.core.get(db, k('clip/current'))));
};
return true;
})()`);
await sleep(250);
assert.equal(await evaluate(`getComputedStyle(document.querySelector('.onion-controls summary')).listStyleType`), 'none');
assert.equal(await evaluate(`document.querySelector('.onion-controls summary').textContent`), '▾');
await evaluate(`document.querySelector('.onion-controls > button').click()`);
await sleep(150);
assert.equal(await evaluate(`document.querySelector('.onion-controls > button').getAttribute('aria-pressed')`), 'true');
await evaluate(`document.querySelector('.onion-controls summary').click()`);
await sleep(100);
assert.equal(await evaluate(`document.querySelector('.onion-controls details').open`), true);
await evaluate(`(() => {
const c = cljs.core, k = c.keyword, m = (...xs) => c.hash_map(...xs), v = (...xs) => c.vector(...xs);
const db = c.deref(re_frame.db.app_db);
const entry = arthur.footage.store.entry(c.get(db, k('clip/current')));
const base = c.get(entry, k('clip'));
const cel = (id, drawing, at) => m(k('id'), k(id), k('kind'), k('instance'), k('z'), id,
k('source'), m(k('symbol'), k(drawing)), k('span'), v(0, 2),
k('time'), m(k('at'), at, k('rate'), 1),
k('playback'), m(k('in'), 0, k('speed'), 0, k('end'), k('stop')));
const drawing = (id, x) => m(k('id'), k(id), k('frames'), 1, k('nodes'),
m(k('mark'), m(k('id'), k('mark'), k('kind'), k('rect'), k('z'), 'a',
k('channels'), m(v(k('style'), k('color')), arthur.domain.channel.framed(1), v(k('geom'), k('size')), arthur.domain.channel.framed(6),
v(k('xform'), k('pos')), arthur.domain.channel.framed(v(x, 10))))));
const symbols = m(k('main'), m(k('id'), k('main'), k('frames'), 6, k('display'), k('lane'),
k('nodes'), m(k('a'), cel('a','ink-a',0), k('b'), cel('b','ink-b',2), k('c'), cel('c','ink-c',4))),
k('ink-a'), drawing('ink-a',10), k('ink-b'), drawing('ink-b',20), k('ink-c'), drawing('ink-c',30));
const doc = c.assoc(base, k('symbols'), symbols);
const id = arthur.footage.store.install_BANG_(c.assoc(entry,k('clip'),doc),'onion-test');
c.swap_BANG_(re_frame.db.app_db, db => {
db = c.assoc(db,k('clip/current'),id);
db = c.assoc_in(db,v(k('ui'),k('open')),k('main'));
db = c.assoc_in(db,v(k('ui'),k('solo')),c.hash_map());
db = c.assoc_in(db,v(k('playback'),k('frame')),2);
db = c.assoc_in(db,v(k('playback'),k('playing?')),false);
return db;
});
re_frame.core.dispatch_sync(v(k('arthur.ui.layout/onion'),k('on?'),true));
arthur.ui.player.refresh_subs_BANG_();
return true;
})()`);
await sleep(300);
const pixels = await evaluate(`(() => {
const ctx = document.querySelector('canvas.onion-skin').getContext('2d');
return [10,20,30].map(x => Array.from(ctx.getImageData(x,10,1,1).data));
})()`);
assert(pixels[0][0] > pixels[0][2] && pixels[0][3] > 0, 'previous cel is red');
assert.equal(pixels[1][3], 0, 'current cel is excluded');
assert(pixels[2][2] > pixels[2][0] && pixels[2][3] > 0, 'next cel is blue');
const playbackAlpha = await evaluate(`(() => {
const c=cljs.core, k=c.keyword;
c.swap_BANG_(re_frame.db.app_db, db => c.assoc_in(db,c.vector(k('playback'),k('playing?')),true));
arthur.ui.player.refresh_subs_BANG_();
arthur.ui.player.paint_BANG_(2);
return document.querySelector('canvas.onion-skin').getContext('2d').getImageData(10,10,1,1).data[3];
})()`);
assert.equal(playbackAlpha, 0, 'ghosts clear during playback');
const preferences = await evaluate(`(() => {
const c=cljs.core,k=c.keyword, read=()=>c.get(c.deref(re_frame.core.subscribe(c.vector(k('arthur.ui.layout/onion')))),k('on?'));
c.swap_BANG_(re_frame.db.app_db,db=>c.assoc_in(db,c.vector(k('ui'),k('open')),k('ink-a')));
const other = read();
c.swap_BANG_(re_frame.db.app_db,db=>c.assoc_in(db,c.vector(k('ui'),k('open')),k('main')));
return [other,read()];
})()`);
assert.deepEqual(preferences, [false,true], 'preferences are remembered per symbol');
assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: onion controls, ghost colors, current-cel exclusion, playback hiding, per-symbol preferences');
} finally {
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) {
if (error.code !== 'ENOTEMPTY') throw error;
}
}

View file

@ -778,7 +778,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.tab:hover .close, .tab.on .close { visibility: visible; } .tab:hover .close, .tab.on .close { visibility: visible; }
.tab .close:hover { background: var(--hair); color: var(--fg); } .tab .close:hover { background: var(--hair); color: var(--fg); }
.palette-bar { .options-bar {
display: flex; display: flex;
align-items: center; align-items: center;
gap: 9px; gap: 9px;
@ -874,10 +874,19 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.stage { display: block; background: var(--stage); } .stage { display: block; background: var(--stage); }
.paint-overlay { position: absolute; inset: 0; touch-action: none; } .paint-overlay { position: absolute; inset: 0; touch-action: none; }
.stage-overlay-wrap {
position: absolute;
left: -100%; top: -100%;
width: 300%; height: 300%;
}
.stage-shade {
position: absolute;
inset: 0;
pointer-events: none;
outline: 1px solid #aaa;
}
/* The footage traced over: a reference above the picture, never part of it. */ /* The footage traced over: a reference above the picture, never part of it. */
.underlay { position: absolute; inset: 0; pointer-events: none; } .tracing { position: absolute; inset: 0; pointer-events: none; }
.paint-overlay.drawing { cursor: crosshair; }
.paint-overlay circle { cursor: grab; }
/* Where a drag out of the pool would land. Dashed and unfilled, so it reads as /* Where a drag out of the pool would land. Dashed and unfilled, so it reads as
"not there yet" over whatever is already drawn. */ "not there yet" over whatever is already drawn. */
@ -1176,6 +1185,12 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
/* A sound's bar, told apart from the picture's at a glance. */ /* A sound's bar, told apart from the picture's at a glance. */
.tl-span.sound { background: #e3efdf; border-color: #a6c49b; } .tl-span.sound { background: #e3efdf; border-color: #a6c49b; }
/* A tracing layer is a reference, never exported: hatched and dashed so it
cannot be read as a drawing. */
.tl-span.trace, .tl-cel.trace {
background: repeating-linear-gradient(135deg, transparent 0 4px, rgba(0, 0, 0, 0.07) 4px 8px);
border: 1px dashed var(--span-line);
}
.pool-item .thumb.sound { display: flex; align-items: center; justify-content: center; color: #d9d9d9; } .pool-item .thumb.sound { display: flex; align-items: center; justify-content: center; color: #d9d9d9; }
/* The span the node exists over. Drawn under the keys so a dot on the first /* The span the node exists over. Drawn under the keys so a dot on the first
@ -1270,15 +1285,16 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
} }
.tl-label.ghost { color: var(--sel); font-style: italic; } .tl-label.ghost { color: var(--sel); font-style: italic; }
/* Flash's keyframe: a filled dot. */ /* Passive animation ticks leave the clip underneath available to grab. */
.tl-key { .tl-key {
position: absolute; position: absolute;
top: 50%; top: 50%;
width: 7px; width: 2px;
height: 7px; height: 6px;
margin: -3.5px 0 0 -3.5px; margin: -3px 0 0 -1px;
background: var(--key); background: var(--key);
border-radius: 50%; opacity: 0.5;
border-radius: 1px;
/* So grabbing a dot grabs the bar under it. */ /* So grabbing a dot grabs the bar under it. */
pointer-events: none; pointer-events: none;
} }
@ -1416,6 +1432,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
rotates with the node and the tag does not. Sizes are in user units because rotates with the node and the tag does not. Sizes are in user units because
this SVG's viewBox is the stage's 320x200 scaled by `zoom`. */ this SVG's viewBox is the stage's 320x200 scaled by `zoom`. */
.paint-overlay .creation-target { pointer-events: none; } .paint-overlay .creation-target { pointer-events: none; }
.paint-overlay .selected-paint-outline { fill: none; stroke: #fbbf24; stroke-width: 0.8; vector-effect: non-scaling-stroke; pointer-events: none; }
.paint-overlay .creation-target .creation-target-box { fill: none; stroke: var(--target-stage); stroke-width: 0.7; } .paint-overlay .creation-target .creation-target-box { fill: none; stroke: var(--target-stage); stroke-width: 0.7; }
.paint-overlay .creation-target .creation-target-tag-bg { fill: var(--target-stage); } .paint-overlay .creation-target .creation-target-tag-bg { fill: var(--target-stage); }
.paint-overlay .creation-target .creation-target-tag { .paint-overlay .creation-target .creation-target-tag {
@ -1526,8 +1543,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.stage-area { padding: 5px; } .stage-area { padding: 5px; }
/* Touch targets, in the strips that are all buttons. */ /* Touch targets, in the strips that are all buttons. */
.pane-head, .palette-bar { gap: 7px; } .pane-head, .options-bar { gap: 7px; }
.palette-bar button, .pane-head button, .top button { min-height: 24px; } .options-bar button, .pane-head button, .top button { min-height: 24px; }
/* A STRIP OF CONTROLS SCROLLS AS A STRIP. Flexbox's instinct when a row does /* A STRIP OF CONTROLS SCROLLS AS A STRIP. Flexbox's instinct when a row does
not fit is to shrink every item and then push the last ones off the end — not fit is to shrink every item and then push the last ones off the end —
@ -1536,17 +1553,206 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
So nothing shrinks, nothing wraps, and each strip scrolls. The `.spacer` So nothing shrinks, nothing wraps, and each strip scrolls. The `.spacer`
and `.status` rules above still win on specificity, which is what keeps the and `.status` rules above still win on specificity, which is what keeps the
right-hand groups right-hand while there IS room. */ right-hand groups right-hand while there IS room. */
.top > *, .pane-head > *, .palette-bar > * { flex-shrink: 0; } .top > *, .pane-head > *, .options-bar > * { flex-shrink: 0; }
.top button, .pane-head button { white-space: nowrap; } .top button, .pane-head button { white-space: nowrap; }
.pane-head, .palette-bar { overflow-x: auto; } .pane-head, .options-bar { overflow-x: auto; }
/* The hints go first: the tool's name and its controls are what is needed. */
/* The one compressible thing in the palette bar is the swatches, so they .options-bar .hint { display: none; }
scroll inside their own share instead of taking it from the commands. The
tone's NAME goes: the ringed swatch already says which one is active, and
it is the widest thing in the bar that nothing is lost by dropping. */
.palette-bar .swatches { flex: 1 1 130px; min-width: 56px; overflow-x: auto; }
/* A swatch is a 15px circle or it is not a swatch: the strip scrolls, the
dots do not get thinner. */
.palette-bar .swatches > * { flex-shrink: 0; }
.palette-bar > .dim { display: none; }
} }
/* --------------------------------------------------------------------------
the tools: a strip down the left of the stage, an options bar above it.
Photoshop's arrangement, which Illustrator and Flash share. The palette is a
grid in the strip under the tools, as Deluxe Paint's and Animator Pro's were:
a fixed table of slots, shown as one. */
.options-bar {
gap: 8px;
min-height: 29px;
padding: 3px 8px;
}
.options-bar .tool-name { font-weight: 600; min-width: 46px; }
.options-bar .hint { overflow: hidden; text-overflow: ellipsis; white-space: nowrap; min-width: 0; flex: 0 1 auto; }
.options-bar .spacer { flex: 1; }
.option { display: flex; align-items: center; gap: 6px; color: var(--dim); white-space: nowrap; }
.option input[type="range"] { width: 110px; }
.option .value { color: var(--fg); min-width: 30px; font-variant-numeric: tabular-nums; }
.palette-assets { display: flex; align-items: center; gap: 3px; }
.workspace { flex: 1; min-height: 0; display: flex; }
.workspace > .stage-area { flex: 1; min-width: 0; position: relative; }
.toolbox {
flex: 0 0 52px;
display: flex;
flex-direction: column;
align-items: center;
gap: 10px;
padding: 7px 0;
background: var(--chrome);
border-right: 1px solid var(--line);
overflow-y: auto;
}
.tools { display: grid; gap: 2px; }
.tool {
width: 34px; height: 30px;
display: grid; place-items: center;
padding: 0;
border: 1px solid transparent;
border-radius: 4px;
background: none;
color: var(--fg);
}
.tool:hover { background: var(--sunk); border-color: var(--hair); }
.tool.on { background: var(--sel-bg); border-color: var(--sel); color: var(--sel); }
.tool svg { fill: currentColor; stroke: none; }
.tool svg .cut { fill: none; stroke: var(--chrome); stroke-width: 1.2; }
.tool.on svg .cut { stroke: var(--sel-bg); }
.palette { display: grid; gap: 7px; justify-items: center; padding-top: 9px; border-top: 1px solid var(--hair); }
/* The colour a new shape gets: Photoshop's foreground chip. */
.palette .chip {
width: 36px; height: 36px;
display: grid; place-items: end start;
border: 1px solid var(--fg);
border-radius: 3px;
box-shadow: inset 0 0 0 2px var(--pane);
}
.palette .chip span {
margin: 0 0 2px 3px; padding: 0 3px;
border-radius: 2px;
background: rgba(255, 255, 255, .85);
color: var(--fg); font-size: 9px; line-height: 12px;
}
.palette .cells { display: grid; grid-template-columns: repeat(2, 17px); gap: 2px; }
.palette .slot { display: contents; }
.palette .cell {
width: 17px; height: 17px;
padding: 0;
border: 1px solid rgba(0, 0, 0, .35);
border-radius: 2px;
cursor: pointer;
}
.palette .cell:hover { border-color: var(--fg); transform: scale(1.12); }
.palette .cell.on { border-color: var(--fg); box-shadow: 0 0 0 1px var(--pane), 0 0 0 2px var(--sel); position: relative; z-index: 1; }
/* Clear is no colour: a knockout. Checkered, as transparency is everywhere. */
.palette .clear,
.palette .chip.clear {
background-color: #fff;
background-image:
linear-gradient(45deg, #c9c9c5 25%, transparent 25%, transparent 75%, #c9c9c5 75%),
linear-gradient(45deg, #c9c9c5 25%, transparent 25%, transparent 75%, #c9c9c5 75%);
background-size: 8px 8px;
background-position: 0 0, 4px 4px;
}
.palette .cell.clear { grid-column: span 2; width: 36px; }
/* --------------------------------------------------------------------------
on the stage: the tools' marks, in stage pixels (the SVG's viewBox), and their
cursors. Hairlines, so the pixels under them can be judged. */
.paint-overlay.tool-pen {
cursor: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' width='22' height='22'%3E%3Cpath d='M2 2 L9 5 L14 11 L11 14 L5 9 Z' fill='%23111' stroke='%23fff' stroke-width='1.2' stroke-linejoin='round'/%3E%3Cpath d='M2 2 L7 7' stroke='%23fff' stroke-width='1'/%3E%3C/svg%3E") 2 2, crosshair;
}
.paint-overlay.tool-pen.closing {
cursor: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' width='22' height='22'%3E%3Cpath d='M2 2 L9 5 L14 11 L11 14 L5 9 Z' fill='%23111' stroke='%23fff' stroke-width='1.2' stroke-linejoin='round'/%3E%3Ccircle cx='17' cy='17' r='3' fill='none' stroke='%23111' stroke-width='1.6'/%3E%3Ccircle cx='17' cy='17' r='3' fill='none' stroke='%23fff' stroke-width='.6'/%3E%3C/svg%3E") 2 2, crosshair;
}
.paint-overlay.tool-brush, .paint-overlay.tool-eraser { cursor: none; }
.paint-overlay .footprint { fill: none; stroke: #fff1be; stroke-width: 0.5; vector-effect: non-scaling-stroke; pointer-events: none; }
.paint-overlay .footprint.eraser { stroke-dasharray: 3 2; }
.paint-overlay .draft polyline { fill: none; stroke: #fff1be; stroke-width: 1; vector-effect: non-scaling-stroke; pointer-events: none; }
.paint-overlay .draft .first { fill: #161820; stroke: #fff1be; stroke-width: 0.5; pointer-events: none; }
.paint-overlay .draft .first.closing { fill: #fff1be; r: 2.6; }
.paint-overlay .points .outline { fill: none; stroke: #fff1be; stroke-width: 1; stroke-opacity: .55; vector-effect: non-scaling-stroke; pointer-events: none; }
.paint-overlay .points .vertex { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: move; }
.paint-overlay .points .vertex:hover { fill: #fff; r: 2.4; }
.paint-overlay .points .insert { fill: #161820; stroke: #fff1be; stroke-width: 0.5; pointer-events: none; }
/* Blender's Adjust Last Operation: the last stroke's settings, in the corner of
the view it was made in, until something else is done. */
.adjust-last {
position: absolute;
left: 10px; bottom: 10px;
display: flex; align-items: center; gap: 10px;
padding: 5px 9px;
background: var(--pane);
border: 1px solid var(--line);
border-radius: 4px;
box-shadow: 0 2px 8px rgba(0, 0, 0, .25);
}
/* Remap: the map swatch, and the inspector's grid for a remap shape. A slot is
shown as what is under the shape will be drawn in; the original is the chip
in its corner. */
.palette .cell.map,
.palette .chip.map {
background: linear-gradient(135deg, #3a3f52 0 50%, #e8d9a8 50% 100%);
color: #fff; font-size: 11px; line-height: 1; text-shadow: 0 1px 1px rgba(0, 0, 0, .6);
}
.palette .cell.map { grid-column: span 2; width: 36px; }
.palette .cell { position: relative; }
.palette .cell .badge {
position: absolute; right: -2px; bottom: -2px;
width: 7px; height: 7px;
border: 1px solid var(--pane); border-radius: 50%;
}
.remap-head { display: flex; align-items: center; gap: 6px; margin-bottom: 6px; }
.remap, .remap-pick { display: grid; grid-template-columns: repeat(8, 22px); gap: 3px; }
.remap-pick { margin-top: 7px; padding-top: 7px; border-top: 1px solid var(--hair); }
.remap-pick > .dim { grid-column: 1 / -1; }
.remap .cell, .remap-pick .cell {
position: relative;
width: 22px; height: 22px;
padding: 0;
border: 1px solid rgba(0, 0, 0, .35);
border-radius: 3px;
cursor: pointer;
}
.remap .cell:hover, .remap-pick .cell:hover { border-color: var(--fg); }
.remap .cell.on, .remap-pick .cell.on { box-shadow: 0 0 0 1px var(--pane), 0 0 0 2px var(--sel); }
.remap .cell.mapped i {
position: absolute; left: 2px; top: 2px;
width: 8px; height: 8px;
border: 1px solid rgba(255, 255, 255, .8);
border-radius: 2px;
}
/* Palette assets stay in the existing narrow tool strip. */
.toolbox .palette-assets { display: block; width: 44px; flex: 0 0 auto; }
.palette-assets summary { cursor: pointer; font-size: 10px; line-height: 1.25; overflow-wrap: anywhere; padding: 3px; }
.palette-popout, .view-popout { position: fixed; z-index: 100; background: var(--pane); color: var(--fg); border: 1px solid var(--line); padding: 10px; box-shadow: 0 4px 16px #0008; line-height: 1.4; }
.palette-popout { left: 52px; width: 230px; display: flex; flex-wrap: wrap; gap: 7px; }
.palette-popout strong { width: 100%; overflow-wrap: anywhere; }
.palette-popout select { width: 100%; }
.view-popout { right: 16px; width: 240px; }
.view-popout label { display: block; margin-bottom: 8px; }
.view-popout input { width: 100%; }
.passepartout-controls summary { cursor: pointer; }
.stage-wrap { flex: 0 0 auto; }
.onion-skin { position: absolute; inset: 0; pointer-events: none; image-rendering: pixelated; }
.onion-controls { display: inline-flex; align-items: center; }
.onion-controls > button { border-radius: 2px 0 0 2px; }
.onion-controls summary {
display: block; cursor: pointer; list-style: none;
color: var(--fg); background: var(--pane); border: 1px solid var(--line);
border-radius: 0 2px 2px 0; margin-left: -1px; padding: 1px 5px;
}
.onion-controls summary:hover, .onion-controls details[open] > summary { background: #fff; }
.onion-controls summary::-webkit-details-marker { display: none; }
.onion-controls .view-popout { line-height: 1.4; }
.onion-controls select { width: 100%; }
/* Expanded automation lanes expose editable keyframe dots. */
button.tl-key { pointer-events: auto; padding: 0; border: 0; width: 11px; height: 11px; margin: -5.5px; cursor: ew-resize; z-index: 4; opacity: 1; border-radius: 50%; }
button.tl-key.selected { background: var(--pick); box-shadow: 0 0 0 2px var(--pick); }