Compare commits

...

26 commits

Author SHA1 Message Date
Olive Vaughn
da7e293814 Solo an instance from its timeline row, shift-click for more than one
A nested mark is now named by the flat path its row has, [a b mark] rather
than [a [b mark]], so a soloed row is a prefix of what it shows.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:44:24 -04:00
Olive Vaughn
7aaf0a15bd Inspector number boxes edit as you type, and are one undo step per focus
The boxes wrote nothing until blur, so a spinner click showed nothing on
screen. Now every keystroke and step is an edit, and history holds the
step open from focus to blur, so typing 4 then 5 is seen as 4, then 45,
and undone once.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:35:52 -04:00
Olive Vaughn
277c0c3b63 Keep the timeline's ruler and playhead dot in view while its rows scroll
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:22:01 -04:00
Olive Vaughn
c139e4d747 Rename the project from the top bar; export from a dialog
The title is a button that becomes a field, saved on Enter or blur. Export's
target and scale move out of the bar into a dialog.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:12:08 -04:00
Olive Vaughn
0f9ce826ef Set the project's stage and rate, and give a symbol its own stage
The inspector edits the project's width, height and fps, and a symbol's length
and, optionally, its own width and height. A symbol without them follows the
project's (`clip/stage`); the stage, export and placement all read it.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:12:08 -04:00
Olive Vaughn
1ac21fdcab Brought-in footage plays at the project's rate
The new symbol gets project-rate frames covering the same wall-clock length,
and its root and sound map them back onto the source's frames.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:11:32 -04:00
Olive Vaughn
4b8123d5e2 Delete a timeline row with everything in it
Delete or Backspace, or the × on the selected row, takes the node out of its
symbol along with every node hanging off it. One edit, so undo brings it back.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:11:16 -04:00
Olive Vaughn
7246534505 Key a node's transform and visibility from the inspector
Each of vis, anchor, pos, rot, scale and skew is a row: ◆ keys the channel on
the node's own frame, or takes the key there off, and a typed value is written
on blur or Enter — a key on a keyed channel, the one value on one that is not.
Rotation reads in degrees. Dense and other channels keep their readout.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 01:11:16 -04:00
Olive Vaughn
38850a29ba Slide rows along time and restack them, at any depth
A node's bar drags along the timeline: one write to its :at, for every node
alike, carried down through the instances above it. The stage and rows show
the slide live through ::render/clip, and it lands as one edit on release.

A row dropped on another's top or bottom edge goes in front of it or behind:
one write to :z, between its new neighbours (symbol/z-between). Onto the edge
of a row in another symbol, it moves there first. Neither needs anything on
screen — nest/down walks a row path by structure, without a frame.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 00:51:34 -04:00
Olive Vaughn
1b8bbc7372 Edit shapes nested in other symbols, from any symbol above them
`nest/inside` walked a row path only through instances. Every node has
the same two maps to its parent, so the walk now steps into any node:
inside an instance is the symbol it places, inside a shape is where its
points and keys are. The selected shape at any depth is `inside` over
its full path, which gives the stage editor its handles (through the
matrix, drags back through the inverse) and the inspector the shape's
own frame to key at, and the time map back for jumping to a key.

`inside` resolves only the node's lineage: where a node is depends on
its parents and nothing else, and resolving the whole symbol cost more
than a stage frame (7.9ms against 3ms on the swarm; now 0.09ms).
Checked equal to the whole-symbol resolve on every node and frame of
the swarm, two instances deep.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-30 00:12:21 -04:00
Olive Vaughn
6a53adb5e0 Projects live at URLs, have owners, and are edited together live
A project is only ever at /p/<id>/<slug>; / is the index of the projects
you own or edit. Every project has an owner, who can name editors;
anyone with the link can view. Every edit saves itself, one request in
flight at a time, as a patch of the leaves that changed, and a websocket
(channels + daphne) carries presence and each committed write to
everyone else in the project. The first write to a leaf wins, and the
loser is told.

Undo is per person: a step undoes only if the leaves it touched still
hold what it left, so it never takes a collaborator's work with it.
Named snapshots replace saving, and restore as an ordinary write.

An empty symbol now survives the leaf round trip with `:nodes {}`.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 22:04:03 -04:00
Olive Vaughn
c17ee138f2 Split domain/clip along the data: clip, nest, bring
domain/clip is the document and what only needs the document: its symbol
table, placing, the resolver, problems. domain/nest is how nested symbols
relate — one walk down a row path gives the frame, the matrix and the time
map, which merges inside and time-down — and moving and grouping between
them, and nested sound. domain/bring is copying symbols in from another
clip, a take from footage, and one placed that merges the store and places
the instance, which conversion and import both now call instead of each
doing it in their own words. Tests follow the same split.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 14:11:41 -04:00
Olive Vaughn
7bb80d315d Bring in symbols from other projects; new and open send the clock home
Dropping a symbol out of the pool's all-assets folder fetches that project's
clip and the blocks it names, copies the symbol and everything it places in
through clip/adopt — renamed where ids collide — and places it where it was
dropped. It comes in as drawing: its tracking stays with the analysis that
measured it. New and open now seek the audio clock to 0 with the readout,
where play used to pick up wherever the last document's audio had got to.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:51:39 -04:00
Olive Vaughn
490460bf45 Drag timeline rows into symbols, into groups, and back out
A node's row can be dragged onto an instance's row, to go inside the symbol
it places; onto any other node's row, to be grouped with it into a new
symbol; or onto empty label space, to come back to the top of the open
symbol. All three keep the picture and the timing as they are, and a refused
move says why in the status line. Pool drop targets now only take things out
of the pool, and row drags set a move effect so the browser delivers the drop.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:50:34 -04:00
Olive Vaughn
eafbe6c4d2 One time map for every node; move and group nodes between symbols
Every node now has the same time map into its parent, local = rate·(parent
− at), with its span and keys in its own frames: what instances had, made the
rule. A shape without a time map reads as it always did, so no data changes.
The per-kind branches, the span-start term and the rate refusal are gone;
node/time-of, then-time and invert-time compose it like the matrix.

clip/move-node puts a node into another symbol without changing the picture
or the timing — its matrix becomes a :pinv, its time a new :at and :rate, and
its channels, keys and span are untouched — and clip/group makes a new symbol
around side-by-side nodes. Generated parts, split stencils, cycles and
looping instances are refused with the reason. Nested sounds use the same
map.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:45:34 -04:00
Olive Vaughn
6bec121108 Draw into the selected symbol
With an instance selected, a finished polygon goes into the symbol it places,
its points and frame carried in through clip/inside — which resolves each
level, so the frame and matrix are the ones the stage draws with — so the
shape lands exactly where it was drawn however the instance is moved, turned,
scaled or retimed. Beside any other selected node, or at the top of the open
symbol with nothing selected. clip/inside also replaces frame-inside for new
symbols, so there is one account of 'which frame is it in there'.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:35:06 -04:00
Olive Vaughn
1a42481575 An instance pivots about the middle of what its symbol draws
place-symbol sets a new instance's anchor to clip/center — the middle of the
bounds of everything the symbol draws over all its frames, or the stage's
middle for a symbol that draws nothing — and a stage drop puts that middle
under the pointer. The anchor is set once and never follows the symbol, as
Flash's transformation point and After Effects' anchor point do, so a symbol
that grows later moves nothing on screen. The drop preview marks the pivot.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:32:52 -04:00
Olive Vaughn
41b4bdf110 Make a symbol from a dropped video
Dropping footage on the stage or the timeline asks which frames and what name:
a dialog plays the video with start and end handles that seek it. Detection
runs on that range only (decoding stops at the end, frames before the start
are skipped) and the range is part of the analysis address, so a partial
analysis is never served as a whole one. The frozen take comes in as one
named symbol, carrying its sound as an audio node, placed where it was
dropped; tracking and tuning come with it when the document has no analysis
of its own.

clip/adopt copies symbols between documents, renaming ids that collide, and
clip/audio-tracks carries sounds out of nested instances so a placed symbol
is heard where it is placed.

Fixes the stage going blank after a conversion: ::store recomputed only when
the clip id changed, so blocks merged into the loaded entry were invisible to
the resolver. And the paint loop now schedules its next frame before
painting and reports a frame it cannot draw instead of stopping.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:21:08 -04:00
Olive Vaughn
270c5a4369 Version static URLs by mtime; flatter tabs
The stylesheet and bundle were served with Last-Modified only, so a browser
could pair new JavaScript with a stale app.css and render the tab strip and
thumbnails unstyled. Their URLs now carry the file's mtime. Tabs are flat on
the chrome with the open one underlined; the close button shows on hover.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:08:38 -04:00
Olive Vaughn
f590ff19cf Drag symbols onto the stage or the timeline, with previews
A symbol dragged out of the pool shows where it would land: on the stage, a
dashed outline of its first frame centred on the pointer, and on the timeline
a preview row of its own length. A stage drop places it at the playhead under
the pointer; a timeline drop places it at the frame under the pointer, in its
own coordinates. A drop that would make a cycle is refused while hovering.
Pool thumbnails are capped at 40x30.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 13:06:38 -04:00
Olive Vaughn
d5f044c6da Media pool: this project and all assets
This project lists every symbol in the document and the video it uses or was
given this session, each with a frame from its proxy as a thumbnail. All
assets lists every upload on the server and every other saved project's
symbols, from a new /api/symbols that reads symbol leaf paths. Every row is a
drag source (symbol:, import:, footage:). Uploading no longer runs straight
into detection; it lands in the project's media.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 12:59:17 -04:00
Olive Vaughn
c81f91c442 Tabs: open any symbol, and the clock follows it
Double-clicking a symbol in the pool, or an instance's row in the timeline,
opens it as a tab above the stage; the stage, the rows, the transport and new
shapes follow the open tab. Each tab gets a clock as long as it is: its own
mixed tracks, the document's audio for the symbol it opens on, or silence.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 12:54:58 -04:00
Olive Vaughn
6b41c6db94 An instance's span is in its own frames
A shape's :span stays in its parent's frames, but an instance's or a sound's
is now in its own: dropping a symbol at frame 97 gives it span 0 … length and
:at 97, so moving it along its parent is one write to :at. :time :in is gone
(it was the span's start written twice); node/placed-span maps an own-time
span out to the parent for playback, the mixer and the timeline rows, and
node/problems reports a stale :in.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 12:53:21 -04:00
Olive Vaughn
2d2eb0fc9f New empty symbol, nested in the selected instance or the open symbol
'+ symbol' in the timeline makes an empty symbol and places it at the
playhead: inside the selected instance, beside any other selected node, or in
the open symbol. Timeline selections carry their row path so a symbol placed
twice nests into the row that was clicked. Symbols gain a :name.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 12:49:46 -04:00
Olive Vaughn
5dff490162 Symbols, not timelines; no symbol is special
Everything that holds nodes is a symbol (domain/timeline -> domain/symbol,
:timelines -> :symbols) and a node that places one is :kind :instance. The
reserved :main root is gone: which symbol is on screen is editor state
([:ui :open]), every domain function that needs a symbol is told which, and
a document opens on the longest symbol nothing else places.

Saved projects move to schema 2 through migration 0007, which rewrites leaf
paths, instance kinds and the feature :symbol key; the client refuses a
schema it does not read.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 12:46:42 -04:00
Olive Vaughn
179770d7d4 Split the shell into topbar, pool, stage, timeline and params panes
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-29 12:25:46 -04:00
102 changed files with 8194 additions and 2209 deletions

View file

@ -40,4 +40,4 @@ RUN python manage.py collectstatic --noinput \
USER app
EXPOSE 8000
CMD ["sh", "-c", "python manage.py migrate --noinput && exec gunicorn server.wsgi:application --bind 0.0.0.0:8000 --workers 1 --threads 4 --timeout 120"]
CMD ["sh", "-c", "python manage.py migrate --noinput && exec daphne --bind 0.0.0.0 --port 8000 server.asgi:application"]

View file

@ -30,8 +30,8 @@ mise exec -- python manage.py migrate
./do start # Django + frontend watcher
```
In the app, upload a video, choose its footage, click **load frames**, then
**save**. Opening that project on another client reuses its saved landmarks and
In the app, drop a video on the media pool — it uploads, extracts and runs
detection — then **save**. Opening that project on another client reuses its saved landmarks and
mouth crops without detecting source frames again. The upload path derives its
footage response from database records; it does not create or consume a
`manifest.json` file. See [frontend/README.md](frontend/README.md) for details.

87
clips/consumers.py Normal file
View file

@ -0,0 +1,87 @@
"""One socket per open project, and it is tl's, nearly line for line.
Two things ride it. DELTAS, which the server sends after a write commits — the
socket is read-only for the document, and a dropped socket cannot lose a write.
PRESENCE, which peers gossip between themselves: all the server does is hand out
a connection id and stamp the sender's identity onto every message, so nobody can
post as somebody else.
"""
import json
import uuid
from asgiref.sync import async_to_sync
from channels.generic.websocket import AsyncWebsocketConsumer
from channels.layers import get_channel_layer
# Who is connected, per project: {group: {cid: presence}}. A cache of what has
# already been relayed, so a joiner gets the room in one message. Process-local,
# like the in-memory channel layer this runs on.
ROOMS = {}
def group(project_id):
return f"project_{project_id}"
def broadcast(project_id, delta, kind="delta"):
"""Send a committed write to everyone in the project's room. `access` says
only that who may write has changed, and each client asks for itself."""
async_to_sync(get_channel_layer().group_send)(
group(project_id), {"type": "project.delta", "delta": {"kind": kind, **delta}},
)
class ProjectConsumer(AsyncWebsocketConsumer):
RELAYED = ("state",)
@property
def room(self):
return ROOMS.setdefault(self.group, {})
async def connect(self):
self.group = group(self.scope["url_route"]["kwargs"]["project_id"])
self.cid = uuid.uuid4().hex[:12]
user = self.scope.get("user")
self.username = user.get_username() if user and user.is_authenticated else None
await self.channel_layer.group_add(self.group, self.channel_name)
await self.accept()
me = {"cid": self.cid, "user": self.username}
others = list(self.room.values())
self.room[self.cid] = me
await self.send(text_data=json.dumps({"kind": "welcome", **me}))
await self.send(text_data=json.dumps({"kind": "roster", "peers": others}))
await self._relay({"kind": "join"})
async def disconnect(self, code):
if hasattr(self, "cid"):
self.room.pop(self.cid, None)
if not self.room:
ROOMS.pop(self.group, None)
await self._relay({"kind": "leave"})
await self.channel_layer.group_discard(self.group, self.channel_name)
async def receive(self, text_data=None, bytes_data=None):
try:
msg = json.loads(text_data or "{}")
except ValueError:
return
if not isinstance(msg, dict) or msg.get("kind") not in self.RELAYED:
return
if self.cid in self.room:
self.room[self.cid].update(
{k: v for k, v in msg.items() if k not in ("kind", "cid", "user")}
)
await self._relay(msg)
async def _relay(self, msg):
await self.channel_layer.group_send(
self.group,
{"type": "peer.msg", "msg": {**msg, "cid": self.cid, "user": self.username}},
)
async def peer_msg(self, event):
await self.send(text_data=json.dumps(event["msg"]))
async def project_delta(self, event):
await self.send(text_data=json.dumps(event["delta"]))

View file

@ -0,0 +1,75 @@
"""Schema 2: a document holds symbols, not timelines, and no symbol is reserved.
Three renames, each in the stored transit and nowhere else:
clip/<cid>/timeline/... -> clip/<cid>/symbol/...
a node leaf's :kind :symbol -> :kind :instance
a feature leaf's :timeline key -> :symbol
A leaf value is transit's map form, ["^ ", k1, v1, k2, v2, ...]. Only TOP-LEVEL
pairs are rewritten, and only literal ones: transit caches a repeated keyword as
"^N", and a rename that met a cache reference where it expected the keyword would
be guessing. Every saved leaf at the time of writing had these as literals; if one
does not, the migration stops rather than writing a document that decodes to
something else.
Renaming a cached keyword in place is safe because the cache is positional: the
literal keeps its slot, so any later "^N" that referred to it now refers to the
new name, which is what it meant.
"""
import re
from django.db import migrations, models
PATH = re.compile(r"^(clip/[^/]+/)timeline(/|$)")
def _rename_pair(value, key, old, new, path):
if not (isinstance(value, list) and value[:1] == ["^ "]):
return value
out = list(value)
for i in range(1, len(out) - 1, 2):
if out[i] != key:
continue
if old is None:
out[i] = new
elif out[i + 1] == old:
out[i + 1] = new
elif isinstance(out[i + 1], str) and out[i + 1].startswith("^") and out[i + 1] != "^ ":
raise RuntimeError(f"leaf {path!r} has a cached {key} value; migrate it by hand")
return out
def forwards(apps, schema_editor):
Leaf = apps.get_model("clips", "Leaf")
Project = apps.get_model("clips", "Project")
for leaf in Leaf.objects.all():
path = PATH.sub(r"\1symbol\2", leaf.path)
value = leaf.value
parts = path.split("/")
if len(parts) == 6 and parts[2] == "symbol" and parts[4] == "node":
value = _rename_pair(value, "~:kind", "~:symbol", "~:instance", leaf.path)
if len(parts) == 4 and parts[2] == "feature":
value = _rename_pair(value, "~:timeline", None, "~:symbol", leaf.path)
if path != leaf.path or value != leaf.value:
leaf.path = path
leaf.value = value
leaf.version += 1
leaf.save(update_fields=["path", "value", "version"])
Project.objects.update(schema_version=2)
class Migration(migrations.Migration):
dependencies = [
("clips", "0006_project_schema_version"),
]
operations = [
migrations.AlterField(
model_name="project",
name="schema_version",
field=models.PositiveIntegerField(default=2),
),
migrations.RunPython(forwards, migrations.RunPython.noop),
]

View file

@ -0,0 +1,39 @@
from django.conf import settings
from django.db import migrations, models
import django.db.models.deletion
def orphans(apps, schema_editor):
# Every project has an owner, and none of the ones saved before owners did.
apps.get_model("clips", "Project").objects.all().delete()
class Migration(migrations.Migration):
dependencies = [
("clips", "0007_symbols_not_timelines"),
migrations.swappable_dependency(settings.AUTH_USER_MODEL),
]
operations = [
migrations.RunPython(orphans, migrations.RunPython.noop),
migrations.AddField(
model_name="leaf",
name="seq",
field=models.PositiveBigIntegerField(
default=0, help_text="the project seq of the write that last changed it"),
),
migrations.AddField(
model_name="project",
name="editors",
field=models.ManyToManyField(blank=True, related_name="shared_projects",
to=settings.AUTH_USER_MODEL),
),
migrations.AddField(
model_name="project",
name="owner",
field=models.ForeignKey(on_delete=django.db.models.deletion.CASCADE,
related_name="projects", to=settings.AUTH_USER_MODEL),
preserve_default=False,
),
]

View file

@ -0,0 +1,18 @@
# Generated by Django 5.2.17 on 2026-09-30 01:54
from django.db import migrations, models
class Migration(migrations.Migration):
dependencies = [
('clips', '0008_owners_editors_leaf_seq'),
]
operations = [
migrations.AddField(
model_name='revision',
name='blocks',
field=models.JSONField(default=dict, help_text="each clip's tier-2 block keys, by cid, so a restore can name them"),
),
]

View file

@ -24,7 +24,9 @@ without parsing its leaves: which footage, which analysis, which blocks.
"""
import uuid
from django.conf import settings
from django.db import models
from django.utils import timezone
class Blob(models.Model):
@ -201,12 +203,21 @@ class Project(models.Model):
`schema_version` identifies the stored document format. `seq` counts writes
to this particular project; it is not a format version. Every write bumps
`seq`, and a client that sees `seq > local + 1` refetches once broadcasts exist.
`seq`, and a client that sees `seq > local + 1` refetches.
ANYONE WITH THE LINK CAN VIEW; the owner and the editors can write. Every
project has an owner.
"""
id = models.UUIDField(primary_key=True, default=uuid.uuid4, editable=False)
owner = models.ForeignKey(
settings.AUTH_USER_MODEL, on_delete=models.CASCADE, related_name="projects",
)
editors = models.ManyToManyField(
settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects",
)
name = models.CharField(max_length=200, default="untitled")
schema_version = models.PositiveIntegerField(default=1)
schema_version = models.PositiveIntegerField(default=2)
seq = models.PositiveBigIntegerField(default=0)
palette = models.CharField(max_length=64, default="arthur/default")
created = models.DateTimeField(auto_now_add=True)
@ -219,10 +230,19 @@ class Project(models.Model):
return f"{self.name} ({self.id})"
def bump(self):
self.seq += 1
self.save(update_fields=["seq", "updated"])
"""The next seq, taken with an UPDATE so that inside a transaction it is
also the write lock: two concurrent saves cannot both get the same one."""
Project.objects.filter(id=self.id).update(
seq=models.F("seq") + 1, updated=timezone.now()
)
self.refresh_from_db(fields=["seq", "updated"])
return self.seq
def can_edit(self, user):
return user.is_authenticated and (
user.id == self.owner_id or self.editors.filter(id=user.id).exists()
)
class Clip(models.Model):
"""Tier 1: the unit of work, and the thing leaf paths are scoped by.
@ -271,6 +291,9 @@ class Leaf(models.Model):
path = models.CharField(max_length=300)
value = models.JSONField()
version = models.PositiveBigIntegerField(default=1)
seq = models.PositiveBigIntegerField(
default=0, help_text="the project seq of the write that last changed it",
)
updated = models.DateTimeField(auto_now=True)
class Meta:
@ -288,7 +311,9 @@ class Leaf(models.Model):
class Revision(models.Model):
"""Tier 1: a snapshot of the authored layer, with a user and a summary.
"""Tier 1: a snapshot of the authored layer, with a user and a summary — a
named snapshot, which is how a person marks a version now that every edit
saves itself.
ON AN EXPLICIT TRIGGER, not on every save. tl snapshots a small annotation
layer; arthur's tier 1 will contain cel polygons, so a snapshot per save bloats
@ -302,6 +327,9 @@ class Revision(models.Model):
author = models.CharField(max_length=200, blank=True)
summary = models.CharField(max_length=500, blank=True)
document = models.JSONField(help_text="every leaf of the project, by path")
blocks = models.JSONField(
default=dict, help_text="each clip's tier-2 block keys, by cid, so a restore can name them",
)
created = models.DateTimeField(auto_now_add=True)
class Meta:

7
clips/routing.py Normal file
View file

@ -0,0 +1,7 @@
from django.urls import path
from .consumers import ProjectConsumer
websocket_urlpatterns = [
path("ws/projects/<uuid:project_id>", ProjectConsumer.as_asgi()),
]

View file

@ -2,11 +2,14 @@
{% comment %}
The host page, served by Django since port-plan step 9.
It was `frontend/public/index.html`, served by shadow-cljs's `:dev-http`, and that
key is gone. The bundle is unchanged: shadow-cljs writes it into
`static/arthur/js` and staticfiles serves it from there, so `manage.py runserver`
and `shadow-cljs watch app` are the whole dev loop with nothing copying files
between them.
It carries no styles of its own any more. They are `static/arthur/app.css`, which
staticfiles serves from the same tree as the bundle — the page grew a five-pane
application chrome and "the styles" stopped being a thing you read in passing on
the way to the markup.
The bundle is unchanged: shadow-cljs writes it into `static/arthur/js` and
staticfiles serves it from there, so `manage.py runserver` and `shadow-cljs watch
app` are the whole dev loop with nothing copying files between them.
The CSRF token is rendered so that Django sets its cookie, which is what
`arthur.fx.http` reads to write the `X-CSRFToken` header. Saves are ordinary POSTs
@ -17,72 +20,12 @@ and PUTs with ordinary CSRF protection — no endpoint in this app is exempt.
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>arthur</title>
<style>
:root { color-scheme: dark; --bg: #12141c; --fg: #c9c3b4; }
html, body { margin: 0; height: 100%; background: var(--bg); color: var(--fg); }
body { font: 14px/1.5 ui-monospace, SFMono-Regular, Menlo, monospace; }
main { padding: 24px; }
/* The preview is nearest-neighbour everywhere. A browser that smooths the
upscale would misrepresent the look the tool exists to judge. */
canvas { image-rendering: pixelated; }
h1 { font-size: 14px; font-weight: normal; opacity: .5; margin: 0 0 12px; }
.stage { display: block; background: #12141c; }
.stage-wrap { position: relative; width: fit-content; }
.paint-overlay { position: absolute; inset: 0; touch-action: none; }
.paint-overlay circle { cursor: grab; }
.paint-tools { width: 640px; margin-top: 9px; font-size: 12px; }
.paint-tools .row { display: flex; flex-wrap: wrap; align-items: center; gap: 6px; margin: 4px 0; }
.paint-tools select { color: var(--fg); background: #1c1f2b; border: 1px solid #2b3040; font: inherit; }
.paint-tools .hint { color: #d0ba86; opacity: .8; }
audio { display: none; }
.transport { margin-top: 12px; width: 640px; }
.transport .row { display: flex; flex-wrap: wrap; gap: 6px; align-items: center; }
.transport .gap { flex: 1; }
button {
font: inherit; color: var(--fg); background: #1c1f2b;
border: 1px solid #2b3040; padding: 3px 10px; cursor: pointer;
}
button:hover { background: #242836; }
button:disabled { opacity: .45; cursor: wait; }
button.on { background: #3a4258; border-color: #556080; }
.scrub { width: 100%; margin: 10px 0 6px; }
.readout { display: flex; gap: 18px; opacity: .55; font-size: 12px; }
.readout .warn { color: #d98f5a; opacity: 1; }
.picture-rate { display: flex; align-items: center; gap: 6px; margin-top: 7px;
font-size: 12px; }
.source-path { display: block; margin-top: 8px; font-size: 12px; opacity: .7; }
.source-path select { margin: 0 8px; padding: 3px 5px;
color: var(--fg); background: #1c1f2b; border: 1px solid #2b3040;
font: inherit; max-width: 360px; }
.load-status { margin-top: 6px; font-size: 12px; opacity: .75; }
.export { width: 640px; margin-top: 14px; padding-top: 12px;
border-top: 1px solid #2b3040; font-size: 12px; }
.export .row { display: flex; flex-wrap: wrap; gap: 6px; align-items: center; }
.export .gap { flex: 1; }
.export select { margin-left: 6px; padding: 3px 5px; color: var(--fg);
background: #1c1f2b; border: 1px solid #2b3040; font: inherit; }
.export .readout { margin-top: 7px; }
.export .note { margin: 7px 0 0; }
.controls { width: 640px; margin-top: 18px; padding-top: 12px;
border-top: 1px solid #2b3040; font-size: 12px; }
.controls select { margin-left: 8px; padding: 3px 5px; color: var(--fg);
background: #1c1f2b; border: 1px solid #2b3040; font: inherit; }
.shared-note { margin-top: 6px; color: #d0ba86; }
.control-list { display: grid; grid-template-columns: 1fr 1fr; gap: 6px 16px;
margin-top: 10px; }
.control-row { display: grid; grid-template-columns: 115px 1fr 42px;
align-items: center; gap: 6px; }
.control-row input { width: 100%; }
.control-row output { text-align: right; }
.regeneration-debug { padding: 8px; margin-top: 10px; background: #1c1f2b;
white-space: pre-wrap; color: #d0ba86; }
.note { opacity: .35; font-size: 12px; max-width: 640px; }
</style>
<link rel="stylesheet" href="{% static 'arthur/app.css' %}?v={{ css_version }}">
</head>
<body>
{% csrf_token %}
<div id="app"></div>
<script src="{% static 'mediapipe/vision_bundle.js' %}"></script>
<script src="{% static 'arthur/js/main.js' %}"></script>
<script src="{% static 'arthur/js/main.js' %}?v={{ js_version }}"></script>
</body>
</html>

View file

@ -361,7 +361,10 @@ class DocumentTests(TestCase):
"""Tier 1: load, save, and the conditional write."""
def setUp(self):
self.project = Project.objects.create(name="a project")
from django.contrib.auth import get_user_model
owner = get_user_model().objects.create_user("owner", password="password1")
self.client.force_login(owner)
self.project = Project.objects.create(name="a project", owner=owner)
descriptor = analysis_descriptor()
self.analysis = key_for(descriptor)
self.client.post("/api/analyses", data=json.dumps(
@ -382,13 +385,13 @@ class DocumentTests(TestCase):
# cache marker, keyword keys, and a frame-keyed inner map.
return {
"clip/c1/timing": ["^ ", "~:fps", 30],
"clip/c1/timeline/main": ["^ ", "~:frames", 48],
"clip/c1/timeline/main/node/mouth": ["^ ", "~:id", "~:mouth", "~:z", "a1"],
"clip/c1/timeline/main/channel/mouth/geom.pts": [
"clip/c1/symbol/main": ["^ ", "~:frames", 48],
"clip/c1/symbol/main/node/mouth": ["^ ", "~:id", "~:mouth", "~:z", "a1"],
"clip/c1/symbol/main/channel/mouth/geom.pts": [
"^ ", "~:animated?", True, "~:dense",
["^ ", "~:store", self.block, "~:offset", 0, "~:stride", 16],
],
"clip/c1/timeline/main/channel/mouth-in/vis": [
"clip/c1/symbol/main/channel/mouth-in/vis": [
"^ ", "~:animated?", True, "~:keys", ["^ ", "~i0", True, "~i12", False],
],
}
@ -401,13 +404,25 @@ class DocumentTests(TestCase):
"blocks": blocks if blocks is not None else [self.block]}],
})
def test_every_saved_symbol_is_listed_across_projects(self):
leaves = self.leaves()
leaves["clip/c1/symbol/sym~face"] = ["^ ", "~:name", "face", "~:frames", 12]
leaves["clip/c1/symbol/sym~face/node/mark"] = ["^ ", "~:id", "~:mark", "~:z", "a1"]
self.assertEqual(200, self.save(leaves).status_code)
rows = self.client.get("/api/symbols").json()["symbols"]
self.assertEqual(
[("face", "sym~face", 12), ("main", "main", 48)],
[(r["name"], r["symbol"], r["frames"]) for r in rows])
self.assertEqual({str(self.project.id)}, {r["project"] for r in rows})
self.assertEqual({"c1"}, {r["cid"] for r in rows})
def test_a_document_comes_back_exactly(self):
response = self.save()
self.assertEqual(200, response.status_code, response.content)
self.assertEqual(5, len(response.json()["written"]))
loaded = self.client.get(f"/api/projects/{self.project.id}").json()
self.assertEqual(1, loaded["schema_version"])
self.assertEqual(2, loaded["schema_version"])
self.assertEqual(1, len(loaded["clips"]))
clip = loaded["clips"][0]
self.assertEqual("c1", clip["cid"])
@ -424,22 +439,22 @@ class DocumentTests(TestCase):
self.save()
first = {leaf.path: leaf.version for leaf in Leaf.objects.all()}
moved = self.leaves()
moved["clip/c1/timeline/main/channel/mouth-in/vis"] = [
moved["clip/c1/symbol/main/channel/mouth-in/vis"] = [
"^ ", "~:animated?", True, "~:keys", ["^ ", "~i0", False],
]
response = self.save(moved)
self.assertEqual(["clip/c1/timeline/main/channel/mouth-in/vis"], response.json()["written"])
self.assertEqual(["clip/c1/symbol/main/channel/mouth-in/vis"], response.json()["written"])
self.assertEqual(4, response.json()["unchanged"])
after = {leaf.path: leaf.version for leaf in Leaf.objects.all()}
self.assertEqual(2, after["clip/c1/timeline/main/channel/mouth-in/vis"])
self.assertEqual(2, after["clip/c1/symbol/main/channel/mouth-in/vis"])
self.assertEqual(first["clip/c1/timing"], after["clip/c1/timing"])
def test_a_removed_node_removes_its_leaf(self):
self.save()
fewer = {k: v for k, v in self.leaves().items()
if k != "clip/c1/timeline/main/node/mouth"}
if k != "clip/c1/symbol/main/node/mouth"}
response = self.save(fewer)
self.assertEqual(["clip/c1/timeline/main/node/mouth"], response.json()["removed"])
self.assertEqual(["clip/c1/symbol/main/node/mouth"], response.json()["removed"])
self.assertEqual(4, Leaf.objects.count())
def test_a_save_does_not_disturb_another_clip(self):
@ -472,7 +487,7 @@ class DocumentTests(TestCase):
def test_a_leaf_write_carries_an_etag(self):
self.save()
url = f"/api/projects/{self.project.id}/leaves/clip/c1/timeline/main/node/mouth"
url = f"/api/projects/{self.project.id}/leaves/clip/c1/symbol/main/node/mouth"
got = self.client.get(url)
self.assertEqual('"1"', got["ETag"])
@ -488,7 +503,7 @@ class DocumentTests(TestCase):
# take-theirs. A PUT that replaced unconditionally is the bug where the
# loser's work disappears silently.
self.save()
url = f"/api/projects/{self.project.id}/leaves/clip/c1/timeline/main/node/mouth"
url = f"/api/projects/{self.project.id}/leaves/clip/c1/symbol/main/node/mouth"
self.put(url, {"value": ["^ ", "~:z", "a2"]}, HTTP_IF_MATCH='"1"')
stale = self.put(url, {"value": ["^ ", "~:z", "a3"]}, HTTP_IF_MATCH='"1"')
self.assertEqual(409, stale.status_code)
@ -511,6 +526,61 @@ class DocumentTests(TestCase):
# --- revisions ---------------------------------------------------------
def patch(self, base, leaves, removed=()):
return self.put(f"/api/projects/{self.project.id}", {
"base": base,
"clips": [{"cid": "c1", "analysis": self.analysis, "leaves": leaves,
"removed": list(removed), "blocks": [self.block]}],
})
def test_a_patch_leaves_what_it_does_not_name_alone(self):
seq = self.save().json()["seq"]
response = self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 24]},
removed=["clip/c1/symbol/main/node/mouth"])
self.assertEqual(200, response.status_code, response.content)
self.assertEqual(["clip/c1/timing"], response.json()["written"])
self.assertEqual(4, Leaf.objects.count())
def test_two_people_on_different_leaves_both_land(self):
seq = self.save().json()["seq"]
self.assertEqual(200, self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 24]}).status_code)
# The second saver has not caught up, and touched a different leaf.
response = self.patch(seq, {"clip/c1/symbol/main": ["^ ", "~:frames", 12]})
self.assertEqual(200, response.status_code, response.content)
leaves = self.client.get(f"/api/projects/{self.project.id}").json()["clips"][0]["leaves"]
self.assertEqual(["^ ", "~:fps", 24], leaves["clip/c1/timing"])
self.assertEqual(["^ ", "~:frames", 12], leaves["clip/c1/symbol/main"])
def test_two_people_on_one_leaf_is_a_conflict_that_writes_nothing(self):
seq = self.save().json()["seq"]
self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 24]})
response = self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 12],
"clip/c1/symbol/main": ["^ ", "~:frames", 12]})
self.assertEqual(409, response.status_code)
self.assertEqual({"clip/c1/timing": ["^ ", "~:fps", 24]}, response.json()["conflicts"])
self.assertEqual(seq + 1, Project.objects.get(id=self.project.id).seq)
self.assertEqual(["^ ", "~:frames", 48],
Leaf.objects.get(path="clip/c1/symbol/main").value)
# Caught up to their seq, the same write is ordinary.
self.assertEqual(200, self.patch(seq + 1, {"clip/c1/timing": ["^ ", "~:fps", 12]}).status_code)
def test_a_named_snapshot_restores_as_an_ordinary_write(self):
self.save()
snap = self.client.post(f"/api/projects/{self.project.id}/revisions",
data=json.dumps({"summary": "before the big change"}),
content_type="application/json").json()
moved = self.leaves()
moved["clip/c1/timing"] = ["^ ", "~:fps", 12]
del moved["clip/c1/symbol/main/node/mouth"]
self.save(moved)
listed = self.client.get(f"/api/projects/{self.project.id}/revisions").json()["revisions"]
self.assertEqual(["before the big change"], [r["summary"] for r in listed])
restored = self.client.post(
f"/api/projects/{self.project.id}/revisions/{snap['id']}/restore").json()
self.assertEqual(2, restored["changed"])
leaves = self.client.get(f"/api/projects/{self.project.id}").json()["clips"][0]["leaves"]
self.assertEqual(self.leaves(), leaves)
def test_a_revision_snapshots_the_authored_layer(self):
self.save()
response = self.client.post(
@ -814,3 +884,99 @@ class UploadTests(TestCase):
digest="e" * 64, fps=12, frames=3, width=8, height=6, audio=blob)
manifest = self.client.get(f"/api/footage/{footage.id}").json()
self.assertIsNone(manifest["video"])
@override_settings(BLOB_ROOT=BLOB_DIR)
class OwnershipTests(TestCase):
"""Anyone with the link reads; the owner and the editors write."""
def setUp(self):
from django.contrib.auth import get_user_model
User = get_user_model()
self.ann = User.objects.create_user("ann", password="password1")
self.bob = User.objects.create_user("bob", password="password1")
self.project = Project.objects.create(name="ann's", owner=self.ann)
def write(self):
return self.client.put(f"/api/projects/{self.project.id}",
data=json.dumps({"name": "renamed", "clips": []}),
content_type="application/json")
def test_anyone_with_the_link_can_read_and_nobody_else_can_write(self):
loaded = self.client.get(f"/api/projects/{self.project.id}").json()
self.assertEqual(("ann", False), (loaded["owner"], loaded["can_edit"]))
self.assertEqual(403, self.write().status_code)
self.client.login(username="bob", password="password1")
self.assertEqual(403, self.write().status_code)
def test_the_owner_names_an_editor_who_can_then_write(self):
self.client.login(username="bob", password="password1")
self.assertEqual(403, self.client.post(
f"/api/projects/{self.project.id}/editors", data=json.dumps({"username": "bob"}),
content_type="application/json").status_code)
self.client.login(username="ann", password="password1")
self.assertEqual(200, self.write().status_code)
self.assertEqual(["bob"], self.client.post(
f"/api/projects/{self.project.id}/editors", data=json.dumps({"username": "bob"}),
content_type="application/json").json()["editors"])
self.client.login(username="bob", password="password1")
self.assertTrue(self.client.get(f"/api/projects/{self.project.id}").json()["can_edit"])
self.assertEqual(200, self.write().status_code)
self.client.login(username="ann", password="password1")
self.client.delete(f"/api/projects/{self.project.id}/editors/bob")
self.client.login(username="bob", password="password1")
self.assertEqual(403, self.write().status_code)
def test_a_project_is_made_by_somebody_signed_in_and_is_theirs(self):
self.assertEqual(403, self.client.post("/api/projects", data=json.dumps({"name": "x"}),
content_type="application/json").status_code)
self.client.post("/api/signup", data=json.dumps(
{"username": "cat", "password": "password1"}), content_type="application/json")
self.assertEqual("cat", self.client.get("/api/me").json()["username"])
mine = self.client.post("/api/projects", data=json.dumps({"name": "y"}),
content_type="application/json").json()
self.assertEqual(("cat", True), (mine["owner"], mine["can_edit"]))
listed = {p["name"] for p in self.client.get("/api/projects").json()["projects"]}
self.assertEqual({"y"}, listed)
self.client.logout()
self.assertEqual([], self.client.get("/api/projects").json()["projects"])
def test_a_project_has_an_address(self):
response = self.client.get(f"/p/{self.project.id}")
self.assertEqual(200, response.status_code)
# The slug is the name, for people; the id is what finds it.
self.assertEqual(200, self.client.get(f"/p/{self.project.id}/anything-at-all").status_code)
self.assertContains(response, 'id="app"')
class SocketTests(TestCase):
"""A committed write reaches everyone in the room; presence is stamped."""
def test_a_save_is_broadcast_to_the_room(self):
from asgiref.sync import async_to_sync, sync_to_async
from channels.testing import WebsocketCommunicator
from clips.consumers import broadcast
from server.asgi import application
from django.contrib.auth import get_user_model
project = Project.objects.create(
name="shared", owner=get_user_model().objects.create_user("host"))
async def scenario():
peer = WebsocketCommunicator(application, f"/ws/projects/{project.id}",
headers=[(b"origin", b"http://localhost")])
connected, _ = await peer.connect()
self.assertTrue(connected)
self.assertEqual("welcome", (await peer.receive_json_from())["kind"])
self.assertEqual([], (await peer.receive_json_from())["peers"])
self.assertEqual("join", (await peer.receive_json_from())["kind"])
# The server stamps who sent it; a claimed name is overwritten.
await peer.send_json_to({"kind": "state", "frame": 12, "user": "forged"})
state = await peer.receive_json_from()
self.assertEqual((12, None), (state["frame"], state["user"]))
await sync_to_async(broadcast)(project.id, {"seq": 1, "clips": []})
delta = await peer.receive_json_from()
self.assertEqual(("delta", 1), (delta["kind"], delta["seq"]))
await peer.disconnect()
async_to_sync(scenario)()

View file

@ -16,6 +16,10 @@ from django.urls import path
from . import views
urlpatterns = [
path("me", views.me),
path("login", views.login),
path("signup", views.signup),
path("logout", views.logout),
path("detector", views.detector),
path("sources", views.sources),
path("extractions", views.extractions),
@ -23,9 +27,13 @@ urlpatterns = [
path("footage", views.footage_list),
path("footage/<uuid:footage_id>", views.footage_detail),
path("projects", views.projects),
path("symbols", views.symbols),
path("projects/<uuid:project_id>", views.project_detail),
path("projects/<uuid:project_id>/leaves/<path:leaf_path>", views.leaf_detail),
path("projects/<uuid:project_id>/revisions", views.revisions),
path("projects/<uuid:project_id>/revisions/<int:revision_id>/restore", views.restore),
path("projects/<uuid:project_id>/editors", views.editors),
path("projects/<uuid:project_id>/editors/<str:username>", views.editors),
path("analyses", views.analyses),
path("analyses/<str:key>", views.analysis_detail),
path("blocks", views.blocks),

View file

@ -32,13 +32,17 @@ from pathlib import Path
from uuid import UUID
from django.conf import settings
from django.contrib.auth import authenticate, get_user_model
from django.contrib.auth import login as auth_login, logout as auth_logout
from django.core.exceptions import ValidationError
from django.db import transaction
from django.db.models import Q
from django.http import FileResponse, HttpResponse, JsonResponse
from django.shortcuts import render
from django.views.decorators.http import require_http_methods
from . import blobs, extraction
from .consumers import broadcast
from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Source
KEY_LENGTH = 71 # "sha256:" + 64 hex
@ -119,10 +123,27 @@ def _crop_blob(chunks):
# the page
def page(request):
def _asset_version(relative):
"""A static file's modification time, for its URL.
The stylesheet and the bundle are served with `Last-Modified` and nothing
else, so a browser is free to keep a stale copy on heuristic freshness — and
new JavaScript over an old stylesheet renders a pane the stylesheet has never
heard of as bare elements. A version in the URL makes each edit a new URL."""
for root in settings.STATICFILES_DIRS:
path = Path(root) / relative
if path.exists():
return str(int(path.stat().st_mtime))
return "0"
def page(request, project_id=None, slug=None):
"""The host page. This replaced `frontend/public/index.html` at step 9, and
`:dev-http` in shadow-cljs.edn went away with it."""
return render(request, "clips/index.html")
return render(request, "clips/index.html", {
"css_version": _asset_version("arthur/app.css"),
"js_version": _asset_version("arthur/js/main.js"),
})
# ---------------------------------------------------------------------------
@ -273,6 +294,44 @@ def footage_list(request):
)
_SYMBOL_LEAF = re.compile(r"^clip/([^/]+)/symbol/([^/]+)$")
def _transit_fields(value, *keys):
"""Top-level fields of a transit map leaf, by keyword name. A leaf's own
facts are a small flat map, so no key repeats and transit's cache never
stands in for one; anything else reads as absent."""
if not (isinstance(value, list) and value[:1] == ["^ "]):
return {}
pairs = dict(zip(value[1::2], value[2::2]))
return {k: pairs.get(f"~:{k}") for k in keys}
@require_http_methods(["GET"])
def symbols(request):
"""Every symbol in every saved project, for the pool's all-assets folder.
Read off the leaf PATHS rather than by loading documents: a symbol's own leaf
is `clip/<cid>/symbol/<sid>`, so listing them is one query and no decoding
beyond the name and length its value carries."""
rows = []
for leaf in Leaf.objects.filter(path__contains="/symbol/").select_related("project"):
m = _SYMBOL_LEAF.match(leaf.path)
if not m:
continue
fields = _transit_fields(leaf.value, "name", "frames")
rows.append({
"project": str(leaf.project_id),
"project_name": leaf.project.name,
"cid": m.group(1),
"symbol": m.group(2),
"name": fields.get("name") or m.group(2).replace("~", "/"),
"frames": fields.get("frames"),
})
rows.sort(key=lambda r: (r["project_name"], r["project"], r["name"]))
return JsonResponse({"symbols": rows})
@require_http_methods(["GET"])
def footage_detail(request, footage_id):
try:
@ -564,7 +623,11 @@ def block_detail(request, key):
# tier 1: projects, clips, leaves
def _project_json(project: Project):
def _who(user):
return {"username": user.get_username() if user.is_authenticated else None}
def _project_json(project: Project, user):
leaves = list(project.leaves.all())
clips = []
for clip in project.clips.all():
@ -585,27 +648,103 @@ def _project_json(project: Project):
"schema_version": project.schema_version,
"seq": project.seq,
"palette": project.palette,
"owner": project.owner.get_username(),
"editors": sorted(project.editors.values_list("username", flat=True)),
"can_edit": project.can_edit(user),
"clips": clips,
}
def _project(project_id):
try:
return Project.objects.select_related("owner").get(id=project_id)
except Project.DoesNotExist:
raise Bad("no such project", status=404)
def _writable(request, project_id):
project = _project(project_id)
if not project.can_edit(request.user):
raise Bad("only the owner and the editors can change this project; "
"save a copy instead", status=403)
return project
# ---------------------------------------------------------------------------
# who you are
#
# Django's session cookie, and the page's CSRF cookie on every write. Nothing
# here that a signed-in admin does not already have; the API gains a way in that
# is not the admin's login page.
@require_http_methods(["GET"])
def me(request):
return JsonResponse(_who(request.user))
@require_http_methods(["POST"])
def login(request):
data = json.loads(request.body or b"{}")
user = authenticate(request, username=data.get("username"), password=data.get("password"))
if user is None:
return JsonResponse({"error": "wrong username or password"}, status=400)
auth_login(request, user)
return JsonResponse(_who(user))
@require_http_methods(["POST"])
def signup(request):
data = json.loads(request.body or b"{}")
username = (data.get("username") or "").strip()
password = data.get("password") or ""
if not username or len(password) < 8:
return JsonResponse({"error": "a username, and a password of 8 or more"}, status=400)
User = get_user_model()
if User.objects.filter(username__iexact=username).exists():
return JsonResponse({"error": "that username is taken"}, status=409)
user = User.objects.create_user(username=username, password=password)
auth_login(request, user)
return JsonResponse(_who(user), status=201)
@require_http_methods(["POST"])
def logout(request):
auth_logout(request)
return JsonResponse(_who(request.user))
# ---------------------------------------------------------------------------
# tier 1: projects, clips, leaves
@require_http_methods(["GET", "POST"])
def projects(request):
"""GET lists what you own and are an editor of — nothing, signed out; POST
makes one, owned by you. Every project has an owner, so making one needs you
signed in."""
if request.method == "GET":
if not request.user.is_authenticated:
return JsonResponse({"projects": []})
visible = Q(owner=request.user) | Q(editors=request.user)
return JsonResponse(
{
"projects": [
{"id": str(p.id), "name": p.name,
"schema_version": p.schema_version, "seq": p.seq,
"owner": p.owner.get_username(),
"updated": p.updated.isoformat()}
for p in Project.objects.all()[:100]
for p in Project.objects.filter(visible).distinct()
.select_related("owner")[:100]
]
}
)
if not request.user.is_authenticated:
return JsonResponse({"error": "sign in to make a project"}, status=403)
try:
data = _body(request)
project = Project.objects.create(name=data.get("name") or "untitled")
return JsonResponse(_project_json(project), status=201)
project = Project.objects.create(name=data.get("name") or "untitled", owner=request.user)
return JsonResponse(_project_json(project, request.user), status=201)
except Bad as exc:
return _error(exc)
@ -613,43 +752,74 @@ def projects(request):
@require_http_methods(["GET", "PUT"])
def project_detail(request, project_id):
try:
project = Project.objects.get(id=project_id)
except Project.DoesNotExist:
return JsonResponse({"error": "no such project"}, status=404)
if request.method == "GET":
return JsonResponse(_project_json(project))
if request.method == "GET":
return JsonResponse(_project_json(_project(project_id), request.user))
project = _writable(request, project_id)
return _save(project, _body(request), request.user)
except Bad as exc:
return _error(exc)
@require_http_methods(["POST", "DELETE"])
def editors(request, project_id, username=None):
"""The owner names who else can write. POST {username} adds; DELETE
`editors/<username>` removes."""
try:
return _save(project, _body(request))
project = _project(project_id)
if not (request.user.is_authenticated and request.user.id == project.owner_id):
raise Bad("only the owner can change who edits", status=403)
if request.method == "POST":
username = _body(request).get("username")
user = get_user_model().objects.filter(username__iexact=username or "").first()
if user is None:
raise Bad(f"nobody is called {username!r}", status=404)
if request.method == "POST":
project.editors.add(user)
else:
project.editors.remove(user)
broadcast(project.id, {}, kind="access")
return JsonResponse({"editors": sorted(project.editors.values_list("username", flat=True))})
except Bad as exc:
return _error(exc)
@transaction.atomic
def _save(project: Project, data):
"""A whole-document save: one clip's leaves replace that clip's leaves.
def _save(project: Project, data, user):
"""A save: one clip's leaves, written.
SCOPED BY CLIP, not by project. A payload that carries clip `a` does not
disturb clip `b`'s leaves, because a save is not the only way the document
changes — a single-leaf conditional write is — and a save that cleared
everything it did not mention would be a save that undoes a collaborator.
disturb clip `b`'s leaves.
Two shapes. Without `base`, a clip's leaves REPLACE that clip's leaves — the
whole-document save. With `base`, the seq the client last caught up to, the
save is a PATCH: `leaves` are the ones it changed, `removed` the ones it
deleted, and nothing it did not mention is touched. A leaf it names that
somebody else changed after `base`, to something else, is a conflict, and the
whole save answers 409 with their values — last-writer-wins per leaf, with the
loser told rather than silently clobbered. docs/architecture.md, "Make the
merge unit small instead of clever".
A leaf whose value is unchanged keeps its VERSION. That is what makes the
entity tag mean something: a save of a document where one channel moved
invalidates one leaf's etag, not all four hundred.
"""
base = data.get("base")
seq = project.bump()
if data.get("name"):
project.name = data["name"]
if data.get("palette"):
project.palette = data["palette"]
project.save(update_fields=["name", "palette"])
written, removed, unchanged = [], [], []
written, removed, unchanged, conflicts, deltas = [], [], [], {}, []
for spec in data.get("clips") or []:
cid = spec.get("cid")
if not cid:
raise Bad("every clip in a save names its cid")
leaves = spec.get("leaves") or {}
gone = spec.get("removed") or [] if base is not None else []
prefix = f"clip/{cid}/"
for path in leaves:
for path in [*leaves, *gone]:
if not path.startswith(prefix):
raise Bad(
f"leaf {path!r} is not addressed to clip {cid!r}",
@ -668,6 +838,16 @@ def _save(project: Project, data):
status=409, missing=missing,
)
existing = {leaf.path: leaf for leaf in project.leaves.filter(path__startswith=prefix)}
if base is not None:
for path in [*leaves, *gone]:
theirs = existing.get(path)
if theirs and theirs.seq > base and (
path not in leaves or theirs.value != leaves[path]):
conflicts[path] = theirs.value
if conflicts:
continue
analysis = Analysis.objects.filter(key=spec.get("analysis")).first()
footage = None
if spec.get("footage"):
@ -677,29 +857,41 @@ def _save(project: Project, data):
cid=cid,
defaults={"name": spec.get("name") or "", "analysis": analysis, "footage": footage},
)
clip.blocks.set(Block.objects.filter(key__in=keys))
blocks = Block.objects.filter(key__in=keys)
if base is None:
clip.blocks.set(blocks)
gone = [path for path in existing if path not in leaves]
else:
clip.blocks.add(*blocks)
existing = {leaf.path: leaf for leaf in project.leaves.filter(path__startswith=prefix)}
changed = {}
for path, value in leaves.items():
leaf = existing.get(path)
if leaf is None:
Leaf.objects.create(project=project, path=path, value=value)
written.append(path)
Leaf.objects.create(project=project, path=path, value=value, seq=seq)
elif leaf.value != value:
leaf.value = value
leaf.value, leaf.seq = value, seq
leaf.version += 1
leaf.save(update_fields=["value", "version", "updated"])
written.append(path)
leaf.save(update_fields=["value", "version", "seq", "updated"])
else:
unchanged.append(path)
for path, leaf in existing.items():
if path not in leaves:
leaf.delete()
removed.append(path)
continue
changed[path] = value
dropped = [path for path in gone if path in existing]
project.leaves.filter(path__in=dropped).delete()
written += changed
removed += dropped
deltas.append({"cid": cid, "leaves": changed, "removed": dropped, "blocks": keys})
seq = project.seq + 1
project.seq = seq
project.save()
if conflicts:
raise Bad(
"somebody else changed these since you last caught up",
status=409, seq=seq - 1, conflicts=conflicts,
)
by = user.get_username() if user.is_authenticated else None
transaction.on_commit(lambda: broadcast(project.id, {
"seq": seq, "by": by, "name": project.name, "clips": deltas,
}))
return JsonResponse(
{
"id": str(project.id),
@ -722,9 +914,9 @@ def leaf_detail(request, project_id, leaf_path):
for a painted cel that is the class of bug that ends trust in a tool.
"""
try:
project = Project.objects.get(id=project_id)
except Project.DoesNotExist:
return JsonResponse({"error": "no such project"}, status=404)
project = _project(project_id) if request.method == "GET" else _writable(request, project_id)
except Bad as exc:
return _error(exc)
leaf = project.leaves.filter(path=leaf_path).first()
if request.method == "GET":
@ -742,35 +934,45 @@ def leaf_detail(request, project_id, leaf_path):
return _error(Bad("a leaf write carries a value"))
match = request.headers.get("If-Match")
if leaf is None:
# ANY `If-Match` on a leaf that does not exist is a failed precondition,
# `*` included: RFC 7232 gives `*` the meaning "the resource must already
# exist", which is exactly the write a client makes when it believes it is
# editing something. Creating it instead would turn "somebody deleted this
# node" into a silent resurrection.
if match:
return JsonResponse(
{"error": "no such leaf", "path": leaf_path}, status=409
)
leaf = Leaf.objects.create(project=project, path=leaf_path, value=data["value"])
else:
if match and match not in ("*", leaf.etag):
response = JsonResponse(
{
"error": "stale write",
"path": leaf.path,
"version": leaf.version,
"value": leaf.value,
},
status=409,
)
response["ETag"] = leaf.etag
return response
leaf.value = data["value"]
leaf.version += 1
leaf.save(update_fields=["value", "version", "updated"])
with transaction.atomic():
seq = project.bump()
leaf = project.leaves.filter(path=leaf_path).first()
if leaf is None:
# ANY `If-Match` on a leaf that does not exist is a failed precondition,
# `*` included: RFC 7232 gives `*` the meaning "the resource must already
# exist", which is exactly the write a client makes when it believes it
# is editing something. Creating it instead would turn "somebody deleted
# this node" into a silent resurrection.
if match:
transaction.set_rollback(True)
return JsonResponse(
{"error": "no such leaf", "path": leaf_path}, status=409
)
leaf = Leaf.objects.create(project=project, path=leaf_path, value=data["value"], seq=seq)
else:
if match and match not in ("*", leaf.etag):
transaction.set_rollback(True)
response = JsonResponse(
{
"error": "stale write",
"path": leaf.path,
"version": leaf.version,
"value": leaf.value,
},
status=409,
)
response["ETag"] = leaf.etag
return response
leaf.value, leaf.seq = data["value"], seq
leaf.version += 1
leaf.save(update_fields=["value", "version", "seq", "updated"])
cid = leaf_path.split("/")[1] if leaf_path.startswith("clip/") else None
by = request.user.get_username() if request.user.is_authenticated else None
transaction.on_commit(lambda: broadcast(project.id, {
"seq": seq, "by": by, "name": project.name,
"clips": [{"cid": cid, "leaves": {leaf.path: leaf.value}, "removed": [], "blocks": []}],
}))
seq = project.bump()
response = JsonResponse({"path": leaf.path, "version": leaf.version, "seq": seq})
response["ETag"] = leaf.etag
return response
@ -778,16 +980,17 @@ def leaf_detail(request, project_id, leaf_path):
@require_http_methods(["GET", "POST"])
def revisions(request, project_id):
"""Mark a version: one snapshot of the authored layer, with a summary."""
"""Named snapshots: GET lists them, POST {summary} takes one of the document
as it is now."""
try:
project = Project.objects.get(id=project_id)
except Project.DoesNotExist:
return JsonResponse({"error": "no such project"}, status=404)
project = _project(project_id) if request.method == "GET" else _writable(request, project_id)
except Bad as exc:
return _error(exc)
if request.method == "GET":
return JsonResponse(
{
"revisions": [
{"seq": r.seq, "author": r.author, "summary": r.summary,
{"id": r.id, "seq": r.seq, "author": r.author, "summary": r.summary,
"created": r.created.isoformat(), "leaves": len(r.document)}
for r in project.revisions.all()[:100]
]
@ -797,8 +1000,57 @@ def revisions(request, project_id):
revision = Revision.objects.create(
project=project,
seq=project.seq,
author=data.get("author") or "",
summary=data.get("summary") or "",
author=request.user.get_username(),
summary=(data.get("summary") or "").strip()[:500],
document={leaf.path: leaf.value for leaf in project.leaves.all()},
blocks={clip.cid: sorted(clip.blocks.values_list("key", flat=True))
for clip in project.clips.all()},
)
return JsonResponse({"seq": revision.seq, "leaves": len(revision.document)}, status=201)
return JsonResponse({"id": revision.id, "seq": revision.seq,
"leaves": len(revision.document)}, status=201)
@require_http_methods(["POST"])
def restore(request, project_id, revision_id):
"""Put a snapshot back: an ordinary write of every leaf that differs, so
everybody in the room receives it the way they receive any other."""
try:
project = _writable(request, project_id)
revision = project.revisions.filter(id=revision_id).first()
if revision is None:
raise Bad("no such snapshot", status=404)
except Bad as exc:
return _error(exc)
with transaction.atomic():
seq = project.bump()
existing = {leaf.path: leaf for leaf in project.leaves.all()}
deltas = {}
def delta(path):
cid = path.split("/")[1]
return deltas.setdefault(cid, {"cid": cid, "leaves": {}, "removed": [],
"blocks": revision.blocks.get(cid, [])})
for path, value in revision.document.items():
leaf = existing.get(path)
if leaf is None:
Leaf.objects.create(project=project, path=path, value=value, seq=seq)
elif leaf.value != value:
leaf.value, leaf.seq = value, seq
leaf.version += 1
leaf.save(update_fields=["value", "version", "seq", "updated"])
else:
continue
delta(path)["leaves"][path] = value
gone = [path for path in existing if path not in revision.document]
project.leaves.filter(path__in=gone).delete()
for path in gone:
delta(path)["removed"].append(path)
for cid, keys in revision.blocks.items():
clip = project.clips.filter(cid=cid).first()
if clip:
clip.blocks.add(*Block.objects.filter(key__in=keys))
by = request.user.get_username()
transaction.on_commit(lambda: broadcast(project.id, {
"seq": seq, "by": by, "name": project.name, "clips": list(deltas.values()),
}))
return JsonResponse({"seq": seq, "changed": sum(len(d["leaves"]) + len(d["removed"])
for d in deltas.values())})

View file

@ -79,6 +79,20 @@ this way.
over which the node exists at all. Distinct from a `[:vis]` channel, which
blinks an existing node on and off.
**Every node has the same two maps into its parent**, whatever kind it is:
- **space** — the matrix its transform channels compose to, times a `:pinv` if
it has been moved in from elsewhere;
- **time** — `local = rate · (parent − at)`, from `:time :at` and `:rate`,
identity when absent. `:span` and every key are in the node's **own** frames.
A move keeps a node's world maps and re-expresses them under its new parent:
the matrix becomes a `:pinv`, the time becomes a new `:at` and `:rate`, and its
channels, keys and span are not touched. Both maps are affine, so any depth of
nesting is one map and every move is one inverse. `node/time-of`,
`node/then-time` and `node/placed-span` are the time half; `clip/move-node` and
`clip/group` are the move.
### Subjects and tracked features
Scene nodes describe drawings, not tracking identity. A scene may also carry a
@ -415,9 +429,11 @@ different rules:
*not* to the plate, which is the whole point of it — so the offset genuinely
belongs at the node, not the clip.
## Timelines, and why a scene is one
## Symbols, and why a scene is one
A **timeline** is an ordered bag of nodes in its own frame space:
A **symbol** is an ordered bag of nodes in its own frame space. (Earlier drafts
and code called this a *timeline*; that word now means only the UI pane that
shows one.)
```clojure
{:frames 91
@ -427,9 +443,10 @@ A **timeline** is an ordered bag of nodes in its own frame space:
That is the whole type, and **everything that holds nodes is one of these**:
- a clip's **scene** is its root timeline,
- a **symbol** in the library is a timeline,
- a node with `:kind :symbol` is an **instance** of one.
- what a document opens on is a symbol, and **no symbol is reserved** — a new
document's is called `main` only because it has to be called something,
- anything placed inside another symbol is a symbol,
- a node with `:kind :instance` is an **instance** of one.
An earlier draft of this document had a scene and a `:kind :timeline` symbol as
two structures with the same fields and never said they were the same thing.
@ -474,7 +491,7 @@ for all three is the same — **their own**:
### Instances
A node with `:kind :symbol` and `:of :sym/blink` places one. Its own channels
A node with `:kind :instance` and `:of :sym/blink` places one. Its own channels
compose *over* the symbol's, so one definition is placed many times and tinted,
offset or retimed at each placement — that is how a three-frame blink is reused
at frames 40, 88 and 200 without copying it.

View file

@ -639,10 +639,10 @@ is what step 9 implemented, for the subset that exists:
clip/<cid>/name clip/<cid>/subject/<sid>
clip/<cid>/timing clip/<cid>/feature/<fid>
clip/<cid>/stage clip/<cid>/group/<gid>
clip/<cid>/source clip/<cid>/timeline/<tid>
clip/<cid>/timeline/<tid>/node/<nid>
clip/<cid>/timeline/<tid>/measured/<nid>
clip/<cid>/timeline/<tid>/channel/<nid>/<prop>
clip/<cid>/source clip/<cid>/symbol/<sid>
clip/<cid>/symbol/<sid>/node/<nid>
clip/<cid>/symbol/<sid>/measured/<nid>
clip/<cid>/symbol/<sid>/channel/<nid>/<prop>
```
Settings live on subject, feature and group leaves. Each feature has one area, so
@ -675,6 +675,45 @@ and `~` is then refused inside a name. That is the whole of the escaping.
That maps onto the tiers exactly — the server stores tier 1 and snapshots tier 1,
with tiers 2 and 3 as content-addressed blobs beside it.
### As built
- **Addresses.** `/` is the index of the projects you own or edit. A project
is only ever at `/p/<uuid>/<slug>`: the id finds it, the slug is its name and
follows a rename without a history entry. "new" makes the project on the
server first and opens it; a built-in example opened in the editor is saved
at once as a project of its own. There is no bare project. The address, the
title and the socket follow `[:project :id]` through one global interceptor
(`events/collab`).
- **Ownership.** Every project has an owner (`Project.owner`, not nullable) and
`editors`. Anyone with the link reads; the owner and editors write. Making a
project needs you signed in. A reader can make a copy of their own.
`/api/{me,login,signup,logout}`, `/api/projects/<id>/editors[/<username>]`.
- **Every edit saves.** No save button. The same interceptor sees
`:paint/revision` move and saves; one request is in flight at a time, and an
edit made meanwhile goes when it lands — so a drag reaches the room as fast
as the round trip allows. A save sends only the leaves that differ from what
was last synced, and a clean document sends nothing. Analyses and blocks
already put on the server are not asked about again.
- **Saves are patches.** With `base` (the seq last caught up to) a save names
only its changed and removed leaves. A named leaf somebody else changed after
`base`, to something else, fails the whole save with 409.
- **The first write wins.** A remote write to a leaf with a local change not
yet sent waits in the entry's `:behind`; the next save, or a 409, puts theirs
on screen over ours and says so. Ours stays in the undo list.
- **The socket** (`/ws/projects/<uuid>`, channels + daphne) carries presence,
the delta each committed write broadcasts, and `access` when the editor list
changes. A gap in `seq`, a welcome, or a 409 refetches the document.
- **Undo** is per person, recorded in `events/edit` as leaf befores and afters
(`domain/history`), and applied as an ordinary edit. A step undoes only if
every leaf it touched still holds what it left there: somebody else's edit
since refuses it rather than being undone with it. Edits to the same leaves
within a second, each starting where the last left off, are one step.
- **Snapshots** are named revisions (`/api/projects/<id>/revisions`), with each
clip's block keys. Restoring one is an ordinary write, broadcast like any.
Not yet: follow mode, frame/selection in presence, the advisory `:editing`
lease, the durable outbox.
### Why this model, and not a CRDT
The usual reason to reach for Yjs or Automerge is automatic convergence without
@ -785,12 +824,12 @@ clip/:cid/timing clip rate
clip/:cid/subject/:sid tracked subject and settings
clip/:cid/feature/:fid tracked feature and settings
clip/:cid/group/:gid shared settings for an eye pair
clip/:cid/timeline/:tid frame count, palette
clip/:cid/timeline/:tid/node/:nid one node: parent, stencil, z, time
clip/:cid/timeline/:tid/channel/:nid/:prop
clip/:cid/timeline/:tid/measured/:nid
clip/:cid/timeline/:tid/cel/:nid/:frame
clip/:cid/timeline/:tid/overrides/:nid/:prop
clip/:cid/symbol/:sid frame count, palette
clip/:cid/symbol/:sid/node/:nid one node: parent, stencil, z, time
clip/:cid/symbol/:sid/channel/:nid/:prop
clip/:cid/symbol/:sid/measured/:nid
clip/:cid/symbol/:sid/cel/:nid/:frame
clip/:cid/symbol/:sid/overrides/:nid/:prop
```
Each feature and node has its own leaf, so tuning separate features and adding

View file

@ -8,11 +8,11 @@ symbol instance. Timelines already provide local node names, independent playbac
and persistence. No new kind of scene container is needed.
```clojure
:timelines
:symbols
{:main {:nodes {:root {:time {:mode :map :expose 2}}
:face {:parent :root :channels <source-to-stage placement>}
:face-1 {:kind :symbol :of :face-1 :parent :face :z "a0"}
:face-2 {:kind :symbol :of :face-2 :parent :face :z "a1"}}}
:face-1 {:kind :instance :of :face-1 :parent :face :z "a0"}
:face-2 {:kind :instance :of :face-2 :parent :face :z "a1"}}}
:face-1 {:nodes {:head {...} :mouth {:parent :head ...} ...}}
:face-2 {:nodes {:head {...} :mouth {:parent :head ...} ...}}}

View file

@ -70,7 +70,7 @@ handling and the relevant key whitelist if its storage location requires it.
- `freeze/performance-nodes` marks generated animated channels with
`:pose-sampled?` and local `:pose-group` names. This includes keyed visibility
as well as dense geometry. `:generated` remains provenance for regeneration.
- `timeline/channel-frame` already applies explicit pose choices and default
- `symbol/channel-frame` already applies explicit pose choices and default
picture sampling to marked channels. Playback and export both use
`clip/resolver` with `:picture-fps`; there is no need for a second sampling
implementation. Export's pose count is still a rate-based estimate.

View file

@ -88,18 +88,66 @@ cd frontend && mise exec -- npx shadow-cljs watch app
```
Then open **<http://localhost:8778/>**. Django serves the page from
`clips/templates/clips/index.html`, and staticfiles serves the bundle out of
`static/arthur/js`, where `shadow-cljs` already writes it — so nothing copies files
between the two.
`clips/templates/clips/index.html`, its styles from `static/arthur/app.css`, and
the bundle out of `static/arthur/js`, where `shadow-cljs` already writes it — so
nothing copies files between the two.
### The window
One screen, five panes, no scrolling page. `src/arthur/ui/shell.cljs` is the grid
and nothing else; each pane owns its own subscriptions.
```
top the document: its name and last status, export, new / open / save
left media pool — the open document's symbols, and footage on the server
centre the palette strip (16 slots) above the stage
right inspector — the clip, the selected node, the tracked objects
bottom timeline — transport, ruler, a row per node
```
**It opens on a blank document**, and **new** makes another one. Nothing is
loaded until it is asked for.
**Whole documents live under `open ▾`, not in the media pool**, and the split is
load-bearing rather than tidy. Opening a project REPLACES the stage; everything
in the pool is a thing to put ON it. Listing documents beside the symbols inside
one of them makes them read as two kinds of the same thing. The menu lists the
projects the server holds; the built-in scenes are under their own heading,
italic, and are not projects — they are compiled into the bundle and the server
has never heard of them.
Everything that holds nodes is a **symbol**, and none is special: a new document
has one called `main` because it has to be called something. Which symbol is on
screen is editor state, `[:ui :open]`, not a fact about the document — the stage
draws it, the timeline lists it, the transport plays it and a new shape goes into
it. A document opens on the longest symbol nothing else places.
Selection lives in app-db under `:ui`, as `[:node <symbol> <node>]`,
`[:symbol <id>]` or `[:subject|:feature|:group <id>]` — four panes ask what is
selected, and a ratom private to one of them can only be shared by making the
other three require it.
**Drop a video on the media pool** and it uploads, extracts and goes straight on
into detection. Dragging a symbol out of the pool onto the stage places an
instance of it at the playhead.
The timeline's rows are the open symbol's nodes, front-most first, with a dot per
keyframe and a bar over the frames the node exists on; a dense channel is hatched
rather than ticked, because one value per frame is a solid block that says less
than the bar does. Opening a row shows its channels; opening an **instance** row
shows the symbol it places, with every frame number mapped back into the open
symbol's frame space — see the namespace docstring in `ui/timeline.cljs`, which
is where that mapping is argued.
### Paint sketch
Click **new polygon**, place at least three vertices on the stage, then click
**finish shape**. Select a shape to drag its vertices. Scrub to another frame and
click **new drawing key** to copy the visible outline there; the previous drawing
holds until that key. The numbered drawing-key buttons jump to editable keys.
The transition control between two drawing keys can switch that gap between a
hold and linear vertex tweening. Other gaps keep their own timing. Tweening works
Pick a tone from the palette strip, click **polygon**, place at least three
vertices on the stage, then click **finish**. Select a shape — on the stage, or by
its timeline row — to drag its vertices. Scrub to another frame and click
**drawing key here** in the inspector to copy the visible outline there; the
previous drawing holds until that key. The numbered key buttons jump to editable
keys. The transition control between two drawing keys can switch that gap between
a hold and linear vertex tweening. Other gaps keep their own timing. Tweening works
best when the same vertex
keeps the same meaning in every drawing. Paint shapes use the timeline clock
directly, so the roto exposure grid does not delay a drawing key or step its
@ -109,7 +157,7 @@ tween. Use the project **save** button to persist the drawings.
has used since step 5, when shadow-cljs's `:dev-http` did no directory-index
resolution and the suite learned to ask for the file.
Four built-in clips, on buttons in the transport:
Four built-in clips, under **built-in examples** in the open menu:
| | |
| --- | --- |
@ -125,14 +173,14 @@ The demo scene itself is `src/arthur/demo/scene.edn`. Both the synthetic take
and real footage use `src/arthur/flow/take.cljs` for the measurement order and
`src/arthur/flow/freeze.cljs` for the landmark-to-channel conversion.
**stage 8625** loads the locally saved `IMG_8625.MOV` project and places its
post-processed timeline twice. The stage layout is
**8625 stage study**, in the open menu, loads the locally saved `IMG_8625.MOV` project and places its
post-processed face symbol twice. The stage layout is
`src/arthur/demo/stage_8625.edn`: the right picture and sound start at frame 48,
and the two pictures overlap slightly in stage space. Audio has its own timeline
and the two pictures overlap slightly in stage space. Audio has its own
nodes, linked to the picture instances but with independent spans and gain
channels. The right sound swells and pans across the stage, then fades out at
frame 260 while its picture continues to
frame 280. The button needs that saved 8625 project in the local server database.
frame 280. The row needs that saved 8625 project in the local server database.
### Projects and the EDN fixtures
@ -148,16 +196,17 @@ the same ClojureScript clip.
The intended editor creates and changes that in-memory clip directly: a project
browser and **new stage** action, timeline instance placement, node and channel
editors, then the existing save path. EDN remains useful for checked-in examples
and reproducible studies. The current UI has save and open, but no project
browser, blank-stage action, or authoring controls yet; open chooses the most
recent project.
and reproducible studies. The UI now has the blank-stage action (**new**), a
project browser (`open ▾`), and placement by dragging a symbol out of the media
pool; node and channel editors are still to come — the inspector reports a
channel's shape but has nowhere to change its values.
### Real footage
Choose a video in the **footage** file input. The server probes it, re-encodes it
Drop a video on the media pool, or use its **+** button. The server probes it, re-encodes it
to an H.264 proxy and a raw stream of the same coded frames, pulls WAV audio and one tracing JPEG per frame,
then makes the resulting footage selectable. Click **load frames** to detect and
freeze it. Extraction progress is currently read from `/api/extractions/<key>`; a
then makes the resulting footage selectable and runs detection on it. **roto**, in
the pool's header, does the same for footage that is already there. Extraction progress is currently read from `/api/extractions/<key>`; a
future WebSocket can push the same job state. The uploaded bytes, extraction job,
and decoded footage have separate records, so the same uploaded video can be
reopened without decoding it again.
@ -216,14 +265,14 @@ the root — all of it is extraction output, and tier 3 does not belong in the r
Loading detects one face per frame, measures the mouth, eyes and brows from
landmarks and the teeth from source pixels, then freezes them into channels,
and adds a button for the footage clip. Detection happens once when you load;
and opens the footage clip. Detection happens once when you load;
playback only resolves channels and paints. Frames without a detection remain
marked absent even though their neighbouring poses are used to condition the
track. The scene now records stable subject and feature IDs and explicit eye
pairs; dense channels can mark one feature absent while another is observed.
Current MediaPipe loading supplies only the full-face detection mask. The stage
stays 320×200 regardless of the footage dimensions. Real
footage starts at the source picture rate. The **picture fps** buttons sample the
footage starts at the source picture rate. The **picture** buttons in the inspector sample the
frozen roto at lower rates while the source track, duration and audio clock stay
unchanged. Picking frames to trace into cels is a separate future editing step.
**save** also stores the detection mask, dense landmarks and raw RGBA mouth crops
@ -252,7 +301,7 @@ runs the old JS tool on 8777, and the two are meant to run side by side.
## Saving
**save** and **open** in the transport. A save has three ordered stages:
**new**, **open** and **save** in the top bar. A save has three ordered stages:
is the tier split:
1. the **analysis** record, so every block stored afterwards can name the detector
@ -269,10 +318,11 @@ unchanged document says `0 leaves · 0 blocks`, which is both halves of the
addressing working at once — an unchanged leaf keeps its version, and a
content-addressed block is already there.
Two things are deliberately visible as failures. Saving `swarm` is refused,
because its blocks have hand-written names and a document may only name content
addresses. And **open** takes the most recently updated project and shows its first
clip: there is no project browser, and the store holds one clip at a time.
Saving `swarm` is deliberately visible as a failure: its blocks have
hand-written names and a document may only name content addresses.
`open ▾` lists every project the server holds, newest first, and shows the first
clip of whichever one is picked — the store holds one clip at a time.
## The oracle, which is finished
@ -313,12 +363,12 @@ them is `clips/templates/clips/index.html`.
## Two evaluators, on purpose
`domain/timeline` has both `eval-frame` and `resolver`, and they are not
`domain/symbol` has both `eval-frame` and `resolver`, and they are not
alternatives:
- **`(eval-frame timeline f store)`** is the specification. Allocating, order-free,
- **`(eval-frame symbol f store)`** is the specification. Allocating, order-free,
obviously correct. Tests and one-off renders use it.
- **`(resolver timeline store)` -> `(fn [f] ops)`** is what playback uses. It caches
- **`(resolver symbol store)` -> `(fn [f] ops)`** is what playback uses. It caches
the topological order and the z paths, holds a cursor per channel and reuses
one point buffer per node, so a frame allocates the op maps and nothing else.

View file

@ -12,6 +12,7 @@
than the render being spelled once per consumer."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]))
(defn wav-bytes
@ -91,22 +92,19 @@
(.setValueAtTime param (* factor v) (/ f fps)))))))
(defn tracks-of
"The audio nodes of one of the clip's timelines.
"The sounds symbol `sid` plays, including those inside what it places — see
`nest/audio-tracks`. Playback mixes the open symbol's."
[document sid]
(nest/audio-tracks document sid))
A timeline parameter rather than always the root, because a symbol is a
timeline and may carry its own sound. `:main` is the clip's own, which is what
playback mixes."
[document tid]
(filter #(= :audio (:kind %)) (vals (:nodes (clip/timeline document tid)))))
(defn- render! [document tid sources store]
(defn- render! [document sid sources store]
(let [fps (:fps document)
frames (:frames (clip/timeline document tid))
tracks (tracks-of document tid)
frames (:frames (clip/symbol document sid))
tracks (tracks-of document sid)
output (js/OfflineAudioContext.
2 (js/Math.ceil (* (/ frames fps) 44100)) 44100)]
(doseq [track tracks]
(let [[start end] (or (:span track) [0 frames])
(let [[start end] (or (node/placed-span track) [0 frames])
start (max 0 start)
end (min frames end)
{:keys [buffer fps]} (get sources (get-in track [:source :footage]))
@ -133,20 +131,20 @@
(.startRendering output)))
(defn buffer!
"Promise of the `AudioBuffer` one timeline's audio tracks mix down to, or nil
"Promise of the `AudioBuffer` one symbol's audio tracks mix down to, or nil
when it has none.
The raw product. `mix!` packages it as a WAV URL for the transport and
`export/frames` packages it as WAV bytes in an archive; a muxer would take it as
it is, which is why this is the function the others are written in terms of."
([document tid] (buffer! document tid nil))
([document tid store]
(let [tracks (tracks-of document tid)]
([document sid] (buffer! document sid nil))
([document sid store]
(let [tracks (tracks-of document sid)]
(if (empty? tracks)
(js/Promise.resolve nil)
(-> (js/Promise.all
(into-array (map source! (distinct (map #(get-in % [:source :footage]) tracks)))))
(.then (fn [pairs] (render! document tid (into {} (array-seq pairs)) store))))))))
(.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store))))))))
(defn decode!
"Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain
@ -162,9 +160,29 @@
(.decodeAudioData (js/OfflineAudioContext. 1 1 44100) bytes)))))
(defn mix!
"Promise of a mixed WAV URL, or the original URL for a clip without audio
tracks. Each track can be trimmed and faded independently of its linked picture."
([document fallback-url] (mix! document fallback-url nil))
([document fallback-url store]
(-> (buffer! document clip/root-id store)
(.then (fn [buffer] (if buffer (wav-url buffer) fallback-url))))))
"Promise of a mixed WAV URL for symbol `sid`, or the original URL when it has
no audio tracks. Each track can be trimmed and faded independently of its
linked picture."
[document sid fallback-url store]
(-> (buffer! document sid store)
(.then (fn [buffer] (if buffer (wav-url buffer) fallback-url)))))
(defn clock!
"Promise of the URL the transport should play while symbol `sid` is open.
The frame is derived from the audio element and from nothing else, so every
open symbol needs a sound exactly as long as it is. In order: its own placed
tracks, mixed; the document's audio file, for the symbol the document opens on
and only that one; and otherwise SILENCE of the symbol's length — a ten-frame
symbol played against the whole take's soundtrack would run ten frames and then
keep the clock going for minutes."
[document sid fallback-url store]
(-> (buffer! document sid store)
(.then (fn [buffer]
(cond
buffer (wav-url buffer)
(and fallback-url (= sid (clip/opens-on document))) fallback-url
:else (let [rate 44100
n (max 1 (js/Math.ceil (* rate (/ (clip/frames document sid)
(:fps document)))))]
(wav-url (.createBuffer (js/OfflineAudioContext. 1 1 rate) 1 n rate))))))))

View file

@ -4,12 +4,17 @@
port-plan step 3: the hand-written scene plays at 30fps against audio, scrubs,
and runs at ½× and ¼×."
(:require [arthur.db :as db]
[arthur.events.collab :as collab]
[arthur.events.footage :as footage]
[arthur.events.history :as history]
[arthur.events.playback]
[arthur.events.paint]
[arthur.events.project]
[arthur.events.project :as project]
[arthur.events.ui]
[arthur.subs.playback]
[arthur.subs.render]
[arthur.subs.ui]
[arthur.ui.index :as index]
[arthur.ui.player :as player]
[arthur.ui.shell :as shell]
[re-frame.core :as rf]
@ -24,14 +29,23 @@
;; the loop would otherwise sit on an unchanged frame number and never redraw.
(rf/clear-subscription-cache!)
(player/refresh-subs!)
(rdc/render @root [shell/view]))
(rdc/render @root [:<> [shell/view] [index/view]]))
(defn init []
(rf/dispatch-sync [::init])
;; A blank document, before the first render. Synchronous for the same reason
;; `::init` is: the shell reads the clip's dimensions, and mounting against a
;; db that has no clip in it yet is a frame of nothing for no reason.
(rf/dispatch-sync [::project/new])
;; What the server already holds, asked for once. The list is small — a row per
;; ingested take — and having it before the first click is what lets the footage
;; picker be a picker rather than a path to type.
(rf/dispatch [::footage/refresh])
(rf/dispatch [::project/list-symbols])
;; After the blank document, so an address that names a project opens it over
;; the blank one, and the blank one is what a bad address leaves on screen.
(collab/start!)
(history/install-keys!)
(reset! root (rdc/create-root (js/document.getElementById "app")))
(mount)
(player/start!))

View file

@ -20,10 +20,8 @@
Read OFF the clip rather than written again beside it: copying a number by hand
into this table is how it comes to disagree with the document it describes.
`:frames` comes from the ROOT TIMELINE and `:fps` from the clip, which is the
split `arthur.domain.clip` exists to make — a timeline is a frame space, a clip
is a rate — and an earlier version of this docstring noted that they sat on one
map \"only because there is one clip per scene today\". They do not any more."
There is no `:frames` here, because a length belongs to a symbol and which
symbol is open is the editor's state — see `events/playback/frames`."
[label-key label clip store]
(merge {:label label :clip clip :store store
;; A static asset since step 9, and not the repo root's `audio.wav`.
@ -32,8 +30,7 @@
;; that the clock has something to run against with no footage ingested.
:audio "/static/arthur/audio.wav"
:cid (name label-key)
:display-fps (:fps clip)
:frames (domain-clip/frames clip)}
:display-fps (:fps clip)}
(select-keys clip [:fps :width :height])))
(def clips
@ -54,7 +51,14 @@
(def default
{;; --- the document ---
:clip/current :take
;;
;; NOTHING IS LOADED. `core/init` dispatches `::project/new` before the first
;; render, so the app opens on a blank stage rather than on whichever built-in
;; scene happened to be convenient — the demos, the swarm and the two takes are
;; rows in the media pool like anything else, and reference material is not a
;; default. The values below are what a blank document is; they are replaced by
;; that dispatch and exist so this map is a valid db on its own.
:clip/current nil
:paint/revision 0
:palette :arthur/default ; a NAME; the ramp itself is project data
@ -64,19 +68,31 @@
;; footage's. That is what deleting `makeXform` buys — the framing became a
;; transform on a node, so nothing downstream of the freeze knows the frame
;; size — and it is why ui/player no longer hardcodes 320x200.
:clip (select-keys (clip-entry :take) [:fps :frames :width :height :audio :display-fps])
:clip (let [c (domain-clip/blank)]
{:fps (:fps c)
:width (:width c) :height (:height c)
:audio nil :display-fps (:fps c)})
;; Which ingested footage to detect, and what the last load said. The list
;; comes from the server — tier 3 is the backend's since step 9 — so there is
;; no path to type any more.
:footage {:id nil :label nil :loading? false :status nil
:available [] :chosen nil}
:available [] :chosen nil :uploaded #{}}
;; Every symbol in every saved project, for the pool's all-assets folder. Rows
;; from `/api/symbols`, nothing loaded: a symbol from elsewhere is fetched when
;; it is dropped.
:assets {:symbols [] :loading? false}
;; The document's own identity on the server. `:seq` is the monotonic project
;; version: a client that sees a delta with `seq > local + 1` refetches, which
;; is what will make staleness self-healing once there is a broadcast to miss.
:project {:id nil :cid nil :name nil :seq nil :busy? false :status nil}
;; What the server holds, for the open menu. A list of rows and nothing more —
;; opening one fetches the document itself.
:projects {:items [] :loading? false}
;; --- transport ---
;;
;; The playhead is in app-db like everything else. An earlier draft of
@ -92,11 +108,12 @@
;; machinery that would share it.
;; --- export ---
;;
;; The REQUEST and its progress, never the frames. Which timeline to write and
;; The REQUEST and its progress, never the frames. Which symbol to write and
;; at what integer zoom is authored state like anything else; the megabytes the
;; render produces are handed straight to a download and never enter the db.
;; `:isolate` is the placement to render alone, or nil for the whole timeline.
:export {:timeline :main :isolate nil :zoom 4 :busy? false :done 0 :total 0
;; `:isolate` is the placement to render alone, or nil for the whole symbol;
;; `:symbol` nil means whichever symbol is open.
:export {:symbol nil :isolate nil :zoom 4 :busy? false :done 0 :total 0
:status nil}
:playback {:frame 0
@ -105,7 +122,48 @@
;; Both for profiling: loop so a run at 4x lasts longer than the
;; clip, mute so sitting in one does not require enduring it.
:loop? false
:muted? false}})
:muted? false}
;; --- the editor's own state ---
;;
;; IN app-db, not in ratoms beside the components that read it. What is
;; selected is asked by four panes at once — the params pane renders it, the
;; timeline highlights its row, the stage draws its handles, the palette says
;; which tone a new shape gets — and a `defonce` atom private to one namespace
;; can only be shared by making the other three require that namespace for its
;; state. It is also small and authored, which is the bar `arthur.db` sets.
;;
;; `:selection` is a vector whose first element says what kind of thing it
;; names, so a pane dispatches on it rather than on which of several
;; "selected-x" keys happens to be non-nil:
;;
;; [:node <symbol> <node>] a shape or an instance
;; [:symbol <id>] a symbol
;; [:subject <id>] [:feature <id>] [:group <id>] a tracked object
;;
;; `:draft` is the polygon being clicked out, flat [x y x y …] as geometry is
;; stored everywhere. `:expanded` holds timeline row PATHS — a path and not a
;; node id, because one symbol placed twice is two rows that open separately.
;;
;; `:open` is the symbol on screen — the one the stage draws, the timeline
;; lists, the transport plays and a new shape goes into — and `:tabs` the
;; symbols open beside it. Editor state and not the document's, because no
;; symbol is special to the document: which one you are looking at is a fact
;; about you.
;;
;; `:knobs` holds a generated setting's value WHILE THE REGENERATION IS IN
;; FLIGHT, keyed by [scope id knob]. Moving a slider dispatches a preview that
;; re-freezes blocks asynchronously, so until it lands the clip still reports
;; the old value — and a slider reading from the clip would spring back under
;; the user's finger on every frame of the drag.
:ui {:open nil
:tabs []
:selection nil
:tone :skin-base
:tool nil
:draft []
:knobs {}
:expanded #{}}})
(def rates
"The transport's rates — all of them `playbackRate` on the audio element, so

View file

@ -6,7 +6,7 @@
validates would not be the one that renders, and the model would be validated
against a scene nobody ever looked at."
(:require [arthur.domain.clip :as domain-clip]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[cljs.reader :as reader]
[shadow.resource :as rc]))
@ -14,15 +14,15 @@
(def clip (reader/read-string source))
(def timeline
"The clip's root timeline: what an evaluator takes. `clip` is the document."
(domain-clip/root clip))
(def main
"The scene's one symbol: what an evaluator takes. `clip` is the document."
(domain-clip/symbol clip :main))
(def fps (:fps clip))
(def frames (domain-clip/frames clip))
(def frames (domain-clip/frames clip :main))
(defn ops-at
"Draw ops for one frame, via the specification path. The page uses
`timeline/resolver` instead; this is here for the REPL."
`symbol/resolver` instead; this is here for the REPL."
[f]
(timeline/eval-frame timeline f))
(symbol/eval-frame main f))

View file

@ -32,7 +32,7 @@
:width 320
:height 200
:timelines
:symbols
{:main
{:id :main
:frames 229

View file

@ -35,7 +35,7 @@
(let [{:keys [name width height frames symbol instances audio scale]} layout
default-anchor (or (:anchor layout)
[(/ (:width source) 2) (/ (:height source) 2)])
original (get-in source [:timelines :main])
original (get-in source [:symbols :main])
;; Authored id -> uuid, so the `:linked-to` in the EDN resolves to the
;; identity the document uses. Built before either pass because the audio
;; nodes refer to the instances.
@ -47,11 +47,11 @@
:known (vec (sort-by str (keys by-id)))}))))
nodes (into
{:root {:id :root :name "stage" :kind :group :z "a1"}}
(map (fn [{:keys [uuid name z span at in center anchor drift phase]}]
(map (fn [{:keys [uuid name z span at center anchor drift phase]}]
(let [anchor (or anchor default-anchor)]
[uuid {:id uuid :name name :kind :symbol :of symbol
[uuid {:id uuid :name name :kind :instance :of symbol
:parent :root :z z :span span
:time {:mode :map :at at :in in :rate 1}
:time {:mode :map :at at :rate 1}
:channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor)))
@ -59,15 +59,15 @@
[:xform :scale] scale}}]))
instances))
nodes (into nodes
(map (fn [{:keys [uuid linked-to z source span at in gain pan]}]
(map (fn [{:keys [uuid linked-to z source span at gain pan]}]
[uuid {:id uuid :kind :audio :parent :root :z z
:linked-to (uuid-of uuid linked-to)
:source source :span span
:time {:mode :map :at at :in in :rate 1}
:time {:mode :map :at at :rate 1}
:channels (cond-> {[:audio :gain] gain}
pan (assoc [:audio :pan] pan))}])
audio))]
(assoc source :name name :width width :height height
:timelines (assoc (:timelines source)
:symbols (assoc (:symbols source)
:main {:id :main :frames frames :nodes nodes}
symbol (assoc original :id symbol)))))

View file

@ -19,16 +19,18 @@
:over []}
;; Audio placements are ordinary timeline nodes with channel parameters.
;; :linked-to is an editorial link; their spans and time maps are independent.
;; A span is in the placement's OWN frames and :at is where its frame 0 lands on
;; the stage, so every entrance below plays from its own start.
:audio
[{:id :voice-left :uuid #uuid "eeaa49c3-1238-469f-bf54-44929e379f6b"
:linked-to :left :z "a3"
:source {:footage "f8cace9e-4ad3-4796-973c-c62eeebe3d01"}
:span [0 280] :at 0 :in 0
:at 0 :span [0 280]
:gain {:animated? false :value 1.0}}
{:id :voice-right :uuid #uuid "468239dd-0e3a-4e5c-ac6f-1858430a0355"
:linked-to :right :z "a4"
:source {:footage "f8cace9e-4ad3-4796-973c-c62eeebe3d01"}
:span [48 260] :at 48 :in 0
:at 48 :span [0 212]
:gain {:animated? true :interp :linear
:keys {48 0.0, 60 1.0, 90 0.35, 115 0.9, 145 0.45,
170 1.0, 195 0.4, 220 0.85, 245 1.0, 259 0.0}
@ -49,29 +51,29 @@
:instances
[{:id :left :uuid #uuid "ee7321c8-faf1-46d7-8029-37771898accb"
:name "8625 left" :z "a1"
:span [0 280] :at 0 :in 0
:at 0 :span [0 280]
:center [40 40] :drift [3 2] :phase 0}
{:id :right :uuid #uuid "1aa0da78-b4ed-4bb6-8d70-b09a3ec5e2c3"
:name "8625 right" :z "a2"
:span [48 280] :at 48 :in 0
:at 48 :span [0 232]
:center [120 40] :drift [-3 2] :phase 17}
{:id :top-third :uuid #uuid "23bb697d-eba7-4af6-a86c-606c50107088"
:name "8625 top third" :z "a5"
:span [24 280] :at 24 :in 0
:at 24 :span [0 256]
:center [200 40] :drift [2 -3] :phase 31}
{:id :top-fourth :uuid #uuid "f4f0241d-026e-4e50-9bea-a4ccde896d8a"
:name "8625 top fourth" :z "a6"
:span [72 280] :at 72 :in 0
:at 72 :span [0 208]
:center [280 40] :drift [-2 -2] :phase 49}
{:id :bottom-left :uuid #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
:name "8625 bottom left" :z "a7"
:span [96 280] :at 96 :in 0
:at 96 :span [0 184]
:center [70 135] :drift [3 -2] :phase 63}
{:id :bottom-middle :uuid #uuid "63f3fb32-9e94-4d68-a1c2-12e6de2d04b5"
:name "8625 bottom middle" :z "a8"
:span [120 280] :at 120 :in 0
:at 120 :span [0 160]
:center [160 135] :drift [-2 3] :phase 81}
{:id :bottom-right :uuid #uuid "fa338701-cb21-4d45-89f1-a5e706f045ec"
:name "8625 bottom right" :z "a9"
:span [144 280] :at 144 :in 0
:at 144 :span [0 136]
:center [250 135] :drift [2 2] :phase 107}]}

View file

@ -153,7 +153,7 @@
:fps fps
:width 320
:height 200
:timelines
:symbols
{:main
{:id :main
:frames frames

View file

@ -12,7 +12,7 @@
│
FREEZE ──▶ channels on nodes
│
timeline/resolver ──▶ raster
symbol/resolver ──▶ raster
— and the order of that diagram is the whole argument for the stage split. The
anchor fit is knob-free. Conditioning smooths its four parameters. The rings are

View file

@ -0,0 +1,116 @@
(ns arthur.domain.bring
"Bringing symbols into a clip from another: out of a saved project, or out of
a freeze of new footage.
Copied, never linked. What comes in gets ids of its own where they are taken,
and editing it here does not touch where it came from. Tracking identities and
the analysis they were measured by come along only when the receiving clip can
hold them; otherwise what comes in is drawing, which plays but does not re-tune.
Plain data in and out — documents, and in `placed` a document with its store —
so the events that fetch them are only fetching."
(:refer-clojure :exclude [take])
(:require [arthur.domain.clip :as clip]
[clojure.string :as string]))
(defn symbols
"Copy symbols `roots` of clip `other`, and every symbol they place, into
`clip`. Returns `{:clip :ids}`, where `:ids` maps each copied symbol's id in
`other` to its id here.
AN ID THAT IS TAKEN IS RENAMED, never merged: two symbols that happen to share
an id are two drawings, and an instance's `:of` inside the copy is rewritten to
follow. `wanted` maps a root's id in `other` to the id it should preferably get,
which is how a symbol made from footage is called what the person typed rather
than `:main`.
Only symbols travel. What else `other` holds — tracking identities, an analysis
— is the caller's decision, because whether it can come too depends on what
`clip` already has."
[clip other roots wanted]
(let [;; A tree walk is safe because placing cannot make a cycle.
reach (into #{} (mapcat #(tree-seq any? (partial clip/places other) %)) roots)
ids (reduce (fn [ids sid]
(let [taken? #(or (contains? (:symbols clip) %)
(some #{%} (vals ids)))]
(assoc ids sid (clip/free-id taken? (get wanted sid sid)))))
{} (sort-by str reach))
copy (fn [sid]
(-> (clip/symbol other sid)
(assoc :id (ids sid))
(update :nodes #(into {} (map (fn [[id n]]
[id (cond-> n (:of n) (update :of ids))]))
%))))]
{:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach)
:ids ids}))
(defn symbol-id
"An id for a symbol a person has named: the name, lower-cased and hyphenated,
or `:symbol` when nothing of it survives."
[label]
(let [slug (-> (str label) string/lower-case
(string/replace #"[^a-z0-9]+" "-")
(string/replace #"^-+|-+$" ""))]
(keyword (if (seq slug) slug "symbol"))))
(defn take
"Put `frozen`, a take, into `clip` as ONE symbol called `label`. Returns
`{:clip :sid :tracked?}`.
`frozen` is what `flow/freeze/clip` makes: a `:main` that places one symbol per
tracked face. `:main` becomes the named symbol — it is what holds the faces in
stage pixels, so it is the thing worth placing — and it gets the take's SOUND
as an audio node of its own, source frames `range` of footage `footage-id`, so
wherever the symbol is placed it is heard.
The tracking identities, and the analysis they were measured by, come along
only when `clip` has no analysis of its own and no face had to be renamed. A
document holds one analysis, and regeneration finds a face's symbol by its
subject id, so either condition failing means the take comes in as drawings
that play but cannot be re-tuned — `:tracked? false` says so."
[clip frozen label footage-id range]
(let [{c :clip ids :ids} (symbols clip frozen [:main] {:main (symbol-id label)})
sid (ids :main)
source-fps (:fps frozen)
project-fps (:fps clip)
;; The new symbol is played by the receiving project's clock. Keep its
;; wall-clock duration by giving it project-rate frames, while its root
;; maps those frames back onto the source timeline. A 30fps source in a
;; 12fps project therefore has 2.5 source frames per project frame.
source-rate (if (and (number? source-fps) (pos? source-fps)
(number? project-fps) (pos? project-fps))
(/ source-fps project-fps)
1)
output-frames (max 1 (js/Math.ceil (/ (clip/frames c sid) source-rate)))
c (-> c
(assoc-in [:symbols sid :frames] output-frames)
(update-in [:symbols sid :nodes :root :time]
#(assoc (or % {}) :mode :map :at 0 :rate source-rate)))
tracked? (and (nil? (:analysis clip))
(every? #(= % (ids %)) (keys (:subjects frozen))))]
{:sid sid
:tracked? tracked?
:clip (cond-> (-> c
(assoc-in [:symbols sid :name] (str label))
(assoc-in [:symbols sid :nodes :sound]
{:id :sound :name "sound" :kind :audio :parent nil
:z "z-sound" :source {:footage footage-id}
;; Source frame `start` plays on the symbol's 0.
:span range
:time {:mode :map
:at (/ (- (first range)) source-rate)
:rate source-rate}}))
tracked? (-> (assoc :analysis (:analysis frozen))
(update :subjects merge (:subjects frozen))
(update :features merge (:features frozen))
(update :groups merge (:groups frozen))))}))
(defn placed
"`entry` — a document and its store — once `brought` holds the symbols brought
in and `store` their blocks: the stores merged and an instance of `sid` placed
in `host` at `frame`, its middle on stage pixel `point` or where it was drawn
when there is none. See `clip/place-symbol`."
[entry brought store sid host frame uuid point]
(let [st (merge (:store entry) store)]
(assoc entry :store st :clip (clip/place-symbol brought st host sid frame uuid point))))

View file

@ -1,47 +1,48 @@
(ns arthur.domain.clip
"A CLIP: the unit of work, and a library of timelines.
"A CLIP: the unit of work, and a library of symbols.
{:name \"take\"
:fps 30
:width 320 :height 200
:analysis {...}
:subjects {...} :features {...} :groups {...}
:timelines {:main {:id :main :frames 229 :nodes {...}}}}
:symbols {:main {:id :main :frames 229 :nodes {...}}}}
Every field here is a fact about the clip and NOT about a bag of nodes, which is
the cut this namespace exists to make. Before it, one map carried both: `:fps`,
the stage dimensions, the analysis record and the tracking identities sat beside
`:nodes`, and `arthur.db` said of it — correctly — that they \"sit on the scene
map only because there is one clip per scene today\". The cost of leaving them
together was not untidiness. It was that a SYMBOL had nowhere to live: a library
timeline is a bag of nodes with a frame space and nothing else, so under the old
shape it would have had to be a clip with seven meaningless fields, or a second
structure with the same `:nodes` key that every walk had to be taught about.
`:nodes`. The cost of leaving them together was not untidiness. It was that a
SYMBOL had nowhere to live: a symbol is a bag of nodes with a frame space and
nothing else, so under the old shape it would have had to be a clip with seven
meaningless fields.
Now there is one node-holding type — `arthur.domain.timeline` — and a clip holds
a MAP of them. A `:kind :symbol` instance names a timeline in `:timelines`,
and the clip resolver gives each placement its own reading heads.
Now there is one node-holding type — `arthur.domain.symbol` — and a clip holds
a MAP of them. A `:kind :instance` node places one symbol inside another, and
the clip resolver gives each instance its own reading heads.
THE ROOT TIMELINE HAS A RESERVED ID, `:main`, rather than the clip carrying a
pointer to it. A pointer is a field that can be wrong — it can name a timeline
that is not there, and then every reader needs a fallback — where a reserved name
can only be absent, which `problems` reports once. Flash reserves `_root` the
same way and for the same reason. Nothing else about `:main` is special: it is an
ordinary entry in the map, and a symbol is another one.
WHAT IS NOT HERE: how nested symbols' frames and coordinates relate, and
moving nodes between them, are `arthur.domain.nest`; bringing symbols in from
another clip is `arthur.domain.bring`. This namespace is the document and the
operations that only need the document.
NO SYMBOL IS SPECIAL. There is no reserved root and no pointer to one: which
symbol is on screen is the editor's state, not the document's, and every
function here that needs a symbol is told which. A new document has one symbol
called `:main` because it has to be called something, and that is all the name
means — it can be renamed, placed inside another symbol or deleted like any of
them. `unplaced` answers the question a reserved root used to: which symbols
nothing else places, and so which ones a person opening the document wants.
WHY :fps IS HERE AND :frames IS NOT. A rate is how fast the whole clip plays
against its audio, and a nested timeline cannot have one of its own — retiming an
against its audio, and a nested symbol cannot have one of its own — retiming an
instance is `:rate` on its `:time` map, which is a factor and not a rate. A
frame COUNT is a property of a frame space, so every timeline has its own."
frame COUNT is a property of a frame space, so every symbol has its own."
(:refer-clojure :exclude [symbol])
(:require [arthur.domain.feature :as feature]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pose :as pose]
[arthur.domain.timeline :as timeline]))
(def ^:const root-id
"The reserved id of the timeline a clip plays. See the namespace docstring."
:main)
[arthur.domain.symbol :as symbol]))
(def clip-keys
"Every top-level field of a clip, and the reason `arthur.domain.leaf` refuses
@ -50,46 +51,98 @@
that loses something on every round trip, which is the one bug a persistence
layer must not be able to have. Add the field here and to `leaf/leaves` and
`leaf/clip` in the same commit."
#{:name :fps :analysis :subjects :features :groups :width :height :timelines})
#{:name :fps :analysis :subjects :features :groups :width :height :symbols})
(defn timeline
"One of the clip's timelines, by id."
[clip id]
(get-in clip [:timelines id]))
(defn symbol
"One of the clip's symbols, by id."
[clip sid]
(get-in clip [:symbols sid]))
(defn root
"The timeline the clip plays."
[clip]
(timeline clip root-id))
(defn symbol-name
"What to call a symbol: its `:name`, or its id when it has none."
[clip sid]
(or (:name (symbol clip sid)) (name sid)))
(defn frames
"The clip's length, which is its root timeline's frame space and is not written
down twice. Reading it off the root is what stops the two from disagreeing."
"A symbol's length. Read off the symbol, never copied beside it."
[clip sid]
(:frames (symbol clip sid)))
(defn stage
"A symbol's stage as `[width height]`: its own, or the clip's where it has none.
Absent rather than copied in at creation, so a symbol nobody has sized follows
the project's size when that changes."
[clip sid]
(let [sym (symbol clip sid)]
[(or (:width sym) (:width clip)) (or (:height sym) (:height clip))]))
(defn update-symbol
"Apply f to one symbol in place."
[clip sid f & args]
(apply update-in clip [:symbols sid] f args))
(defn places
"The ids of the symbols `sid` places, directly."
[clip sid]
(into #{} (keep (fn [n] (when (= :instance (:kind n)) (:of n))))
(vals (:nodes (symbol clip sid)))))
(defn contains-symbol?
"Whether `inner` is `outer` or is placed anywhere inside it. Placing `outer`
into `inner` when this is true is a cycle."
[clip outer inner]
(let [seen (volatile! #{})]
(letfn [(walk [sid]
(or (= sid inner)
(when-not (@seen sid)
(vswap! seen conj sid)
(some walk (places clip sid)))))]
(boolean (walk outer)))))
(defn unplaced
"The symbols no other symbol places, sorted by id. What to open when a
document is opened."
[clip]
(:frames (root clip)))
(let [placed (into #{} (mapcat #(places clip %)) (keys (:symbols clip)))]
(vec (sort-by str (remove placed (keys (:symbols clip)))))))
(defn update-timeline
"Apply f to one timeline in place."
[clip id f & args]
(apply update-in clip [:timelines id] f args))
(defn update-root [clip f & args]
(apply update-timeline clip root-id f args))
(defn nodes
"The root timeline's nodes. A convenience for the many callers that mean the
root and would otherwise spell it out; anything that could mean a symbol says
which timeline instead."
(defn opens-on
"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
unplaced ones in every document made so far, and a reserved name is what this
replaces."
[clip]
(:nodes (root clip)))
(first (sort-by (fn [sid] [(- (or (frames clip sid) 0)) (str sid)])
(unplaced clip))))
(def ^:const blank-frames
"How long a new document is before anything says otherwise. Four seconds at 30,
which is long enough to key something into and short enough to scrub by hand."
120)
(defn blank
"A new, empty document: one empty symbol.
`:nodes` is empty rather than seeded with a layer, because an empty symbol is
a true statement and a layer nobody asked for is one more thing to delete. The
tracking maps are present and empty for the same reason `clip-keys` exists: a
field that is sometimes absent is a field every reader needs a fallback for."
[]
{:name "untitled"
:fps 30
:width 320 :height 200
:subjects {} :features {} :groups {}
:symbols {:main {:id :main :frames blank-frames :nodes {}}}})
(defn- transform-op
"Put a symbol's already resolved mark into its instance's parent space."
"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."
[op m path]
(let [at (fn [x y] [(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4))
(+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))])
scale (node/mean-scale m)
op (assoc op :node (conj path (:node op)))]
n (:node op)
op (assoc op :node (if (vector? n) (into path n) (conj path n)))]
(case (:kind op)
:poly (let [out (js/Float64Array. (.-length (:pts op)))]
(dotimes [i (:n op)]
@ -105,35 +158,30 @@
op)))
(defn resolver
"Resolve a clip, including each library timeline placed by a symbol instance.
"Resolve symbol `sid` of a clip, including every symbol its instances place.
Each instance owns its own timeline resolver, so two offsets never share a
Each instance owns its own symbol resolver, so two offsets never share a
channel cursor or point buffer. The returned ops must be drawn before the next
frame, as with timeline/resolver.
frame, as with symbol/resolver.
`root` is which timeline to resolve AS the root, and it defaults to the clip's.
Passing a symbol's id is the whole of \"render that symbol\": a library timeline
and the clip's own are the same type, so a symbol resolves by being rooted
rather than by a second code path — which is the return on collapsing the two
into `domain/timeline`. Its frame space is its own `:frames`, and nested symbols
inside it still resolve, because this is the function that knows how to do that."
([clip store] (resolver clip store pal/index-of root-id))
([clip store palette] (resolver clip store palette root-id))
([clip store palette root] (resolver clip store palette root nil))
([clip store palette root {:keys [picture-fps] :as opts}]
(letfn [(build [tid chain pose-tracks]
(when (some #{tid} chain)
(throw (ex-info "symbol timeline cycle" {:chain (conj chain tid)})))
(let [tl (or (timeline clip tid)
(throw (ex-info "symbol names a missing timeline" {:timeline tid})))
nodes (:nodes tl)
rank (timeline/draw-rank nodes (timeline/order nodes))
Any symbol can be resolved and none is the default: the frame space is the
resolved symbol's own `:frames`, and nested instances inside it still resolve,
because this is the function that knows how to do that."
([clip store palette sid] (resolver clip store palette sid nil))
([clip store palette sid {:keys [picture-fps] :as opts}]
(letfn [(build [sid chain pose-tracks]
(when (some #{sid} chain)
(throw (ex-info "symbol cycle" {:chain (conj chain sid)})))
(let [sym (or (symbol clip sid)
(throw (ex-info "an instance names a missing symbol" {:symbol sid})))
nodes (:nodes sym)
rank (symbol/draw-rank nodes (symbol/order nodes))
ids (sort-by rank (keys nodes))
own (timeline/resolver tl store palette pose-tracks
own (symbol/resolver sym store palette pose-tracks
(assoc opts :source-fps (:fps clip)))
children (into {}
(for [[id n] nodes :when (= :symbol (:kind n))]
[id (build (:of n) (conj chain tid)
(for [[id n] nodes :when (= :instance (:kind n))]
[id (build (:of n) (conj chain sid)
(get-in n [:playback :tracks]))]))]
(fn [f]
(let [by-id (into {} (map (juxt :node identity)) (own f))]
@ -141,10 +189,10 @@
(mapcat
(fn [id]
(let [n (get nodes id)]
(if (= :symbol (:kind n))
(let [m (timeline/world-of own id)
local (timeline/frame-of own id)
target (timeline clip (:of n))
(if (= :instance (:kind n))
(let [m (symbol/world-of own id)
local (symbol/frame-of own id)
target (symbol clip (:of n))
length (:frames target)
frame (when (and m (number? local))
(if (get-in n [:time :loop?])
@ -155,7 +203,109 @@
[]))
(when-let [op (get by-id id)] [op]))))
ids))))))]
(build root [] nil))))
(build sid [] nil))))
(defn center
"The middle of everything symbol `sid` draws, over all its frames, in its own
coordinates. ALL frames rather than the first, so a symbol whose drawing
enters late, or travels, still has its middle where the drawing is. A symbol
that draws nothing gets the STAGE's middle, which is where a drawing made into
it will be, because drawings are made on the stage.
What this feeds is a DEFAULT: `place-symbol` copies it into a new instance's
anchor and nothing ever updates it, as Flash's transformation point and After
Effects' anchor point are set once and left. A symbol that grows later keeps
its instances' pivots where they were, so nothing on screen moves."
[clip store sid]
(let [resolve (resolver clip store pal/index-of sid)
bounds (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
[x0 y0 x1 y1]
(reduce
(fn [b {:keys [kind pts n cx cy r size]}]
(case kind
:poly (reduce (fn [b i] (bounds b (aget pts (* 2 i)) (aget pts (inc (* 2 i)))))
b (range n))
:disc (-> b (bounds (- cx r) (- cy r)) (bounds (+ cx r) (+ cy r)))
:rect (let [h (/ size 2)] (-> b (bounds (- cx h) (- cy h)) (bounds (+ cx h) (+ cy h))))
b))
nil
(mapcat resolve (range (frames clip sid))))]
(if x0
[(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]
(mapv #(/ % 2) (stage clip sid)))))
(defn place-symbol
"An instance of symbol `sid`, inside symbol `host`, at `frame` of `host`.
THE ANCHOR IS THE MIDDLE. Every instance pivots about the centre of what it
draws — see `center` — so rotating or scaling one turns it in place rather than
swinging it about a corner. At the identity transform the anchor moves nothing,
so where the drawing lands is `pos` alone: with `point`, a stage pixel, the
middle goes there; without one — a drop on the timeline — the drawing stays
where it was drawn.
THE UUID IS AN ARGUMENT. A placement's identity is the key it has in the node
map — it is what `:linked-to`, an export target and a saved leaf all name — so
generating one in here would make this function's result depend on when it was
called, and this namespace is the pure one.
The instance's own time starts where it was dropped: `:at frame` means frame 0
of the symbol plays on `frame` of `host`, which is what dragging something onto
a playhead is asking for. Its `:span` is in its OWN frames — the whole symbol,
0 to its length — wherever it was dropped; see `node/placed-span`.
Refused, returning the clip unchanged, when it would make a cycle: a symbol
cannot be placed inside itself or inside anything it places."
[clip store host sid frame uuid point]
(let [target (symbol clip sid)
end (frames clip host)]
(if (or (nil? target) (nil? end) (nil? frame) (neg? frame) (>= frame end)
(contains-symbol? clip sid host))
clip
(let [middle (center clip store sid)]
(update-symbol
clip host assoc-in [:nodes uuid]
{:id uuid
:name (symbol-name clip sid)
:kind :instance
:of sid
:parent nil
;; Lexicographic draw order, as `domain/paint` does it: a placement made
;; later sits above one made earlier, and neither has to renumber.
:z (str "z" (js/Date.now) "-" (name sid))
:span [0 (:frames target)]
:time {:mode :map :at frame :rate 1}
:channels {[:xform :pos] {:animated? false
:value (if point (mapv - point middle) [0 0])}
[:xform :anchor] {:animated? false :value middle}}})))))
(defn fresh-id
"The first `:symbol-N` the clip does not already hold. Readable because an id
shows up in saved leaf paths, and deterministic because this namespace is pure."
[clip]
(first (remove (:symbols clip) (map #(keyword (str "symbol-" %)) (iterate inc 1)))))
(defn new-symbol
"A new, empty symbol `sid`, placed inside `host` at `frame` and running to the
end of it. Placed at the origin, so whatever is drawn into it lands where it was
drawn until the instance is moved."
[clip host sid frame uuid]
(let [end (frames clip host)]
(if (or (nil? end) (symbol clip sid) (nil? frame) (neg? frame) (>= frame end))
clip
(-> clip
(assoc-in [:symbols sid] {:id sid :name (name sid) :frames (- end frame) :nodes {}})
(place-symbol nil host sid frame uuid nil)))))
(defn free-id
"`wanted`, or the first `wanted-2`, `wanted-3`… `taken?` does not claim.
Keeps the namespace, so `:sym/face` becomes `:sym/face-2`."
[taken? wanted]
(first (remove taken?
(cons wanted
(map #(keyword (namespace wanted) (str (name wanted) "-" %))
(iterate inc 2))))))
(defn problems
"Human-readable reasons this clip will not evaluate or save."
@ -164,28 +314,26 @@
(concat
(for [k (remove clip-keys (keys clip))]
(str "clip has a field with no leaf to save it in: " (pr-str k)))
(when-not (map? (:timelines clip))
[":timelines must be a map of id -> timeline"])
(when (and (map? (:timelines clip)) (nil? (root clip)))
[(str "no " (pr-str root-id) " timeline — a clip plays the one with the reserved id")])
(when-not (map? (:symbols clip))
[":symbols must be a map of id -> symbol"])
(when-not (or (nil? (:fps clip)) (and (number? (:fps clip)) (pos? (:fps clip))))
[(str ":fps is " (pr-str (:fps clip)) " — a rate is a positive number")])
(for [[id tl] (:timelines clip)
:when (not= id (:id tl))]
(str "timeline under key " (pr-str id) " has :id " (pr-str (:id tl))))
(for [[id tl] (:timelines clip)
p (timeline/problems tl)]
(str "timeline " (pr-str id) ": " p))
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)
:when (and (= :symbol (:kind n))
(not (contains? (:timelines clip) (:of n))))]
(str "timeline " (pr-str tid) " symbol " (pr-str id)
" names missing timeline " (pr-str (:of n))))
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)
:when (= :symbol (:kind n))
:let [target (get-in clip [:timelines (:of n)])
(for [[id sym] (:symbols clip)
:when (not= id (:id sym))]
(str "symbol under key " (pr-str id) " has :id " (pr-str (:id sym))))
(for [[id sym] (:symbols clip)
p (symbol/problems sym)]
(str "symbol " (pr-str id) ": " p))
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
:when (and (= :instance (:kind n))
(not (contains? (:symbols clip) (:of n))))]
(str "symbol " (pr-str sid) " instance " (pr-str id)
" names missing symbol " (pr-str (:of n))))
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
:when (= :instance (:kind n))
:let [target (get-in clip [:symbols (:of n)])
active (filter (fn [node]
(some :pose-sampled? (vals (:channels node))))
(vals (:nodes target)))
@ -194,11 +342,11 @@
(map #(vector :node (:id %)) active)))]
p (pose/problems (get-in n [:playback :tracks])
(:frames target) groups)]
(str "timeline " (pr-str tid) " symbol " (pr-str id) ": " p))
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)
(str "symbol " (pr-str sid) " instance " (pr-str id) ": " p))
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
:when (and (= :audio (:kind n)) (:linked-to n)
(not (contains? (:nodes tl) (:linked-to n))))]
(str "timeline " (pr-str tid) " audio " (pr-str id)
(not (contains? (:nodes sym) (:linked-to n))))]
(str "symbol " (pr-str sid) " audio " (pr-str id)
" links to missing node " (pr-str (:linked-to n))))
(feature/problems clip))))

View file

@ -1,6 +1,6 @@
(ns arthur.domain.feature
"Tracked subjects, feature ownership, and eye-pair settings.
Features name their timeline explicitly; node ids are local to that timeline."
Features name their symbol explicitly; node ids are local to that symbol."
(:require [arthur.domain.params :as params]))
(defn owned
@ -44,14 +44,14 @@
clip))
(defn problems
"Check tracked identities and timeline-local node ownership."
"Check tracked identities and symbol-local node ownership."
[clip]
(let [subjects (:subjects clip)
features (:features clip)
groups (:groups clip)
memberships (mapcat (comp :members val) groups)
node-owners (for [[_ f] features n (:nodes f)]
[(:timeline f) n])]
[(:symbol f) n])]
(vec
(concat
(for [[id s] subjects :when (not= id (:id s))]
@ -60,8 +60,8 @@
:when (not (params/valid-settings? :subject (or (:params s) {})))]
(str "subject " (pr-str id) " has invalid settings"))
(for [[id _] subjects
:when (not (seq (get-in clip [:timelines id :nodes :head :measured])))]
(str "subject " (pr-str id) " has no measured head in its timeline"))
:when (not (seq (get-in clip [:symbols id :nodes :head :measured])))]
(str "subject " (pr-str id) " has no measured head in its symbol"))
(for [[id f] features :when (not= id (:id f))]
(str "feature " (pr-str id) " has a different :id"))
(for [[id f] features :when (not (contains? subjects (:subject f)))]
@ -72,10 +72,10 @@
:when (not (params/valid-settings? (:area f) (or (:params f) {})))]
(str "feature " (pr-str id) " has invalid settings for " (pr-str (:area f))))
(for [[id f] features
:when (not (contains? (:timelines clip) (:timeline f)))]
(str "feature " (pr-str id) " names a missing timeline"))
:when (not (contains? (:symbols clip) (:symbol f)))]
(str "feature " (pr-str id) " names a missing symbol"))
(for [[id f] features node-id (:nodes f)
:let [owned-nodes (get-in clip [:timelines (:timeline f) :nodes])]
:let [owned-nodes (get-in clip [:symbols (:symbol f) :nodes])]
:when (not (contains? owned-nodes node-id))]
(str "feature " (pr-str id) " refers to missing node " (pr-str node-id)))
(for [[id n] (frequencies node-owners) :when (> n 1)]

View file

@ -0,0 +1,130 @@
(ns arthur.domain.history
"Undo, per person, as leaf writes. docs/architecture.md, \"Undo is per-user\".
A step is the leaves one edit changed: what they held before, and what they
held after. Undoing writes the befores back as an ordinary edit, which the
next save sends like any other — so undo needs nothing from the server, and
nothing about it is shared.
ONLY YOUR OWN CHANGES. A step undoes only if every leaf it touched still holds
what the step left there. Somebody else's write to one of them since — their
edit to the shape you made — refuses the step rather than taking their work
with it; it is dropped, and the next undo is the step before. With nobody else
in the document the values always match, and this is ordinary undo.
A nil value is an absent leaf: a step that made a node has nil befores for its
leaves, so undoing it removes them."
(:require [clojure.string :as str]))
(def gap-ms
"Edits to the same leaves closer together than this are one step: a drag
writes a vertex per pointermove, and is one thing to undo. Only when each
starts where the last left off — anything landing between them, a
collaborator's write included, makes the next edit a step of its own."
1000)
(def depth 200)
(defn- changes
"`[before after]`, restricted to the paths that differ."
[before after]
(reduce (fn [[b a :as acc] path]
(let [x (get before path)
y (get after path)]
(if (= x y) acc [(assoc b path x) (assoc a path y)])))
[{} {}]
(distinct (concat (keys before) (keys after)))))
(defn- node-name [leaves path]
(let [[_ _ _ sid _ nid] (str/split path #"/")
node (get leaves (str/join "/" ["clip" "u" "symbol" sid "node" nid]))]
(or (:name node) (str/replace nid "~" "/"))))
(defn- said
"What one changed leaf was, in words, and how much it outranks the others:
making or deleting a thing names the step before editing it does."
[before after path]
(let [[_ _ kind a b] (str/split path #"/")
leaves (merge before after)]
(case [kind b]
["symbol" nil] [1 (str "symbol " (or (:name (get leaves path)) (str/replace a "~" "/")))]
["symbol" "node"]
(cond (nil? (get before path)) [0 (str "add " (node-name leaves path))]
(nil? (get after path)) [0 (str "delete " (node-name leaves path))]
:else [1 (str "edit " (node-name leaves path))])
(if (#{"channel" "measured"} b)
[1 (str "edit " (node-name leaves path))]
[2 (case kind
("timing" "stage" "name") "project settings"
("subject" "feature" "group") "tracking settings"
kind)]))))
(defn label
"A step in words: \"add shape 3\", \"edit mouth, brow-l\"."
[before after paths]
(let [said (->> paths (map #(said before after %)) distinct sort)
top (first (first said))
words (distinct (map second (filter #(= top (first %)) said)))]
(str (str/join ", " (take 2 words)) (when (< 2 (count words)) " …"))))
(defn record
"History `h` with an edit from leaves `before` to `after` at time `now`."
[{:keys [done held?] :as h} before after now]
(let [[b a] (changes before after)
top (peek done)]
(cond
(empty? a) h
(and top (not (:closed? top)) (= b (:after top))
(or held? (< (- now (:at top)) gap-ms)))
(assoc h :done (conj (pop done) (assoc top :after a :at now)) :undone [])
:else
(assoc h
:done (conj (vec (take-last (dec depth) done))
{:before b :after a :at now :label (label before after (keys a))})
:undone []))))
(defn- close [{:keys [done] :as h}]
(cond-> h (seq done) (assoc :done (conj (pop done) (assoc (peek done) :closed? true)))))
(defn hold
"While a field has focus, everything typed into it is one step, however slowly
— the digits of 45 are seen as 4 and then 45, and undone as one. It starts a
step of its own rather than joining whatever came before."
[h]
(assoc (close h) :held? true))
(defn settle
"The field is done with: its step is finished, and nothing joins it."
[h]
(dissoc (close h) :held?))
(defn steps
"The labels, newest first: `:done` is what undo would take off, `:undone`
what redo would put back."
[h]
{:done (mapv :label (rseq (or (:done h) [])))
:undone (mapv :label (rseq (or (:undone h) [])))})
(defn- holds? [leaves m]
(every? (fn [[path v]] (= v (get leaves path))) m))
(defn- put-all [leaves m]
(reduce-kv (fn [ls path v] (if (nil? v) (dissoc ls path) (assoc ls path v))) leaves m))
(defn- move
"One step from `from` to `to`, if `leaves` still hold what it expects."
[h leaves from to expect write]
(when-let [step (peek (get h from))]
(let [h (update h from pop)]
(if (holds? leaves (expect step))
{:leaves (put-all leaves (write step)) :history (update h to (fnil conj []) step)}
{:blocked step :history h}))))
(defn undo
"`{:leaves :history}`, `{:blocked :history}` when somebody else has since
changed what the step touched, or nil with nothing to undo."
[h leaves]
(move h leaves :done :undone :after :before))
(defn redo [h leaves]
(move h leaves :undone :done :before :after))

View file

@ -11,21 +11,21 @@
clip/<cid>/timing fps
clip/<cid>/stage width, height
clip/<cid>/source the analysis record this came out of
clip/<cid>/subject/<sid> a tracked subject and its params
clip/<cid>/subject/<subj> a tracked subject and its params
clip/<cid>/feature/<fid> one feature: area, nodes, params
clip/<cid>/group/<gid> an eye pair and its shared params
clip/<cid>/timeline/<tid> frames, and a palette one day
clip/<cid>/timeline/<tid>/node/<nid> kind, parent, stencil, z, time
clip/<cid>/timeline/<tid>/channel/<nid>/<prop>
clip/<cid>/timeline/<tid>/measured/<nid> the channels a re-freeze owns
clip/<cid>/symbol/<sid> frames, and a palette one day
clip/<cid>/symbol/<sid>/node/<nid> kind, parent, stencil, z, time
clip/<cid>/symbol/<sid>/channel/<nid>/<prop>
clip/<cid>/symbol/<sid>/measured/<nid> the channels a re-freeze owns
WHY NODES SIT UNDER A TIMELINE. A clip holds a library of timelines. Its root
and each symbol have their own nodes, so the timeline id is a path segment.
The root is `main`, and a symbol's nodes use the same path shape.
WHY NODES SIT UNDER A SYMBOL. A clip holds a library of symbols and each has
its own nodes, so the symbol id is a path segment. No symbol has a reserved
segment: `main` in a path is an id like any other.
`:frames` MOVED OFF `timing` onto the timeline. A timeline is a frame space and a
`:frames` MOVED OFF `timing` onto the symbol. A symbol is a frame space and a
clip is a rate, so `timing` holds `:fps` alone. Both used to be in one leaf, which
is how a nested timeline's length would have had nowhere to go.
is how a nested symbol's length would have had nowhere to go.
WHY THESE BOUNDARIES. Last-writer-wins only clobbers when its unit is too big,
so the cut is chosen so that the things people do simultaneously land on
@ -56,7 +56,7 @@
it is one character rather than a scheme."
(:require [arthur.domain.clip :as clip]
[arthur.domain.sha256 :as sha]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[clojure.string :as str]))
;; ---------------------------------------------------------------------------
@ -124,11 +124,11 @@
(when (seq unknown)
(throw (ex-info "the clip has a field with no leaf to save it in; see arthur.domain.clip/clip-keys"
{:unknown (vec (sort-by str unknown))}))))
(doseq [[id tl] (:timelines clip)]
(let [unknown (remove timeline/timeline-keys (keys tl))]
(doseq [[id sym] (:symbols clip)]
(let [unknown (remove symbol/symbol-keys (keys sym))]
(when (seq unknown)
(throw (ex-info "a timeline has a field with no leaf to save it in; see arthur.domain.timeline/timeline-keys"
{:timeline id :unknown (vec (sort-by str unknown))})))))
(throw (ex-info "a symbol has a field with no leaf to save it in; see arthur.domain.symbol/symbol-keys"
{:symbol id :unknown (vec (sort-by str unknown))})))))
(let [at (fn [& parts] (str/join "/" (into ["clip" (segment cid)] parts)))
some-leaf (fn [path v] (when (seq v) {path v}))]
(apply merge
@ -140,30 +140,30 @@
(for [[id v] (:subjects clip)] {(at "subject" (segment id)) v})
(for [[id v] (:features clip)] {(at "feature" (segment id)) v})
(for [[id v] (:groups clip)] {(at "group" (segment id)) v})
;; The timeline's own facts. `:id` is the path segment, so writing it
;; The symbol's own facts. `:id` is the path segment, so writing it
;; into the value as well would be the one field a rename could
;; disagree with itself about; `clip` puts it back.
(for [[tid tl] (:timelines clip)]
{(at "timeline" (segment tid))
(select-keys tl [:frames :palette])})
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)]
{(at "timeline" (segment tid) "node" (segment id))
(for [[sid sym] (:symbols clip)]
{(at "symbol" (segment sid))
(select-keys sym [:name :frames :width :height :palette])})
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)]
{(at "symbol" (segment sid) "node" (segment id))
(apply dissoc n node-channel-keys)})
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
:when (seq (:measured n))]
{(at "timeline" (segment tid) "measured" (segment id)) (:measured n)})
(for [[tid tl] (:timelines clip)
[id n] (:nodes tl)
{(at "symbol" (segment sid) "measured" (segment id)) (:measured n)})
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
[prop ch] (:channels n)]
{(at "timeline" (segment tid) "channel" (segment id) (prop->path prop)) ch})))))
{(at "symbol" (segment sid) "channel" (segment id) (prop->path prop)) ch})))))
(defn clip
"The inverse of `leaves`, for one clip. Paths belonging to another clip are
ignored, so a project's whole leaf map can be handed straight in.
A timeline's `:id` is restored from its path segment rather than read out of the
A symbol's `:id` is restored from its path segment rather than read out of the
value, which is why `leaves` does not write it: a segment and a field that both
claim to be the id are two places for one fact."
[cid leaves]
@ -173,14 +173,16 @@
(let [[_ found kind a b c] (str/split path #"/")]
(if-not (= want found)
acc
(if (= "timeline" kind)
(let [tid (unsegment a)
acc (assoc-in acc [:timelines tid :id] tid)]
(if (= "symbol" kind)
(let [sid (unsegment a)
acc (assoc-in acc [:symbols sid :id] sid)]
(case b
nil (update-in acc [:timelines tid] merge v)
"node" (update-in acc [:timelines tid :nodes (unsegment c)] merge v)
"measured" (assoc-in acc [:timelines tid :nodes (unsegment c) :measured] v)
"channel" (assoc-in acc [:timelines tid :nodes (unsegment c)
;; `:nodes` is there before any node leaf is: an empty
;; symbol has none, and is still a symbol.
nil (update-in acc [:symbols sid] #(merge {:nodes {}} % v))
"node" (update-in acc [:symbols sid :nodes (unsegment c)] merge v)
"measured" (assoc-in acc [:symbols sid :nodes (unsegment c) :measured] v)
"channel" (assoc-in acc [:symbols sid :nodes (unsegment c)
:channels (path->prop (nth (str/split path #"/") 6))]
v)
(throw (ex-info "not a leaf path" {:path path}))))
@ -210,20 +212,20 @@
content-addressed is that it does not have to travel with tier 1 to be found."
[leaves]
(let [parts (into {} (map (juxt identity #(vec (str/split % #"/")))) (keys leaves))
;; A node leaf, by (clip, timeline, node). Under a timeline id, because a
;; symbol and the root may both hold a `:mouth` and a channel of one is not
;; a channel of the other.
;; A node leaf, by (clip, symbol, node). Under a symbol id, because two
;; symbols may both hold a `:mouth` and a channel of one is not a channel
;; of the other.
nodes (into #{} (keep (fn [[_ p]]
(when (and (= 6 (count p)) (= "timeline" (nth p 2))
(when (and (= 6 (count p)) (= "symbol" (nth p 2))
(= "node" (nth p 4)))
[(nth p 1) (nth p 3) (nth p 5)])))
parts)
;; Which segment index holds the kind, and what shapes are legal.
legal? (fn [p]
(and (= "clip" (first p)) (second p)
(if (= "timeline" (nth p 2 nil))
(if (= "symbol" (nth p 2 nil))
(case (count p)
4 true ; the timeline itself
4 true ; the symbol itself
6 (#{"node" "measured"} (nth p 4))
7 (= "channel" (nth p 4))
false)
@ -238,13 +240,13 @@
:when (not (legal? p))]
(str (pr-str path) " is not a leaf path"))
(for [[path p] (sort-by key parts)
:when (and (legal? p) (= "timeline" (nth p 2 nil)) (>= (count p) 6)
:when (and (legal? p) (= "symbol" (nth p 2 nil)) (>= (count p) 6)
(#{"channel" "measured"} (nth p 4))
(not (contains? nodes [(nth p 1) (nth p 3) (nth p 5)])))]
(str (pr-str path) " addresses a node with no node leaf"))
(for [[path p] (sort-by key parts)
:let [v (get leaves path)]
:when (and (legal? p) (= "timeline" (nth p 2 nil)) (= 7 (count p))
:when (and (legal? p) (= "symbol" (nth p 2 nil)) (= 7 (count p))
(:dense v) (not (sha/key? (:store (:dense v)))))]
(str (pr-str path) " names tier 2 as " (pr-str (:store (:dense v)))
" — a dense channel in a saved document names a content address"))))))

View file

@ -0,0 +1,352 @@
(ns arthur.domain.nest
"How nested symbols relate, and moving things between them.
A row path — the ids from the open symbol down through instances, as the
timeline names a row — says where something is. Walking one answers three
questions at once, which is why there is one walk: what frame is showing down
there, what matrix takes its coordinates up to the open symbol's, and what
time map takes the open symbol's frames down to its own.
ONE NESTING, AS FAR AS A PERSON IS CONCERNED. Putting a node inside another
symbol is how things are grouped: the symbol is a shared timeline, and its
instance is the handle that moves, retimes and transforms everything in it
together. Parent pointers inside a symbol stay — the roto rig is built on them
— but they are not something the timeline hands out.
A MOVE CHANGES NEITHER THE PICTURE NOR THE TIMING. Every node has the same two
maps into its parent — the matrix of its transform, and `node/time-of` — and a
move keeps a node's world maps and re-expresses them under the new parent: the
matrix becomes a `:pinv`, Blender's parent-inverse, and the time a new `:at`
and `:rate`. Its channels, keys and span are untouched."
(:require [arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]))
(defn invert
"The inverse of a 2x3 affine, or nil when it has none — an instance scaled to
nothing has no inside to draw into."
[^js m]
(let [[a b c d e f] (array-seq m)
det (- (* a d) (* b c))]
(when-not (zero? det)
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
(defn- resolved
"Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then
answers `symbol/world-of` and `symbol/frame-of` for it on that frame.
Only its lineage is resolved, because where a node is depends on its parents
and nothing else in the symbol — and the whole symbol costs more than a frame
of the stage, which the editor asks for on every frame."
[clip store sid frame id]
(let [sym (clip/symbol clip sid)
sym (update sym :nodes select-keys (symbol/lineage (:nodes sym) id))
r (symbol/resolver sym store pal/index-of nil {:source-fps (:fps clip)})]
(r frame)
r))
(defn inside
"Walk row path `path` down from symbol `sid`, whose frame `f` is showing, into
the node it ends at. Returns `{:sid :frame :matrix :time}`: the symbol that
node places (nil for one that places none), the frame of its own it is
showing, the matrix from its coordinates to `sid`'s, and the time map from
`sid`'s frames to its own — or nil when a node on the way is not on screen at
that frame, where there is no inside to be in.
THE SAME STEP FOR EVERY NODE. Inside an instance is the symbol it places;
inside a shape is where its points and keys are. Either way it is the node's
own coordinates and frames, so a shape any depth down is edited through the
maps it is drawn with.
The frame and the matrix come from RESOLVING each level, so they are the ones
the stage draws with, floors included. The time map is the affine part, floors
aside, and is nil through a looping node, whose frames come round again and do
not map one to one."
[clip store sid path f]
(reduce (fn [{:keys [sid frame matrix time]} id]
(let [r (resolved clip store sid frame id)
nodes (:nodes (clip/symbol clip sid))
chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))
m (symbol/world-of r id)
local (symbol/frame-of r id)
inner (get-in nodes [id :of])]
(if (and m (number? local)
(or (nil? inner) (< -1 local (clip/frames clip inner))))
{:sid inner :frame (js/Math.floor local)
:matrix (node/mul! (node/mat) matrix m)
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain))
(reduce node/then-time time (map node/time-of chain)))}
(reduced nil))))
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
path))
(defn drawn-inside
"Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the
symbol `path` leads to, so a shape added there lands exactly where it was drawn.
`{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside."
[clip store sid path f pts]
(when-let [{:keys [matrix] :as at} (inside clip store sid path f)]
(when-let [inv (invert matrix)]
(let [out (js/Float64Array. 2)]
(assoc (select-keys at [:sid :frame])
:pts (into [] (mapcat (fn [[x y]]
(node/apply-pt! out 0 inv x y)
[(aget out 0) (aget out 1)]))
(partition 2 pts)))))))
(defn audio-tracks
"Every sound symbol `sid` plays, as audio nodes in `sid`'s own frames: its own
and, recursively, those inside the instances it places.
A sound inside a placed symbol is heard where the instance puts it, so each one
is carried OUT through the instance's time map — the same map a timeline row
draws with — and cut to the instance's own span, until it is in the frames of
the symbol being played. Keyed automation moves with it. What comes back is
what a mixer that only knows flat tracks can play as it is."
[clip sid]
(let [sym (clip/symbol clip sid)]
(into (vec (filter #(= :audio (:kind %)) (vals (:nodes sym))))
(mapcat
(fn [inst]
(let [outer (node/time-of inst)
->outer (fn [x] (+ (:at outer) (/ x (:rate outer))))
[in out] (or (:span inst) [0 (clip/frames clip (:of inst))])]
(keep (fn [a]
(let [[p0 p1] (or (node/placed-span a) [in out])
x0 (max p0 in)
x1 (min p1 out)
own (node/time-of a)
->own (fn [x] (* (:rate own) (- x (:at own))))
world (node/then-time outer own)]
(when (< x0 x1)
(-> a
(assoc :span [(->own x0) (->own x1)]
:time {:mode :map :at (:at world) :rate (:rate world)})
(update :channels
(fn [chs]
(into {} (map (fn [[p ch]]
[p (cond-> ch (:keys ch)
(update :keys #(into {} (map (fn [[f v]] [(->outer f) v])) %)))]))
chs)))))))
(audio-tracks clip (:of inst)))))
(filter #(= :instance (:kind %)) (vals (:nodes sym)))))))
(defn- retime
"Node `n` with its own time map replaced by `m`, and nothing else touched: its
span and keys are in its own frames, which a move does not change."
[n {:keys [at rate]}]
(assoc n :time (merge (:time n) {:mode :map :at at :rate rate :offset 0})))
(defn- subtree
"`id` and every node whose parent chain reaches it."
[nodes id]
(into #{} (filter #(some #{id} (symbol/lineage nodes %))) (keys nodes)))
(defn delete-node
"Take node `id` out of symbol `sid`, with everything hanging off it."
[clip sid id]
(clip/update-symbol clip sid update :nodes #(apply dissoc % (subtree % id))))
(defn- transplant
"Move node `id` from symbol `host`, where frame `frame` is showing, into symbol
`target`, keeping where it is on screen and when. `carry` is the matrix from
`host`'s coordinates to `target`'s, and `back` the time map from `target`'s
frames to `host`'s.
THE ONE RULE, for space and time alike: the node's new map is its old one
under what it leaves — its parents here, and the way from here to there — so
the picture and the timing through it do not change. For space that is a
`:pinv`, Blender's parent-inverse; for time it is a new `:at` and `:rate`. Its
channels, keys and span are untouched, and its children keep their parent
pointers and come with it. `{:clip}` or `{:refused why}`."
[clip store host frame id target carry back]
(let [nodes (:nodes (clip/symbol clip host))
n (get nodes id)
moving (subtree nodes id)
;; Its parents in this symbol, outermost first.
chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
parent (when-let [p (:parent n)]
(some-> (symbol/world-of (resolved clip store host frame p) p)
js/Float64Array.from))]
(cond
(= host target) {:refused "it is already there"}
(and (= :instance (:kind n)) (clip/contains-symbol? clip (:of n) target))
{:refused "a symbol cannot go inside itself"}
(some (fn [m] (or (:measured (get nodes m))
(some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m))))))
moving)
{:refused "generated parts stay with their take — move the instance that places it"}
(some (fn [[k m]] (and (:stencil m)
(not= (contains? moving k) (contains? moving (:stencil m)))))
nodes)
{:refused "a stencil and what it clips have to move together"}
(and (:parent n) (nil? parent))
{:refused "its parent is not on screen at this frame"}
(some #(get-in % [:time :loop?]) chain)
{:refused "a looping parent is in the way"}
:else
(let [taken (:nodes (clip/symbol clip target))
ids (into {} (map (fn [m] [m (clip/free-id #(contains? taken %) m)])) moving)
pinv (reduce #(node/mul! (node/mat) %1 %2) carry (keep identity [parent (node/pinv n)]))
;; back · parents · own: target frames to the node's own.
time (reduce node/then-time back (concat (map node/time-of chain)
[(node/time-of n)]))
moved (for [m moving
:let [x (get nodes m)]]
(cond-> (-> x
(assoc :id (ids m))
(update :parent #(get ids %)))
(:stencil x) (update :stencil ids)
(= m id) (-> (retime time)
(assoc :pinv (vec (array-seq pinv))
:z (str "z" (js/Date.now) "-" (ids m))))))]
{:id (ids id)
:sid target
:clip (-> clip
(clip/update-symbol host update :nodes #(apply dissoc % moving))
(clip/update-symbol target update :nodes (fnil into {})
(map (juxt :id identity)) moved))}))))
(defn move-node
"Move the node at row path `from` — its last id is the node, the rest the
instances down to where it lives — into the symbol placed by the instance at
row path `to`, or to the top of `open` when `to` is empty. Row paths start at
`open`, and `f` is its current frame, at which both have to be on screen.
`{:clip :sid :id}` — the symbol it landed in and its id there, renamed only if
that one was taken — or `{:refused why}`."
[clip store open from to f]
(let [here (inside clip store open (pop from) f)
there (inside clip store open to f)
a (:time here)
b (:time there)
inv (some-> there :matrix invert)]
(cond
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)]))
{:refused "nothing to move"}
(or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"}
(nil? (:sid there)) {:refused "only a symbol can take it"}
(not (and a b)) {:refused "a looping instance is in the way"}
(nil? inv) {:refused "the target is scaled to nothing"}
:else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there)
(node/mul! (node/mat) inv (:matrix here))
(node/then-time (node/invert-time b) a)))))
(defn- down
"Walk row path `path` down from symbol `sid` by structure alone: `{:sid
:time}`, the symbol it leads to and the time map from `sid`'s frames to that
symbol's own, nil through a loop.
`inside` without the frame. Which symbol a row is in and how fast it runs
there are the same on every frame, so asking needs nothing to be on screen;
only a move that keeps the PICTURE needs a frame, for the matrix."
[clip sid path]
(let [sids (reductions #(get-in clip [:symbols %1 :nodes %2 :of]) sid path)
;; Every node on the way, outermost first: each instance, after its
;; parents in the symbol it is in.
chain (mapcat (fn [sid id]
(let [nodes (:nodes (clip/symbol clip sid))]
(map #(get nodes %) (rseq (symbol/lineage nodes id)))))
sids path)]
{:sid (last sids)
:time (when (not-any? #(get-in % [:time :loop?]) chain)
(reduce node/then-time {:at 0 :rate 1} (map node/time-of chain)))}))
(defn slide
"Move the node at row path `path` along its symbol's time by `df` frames of
`open`. `{:clip}` or `{:refused why}`.
ONE WRITE TO `:at`, for every node alike: its span, keys and children are in
its own frames and come with it. `df` is carried down into the frames `:at` is
in — the symbol's, through each instance on the way, and its parents' there."
[clip open path df]
(let [here (down clip open (pop path))
id (peek path)
nodes (:nodes (clip/symbol clip (:sid here)))]
(cond
(nil? (get nodes id)) {:refused "nothing to move"}
(nil? (:time here)) {:refused "a looping instance is in the way"}
:else
(let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id))))
d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))]
{:clip (clip/update-symbol
clip (:sid here) update-in [:nodes id]
(fn [n]
(if (= :map (get-in n [:time :mode]))
(update-in n [:time :at] (fnil + 0) d)
(assoc n :time {:mode :map :at d :rate 1}))))}))))
(defn restack
"Put the node at row path `from` just in front of the one at `to` when
`front?`, or just behind it — side by side in one symbol, as the timeline lists
them. `{:clip :sid :id}` or `{:refused why}`.
ONE WRITE TO `:z`, between the two it lands between, so nothing else is
renumbered. Among the nodes that share its parent, because that is what `:z`
orders; a roto part's parent is the rig, and it restacks within that."
[clip open from to front?]
(let [{sid :sid} (down clip open (pop to))
nodes (:nodes (clip/symbol clip sid))
n (get nodes (peek from))
t (get nodes (peek to))
z #(or (:z %) "")
zs (->> nodes
(keep (fn [[k m]] (when (and (= (:parent m) (:parent t)) (not= k (peek from)))
(z m))))
sort)]
(cond
(not= (pop from) (pop to)) {:refused "only things side by side can be restacked"}
(or (nil? n) (nil? t)) {:refused "nothing to restack"}
(not= (:parent n) (:parent t)) {:refused "they hang off different parents"}
:else
{:sid sid
:id (peek from)
:clip (clip/update-symbol
clip sid assoc-in [:nodes (peek from) :z]
(if front?
(symbol/z-between (z t) (first (filter #(pos? (compare % (z t))) zs)))
(symbol/z-between (last (filter #(neg? (compare % (z t))) zs)) (z t))))})))
(defn group
"Put the nodes at row paths `froms`, all side by side in one symbol, into a
NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or
`{:refused why}`.
The new symbol starts where the earliest of them starts and ends where the
last one ends, so its instance's bar on the timeline covers exactly theirs.
Its instance sits at the identity, so nothing moves, and pivots about the
middle of what it now holds."
[clip store open froms sid uuid f]
(let [host-path (pop (first froms))
{host :sid frame :frame} (inside clip store open host-path f)
nodes (:nodes (clip/symbol clip host))]
(cond
(nil? host) {:refused "they have to be on screen at this frame"}
(not-every? #(= host-path (pop %)) froms) {:refused "only things side by side can be grouped"}
(some #(nil? (get nodes (peek %))) froms) {:refused "nothing to group"}
:else
(let [whole [0 (clip/frames clip host)]
spans (for [from froms
:let [n (get nodes (peek from))]]
(or (node/placed-span n)
(when (= :instance (:kind n))
(node/placed-span (assoc n :span [0 (clip/frames clip (:of n))])))
whole))
start (js/Math.floor (max 0 (apply min (map first spans))))
end (min (second whole) (apply max (map second spans)))
made (-> clip
(assoc-in [:symbols sid] {:id sid :name (name sid)
:frames (max 1 (js/Math.ceil (- end start)))
:nodes {}})
(clip/place-symbol store host sid start uuid nil))
back (node/invert-time (node/time-of (get-in made [:symbols host :nodes uuid])))
moved (reduce (fn [acc from]
(let [r (transplant (:clip acc) store host frame (peek from) sid
(node/mat) back)]
(if (:refused r) (reduced r) r)))
{:clip made} froms)]
(cond-> moved
(:clip moved) (update :clip assoc-in
[:symbols host :nodes uuid :channels [:xform :anchor] :value]
(clip/center (:clip moved) store sid)))))))

View file

@ -21,9 +21,9 @@
"`:bitmap` is in the vocabulary and not implemented; it is
here so that a scene that names one fails as \"not implemented\" rather than as
\"not a kind\"."
#{:poly :disc :rect :group :bitmap :symbol :audio})
#{:poly :disc :rect :group :bitmap :instance :audio})
(def implemented-kinds #{:poly :disc :rect :group :symbol :audio})
(def implemented-kinds #{:poly :disc :rect :group :instance :audio})
(def xform-paths
"In composition order, which is also the order they have to be sampled in.
@ -45,7 +45,7 @@
change to this spec silently change what gets drawn."
(let [base (into #{[:vis]} xform-paths)]
{:group base
:symbol base
:instance base
:audio (into base [[:audio :gain] [:audio :pan] [:audio :rate]])
:poly (into base [[:geom :pts] [:style :color]])
;; A disc's radius is framed in practice — iris size is a knob, not a
@ -70,6 +70,30 @@
[n]
(merge defaults (:channels n)))
(defn set-channel
"Write `v` into channel `path`: a key on the node's own frame `f` when the
channel is keyed, its one value when it is not."
[n path f v]
(let [c (get (channels n) path)]
(assoc-in n [:channels path]
(if (:keys c) (assoc-in c [:keys f] v) (ch/framed v)))))
(defn toggle-key
"Key channel `path` on the node's own frame `f` with the value it has there, or
take the key there off. The first key starts the channel animating and taking
the last one off leaves it that one value. A boolean holds; anything else tweens."
[n path f]
(let [c (get (channels n) path)
v (ch/value-at c f)
ks (dissoc (:keys c) f)]
(assoc-in n [:channels path]
(cond
(not (:keys c)) (ch/keyed {f v} (if (boolean? v) :hold :linear))
(not (contains? (:keys c) f)) (assoc-in c [:keys f] v)
(seq ks) (cond-> (assoc c :keys ks)
(:segments c) (update :segments dissoc f))
:else (ch/framed v)))))
;; ---------------------------------------------------------------------------
;; time maps
;;
@ -103,6 +127,43 @@
(/ source-fps picture-fps))))
f))
(defn time-of
"A node's own time as the affine map it is: `{:at a :rate r}`, meaning a frame
`p` of its parent is frame `r·(p − a)` of its own. THE SAME FOR EVERY NODE. A
node with no time map is `{:at 0 :rate 1}`, reading its parent's frames as its
own; a mouth lead's `:offset` is folded into `:at`. Exposure and picture
sampling are floors, not part of the map, and are left out: this is the map a
move preserves and a timeline row draws with, and `local-frame` is what reads
a frame, floors and the lead in their load-bearing order."
[n]
(let [{:keys [mode at rate offset] :or {at 0 rate 1 offset 0}} (:time n)]
(if (= mode :map)
{:at (- at (/ offset rate)) :rate rate}
{:at 0 :rate 1})))
(defn then-time
"`outer` then `inner`: the map from `outer`'s parent straight to `inner`'s own
frames. Time maps compose like matrices do, which is what makes a nesting of
any depth one map."
[{a1 :at r1 :rate} {a2 :at r2 :rate}]
{:at (+ a1 (/ a2 r1)) :rate (* r1 r2)})
(defn invert-time [{:keys [at rate]}]
{:at (- (* at rate)) :rate (/ 1 rate)})
(defn placed-span
"Where a node exists, as `[in out)` in its PARENT's frames, or nil for always.
A `:span` is in the node's OWN frames — which of its frames exist — for every
node alike, and its time map says where they land in the parent. For a node
with no time map the two are the same frames, so a shape's span reads as it
always did. Moving a node along its parent is then one write to `:at`, and the
span, which says what the node IS, does not change when it is moved."
[n]
(when-let [[in out] (:span n)]
(let [{:keys [at rate]} (time-of n)]
[(+ at (/ in rate)) (+ at (/ out rate))])))
(defn local-frame
"Apply a node's time map to the frame it was handed by its parent.
@ -111,29 +172,24 @@
it on most frames, so the lead slider reads as doing nothing at exposures above
1, which is indistinguishable from the slider being unwired.
Composed along the parent chain, outermost first, by timeline/eval-frame. Two
Composed along the parent chain, outermost first, by symbol/eval-frame. Two
rules fall out and they are different rules: exposure INHERITS STRICTLY,
because a head cutting on odd frames against a mouth cutting on even ones reads
as two performances; offset is PER-NODE by design, because mouth lead applies
to performance nodes and not to the plate, which is the entire point of it."
[n f]
(let [{:keys [mode offset rate at in source-fps sample-fps]
ex :expose :or {mode :inherit}} (:time n)]
(let [{:keys [mode source-fps sample-fps] ex :expose :or {mode :inherit}} (:time n)]
(if (= mode :inherit)
f
(do
(when (and (not (#{:symbol :audio} (:kind n))) rate (not= rate 1.0) (not= rate 1))
(throw (ex-info "time map :rate belongs to a symbol or audio instance"
{:node (:id n) :time (:time n)})))
(when (and sample-fps (not (and source-fps (pos? source-fps))))
(throw (ex-info "picture sampling needs a positive source fps"
{:node (:id n) :time (:time n)})))
(cond-> (if (#{:symbol :audio} (:kind n))
(+ (or in 0) (* (or rate 1) (- f (or at 0))))
f)
sample-fps (sample-frame source-fps sample-fps)
ex (expose ex)
offset (+ offset))))))
(let [{:keys [at rate offset] :or {at 0 rate 1}} (:time n)]
(cond-> (* rate (- f at))
sample-fps (sample-frame source-fps sample-fps)
ex (expose ex)
offset (+ offset)))))))
;; ---------------------------------------------------------------------------
;; the transform
@ -265,15 +321,17 @@
(not (contains? implemented-kinds k)))
(conj (str ":kind " k " is in the vocabulary but not implemented"))
(and (= k :symbol) (nil? (:of n))) (conj "a symbol instance needs :of")
(and (= k :instance) (nil? (:of n))) (conj "an instance needs :of")
(and (= k :audio) (nil? (get-in n [:source :footage])))
(conj "an audio instance needs :source :footage")
(and (#{:symbol :audio} k) (some? (get-in n [:time :rate]))
(and (some? (get-in n [:time :rate]))
(not (pos? (get-in n [:time :rate]))))
(conj "an instance's :rate must be positive")
(conj ":time :rate must be positive")
(nil? (:z n)) (conj "no :z — draw order is authored per scene, not implied by the tree")
(and (:span n) (not= 2 (count (:span n))))
(conj ":span must be [in out]"))
(conj ":span must be [in out]")
(some? (get-in n [:time :in]))
(conj ":time has an :in — an instance's first frame is the start of its own :span"))
(into (when valid
(for [[path _] (:channels n)

View file

@ -1,12 +1,13 @@
(ns arthur.domain.paint
"Small authored polygon operations. Paint nodes read timeline frames directly;
the roto root's exposure and picture sampling must not quantise a hand edit."
"Small authored polygon operations, each on a named symbol. Paint nodes read
their symbol's frames directly; a roto instance's exposure and picture sampling
must not quantise a hand edit."
(:require [arthur.domain.channel :as channel]))
(def geometry [:geom :pts])
(defn shapes [clip]
(->> (get-in clip [:timelines :main :nodes])
(defn shapes [clip sid]
(->> (get-in clip [:symbols sid :nodes])
(filter (fn [[_ node]] (:paint? node)))
(sort-by (comp :z val))
vec))
@ -15,21 +16,21 @@
(let [frames (sort (keys (:keys ch)))]
(or (last (take-while #(<= % frame) frames)) (first frames))))
(defn new-shape [clip id frame points color]
(let [end (get-in clip [:timelines :main :frames])
(defn new-shape [clip sid id frame points color]
(let [end (get-in clip [:symbols sid :frames])
z (str "z" (js/Date.now) "-" (name id))]
(if (and (<= 0 frame) (< frame end) (>= (count points) 6)
(even? (count points)))
(assoc-in clip [:timelines :main :nodes id]
{:id id :name (str "shape " (inc (count (shapes clip))))
(assoc-in clip [:symbols sid :nodes id]
{:id id :name (str "shape " (inc (count (shapes clip sid))))
:kind :poly :paint? true :parent nil :z z
:span [frame end]
:channels {geometry (channel/keyed {frame points})
[:style :color] (channel/framed color)}})
clip)))
(defn add-key [clip id frame]
(let [path [:timelines :main :nodes id]
(defn add-key [clip sid id frame]
(let [path [:symbols sid :nodes id]
node (get-in clip path)
ch (get-in node [:channels geometry])
[start end] (:span node)]
@ -38,20 +39,20 @@
(vec (channel/value-at ch frame)))
clip)))
(defn set-vertex [clip id key-frame vertex [x y]]
(let [path [:timelines :main :nodes id :channels geometry :keys key-frame]
(defn set-vertex [clip sid id key-frame vertex [x y]]
(let [path [:symbols sid :nodes id :channels geometry :keys key-frame]
points (get-in clip path)
i (* 2 vertex)]
(if (and points (< (inc i) (count points)))
(assoc-in clip path (-> points (assoc i x) (assoc (inc i) y)))
clip)))
(defn set-segment-interp [clip id key-frame interp]
(let [node (get-in clip [:timelines :main :nodes id])
(defn set-segment-interp [clip sid id key-frame interp]
(let [node (get-in clip [:symbols sid :nodes id])
keys (get-in node [:channels geometry :keys])]
(if (and (:paint? node) (contains? keys key-frame)
(some #(< key-frame %) (clojure.core/keys keys))
(#{:hold :linear} interp))
(assoc-in clip [:timelines :main :nodes id :channels geometry
(assoc-in clip [:symbols sid :nodes id :channels geometry
:segments key-frame] interp)
clip)))

View file

@ -88,7 +88,7 @@
(defn encoder
"(fn [raster ramp] -> promise of PNG bytes), for one stage size and one zoom.
Built once per export rather than per frame, in the shape `timeline/resolver`
Built once per export rather than per frame, in the shape `symbol/resolver`
already uses: everything that does not change frame to frame is held here. What
that buys is the scanline scratch, which at zoom 6 is seven megabytes — a
per-frame allocation of that size is the one thing that would make a long export

View file

@ -32,16 +32,17 @@
default-frame))
(defn put-cut
"Set one held pose on a symbol instance. Earlier motion stays untouched."
[clip instance group at source]
(let [node (get-in clip [:timelines :main :nodes instance])
symbol (get-in clip [:timelines (:of node)])
length (:frames symbol)
"Set one held pose on an instance inside symbol `sid`. Earlier motion stays
untouched."
[clip sid instance group at source]
(let [node (get-in clip [:symbols sid :nodes instance])
placed (get-in clip [:symbols (:of node)])
length (:frames placed)
active (filter (fn [n] (some :pose-sampled? (vals (:channels n))))
(vals (:nodes symbol)))
(vals (:nodes placed)))
groups (set (map #(or (:pose-group %) (:id %)) active))
ids (set (map :id active))]
(when-not (and (= :symbol (:kind node))
(when-not (and (= :instance (:kind node))
(or (contains? groups group)
(and (vector? group) (= 2 (count group))
(= :node (first group))
@ -50,17 +51,17 @@
(integer? source) (<= 0 source) (< source length))
(throw (ex-info "invalid stage pose cut"
{:instance instance :group group :at at :source source})))
(update-in clip [:timelines :main :nodes instance :playback :tracks group]
(update-in clip [:symbols sid :nodes instance :playback :tracks group]
#(assoc (or % {}) at source))))
(defn remove-cut
"Remove a cut; an empty track again follows the normal generated motion."
[clip instance group at]
(let [path [:timelines :main :nodes instance :playback :tracks group]]
[clip sid instance group at]
(let [path [:symbols sid :nodes instance :playback :tracks group]]
(if-let [entries (get-in clip path)]
(if-let [remaining (not-empty (dissoc entries at))]
(assoc-in clip path remaining)
(update-in clip [:timelines :main :nodes instance :playback :tracks]
(update-in clip [:symbols sid :nodes instance :playback :tracks]
dissoc group))
clip)))

View file

@ -29,6 +29,12 @@
(:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire]))
(def schema-version
"The stored document format this client reads and writes. 2 is symbols: leaf
paths say `symbol`, a placing node is `:kind :instance`, and no symbol id is
reserved. `clips/migrations/0007` moved every saved project from 1."
2)
(defn block-keys
"Every tier-2 key a leaf map names, in a stable order."
[leaves]
@ -53,8 +59,8 @@
round-trip a clip through `JSON.parse(JSON.stringify(...))` and be running the
same conversion the network runs, rather than a CLJS-shaped rehearsal of it. The
one thing a keywordising `js->clj` would quietly break is the leaf paths —
`:clip/c1/timeline/main/node/mouth` is a keyword whose `name` is
\"c1/timeline/main/node/mouth\", so the
`:clip/c1/symbol/main/node/mouth` is a keyword whose `name` is
\"c1/symbol/main/node/mouth\", so the
\"clip/\" would be lost on the way back in.
Refuses a document `domain/leaf` calls unaddressable, which is where a hand-made
@ -83,19 +89,27 @@
:state (when state (wire/base64 state))}))
(block-keys leaves)))})))
(defn tier1
"A response's leaves object -> `{path value}`, the shape `leaf/leaves` returns."
[^js leaves]
(into {} (map (fn [path] [path (wire/decode-json (aget leaves path))]))
(js-keys leaves)))
(defn store
"Fetched blocks -> the store `save` reads them back out of."
[blocks]
(into {}
(map (fn [^js b]
[(.-key b)
(cond-> {:descriptor (.-descriptor b)
:data (wire/typed (block-type (.-descriptor b))
(.-data b))}
(.-state b) (assoc :state (wire/bytes-of (.-state b))))]))
(array-seq (or blocks #js []))))
(defn load
"The parsed response -> `{:clip :store}`, which is what `flow/freeze` returns
and therefore what the player already knows how to play."
[cid ^js doc]
(let [leaves (.-leaves doc)
tier1 (into {} (map (fn [path] [path (wire/decode-json (aget leaves path))]))
(js-keys leaves))]
{:clip (leaf/clip cid tier1)
:store (into {}
(map (fn [^js b]
[(.-key b)
(cond-> {:descriptor (.-descriptor b)
:data (wire/typed (block-type (.-descriptor b))
(.-data b))}
(.-state b) (assoc :state (wire/bytes-of (.-state b))))]))
(array-seq (or (.-blocks doc) #js [])))}))
{:clip (leaf/clip cid (tier1 (.-leaves doc)))
:store (store (.-blocks doc))})

View file

@ -30,7 +30,7 @@
edge landing exactly on a pixel boundary resolves consistently.
Flat and preallocated because this is the per-frame path: fixed topology means
a node's vertex count is known at freeze time, so timeline/resolver hands the same
a node's vertex count is known at freeze time, so symbol/resolver hands the same
buffer back every frame and a frame allocates nothing. At 30fps per-frame
allocation is the only thing that will make this stutter.

View file

@ -1,38 +1,36 @@
(ns arthur.domain.timeline
"A TIMELINE: an ordered bag of nodes in its own frame space, and the two ways to
(ns arthur.domain.symbol
"A SYMBOL: an ordered bag of nodes in its own frame space, and the two ways to
evaluate it at a frame.
{:id :main :frames 229 :nodes {id -> node} :palette nil}
That is the whole type, and EVERYTHING THAT HOLDS NODES IS ONE OF THESE. A
clip's root timeline is one; a symbol in the library is one; a `:kind :symbol`
node is an INSTANCE of one. An earlier arrangement had the clip's node tree and
a library symbol as two structures with the same fields and never said they were
the same thing — the clip map carried `:fps`, `:width`, `:height`, `:analysis`
and the tracking identities alongside `:nodes`, so a symbol had nowhere to live
that was not a clip with seven meaningless fields. Flash's `_root` is a
MovieClip and After Effects' pre-comp is just a layer; collapsing them is what
makes nesting arbitrary and free rather than a feature to be added.
That is the whole type, and EVERYTHING THAT HOLDS NODES IS ONE OF THESE. What
a document opens on is a symbol; what a `:kind :instance` node places is a
symbol; there is no second structure. An earlier arrangement had a root node
tree and a library entry as two structures with the same fields and never said
they were the same thing. Flash's `_root` is a MovieClip and After Effects'
pre-comp is just a layer; collapsing them is what makes nesting arbitrary and
free rather than a feature to be added.
The clip-level facts are in `arthur.domain.clip`. A timeline has a FRAME SPACE,
The clip-level facts are in `arthur.domain.clip`. A symbol has a FRAME SPACE,
not a rate and not a size: `:fps` is the clip's, because a rate is a fact about
how fast the whole thing plays, and a nested timeline cannot have its own.
how fast the whole thing plays, and a nested symbol cannot have its own.
TWO AXES OF NESTING, and conflating them is why \"nested\" and \"flat with parent
pointers\" sound contradictory when they are not. Parent/child is transform
composition WITHIN one timeline and is stored flat with pointers. Instance is a
timeline inside another timeline and is stored by reference into the library.
Each timeline is flat; timelines nest. Every argument for flat storage —
composition WITHIN one symbol and is stored flat with pointers. Instance is a
symbol inside another symbol and is stored by reference into the library.
Each symbol is flat; symbols nest. Every argument for flat storage —
addressability, one-field reparenting, structural sharing, per-node sync leaves —
is about the first axis and is untouched by the second.
Two ways to evaluate one at a frame:
(eval-frame tl f store) THE SPECIFICATION. Allocating, order-free,
(eval-frame sym f store) THE SPECIFICATION. Allocating, order-free,
obviously correct. Use it in tests and for a
one-off render.
(resolver tl store) -> (fn [f] ops). What playback uses. Caches the
(resolver sym store) -> (fn [f] ops). What playback uses. Caches the
topological order and the z paths, holds one
CURSOR per channel and one PREALLOCATED point
buffer per node, so a frame allocates the op
@ -42,7 +40,7 @@
read and where points are written. That is deliberate: two independent
implementations of frame evaluation would drift, and the drift would look like
a rendering bug rather than like two functions disagreeing. What differs
between them is exactly the part that can be wrong, and timeline-test asserts
between them is exactly the part that can be wrong, and symbol-test asserts
they agree frame for frame in forward, backward and random order.
The output is a list of DRAW OPS, and it is the boundary with the rasteriser:
@ -76,12 +74,12 @@
(when-let [p (:parent (get nodes i))]
(if (contains? nodes p)
p
(throw (ex-info "node's :parent is not in the timeline"
(throw (ex-info "node's :parent is not in the symbol"
{:node i :parent p})))))
chain (into [] (comp (take-while some?) (take (inc (count nodes))))
(iterate up id))]
(when (> (count chain) (count nodes))
(throw (ex-info "parent cycle in timeline" {:node id :chain chain})))
(throw (ex-info "parent cycle in symbol" {:node id :chain chain})))
chain))
(defn depth
@ -112,6 +110,30 @@
[nodes id]
(mapv #(:z (get nodes %)) (rseq (lineage nodes id))))
(defn z-between
"A `:z` that sorts strictly between `a` and `b`, which must be in order; nil
for either is no bound on that side. What makes restacking one write.
The midpoint of the first character they differ in, when there is room. When
there is not, anything that starts with `a` and is longer sorts after it, and
before `b` too unless `a` is a prefix of `b` — and then the room is found one
character further into `b`. \"0\" is the floor, and nothing this makes ends
in it, so there is always a further character to go to; only an authored key
ending in \"0\" leaves none, and then one character less than it does."
[a b]
(let [a (or a "")]
(if (nil? b)
(str a "m")
(let [i (count (take-while true? (map = a b)))
hi (.charCodeAt b i)
lo (if (< i (count a)) (.charCodeAt a i) 48)
mid (quot (+ lo hi) 2)]
(cond
(> mid lo) (str (subs b 0 i) (char mid))
(< i (count a)) (str a "m")
(< (inc i) (count b)) (str (subs b 0 (inc i)) (z-between nil (subs b (inc i))))
:else (str (subs b 0 i) (char (dec hi)) "m"))))))
(defn- z-lex
"Lexicographic compare of two z paths, a prefix sorting first.
@ -129,9 +151,9 @@
"id -> its position in draw order.
Computed ONCE. Draw order is a function of the z paths, which are structural —
they change when the timeline changes and never because the playhead moved — so
they change when the symbol changes and never because the playhead moved — so
sorting ops by z on every frame was re-deriving a constant thirty times a
second. Here it is derived when the timeline is, and a frame sorts small integers.
second. Here it is derived when the symbol is, and a frame sorts small integers.
`sort-by` is stable and `ord` is topological, so nodes sharing a z path keep
parent-before-child order without a tiebreak field on every op."
@ -146,9 +168,9 @@
"Tone keyword -> the index the raster writes, in a given palette.
`palette` is a map of tone -> index. It is a PARAMETER, not a global: a tone
names which mark this is, and which ramp it is read in belongs to the timeline
names which mark this is, and which ramp it is read in belongs to the symbol
the node sits in, so resolution cannot reach for one ambient answer. Today
there is one palette and it is passed in anyway; when timelines carry a
there is one palette and it is passed in anyway; when symbols carry a
`:palette` channel, the walk carries the palette in scope exactly as it already
carries the parent transform and the local frame.
@ -168,10 +190,11 @@
(defn- in-span?
"`:span` is Lottie's ip/op and Flash's PlaceObject/RemoveObject: the range over
which the node EXISTS, tested in the PARENT's frame space and therefore before
the node's own time map runs. Distinct from `[:vis]`, which blinks an existing
node on and off. Half-open, so two adjacent spans do not both own a frame."
the node's own time map runs — an instance's own-time span is mapped out by
`node/placed-span`. Distinct from `[:vis]`, which blinks an existing node on and
off. Half-open, so two adjacent spans do not both own a frame."
[n f]
(if-let [[in out] (:span n)]
(if-let [[in out] (node/placed-span n)]
(and (>= f in) (< f out))
true))
@ -229,7 +252,7 @@
flow/freeze writes it KEYED, because a threshold crossing is a handful of
transitions and hold is the default, and because a human has to be able to fix
one frame of it. When something does want a dense one it will land here loudly
instead of blanking the timeline.
instead of blanking the symbol.
Absence is not a boolean and is not an error: a subject that is not on the
frame has nothing to show."
@ -271,13 +294,13 @@
:rd rd})))))))
(defn- emit
"Emit geometry in the timeline'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."
[{:keys [palette buf-for]} n {:keys [m rd]} base]
(let [colour #(colour-index palette (rd [:style :color]))]
(case (:kind n)
:group nil
:symbol nil
:instance nil
:audio nil
:poly
@ -311,20 +334,20 @@
{:node (:id n) :kind (:kind n)})))))
(defn- nodes-of
"The timeline's node map, REFUSING a map that has none.
"The symbol's node map, REFUSING a map that has none.
A clip and a timeline both have an `:id` and both are maps, so handing a CLIP to
A clip and a symbol both have an `:id` and both are maps, so handing a CLIP to
an evaluator is the one mistake this type split makes easy — and the result is
not an error, it is `(:nodes clip)` being nil and a frame resolving to no ops at
all. That reads as a black stage, or, in a benchmark, as \"0 nodes\" and a
flattering number. It happened once while the split was being made, which is why
this is a guard and not a comment."
[tl]
(let [nodes (:nodes tl)]
[sym]
(let [nodes (:nodes sym)]
(when-not (map? nodes)
(throw (ex-info (str "not a timeline: :nodes is " (pr-str nodes)
" — a clip is not a timeline, its `:timelines` hold them")
{:keys (vec (sort-by str (keys tl)))})))
(throw (ex-info (str "not a symbol: :nodes is " (pr-str nodes)
" — a clip is not a symbol, its `:symbols` hold them")
{:keys (vec (sort-by str (keys sym)))})))
nodes))
(defn- channel-frame
@ -386,18 +409,18 @@
;; the specification
(defn eval-frame
"Timeline at frame f -> draw ops in z order. Pure, and allocates freely.
"Symbol at frame f -> draw ops in z order. Pure, and allocates freely.
`f` is in THIS timeline's frame space. At the clip's root that is clip frames;
inside an instance it is the instance's own space, and the instance boundary is
`f` is in THIS symbol's frame space. For the symbol on screen that is the
transport's frame; inside an instance it is the instance's own space, and the instance boundary is
the only place the space changes.
This is the definition of what a frame means. `resolver` is what plays it."
([tl f] (eval-frame tl f nil pal/index-of))
([tl f store] (eval-frame tl f store pal/index-of))
([tl f store palette] (eval-frame tl f store palette nil nil))
([tl f store palette pose-tracks opts]
(let [nodes (nodes-of tl)
([sym f] (eval-frame sym f nil pal/index-of))
([sym f store] (eval-frame sym f store pal/index-of))
([sym f store palette] (eval-frame sym f store palette nil nil))
([sym f store palette pose-tracks opts]
(let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks)
anchors (prepared-anchors nodes)
{:keys [source-fps picture-fps]} opts
@ -456,12 +479,12 @@
The op maps themselves are allocated fresh, and deliberately: there are a dozen
of them per frame against hundreds of points, so pooling them would buy
nothing and cost the ability to hand an op list around as plain data."
([tl] (resolver tl nil pal/index-of nil nil))
([tl store] (resolver tl store pal/index-of nil nil))
([tl store palette] (resolver tl store palette nil nil))
([tl store palette pose-tracks] (resolver tl store palette pose-tracks nil))
([tl store palette pose-tracks {:keys [source-fps picture-fps]}]
(let [nodes (nodes-of tl)
([sym] (resolver sym nil pal/index-of nil nil))
([sym store] (resolver sym store pal/index-of nil nil))
([sym store palette] (resolver sym store palette nil nil))
([sym store palette pose-tracks] (resolver sym store palette pose-tracks nil))
([sym store palette pose-tracks {:keys [source-fps picture-fps]}]
(let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks)
anchors (prepared-anchors nodes)
ord (order nodes)
@ -507,20 +530,26 @@
;; ---------------------------------------------------------------------------
(def timeline-keys
"Every field a timeline may carry, and the reason `arthur.domain.leaf` refuses
(def symbol-keys
"Every field a symbol may carry, and the reason `arthur.domain.leaf` refuses
one it does not know: a field added without a leaf to save it in is a field that
saves silently and comes back missing.
`:palette` is in the vocabulary and nothing writes one yet. A timeline is where
a ramp belongs — `domain/timeline` takes the palette as a PARAMETER rather than
reaching for a global precisely so that a nested timeline can carry its own —
`:palette` is in the vocabulary and nothing writes one yet. A symbol is where
a ramp belongs — `domain/symbol` takes the palette as a PARAMETER rather than
reaching for a global precisely so that a nested symbol can carry its own —
and leaving the field out would make the first one a migration instead of a
write."
#{:id :frames :nodes :palette})
write.
`:name` is what a person calls it, and is not its id: an id is what instances
and saved leaves point at, so renaming a symbol must not change it.
`:width` and `:height` are the symbol's own stage, and are absent until someone
sets them: a symbol without them uses the clip's — see `clip/stage`."
#{:id :name :frames :width :height :nodes :palette})
(defn problems
"Human-readable reasons this timeline will not evaluate. Empty means it will.
"Human-readable reasons this symbol will not evaluate. Empty means it will.
Node structure only. The tracking identities — subjects, features, groups — are
the CLIP's and are checked by `arthur.domain.clip/problems`, which is not a
@ -530,8 +559,8 @@
Total by construction — it reports a cycle rather than looping on one — because
its whole job is to be safe to run over authored data before that data is
trusted."
[tl]
(let [nodes (:nodes tl)]
[sym]
(let [nodes (:nodes sym)]
(if-not (map? nodes)
[":nodes must be a map of id -> node"]
(-> []
@ -541,11 +570,11 @@
(into (for [[id n] nodes
:when (and (:parent n) (not (contains? nodes (:parent n))))]
(str "node " (pr-str id) " has :parent " (pr-str (:parent n))
" which is not in the timeline")))
" which is not in the symbol")))
(into (for [[id n] nodes
:when (and (:stencil n) (not (contains? nodes (:stencil n))))]
(str "node " (pr-str id) " has :stencil " (pr-str (:stencil n))
" which is not in the timeline")))
" which is not in the symbol")))
(into (for [[id n] nodes
p (node/problems n)]
(str "node " (pr-str id) ": " p)))
@ -554,19 +583,23 @@
:let [anchors (:anchors n)]
:when (some? anchors)
:when (not (and (map? anchors) (contains? anchors 0)
(integer? (:frames tl))
(integer? (:frames sym))
(every? #(and (integer? %) (<= 0 %)
(< % (:frames tl)))
(< % (:frames sym)))
(concat (keys anchors) (vals anchors)))
(seq (:measured n))
(= (:channels n) (:measured n))))]
(str "node " (pr-str id)
": :anchors must start at frame 0, name valid measured frames, and read that node's own measured channels")))
(into (for [k (remove timeline-keys (keys tl))]
(str "timeline has a field with no leaf to save it in: " (pr-str k))))
(into (when-not (or (nil? (:frames tl)) (and (integer? (:frames tl)) (pos? (:frames tl))))
[(str ":frames is " (pr-str (:frames tl))
" — a timeline is a frame SPACE, so its length is a positive integer")]))
(into (for [k (remove symbol-keys (keys sym))]
(str "symbol has a field with no leaf to save it in: " (pr-str k))))
(into (when-not (or (nil? (:frames sym)) (and (integer? (:frames sym)) (pos? (:frames sym))))
[(str ":frames is " (pr-str (:frames sym))
" — a symbol is a frame SPACE, so its length is a positive integer")]))
(into (for [k [:width :height]
:let [v (get sym k)]
:when (and (some? v) (not (and (integer? v) (pos? v))))]
(str k " is " (pr-str v) " — a symbol stage dimension must be a positive integer")))
(into (try
(doall (map #(depth nodes %) (keys nodes)))
nil

View file

@ -0,0 +1,438 @@
(ns arthur.events.collab
"Everything that makes a document somewhere other people are: its address, who
you are, who else is in it, and their writes arriving while you work.
docs/architecture.md, Collaboration, and tl's model with the four additions it
asks for. Writes stay on HTTP; the socket carries presence and the deltas the
server broadcasts after a write commits.
ONE RULE FOR THE ADDRESS AND THE ROOM. They follow `[:project :id]`, whatever
event changed it — open, save, new, a copy — through one interceptor, so no
event that loads a document has to remember to join its room.
THE OUTBOX RULE, without an outbox. A remote leaf lands unless we have a change
to that leaf the server has not seen — a leaf whose local value differs from the
last value we synced. Otherwise their write would snap our unsaved edit back.
The next save sends ours, and if theirs moved since, it answers 409 and we catch
up, and the save after that is ours."
(:require [arthur.domain.leaf :as leaf]
[arthur.domain.project :as project]
[arthur.events.edit :as edit]
[arthur.events.playback :as pb]
[arthur.events.project :as events.project]
[arthur.footage.store :as store]
[arthur.fx.http :as http]
[clojure.string :as str]
[re-frame.core :as rf]))
;; ---------------------------------------------------------------------------
;; the address
(defn- path-id
"The project a path names: `/p/<uuid>/<slug>`. The slug is for people; the
id is what finds it."
[path]
(second (re-matches #"/p/([0-9a-fA-F-]{36})(?:/.*)?" path)))
(defn slug [name]
(or (not-empty (-> (str/lower-case (or name ""))
(str/replace #"[^a-z0-9]+" "-")
(str/replace #"^-+|-+$" "")))
"untitled"))
(defn project-path [id name] (str "/p/" id "/" (slug name)))
(defn- route! []
(rf/dispatch [::routed (path-id (.. js/window -location -pathname))]))
(defn navigate! [path]
(.pushState js/history nil "" path)
(route!))
(rf/reg-event-fx
::routed
;; `/` is the index of your projects; a project is only ever at its address.
(fn [{:keys [db]} [_ id]]
(cond
(nil? id) {:db (assoc db :route :index)
:dispatch [::events.project/list]}
(= id (get-in db [:project :id])) {:db (assoc db :route [:project id])}
:else {:db (assoc db :route [:project id])
:dispatch [::events.project/open id]})))
(rf/reg-sub ::route (fn [db _] (:route db)))
(rf/reg-fx
::create!
(fn [name]
(-> (http/POST "/api/projects" #js {:name name})
(.then (fn [^js made] (navigate! (project-path (.-id made) (.-name made)))))
(.catch #(rf/dispatch [::refused (ex-message %)])))))
(rf/reg-event-fx ::create (fn [_ [_ name]] {::create! (or name "untitled")}))
;; ---------------------------------------------------------------------------
;; the socket
(defonce ^:private socket (atom nil))
(defonce ^:private conn (atom {:id nil :tries 0 :timer nil}))
(defn- ws-url [id]
(str (if (= "https:" (.. js/window -location -protocol)) "wss://" "ws://")
(.. js/window -location -host) "/ws/projects/" id))
(declare open!)
(defn- retry-later! [id]
(let [tries (:tries @conn)
delay (min 30000 (* 500 (js/Math.pow 2 tries)))]
(swap! conn assoc :tries (inc tries)
:timer (js/setTimeout #(when (= id (:id @conn)) (open! id)) delay))))
(defn- open! [id]
(let [s (js/WebSocket. (ws-url id))]
(reset! socket s)
(set! (.-onopen s) (fn [_] (swap! conn assoc :tries 0)))
(set! (.-onmessage s) (fn [e] (rf/dispatch [::message (js/JSON.parse (.-data e))])))
;; Only the CURRENT socket clears the roster and retries: closing the last
;; project's on a switch must not wipe the new one's.
(set! (.-onclose s) (fn [_]
(when (identical? s @socket)
(reset! socket nil)
(rf/dispatch [::peers-reset])
(retry-later! id))))))
(defn- connect! [id]
(some-> (:timer @conn) js/clearTimeout)
(when-let [s @socket] (set! (.-onclose s) nil) (.close s))
(reset! socket nil)
(reset! conn {:id id :tries 0 :timer nil})
(rf/dispatch [::peers-reset])
(when id (open! id)))
(rf/reg-fx
::follow!
(fn [{:keys [id name]}]
(when id
(let [here (.. js/window -location -pathname)
path (project-path id name)]
(cond
(= path here) nil
;; Renamed: the same page, a new slug, and no new history entry.
(= id (path-id here)) (.replaceState js/history nil "" path)
:else (.pushState js/history nil "" path))))
(set! (.-title js/document) (if name (str name " — arthur") "arthur"))
(when (not= id (:id @conn))
(connect! id))))
(rf/reg-fx ::reconnect! (fn [_] (connect! (:id @conn))))
(def autosave?
"Every edit saves. Off only for tests that need an edit held unsaved."
true)
(def ^:private follow
"The address, the title and the room follow the open project, and the
document saves itself on every edit — `:paint/revision` is what moves when
the document does. A save with nothing to send sends nothing, and one made
while another is in flight goes when it lands.
THERE IS NO BARE PROJECT. A document with no id on screen at a project's
address — a built-in example, opened from the menu — is saved at once, and
becomes a project with an address of its own."
(rf/->interceptor
:id ::follow
:after (fn [ctx]
(let [db (get-in ctx [:effects :db] (get-in ctx [:coeffects :db]))
before (get-in ctx [:coeffects :db :project])
after (:project db)]
(cond-> ctx
(not= (select-keys before [:id :name]) (select-keys after [:id :name]))
(update-in [:effects :fx] (fnil conj [])
[::follow! (select-keys after [:id :name])])
(and autosave? (:id after) (vector? (:route db))
(not= (:paint/revision db) (get-in ctx [:coeffects :db :paint/revision])))
(update-in [:effects :fx] (fnil conj [])
[:dispatch [::events.project/save {:auto? true}]])
(and (nil? (:id after)) (vector? (:route db))
(or (:id before) (not= (:cid before) (:cid after))))
(update-in [:effects :fx] (fnil conj [])
[:dispatch [::events.project/save]]))))))
;; ---------------------------------------------------------------------------
;; presence
(rf/reg-event-db ::peers-reset (fn [db _] (assoc db :peers {})))
(defn- peer [^js m] {:cid (.-cid m) :user (.-user m)})
(rf/reg-event-fx
::message
(fn [{:keys [db]} [_ ^js m]]
(case (.-kind m)
"welcome" {:db (assoc db :peers {} :peer-cid (.-cid m))
;; Anything written between our GET and our joining the room
;; was broadcast to a room we were not in yet.
:dispatch [::catch-up]}
"roster" {:db (update db :peers into (map (fn [^js p] [(.-cid p) (peer p)]))
(array-seq (.-peers m)))}
("join" "state") {:db (assoc-in db [:peers (.-cid m)] (peer m))}
"leave" {:db (update db :peers dissoc (.-cid m))}
"delta" {:dispatch [::delta m]}
"access" {:dispatch [::catch-up]}
{})))
(rf/reg-sub
::peers
(fn [db _]
(->> (vals (:peers db))
(remove #(= (:cid %) (:peer-cid db)))
(sort-by (juxt (comp nil? :user) :user)))))
;; ---------------------------------------------------------------------------
;; their writes
(defn- put [m path v] (if (nil? v) (dissoc m path) (assoc m path v)))
(defn- landed
"Their change laid over ours, as `[local synced behind]`; a nil value is a
removal.
A leaf we have changed and not saved keeps our value, and theirs waits in
`behind` rather than in `synced`: `synced` is what we have SEEN, and putting
theirs there would let our next save overwrite it without a word. `take?` is
the first write winning — theirs was, so it goes on screen over ours."
[local synced behind theirs take?]
(let [pending? #(not= (get local %) (get synced %))]
(reduce-kv (fn [[now seen behind] path v]
(cond
(not (pending? path)) [(put now path v) (put seen path v) behind]
take? [(put now path v) (put seen path v) (dissoc behind path)]
:else [now seen (assoc behind path v)]))
[local synced behind] theirs)))
(rf/reg-fx
::fetch-blocks!
(fn [{:keys [keys then]}]
(-> (js/Promise.all (into-array (map #(http/GET (str "/api/blocks/" %)) keys)))
(.then #(rf/dispatch (conj then (project/store %))))
(.catch #(rf/dispatch [::events.project/failed (ex-message %)])))))
(rf/reg-event-fx
::remote
;; `written` and `removed` against what we last synced; `blocks` is the store
;; of any the new leaves name that we do not hold, once fetched.
(fn [{:keys [db]} [_ {:keys [by written removed take?] at :seq :as change} blocks]]
(let [cid (get-in db [:project :cid])
entry (store/entry (:clip/current db))
local (leaf/leaves cid (:clip entry))
theirs (merge written (zipmap removed (repeat nil)))
lost (if take?
(count (filter #(not= (get local %) (get (:synced entry) %)) (keys theirs)))
0)
[now synced behind] (landed local (:synced entry) (:behind entry) theirs take?)
have (merge (:store entry) blocks)
lack (remove #(contains? have %) (project/block-keys now))
status (fn [now synced]
(if (pos? lost)
(str lost (if (= 1 lost) " change" " changes")
" of yours lost to someone else's at the same moment — in your undo list")
(str (or by "someone") " saved r" at
(when (not= now synced) " · yours unsaved"))))]
(cond
(seq lack)
{::fetch-blocks! {:keys lack :then [::remote change]}}
(= now local)
{:db (-> db
(update :clip/current
#(or (store/edit-entry! % (fn [e] (assoc e :synced synced
:behind behind)))
%))
(assoc-in [:project :seq] at)
;; Our own write, back from the room, changes nothing to say.
(cond-> (or take? (not= by (get-in db [:me :username])))
(assoc-in [:project :status] (status now synced))))}
:else
(let [clip (leaf/clip cid now)
;; Theirs, so not a step of ours to undo.
db' (-> (edit/replace-entry db #(-> %
(assoc :clip clip :synced synced
:behind behind)
(update :store merge blocks)))
(edit/transport clip)
(update :project merge
{:seq at :status (status now synced)}))]
(cond-> {:db db'}
(not= (:fps clip) (get-in db [:clip :fps]))
(assoc ::pb/seek! [(:fps clip) (pb/frames db') (get-in db [:playback :frame])])))))))
(defn- ours
"The clip in a delta or a document that is the one open here."
[db clips]
(let [cid (get-in db [:project :cid])]
(first (filter #(= cid (.-cid ^js %)) (array-seq clips)))))
(rf/reg-event-fx
::delta
(fn [{:keys [db]} [_ ^js m]]
(let [local (get-in db [:project :seq])
seq (.-seq m)]
(cond
(or (nil? local) (<= seq local)) {}
;; A missed delta is a stale document forever, unless it is noticed.
(> seq (inc local)) {:dispatch [::catch-up]}
:else
(let [^js c (ours db (.-clips m))]
(cond-> {:db (cond-> (assoc-in db [:project :seq] seq)
(.-name m) (assoc-in [:project :name] (.-name m)))}
c (assoc :dispatch [::remote {:seq seq :by (.-by m)
:written (project/tier1 (.-leaves c))
:removed (vec (.-removed c))}])))))))
(rf/reg-fx
::catch-up!
(fn [[id take?]]
(-> (http/GET (str "/api/projects/" id))
(.then #(rf/dispatch [::caught-up % take?]))
(.catch #(js/console.warn "catching up failed" %)))))
(rf/reg-event-fx
::catch-up
(fn [{:keys [db]} [_ take?]]
(if-let [id (get-in db [:project :id])]
{::catch-up! [id take?]}
{})))
(rf/reg-event-fx
::caught-up
;; The whole document, diffed against what we last synced: which leaves they
;; wrote, and which they deleted.
(fn [{:keys [db]} [_ ^js loaded take?]]
(let [^js c (ours db (.-clips loaded))
synced (:synced (store/entry (:clip/current db)))
theirs (when c (project/tier1 (.-leaves c)))
access {:owner (.-owner loaded) :editors (vec (.-editors loaded))
:can-edit? (.-can_edit loaded)}]
(cond-> {:db (update db :project merge access)}
(and c (or take? (not= (.-seq loaded) (get-in db [:project :seq]))))
(assoc :dispatch [::remote {:seq (.-seq loaded) :by nil :take? take?
:written (into {} (remove (fn [[p v]] (= v (get synced p))))
theirs)
:removed (remove #(contains? theirs %) (keys synced))}])))))
;; ---------------------------------------------------------------------------
;; who you are, and who else may write
(rf/reg-fx
::request!
(fn [{:keys [method url body then]}]
(-> (http/request! method url body)
(.then #(rf/dispatch (conj then %)))
(.catch #(rf/dispatch [::refused (ex-message %)])))))
(rf/reg-event-fx ::who (fn [_ _] {::request! {:method "GET" :url "/api/me" :then [::signed]}}))
(rf/reg-event-fx
::sign-in
(fn [_ [_ mode username password]]
{::request! {:method "POST" :url (str "/api/" (name mode))
:body #js {:username username :password password}
:then [::signed]}}))
(rf/reg-event-fx
::sign-out
(fn [_ _] {::request! {:method "POST" :url "/api/logout" :then [::signed]}}))
(rf/reg-event-fx
::signed
;; Who you are changes what you may write and what the room calls you.
(fn [{:keys [db]} [_ ^js who]]
(let [username (.-username who)
changed? (not= username (get-in db [:me :username]))]
(cond-> {:db (assoc db :me {:username username})}
(and changed? (contains? db :me)) (assoc ::reconnect! nil
:fx [[:dispatch [::catch-up]]
[:dispatch [::events.project/list]]])))))
(rf/reg-event-db ::refused (fn [db [_ message]] (assoc-in db [:me :error] message)))
(rf/reg-sub ::me (fn [db _] (:me db)))
(rf/reg-event-fx
::add-editor
(fn [{:keys [db]} [_ username]]
{::request! {:method "POST" :url (str "/api/projects/" (get-in db [:project :id]) "/editors")
:body #js {:username username} :then [::editors]}}))
(rf/reg-event-fx
::remove-editor
(fn [{:keys [db]} [_ username]]
{::request! {:method "DELETE"
:url (str "/api/projects/" (get-in db [:project :id]) "/editors/"
(js/encodeURIComponent username))
:then [::editors]}}))
(rf/reg-event-db
::editors
(fn [db [_ ^js answer]]
(-> (assoc-in db [:project :editors] (vec (.-editors answer)))
(update :me dissoc :error))))
;; ---------------------------------------------------------------------------
;; snapshots: named versions, now that every edit saves itself
(defn- snapshots-url [db] (str "/api/projects/" (get-in db [:project :id]) "/revisions"))
(rf/reg-event-fx
::snapshots
(fn [{:keys [db]} _]
{::request! {:method "GET" :url (snapshots-url db) :then [::snapshots-listed]}}))
(rf/reg-event-db
::snapshots-listed
(fn [db [_ ^js answer]]
(assoc db :snapshots
(mapv (fn [^js r] {:id (.-id r) :name (.-summary r) :author (.-author r)
:seq (.-seq r) :created (.-created r)})
(array-seq (.-revisions answer))))))
(rf/reg-sub ::snapshot-list (fn [db _] (:snapshots db)))
(rf/reg-event-fx
::snapshot
(fn [{:keys [db]} [_ name]]
{::request! {:method "POST" :url (snapshots-url db) :body #js {:summary name}
:then [::snapshotted name]}}))
(rf/reg-event-fx
::snapshotted
(fn [{:keys [db]} [_ name _]]
{:db (assoc-in db [:project :status] (str "snapshot \"" name "\" taken"))
:dispatch [::snapshots]}))
(rf/reg-event-fx
::restore
;; An ordinary write on the server, which comes back to every open tab —
;; this one included — as a delta.
(fn [{:keys [db]} [_ {:keys [id name]}]]
{::request! {:method "POST" :url (str (snapshots-url db) "/" id "/restore")
:then [::restored name]}}))
(rf/reg-event-db
::restored
(fn [db [_ name _]] (assoc-in db [:project :status] (str "restored \"" name "\""))))
;; ---------------------------------------------------------------------------
(defn start!
"Follow the open project from now on, show what the address names — the
index, or a project — and answer the back button."
[]
(rf/reg-global-interceptor follow)
(rf/dispatch [::who])
(route!)
(.addEventListener js/window "popstate" route!))

View file

@ -0,0 +1,75 @@
(ns arthur.events.edit
"The one way an event changes the loaded document.
Three things have to happen together and the bug is any one of them being
forgotten: the clip in `footage/store` is edited, the id app-db refers to it by
is updated — `edit-clip!` may INSTALL A COPY, because a built-in clip is a
delayed value that must stay reusable — and `:paint/revision` is bumped so the
layer-3 subs downstream of `::render/clip` recompute. The revision exists
because the clip itself is behind a handle: app-db holds an id, the id does not
change when the document does, and a sub keyed only on the id would never see
the edit.
It started life private inside `events/paint`, which was right while polygons
were the only thing anyone could edit. They are not.
It is also where UNDO is recorded, for the same reason: being the one way a
person changes the document, it is the one place that sees every change they
make — and nothing else. A collaborator's write and an undo itself go through
`replace-entry`, which is this without the recording."
(:require [arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.footage.store :as store]))
(defn leaves
"The clip as leaves, which is what a history step is made of; nil for a clip
that has no leaf form."
[clip]
(try (leaf/leaves "u" clip) (catch :default _ nil)))
(defn- recorded [f]
(fn [entry]
(let [after (f entry)
b (when-not (identical? (:clip entry) (:clip after)) (leaves (:clip entry)))
a (when b (leaves (:clip after)))]
(cond-> after
a (assoc :history (history/record (:history entry) b a (js/Date.now)))))))
(defn replace-entry
"Apply `f` to the loaded entry without recording it as a step of yours."
[db f]
(let [id (store/edit-entry! (:clip/current db) f)]
(if id
(-> db
(assoc :clip/current id)
(update :paint/revision (fnil inc 0))
(update :project merge {:status "edited · unsaved"}))
db)))
(defn edit-entry
"Apply `f` to the loaded ENTRY — the document and the blocks, footage and
source tracks beside it — and return the new db. For an edit that brings tier-2
data in with it, which a document edit alone cannot."
[db f]
(replace-entry db (recorded f)))
(defn transport
"App-db's copy of what the transport reads off the clip, after the clip was
replaced under it — as `::events.project/project-setting` writes it."
[db clip]
(cond-> (update db :clip merge (select-keys clip [:width :height]))
(not= (:fps clip) (get-in db [:clip :fps]))
(update :clip merge {:fps (:fps clip) :display-fps (:fps clip)})))
(defn history
"Apply `f` to the loaded entry's undo history, which is not an edit: nothing
is redrawn and nothing becomes unsaved."
[db f]
(if-let [id (store/edit-entry! (:clip/current db) #(update % :history f))]
(assoc db :clip/current id)
db))
(defn edit
"Apply `f` to the loaded clip and return the new db."
[db f]
(edit-entry db #(update % :clip f)))

View file

@ -2,7 +2,7 @@
"Export, as intents and one effect.
The walk is not an event and must not become one: it is a promise chain that
runs for as long as the timeline is long, and re-frame events are the wrong unit
runs for as long as the symbol is long, and re-frame events are the wrong unit
for something with a middle. So `::start` collects what the render needs out of
the db and hands it to an fx, and the fx dispatches progress back — the same
arrangement `events/project`'s save uses, and for the same reason.
@ -44,84 +44,88 @@
(defn target-value
"An export target as a `<select>` option value.
Two kinds, told apart by a leading letter: `t:<timeline>` is a whole timeline,
`n:<timeline>:<node>` is one placement inside one. The parts are joined with `:`
because neither a timeline id nor a uuid contains one.
Two kinds, told apart by a leading letter: `s:<symbol>` is a whole symbol,
`n:<symbol>:<node>` is one instance inside one. The parts are joined with `:`
because neither a symbol id nor a uuid contains one.
IT CARRIES THE NAMESPACE. `(name :sym/face-8625)` is \"face-8625\", and a value
written that way cannot be read back: `keyword` on it gives `:face-8625`, which
is not a key in `:timelines`, so the plan silently becomes nil and the export
throws \"there is no such timeline\" from inside re-frame's `:do-fx`. That
is not a key in `:symbols`, so the plan silently becomes nil and the export
throws \"there is no such symbol\" from inside re-frame's `:do-fx`. That
presented as the tab locking up rather than as an error — see `::run!` below for
the other half of why — and it is the reason this is a named pair of functions
with a test rather than `name` and `keyword` at the two ends of a select."
[{:keys [timeline isolate]}]
(let [tl (subs (str (or timeline :main)) 1)]
(if isolate (str "n:" tl ":" isolate) (str "t:" tl))))
[{sid :symbol isolate :isolate}]
(let [s (subs (str sid) 1)]
(if isolate (str "n:" s ":" isolate) (str "s:" s))))
(defn target-id
"The inverse of `target-value`. `keyword` splits on the `/` itself, so a
namespaced timeline id survives; a placement comes back a uuid, which is what
namespaced symbol id survives; an instance comes back a uuid, which is what
the node map is keyed by."
[v]
(let [[kind tl node] (str/split v #":")]
(cond-> {:timeline (keyword tl)}
(let [[kind s node] (str/split v #":")]
(cond-> {:symbol (keyword s)}
(= "n" kind) (assoc :isolate (uuid node)))))
(defn targets
"Everything an export can be pointed at, in the order the picker lists them.
THREE KINDS, and the distinction is the point. `:main` is the clip. A symbol
timeline is the DRAWING — one file however many times it is placed, in its own
frame space. A placement is that drawing WHERE IT SITS: the stage's length and
rate, with the other placements removed, which is why seven instances of one
symbol are seven different exports rather than seven copies of one.
TWO KINDS, and the distinction is the point. A symbol is the DRAWING — one file
however many times it is placed, in its own frame space. An instance is that
drawing WHERE IT SITS in the open symbol: that symbol's length and rate, with
the other instances removed, which is why seven instances of one symbol are
seven different exports rather than seven copies of one.
Placements are ordered and labelled by `:name`, never by id: a uuid sorts at
Instances are ordered and labelled by `:name`, never by id: a uuid sorts at
random and means nothing to read."
[clip]
(let [libs (cons :main (sort-by str (remove #{:main} (keys (:timelines clip)))))
placements (->> (get-in clip [:timelines :main :nodes])
(filter (comp #{:symbol} :kind val))
(sort-by (fn [[id n]] [(or (:name n) "") (str id)])))]
(into (mapv (fn [tid]
{:timeline tid
:label (if (= :main tid) "main (the clip)" (name tid))})
libs)
[clip open]
(let [instances (->> (get-in clip [:symbols open :nodes])
(filter (comp #{:instance} :kind val))
(sort-by (fn [[id n]] [(or (:name n) "") (str id)])))]
(into (mapv (fn [sid] {:symbol sid :label (name sid)})
(sort-by str (keys (:symbols clip))))
(mapv (fn [[id n]]
{:timeline :main :isolate id
{:symbol open :isolate id
:label (or (:name n) (str id))})
placements))))
instances))))
(defn target
"What the export is pointed at. A nil symbol is whichever one is open, so a
new document exports what is on screen without anyone choosing."
[db]
(let [{sid :symbol isolate :isolate} (:export db)]
{:symbol (or sid (get-in db [:ui :open])) :isolate isolate}))
(defn- label-of
"The label of the target `db` currently points at, for the filename."
[clip {:keys [timeline isolate]}]
(:label (or (first (filter #(and (= timeline (:timeline %))
(= isolate (:isolate %)))
(targets clip)))
{:label (some-> timeline name)})))
[clip open {sid :symbol isolate :isolate}]
(:label (or (first (filter #(and (= sid (:symbol %)) (= isolate (:isolate %)))
(targets clip open)))
{:label (some-> sid name)})))
(rf/reg-sub ::state (fn [db _] (:export db)))
(rf/reg-sub ::state (fn [db _] (assoc (:export db) :target (target db))))
(rf/reg-sub
::targets
(fn [db _]
(targets (:clip (store/entry (:clip/current db))))))
(targets (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]))))
(rf/reg-sub
::plan
(fn [db _]
(let [{:keys [clip]} (store/entry (:clip/current db))
{:keys [timeline zoom isolate]} (:export db)]
(export/plan {:clip clip :timeline timeline :zoom zoom :isolate isolate
{sid :symbol isolate :isolate} (target db)]
(export/plan {:clip clip :symbol sid :zoom (get-in db [:export :zoom])
:isolate isolate
:picture-fps (get-in db [:clip :display-fps])}))))
(rf/reg-event-db
::set-target
;; Both keys always, so switching from a placement back to a whole timeline
;; Both keys always, so switching from an instance back to a whole symbol
;; clears the isolate rather than leaving it to filter the new target.
(fn [db [_ {:keys [timeline isolate]}]]
(update db :export merge {:timeline (or timeline :main) :isolate isolate})))
(fn [db [_ {sid :symbol isolate :isolate}]]
(update db :export merge {:symbol sid :isolate isolate})))
(rf/reg-event-db
::set-zoom
@ -134,16 +138,17 @@
{}
(let [id (:clip/current db)
entry (store/entry id)
{:keys [timeline zoom isolate]} (:export db)]
{sid :symbol isolate :isolate} (target db)
zoom (get-in db [:export :zoom])]
{:db (update db :export merge {:busy? true :done 0
:total (:frames (export/plan
{:clip (:clip entry)
:timeline timeline
:symbol sid
:isolate isolate
:zoom zoom}))
:status "rendering…"})
::run! {:clip (:clip entry)
:timeline timeline
:symbol sid
:isolate isolate
:store (:store entry)
;; The same palette and ramp the preview resolves and blits
@ -156,8 +161,8 @@
:picture-fps (get-in db [:clip :display-fps])
:audio-url (:audio entry)
:name (stem (:label entry)
(label-of (:clip entry)
{:timeline timeline :isolate isolate}))}}))))
(label-of (:clip entry) (get-in db [:ui :open])
{:symbol sid :isolate isolate}))}}))))
(rf/reg-event-db
::progress
@ -197,7 +202,7 @@
::run!
(fn [spec]
;; THE CALL IS GUARDED because `export/run!` validates its request BEFORE it
;; returns a promise, so a bad timeline id throws synchronously — here, inside
;; returns a promise, so a bad symbol id throws synchronously — here, inside
;; re-frame's `:do-fx` interceptor. An uncaught throw there never reaches the
;; `.catch` below, so `::failed` never dispatches and `:busy?` stays true: the
;; button sits disabled on \"rendering…\" and the readout on \"frame 0 /\"

View file

@ -4,7 +4,9 @@
The frames come from the server by URL since step 9 — see `flow/ingest` — and the
detector's identity comes from the server too, because it goes into the content
address of every block this produces."
(:require [arthur.domain.clip :as clip]
(:require [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]
[arthur.events.edit :as edit]
[arthur.events.playback :as pb]
[arthur.flow.detect :as detect]
[arthur.flow.ingest :as ingest]
@ -14,6 +16,7 @@
[arthur.footage.store :as store]
[arthur.domain.landmarks :as lm]
[arthur.fx.http :as http]
[clojure.string :as string]
[re-frame.core :as rf]))
(defonce ^:private clock (atom 0))
@ -44,8 +47,12 @@
The work happens inside `decode!`'s callback, and the promise it returns is the
backpressure: the decoder does not run ahead of the detector, so a 900-frame
take does not hold 900 decoded frames at 1440x1920 in memory."
[manifest model]
take does not hold 900 decoded frames at 1440x1920 in memory.
Only source frames `[start end)` are measured. Decoding still begins at frame
0, because every frame after the first is coded against the ones before it,
and it stops at `end`; frames before `start` are decoded and dropped unread."
[manifest model [start end]]
(let [[w h] [(:width manifest) (:height manifest)]
canvas (.createElement js/document "canvas")
ctx (.getContext canvas "2d" #js {:willReadFrequently true})
@ -53,45 +60,48 @@
raw (atom [])
crops (atom [])
inner (atom [])
total (:frames manifest)]
total end]
(set! (.-width canvas) w)
(set! (.-height canvas) h)
(rf/dispatch [::progress "loading the video…"])
(-> (ingest/stream! (ingest/stream-url manifest) total)
(-> (ingest/stream! (ingest/stream-url manifest) (:frames manifest))
(.then
(fn [stream]
(ingest/decode!
stream fps w h
(update stream :units subvec 0 end) fps w h
(fn [i frame]
(.drawImage ctx frame 0 0)
;; EVERY FACE ON THIS FRAME, each with its own mouth crop taken
;; while the frame's pixels are still on the canvas. Which of these
;; detections belongs to which subject is not decided here — the
;; answer needs the whole take — so all three vectors stay in
;; DETECTION ORDER and `detect/tracks` re-keys them afterwards.
(let [faces (detect/detect! model canvas (ingest/frame-ms fps i))
boxes (mapv (fn [face]
(interior/crop (mapv #(nth face %) lm/LIPS-INNER)
[w h]))
faces)
frame-crops (mapv (fn [box]
(when box
{:box box
:data (.-data (.getImageData
ctx (:x box) (:y box)
(:w box) (:h box)))}))
boxes)]
(swap! raw conj faces)
(swap! crops conj frame-crops)
;; MEASURED HERE, NOT IN A SECOND PASS. It is the same work
;; either way, but done after the fact it is ten seconds of
;; synchronous arithmetic with the main thread held and the
;; frame counter frozen on its last value — which reads as the
;; decoder hanging, and was diagnosed as that twice.
(swap! inner conj (mapv #(source/measure-crop take/knobs %)
frame-crops)))
(when (>= i start)
(.drawImage ctx frame 0 0)
;; EVERY FACE ON THIS FRAME, each with its own mouth crop taken
;; while the frame's pixels are still on the canvas. Which of
;; these detections belongs to which subject is not decided here
;; — the answer needs the whole take — so all three vectors stay
;; in DETECTION ORDER and `detect/tracks` re-keys them afterwards.
(let [faces (detect/detect! model canvas (ingest/frame-ms fps i))
boxes (mapv (fn [face]
(interior/crop (mapv #(nth face %) lm/LIPS-INNER)
[w h]))
faces)
frame-crops (mapv (fn [box]
(when box
{:box box
:data (.-data (.getImageData
ctx (:x box) (:y box)
(:w box) (:h box)))}))
boxes)]
(swap! raw conj faces)
(swap! crops conj frame-crops)
;; MEASURED HERE, NOT IN A SECOND PASS. It is the same work
;; either way, but done after the fact it is ten seconds of
;; synchronous arithmetic with the main thread held and the
;; frame counter frozen on its last value — which reads as the
;; decoder hanging, and was diagnosed as that twice.
(swap! inner conj (mapv #(source/measure-crop take/knobs %)
frame-crops))))
(when (or (zero? i) (zero? (mod (inc i) 4)) (= (inc i) total))
(rf/dispatch [::progress (str "detecting " (inc i) "/" total)]))
(rf/dispatch [::progress (if (< i start)
(str "seeking " (inc i) "/" start)
(str "detecting " (- (inc i) start) "/" (- end start)))]))
;; Yield, so the status and the transport paint between synchronous
;; MediaPipe calls. `decode!` waits on this before feeding more.
(js/Promise. (fn [done] (js/setTimeout done 0)))))))
@ -142,7 +152,6 @@
source-blocks (source/pack-subjects (:id (:analysis built)) subjects)
_ (mark! "build-clip: pack source blocks")]
(assoc (select-keys built [:fps :width :height])
:frames (clip/frames built)
:display-fps (:fps built)
:clip built :store (:store frozen)
:source-blocks source-blocks
@ -252,38 +261,44 @@
(js/Promise.resolve track)
(:subjects track)))
(defn- analyse!
"Promise of source frames `[start end)` of footage `footage-id`, detected,
measured and frozen — `{:clip :store ...}` as `build-clip` makes it, with the
footage reading as though it were only those frames. A saved analysis of
exactly that range is reused instead of detecting again."
[footage-id [start end]]
(-> (js/Promise.all #js [(ingest/manifest! footage-id) (ingest/detector!)])
(.then (fn [[full detector]]
(let [manifest (ingest/slice full start end)]
(reset! clock (js/Date.now))
(rf/dispatch [::progress "looking for saved analysis…"])
(-> (cached-source! manifest detector)
(.then (fn [track]
(if track
(do (rf/dispatch [::progress "reusing saved analysis…"])
(-> (measure-crops!
take/knobs track
(fn [done total]
(when (or (= 1 done) (zero? (mod done 4))
(= done total))
(rf/dispatch
[::progress (str "measuring " done "/" total)]))))
(.then #(build-clip manifest detector %))))
(do (rf/dispatch [::progress "loading MediaPipe…"])
(-> (detect/landmarker!)
(.then (fn [model]
(mark! "MediaPipe ready")
(rf/dispatch [::progress "opening the video…"])
(detect-frames! full model [start end])))
(.then #(build-clip manifest detector %)))))))))))))
(rf/reg-fx
::begin!
(fn [footage-id]
(-> (js/Promise.all #js [(ingest/manifest! footage-id) (ingest/detector!)])
(.then (fn [[manifest detector]]
(reset! clock (js/Date.now))
(rf/dispatch [::progress "looking for saved analysis…"])
(-> (cached-source! manifest detector)
(.then (fn [track]
(if track
(do (rf/dispatch [::progress "reusing saved analysis…"])
(-> (measure-crops!
take/knobs track
(fn [done total]
(when (or (= 1 done) (zero? (mod done 4))
(= done total))
(rf/dispatch
[::progress (str "measuring " done "/" total)]))))
(.then (fn [measured]
(build-clip manifest detector measured)))))
(do (rf/dispatch [::progress "loading MediaPipe…"])
(-> (detect/landmarker!)
(.then (fn [model]
(mark! "MediaPipe ready")
(rf/dispatch [::progress "opening the video…"])
(-> (detect-frames! manifest model)
(.then (fn [fresh]
(build-clip manifest detector fresh))))))))))))))
(.then (fn [entry]
::convert!
(fn [{:keys [footage-id range] :as request}]
(-> (analyse! footage-id range)
(.then (fn [built]
(mark! "build-clip: done")
(let [id (store/install! entry)]
(rf/dispatch [::loaded id (:summary entry)]))))
(rf/dispatch [::converted request built])))
(.catch (fn [error]
(js/console.error error)
;; A run that ended badly may have ended on a MediaPipe graph
@ -337,8 +352,13 @@
(rf/reg-event-fx
::uploaded
(fn [{:keys [db]} [_ footage-id]]
{:db (update db :footage merge {:loading? false :chosen footage-id
:status "video extracted — load frames to analyze"})
;; Into the pool, and no further. An upload is media for this project; turning
;; it into a symbol is a separate decision — which frames, what name — made by
;; dropping it where it should go.
{:db (update db :footage #(-> %
(merge {:loading? false :chosen footage-id
:status "video extracted"})
(update :uploaded (fnil conj #{}) footage-id)))
:dispatch [::refresh]}))
(rf/reg-event-fx
@ -357,19 +377,6 @@
::choose
(fn [db [_ id]] (assoc-in db [:footage :chosen] id)))
(rf/reg-event-fx
::load
(fn [{:keys [db]} _]
(let [chosen (get-in db [:footage :chosen])]
(cond
(get-in db [:footage :loading?]) {}
(nil? chosen)
{:db (assoc-in db [:footage :status] "upload a video to begin")}
:else
{:db (update db :footage merge {:loading? true :status "reading the manifest…"})
::pb/pause! nil
::begin! chosen}))))
(rf/reg-event-db
::progress
(fn [db [_ message]] (assoc-in db [:footage :status] message)))
@ -380,15 +387,67 @@
(assoc db :footage (assoc (:footage db)
:loading? false :status (str "footage failed: " message)))))
;; ---------------------------------------------------------------------------
;; footage -> a symbol
;;
;; Dropping a video asks first. `[:ui :convert]` is the question — which footage,
;; which of its frames, what to call the result — and where the answer will be
;; placed: `:host`, `:frame` and `:point` are the drop's, captured when it happened
;; so that switching tabs while detection runs does not move where it lands.
(rf/reg-event-db
::ask-convert
(fn [db [_ {:keys [frames label] :as footage} frame point]]
(assoc-in db [:ui :convert]
(merge (select-keys footage [:id :label :frames :fps :video])
{:range [0 frames]
:name (string/replace (str label) #"\.[^.]*$" "")
:host (get-in db [:ui :open]) :frame frame :point point}))))
(rf/reg-event-db
::convert-set
(fn [db [_ k v]] (assoc-in db [:ui :convert k] v)))
(rf/reg-event-db
::convert-cancel
(fn [db _]
(if (get-in db [:footage :loading?]) db (update db :ui dissoc :convert))))
(rf/reg-event-fx
::loaded
(fn [{:keys [db]} [_ id summary]]
(let [clip (store/entry id)]
::convert
(fn [{:keys [db]} _]
(let [{:keys [id range] :as request} (get-in db [:ui :convert])]
(if (or (nil? request) (get-in db [:footage :loading?]))
{}
{:db (update db :footage merge {:loading? true :status "starting…"})
::pb/pause! nil
::convert! {:footage-id id :range range :request request}}))))
(rf/reg-event-fx
::converted
(fn [{:keys [db]} [_ {{:keys [name host frame point range]} :request footage-id :footage-id}
built]]
(let [uuid (random-uuid)
fps (get-in db [:clip :fps])
{:keys [clip sid tracked?]}
(bring/take (:clip (store/entry (:clip/current db))) (:clip built)
name footage-id range)
imported-frames (clip/frames clip sid)
source-fps (get-in built [:clip :fps])
db (edit/edit-entry
db
#(cond-> (bring/placed % clip (:store built) sid host frame uuid point)
tracked? (merge (select-keys built [:footage-id :source-blocks
:source-inputs]))))]
{:db (-> db
(assoc :clip/current id
:clip (select-keys clip [:fps :frames :width :height :audio :display-fps])
:footage (assoc (:footage db) :id id :label (:label clip)
:loading? false :status summary))
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pb/pause! nil})))
(update :ui dissoc :convert)
(assoc-in [:ui :selection] [:node host uuid [uuid]])
(update :footage merge
{:loading? false
:status (str "made " name " · " imported-frames " frames at " fps " fps"
(when (not= fps source-fps)
(str " · sampled from " source-fps " fps"))
(when-not tracked?
" · as drawings: this project already tracks other footage"))}))
:dispatch [::pb/refresh-clock]})))

View file

@ -0,0 +1,88 @@
(ns arthur.events.history
"Undo and redo: `domain/history` against the open document, and the keys.
An undone step is an ordinary unsaved edit afterwards, and the next save sends
it — so undo reaches a collaborator the way any change of yours does."
(:require [arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.events.edit :as edit]
[arthur.events.playback :as pb]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[re-frame.core :as rf]))
(defn- step
"One step of `move` on `db`: `{:db :fps :ok?}`, `:ok?` false when there was
nothing to do or the step was refused."
[db move done]
(let [entry (store/entry (:clip/current db))
leaves (edit/leaves (:clip entry))
r (when leaves (move (:history entry) leaves))]
(cond
(nil? r)
{:db (assoc-in db [:project :status] (str "nothing to " (subs done 0 4))) :ok? false}
(:blocked r)
{:db (-> (edit/replace-entry db #(assoc % :history (:history r)))
(assoc-in [:project :status]
(str "not " done ": " (:label (:blocked r))
" — someone else has changed it since")))
:ok? false}
:else
(let [clip (leaf/clip "u" (:leaves r))
[kind host node] (get-in db [:ui :selection])
label (:label (peek (get (:history r) (if (= done "undone") :undone :done))))]
{:ok? true
:db (-> (edit/replace-entry db #(assoc % :clip clip :history (:history r)))
(edit/transport clip)
;; A selection of what the step removed selects nothing.
(cond-> (and (= :node kind) (nil? (get-in clip [:symbols host :nodes node])))
(update :ui dissoc :selection))
(assoc-in [:project :status] (str done " " label " · unsaved")))}))))
(defn- steps
"`n` steps, stopping at the first that cannot be taken."
[db move done n]
(let [fps (get-in db [:clip :fps])
db (loop [db db n n]
(let [r (step db move done)]
(if (and (:ok? r) (< 1 n)) (recur (:db r) (dec n)) (:db r))))]
(cond-> {:db db}
(not= fps (get-in db [:clip :fps]))
(assoc ::pb/seek! [(get-in db [:clip :fps]) (pb/frames db) (get-in db [:playback :frame])]))))
(rf/reg-event-fx ::undo (fn [{:keys [db]} [_ n]] (steps db history/undo "undone" (or n 1))))
(rf/reg-event-fx ::redo (fn [{:keys [db]} [_ n]] (steps db history/redo "redone" (or n 1))))
(rf/reg-event-db ::hold (fn [db _] (edit/history db history/hold)))
(rf/reg-event-db ::settle (fn [db _] (edit/history db history/settle)))
(rf/reg-sub
::steps
;; The history is on the entry, outside app-db; the revision is what moves
;; when the entry does, undo and redo included.
(fn [db _]
(:paint/revision db)
(history/steps (:history (store/entry (:clip/current db))))))
(defn- typing? [^js target]
(or (#{"INPUT" "TEXTAREA" "SELECT"} (.-tagName target)) (.-isContentEditable target)))
(defn install-keys!
"⌘Z / Ctrl+Z undoes, with Shift redoes, and Ctrl+Y redoes; Delete or
Backspace deletes the selected node, which undo brings back. Not while typing
in a field, where the browser's own keys are the ones wanted."
[]
(.addEventListener
js/window "keydown"
(fn [^js e]
(when-not (typing? (.-target e))
(let [k (.toLowerCase (.-key e))]
(when-let [ev (if (or (.-metaKey e) (.-ctrlKey e))
(cond (and (= k "z") (.-shiftKey e)) ::redo
(= k "z") ::undo
(= k "y") ::redo)
(when (#{"delete" "backspace"} k) ::ui/delete-selected))]
(.preventDefault e)
(rf/dispatch [ev])))))))

View file

@ -1,33 +1,30 @@
(ns arthur.events.paint
"Polygon edits. Every one of them is `edit/edit` plus a pure `domain/paint`
function, which is the shape every document edit in this app should have."
(:require [arthur.domain.paint :as paint]
[arthur.footage.store :as store]
[arthur.events.edit :as edit]
[re-frame.core :as rf]))
(defn- edit [db f]
(let [id (store/edit-clip! (:clip/current db) f)]
(if id
(-> db
(assoc :clip/current id)
(update :paint/revision (fnil inc 0))
(update :project merge {:status "paint edited · unsaved"}))
db)))
(rf/reg-event-db
::new-shape
(fn [db [_ id points color]]
(edit db #(paint/new-shape % id (get-in db [:playback :frame]) points color))))
;; `frame` is the symbol's own: a shape drawn into an instance starts on the
;; frame that instance is showing, not the transport's.
(fn [db [_ sid id frame points color]]
(edit/edit db #(paint/new-shape % sid id frame points color))))
(rf/reg-event-db
::add-key
(fn [db [_ id]]
(edit db #(paint/add-key % id (get-in db [:playback :frame])))))
;; `frame` is the shape's own, which is the transport's only for a shape in the
;; open symbol with no time map of its own.
(fn [db [_ sid id frame]]
(edit/edit db #(paint/add-key % sid id frame))))
(rf/reg-event-db
::set-vertex
(fn [db [_ id key-frame vertex point]]
(edit db #(paint/set-vertex % id key-frame vertex point))))
(fn [db [_ sid id key-frame vertex point]]
(edit/edit db #(paint/set-vertex % sid id key-frame vertex point))))
(rf/reg-event-db
::set-segment-interp
(fn [db [_ id key-frame interp]]
(edit db #(paint/set-segment-interp % id key-frame interp))))
(fn [db [_ sid id key-frame interp]]
(edit/edit db #(paint/set-segment-interp % sid id key-frame interp))))

View file

@ -10,12 +10,35 @@
traversals a second, which is the one genuinely expensive thing you can do to
a small app-db. If global interceptors are added later they are added to a
chain these events are excluded from, not to `reg-global-interceptor`."
(:require [arthur.clock :as clock]
(:require [arthur.audio.mix :as mix]
[arthur.clock :as clock]
[arthur.domain.clip :as clip]
[arthur.footage.store :as footage]
[re-frame.core :as rf]))
(defn- fps [db] (get-in db [:clip :fps]))
(defn- frames [db] (get-in db [:clip :frames]))
(defn frames
"The open symbol's length. Derived from the document every time, never kept in
the db beside it, because an edit can change it."
[db]
(or (some-> (footage/entry (:clip/current db)) :clip
(clip/frames (get-in db [:ui :open])))
1))
(defn show
"Put loaded clip `id` on screen, open on the symbol it opens on, with the
playhead home. What every way of loading a document ends in, so that none of
them can forget which symbol is open."
[db id]
(let [entry (footage/entry id)
sid (clip/opens-on (:clip entry))]
(-> db
(assoc :clip/current id
:clip (select-keys entry [:fps :width :height :audio :display-fps]))
(update :ui merge {:open sid :tabs (if sid [sid] [])})
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))))
(rf/reg-event-db
::tick
@ -99,14 +122,87 @@
;; Changing the clip changes the resolver, the frame count and the rate all
;; at once, so the playhead goes home rather than being left pointing at a
;; frame the new clip may not have.
(let [{:keys [fps frames] :as clip} (footage/entry id)]
{:db (-> db
(assoc :clip/current id)
;; The stage travels with the clip: two clips may be different
;; sizes, and the raster the loop paints into is the clip's, not
;; the app's.
(assoc :clip (select-keys clip [:fps :frames :width :height :audio :display-fps]))
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
(let [{:keys [label cid]} (footage/entry id)
db (-> (show db id)
;; The document's identity goes with it. A built-in scene has no
;; project on the server, so this CLEARS the id rather than
;; keeping the last one — saving a fixture must create a
;; document of its own, not overwrite whatever was open before.
(assoc :project {:id nil :cid cid :name label
:seq nil :busy? false
:status "built-in example · not a saved project"}))]
{:db db
::pause! nil
::seek! [fps frames 0]})))
::seek! [(fps db) (frames db) 0]})))
;; ---------------------------------------------------------------------------
;; tabs
;;
;; A tab is an open symbol. `:open` is the one on screen and `:tabs` the ones
;; beside it, in the order they were opened. Switching is `:open` and a clock:
;; the stage, the timeline rows, the transport's length and a new shape's home
;; all follow `:open` through their subscriptions without being told.
(defonce ^:private clock-url (atom nil))
(rf/reg-fx
::clock!
(fn [{:keys [id sid]}]
(let [{:keys [clip audio store]} (footage/entry id)]
(-> (mix/clock! clip sid audio store)
(.then #(rf/dispatch [::clock-ready id sid %]))
(.catch #(js/console.error %))))))
(rf/reg-event-fx
::clock-ready
(fn [{:keys [db]} [_ id sid url]]
(if (and (= id (:clip/current db)) (= sid (get-in db [:ui :open])))
(do
;; A blob URL made for the last tab is released when the next one lands,
;; and never the document's own file.
(when-let [old @clock-url]
(when (not= old url) (js/URL.revokeObjectURL old)))
(reset! clock-url (when (and (not= url (:audio (footage/entry id)))
(.startsWith url "blob:"))
url))
{:db (assoc-in db [:clip :audio] url)})
{})))
(rf/reg-event-db
::paint-failed
(fn [db [_ message]]
(update db :project merge {:status (str "cannot draw: " message)})))
(rf/reg-event-fx
::refresh-clock
;; After an edit that changes what the open symbol sounds like.
(fn [{:keys [db]} _]
{::clock! {:id (:clip/current db) :sid (get-in db [:ui :open])}}))
(rf/reg-event-fx
::open-symbol
(fn [{:keys [db]} [_ sid]]
(let [clip (:clip (footage/entry (:clip/current db)))]
(if (or (nil? (clip/symbol clip sid)) (= sid (get-in db [:ui :open])))
{}
{:db (-> db
(update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid)))
(assoc-in [:ui :open] sid)
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pause! nil
::clock! {:id (:clip/current db) :sid sid}}))))
(rf/reg-event-fx
::close-tab
(fn [{:keys [db]} [_ sid]]
;; The last tab cannot be closed: something is always on screen, because the
;; transport and the stage have no meaning without a symbol.
(let [tabs (get-in db [:ui :tabs])
left (vec (remove #{sid} tabs))]
(cond
(empty? left) {}
(not= sid (get-in db [:ui :open])) {:db (assoc-in db [:ui :tabs] left)}
:else (let [i (.indexOf tabs sid)]
{:db (assoc-in db [:ui :tabs] left)
:dispatch [::open-symbol (get left (min i (dec (count left))))]})))))

View file

@ -21,7 +21,12 @@
Nothing here touches app-db except through events. The promise chain lives in an
fx, which is the only thing in this namespace that is not pure."
(:require [arthur.domain.clip :as clip]
(:require [arthur.db :as db]
[arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.events.edit :as edit]
[arthur.audio.mix :as mix]
[arthur.demo.stage :as stage]
[arthur.domain.feature :as feature]
@ -37,6 +42,7 @@
[arthur.flow.take :as take]
[arthur.fx.http :as http]
[arthur.synth :as synth]
[clojure.string :as str]
[re-frame.core :as rf]))
(defn- analysis-payload [analysis]
@ -108,28 +114,109 @@
built (:clip loaded)]
(let [entry (merge (select-keys built [:fps :width :height])
{:label (str (or (.-name clip-json) cid) " (saved)")
:cid cid :frames (clip/frames built)
:cid cid
;; What the server holds, as of the seq
;; this was opened at: a save sends what
;; differs from it, and a collaborator's
;; write lands on what does not.
:synced (project/tier1 (.-leaves clip-json))
:display-fps (:fps built)
:clip built :store (:store loaded)
:footage-id footage-id
:audio (if footage (.-audio footage)
"/static/arthur/audio.wav")})]
(-> (mix/mix! built (:audio entry) (:store entry))
(-> (mix/mix! built (clip/opens-on built) (:audio entry) (:store entry))
(.then (fn [audio] (assoc entry :audio audio)))))))))))
(defn- saved-clip!
"Promise of clip `cid` of saved project `pid`, as `{:clip :store}`: its
document and the blocks it names, and nothing played or mixed."
[pid cid]
(-> (http/GET (str "/api/projects/" pid))
(.then (fn [^js doc]
(let [^js c (or (first (filter #(= cid (.-cid ^js %)) (array-seq (.-clips doc))))
(throw (ex-info "that project no longer has that clip" {:cid cid})))]
(-> (js/Promise.all (into-array (map #(http/GET (str "/api/blocks/" %))
(array-seq (.-blocks c)))))
(.then (fn [blocks]
(project/load cid #js {:leaves (.-leaves c) :blocks blocks})))))))))
(rf/reg-fx
::import!
(fn [{:keys [project cid] :as request}]
(-> (saved-clip! project cid)
(.then #(rf/dispatch [::imported request %]))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-event-fx
::import
;; A symbol out of another saved project, dropped at `frame` of the open symbol
;; and, from the stage, with its middle on `point`.
(fn [{:keys [db]} [_ carried frame point]]
{:db (update db :project merge {:status (str "fetching " (:label carried) "…")})
::import! (assoc (select-keys carried [:project :cid :symbol :label])
:host (get-in db [:ui :open]) :frame frame :point point)}))
(rf/reg-event-fx
::imported
;; As drawing: its tracking stays with the analysis that measured it. See
;; `arthur.domain.bring`.
(fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]]
(let [sid (leaf/unsegment symbol)
uuid (random-uuid)
{:keys [clip ids]} (bring/symbols (:clip (store/entry (:clip/current db)))
(:clip other) [sid] {})
db (edit/edit-entry db #(bring/placed % clip (:store other) (ids sid)
host frame uuid point))]
{:db (-> db
(assoc-in [:ui :selection] [:node host uuid [uuid]])
(update :project merge {:status (str "brought in " label)}))
:dispatch [::pb/refresh-clock]})))
(defn- clip-payload
"One clip of a save. With `base` — the seq the open document last caught up
to — only the leaves that differ from what the server held then, and the ones
since deleted: a collaborator's leaves are not ours to write back. Without it,
the whole clip."
[^js doc base local synced]
(if base
(let [all (.-leaves doc)
out (js-obj)]
(doseq [[path v] local :when (not= v (get synced path))]
(aset out path (aget all path)))
#js {:leaves out
:removed (into-array (remove #(contains? local %) (keys synced)))})
#js {:leaves (.-leaves doc)}))
(defonce ^:private on-server
;; Analyses and block keys this page has already put on the server. Content
;; addressed, so once there they are there: a save of a moved vertex asks for
;; none of it again, and is one request.
(atom #{}))
(defn- upload-new! [^js doc]
(let [keys (array-seq (block-keys doc))]
(if (every? @on-server keys)
(js/Promise.resolve 0)
(.then (upload-missing! doc) (fn [n] (swap! on-server into keys) n)))))
(rf/reg-fx
::save!
(fn [{:keys [id cid label clip]}]
(fn [{:keys [id cid label clip base]}]
(let [analysis (:analysis (:clip clip))
doc (project/save cid clip)
local (leaf/leaves cid (:clip clip))
base (when (and id (:synced clip)) base)
source-blocks (:source-blocks clip)]
(-> (ensure-project! id label)
(.then (fn [pid]
(-> (if analysis
(-> (if (and analysis (not (@on-server (:id analysis))))
(http/POST "/api/analyses" (analysis-payload analysis))
(js/Promise.resolve nil))
(.then (fn [_]
(when (seq source-blocks)
(when (and (seq source-blocks) (not (@on-server (:id analysis))))
(-> (upload-missing!
#js {:blocks (source/upload-blocks source-blocks)})
(.then (fn [_]
@ -141,24 +228,74 @@
#js {:source_blocks
(into-array
(source/block-keys source-blocks))})))))))
(.then (fn [_] (upload-missing! doc)))
(.then (fn [_]
(when analysis (swap! on-server conj (:id analysis)))
(upload-new! doc)))
(.then (fn [uploaded]
(-> (http/PUT (str "/api/projects/" pid)
#js {:name label
:clips #js [#js {:cid cid
:name label
:analysis (:id analysis)
:footage (:footage-id clip)
:leaves (.-leaves doc)
:blocks (block-keys doc)}]})
:base base
:clips #js [(js/Object.assign
#js {:cid cid
:name label
:analysis (:id analysis)
:footage (:footage-id clip)
:blocks (block-keys doc)}
(clip-payload doc base local
(:synced clip)))]})
(.then (fn [^js saved]
(rf/dispatch [::saved pid cid label
(.-seq saved)
(count (array-seq (.-written saved)))
uploaded])))))))))
uploaded
{:synced local :base base}])))))))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(if-let [conflicts (get-in (ex-data error) [:body :conflicts])]
(rf/dispatch [::conflicted (count conflicts)])
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))))
(rf/reg-fx
::list!
(fn [_]
(-> (http/GET "/api/projects")
(.then (fn [^js listed]
(rf/dispatch [::listed
(mapv (fn [^js row]
{:id (.-id row) :name (.-name row)
:owner (.-owner row)
:seq (.-seq row) :updated (.-updated row)})
(array-seq (.-projects listed)))])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-fx
::list-symbols!
(fn [_]
(-> (http/GET "/api/symbols")
(.then (fn [^js listed]
(rf/dispatch [::symbols-listed
(mapv (fn [^js r]
{:project (.-project r) :project-name (.-project_name r)
:cid (.-cid r) :symbol (.-symbol r)
:name (.-name r) :frames (.-frames r)})
(array-seq (.-symbols listed)))])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-event-fx
::list-symbols
(fn [{:keys [db]} _]
{:db (assoc-in db [:assets :loading?] true)
::list-symbols! nil}))
(rf/reg-event-db
::symbols-listed
(fn [db [_ rows]] (assoc db :assets {:symbols rows :loading? false})))
(rf/reg-sub ::assets (fn [db _] (:assets db)))
(declare blank-entry)
(rf/reg-fx
::open!
@ -174,15 +311,26 @@
(.then (fn [^js row] (http/GET (str "/api/projects/" (.-id row)))))
(.then (fn [^js loaded]
(let [^js clip-json (first (array-seq (.-clips loaded)))]
(when-not clip-json
(throw (ex-info "that project has no clips" {})))
(-> (opened-entry! clip-json)
(when (not= project/schema-version (.-schema_version loaded))
(throw (ex-info (str "that project is stored as schema "
(.-schema_version loaded) " and this client reads "
project/schema-version)
{})))
;; A project made from the index has nothing in it yet: it
;; opens on a blank document, of which the server has seen
;; nothing, so the first save sends all of it.
(-> (if clip-json
(opened-entry! clip-json)
(js/Promise.resolve (assoc (blank-entry) :synced {})))
(.then (fn [entry]
(rf/dispatch [::opened
(store/install! entry "project")
(.-id loaded)
(.-name loaded)
(.-seq loaded)])))))))
(.-seq loaded)
{:owner (.-owner loaded)
:editors (vec (.-editors loaded))
:can-edit? (.-can_edit loaded)}])))))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
@ -199,9 +347,9 @@
(.then (fn [entry]
(let [built (stage/compose (:clip entry))
entry (assoc entry :clip built :label (:name built)
:cid "stage-8625" :frames (clip/frames built)
:cid "stage-8625"
:width (:width built) :height (:height built))]
(-> (mix/mix! built (:audio entry) (:store entry))
(-> (mix/mix! built (clip/opens-on built) (:audio entry) (:store entry))
(.then (fn [audio]
(rf/dispatch
[::stage-opened
@ -330,6 +478,7 @@
:request request}})))))
(rf/reg-sub ::regeneration (fn [db _] (:regeneration db)))
(rf/reg-sub ::listing (fn [db _] (:projects db)))
(rf/reg-event-fx
::settings-previewed
@ -345,27 +494,157 @@
;; ---------------------------------------------------------------------------
;; events
(def blank-audio
"A new document still needs a clock.
The frame is derived from an audio element and from nothing else — see
`arthur.clock` — so a stage with no sound has no time and `play` is a button
that cannot work. The synthetic take borrows this same asset for exactly this
reason. When a document gets audio of its own, it replaces this."
"/static/arthur/audio.wav")
(defn blank-entry
"A blank clip, in the shape `footage/store` and the transport expect."
[]
(let [c (clip/blank)]
{:label "untitled" :clip c :store nil
:audio blank-audio
;; A content id of its own from the start: `::save!` addresses the clip by
;; it, and two untitled documents saved from two tabs are two documents.
:cid (str (random-uuid))
:display-fps (:fps c)
:fps (:fps c) :width (:width c) :height (:height c)}))
(rf/reg-event-fx
::new
(fn [{:keys [db]} _]
;; A document with no id on the server, so the next `save` creates one. This
;; is also what the app opens on: nothing is loaded until something is asked
;; for, and the built-in scenes are rows in the media pool like anything else.
(let [entry (blank-entry)
id (store/install! entry "new")]
{:db (-> (assoc db :ui (:ui db/default))
(pb/show id)
(assoc :project {:id nil :cid (:cid entry) :name nil :seq nil
:busy? false :status "new document"}))
;; The readout goes home with the document; so must the clock, or play
;; picks up wherever the last document's audio had got to.
::pb/seek! [(:fps entry) (clip/frames (:clip entry) (clip/opens-on (:clip entry))) 0]
::pb/pause! nil})))
(rf/reg-event-fx
::save
(fn [{:keys [db]} _]
;; `auto?` is the save an edit schedules (see `arthur.events.collab`): it does
;; not lock the controls the way a save you asked for does, and it never saves
;; somebody else's project as a copy. Either kind waits its turn behind one in
;; flight, and writes nothing when nothing changed. `force?` saves what is not a leaf —
;; the name.
(fn [{:keys [db]} [_ {:keys [auto? force?] :as how}]]
(let [id (:clip/current db)
clip (store/entry id)]
(if (or (:busy? (:project db)) (nil? clip))
clip (store/entry id)
{pid :id :keys [busy? saving? can-edit?]} (:project db)
cid (or (:cid clip) (name id))]
(cond
(nil? clip)
{}
{:db (update db :project merge {:busy? true :status "saving…"})
::save! {:id (:id (:project db))
:cid (or (:cid clip) (name id))
:label (or (:label clip) (name id))
;; Behind the one in flight, never instead of it: an edit made while a
;; save is on the wire is not in that save. One request at a time, and
;; the next carries everything that changed meanwhile — so a drag goes
;; out as fast as the round trip allows, and no faster.
(or busy? saving?)
{:db (assoc-in db [:project :again] (or how {}))}
(and auto? (false? can-edit?))
{}
(and pid (:synced clip) (not force?) (empty? (:behind clip))
(= (:synced clip) (try (leaf/leaves cid (:clip clip)) (catch :default _ nil))))
{}
;; Somebody else wrote leaves we had changed too, first. The first
;; write wins: theirs goes on screen over ours, which stays in our undo
;; list. See `arthur.events.collab/landed`.
(seq (:behind clip))
{:dispatch [:arthur.events.collab/remote
{:seq (get-in db [:project :seq]) :take? true
:written (into {} (remove (comp nil? val)) (:behind clip))
:removed (keep (fn [[p v]] (when (nil? v) p)) (:behind clip))}]}
:else
;; Somebody else's project, which we may look at and not write, saves as
;; a copy of our own.
{:db (update db :project merge {(if auto? :saving? :busy?) true :status "saving…"})
::save! {:id (when-not (false? can-edit?) pid)
:base (get-in db [:project :seq])
:cid cid
:label (or (not-empty (get-in db [:project :name]))
(:label clip) (name id))
:clip clip}}))))
(rf/reg-event-fx
::open
::rename
(fn [{:keys [db]} [_ value]]
{:db (assoc-in db [:project :name] (not-empty (str/trim value)))
:dispatch [::save {:auto? true :force? true}]}))
(rf/reg-event-fx
::project-setting
(fn [{:keys [db]} [_ key value]]
(if (or (not (#{:fps :width :height} key))
(not (and (integer? value) (pos? value))))
{}
(let [db' (-> (edit/edit db #(assoc % key value))
(assoc-in [:clip key] value)
(cond-> (= key :fps) (assoc-in [:clip :display-fps] value)))
frame (get-in db [:playback :frame])]
(cond-> {:db db'}
(= key :fps) (assoc ::pb/seek! [value (pb/frames db') frame]))))))
(rf/reg-event-db
::symbol-setting
(fn [db [_ sid key value]]
(if-not (and (#{:frames :width :height} key)
(or (nil? value) (and (integer? value) (pos? value))))
db
(edit/edit db
(fn [c]
(if (nil? value)
(update-in c [:symbols sid] dissoc key)
(assoc-in c [:symbols sid key] value)))))))
(rf/reg-event-db
::set-channel
;; `frame` is the node's own, as for a drawing key.
(fn [db [_ sid id path frame value]]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/set-channel path frame value))))
(rf/reg-event-db
::toggle-key
(fn [db [_ sid id path frame]]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame))))
(rf/reg-event-fx
::list
(fn [{:keys [db]} _]
{:db (assoc-in db [:projects :loading?] true)
::list! nil}))
(rf/reg-event-db
::listed
(fn [db [_ rows]] (assoc db :projects {:items rows :loading? false})))
(rf/reg-event-fx
::open
(fn [{:keys [db]} [_ id]]
;; `id` names which project. Without one it is the open document's own id, and
;; without that the most recently updated — which is what "open" meant when
;; there was no list to pick from.
(if (:busy? (:project db))
{}
{:db (update db :project merge {:busy? true :status "opening…"})
::pb/pause! nil
::open! (:id (:project db))})))
::open! (or id (:id (:project db)))})))
(rf/reg-event-fx
::load-stage
@ -379,41 +658,67 @@
(rf/reg-event-fx
::stage-opened
(fn [{:keys [db]} [_ clip-id]]
(let [entry (store/entry clip-id)]
{:db (-> db
(assoc :clip/current clip-id
:clip (select-keys entry [:fps :frames :width :height :audio :display-fps]))
(assoc :project {:id nil :cid nil :name nil :seq nil
:busy? false :status "loaded 8625 stage study"})
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pb/seek! [(:fps entry) (:frames entry) 0]})))
(let [db (-> (pb/show db clip-id)
(assoc :project {:id nil :cid nil :name nil :seq nil
:busy? false :status "loaded 8625 stage study"}))]
{:db db
::pb/seek! [(get-in db [:clip :fps]) (pb/frames db) 0]})))
(rf/reg-event-db
(rf/reg-event-fx
::saved
(fn [db [_ id cid label seq written uploaded]]
(update db :project merge
{:id id :cid cid :name label :seq seq :busy? false
:status (str "saved r" seq " · " written
(if (= 1 written) " leaf" " leaves")
" · " uploaded (if (= 1 uploaded) " block" " blocks"))})))
(fn [{:keys [db]} [_ id cid label seq written uploaded {:keys [synced base]}]]
(let [fresh? (not= id (get-in db [:project :id]))]
{:db (-> db
(update :clip/current #(or (store/edit-entry! % (fn [e] (-> (assoc e :synced synced)
(dissoc :behind))))
%))
(update :project dissoc :again)
(update :project merge
{:id id :cid cid :name label :seq seq :busy? false :saving? false
:status (str "saved r" seq " · " written
(if (= 1 written) " leaf" " leaves")
" · " uploaded (if (= 1 uploaded) " block" " blocks"))}
(when fresh?
{:owner (get-in db [:me :username]) :editors [] :can-edit? true})))
:fx [;; The all-assets folder lists saved symbols, so a save can add rows to it.
[:dispatch [::list-symbols]]
;; Somebody wrote between what we last saw and this save. Their
;; deltas may still be on the wire, and a seq we have jumped past
;; would drop them, so ask for the document instead.
(when (and base (not= seq (inc base)))
[:dispatch [:arthur.events.collab/catch-up]])
(when-let [how (get-in db [:project :again])]
[:dispatch [::save how]])]})))
(rf/reg-event-fx
::conflicted
;; Nothing was written: somebody else's write to the same leaves got there
;; first. Catching up TAKES theirs, over ours — then the rest of ours saves.
(fn [{:keys [db]} [_ n]]
{:db (-> db
(update :project dissoc :again)
(update :project merge {:busy? false :saving? false}))
:fx [[:dispatch [:arthur.events.collab/catch-up true]]
[:dispatch [::save {:auto? true}]]]}))
(rf/reg-event-fx
::opened
(fn [{:keys [db]} [_ clip-id project-id name seq]]
(let [clip (store/entry clip-id)]
{:db (-> db
(assoc :clip/current clip-id
:clip (select-keys clip [:fps :frames :width :height :audio :display-fps]))
(update :project merge
{:id project-id :name name :seq seq :cid (:cid clip)
:busy? false
:status (str "opened " name " r" seq)})
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pb/pause! nil})))
(fn [{:keys [db]} [_ clip-id project-id name seq access]]
{:db (-> (pb/show db clip-id)
(update :project merge access
{:id project-id :name name :seq seq
:cid (:cid (store/entry clip-id))
:busy? false
:status (str "opened " name " r" seq)}))
::pb/pause! nil
::pb/seek! (let [{c :clip fps :fps} (store/entry clip-id)]
[fps (clip/frames c (clip/opens-on c)) 0])}))
(rf/reg-event-db
(rf/reg-event-fx
::failed
(fn [db [_ message]]
(update db :project merge {:busy? false :status (str "failed: " message)})))
(fn [{:keys [db]} [_ message]]
(cond-> {:db (-> db
(update :project dissoc :again)
(update :project merge {:busy? false :saving? false
:status (str "failed: " message)}))}
(get-in db [:project :again]) (assoc :dispatch [::save (get-in db [:project :again])]))))

View file

@ -0,0 +1,257 @@
(ns arthur.events.ui
"Selection, the active tone, the polygon being drawn, and which timeline rows
are open.
All of it is `assoc-in` under `:ui`. There is no effect in this namespace and
there should not be one: an editor's own state is the cheapest thing in the
app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.events.edit :as edit]
[arthur.events.paint :as paint]
[arthur.footage.store :as store]
[re-frame.core :as rf]))
(rf/reg-event-db
::select
(fn [db [_ selection]] (assoc-in db [:ui :selection] selection)))
(rf/reg-event-db
::set-tone
(fn [db [_ tone]] (assoc-in db [:ui :tone] tone)))
(rf/reg-event-db
::toggle-row
(fn [db [_ path]]
(update-in db [:ui :expanded] #(if (contains? % path) (disj % path) (conj % path)))))
(rf/reg-event-db
::solo
(fn [db [_ path more?]]
;; Per open symbol, because a row path only means something from the symbol
;; it was walked from. A click solos that row alone, or un-solos it if it
;; already was; a shift-click adds it to or takes it out of the ones soloed.
(update-in db [:ui :solo (get-in db [:ui :open])]
(fn [on]
(cond more? (if (contains? on path) (disj on path) (conj (set on) path))
(= on #{path}) #{}
:else #{path})))))
(defn- where-new-goes
"The row path, from the open symbol down, of the symbol a new thing goes into:
INSIDE the selected instance, or BESIDE any other selected node, or at the top
of the open symbol when nothing is selected.
A selection from a timeline row carries that row's path, because one symbol
placed twice is two rows and only the path says which was clicked. One made on
the stage does not, and names a node directly in the open symbol."
[clip db]
(let [[kind sid id path] (get-in db [:ui :selection])
path (when (= :node kind) (or path [id]))]
(cond
(nil? path) []
(= :instance (get-in clip [:symbols sid :nodes id :kind])) path
:else (pop path))))
;; ---------------------------------------------------------------------------
;; drawing a polygon
;;
;; Three events and a vector of numbers. The draft is in app-db rather than in a
;; ratom because the stage draws it, the palette colours it and the params pane
;; reports its vertex count — 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.
(rf/reg-event-db
::begin-polygon
;; The selection is KEPT: a selected instance is where the new shape will go.
(fn [db _] (update db :ui merge {:tool :polygon :draft []})))
(rf/reg-event-db
::cancel-polygon
(fn [db _] (update db :ui merge {:tool nil :draft []})))
(rf/reg-event-db
::add-draft-point
(fn [db [_ x y]]
(if (= :polygon (get-in db [:ui :tool]))
(update-in db [:ui :draft] into [x y])
db)))
(rf/reg-event-fx
::finish-polygon
(fn [{:keys [db]} _]
(let [draft (get-in db [:ui :draft])
open (get-in db [:ui :open])
{clip :clip st :store} (store/entry (:clip/current db))
down (where-new-goes clip db)
;; Drawn on the stage, stored where it goes: inside the selected
;; instance, re-expressed in that symbol's coordinates and frame so it
;; lands exactly where it was drawn.
{:keys [sid frame pts]} (nest/drawn-inside clip st open down
(get-in db [:playback :frame]) draft)]
(cond
(< (count draft) 6) {}
(nil? sid) {:db (update db :project merge
{:status "the selected instance is not on screen at this frame"})}
;; `random-uuid` is the one impurity in this namespace, and it is here
;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
;; 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
;; log ever has to reproduce a document exactly, this becomes a cofx.
:else
(let [id (keyword (str "paint-" (random-uuid)))]
{:db (-> db
(update :ui merge {:tool nil :draft []
:selection [:node sid id (conj down id)]})
(update-in [:ui :expanded] into (rest (reductions conj [] down))))
:dispatch [::paint/new-shape sid id frame pts (get-in db [:ui :tone])]})))))
(rf/reg-event-db
::set-knob
(fn [db [_ scope id knob value]]
(assoc-in db [:ui :knobs [scope id knob]] value)))
;; ---------------------------------------------------------------------------
;; a new symbol
(rf/reg-event-db
::new-symbol
(fn [db _]
(let [{clip :clip st :store} (store/entry (:clip/current db))
down (where-new-goes clip db)
{host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down
(get-in db [:playback :frame]))
sid (clip/fresh-id clip)
uuid (random-uuid)]
(if-not host
(update db :project merge
{:status "the selected instance is not on screen at this frame"})
(-> db
(edit/edit #(clip/new-symbol % host sid frame uuid))
(assoc-in [:ui :selection] [:node host uuid (conj down uuid)])
;; Open every row down to it, or the new row is inside a closed one
;; and the button looks like it did nothing.
(update-in [:ui :expanded] into (rest (reductions conj [] down))))))))
;; ---------------------------------------------------------------------------
;; a drop in flight
;;
;; `[:ui :drop]` is where a drag out of the pool would land: `:where` is :stage or
;; :timeline, `:frame` the frame of the open symbol it would start on, and
;; `:point` the stage pixel under the pointer when that is the stage. `:label`
;; and `:frames` ride along so the timeline can draw the preview row without
;; reaching into the drag. Only written when it CHANGES — dragover fires every few
;; milliseconds whether the pointer moved or not.
(rf/reg-event-db
::drop-hover
(fn [db [_ hover]]
(if (= hover (get-in db [:ui :drop])) db (assoc-in db [:ui :drop] hover))))
(rf/reg-event-db
::drop-clear
(fn [db _] (update db :ui dissoc :drop)))
(rf/reg-event-db
::drop-symbol
;; `point` is the stage pixel it was dropped on, or nil from the timeline.
(fn [db [_ sid frame point]]
(let [uuid (random-uuid)
host (get-in db [:ui :open])]
(-> db
(update :ui dissoc :drop)
(edit/edit-entry #(update % :clip clip/place-symbol (:store %)
host sid frame uuid point))
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
;; ---------------------------------------------------------------------------
;; moving rows between symbols
;;
;; Both are `nest/move-node` and `nest/group`, which keep the picture and the
;; timing as they are; what these add is where the selection goes and the reason
;; when a move is refused, which is the only feedback a refused drop has.
(defn- refused [db why]
(update db :project merge {:status (str "can't: " why)}))
(rf/reg-event-db
::move-node
(fn [db [_ from to]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
r (nest/move-node clip st (get-in db [:ui :open]) from to
(get-in db [:playback :frame]))]
(if-let [why (:refused r)]
(refused db why)
(-> db
(edit/edit (constantly (:clip r)))
(assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj to (:id r))])
(update-in [:ui :expanded] into (rest (reductions conj [] to))))))))
(rf/reg-event-db
::sliding
;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the
;; drag is abandoned.
(fn [db [_ path df]]
(if path
(assoc-in db [:ui :sliding] {:path path :df df})
(update db :ui dissoc :sliding))))
(rf/reg-event-db
::slide
(fn [db [_ path df]]
(let [db (update db :ui dissoc :sliding)
r (nest/slide (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]) path df)]
(cond
(zero? df) db
(:refused r) (refused db (:refused r))
:else (edit/edit db (constantly (:clip r)))))))
(rf/reg-event-db
::delete-selected
(fn [db _]
(let [[kind sid id] (get-in db [:ui :selection])]
(if (= :node kind)
(-> db
(edit/edit #(nest/delete-node % sid id))
(assoc-in [:ui :selection] nil))
db))))
(rf/reg-event-db
::restack
;; Onto the edge of a row in another symbol, it goes into that symbol first:
;; one gesture, as in a layers panel, for where it lives and where in the stack.
(fn [db [_ from to front?]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
f (get-in db [:playback :frame])
host (pop to)
moved (if (= host (pop from))
{:clip clip :id (peek from)}
(nest/move-node clip st open from host f))
r (if (:refused moved)
moved
(nest/restack (:clip moved) open (conj host (:id moved)) to front?))]
(if-let [why (:refused r)]
(refused db why)
(-> db
(edit/edit (constantly (:clip r)))
(assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj host (:id r))])
(update-in [:ui :expanded] into (rest (reductions conj [] host))))))))
(rf/reg-event-db
::group
(fn [db [_ froms]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
f (get-in db [:playback :frame])
host (pop (first froms))
uuid (random-uuid)
r (nest/group clip st open froms (clip/fresh-id clip) uuid f)]
(if-let [why (:refused r)]
(refused db why)
(-> db
(edit/edit (constantly (:clip r)))
(assoc-in [:ui :selection] [:node (:sid (nest/inside clip st open host f))
uuid (conj host uuid)])
(update-in [:ui :expanded] conj (conj host uuid)))))))

View file

@ -12,7 +12,7 @@
reachable and neither should be the other's special case.
What is genuinely shared is everything above the sink, and it is most of the
work: rooting the resolver at the chosen timeline, generated-channel picture
work: rooting the resolver at the chosen symbol, generated-channel picture
sampling,
the raster, the frame loop, the audio mix, the progress reporting and the
yielding that lets the page paint. So `run!` owns all of that and calls three
@ -20,7 +20,7 @@
TWO RULES THE WALK ENFORCES, both about sync:
Every frame of the timeline's frame space is emitted, at the CLIP's rate. A
Every frame of the symbol's frame space is emitted, at the CLIP's rate. A
lower picture rate holds a pose across several frames — it never drops them —
so the exported duration matches the audio no matter what the picture rate is.
Decimating instead is how an export silently runs short and the sound slides
@ -37,14 +37,14 @@
[arthur.domain.raster :as raster]))
(defprotocol Exporter
"A sink for a rendered timeline. Implementations live under `arthur.export.*`.
"A sink for a rendered symbol. Implementations live under `arthur.export.*`.
Called in this order, once, per export: `begin!`, then `frame!` for every frame
in order from 0, then `finish!`. Any of them may return a promise and the walk
waits for it, which is what keeps a slow encoder from being fed faster than it
drains and what gives the page a chance to paint between frames.
`Exporter` rather than `IExporter`, which is what `domain/timeline`'s
`Exporter` rather than `IExporter`, which is what `domain/symbol`'s
`IResolver` would suggest, because it names a role a thing plays rather than a
capability a value has."
@ -60,7 +60,7 @@
:fps frames per second of the finished file — the CLIP's rate
:frames how many frames will arrive
:ramp index -> [r g b], the palette to expand through
:audio an AudioBuffer, or nil when the timeline has no sound
:audio an AudioBuffer, or nil when the symbol has no sound
The ramp and the audio are here rather than on `frame!` because neither
changes across an export, and a muxer has to declare its tracks before it
@ -71,7 +71,7 @@
THE RASTER IS REUSED and must be consumed before this returns (or before the
promise it returns settles). The walk hands back the same buffer every frame,
for the same reason `timeline/resolver` reuses its point buffers: a 900-frame
for the same reason `symbol/resolver` reuses its point buffers: a 900-frame
export that allocates a stage per frame is a tab that swaps. A sink that wants
to keep pixels has to copy or encode them here.")
@ -92,7 +92,7 @@
not the thing that was asked for.
Siblings go. That is the whole point: what comes out is one placement, where it
sits, on the timeline it sits on."
sits, in the symbol it sits in."
[nodes id]
(let [up (loop [i id acc #{}]
(if (or (nil? i) (contains? acc i))
@ -114,7 +114,7 @@
k))))
(defn isolate
"The timeline with only `id` and its kin kept. `nil` leaves it alone.
"The symbol with only `id` and its kin kept. `nil` leaves it alone.
The FRAME SPACE IS UNTOUCHED, which is what makes this different from exporting
the symbol a placement plays. Rooting at `:sym/face-8625` renders the drawing in
@ -122,10 +122,10 @@
renders the STAGE — its length, its rate, the placement's span, drift and scale
— with the other six removed. The first is the drawing; the second is that face
on the stage, and they are different deliverables."
[tl id]
(if (and id (get-in tl [:nodes id]))
(update tl :nodes select-keys (kin (:nodes tl) id))
tl))
[sym id]
(if (and id (get-in sym [:nodes id]))
(update sym :nodes select-keys (kin (:nodes sym) id))
sym))
(defn- yield!
"Hand the event loop a turn between frames.
@ -140,68 +140,70 @@
(defn audio!
"Promise of the AudioBuffer to export alongside the picture, or nil.
A timeline's own placed audio tracks win. Failing that, the ROOT timeline — and
only the root — falls back to the clip's audio file, which is where a take's
sound lives before anyone has placed a track. A symbol exports silence rather
than the whole clip's soundtrack, because a symbol's frame space is its own and
the clip's audio is not a fact about it."
[clip-doc tid store fallback-url]
(-> (mix/buffer! clip-doc tid store)
A symbol's own placed audio tracks win. Failing that, the symbol the document
OPENS ON — and only that one — falls back to the clip's audio file, which is
where a take's sound lives before anyone has placed a track. Any other symbol
exports silence rather than the whole clip's soundtrack, because its frame
space is its own and the clip's audio is not a fact about it."
[clip-doc sid store fallback-url]
(-> (mix/buffer! clip-doc sid store)
(.then (fn [buffer]
(cond
buffer buffer
(and (= tid clip/root-id) fallback-url) (mix/decode! fallback-url)
(and (= sid (clip/opens-on clip-doc)) fallback-url) (mix/decode! fallback-url)
:else nil)))))
(defn plan
"What an export of `tid` will produce, without producing any of it.
"What an export of `sid` will produce, without producing any of it.
Separate from `run!` so the UI can show the size and length it is about to
commit to, and so the arithmetic is assertable without a sink."
[{:keys [clip timeline zoom picture-fps] isolate-id :isolate}]
(let [tl (some-> (clip/timeline clip timeline) (isolate isolate-id))
[{:keys [clip zoom picture-fps] sid :symbol isolate-id :isolate}]
(let [sym (some-> (clip/symbol clip sid) (isolate isolate-id))
[width height] (clip/stage clip sid)
zoom (max 1 (js/Math.floor (or zoom 1)))]
(when tl
{:frames (:frames tl)
(when sym
{:frames (:frames sym)
:fps (:fps clip)
:zoom zoom
:width (* (:width clip) zoom)
:height (* (:height clip) zoom)
:seconds (/ (:frames tl) (:fps clip))
:width (* width zoom)
:height (* height zoom)
:seconds (/ (:frames sym) (:fps clip))
;; The unedited picture-grid count. A per-instance pose track can add or
;; remove changes, so this is only the grid's nominal count.
:poses (if (and picture-fps (< picture-fps (:fps clip)))
(js/Math.ceil (* (/ (:frames tl) (:fps clip)) picture-fps))
(:frames tl))})))
(js/Math.ceil (* (/ (:frames sym) (:fps clip)) picture-fps))
(:frames sym))})))
(defn run!
"Render `timeline` into `exporter`. Promise of `{:filename :blob}`.
"Render symbol `sid` into `exporter`. Promise of `{:filename :blob}`.
`on-progress` is called with `[done total]` as frames complete, and is where a
UI hangs its readout."
[{:keys [clip timeline store palette ramp zoom picture-fps name audio-url]
isolate-id :isolate}
[{:keys [clip store palette ramp zoom picture-fps name audio-url]
sid :symbol isolate-id :isolate}
exporter on-progress]
(let [tl (some-> (clip/timeline clip timeline) (isolate isolate-id))]
(when-not tl
(throw (ex-info "there is no such timeline to export"
{:timeline timeline
:timelines (vec (sort-by str (keys (:timelines clip))))})))
(let [{:keys [frames fps zoom]} (plan {:clip clip :timeline timeline :zoom zoom
(let [sym (some-> (clip/symbol clip sid) (isolate isolate-id))]
(when-not sym
(throw (ex-info "there is no such symbol to export"
{:symbol sid
:symbols (vec (sort-by str (keys (:symbols clip))))})))
(let [{:keys [frames fps zoom]} (plan {:clip clip :symbol sid :zoom zoom
:isolate isolate-id})
;; Rooted at the chosen timeline, so exporting a symbol is exporting a
;; clip whose root that symbol is. Nested symbols inside it still
;; resolve — clip/resolver is the function that knows how.
doc (assoc-in clip [:timelines timeline] tl)
resolve-frame (clip/resolver doc store palette timeline
[width height] (clip/stage clip sid)
;; Rooted at the chosen symbol, as the stage is. Nested instances
;; inside it still resolve — clip/resolver is the function that knows
;; how.
doc (assoc-in clip [:symbols sid] sym)
resolve-frame (clip/resolver doc store palette sid
{:picture-fps picture-fps})
ras (raster/make (:width clip) (:height clip))
ras (raster/make width height)
bg (get palette :bg 0)]
(-> (audio! doc timeline store audio-url)
(-> (audio! doc sid store audio-url)
(.then (fn [audio]
(js/Promise.resolve
(begin! exporter {:name name :width (:width clip)
:height (:height clip) :zoom zoom
(begin! exporter {:name name :width width
:height height :zoom zoom
:fps fps :frames frames :ramp ramp
:audio audio}))))
(.then (fn [_]

View file

@ -67,8 +67,15 @@
over the same frames and the same model they disagree by up to 0.013 of frame
width, which is a visible difference on a mouth. Optional, because the synthetic
take has no running mode to declare and an absent field is how the other
optional inputs already say \"not applicable\"."
[{:keys [detector version source footage frames fps aspect seed mode tracking]}]
optional inputs already say \"not applicable\".
`:range` is `[first end)` source frames when only part of the footage was
analysed, and absent for all of it — so every analysis made before ranges
existed keeps its address. It is in here because a partial analysis is a
different artifact: without it, detecting frames 40–90 would be saved under the
same key as the whole take, and the next conversion of the whole take would be
handed fifty frames."
[{:keys [detector version source footage frames fps aspect seed mode tracking range]}]
(when-not (and (string? detector) (seq detector) (string? version) (seq version))
(throw (ex-info "an analysis names its detector and the detector's VERSION: an upgrade that silently reuses old landmarks is the failure content addressing exists to prevent"
{:detector detector :version version})))
@ -82,7 +89,8 @@
footage (assoc :footage footage)
seed (assoc :seed seed)
mode (assoc :mode mode)
tracking (assoc :tracking tracking))))
tracking (assoc :tracking tracking)
range (assoc :range range))))
(defn analysis
"An analysis record with its `:id` filled in. The record is tier 1 — it says

View file

@ -33,7 +33,6 @@
plate, which a human draws, is worth decimating. Sparse visibility keys capture
decisions about the mouth cavity, blink and teeth without thinning geometry."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.feature :as feature]
[arthur.domain.geom :as geom]
[arthur.domain.ring :as ring]
@ -262,7 +261,7 @@
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,
because an anchor map lives on that subject's own head node and
`domain/timeline` reads anchors off whatever node carries them."
`domain/symbol` reads anchors off whatever node carries them."
[{:keys [subject mode anchors]} {:keys [clip]}]
(when-not (contains? head-modes mode)
(throw (ex-info "head mode must be free or anchored"
@ -274,14 +273,14 @@
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
(reduce
(fn [c sid]
(let [frames (get-in c [:timelines sid :frames])]
(let [frames (get-in c [:symbols sid :frames])]
(when (and (= mode :anchored)
(not (and (map? anchors) (contains? anchors 0)
(every? #(and (integer? %) (<= 0 %) (< % frames))
(concat (keys anchors) (vals anchors))))))
(throw (ex-info "anchored head needs a frame-zero key and valid source frames"
{:subject sid :anchors anchors :frames frames})))
(update-in c [:timelines sid :nodes :head]
(update-in c [:symbols sid :nodes :head]
(fn [n]
(cond-> (assoc n :channels (:measured n))
(= mode :anchored) (assoc :anchors anchors)
@ -654,7 +653,7 @@
;; the clip
(defn- subject-part
"A subject's drawing, metadata and blocks. Node names are timeline-local."
"A subject's drawing, metadata and blocks. Node names are symbol-local."
[params subject {:keys [outer eyes brows teeth] :as inputs}]
(let [own (partial feature/owned subject)
areas (cond-> [:mouth] (and eyes brows) (into [:eye :brow]) teeth (conj :teeth))
@ -666,13 +665,13 @@
:eye-l [:eye [:eye-l :eye-l-in :iris-l :pupil-l]]
:brow-r [:brow [:brow-r]] :brow-l [:brow [:brow-l]]})
teeth (assoc :teeth [:teeth [:teeth]]))]
{:timeline {:id subject :frames (count outer)
{:symbol {:id subject :frames (count outer)
:nodes (into {:head {:id :head :name "head" :kind :group :z "a1"
:measured (:measured head)}}
(mapcat :nodes) parts)}
:features (into {} (map (fn [[role [area nodes]]]
[(own role) {:id (own role) :subject subject
:timeline subject :area area
:symbol subject :area area
:nodes nodes :params {}}])) features)
:groups (if (and eyes brows)
{(own :eyes) {:id (own :eyes) :kind :eye-pair :subject subject
@ -681,12 +680,13 @@
:store (into (:store head) (mapcat :store) parts)}))
(defn clip
"Subject-id -> conditioned measurements becomes a library of face timelines.
"Subject-id -> conditioned measurements becomes one symbol per face, and a
symbol called :main that places them.
:main holds exposure and a shared source-to-stage placement. Each subject is
placed by an ordinary symbol instance, so pose choices and transforms have
their existing instance scope. Features name local nodes in that subject's
timeline; block descriptors still name globally distinct features.
placed by an ordinary instance, so pose choices and transforms have their
existing instance scope. Features name local nodes in that subject's symbol;
block descriptors still name globally distinct features.
Subjects share a source frame space. :head and :anchors may be overridden
per subject; all other freeze settings come from params."
@ -697,7 +697,7 @@
(throw (ex-info "a freeze needs subjects with ids distinct from :main, :root and :face" {})))
(let [ordered (sort-by (comp str key) subjects)
parts (mapv (fn [[id inputs]] [id (subject-part params id inputs)]) ordered)
lengths (distinct (map #(get-in % [1 :timeline :frames]) parts))
lengths (distinct (map #(get-in % [1 :symbol :frames]) parts))
_ (when-not (and (= 1 (count lengths)) (pos? (first lengths)))
(throw (ex-info "subjects need the same positive frame count"
{:frames (vec lengths)})))
@ -707,9 +707,9 @@
:width (first stage) :height (second stage)
:subjects (into {} (map (fn [[id _]] [id {:id id :params {}}])) ordered)
:features (merged :features) :groups (merged :groups)
:timelines
(into {clip/root-id
{:id clip/root-id :frames nf
:symbols
(into {:main
{:id :main :frames nf
:nodes (into {:root {:id :root :name "clip" :kind :group :z "a1"
:time {:mode :map :expose expose}}
:face {:id :face :name "source placement" :kind :group
@ -717,10 +717,10 @@
:channels (face-placement params subjects)}}
(map-indexed
(fn [i [id _]]
[id {:id id :kind :symbol :of id :parent :face
[id {:id id :kind :instance :of id :parent :face
:z (str "a" i)}]))
ordered)}}
(map (fn [[id part]] [id (:timeline part)])) parts)}]
(map (fn [[id part]] [id (:symbol part)])) parts)}]
(doseq [[subject inputs] ordered
[id track] (:presence inputs)]
(when-not (and (= nf (count track))

View file

@ -86,6 +86,20 @@
(-> (http/GET "/api/detector")
(.then (fn [json] (js->clj json :keywordize-keys true)))))
(defn slice
"The manifest of source frames `[start end)` of this footage, as though that
were all of it: its frame count, its tracing stills and its absence tracks cut
to the range, and `:range` saying where it came from — which goes into the
analysis address, see `flow/address`. The whole footage is returned unchanged,
so a full-length conversion reuses analyses made before ranges existed."
[m start end]
(if (= [start end] [0 (:frames m)])
m
(-> m
(assoc :frames (- end start) :range [start end])
(update :urls #(some-> % vec (subvec start end)))
(update :presence #(into {} (map (fn [[id track]] [id (subvec (vec track) start end)])) %)))))
(defn audio-url [manifest]
(:audio manifest))

View file

@ -39,7 +39,7 @@
:when (:generated channel)]
[id prop channel])]
(-> (reduce (fn [entry [id prop channel]]
(let [at [:clip :timelines (get-in entry [:clip :features fid :timeline])
(let [at [:clip :symbols (get-in entry [:clip :features fid :symbol])
:nodes id :channels prop]
old (get-in entry at)]
(assoc-in entry at
@ -103,7 +103,7 @@
by hand."
[entry params base subject]
(let [baked (freeze/head-part subject params @base)
at [:clip :timelines subject :nodes :head]
at [:clip :symbols subject :nodes :head]
old (get-in entry at)
measured (:measured baked)]
(cond-> (-> entry

View file

@ -19,16 +19,17 @@
(defn analysis-for [manifest detector]
(let [aspect (/ (:width manifest) (:height manifest))]
(address/analysis
(merge {:detector "mediapipe" :version "unknown"}
detector
{:source (:source manifest)
:footage (:footage manifest)
:frames (:frames manifest)
:fps (:fps manifest)
:aspect aspect
;; How the detector was run, not just which one it was. See
;; `flow/address/analysis-descriptor`.
:mode "video" :tracking detect/settings}))))
(cond-> (merge {:detector "mediapipe" :version "unknown"}
detector
{:source (:source manifest)
:footage (:footage manifest)
:frames (:frames manifest)
:fps (:fps manifest)
:aspect aspect
;; How the detector was run, not just which one it was. See
;; `flow/address/analysis-descriptor`.
:mode "video" :tracking detect/settings})
(:range manifest) (assoc :range (:range manifest))))))
(defn measure
"Condition the anchor before measuring rings through it."

View file

@ -32,12 +32,17 @@
@loaded
(db/clip-entry id)))
(defn edit-clip!
"Edit the loaded document. Built-in clips are copied into the runtime store
on first edit, so their delayed source values remain reusable."
(defn edit-entry!
"Edit the loaded entry — the document and what travels with it: its blocks,
its footage, its retained source tracks. Built-in clips are copied into the
runtime store on first edit, so their delayed source values remain reusable."
[id f]
(if (= id (:id @loaded))
(do (swap! loaded update :clip f) id)
(let [entry (entry id)]
(when entry
(install! (update entry :clip f) "paint")))))
(do (swap! loaded f) id)
(when-let [entry (entry id)]
(install! (f entry) "paint"))))
(defn edit-clip!
"Edit the loaded document and nothing beside it."
[id f]
(edit-entry! id #(update % :clip f)))

View file

@ -4,8 +4,8 @@
Everything here returns a promise of a PARSED JS VALUE, not of CLJS data, and
that is deliberate: a leaf is transit, and `domain/project` reads it straight out
of the response object. A keywordising `js->clj` on the way past would turn the
leaf path \"clip/c1/timeline/main/node/mouth\" into a keyword whose name is
\"c1/timeline/main/node/mouth\",
leaf path \"clip/c1/symbol/main/node/mouth\" into a keyword whose name is
\"c1/symbol/main/node/mouth\",
losing the prefix — a corruption that only shows up on the way back in.
CSRF IS NOT EXEMPTED. The page renders `{% csrf_token %}`, so Django sets its

View file

@ -2,7 +2,9 @@
"Layer-2 extractors over the transport. Cheap by construction: each one reads a
path and returns a value, so a tick that changes only `:frame` notifies only
the things that asked for `:frame`."
(:require [re-frame.core :as rf]))
(:require [arthur.domain.clip :as clip]
[arthur.footage.store :as store]
[re-frame.core :as rf]))
(rf/reg-sub ::frame (fn [db _] (get-in db [:playback :frame])))
(rf/reg-sub ::playing? (fn [db _] (get-in db [:playback :playing?])))
@ -11,12 +13,19 @@
(rf/reg-sub ::muted? (fn [db _] (get-in db [:playback :muted?])))
(rf/reg-sub ::fps (fn [db _] (get-in db [:clip :fps])))
(rf/reg-sub ::display-fps (fn [db _] (get-in db [:clip :display-fps])))
(rf/reg-sub ::frames (fn [db _] (get-in db [:clip :frames])))
;; The stage, in pixels. On the clip because project dimensions are independent
;; of the footage — see flow/freeze/face-placement — so the canvas and the raster
;; take their size from the document rather than from a constant.
(rf/reg-sub ::width (fn [db _] (get-in db [:clip :width])))
(rf/reg-sub ::height (fn [db _] (get-in db [:clip :height])))
;; The open symbol can have a local stage size; otherwise it follows the project.
(rf/reg-sub ::stage-size
:<- [:arthur.subs.playback/clip-id]
:<- [:arthur.subs.playback/revision]
:<- [:arthur.subs.playback/open]
(fn [[id _ sid] _]
(when-let [document (:clip (store/entry id))]
(clip/stage document sid))))
(rf/reg-sub ::clip-id (fn [db _] (:clip/current db)))
(rf/reg-sub ::revision (fn [db _] (:paint/revision db)))
(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
(rf/reg-sub ::width :<- [::stage-size] (fn [[w _] _] w))
(rf/reg-sub ::height :<- [::stage-size] (fn [[_ h] _] h))
(rf/reg-sub ::audio (fn [db _] (get-in db [:clip :audio])))
(rf/reg-sub ::footage (fn [db _] (:footage db)))
;; The document's identity on the server. Not derived and not large — an id, a

View file

@ -8,8 +8,8 @@
recomputation here and a frame costs a lookup and a blit — and, crucially, the
playhead is not an input, so moving it cannot invalidate this."
(:require [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]
[arthur.footage.store :as footage]
[arthur.subs.playback :as playback]
[re-frame.core :as rf]))
@ -17,33 +17,55 @@
(rf/reg-sub ::clip-id (fn [db _] (:clip/current db)))
(rf/reg-sub ::paint-revision (fn [db _] (:paint/revision db)))
(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
(rf/reg-sub
::clip
:<- [::clip-id]
:<- [::paint-revision]
(fn [[id _] _] (:clip (footage/entry id))))
:<- [::sliding]
:<- [::open]
(fn [[id _ sliding open] _]
;; With a timeline bar being slid, the document as it will be when the drag
;; lets go, so the stage and the rows follow the pointer. Nothing is written
;; until then: one drag is one undo step and one write to collaborators.
(let [c (:clip (footage/entry id))]
(or (when-let [{:keys [path df]} sliding]
(:clip (nest/slide c open path df)))
c))))
(rf/reg-sub
::timeline
::symbol
:<- [::clip]
(fn [clip _] (some-> clip clip/root)))
:<- [::open]
(fn [[clip sid] _] (some-> clip (clip/symbol sid))))
(rf/reg-sub
::frames
:<- [::symbol]
(fn [sym _]
;; The open symbol's length, read off it rather than copied into the db, so a
;; drop that lengthens it lengthens the transport with it.
(:frames sym)))
(rf/reg-sub
::exposure
:<- [::timeline]
(fn [tl _]
;; Exposure lives on the timeline's root node and is INHERITED, so reading it
:<- [::symbol]
(fn [sym _]
;; Exposure lives on the symbol's root node and is INHERITED, so reading it
;; there is reading it everywhere. The transport shows it so that `exposure 2`
;; is visibly doing something at the transport rather than only inside the
;; document.
(or (get-in tl [:nodes :root :time :expose]) 1)))
(or (get-in sym [:nodes :root :time :expose]) 1)))
(rf/reg-sub
::palette
(fn [db _]
;; A NAME resolves to a ramp. One today; when timelines carry a `:palette`
;; channel this becomes the project's table and the walk carries the ramp in
;; scope, which is why domain/timeline takes the palette as a parameter rather
;; scope, which is why domain/symbol takes the palette as a parameter rather
;; than reaching for a global.
(get {:arthur/default pal/index-of} (:palette db) pal/index-of)))
@ -59,20 +81,53 @@
(rf/reg-sub
::store
:<- [::clip-id]
(fn [id _]
:<- [::paint-revision]
(fn [[id _] _]
;; Tier 2, behind a handle, and never in app-db itself — what is in the db is
;; the id of the clip whose blocks these are. The hand-written demo has none;
;; the swarm is entirely dense.
;; the id of the clip whose blocks these are.
;;
;; ON THE REVISION AS WELL AS THE ID, like `::clip`. An edit can bring blocks
;; in with it — a video made into a symbol does — without the id changing, and
;; a store read only when the id changed is the old one: the document names the
;; new blocks, the resolver cannot find them, and the frame throws.
(:store (footage/entry id))))
(defn- placed?
"Does row `path` from symbol `sid` still name an instance, all the way down?"
[clip sid path]
(reduce (fn [sid id] (or (get-in clip [:symbols sid :nodes id :of]) (reduced nil)))
sid path))
(rf/reg-sub
::resolver
:<- [::clip]
:<- [::timeline]
:<- [::open]
:<- [::store]
:<- [::palette]
:<- [::playback/display-fps]
(fn [[document tl store palette picture-fps] _]
(when tl (clip/resolver (assoc-in document [:timelines :main] tl)
store palette clip/root-id
{:picture-fps picture-fps}))))
(fn [[document sid store palette picture-fps] _]
(when (and document (clip/symbol document sid))
(clip/resolver document store palette sid {:picture-fps picture-fps}))))
(rf/reg-sub
::shown
:<- [::resolver]
:<- [::clip]
:<- [::open]
:<- [::solo]
(fn [[resolve document sid solo] _]
;; What the stage draws: `::resolver`, less whatever is not under a soloed
;; row. Its own layer, so soloing does not rebuild the resolver.
;;
;; A soloed row that has since been deleted or moved would otherwise leave
;; the stage blank, with no row left to un-solo it from.
(let [solo (filter #(placed? document sid %) solo)]
(if (or (nil? resolve) (empty? solo))
resolve
;; An op inside an instance is named by the path its row has; one at the
;; top by its bare id.
(fn [f]
(filterv (fn [{n :node}]
(let [p (if (vector? n) n [n])]
(some #(= % (take (count %) p)) solo)))
(resolve f)))))))

View file

@ -0,0 +1,69 @@
(ns arthur.subs.ui
"Layer-2 extractors over the editor's own state, plus the one layer-3 that
resolves a selection to the thing it names.
Cheap by construction, like `subs/playback`: each reads a path and returns a
value, so clicking a swatch notifies the swatches and nothing else."
(:require [arthur.domain.nest :as nest]
[arthur.footage.store :as store]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[re-frame.core :as rf]))
(rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection])))
(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 ::draft (fn [db _] (get-in db [:ui :draft])))
(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 ::tabs (fn [db _] (get-in db [:ui :tabs])))
(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
::selected-node
:<- [::selection]
:<- [::render/clip]
(fn [[selection clip] _]
;; `[timeline-id node-id node]`, or nil. Returned as a triple rather than as
;; the node alone because every caller that wants the node also wants to know
;; where it lives — an edit names the timeline, and a bare node has forgotten.
(when (and clip (= :node (first selection)))
(let [[_ sid id] selection]
(when-let [n (get-in clip [:symbols sid :nodes id])]
[sid id n])))))
(rf/reg-sub
::selected-local
:<- [::selected-node]
:<- [::selection]
:<- [::render/clip-id]
:<- [::render/open]
:<- [::playback/frame]
(fn [[[_ id n] [_ _ _ path] clip-id open f] _]
;; `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
;; symbol's frames to its own. A selection made on the stage has no path and
;; names a node in the open symbol.
(when n
(let [{clip :clip st :store} (store/entry clip-id)]
(nest/inside clip st open (or path [id]) f)))))
(rf/reg-sub
::project-footage
:<- [::render/clip-id]
:<- [::render/paint-revision]
:<- [::playback/footage]
(fn [[id _ {:keys [available uploaded]}] _]
;; THIS PROJECT's video: what the document was made from, what its sounds
;; play, and what was uploaded while it was open. Read off the document rather
;; than kept beside it, so a sound placed from footage makes that footage the
;; project's without anything else being told.
(let [entry (store/entry id)
used (into (set (keep identity [(:footage-id entry)])) uploaded)
used (into used (for [[_ sym] (get-in entry [:clip :symbols])
[_ n] (:nodes sym)
:let [f (get-in n [:source :footage])]
:when f]
f))]
(filterv #(contains? used (:id %)) available))))

View file

@ -0,0 +1,90 @@
(ns arthur.ui.convert
"The question a dropped video asks: which of its frames become a symbol, and
what is that symbol called.
The video plays in the dialog so the frames can be chosen by looking at them.
The two handles under it are the range, `[start end)` in source frames; moving
either seeks the video to the frame it is on, so the edge being chosen is the
picture being shown. Detection then runs on those frames only — see
`events/footage/analyse!` — and the result lands where the video was dropped."
(:require [arthur.events.footage :as footage]
[arthur.subs.playback :as playback]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- frame-at [^js track x frames]
(let [box (.getBoundingClientRect track)]
(-> (/ (* (- x (.-left box)) frames) (.-width box))
js/Math.round (max 0) (min frames))))
(defn- range-bar
"Two handles over the footage's length. `player` holds the element to seek."
[{:keys [frames fps range]} player]
(r/with-let [held (atom nil)
track (atom nil)]
(let [[start end] range
pct #(str (* 100 (/ % (max 1 frames))) "%")
move! (fn [^js e]
(when-let [which @held]
(let [f (frame-at @track (.-clientX e) frames)
[s' e'] (if (= :start which)
[(min f (dec end)) end]
[start (max f (inc start))])]
(rf/dispatch [::footage/convert-set :range [s' e']])
(when-let [^js v @player]
(set! (.-currentTime v)
(/ (if (= :start which) s' (dec e')) fps))))))
grab (fn [which]
(fn [^js e]
(.preventDefault e)
(reset! held which)
(try (.setPointerCapture (.-currentTarget e) (.-pointerId e))
(catch :default _ nil))))]
[:div.convert-range {:ref #(reset! track %)}
[:div.convert-kept {:style {:left (pct start) :width (pct (- end start))}}]
(doall
(for [[which f] [[:start start] [:end end]]]
^{:key which}
[:div {:class (str "convert-handle " (name which))
:style {:left (pct f)}
:title (str (name which) " · frame " f)
:on-pointer-down (grab which)
:on-pointer-move move!
:on-pointer-up #(reset! held nil)
:on-pointer-cancel #(reset! held nil)}]))])))
(defn view []
(r/with-let [player (atom nil)]
(when-let [{:keys [label frames fps video range name] :as request}
@(rf/subscribe [::sub/convert])]
(let [{:keys [loading? status]} @(rf/subscribe [::playback/footage])
[start end] range
n (- end start)]
[:div.convert-scrim
[:div.convert
[:div.pane-head (str "make a symbol from " label)]
[:div.convert-body
[:video.convert-video
{:ref #(reset! player %)
:src video :controls true :muted false :preload "auto"
:plays-inline true}]
[range-bar request player]
[:div.row.dim
(str "frames " start " … " end " · " n " frames · "
(.toFixed (/ n fps) 1) "s of " frames)]
[:label.convert-name
[:span.dim "name"]
[:input {:type "text" :value name :disabled loading?
:auto-focus true
:on-change #(rf/dispatch [::footage/convert-set :name
(.. % -target -value)])
:on-key-down #(when (= "Enter" (.-key %))
(rf/dispatch [::footage/convert]))}]]
(when loading? [:div.dim status])]
[:div.convert-actions
[:button {:disabled loading?
:on-click #(rf/dispatch [::footage/convert-cancel])} "cancel"]
[:button.on {:disabled (or loading? (< n 1) (empty? name))
:on-click #(rf/dispatch [::footage/convert])}
(if loading? "working…" "make symbol")]]]]))))

View file

@ -0,0 +1,106 @@
(ns arthur.ui.drag
"What a drag out of the pool is carrying while it is in flight, and what it
would look like where it lands.
A PAGE-LOCAL ATOM, not `dataTransfer`. A browser lets a drop target read the
payload on `drop` and hides it on every `dragover` before that, which is exactly
when a preview needs it — so the pool writes the payload here on `dragstart`,
and the `text/plain` it also sets is only what makes the drag a drag. A plain
atom rather than app-db because it lives for one gesture and nothing renders
from it; what the preview DOES render from — the frame and point under the
pointer — is `[:ui :drop]`, set by `::ui/drop-hover`."
(:require [arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
[arthur.events.footage :as footage]
[arthur.events.project :as project]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[re-frame.core :as rf]))
(defonce carrying (atom nil))
(defn- outline
"Frame 0 of symbol `sid` as plain shapes in its own space, for the stage's
preview. Frame 0 because an instance dropped at the playhead starts there."
[document st sid]
(vec (keep (fn [op]
(case (:kind op)
:poly {:kind :poly :pts (vec (take (* 2 (:n op)) (array-seq (:pts op))))}
:disc (select-keys op [:kind :cx :cy :r])
:rect (select-keys op [:kind :cx :cy :size])
nil))
((clip/resolver document st pal/index-of sid) 0))))
(defn symbol!
"Start carrying symbol `sid` of the loaded document into the open symbol."
[clip-id sid open]
(let [{document :clip st :store} (store/entry clip-id)]
(reset! carrying (merge {:kind :symbol :sid sid
:label (clip/symbol-name document sid)
:frames (clip/frames document sid)
;; A symbol cannot go inside itself or inside
;; anything it places. Refused by not ACCEPTING the
;; drop, so the pointer says so while it hovers.
:refused? (clip/contains-symbol? document sid open)
;; The same middle `clip/place-symbol` will anchor
;; on, so the preview is where the drop lands.
:center (clip/center document st sid)
:shapes (outline document st sid)}))))
(defn accepts?
"Whether the stage or the tracks should accept what is being carried: things
out of the pool, and not one that would make a cycle."
[]
(let [c @carrying]
(and c (#{:symbol :footage :import} (:kind c)) (not (:refused? c)))))
(defn row!
"Start carrying the timeline row at `path` — a node, to be moved into another
symbol or grouped with another node."
[path]
(reset! carrying {:kind :row :path path}))
(defn row
"The path of the row being carried, or nil when it is not a row."
[]
(let [c @carrying] (when (= :row (:kind c)) (:path c))))
(defn other!
"Start carrying something that is not yet in the document: `:kind` says what,
and the rest is what a preview can show of it before it is fetched."
[payload]
(reset! carrying payload))
(defn done!
"The gesture is over, dropped or abandoned."
[]
(reset! carrying nil)
(rf/dispatch [::ui/drop-clear]))
(defn hover!
"Say where the drag would land, for the previews. `point` is nil over the
timeline."
[where frame point]
(when-let [{:keys [label frames]} @carrying]
(rf/dispatch [::ui/drop-hover {:where where :frame frame :point point
:label label :frames frames}])))
(defn pos-for
"Where the preview goes so the symbol's middle is under `point` — what
`clip/place-symbol` will do on the drop."
[point]
(mapv - point (or (:center @carrying) [0 0])))
(defn land!
"Drop what is being carried at `frame` of the open symbol: with its middle on
stage pixel `point`, or, with no point — the timeline — where it was drawn."
[frame point]
(when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)]
(case kind
:symbol (rf/dispatch [::ui/drop-symbol sid frame point])
;; Video is asked about before anything happens: which frames, and what
;; the symbol they become is called.
:footage (rf/dispatch [::footage/ask-convert c frame point])
:import (rf/dispatch [::project/import c frame point])
nil))
(done!))

View file

@ -0,0 +1,44 @@
(ns arthur.ui.index
"`/`: the projects you own and edit, and a way to make one. A project is only
ever at its own address, so this is where you are when you are in none.
Over the editor rather than instead of it: the stage, the audio element and
the draw loop stay mounted, and opening a project is showing them again."
(:require [arthur.events.collab :as collab]
[arthur.events.project :as project]
[arthur.ui.share :as share]
[re-frame.core :as rf]))
(defn view []
(when (= :index @(rf/subscribe [::collab/route]))
(let [{:keys [username error]} @(rf/subscribe [::collab/me])
{:keys [items loading?]} @(rf/subscribe [::project/listing])]
[:div.index
[:header.top
[:span.brand "arthur"]
[:span.status]
[share/account]]
[:main.index-body
(if-not username
[:<>
[:h1 "arthur"]
[:p.dim "Sign in, or create an account, to see your projects and make new ones."]]
[:<>
[:div.index-head
[:h1 "projects"]
[:button {:on-click #(rf/dispatch [::collab/create])} "new project"]]
(when error [:p.warn error])
(cond
loading? [:p.dim "…"]
(empty? items) [:p.dim "Nothing yet. A new project starts empty."]
:else
[:ul.index-list
(doall
(for [{:keys [id name owner seq updated]} items
:let [path (collab/project-path id name)]]
^{:key id}
[:li
[:a {:href path :on-click (fn [e] (.preventDefault e) (collab/navigate! path))}
(or name "untitled")]
[:span.dim (str (when (not= owner username) (str owner " · "))
"r" seq " · " (subs (str updated) 0 10))]]))])])]])))

View file

@ -0,0 +1,78 @@
(ns arthur.ui.openmenu
"File → Open. The projects the server holds, and nothing else.
IT IS NOT THE MEDIA POOL. A project is a whole document — opening one replaces
the stage — and the pool is the open document's own library. Listing documents
beside the symbols inside one of them makes them look like two kinds of the
same thing, which is the confusion this split exists to end.
The built-in scenes are under their own heading and are NOT projects: they are
compiled into the bundle, the server has never heard of them, and `demo/scene`
and the swarm exist to exercise and to profile the model rather than to be
worked on. They are here because there is nowhere else for a fixture to live,
and they are labelled so that nothing about them reads as a saved document."
(:require [arthur.db :as db]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.subs.playback :as playback]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- when-said
"The ISO stamp the server sends, as a date. Truncated rather than formatted:
a list of documents wants to be sorted and scanned, not read to the second."
[iso]
(when iso (subs (str iso) 0 10)))
(defn- item
"One row. `example?` is not decoration: the server is full of documents called
\"take\", so \"the row labelled take\" does not identify one thing — the class is
what lets a reader, and `test/browser`, tell a saved project from the fixture
that shares its name."
[{:keys [label sub on-click disabled? example?]}]
[:button {:class (str "menu-item" (when example? " example"))
:on-click on-click :disabled (boolean disabled?) :title label}
label
(when sub [:span.sub sub])])
(defn view []
(r/with-let [open? (r/atom false)]
(let [{:keys [items loading?]} @(rf/subscribe [::project/listing])
busy? (:busy? @(rf/subscribe [::playback/project]))
choose! (fn [event] (reset! open? false) (rf/dispatch event))]
[:div.menu-wrap
[:button {:disabled busy?
:class (when @open? "on")
:on-click (fn []
(when-not @open? (rf/dispatch [::project/list]))
(swap! open? not))}
"open ▾"]
(when @open?
[:<>
;; A full-page catcher behind the panel, so clicking anywhere else
;; dismisses it. Cheaper and more predictable than a document-level
;; listener that has to be added, removed and told to ignore the click
;; that opened the menu.
[:div.menu-scrim {:on-click #(reset! open? false)}]
[:div.menu
[:h2 "projects"]
(cond
loading? [:div.dim "…"]
(empty? items) [:div.dim "none saved yet"]
:else
(doall
(for [{:keys [id name seq updated]} items]
^{:key id}
[item {:label (or name "untitled")
:sub (str "r" seq " · " (when-said updated))
:on-click #(choose! [::project/open id])}])))
[:h2 "built-in examples"]
[:div.dim "compiled in, not saved documents"]
(doall
(for [[id {:keys [label]}] db/clips]
^{:key id}
[item {:label label :example? true
:on-click #(choose! [::pb/select-clip id])}]))
[item {:label "8625 stage study" :example? true
:sub "composed from a locally saved project"
:on-click #(choose! [::project/load-stage])}]]])])))

View file

@ -1,149 +0,0 @@
(ns arthur.ui.paint
"Polygon authoring overlay. The raster canvas remains the playback sink; SVG
supplies only editor handles and an unfinished outline."
(:require [arthur.domain.channel :as channel]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as palette]
[arthur.events.paint :as events]
[arthur.events.playback :as pb]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[re-frame.core :as rf]
[reagent.core :as r]))
(defonce ^:private selected (r/atom nil))
(defonce ^:private drawing? (r/atom false))
(defonce ^:private draft (r/atom []))
(defonce ^:private tone (r/atom :skin-base))
(defonce ^:private dragging (atom nil))
(defn- point [event w h]
(let [box (.getBoundingClientRect (.-currentTarget event))]
[(-> (/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
js/Math.round (max 0) (min (dec w)))
(-> (/ (* (- (.-clientY event) (.-top box)) h) (.-height box))
js/Math.round (max 0) (min (dec h)))]))
(defn- pairs [pts]
(mapv vec (partition 2 pts)))
(defn- points-text [pts]
(apply str (interpose " " (map (fn [[x y]] (str x "," y)) (pairs pts)))))
(defn- begin! []
(reset! selected nil)
(reset! draft [])
(reset! drawing? true))
(defn- finish! []
(when (>= (count @draft) 6)
(let [id (keyword (str "paint-" (random-uuid)))]
(rf/dispatch [::events/new-shape id @draft @tone])
(reset! selected id)
(reset! draft [])
(reset! drawing? false))))
(defn toolbar []
(let [clip @(rf/subscribe [::render/clip])
frame @(rf/subscribe [::playback/frame])
shapes (paint/shapes clip)
ids (set (map first shapes))
id (when (contains? ids @selected) @selected)
shape (get-in clip [:timelines :main :nodes id])
geom (get-in shape [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
keys (when geom (sort (keys (:keys geom))))
next-key (first (filter #(> % active) keys))
tween? (= :linear (channel/segment-interp geom active))]
[:div.paint-tools
[:div.row
[:strong "paint"]
[:button {:class (when @drawing? "on") :on-click begin!} "new polygon"]
(when @drawing?
[:button {:disabled (< (count @draft) 6) :on-click finish!} "finish shape"])
(when @drawing?
[:button {:on-click #(do (reset! drawing? false) (reset! draft []))} "cancel"])
[:label "colour "
[:select {:value (name @tone)
:on-change #(reset! tone (keyword (.. % -target -value)))}
(for [{:keys [name hex]} (rest palette/entries)]
^{:key name} [:option {:value (clojure.core/name name)}
(str (clojure.core/name name) " " hex)])]]]
[:div.row
[:label "shape "
[:select {:value (if id (name id) "")
:on-change #(reset! selected (when-not (= "" (.. % -target -value))
(keyword (.. % -target -value))))}
[:option {:value ""} "select"]
(for [[shape-id node] shapes]
^{:key shape-id} [:option {:value (name shape-id)} (:name node)])]]
(when id
[:button {:disabled (or (< frame (first (:span shape)))
(contains? (:keys geom) frame))
:on-click #(rf/dispatch [::events/add-key id])}
"new drawing key"])
(when (and id next-key)
[:label (str "key " active " → " next-key " ")
[:select {:value (name (or (channel/segment-interp geom active) :hold))
:on-change #(rf/dispatch [::events/set-segment-interp id active
(keyword (.. % -target -value))])}
[:option {:value "hold"} "hold"]
[:option {:value "linear"} "tween shape"]]])]
(when (seq keys)
[:div.row
[:span "drawing keys "]
(for [f keys]
^{:key f}
[:button {:class (when (= frame f) "on")
:on-click #(rf/dispatch [::pb/seek f])}
(str f)])])
[:div.hint
(cond
@drawing? (str "Click vertices on the stage, then Finish shape. "
(quot (count @draft) 2) " points")
(and id tween? (not (contains? (:keys geom) frame)))
"Tweening between drawings. Add a drawing key here, or jump to a key to edit its vertices."
id (str "Drag vertices to edit drawing key " active
". New drawing key copies the visible shape at this frame. The transition control changes only the selected gap.")
:else "Create a polygon, or select one to edit its drawing keys.")]]))
(defn overlay [w h zoom]
(let [clip @(rf/subscribe [::render/clip])
frame @(rf/subscribe [::playback/frame])
shape (get-in clip [:timelines :main :nodes @selected])
geom (get-in shape [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
visible? (and shape (let [[start end] (:span shape)] (<= start frame) (< frame end)))
pts (when visible? (channel/value-at geom frame))
editable? (or (not= :linear (channel/segment-interp geom active))
(contains? (:keys geom) frame))]
[:svg.paint-overlay
{:width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h)
:on-pointer-down (fn [event]
(when @drawing?
(let [[x y] (point event w h)]
(swap! draft into [x y]))))
:on-pointer-move (fn [event]
(when-let [[id key-frame vertex] @dragging]
(rf/dispatch [::events/set-vertex id key-frame vertex
(point event w h)])))
:on-pointer-up (fn [_] (reset! dragging nil))
:on-pointer-cancel (fn [_] (reset! dragging nil))}
(when (seq @draft)
[:polyline {:points (points-text @draft) :fill "none"
:stroke "#d0ba86" :stroke-width 1}])
(when (and visible? (not @drawing?) pts)
[:g
[:polygon {:points (points-text pts) :fill "none"
:stroke "#e6ca8b" :stroke-width 1}]
(for [[i [x y]] (map-indexed vector (pairs (when editable? pts)))]
^{:key i}
[:circle {:cx x :cy y :r 2.6 :fill "#fff1be"
:stroke "#161820" :stroke-width 0.7
:on-pointer-down (fn [event]
(.stopPropagation event)
(.preventDefault event)
(.setPointerCapture (.-currentTarget event)
(.-pointerId event))
(reset! dragging [@selected active i]))}])])]))

View file

@ -0,0 +1,51 @@
(ns arthur.ui.palette
"The bar above the stage: the tone a new shape gets, and the tool that makes
one.
SIXTEEN SLOTS, and the palette supplies nine of them. The count is the format's
and not the data's — an indexed 320x200 picture in the Animator Pro idiom this
tool inherits has a fixed-size table, and a strip that grew and shrank as tones
were added would make the palette look like a list of colours rather than like
a table with room in it. So the empty slots are drawn, hatched, and refuse the
click.
Slot 0 is the background, which is why it is shown and not selectable: a
polygon filled with index 0 is invisible against a stage cleared to index 0, so
offering it as a fill is offering a shape that vanishes on creation."
(:require [arthur.domain.palette :as pal]
[arthur.events.ui :as ui]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]))
(def ^:const slots 16)
(defn- swatch [i tone]
(let [{slot-tone :name :keys [hex]} (get pal/entries i)
bg? (zero? i)
pick (and slot-tone (not bg?))]
[:button
{:key i
:class (str "swatch"
(when-not slot-tone " empty")
(when bg? " bg")
(when (and pick (= slot-tone tone)) " on"))
:style (when hex {:background hex})
:title (if slot-tone (str i " · " (name slot-tone) " " hex) (str i " · empty"))
:disabled (not pick)
:on-click #(rf/dispatch [::ui/set-tone slot-tone])}]))
(defn bar []
(let [tone @(rf/subscribe [::sub/tone])
tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])]
[:div.palette-bar
[:div.swatches (doall (map #(swatch % tone) (range slots)))]
[:span.dim (name tone)]
[: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 {:on-click #(rf/dispatch [::ui/begin-polygon])} "polygon"])]))

View file

@ -0,0 +1,350 @@
(ns arthur.ui.params
"The right pane: what the selection is, and what can be changed about it.
Sections rather than a mode switch. The clip's facts are always true, so the
clip section is always there; the node and symbol sections appear when
something of that kind is selected; the tracking section appears when the clip
has analysis in it. Nothing here computes — every control dispatches an intent
and every readout comes off a subscription."
(:require [clojure.string :as str]
[arthur.domain.clip :as clip-domain]
[arthur.domain.channel :as channel]
[arthur.domain.feature :as feature]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.params :as params]
[arthur.events.history :as history]
[arthur.events.paint :as paint-events]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- brief
"A value that fits the column. The `facts` list puts the whole thing in a
`title`, so nothing is lost — but a node id is a uuid and a `:z` is a
timestamp joined to one, and either wrapped over three lines pushes every
parameter below it off the pane."
[v]
(let [s (str v)]
(if (> (count s) 22) (str (subs s 0 20) "…") s)))
(defn- facts [& pairs]
(into [:dl.facts]
(mapcat (fn [[k v]] (when v [[:dt k] [:dd {:title (str v)} v]])))
(partition 2 pairs)))
(defn- section [title & body]
(into [:section.section [:h2 title]] body))
(defn- number-input
"A number box that edits as it is typed in or stepped, and is one undo step
from focus to blur. What is typed is kept while it has focus — \"-\" or
\"4.\" is no number yet, and the value it would round-trip to must not
replace it under the caret."
[_]
(let [draft (r/atom nil)]
(fn [{:keys [value parse on-number] :as attrs}]
[:input (merge (dissoc attrs :value :parse :on-number)
{:type "number"
:value (or @draft value "")
:on-focus (fn [e]
(reset! draft (.. e -target -value))
(rf/dispatch [::history/hold]))
:on-blur (fn [_]
(reset! draft nil)
(rf/dispatch [::history/settle]))
:on-key-down #(when (= "Enter" (.-key %)) (.. % -target blur))
:on-change (fn [e]
(let [s (.. e -target -value)
n (parse s)]
(when @draft (reset! draft s))
(when-not (js/isNaN n) (on-number n))))})])))
(defn- number-field [label value on-change & [placeholder disabled?]]
[:label.inspector-field label
[number-input {:min 1 :step 1 :value value
:placeholder placeholder
:disabled disabled?
:parse #(if (seq %) (js/parseInt % 10) nil)
:on-number on-change}]])
;; ---------------------------------------------------------------------------
;; the clip
(defn- clip-section []
(let [clip @(rf/subscribe [::render/clip])
fps @(rf/subscribe [::playback/fps])
picture @(rf/subscribe [::playback/display-fps])
open @(rf/subscribe [::render/open])
frames @(rf/subscribe [::render/frames])
project @(rf/subscribe [::playback/project])
busy? (:busy? project)]
[section "project"
[facts
"name" (or (:name project) (:name clip))
"stage" (str (:width clip) "×" (:height clip))
"open" (some-> open name)
"length" (str frames " frames")
"rate" (str fps " fps")]
[:div.inspector-form
[number-field "width" (:width clip)
#(rf/dispatch [::project/project-setting :width %]) nil busy?]
[number-field "height" (:height clip)
#(rf/dispatch [::project/project-setting :height %]) nil busy?]
[number-field "project fps" fps
#(rf/dispatch [::project/project-setting :fps %]) nil busy?]]
;; Sampling the frozen roto at a lower rate. The source track, the duration
;; and the audio clock are untouched — a drawing is HELD, the file is never
;; short — which is why this is a picture rate and not a playback rate.
[:div.row {:style {:margin-top "5px"}}
[:span.dim "picture"]
(doall
(for [r (distinct (filter #(<= % fps) [8 12 15 24 fps]))]
^{:key r}
[:button {:class (when (= r picture) "on")
:on-click #(rf/dispatch [::pb/set-picture-fps r])}
(if (= r fps) "source" (str r))]))]]))
;; ---------------------------------------------------------------------------
;; a node
(defn- channel-state
"One line saying how this channel is animated, which is the only thing about it
this pane can say without an editor for its values."
[ch]
(cond
(:dense ch) (str "dense · " (get-in ch [:dense :frames]) " frames")
(:keys ch) (str (count (:keys ch)) " keys · " (name (or (:interp ch) :hold)))
:else (let [v (:value ch)]
(str "framed · " (if (channel/nothing? v) "absent" (pr-str v))))))
(defn- drawing-keys
"The polygon controls: jump to a drawing key, add one here, and choose what the
gap after the current one does. Lifted out of the old stage toolbar unchanged —
a drawing key is a parameter of the shape, and this is where the shape's
parameters are.
Keys are in the shape's OWN frames — the symbol's it lives in, through every
instance above it — and `time` maps the open symbol's frames to them. `frame`
is nil when the shape is not on screen, where there is no here to key."
[sid id n {:keys [frame time]}]
(let [geom (get-in n [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
ks (when geom (sort (keys (:keys geom))))
next-k (first (filter #(> % active) ks))
[start end] (:span n)]
[:<>
[:div.row {:style {:margin "5px 0"}}
[:button {:disabled (or (nil? frame) (< frame start) (>= frame end)
(contains? (:keys geom) frame))
:on-click #(rf/dispatch [::paint-events/add-key sid id frame])}
"drawing key here"]]
(when (seq ks)
[:div.row
[:span.dim "keys"]
(doall
(for [f ks]
^{:key f}
[:button {:class (when (= frame f) "on")
:disabled (nil? time)
:on-click #(rf/dispatch [::pb/seek (js/Math.round
(+ (:at time) (/ f (:rate time))))])}
(str f)]))])
(when next-k
[:div.row {:style {:margin-top "5px"}}
[:label.dim (str "key " active " → " next-k " ")
[:select {:value (name (or (channel/segment-interp geom active) :hold))
:on-change #(rf/dispatch [::paint-events/set-segment-interp
sid id active (keyword (.. % -target -value))])}
[:option {:value "hold"} "hold"]
[:option {:value "linear"} "tween"]]]])]))
;; The transform and visibility, which every node has, as one row each: ◆ keys
;; the channel here or takes the key here off, and an edit writes a key on a
;; keyed channel or the one value on one that is not. `frame` is the node's own,
;; nil when it is not on screen, where a keyed channel has no here to write to.
;; Rotation is shown in degrees.
(defn- channel-control [sid id path ch frame]
(let [keyed? (some? (:keys ch))
v (channel/value-at ch (or frame 0))
off? (and keyed? (nil? frame))
deg? (= path [:xform :rot])
put #(rf/dispatch [::project/set-channel sid id path frame %])
field (fn [i x on-number]
^{:key i}
[number-input {:step "any" :disabled off?
:value (if deg? (/ (js/Math.round (* x (/ 18000 js/Math.PI))) 100) x)
:parse js/parseFloat
:on-number #(on-number (if deg? (* % (/ js/Math.PI 180)) %))}])]
[:dd.channel
[:button.key {:class (cond (contains? (:keys ch) frame) "on" keyed? "keyed")
:disabled (nil? frame)
:title (if keyed? (str (count (:keys ch)) " keys") "key this here")
:on-click #(rf/dispatch [::project/toggle-key sid id path frame])}
"◆"]
(cond
(boolean? v) [:input {:type "checkbox" :checked v :disabled off?
:on-change #(put (.. % -target -checked))}]
(number? v) (field 0 v put)
:else (doall (map-indexed (fn [i x] (field i x #(put (assoc (vec v) i %))))
v)))]))
(defn- node-section [[sid id n]]
(let [[start end] (:span n)]
[section (str (name (:kind n)) " · in " (name sid))
[facts
"name" (or (:name n) (brief id))
"id" (brief id)
;; Which symbol an instance places. The one fact that makes an instance
;; legible as an instance rather than as a node.
"of" (when (= :instance (:kind n)) (str (:of n)))
;; A span is in the node's OWN frames and `at` is where its frame 0 sits
;; in this symbol. See `node/placed-span`.
"span" (when start (str start " … " end))
"at" (when (= :map (get-in n [:time :mode])) (str (get-in n [:time :at] 0)))]
(when (:paint? n) [drawing-keys sid id n @(rf/subscribe [::sub/selected-local])])
[:div.row {:style {:margin-top "6px"}} [:span.dim "channels"]]
(let [{:keys [frame]} @(rf/subscribe [::sub/selected-local])]
[:dl.facts
(doall
(for [[path ch] (sort-by (comp str key) (node/channels n))]
^{:key (str path)}
[:<>
[:dt (str/join " " (map name path))]
(if (and (contains? node/defaults path) (not (:dense ch)))
[channel-control sid id path ch frame]
[:dd (channel-state ch)])]))])]))
;; ---------------------------------------------------------------------------
;; a symbol
(defn- symbol-section [sid]
(let [clip @(rf/subscribe [::render/clip])
sym (get-in clip [:symbols sid])
busy? (:busy? @(rf/subscribe [::playback/project]))]
[section "symbol"
[facts
"id" (str sid)
"length" (str (:frames sym) " frames")
"stage" (let [[w h] (clip-domain/stage clip sid)] (str w "×" h))
"nodes" (str (count (:nodes sym)))]
[:div.inspector-form
[number-field "length (frames)" (:frames sym)
#(rf/dispatch [::project/symbol-setting sid :frames %]) nil busy?]
[number-field "width" (:width sym)
#(rf/dispatch [::project/symbol-setting sid :width %]) "project default" busy?]
[number-field "height" (:height sym)
#(rf/dispatch [::project/symbol-setting sid :height %]) "project default" busy?]
(when (or (:width sym) (:height sym))
[:div.row
[:button {:disabled busy? :on-click #(do
(rf/dispatch [::project/symbol-setting sid :width nil])
(rf/dispatch [::project/symbol-setting sid :height nil]))}
"use project stage"]])]]))
;; ---------------------------------------------------------------------------
;; tracked objects
;;
;; The generated settings. Unlike everything above, moving one of these does real
;; work: `::project/preview-settings` re-freezes whatever blocks the knob
;; invalidates, which is why the slider's value is held in `:ui :knobs` until the
;; regeneration comes back.
(defn- owners [clip]
(vec (for [[scope objects] [[:subject (:subjects clip)]
[:feature (:features clip)]
[:group (:groups clip)]]
id (sort-by str (keys objects))]
[scope id])))
(defn- bounds [knob {:keys [type default min even?] upper :max}]
{:min (or min (if (= knob :blob-grow) -3 0))
:max (or upper (get {:verts 20 :eye-verts 16 :brow-verts 10
:teeth-verts 20 :blob-grow 3 :top-bias 2
:gaze-gain 4} knob)
(max 1 (* 2 default)))
:step (cond even? 2 (= type :integer) 1 :else 0.01)})
(defn- tracking-section []
(let [clip @(rf/subscribe [::render/clip])
selection @(rf/subscribe [::sub/selection])
knobs @(rf/subscribe [::sub/knobs])
busy? (:busy? @(rf/subscribe [::playback/project]))
report @(rf/subscribe [::project/regeneration])
all (owners clip)
[scope id :as owner] (if (some #{selection} all) selection (first all))
area (case scope
:subject :subject
:feature (get-in clip [:features id :area])
:group :eye
nil)
values (case scope
:subject (merge (params/for-area :subject)
(get-in clip [:subjects id :params]))
:feature (when id (feature/effective-params clip id))
:group (merge (params/for-area :eye)
(get-in clip [:groups id :params]))
nil)]
[section "tracking"
;; The option VALUE is the INDEX, not the owner. A `[scope id]` pair written
;; into the DOM comes back as a string that has to be parsed back into a
;; keyword pair, and `subs`/`keyword` on a namespaced id loses its namespace
;; — the same trap `events/export/target-value` exists to avoid. An index
;; into a vector both ends agree on cannot be misread.
[:select {:value (or (first (keep-indexed #(when (= %2 owner) %1) all)) 0)
:on-change #(rf/dispatch
[::ui/select (nth all (js/parseInt (.. % -target -value) 10))])}
(doall
(for [[i [kind object-id]] (map-indexed vector all)]
^{:key i}
[:option {:value i} (str (name kind) " · " (subs (str object-id) 1))]))]
(when area
[:div {:style {:margin-top "6px"}}
(doall
(for [[knob spec] (sort-by (comp str key) params/definitions)
:when (= area (:area spec))]
(let [k (get knobs [scope id knob] (get values knob))
{:keys [min max step]} (bounds knob spec)]
^{:key knob}
[:label.knob
[:span.top-line [:span.name (name knob)] [:span (str k)]]
[:input {:type "range" :min min :max max :step step :value k
:disabled busy?
:on-change
(fn [^js event]
(let [s (.. event -target -value)
v (if (= :integer (:type spec))
(js/parseInt s 10)
(js/parseFloat s))]
(rf/dispatch [::ui/set-knob scope id knob v])
(rf/dispatch [::project/preview-settings
{:scope scope :id id :knob knob :value v}])))}]])))])
(when report
;; `regeneration-debug` is a hook rather than a style: `test/browser` reads
;; this line to assert which feature a knob dirtied and which tier it
;; reached, and that is the one thing on the page that says so.
[:div.dim.regeneration-debug {:style {:margin-top "6px"}}
(str "dirty: " (pr-str (:features report))
" · blocks: " (if (seq (:roles report))
(pr-str (sort (:roles report))) "tier 1 only"))])]))
;; ---------------------------------------------------------------------------
(defn view []
(let [clip @(rf/subscribe [::render/clip])
selection @(rf/subscribe [::sub/selection])
node @(rf/subscribe [::sub/selected-node])
tracked? (seq (owners clip))]
[:section.pane.params
[:div.pane-head "inspector"]
[:div {:style {:min-height 0}}
[clip-section]
(when node [node-section node])
(when (= :symbol (first selection)) [symbol-section (second selection)])
(when tracked? [tracking-section])]]))

View file

@ -100,13 +100,13 @@
(reset! tracker
(ratom/run!
(let [was (:resolver @snapshot)
now @(rf/subscribe [::render/resolver])]
now @(rf/subscribe [::render/shown])]
(reset! snapshot
{:resolver now
:palette @(rf/subscribe [::render/palette])
:ramp @(rf/subscribe [::render/ramp])
:fps @(rf/subscribe [::sub/fps])
:frames @(rf/subscribe [::sub/frames])
:frames @(rf/subscribe [::render/frames])
:width @(rf/subscribe [::sub/width])
:height @(rf/subscribe [::sub/height])
:frame @(rf/subscribe [::sub/frame])
@ -184,7 +184,17 @@
;; painted when it was not is how the canvas stays empty forever.
(when (and ready? f (not= f (:last @state)))
(swap! state assoc :last f)
(paint! f)
;; A frame that cannot be drawn is REPORTED and the clock carries on. Let
;; it throw and the transport freezes with it — the playhead stops, the
;; stage stays on whatever it last showed, and the one line saying why is
;; buried under the next sixty identical ones. Reported once per message.
(try
(paint! f)
(catch :default error
(when (not= (ex-message error) (:failed @state))
(swap! state assoc :failed (ex-message error))
(js/console.error "arthur: frame" f "could not be drawn:" error)
(rf/dispatch [::pb/paint-failed (ex-message error)]))))
(when live? (meter! f))
(when live? (rf/dispatch [::pb/tick f])))
;; The audio ending is the authority on playback having stopped; nothing
@ -193,8 +203,9 @@
(rf/dispatch [::pb/pause]))))
(defn- frame-loop []
(tick!)
(swap! state assoc :raf (js/requestAnimationFrame frame-loop)))
;; Scheduled BEFORE the tick, so nothing the tick does can end the loop.
(swap! state assoc :raf (js/requestAnimationFrame frame-loop))
(tick!))
(defn start! []
(refresh-subs!)

View file

@ -0,0 +1,181 @@
(ns arthur.ui.pool
"The media pool: what can be put into the open symbol, in two folders.
THIS PROJECT is the open document's own: every symbol in it — the open one
included, because none is special — and the video it uses or was given this
session. ALL ASSETS is everything the server holds: every upload, and every
symbol of every other saved project. Whole projects are `ui/openmenu`'s, and
the split is the point: opening a project REPLACES what is on screen, where
everything in here is a thing to put INTO it.
Every row is a drag source, and what it carries says what it is:
`symbol:<id>` for a symbol of this document, `import:<project>|<cid>|<id>` for
one of another's, and `footage:<id>` for video. The stage and the timeline are
where they are dropped.
THE WHOLE PANE IS THE DROP TARGET for a file. A video dropped anywhere in it
uploads and lands in THIS PROJECT's media, and goes no further: which frames of
it become a symbol, and what that symbol is called, is asked when it is dropped
where it should go. The uploaded bytes, the extraction job and the decoded
footage stay separate records on the server, so dropping the same file twice
does not decode it twice."
(:require [arthur.domain.clip :as clip]
[arthur.events.footage :as footage]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.drag :as drag]
[clojure.string :as str]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- item
"One row. `opts` is merged last so a caller can add its handlers without this
function growing a parameter per affordance."
[{:keys [label sub on? disabled? thumb] :as opts}]
[:button (merge {:class (str "pool-item" (when on? " on") (when thumb " media"))
:disabled (boolean disabled?)
:title label}
(dissoc opts :label :sub :on? :disabled? :thumb))
thumb
[:span.text label (when sub [:span.sub sub])]])
(defn- carrying
"The drag handlers for a row. `text` is what makes it a drag at all and what
another application would receive; `start!` puts the real payload where the
stage and the timeline can read it while hovering — see `ui/drag`."
[text start!]
{:draggable true
:on-drag-start (fn [^js event]
(.setData (.-dataTransfer event) "text/plain" text)
(set! (.. event -dataTransfer -effectAllowed) "copy")
(start!))
:on-drag-end (fn [_] (drag/done!))})
(defn- thumbnail
"One frame of a video, from its proxy. `#t=` seeks a paused, muted element to a
frame that is not the black leader most phone footage opens on; nothing is
played and nothing is decoded past it."
[{:keys [video]}]
(if video
;; Sized here as well as in the stylesheet: a video element with no size
;; is as big as its footage, and a portrait phone clip is 1440×1920.
[:video.thumb {:src (str video "#t=0.2") :muted true :preload "metadata"
:plays-inline true :tab-index -1
:style {:width 40 :height 30 :max-width 40 :max-height 30}}]
[:span.thumb]))
(defn- footage-row [{:keys [id label frames fps video] :as f} chosen]
[item (merge {:label label
:sub (str frames "f @ " fps)
:thumb [thumbnail f]
:on? (= id chosen)
:on-click #(rf/dispatch [::footage/choose id])}
(carrying (str "footage:" id)
#(drag/other! {:kind :footage :id id :label label
:frames frames :fps fps :video video})))])
(defn- folder [title & children]
(into [:details.pool-folder {:open true} [:summary title]] children))
(defn- group [title & children]
(into [:div.pool-group {:class title} [:h2 title]] children))
(defn- this-project []
(let [document @(rf/subscribe [::render/clip])
clip-id @(rf/subscribe [::render/clip-id])
selection @(rf/subscribe [::sub/selection])
open @(rf/subscribe [::render/open])
media @(rf/subscribe [::sub/project-footage])
{:keys [chosen]} @(rf/subscribe [::playback/footage])]
(folder "this project"
(group "symbols"
(doall
(for [sid (sort-by str (keys (:symbols document)))
:let [sym (clip/symbol document sid)]]
^{:key (str sid)}
[item (merge {:label (clip/symbol-name document sid)
:sub (str (:frames sym) "f · " (count (:nodes sym)) " nodes"
(when (= sid open) " · open"))
:on? (= selection [:symbol sid])
:on-click #(rf/dispatch [::ui/select [:symbol sid]])
:on-double-click #(rf/dispatch [::pb/open-symbol sid])}
(carrying (str "symbol:" (subs (str sid) 1))
#(drag/symbol! clip-id sid open)))]))
[:div.dim "double-click to open · drag to place"])
(group "media"
(if (empty? media)
[:div.dim "drop a video here"]
(doall (for [f media] ^{:key (:id f)} [footage-row f chosen])))))))
(defn- all-assets []
(let [{:keys [available chosen]} @(rf/subscribe [::playback/footage])
{:keys [symbols]} @(rf/subscribe [::project/assets])
{:keys [id]} @(rf/subscribe [::playback/project])]
(folder "all assets"
(group "media"
(if (empty? available)
[:div.dim "nothing uploaded yet"]
(doall (for [f available] ^{:key (:id f)} [footage-row f chosen]))))
(group "symbols"
(let [others (remove #(= id (:project %)) symbols)]
(if (empty? others)
[:div.dim "no other saved projects"]
(doall
(for [[[pid pname] rows] (group-by (juxt :project :project-name) others)]
^{:key pid}
;; Closed: a server holds many projects, and a wall of
;; every symbol in every one buries the one you want.
[:details.pool-project
[:summary (str pname " · " (count rows)
(if (= 1 (count rows)) " symbol" " symbols"))]
(doall
(for [{:keys [cid symbol name frames]} rows]
^{:key (str cid symbol)}
[item (merge {:label name :sub (str frames "f")}
(carrying (str "import:" (str/join "|" [pid cid symbol]))
#(drag/other! {:kind :import :label name
:frames frames
:project pid :cid cid
:symbol symbol})))]))]))))))))
(defn view []
(r/with-let [;; Counted, not a boolean. `dragenter`/`dragleave` fire for every
;; child element the pointer crosses, so a flag set on enter and
;; cleared on leave flickers off the moment the drag passes over a
;; row — the depth counter is what makes the outline steady.
depth (r/atom 0)]
(let [{:keys [loading? status]} @(rf/subscribe [::playback/footage])
files? (fn [^js e] (some #{"Files"} (array-seq (.. e -dataTransfer -types))))]
[:section.pane.pool
{:class (when (pos? @depth) "dropping")
;; Only a FILE lights the pane up: a row dragged out of the pool is on
;; its way somewhere else.
:on-drag-enter (fn [^js e] (when (files? e) (.preventDefault e) (swap! depth inc)))
:on-drag-leave (fn [^js e] (when (files? e) (swap! depth #(max 0 (dec %)))))
:on-drag-over (fn [^js e] (when (files? e) (.preventDefault e)))
:on-drop (fn [^js e]
(.preventDefault e)
(reset! depth 0)
(when-let [file (aget (.. e -dataTransfer -files) 0)]
(rf/dispatch [::footage/upload file])))}
[:div.pane-head
"media pool"
[:span.spacer]
[:button {:title "add a video"
:disabled loading?
:on-click #(.click (js/document.getElementById "pool-file"))}
"+"]]
[:input {:id "pool-file" :type "file" :accept "video/*"
:style {:display "none"}
:on-change (fn [^js event]
(when-let [file (aget (.. event -target -files) 0)]
(rf/dispatch [::footage/upload file])
(set! (.. event -target -value) "")))}]
[:div.pane-body
[this-project]
[all-assets]
(when status [:div.dim status])]])))

View file

@ -0,0 +1,99 @@
(ns arthur.ui.share
"Who is here, who may write, and who you are: the top bar's right-hand end.
The same drop-down as `openmenu` — a button, a scrim, a panel — because these
are the same kind of thing: a few rows about the document, gone on the next
click."
(:require [arthur.events.collab :as collab]
[arthur.events.project :as project]
[arthur.subs.playback :as playback]
[clojure.string :as str]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- menu
([label open? body] (menu label open? nil body))
([label open? class body]
[:div.menu-wrap
[:button {:class [class (when @open? "on")] :on-click #(swap! open? not)} label]
(when @open?
[:<> [:div.menu-scrim {:on-click #(reset! open? false)}]
(into [:div.menu] body)])]))
(defn- initial [user] (str/upper-case (subs (or user "?") 0 1)))
(defn- roster []
(let [peers @(rf/subscribe [::collab/peers])]
(when (seq peers)
[:span.roster {:title (str/join ", " (map #(or (:user %) "guest") peers))}
(doall (for [{:keys [cid user]} (take 5 peers)]
^{:key cid} [:span.peer {:class (when-not user "guest")} (initial user)]))
(when (< 5 (count peers)) [:span.dim (str "+" (- (count peers) 5))])])))
(defn- sharing []
(r/with-let [open? (r/atom false)
draft (r/atom "")]
(let [{:keys [id name owner editors can-edit?]} @(rf/subscribe [::playback/project])
{:keys [username error]} @(rf/subscribe [::collab/me])
owner? (and owner (= owner username))
link (str (.. js/window -location -origin) (collab/project-path id name))]
(when id
[menu (if (false? can-edit?) "view only ▾" "Share") open? "share-button"
[[:h2 "link"]
[:div.row
[:input.share-link {:read-only true :value link :on-focus #(.select (.-target %))}]
[:button {:on-click #(.writeText (.-clipboard js/navigator) link)} "copy"]]
(if (false? can-edit?)
[:<>
[:p.dim "you can view this; to change it, make a copy of your own"]
(when username
[:button {:on-click (fn [] (reset! open? false)
(rf/dispatch [::project/save]))}
"make a copy"])]
[:p.dim "anyone with the link can view"])
(when owner
[:<>
[:h2 "can edit"]
[:div.menu-item.static owner [:span.sub "owner"]]
(doall (for [e editors]
^{:key e}
[:div.menu-item.static e
(when owner?
[:button.link {:on-click #(rf/dispatch [::collab/remove-editor e])}
"remove"])]))
(when owner?
[:form.row {:on-submit (fn [ev]
(.preventDefault ev)
(when (seq (str/trim @draft))
(rf/dispatch [::collab/add-editor (str/trim @draft)])
(reset! draft "")))}
[:input {:placeholder "username" :value @draft
:on-change #(reset! draft (.. % -target -value))}]
[:button {:type "submit"} "add"]])
(when error [:p.warn error])])]]))))
(defn account []
(r/with-let [open? (r/atom false)
username (r/atom "")
password (r/atom "")]
(let [{signed-in :username :keys [error]} @(rf/subscribe [::collab/me])
go! (fn [mode] (rf/dispatch [::collab/sign-in mode @username @password])
(reset! password ""))]
(if signed-in
[menu (str signed-in " ▾") open?
[[:button.menu-item {:on-click (fn [] (reset! open? false)
(rf/dispatch [::collab/sign-out]))}
"sign out"]]]
[menu "sign in ▾" open?
[[:form.account {:on-submit (fn [e] (.preventDefault e) (go! :login))}
[:input {:placeholder "username" :auto-complete "username" :value @username
:on-change #(reset! username (.. % -target -value))}]
[:input {:type "password" :placeholder "password" :auto-complete "current-password"
:value @password :on-change #(reset! password (.. % -target -value))}]
[:div.row
[:button {:type "submit"} "sign in"]
[:button {:type "button" :on-click #(go! :signup)} "create account"]]
(when error [:p.warn error])]]]))))
(defn view []
[:<> [roster] [sharing] [account]])

View file

@ -1,300 +1,44 @@
(ns arthur.ui.shell
"The page. Transport, canvas, readouts.
"The window: one grid, five panes, and the audio element.
Nothing here computes anything about a frame: it dispatches intents and reads
extractors. The picture is put on the canvas by ui/player's loop, not by this
component re-rendering — which is why the canvas has no reactive content and
why scrubbing at speed does not re-render the page."
Nothing else. Each pane owns its own subscriptions, so this component re-renders
only when the grid itself would change — which is never. The picture is put on
the canvas by `ui/player`'s loop rather than by anything here re-rendering,
which is why scrubbing at speed does not touch React at all."
(:require [arthur.clock :as clock]
[arthur.db :as db]
[arthur.domain.feature :as feature]
[arthur.domain.params :as params]
[arthur.events.export :as export]
[arthur.events.footage :as footage]
[arthur.ui.convert :as convert]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.subs.playback :as sub]
[arthur.subs.render :as render]
[arthur.ui.player :as player]
[arthur.ui.paint :as paint]
[re-frame.core :as rf]
[reagent.core :as r]))
(def ^:private zoom 2)
(defonce ^:private selected-owner (r/atom nil))
(defonce ^:private drafts (r/atom {}))
(defn- setting-owners [clip]
(vec (for [[scope objects] [[:subject (:subjects clip)]
[:feature (:features clip)]
[:group (:groups clip)]]
id (sort-by str (keys objects))]
[scope id])))
(defn- slider-bounds [knob {:keys [type default min even?] upper :max}]
{:min (or min (if (= knob :blob-grow) -3 0))
:max (or upper (get {:verts 20 :eye-verts 16 :brow-verts 10
:teeth-verts 20 :blob-grow 3 :top-bias 2
:gaze-gain 4} knob)
(max 1 (* 2 default)))
:step (cond even? 2 (= type :integer) 1 :else 0.01)})
(defn- controls []
(let [clip @(rf/subscribe [::render/clip])
busy? (:busy? @(rf/subscribe [::sub/project]))
report @(rf/subscribe [::project/regeneration])
owners (setting-owners clip)
[scope id :as owner] (if (some #{(deref selected-owner)} owners)
@selected-owner (first owners))
area (case scope
:subject :subject
:feature (get-in clip [:features id :area])
:group :eye
nil)
values (case scope
:subject (merge (params/for-area :subject)
(get-in clip [:subjects id :params]))
:feature (when id (feature/effective-params clip id))
:group (merge (params/for-area :eye)
(get-in clip [:groups id :params]))
nil)]
[:section.controls
[:label "active object "
[:select {:value (or (first (keep-indexed
(fn [i option] (when (= option owner) i)) owners)) 0)
:on-change #(reset! selected-owner
(nth owners (js/parseInt (.. % -target -value) 10)))}
(if (seq owners)
(doall (for [[i [kind object-id]] (map-indexed vector owners)]
^{:key i} [:option {:value i}
(str (name kind) " · " (subs (str object-id) 1))]))
[:option {:value 0} "no tracked objects"])] ]
(when area
[:div.control-list
(doall
(for [[knob spec] (sort-by (comp str key) params/definitions)
:when (= area (:area spec))]
(let [draft-key [scope id knob]
value (get @drafts draft-key (get values knob))
{:keys [min max step]} (slider-bounds knob spec)]
^{:key (str draft-key)}
[:label.control-row
[:span (name knob)]
[:input {:type "range" :min min :max max :step step :value value
:disabled busy?
:on-change (fn [event]
(let [s (.. event -target -value)
v (if (= :integer (:type spec))
(js/parseInt s 10)
(js/parseFloat s))]
(swap! drafts assoc draft-key v)
(rf/dispatch [::project/preview-settings
{:scope scope :id id :knob knob
:value v}]))) }]
[:output (str value)]])))])
(when report
[:pre.regeneration-debug
(str "dirty features: " (pr-str (:features report)) "\n"
"new block roles: " (if (seq (:roles report))
(pr-str (sort (:roles report))) "none (tier 1 only)")
"\n" (get-in @(rf/subscribe [::sub/project]) [:status]))])]))
[arthur.subs.playback :as playback]
[arthur.ui.palette :as palette]
[arthur.ui.params :as params]
[arthur.ui.pool :as pool]
[arthur.ui.stage :as stage]
[arthur.ui.tabs :as tabs]
[arthur.ui.timeline :as timeline]
[arthur.ui.topbar :as topbar]
[re-frame.core :as rf]))
(defn- audio []
(let [src @(rf/subscribe [::sub/audio])]
[:audio
{:ref #(when % (clock/attach! %))
:src src
:preload "auto"
;; Transport state follows the ELEMENT, not the other way round: the audio
;; is the clock, so anything that can change its state — the end of the
;; file, the OS media keys, a browser autoplay block — has to be able to
;; correct the document rather than be contradicted by it.
[:audio
{:ref #(when % (clock/attach! %))
:src @(rf/subscribe [::playback/audio])
:preload "auto"
;; Transport state follows the ELEMENT, not the other way round: the audio is
;; the clock, so anything that can change its state — the end of the file, the
;; OS media keys, a browser autoplay block — has to be able to correct the
;; document rather than be contradicted by it.
:on-play #(rf/dispatch [::pb/play])
:on-pause #(rf/dispatch [::pb/pause])}]))
(defn- transport []
(let [playing? @(rf/subscribe [::sub/playing?])
rate @(rf/subscribe [::sub/rate])
frame @(rf/subscribe [::sub/frame])
frames @(rf/subscribe [::sub/frames])
fps @(rf/subscribe [::sub/fps])
picture-fps @(rf/subscribe [::sub/display-fps])
current @(rf/subscribe [::render/clip-id])
expose @(rf/subscribe [::render/exposure])
{:keys [id label loading? status available chosen]} @(rf/subscribe [::sub/footage])
{project-name :name :keys [busy?] project-status :status
project-seq :seq} @(rf/subscribe [::sub/project])]
[:div.transport
[:div.row
[:button {:on-click #(rf/dispatch [::pb/toggle])}
(if playing? "pause" "play")]
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"]
[:button {:on-click #(rf/dispatch [::pb/step -1])} "-1"]
[:button {:on-click #(rf/dispatch [::pb/step 1])} "+1"]
[:button {:class (when @(rf/subscribe [::sub/loop?]) "on")
:on-click #(rf/dispatch [::pb/toggle-loop])} "loop"]
[:button {:class (when @(rf/subscribe [::sub/muted?]) "on")
:on-click #(rf/dispatch [::pb/toggle-mute])} "mute"]
[:span.gap]
(doall
(for [[id {:keys [label]}] db/clips]
^{:key id}
[:button {:class (when (= id @(rf/subscribe [::render/clip-id])) "on")
:on-click #(rf/dispatch [::pb/select-clip id])}
label]))
(when id
[:button {:class (when (= id @(rf/subscribe [::render/clip-id])) "on")
:on-click #(rf/dispatch [::pb/select-clip id])}
(or label "footage")])
[:button {:disabled (or loading? (nil? chosen))
:on-click #(rf/dispatch [::footage/load])}
(if loading? "loading…" "load frames")]
[:span.gap]
;; The document, over HTTP. Two buttons, because the round trip is the proof
;; the model serialises and a proof nobody can run is not one.
[:button {:disabled busy? :on-click #(rf/dispatch [::project/save])} "save"]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/open])} "open"]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/load-stage])}
"stage 8625"]
[:span.gap]
(doall
(for [r db/rates]
^{:key r}
[:button {:class (when (== r rate) "on")
;; playbackRate and nothing else: the audio slows, currentTime
;; advances proportionally, and the derived frame follows. Slow
;; motion cannot desync by construction.
:on-click #(rf/dispatch [::pb/set-rate r])}
(case r 1.0 "1x" 0.5 "1/2x" 0.25 "1/4x" 2.0 "2x" 4.0 "4x" (str r))]))]
[:input.scrub
{:type "range" :min 0 :max (dec frames) :step 1 :value frame
:on-change #(rf/dispatch [::pb/seek (js/parseInt (.. % -target -value) 10)])}]
[:div.readout
[:span (str "frame " frame " / " frames)]
[:span (str "source " fps " fps")]
[:span (str "picture " picture-fps " fps")]
[:span (str "pose " (clock/picture-frame frame fps picture-fps expose))]
[:span (str (js/Math.round (* 100 rate)) "%")]
;; Measured in the loop, not derived from the clock: the whole question
;; while profiling is whether the painting keeps up with the clock, so a
;; number computed FROM the clock would answer itself.
(let [{:keys [fps drop]} @player/meter]
[:span {:class (when (and drop (> drop 1.35)) "warn")}
(str (.toFixed (or fps 0) 1) " paint/s"
(when (and drop (pos? drop))
(str " · " (.toFixed drop 2) " frames/paint")))])]
(when (= id current)
[:div.picture-rate
[:span "picture fps "]
(doall
(for [r (distinct (filter #(<= % fps) [8 12 15 24 fps]))]
^{:key r}
[:button {:class (when (= r picture-fps) "on")
:on-click #(rf/dispatch [::pb/set-picture-fps r])}
(if (= r fps) "source" (str r))]))])
;; Upload a video or choose existing server footage. Both routes produce the
;; same immutable frame and audio manifest.
[:label.source-path "footage "
[:input {:type "file" :accept "video/*" :disabled loading?
:on-change (fn [event]
(when-let [file (aget (.. event -target -files) 0)]
(rf/dispatch [::footage/upload file])
(set! (.. event -target -value) "")))}]
[:select {:value (or chosen "") :disabled loading?
:on-change #(rf/dispatch [::footage/choose (.. % -target -value)])}
(if (seq available)
(doall (for [{:keys [id label frames fps]} available]
^{:key id}
[:option {:value id}
(str label " · " frames "f @" fps)]))
[:option {:value ""} "no footage yet"])]
[:button {:disabled loading?
:on-click #(rf/dispatch [::footage/refresh])} "refresh"]]
(when status [:div.load-status status])
(when (or project-name project-status)
[:div.load-status
(when project-name (str "project " project-name
(when project-seq (str " r" project-seq)) " · "))
project-status])]))
(defn- exporter []
(let [{:keys [timeline zoom isolate busy? done total status]} @(rf/subscribe [::export/state])
targets @(rf/subscribe [::export/targets])
{:keys [width height frames fps seconds poses]} @(rf/subscribe [::export/plan])]
[:section.export
[:div.row
[:label "export "
;; ONE SELECT over everything exportable: the clip, each symbol in its
;; library, and each placement on the stage. They are one list because they
;; are one kind of request — render this, alone — and a mode switch beside a
;; picker would only make the same choice twice.
;;
;; The option VALUE is `events/export/target-value`, not `(name id)`: a
;; symbol timeline is `:sym/face-8625` and a placement is a uuid, and
;; writing either through `name` loses what identifies it. That is the bug
;; where the id read back as `:face-8625`, matched no timeline, and the
;; export died inside re-frame's `:do-fx` with the button stuck on
;; "rendering…".
[:select {:value (export/target-value {:timeline (or timeline :main)
:isolate isolate})
:disabled busy?
:on-change #(rf/dispatch [::export/set-target
(export/target-id (.. % -target -value))])}
(doall
(for [{:keys [label] :as target} targets]
^{:key (export/target-value target)}
[:option {:value (export/target-value target)}
;; A placement is indented under the library above it, so that "the
;; drawing" and "that one on the stage" read as different things.
(str (when (:isolate target) "· ") label)]))]]
[:span.gap]
(doall
(for [z export/zooms]
^{:key z}
[:button {:class (when (= z zoom) "on") :disabled busy?
:on-click #(rf/dispatch [::export/set-zoom z])}
(str z "x")]))
[:button {:disabled busy? :on-click #(rf/dispatch [::export/start])}
(if busy? "rendering…" "frames + wav")]]
(when (and width frames)
[:div.readout
[:span (str width "x" height)]
[:span (str frames " frames @ " fps)]
[:span (str (.toFixed seconds 2) "s")]
;; Poses and frames are different numbers at a lower picture rate, and
;; showing both is how "exposure holds a drawing" stops being invisible:
;; the file is never short, the drawing is just held.
(when (not= poses frames) [:span (str poses " poses")])])
(when busy?
[:div.load-status (str "frame " done " / " total)])
(when (and status (not busy?)) [:div.load-status status])
[:p.note
"A lossless PNG sequence at an integer zoom, with the mixed audio, in one "
"zip. Import the sequence and the WAV as separate tracks."]]))
(defn- stage []
;; The canvas is the STAGE's size, and the stage is the clip's — not a constant
;; and not the footage's. Reactive, so selecting a clip of another size resizes
;; it; ui/canvas guards the width assignment, which reallocates the backing
;; store, so this being a re-render costs nothing per frame.
(let [w @(rf/subscribe [::sub/width])
h @(rf/subscribe [::sub/height])]
[:div.stage-wrap
[:canvas.stage
{:ref #(player/set-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px") :height (str (* zoom h) "px")}}]
[paint/overlay w h zoom]]))
:on-pause #(rf/dispatch [::pb/pause])}])
(defn view []
[:main
[:h1 "arthur"]
[stage]
[paint/toolbar]
[audio]
[transport]
[exporter]
[controls]
[:p.note
"Upload a video, choose its footage, then load frames. Save the project to "
"share the analyzed take without detecting frames again."]])
[:div.app
[topbar/view]
[pool/view]
[:section.view
[tabs/view]
[palette/bar]
[stage/view]]
[params/view]
[timeline/view]
[convert/view]
[audio]])

View file

@ -0,0 +1,44 @@
(ns arthur.ui.snapshots
"Named versions. Every edit saves itself, so there is nothing to save — only
moments worth a name, to go back to."
(:require [arthur.events.collab :as collab]
[arthur.subs.playback :as playback]
[clojure.string :as str]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn view []
(r/with-let [open? (r/atom false)
draft (r/atom "")]
(let [{:keys [can-edit?]} @(rf/subscribe [::playback/project])
rows @(rf/subscribe [::collab/snapshot-list])
editable? (not (false? can-edit?))]
[:div.menu-wrap
[:button {:class (when @open? "on")
:on-click (fn [] (when-not @open? (rf/dispatch [::collab/snapshots]))
(swap! open? not))}
"snapshots ▾"]
(when @open?
[:<> [:div.menu-scrim {:on-click #(reset! open? false)}]
[:div.menu.menu-left
(when editable?
[:form.row {:on-submit (fn [e]
(.preventDefault e)
(rf/dispatch [::collab/snapshot
(or (not-empty (str/trim @draft)) "snapshot")])
(reset! draft ""))}
[:input {:placeholder "name this version" :value @draft :auto-focus true
:on-change #(reset! draft (.. % -target -value))}]
[:button {:type "submit"} "take snapshot"]])
[:h2 "snapshots"]
(if (empty? rows)
[:div.dim "none yet"]
(doall
(for [{:keys [id name author created] :as row} rows]
^{:key id}
[:div.menu-item.static
[:span name [:span.sub (str author " · " (subs (str created) 0 16))]]
(when editable?
[:button.link {:on-click (fn [] (reset! open? false)
(rf/dispatch [::collab/restore row]))}
"restore"])])))]])])))

View file

@ -0,0 +1,177 @@
(ns arthur.ui.stage
"The stage: the raster canvas, and the SVG editor over it.
They are one widget and live in one namespace. The canvas is the playback sink
— `ui/player`'s loop writes it from an animation frame, so it has no reactive
content and scrubbing at speed does not re-render this component — and the SVG
is the only thing on the page that draws a shape a human can grab. Splitting
them would mean two namespaces sharing one coordinate transform.
THE CANVAS IS THE RASTER'S OWN SIZE, scaled by CSS. See `ui/canvas` for why
that is load-bearing rather than convenient."
(:require [arthur.domain.channel :as channel]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.events.paint :as paint-events]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.drag :as drag]
[arthur.ui.player :as player]
[re-frame.core :as rf]))
(def ^:const zoom
"Integer, and the browser suite reads the canvas's own pixels rather than a
screenshot because of it."
2)
(defn stage-point
"Where a pointer event landed, in stage pixels. Shared by the vertex editor and
by a drop out of the media pool, which is the whole reason it is public."
[event w h]
(let [box (.getBoundingClientRect (.-currentTarget event))]
[(-> (/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
js/Math.round (max 0) (min (dec w)))
(-> (/ (* (- (.-clientY event) (.-top box)) h) (.-height box))
js/Math.round (max 0) (min (dec h)))]))
(defn- pairs [pts] (mapv vec (partition 2 pts)))
(defn- points-text [pts]
(apply str (interpose " " (map (fn [[x y]] (str x "," y)) (pairs pts)))))
;; Which vertex the pointer has captured. A PLAIN atom, not app-db and not a
;; ratom: it is pointer bookkeeping that lives for the length of one drag, it is
;; written on every pointermove, and nothing renders from it — the moves it
;; produces go straight out as `::set-vertex`, which is where the document
;; changes and where re-frame belongs.
(defonce ^:private dragging (atom nil))
(defn- editing
"The selected node when it is a polygon on screen, however deep it is nested,
as `[sid id geom active-key editable? frame matrix]`: its own frame, and the
matrix from its coordinates to the stage's. See `::sub/selected-local`."
[]
(let [[sid id n] @(rf/subscribe [::sub/selected-node])
{:keys [frame matrix]} @(rf/subscribe [::sub/selected-local])]
(when (and (:paint? n) matrix)
(let [geom (get-in n [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))]
[sid id geom active
;; A frame between two drawing keys with a tween running has no vertices
;; of its own to move: what is on screen there is interpolated, and
;; dragging it would silently edit the key behind it instead.
(or (not= :linear (channel/segment-interp geom active))
(contains? (:keys geom) frame))
frame matrix]))))
(defn- through
"Flat points `pts` through matrix `m`."
[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- ghost
"Where a drag out of the pool would land: the outline of its first frame,
dashed, and a cross on the middle it will pivot about, which goes under the
pointer. Drawn from the drag's own outline rather than by resolving anything,
so hovering costs one re-render and no evaluation. The cross is always drawn: a
face symbol is a fraction of a pixel until what places it scales it up, and
then it is the only thing to see."
[]
(let [{:keys [where point]} @(rf/subscribe [::sub/drop])
{:keys [shapes center]} @drag/carrying]
(when (and (= :stage where) point)
(let [[x y] (drag/pos-for point)
[cx cy] (or center [0 0])]
[:g.ghost {:transform (str "translate(" x "," y ")")}
(doall
(map-indexed
(fn [i {:keys [kind pts cx cy r size]}]
(case kind
:poly ^{:key i} [:polygon {:points (points-text pts)}]
:disc ^{:key i} [:circle {:cx cx :cy cy :r r}]
:rect ^{:key i} [:rect {:x (- cx (/ size 2)) :y (- cy (/ size 2))
:width size :height size}]
nil))
shapes))
[:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5)
" M " cx " " (- cy 5) " V " (+ cy 5))}]]))))
(defn- overlay [w h]
(let [tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])
drawing? (= :polygon tool)
[sid id geom active editable? frame matrix] (editing)
pts (when geom (through matrix (channel/value-at geom frame)))]
[:svg {:class (str "paint-overlay" (when drawing? " drawing"))
:width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h)
:on-pointer-down (fn [event]
(when drawing?
(let [[x y] (stage-point event w h)]
(rf/dispatch [::ui/add-draft-point x y]))))
:on-pointer-move (fn [event]
;; Back through the inverse of what the handle was
;; drawn through, into the shape's own coordinates.
(when-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))])))
:on-pointer-up (fn [_] (reset! dragging nil))
:on-pointer-cancel (fn [_] (reset! dragging nil))}
[ghost]
(when (seq draft)
[:polyline {:points (points-text draft) :fill "none"
:stroke "#d0ba86" :stroke-width 1}])
(when (and id pts (not drawing?) (not (channel/nothing? pts)))
[:g
[:polygon {:points (points-text pts) :fill "none"
:stroke "#e6ca8b" :stroke-width 1}]
(when-let [inv (when editable? (nest/invert matrix))]
(doall
(for [[i [x y]] (map-indexed vector (pairs pts))]
^{:key i}
[:circle {:cx x :cy y :r 2.6 :fill "#fff1be"
:stroke "#161820" :stroke-width 0.7
:on-pointer-down
(fn [event]
(.stopPropagation event)
(.preventDefault event)
(.setPointerCapture (.-currentTarget event)
(.-pointerId event))
(reset! dragging [sid id active i inv]))}])))])]))
(defn view []
;; Reactive on the clip's dimensions, so selecting a clip of another size
;; resizes the canvas. `ui/canvas` guards the width assignment — which
;; reallocates the backing store — so this re-rendering costs nothing per frame.
(let [w @(rf/subscribe [::playback/width])
h @(rf/subscribe [::playback/height])
frame @(rf/subscribe [::playback/frame])]
[:div.stage-area
[:div.stage-wrap
;; 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.
;; `dragenter` is cancelled as well as `dragover`: a drop target has to
;; accept on BOTH, and the element under the pointer changes whenever the
;; preview re-renders beneath it, which fires a fresh `dragenter`.
{:on-drag-enter (fn [^js event] (when (drag/accepts?) (.preventDefault event)))
:on-drag-over (fn [^js event]
(when (drag/accepts?)
(.preventDefault event)
(drag/hover! :stage frame (stage-point event w h))))
:on-drag-leave (fn [^js event]
(when-not (.contains (.-currentTarget event) (.-relatedTarget event))
(rf/dispatch [::ui/drop-clear])))
:on-drop (fn [^js event]
(.preventDefault event)
(drag/land! frame (stage-point event w h)))}
[:canvas.stage {:ref #(player/set-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}]
[overlay w h]]]))

View file

@ -0,0 +1,30 @@
(ns arthur.ui.tabs
"The open symbols, one tab each, above the stage.
A tab is a symbol and nothing else — there is no document tab and no special
first one, because no symbol is special. Double-clicking a symbol in the pool,
or an instance's row in the timeline, opens it here."
(:require [arthur.domain.clip :as clip]
[arthur.events.playback :as pb]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]))
(defn view []
(let [document @(rf/subscribe [::render/clip])
tabs @(rf/subscribe [::sub/tabs])
open @(rf/subscribe [::render/open])]
[:div.tabs
(doall
(for [sid tabs :when (clip/symbol document sid)]
^{:key (str sid)}
[:div {:class (str "tab" (when (= sid open) " on"))
:title (str sid)
:on-click #(rf/dispatch [::pb/open-symbol sid])}
[:span.name (clip/symbol-name document sid)]
(when (< 1 (count tabs))
[:button.close {:title "close this tab"
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::pb/close-tab sid]))}
"×"])]))]))

View file

@ -0,0 +1,416 @@
(ns arthur.ui.timeline
"The bottom pane: the transport, a ruler, and a row per node of the open symbol.
`rows` is the whole of the interesting part and it is a PURE function of the
clip, the open symbol and the set of open paths. It flattens the document's two
axes of nesting — parent/child within a symbol, and instance of another
symbol — into
one depth-tagged list, which is what lets the labels column and the tracks
column render from the same vector and therefore stay aligned without measuring
anything.
EVERY FRAME NUMBER A ROW CARRIES IS IN THE OPEN SYMBOL'S FRAME SPACE. A node's
keys are in its own frames, and drawing them against the ruler unmapped would
put a key under the wrong frame — silently, and most convincingly when the
node starts at 0. So the walk carries a `->open` function and composes one more
mapping into it at each level: the inverse of the node's time map,
`local = rate·(parent − at)`, so `parent = at + local/rate`.
WHAT IT DOES NOT DO YET: a looping instance repeats its symbol, and only the
first pass is drawn. An expanded loop therefore shows keys where they first
happen and not where they happen again."
(:require [clojure.string :as str]
[arthur.domain.node :as node]
[arthur.events.playback :as pb]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.drag :as drag]
[arthur.ui.player :as player]
[re-frame.core :as rf]
[reagent.core :as r]))
;; ---------------------------------------------------------------------------
;; the rows
(defn- local->parent
"The inverse of a node's time map: where a frame of its OWN time sits in the
symbol it lives in. See `node/time-of`.
Two frame spaces meet at every node and mixing them up is the bug this exists
to prevent: a placement `:at 48` whose scale is keyed at 0 has that key on
frame 48 of the symbol it is in, and drawing it at 0 puts every placement's
keys in the same place however staggered they are.
Exposure is not inverted, because it is a floor and has no inverse: a key on a
frame the exposure grid never samples is still authored on that frame, and that
is where the row should show it."
[n]
(let [{:keys [at rate]} (node/time-of n)]
(if (and (zero? at) (= 1 rate))
identity
(fn [f] (js/Math.round (+ at (/ f rate)))))))
(defn- keyed-frames [ch] (some-> (:keys ch) keys sort))
(defn- node-label
"What to call a node in the label column.
A placement's id is a uuid and an authored node's is a keyword, and neither
reads as a name: `(str id)` gives `:face-1` with the colon still on it, or
thirty-six characters of hex that push the column open. `:name` when there is
one, and a legible stand-in when there is not."
[id n]
(or (:name n)
(if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))
(defn- channel-rows [n path depth ->open span]
(for [[cpath ch] (sort-by (comp str key) (node/channels n))]
{:path (conj path cpath)
:depth depth
:label (str/join " " (map name cpath))
:kind :channel
:select nil
:span (when (or (:dense ch) (seq (:keys ch))) span)
:keys (mapv ->open (keyed-frames ch))
:dense? (boolean (:dense ch))}))
(defn rows
"The visible rows of symbol `sid`, outermost first. `expanded` is a set of row
paths."
[clip sid expanded]
(letfn [(walk [sid path depth ->open]
(let [sym (get-in clip [:symbols sid])
ordered (->> (:nodes sym)
;; Front-most at the top, as a layer list is drawn
;; everywhere. `:z` is the lexicographic draw key;
;; the id breaks ties so the order is stable.
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]))
reverse)]
(into []
(mapcat
(fn [[id n]]
(let [rpath (conj path id)
open? (contains? expanded rpath)
channels (node/channels n)
;; The span is in the PARENT's space and the channels
;; are in the node's own, so they take different
;; mappings. `self` is also what the instance's
;; symbol is resolved in — `clip/resolver` roots the
;; child at this node's local frame — so the nested
;; walk carries it down unchanged.
self (comp ->open (local->parent n))
span (mapv ->open
(or (node/placed-span
(cond-> n
(and (= :instance (:kind n)) (nil? (:span n)))
(assoc :span [0 (get-in clip [:symbols (:of n) :frames])])))
[0 (:frames sym)]))
row {:path rpath
:depth depth
:label (node-label id n)
:kind :node
:node-kind (:kind n)
:of (:of n)
:select [:node sid id rpath]
:expandable? true
:expanded? open?
:span span
:keys (into [] (comp (mapcat keyed-frames)
(map self)
(distinct))
(vals channels))
:dense? (boolean (some :dense (vals channels)))}]
(if-not open?
[row]
(-> [row]
(into (channel-rows n rpath (inc depth) self span))
(into (when (= :instance (:kind n))
(walk (:of n) rpath (inc depth) self)))))))
ordered))))]
(if (get-in clip [:symbols sid])
(walk sid [] 0 identity)
[])))
;; ---------------------------------------------------------------------------
;; geometry
;;
;; Percentages, so nothing has to measure the track column. A frame f occupies
;; [f/frames, (f+1)/frames), and a mark that names one frame sits at its centre.
(defn- at% [f frames] (str (* 100 (/ (+ f 0.5) (max 1 frames))) "%"))
(defn- edge% [f frames] (str (* 100 (/ f (max 1 frames))) "%"))
(defn- frame-at
"Which frame the pointer is over."
[^js event frames]
(let [box (.getBoundingClientRect (.-currentTarget event))
x (- (.-clientX event) (.-left box))]
(-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames)))))
;; ---------------------------------------------------------------------------
;; the panes
(defn- transport []
(let [playing? @(rf/subscribe [::playback/playing?])
rate @(rf/subscribe [::playback/rate])
frame @(rf/subscribe [::playback/frame])
frames @(rf/subscribe [::render/frames])
{:keys [fps drop]} @player/meter]
[:div.pane-head
[:button {:on-click #(rf/dispatch [::pb/toggle])} (if playing? "pause" "play")]
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"]
[:button {:on-click #(rf/dispatch [::pb/step -1])} "-1"]
[:button {:on-click #(rf/dispatch [::pb/step 1])} "+1"]
[:button {:class (when @(rf/subscribe [::playback/loop?]) "on")
:on-click #(rf/dispatch [::pb/toggle-loop])} "loop"]
[:button {:class (when @(rf/subscribe [::playback/muted?]) "on")
:on-click #(rf/dispatch [::pb/toggle-mute])} "mute"]
(doall
(for [r [0.25 0.5 1.0 2.0 4.0]]
^{:key r}
;; playbackRate on the audio element and nothing else: the sound slows,
;; currentTime advances proportionally, and the derived frame follows. Slow
;; motion cannot desync by construction.
[:button {:class (when (== r rate) "on")
:on-click #(rf/dispatch [::pb/set-rate r])}
(case r 1.0 "1x" 0.5 "½" 0.25 "¼" 2.0 "2x" 4.0 "4x" (str r))]))
[:button {:title "a new empty symbol inside the selected instance, or beside the selected node, or in the open symbol"
:on-click #(rf/dispatch [::ui/new-symbol])}
"+ symbol"]
[:span.spacer]
[:span.dim (str frame " / " frames)]
;; Measured in the loop, not derived from the clock — the whole question
;; while profiling is whether the painting keeps up with the clock, and a
;; number computed FROM the clock would answer itself.
[:span {:class (if (and drop (> drop 1.35)) "warn" "dim")}
(str (.toFixed (or fps 0) 1) " paint/s"
(when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]]))
(defn- takes?
"Whether the row at `target` can take the row being carried: not itself, and
not anything inside it."
[target]
(when-let [from (drag/row)]
(not= from (subvec target 0 (min (count from) (count target))))))
(defn- zone
"Which part of a row the pointer is over: its top edge, to go in front of it;
its bottom edge, to go behind; its middle, to go into it or be grouped with it."
[^js e]
(let [box (.getBoundingClientRect (.-currentTarget e))
y (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))]
(cond (< y 0.3) :front (> y 0.7) :back :else :into)))
(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of]}
selection over solo]
(let [node? (= :node kind)
[over-path where] @over]
[:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
(when (= :ghost kind) " ghost")
(when (= path over-path)
(case where
:front " drop-front"
:back " drop-back"
(if (= :instance node-kind) " drop-into" " drop-group"))))
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
:title label
:on-click #(when select (rf/dispatch [::ui/select select]))
;; An instance's row opens the symbol it places, as a tab.
:on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))}
;; A node's row can be dragged onto another: onto an instance's, to
;; go inside the symbol it places; onto any other node's, to be
;; grouped with it into a new one; onto an edge of either, to be
;; restacked in front of it or behind it, in whichever symbol it is
;; in. All of them keep the picture as it is, but for the stacking.
node? (merge {:draggable true
:on-drag-start (fn [^js e]
(.stopPropagation e)
(.setData (.-dataTransfer e) "text/plain" "row")
(set! (.. e -dataTransfer -effectAllowed) "move")
(drag/row! path))
:on-drag-end (fn [_] (reset! over nil) (drag/done!))
:on-drag-enter (fn [^js e] (when (takes? path) (.preventDefault e)))
:on-drag-over (fn [^js e]
(when (takes? path)
(.preventDefault e)
(.stopPropagation e)
(set! (.. e -dataTransfer -dropEffect) "move")
(let [o [path (zone e)]]
(when (not= o @over) (reset! over o)))))
:on-drop (fn [^js e]
(.preventDefault e)
(.stopPropagation e)
(let [from (when (takes? path) (drag/row))
where (zone e)]
(reset! over nil)
(drag/done!)
(when from
(rf/dispatch
(cond
(not= :into where) [::ui/restack from path (= :front where)]
(= :instance node-kind) [::ui/move-node from path]
:else [::ui/group [from path]])))))}))
[:button.tl-twist
{:disabled (not expandable?)
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/toggle-row path]))}
(when expandable? (if expanded? "▾" "▸"))]
[:span.name label]
(when node? [:span.kind (str "·" (name node-kind))])
(when (= :instance node-kind)
[:button {:class (str "tl-solo" (when (contains? solo path) " on"))
:title "show only this on the stage (⇧ for more than one)"
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/solo path (.-shiftKey e)]))}
"S"])
(when (and node? (= select selection))
[:button.tl-delete {:title "delete, with everything in it (⌫)"
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/delete-selected]))}
"×"])]))
(defn- track-cell
"`sliding` is the pointer's side of a bar being dragged, `{:path :x :width
:df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every
row and the stage are drawn from already has in it."
[{:keys [path span keys dense? kind select]} frames sliding]
(let [{from :path x0 :x width :width} @sliding
slide (fn [^js e]
(when (= path from)
(let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))]
(when (not= df (:df @sliding))
(swap! sliding assoc :df df)
(rf/dispatch [::ui/sliding path df])))))
done (fn [commit?]
(when (= path from)
(let [df (:df @sliding)]
(reset! sliding nil)
(rf/dispatch (if commit? [::ui/slide path df] [::ui/sliding nil])))))]
[:div.tl-track
;; The track, not the bar, holds the pointer while a bar slides, so the drag
;; goes on when the bar has slid off the ruler and is no longer drawn.
{:on-pointer-move slide
:on-pointer-up (fn [e] (slide e) (done true))
:on-pointer-cancel (fn [_] (done false))}
;; Clipped to the ruler: an instance longer than the room left in its
;; symbol still plays its own frames from 0, it is just cut off at the end.
(when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])]
(when (< in out)
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
(when select " movable") (when (= path from) " sliding"))
:style {:left (edge% in frames)
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
:on-pointer-down
(when select
(fn [^js e]
(let [track (.. e -currentTarget -parentElement)]
(.stopPropagation e)
(rf/dispatch [::ui/select select])
(reset! sliding {:path path :x (.-clientX e) :df 0
:width (.-width (.getBoundingClientRect track))})
;; As on the ruler: an enhancement that throws on a pointer
;; the browser has no record of.
(try (.setPointerCapture track (.-pointerId e))
(catch :default _ nil)))))}]))
;; A dense channel has a value on every frame, so ticking each one is a solid
;; block that says less than the bar behind it already does.
(when-not dense?
(doall
(for [f keys :when (and (<= 0 f) (< f frames))]
^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))]))
(defn view []
(r/with-let [scrubbing (r/atom false)
;; The row a carried row is over and which part of it, for the
;; highlight.
over (r/atom nil)
sliding (r/atom nil)]
(let [clip @(rf/subscribe [::render/clip])
frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
frame @(rf/subscribe [::playback/frame])
selection @(rf/subscribe [::sub/selection])
expanded @(rf/subscribe [::sub/expanded])
drop @(rf/subscribe [::sub/drop])
solo (set @(rf/subscribe [::render/solo]))
;; Where a drag out of the pool would land, as a row of its own at the
;; top: its own length, starting on the frame it would start on. The
;; stage's drop shows it too, at the playhead.
visible (cond->> (rows clip @(rf/subscribe [::render/open]) expanded)
drop (cons {:path [::drop] :depth 0 :kind :ghost
:label (str "+ " (:label drop))
:span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]
:keys []}))
;; Roughly ten labels, on a round number of frames.
step (* 10 (js/Math.ceil (/ frames 100)))]
[:section.pane.time
[transport]
[:div.tl-body
[:div.tl-labels
;; Empty label space takes a row back out to the top of the open symbol.
{:on-drag-over (fn [^js e]
(when (drag/row)
(.preventDefault e)
(set! (.. e -dataTransfer -dropEffect) "move")))
:on-drop (fn [^js e]
(.preventDefault e)
(when-let [from (drag/row)]
(drag/done!)
(reset! over nil)
(when (< 1 (count from))
(rf/dispatch [::ui/move-node from []]))))}
[:div.tl-corner]
(doall (for [row visible]
^{:key (str (:path row))} [label-cell row selection over solo]))]
[:div.tl-tracks
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
:on-drag-over (fn [^js e]
(when (drag/accepts?)
(.preventDefault e)
(drag/hover! :timeline (frame-at e frames) nil)))
:on-drag-leave (fn [^js e]
(when-not (.contains (.-currentTarget e) (.-relatedTarget e))
(rf/dispatch [::ui/drop-clear])))
;; In its own coordinates: dropped in time, nowhere in particular in
;; space, so what was drawn at a place stays at that place.
:on-drop (fn [^js e]
(.preventDefault e)
(drag/land! (frame-at e frames) nil))
;; Five frames as a percentage of the whole span, handed to the
;; stylesheet so the frame grid can be a repeating background instead
;; of a div per frame. A 900-frame take is 900 elements nobody needs.
:style {"--tick" (str (* 100 (/ 5 frames)) "%")}}
[:div.tl-ruler
{:on-pointer-down (fn [^js e]
(rf/dispatch [::pb/seek (frame-at e frames)])
(reset! scrubbing true)
;; Capture is what keeps a drag scrubbing once it
;; leaves the ruler, and it is an ENHANCEMENT: it
;; throws on a pointer id the browser does not have
;; an active pointer for, which is every event
;; `test/browser` synthesises. Seeking already
;; happened, so the catch loses the drag and nothing
;; else — where letting it throw would put an
;; uncaught error on the console that the suite
;; rightly fails on.
(try
(.setPointerCapture (.-currentTarget e) (.-pointerId e))
(catch :default _ nil)))
:on-pointer-move (fn [^js e]
(when @scrubbing
(rf/dispatch [::pb/seek (frame-at e frames)])))
:on-pointer-up (fn [_] (reset! scrubbing false))
:on-pointer-cancel (fn [_] (reset! scrubbing false))}
(doall
(for [f (range 0 frames step)]
^{:key f} [:div.tick {:style {:left (edge% f frames)}} f]))
[:div.tl-knob {:style {:left (at% frame frames)}}]]
(if (seq visible)
(doall (for [row visible]
^{:key (str (:path row))} [track-cell row frames sliding]))
[:div.tl-empty "nothing in this symbol"])
[:div.tl-playhead {:style {:left (at% frame frames)}}]]]])))

View file

@ -0,0 +1,80 @@
(ns arthur.ui.topbar
"The strip across the top: what document this is, and the three things you can
do to the whole of it.
Save, open and export are here rather than in a pane because none of them is a
property of a selection — they act on the document, and the document is the
window."
(:require [arthur.events.collab :as collab]
[arthur.events.export :as export]
[arthur.events.project :as project]
[arthur.subs.playback :as playback]
[arthur.ui.openmenu :as openmenu]
[arthur.ui.share :as share]
[arthur.ui.snapshots :as snapshots]
[arthur.ui.undo :as undo]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- exporter [open?]
(let [{:keys [target zoom busy? done total]} @(rf/subscribe [::export/state])
targets @(rf/subscribe [::export/targets])]
[:<>
[:button {:disabled busy? :on-click #(reset! open? true)} "export…"]
(when @open?
[:<> [:div.export-scrim {:on-click #(when-not busy? (reset! open? false))}]
[:section.export-dialog {:role "dialog" :aria-modal true :aria-label "Export"}
[:h2 "Export"]
[:label.export-field "what to render"
[:select {:value (export/target-value target) :disabled busy?
:on-change #(rf/dispatch [::export/set-target
(export/target-id (.. % -target -value))])}
(doall (for [{:keys [label] :as t} targets]
^{:key (export/target-value t)}
[:option {:value (export/target-value t)}
(str (when (:isolate t) "· ") label)]))]]
[:label.export-field "scale"
[:select {:value zoom :disabled busy?
:on-change #(rf/dispatch [::export/set-zoom
(js/parseInt (.. % -target -value) 10)])}
(doall (for [z export/zooms] ^{:key z} [:option {:value z} (str z "×")]))]]
[:p.dim "PNG sequence and audio in a ZIP archive"]
[:div.row
[:button {:disabled busy? :on-click #(rf/dispatch [::export/start])}
(if busy? (str "rendering " done "/" total) "start export")]
[:button {:disabled busy? :on-click #(reset! open? false)} "close"]]]])]))
(defn view []
(r/with-let [renaming? (r/atom false)
draft (r/atom "")
export-open? (r/atom false)]
(let [{project-name :name :keys [busy? seq status]} @(rf/subscribe [::playback/project])
{footage-status :status} @(rf/subscribe [::playback/footage])
{export-status :status} @(rf/subscribe [::export/state])
title (or project-name "untitled")
commit! (fn []
(rf/dispatch [::project/rename @draft])
(reset! renaming? false))]
[:header.top
[:a.brand {:href "/" :title "your projects"
:on-click (fn [e] (.preventDefault e) (collab/navigate! "/"))} "arthur"]
[:button {:disabled busy? :on-click #(rf/dispatch [::collab/create])} "new"]
[openmenu/view]
[undo/view]
[snapshots/view]
(if @renaming?
[:input.project-name {:auto-focus true :value @draft
:on-change #(reset! draft (.. % -target -value))
:on-blur (fn [_] (commit!))
:on-key-down (fn [e]
(case (.-key e)
"Enter" (do (.preventDefault e) (commit!))
"Escape" (reset! renaming? false)
nil))}]
[:button.project-title {:disabled busy? :title "click to rename project"
:on-click (fn [] (reset! draft title)
(reset! renaming? true))}
title (when seq (str " r" seq))])
[:span.status (or export-status status footage-status)]
[exporter export-open?]
[share/view]])))

View file

@ -0,0 +1,32 @@
(ns arthur.ui.undo
"Undo, redo, and the list of what undo would take off — newest first, so
choosing the third row undoes three steps."
(:require [arthur.events.history :as history]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn view []
(r/with-let [open? (r/atom false)]
(let [{:keys [done undone]} @(rf/subscribe [::history/steps])]
[:div.menu-wrap.undo
[:button {:disabled (empty? done) :title (if (seq done) (str "undo " (first done) " (⌘Z)") "nothing to undo")
:on-click #(rf/dispatch [::history/undo])}
"undo"]
[:button.undo-list {:disabled (empty? done) :class (when @open? "on")
:title "undo history" :on-click #(swap! open? not)}
"▾"]
[:button {:disabled (empty? undone) :title (if (seq undone) (str "redo " (first undone) " (⇧⌘Z)") "nothing to redo")
:on-click #(rf/dispatch [::history/redo])}
"redo"]
(when (and @open? (seq done))
[:<> [:div.menu-scrim {:on-click #(reset! open? false)}]
[:div.menu.menu-left
[:h2 "undo"]
(doall
(map-indexed
(fn [i label]
^{:key i}
[:button.menu-item {:on-click (fn [] (reset! open? false)
(rf/dispatch [::history/undo (inc i)]))}
label (when (pos? i) [:span.sub (str (inc i) " steps")])])
(take 30 done)))]])])))

View file

@ -13,7 +13,7 @@
[arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.timeline :as timeline]))
[arthur.domain.symbol :as symbol]))
(defn- ms [label n f]
(let [t0 (js/Date.now)]
@ -24,11 +24,11 @@
(/ dt n))))
(deftest bench
(let [res (timeline/resolver (clip/root @swarm/clip) @swarm/store pal/index-of)
(let [res (symbol/resolver (clip/symbol @swarm/clip :main) @swarm/store pal/index-of)
ras (raster/make 320 200)
dest (js/Uint8ClampedArray. (* 320 200 4))
n 120]
(println "\nswarm:" (count (clip/nodes @swarm/clip)) "nodes")
(println "\nswarm:" (count (:nodes (clip/symbol @swarm/clip :main))) "nodes")
(let [a (ms "resolve " n (fn [i] (res (mod i 229))))
b (ms "resolve+draw " n (fn [i]
(raster/clear! ras 0)

View file

@ -0,0 +1,26 @@
(ns arthur.domain.bring-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
[]
(-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
(deftest adopting-symbols-renames-what-collides
(let [here (nested)
there (-> (clip/blank)
(assoc-in [:symbols :inner] {:id :inner :frames 4 :nodes {}})
(clip/place-symbol nil :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" nil))
{:keys [clip ids]} (bring/symbols here there [:main] {:main :take})]
(is (= {:main :take :inner :inner-2} ids)
"the root gets the name asked for; a taken id gets the next free one")
(is (= 10 (clip/frames clip :inner)) "what was already here is untouched")
(is (= :inner-2 (:of (first (vals (get-in clip [:symbols :take :nodes])))))
"and the copy's instance follows its renamed symbol")
(is (empty? (clip/problems clip)))))

View file

@ -11,14 +11,14 @@
{:subjects (into {} (map (fn [id] [id {:id id :params {}}]) people))
:features (into {} (map-indexed (fn [i id]
[id {:id id :subject (nth people (quot i 2))
:timeline (nth people (quot i 2))
:symbol (nth people (quot i 2))
:area :eye :nodes [] :params {}}]) eyes))
:groups (into {} (map-indexed (fn [i ids]
(let [id (keyword (str "pair-" i))]
[id {:id id :kind :eye-pair
:subject (nth people i)
:members ids :params {}}])) members))
:timelines (into {} (map (fn [id]
:symbols (into {} (map (fn [id]
[id {:id id :frames 1
:nodes {:head {:id :head :kind :group :z "a1"
:measured {[:xform :rot]

View file

@ -0,0 +1,74 @@
(ns arthur.domain.history-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.history :as history]))
(def empty-doc {"t" 1})
(deftest undo-and-redo-walk-your-own-steps
(let [made (assoc empty-doc "b" :shape)
moved (assoc made "b" :moved)
h (-> nil
(history/record empty-doc made 0)
(history/record made moved 5000))
one (history/undo h moved)
two (history/undo (:history one) (:leaves one))]
(is (= made (:leaves one)))
(is (= empty-doc (:leaves two)))
(is (nil? (history/undo (:history two) (:leaves two))))
(is (= made (:leaves (history/redo (:history two) (:leaves two)))))))
(deftest a-drag-is-one-step
(let [h (reduce (fn [h [x t]] (history/record h {"v" (dec x)} {"v" x} t))
nil [[1 0] [2 100] [3 200]])]
(is (= 1 (count (:done h))))
(is (= {"v" 0} (:leaves (history/undo h {"v" 3}))))))
(deftest typing-into-a-field-is-one-step-however-slow
(let [h (-> nil
(history/record {"w" 1} {"w" 2} 0)
history/hold
(history/record {"w" 2} {"w" 4} 100)
(history/record {"w" 4} {"w" 45} 9000)
history/settle
(history/record {"w" 45} {"w" 46} 9100))]
(is (= 3 (count (:done h))) "the edit before focus and the one after blur stand apart")
(is (= {"w" 2} (:leaves (history/undo (:history (history/undo h {"w" 46})) {"w" 45}))))))
(deftest their-write-between-two-of-mine-keeps-them-apart
(let [h (-> nil
(history/record {"fps" 30} {"fps" 12} 0)
;; theirs lands: 12 -> 9, not recorded
(history/record {"fps" 9} {"fps" 15} 300))]
(is (= 2 (count (:done h))))
(is (= {"fps" 9} (:leaves (history/undo h {"fps" 15}))))))
(deftest undo-never-takes-somebody-elses-work
(testing "I make b; they edit it; I edit it; I undo twice"
(let [made {"b" :shape}
theirs {"b" :their-edit}
mine {"b" :my-edit}
h (-> nil
(history/record {} made 0)
;; their edit arrives as a remote write: not recorded
(history/record theirs mine 5000))
one (history/undo h mine)
two (history/undo (:history one) (:leaves one))]
(is (= theirs (:leaves one)) "my edit comes off, theirs is what is left")
(is (:blocked two) "removing b would remove their edit, so it is refused")
(is (empty? (:done (:history two))) "and the refused step is dropped"))))
(deftest a-new-edit-clears-redo
(let [h (history/record nil {} {"a" 1} 0)
u (history/undo h {"a" 1})
h (history/record (:history u) (:leaves u) {"c" 1} 9000)]
(is (nil? (history/redo h {"c" 1})))))
(deftest a-step-says-what-it-was
(let [node "clip/u/symbol/main/node/b"
pts "clip/u/symbol/main/channel/b/geom.pts"
made {node {:id :b :name "shape 3"} pts :p}]
(is (= "add shape 3" (history/label {} made [node pts])))
(is (= "edit shape 3" (history/label made (assoc made pts :q) [pts])))
(is (= "delete shape 3" (history/label made {} [node pts])))
(is (= "project settings" (history/label {} {"clip/u/timing" {:fps 9}} ["clip/u/timing"])))
(is (= ["add shape 3"] (:done (history/steps (history/record nil {} made 0)))))))

View file

@ -0,0 +1,291 @@
(ns arthur.domain.instance-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.stage :as stage]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.pose :as pose]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]))
(def source
{:name "source" :fps 30 :width 320 :height 200
:symbols
{:main {:id :main :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
2 [20 0] 3 [30 0]})
[:geom :size] (ch/framed 4)
[:style :color] (ch/framed :brow)}}}}}})
(deftest two-instances-own-their-frame-and-placement
(let [document
(-> source
(assoc-in [:symbols :main]
{:id :main :frames 6
:nodes {:root {:id :root :kind :group :z "a1"}
:left {:id :left :kind :instance :of :sym/test
:parent :root :z "a1" :span [0 4]
:channels {[:xform :pos] (ch/framed [100 50])}}
:right {:id :right :kind :instance :of :sym/test
:parent :root :z "a2" :span [0 4]
:time {:mode :map :at 2 :rate 1}
:channels {[:xform :pos] (ch/framed [120 50])}}}})
(assoc-in [:symbols :sym/test]
(assoc (get-in source [:symbols :main]) :id :sym/test)))
resolve (clip/resolver document nil pal/index-of :main)
at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
(is (empty? (clip/problems document)))
(is (= [[[:left :mark] 110]] (at 1)))
(is (= [[[:left :mark] 120] [[:right :mark] 120]] (at 2)))
(is (= [[[:right :mark] 150]] (at 5)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(deftest a-placement-holds-and-cuts-each-generated-shape-independently
(let [values (js/Int16Array. (clj->js (range 2 32)))
visible (ch/keyed {0 true 20 true 21 false})
dense {:animated? true :interp :hold
:dense {:store "sizes" :offset 0 :stride 1 :frames 30}
:pose-sampled? true}
shape (fn [id z group]
{:id id :kind :rect :parent :root :z z :pose-group group
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]})
[:geom :size] dense
[:vis] (assoc visible :pose-sampled? true)
[:style :color] (ch/framed :brow)}})
symbol {:id :sym/poses :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:mouth (shape :mouth "a1" :mouth)
:mouth-detail (shape :mouth-detail "a2" :mouth)
:eye (shape :eye "a3" :eye)
:brow (shape :brow "a4" :brow)}}
document {:fps 30 :width 320 :height 200
:symbols
{:main {:id :main :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:first {:id :first :kind :instance :of :sym/poses
:parent :root :z "a1"
:playback {:tracks {:mouth {0 0, 8 20, 9 21}
[:node :mouth-detail] {0 0, 8 4}
:eye {0 0, 4 4}}}}
:second {:id :second :kind :instance :of :sym/poses
:parent :root :z "a2"
:playback {:tracks {:mouth {0 0, 8 8}}}}}}
:sym/poses symbol}}
resolve (clip/resolver document {"sizes" {:data values}} pal/index-of :main)
low-resolve (clip/resolver document {"sizes" {:data values}}
pal/index-of :main {:picture-fps 8})
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))
low-at (fn [f] (into {} (map (fn [op] [(:node op) op])) (low-resolve f)))]
(is (empty? (clip/problems document)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (= 2 (:size (get (at 7) [:first :mouth]))) "eight static frames")
(is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20")
(is (= 6 (:size (get (at 8) [:first :mouth-detail])))
"one node may depart from its shared mouth group")
(is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8")
(is (= 6 (:size (get (at 7) [:first :eye]))) "eye has its own timing")
(is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time")
(is (nil? (get (at 9) [:first :mouth]))
"generated visibility is read from the same selected pose")
(is (some? (get (at 9) [:second :mouth])))
(is (= 5 (:size (get (low-at 7) [:first :brow])))
"picture rate samples only generated motion")
(is (= 22 (:size (get (low-at 8) [:first :mouth])))
"an explicit cut occurs at its exact local frame, even off the picture grid")
(is (= 8 (:cx (get (low-at 8) [:first :eye])))
"authored position ignores the picture grid")
(let [sym (get-in document [:symbols :sym/poses])
opts {:source-fps 30 :picture-fps 8}]
(is (= (mapv #(select-keys % [:node :cx :size])
(symbol/eval-frame sym 8 {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts))
(mapv #(select-keys % [:node :cx :size])
((symbol/resolver sym {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts) 8)))
"pure evaluation and playback apply the same pose choice"))))
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
(let [document (-> source
(assoc-in [:symbols :main :nodes :placed]
{:id :placed :kind :instance :of :sym/test :parent :root
:z "a2"})
(assoc-in [:symbols :sym/test]
{:id :sym/test :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root
:z "a1" :pose-group :mark
:channels {[:geom :size]
{:animated? true :interp :hold
:keys {0 2 1 3 2 4 3 5}
:pose-sampled? true}}}}})
(pose/put-cut :main :placed :mark 2 3))
cuts (get-in document [:symbols :main :nodes :placed :playback :tracks :mark])]
(is (= {2 3} cuts))
(is (= 1 (pose/source-frame (pose/prepare {:mark cuts}) :mark 1 1))
"before the first cut, dense motion continues")
(is (= 3 (pose/source-frame (pose/prepare {:mark cuts}) :mark 2 2)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (nil? (get-in (pose/remove-cut document :main :placed :mark 2)
[:symbols :main :nodes :placed :playback :tracks :mark])))
(is (seq (clip/problems (assoc-in document
[:symbols :main :nodes :placed :playback :tracks :mark]
{4 3}))))))
(defn- uuid-of
"The uuid the layout authors for the placement whose handle is `id`.
Read out of `stage/layout` rather than written here as a literal: what this test
is about is the mapping `compose` performs, and nine copied uuids would assert
that someone copied them correctly."
[id]
(or (->> (concat (:instances stage/layout) (:audio stage/layout))
(some (fn [p] (when (= id (:id p)) (:uuid p)))))
(throw (ex-info "no such placement in the layout" {:id id}))))
(defn- placement
"The composed node for the placement the layout calls `id`."
[document id]
(get-in document [:symbols :main :nodes (uuid-of id)]))
(deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)]
(is (empty? (clip/problems document)))
(is (= #{:main :sym/face-8625} (set (keys (:symbols document)))))
(is (= :sym/face-8625 (:of (placement document :left))))
(is (= :sym/face-8625 (:of (placement document :right))))
(testing "every placement is keyed by its own uuid"
;; The identity change: seven placements of one drawing are seven things,
;; and each is named by something that means only itself. Sharing a key, or
;; keying by a description of where a thing sits, is what this rules out.
(let [symbols (filter (comp #{:instance} :kind val)
(get-in document [:symbols :main :nodes]))]
(is (= 7 (count symbols)))
(is (every? uuid? (map key symbols)))
(is (= 7 (count (distinct (map key symbols)))))
(testing "and each still says which drawing it plays and what to call it"
(is (every? #(= :sym/face-8625 (:of (val %))) symbols))
(is (every? #(string? (:name (val %))) symbols))
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :instance (:kind %))
(vals (get-in document [:symbols :main :nodes]))))))
(is (= [0 232] (:span (placement document :right))) "its own frames, from its own 0")
(is (= [48 280] (node/placed-span (placement document :right))) "and where that sits on the stage")
(let [left (placement document :left)
scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0)]
(is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0)))
(is (= [0.56 0.56] (ch/value-at scale 12)))
(is (= [0.52 0.52] (ch/value-at scale 48)))
(doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f) [0 0] anchor)
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales"))))
(testing "the editorial link resolves to the placement's uuid"
;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
;; resolves to a node at all; this checks it resolves to the RIGHT one.
(is (= (uuid-of :right) (:linked-to (placement document :voice-right))))
(is (uuid? (:linked-to (placement document :voice-right)))))
(is (= [48 260] (node/placed-span (placement document :voice-right))))
(is (= 0.5 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :gain]]) 54)))
(is (< -0.8 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :pan]]) 110) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
[]
(-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
(deftest no-symbol-is-special
(let [c (nested)]
(testing "a document opens on the longest symbol nothing places"
(is (= [:loose :main :outer] (clip/unplaced c)))
(is (= :outer (clip/opens-on c)))
(is (= :main (clip/opens-on (clip/blank)))))
(testing "an instance can go into any symbol, and spans that symbol's frames"
(let [[n] (vals (get-in c [:symbols :outer :nodes]))]
(is (= :inner (:of n)))
(is (= [0 10] (:span n)) "its own frames: all of what it places, from its own 0")
(is (= [5 15] (node/placed-span n)) "and where that lands in the symbol it is in")))
(testing "placing is refused when it would make a cycle"
(is (clip/contains-symbol? c :outer :inner))
(is (not (clip/contains-symbol? c :inner :outer)))
(is (= c (clip/place-symbol c nil :inner :outer 0 (random-uuid) nil))
"outer inside inner, which is inside outer")
(is (= c (clip/place-symbol c nil :inner :inner 0 (random-uuid) nil))
"a symbol inside itself"))
(testing "and the result is a valid document whose instance saves"
(is (empty? (clip/problems c)))
(is (= (get-in c [:symbols :outer :nodes])
(get-in (leaf/clip "c" (leaf/leaves "c" c)) [:symbols :outer :nodes]))))))
(deftest a-new-symbol-is-empty-and-placed-where-it-was-asked-for
(let [c (nested)
u #uuid "00000000-0000-4000-8000-000000000001"
id (clip/fresh-id c)
made (clip/new-symbol c :outer id 20 u)]
(is (= :symbol-1 id))
(is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide")
(is (= {:id :symbol-1 :name "symbol-1" :frames 180 :nodes {}}
(clip/symbol made :symbol-1))
"empty, and as long as the rest of what it was placed in")
(is (= {:of :symbol-1 :span [0 180] :time {:mode :map :at 20 :rate 1}}
(select-keys (get-in made [:symbols :outer :nodes u]) [:of :span :time])))
(is (empty? (clip/problems made)))
(is (= c (clip/new-symbol c :outer :inner 0 u)) "an id already in use is refused")
(is (= c (clip/new-symbol c :outer id 200 u)) "past the end is refused")))
(deftest an-instance-span-is-in-its-own-frames
(let [n {:id :i :kind :instance :of :x :z "a1" :span [3 13]
:time {:mode :map :at 40 :rate 2}}]
(is (= [41.5 46.5] (node/placed-span n)) "own frames 3 to 13, at double rate, from 40")
(is (= 0 (node/local-frame n 40)) "the parent's :at is where its own frame 0 lands")
(is (= 8 (node/local-frame n 44)))
(is (= [2 9] (node/placed-span {:kind :poly :span [2 9]}))
"a shape has no time of its own, so its span is already the parent's")
(is (seq (node/problems (assoc-in n [:time :in] 3)))
"a stale :in is reported rather than silently ignored")))
(deftest an-instance-pivots-about-the-middle-of-what-it-draws
(let [square (fn [x y] {:kind :poly :z "a1" :id :sq
:channels {[:geom :pts] (ch/framed [x y (+ x 10) y (+ x 10) (+ y 10) x (+ y 10)])
[:style :color] (ch/framed :brow)}})
c (-> (clip/blank)
(assoc-in [:symbols :box] {:id :box :frames 4 :nodes {:sq (assoc (square 20 30) :id :sq)}})
(assoc-in [:symbols :empty] {:id :empty :frames 4 :nodes {}}))
u #uuid "00000000-0000-4000-8000-0000000000cc"
placed (fn [c sid point] (get-in (clip/place-symbol c nil :main sid 0 u point)
[:symbols :main :nodes u :channels]))]
(is (= [25 35] (clip/center c nil :box)) "the middle of the square")
(is (= [160 100] (clip/center c nil :empty)) "nothing drawn: the stage's middle")
(testing "the anchor is the middle, and it moves nothing at the identity"
(is (= [25 35] (get-in (placed c :box nil) [[:xform :anchor] :value])))
(is (= [0 0] (get-in (placed c :box nil) [[:xform :pos] :value]))
"dropped on the timeline: where it was drawn"))
(testing "dropped on a stage pixel, its middle goes there"
(is (= [75 65] (get-in (placed c :box [100 100]) [[:xform :pos] :value]))))
(testing "and growing the symbol later does not move an instance's pivot"
(let [c (clip/place-symbol c nil :main :box 0 u nil)
grown (assoc-in c [:symbols :box :nodes :sq2] (assoc (square 80 30) :id :sq2 :z "a2"))]
(is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved")
(is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value]))
"the instance's did not")))))

View file

@ -6,7 +6,7 @@
So the assertion is exact equality on the real clips — the frozen take in both
head modes, the hand-written demo, the swarm — rather than on a fixture, and
`clip/clip-keys` plus `timeline/timeline-keys` make a field added without a leaf
`clip/clip-keys` plus `symbol/symbol-keys` make a field added without a leaf
fail loudly instead."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo :as demo]
@ -16,11 +16,11 @@
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]))
(defn- one-timeline
(defn- one-symbol
"A minimal clip holding one timeline of these nodes, for the cases that are
about a path rather than about a take."
[nodes]
{:timelines {:main {:id :main :frames 1 :nodes nodes}}})
{:symbols {:main {:id :main :frames 1 :nodes nodes}}})
(deftest every-real-clip-survives-the-split-exactly
(doseq [[label c] [["the frozen take" @take/clip]
@ -30,6 +30,12 @@
(testing label
(is (= c (leaf/clip :c1 (leaf/leaves :c1 c)))))))
(deftest an-empty-symbol-comes-back-a-symbol
;; No node leaves, and still `:nodes {}`: nil there is what `symbol/nodes-of`
;; refuses, so a saved blank document would not open.
(is (= (get-in (clip/blank) [:symbols :main])
(get-in (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))) [:symbols :main]))))
(deftest the-leaves-are-the-paths-the-sync-design-names
(let [ls (leaf/leaves :c7 @take/clip)]
(is (contains? ls "clip/c7/timing"))
@ -37,20 +43,20 @@
(is (contains? ls "clip/c7/source"))
;; A TIMELINE ID IS A SEGMENT, which is what lets a symbol's nodes be
;; addressed by the same path shape as the clip's own. `main` is the root.
(is (contains? ls "clip/c7/timeline/main"))
(is (= {:frames 229} (get ls "clip/c7/timeline/main"))
(is (contains? ls "clip/c7/symbol/main"))
(is (= {:frames 229} (get ls "clip/c7/symbol/main"))
"a timeline's leaf is its frame space; :fps is the clip's")
;; Nodes are local to the face timeline; feature and group ids are clip-wide.
(is (contains? ls "clip/c7/timeline/face-1/node/mouth"))
(is (contains? ls "clip/c7/timeline/face-1/channel/mouth/geom.pts"))
(is (contains? ls "clip/c7/timeline/face-1/channel/mouth-in/vis"))
(is (contains? ls "clip/c7/symbol/face-1/node/mouth"))
(is (contains? ls "clip/c7/symbol/face-1/channel/mouth/geom.pts"))
(is (contains? ls "clip/c7/symbol/face-1/channel/mouth-in/vis"))
(is (contains? ls "clip/c7/feature/face-1~eye-r"))
(is (contains? ls "clip/c7/group/face-1~eyes"))
(is (contains? ls "clip/c7/subject/face-1"))
;; A head's measured channels are written together by a freeze and replaced
;; together by a re-freeze, so they are one leaf and not three.
(is (contains? ls "clip/c7/timeline/face-1/measured/head"))
(is (= 3 (count (get ls "clip/c7/timeline/face-1/measured/head"))))
(is (contains? ls "clip/c7/symbol/face-1/measured/head"))
(is (= 3 (count (get ls "clip/c7/symbol/face-1/measured/head"))))
;; :frames is NOT in `timing` any more. A timeline is a frame space and a clip
;; is a rate, so the one leaf that held both was the persistence half of the
;; conflation `domain/clip` exists to undo.
@ -60,11 +66,11 @@
;; The boundary that lets two people key different parts without meeting. A node
;; leaf carries structure and no geometry.
(let [ls (leaf/leaves :c1 @take/clip)
n (get ls "clip/c1/timeline/face-1/node/mouth")]
n (get ls "clip/c1/symbol/face-1/node/mouth")]
(is (= {:id :mouth :name "mouth" :kind :poly :parent :head
:z "a1" :pose-group :mouth} n))
(is (nil? (:channels n)))
(is (:animated? (get ls "clip/c1/timeline/face-1/channel/mouth/geom.pts")))))
(is (:animated? (get ls "clip/c1/symbol/face-1/channel/mouth/geom.pts")))))
(deftest a-field-with-no-leaf-is-refused-rather-than-dropped
;; The invariant that keeps the round trip exact as the model grows: a field
@ -74,7 +80,7 @@
(leaf/leaves :c1 (assoc @take/clip :sequences []))))
(is (thrown-with-msg? ExceptionInfo #"no leaf to save it in"
(leaf/leaves :c1 (assoc-in @take/clip
[:timelines :main :markers] []))))
[:symbols :main :markers] []))))
(is (= clip/clip-keys (set (keys (assoc @take/clip :name "x"))))
"clip-keys has drifted from what a frozen clip actually holds"))
@ -86,16 +92,16 @@
(is (not (contains? ls "clip/c1/source")))
(is (not (contains? (leaf/clip :c1 ls) :analysis)))
(is (not (contains? (get-in (leaf/clip :c1 ls)
[:timelines :main :nodes :root])
[:symbols :main :nodes :root])
:channels)))))
(deftest a-namespaced-id-is-one-path-segment
;; docs/architecture.md draws a node as `:eye-r/iris`, and a leaf path is
;; "/"-delimited, so the two have to be reconciled somewhere.
(let [c (one-timeline {:eye-r/iris {:id :eye-r/iris :kind :disc :parent nil :z "a1"
(let [c (one-symbol {:eye-r/iris {:id :eye-r/iris :kind :disc :parent nil :z "a1"
:channels {[:geom :radius] (ch/framed 2)}}})
ls (leaf/leaves :c1 c)]
(is (contains? ls "clip/c1/timeline/main/node/eye-r~iris"))
(is (contains? ls "clip/c1/symbol/main/node/eye-r~iris"))
(is (= c (leaf/clip :c1 ls))))
;; `(keyword "a~b")` rather than a literal: ~ is unquote in CLJS source.
(is (thrown-with-msg? ExceptionInfo #"cannot contain ~"
@ -109,13 +115,13 @@
;; right in a log and resolves nothing: `:linked-to` dangles and an export target
;; matches no node, with no error anywhere.
(let [u #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
c (one-timeline {u {:id u :kind :symbol :of :sym/face-8625 :parent nil
c (one-symbol {u {:id u :kind :instance :of :sym/face-8625 :parent nil
:z "a1" :name "8625 bottom left"}})
ls (leaf/leaves :c1 c)]
(is (contains? ls (str "clip/c1/timeline/main/node/" u))
(is (contains? ls (str "clip/c1/symbol/main/node/" u))
"written plainly, with no sigil")
(is (= c (leaf/clip :c1 ls)))
(is (uuid? (first (keys (get-in (leaf/clip :c1 ls) [:timelines :main :nodes])))))))
(is (uuid? (first (keys (get-in (leaf/clip :c1 ls) [:symbols :main :nodes])))))))
(deftest only-a-whole-canonical-uuid-reads-as-one
;; The id encoding decides by SHAPE, so the boundaries of that shape are the
@ -155,24 +161,24 @@
(is (empty? (leaf/problems (leaf/leaves :c1 @take/locked)))))
(deftest a-channel-leaf-for-a-node-that-is-not-there-is-named
(let [ls (dissoc (leaf/leaves :c1 @take/clip) "clip/c1/timeline/face-1/node/mouth")]
(let [ls (dissoc (leaf/leaves :c1 @take/clip) "clip/c1/symbol/face-1/node/mouth")]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-node-leaf-is-scoped-to-its-own-timeline
(deftest a-node-leaf-is-scoped-to-its-own-symbol
;; The reason the node index in `problems` is keyed by (clip, timeline, node)
;; rather than by node alone: two timelines may each hold a `:mouth`, and a
;; channel of one is not a channel of the other. Keyed by node alone, deleting
;; the root's node leaf would have been excused by the symbol's.
(let [ls (-> (leaf/leaves :c1 @take/clip)
(assoc "clip/c1/timeline/sym~blink" {:frames 3}
"clip/c1/timeline/sym~blink/node/mouth"
(assoc "clip/c1/symbol/sym~blink" {:frames 3}
"clip/c1/symbol/sym~blink/node/mouth"
{:id :mouth :kind :poly :parent nil :z "a1"})
(dissoc "clip/c1/timeline/face-1/node/mouth"))]
(dissoc "clip/c1/symbol/face-1/node/mouth"))]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-property-with-path-punctuation-in-it-is-refused
(is (thrown-with-msg?
ExceptionInfo #"cannot contain . or /"
(leaf/leaves :c1 (one-timeline
(leaf/leaves :c1 (one-symbol
{:a {:id :a :kind :poly :parent nil :z "a1"
:channels {[:geom :pts.x] (ch/framed [0 0])}}})))))

View file

@ -0,0 +1,240 @@
(ns arthur.domain.nest-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]))
(defn- nested
"Three symbols: :outer places :inner, and :loose is placed by nothing."
[]
(-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names
(let [c (nested)
[id] (keys (get-in c [:symbols :outer :nodes]))
at #(select-keys (nest/inside c nil :outer %1 %2) [:sid :frame])]
(is (= {:sid :outer :frame 12} (at [] 12)))
(is (= {:sid :inner :frame 7} (at [id] 12))
"the instance starts at 5, so frame 12 outside is frame 7 inside")
(is (nil? (nest/inside c nil :outer [id] 2))
"and before it starts there is no inside to be in")))
(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn
(let [u #uuid "00000000-0000-4000-8000-0000000000dd"
c (-> (clip/blank)
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
(clip/place-symbol nil :main :box 10 u nil)
;; moved, turned and doubled, so nothing lines up by accident
(update-in [:symbols :main :nodes u :channels] merge
{[:xform :pos] (ch/framed [40 20])
[:xform :rot] (ch/framed (/ js/Math.PI 2))
[:xform :scale] (ch/framed [2 2])}))
drawn [100 50 140 50 120 90]
{:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn)
c (paint/new-shape c sid :shape frame pts :brow)
[op] (filter #(= [u :shape] (:node %))
((clip/resolver c nil pal/index-of :main) 16))]
(is (= :box sid))
(is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10")
(is (every? #(< (js/Math.abs %) 1e-9)
(map - drawn (take 6 (array-seq (:pts op)))))
"resolved back out through the instance, it is exactly what was drawn")))
(deftest a-shape-two-instances-down-is-edited-where-it-is-seen
(let [u #uuid "00000000-0000-4000-8000-0000000000d1"
v #uuid "00000000-0000-4000-8000-0000000000d2"
turn (fn [c host id pos rot k]
(update-in c [:symbols host :nodes id :channels] merge
{[:xform :pos] (ch/framed pos)
[:xform :rot] (ch/framed rot)
[:xform :scale] (ch/framed [k k])}))
c (-> (clip/blank)
(assoc-in [:symbols :mid] {:id :mid :frames 40 :nodes {}})
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
(clip/place-symbol nil :main :mid 10 u nil)
(clip/place-symbol nil :mid :box 2 v nil)
(turn :main u [40 20] (/ js/Math.PI 2) 2)
(turn :mid v [5 -3] 0.3 1.5)
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow))
draw #(take 6 (array-seq (:pts (first (filter (fn [op] (= [u v :shape] (:node op)))
((clip/resolver % nil pal/index-of :main) 16))))))
{:keys [frame matrix time]} (nest/inside c nil :main [u v :shape] 16)
out (js/Float64Array. 2)
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
(partition 2 [0 0 10 0 5 10]))
[x y] (array-seq (node/apply-pt! out 0 (nest/invert matrix) 7 3))
moved (paint/set-vertex c :box :shape frame 0 [x y])
keyed (paint/add-key c :box :shape (:frame (nest/inside c nil :main [u v :shape] 20)))]
(is (= 4 frame) "16 of main is 6 of mid, which is 4 of box and of the shape in it")
(is (= {:at 12 :rate 1} time))
(is (= #{4 8} (set (keys (get-in keyed [:symbols :box :nodes :shape :channels paint/geometry :keys]))))
"a key added at 20 of main lands at 8, the shape's own time")
(is (nil? (nest/inside c nil :main [u v :shape] 13))
"and where the shape is not on screen there is nothing to edit")
(is (every? #(< (js/Math.abs %) 1e-9) (map - (draw c) seen))
"the handles sit on what the stage draws")
(is (every? #(< (js/Math.abs %) 1e-9) (map - [7 3] (take 2 (draw moved))))
"and a vertex dragged to (7, 3) is drawn at (7, 3)")))
(deftest a-placed-symbols-sound-is-heard-where-it-is-placed
(let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1"
:span [10 40] :time {:mode :map :at -10 :rate 1}
:channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}}
c (-> (clip/blank)
(assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}})
(clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil))
[t] (nest/audio-tracks c :main)]
(is (= [10 40] (:span t)) "the same frames of the source")
(is (= [50 80] (node/placed-span t)) "starting where the instance starts")
(is (= #{50 55} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
"with its automation moved along")
(testing "and cut off where the instance's own span ends"
(let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12])
[t] (nest/audio-tracks c :main)]
(is (= [10 22] (:span t)))
(is (= [50 62] (node/placed-span t)))))))
(defn- picture
"What `sid` draws at each of `fs`, without the node paths a move changes:
per frame, the sorted marks with their points rounded to a thousandth."
[c sid fs]
(let [resolve (clip/resolver c nil pal/index-of sid)
round #(/ (js/Math.round (* 1000 %)) 1000)]
(mapv (fn [f]
(sort-by str (map (fn [op]
[(:color op) (mapv round (take (* 2 (:n op)) (array-seq (:pts op))))])
(resolve f))))
fs)))
(def ^:private a-uuid #uuid "00000000-0000-4000-8000-0000000000e1")
(def ^:private b-uuid #uuid "00000000-0000-4000-8000-0000000000e2")
(defn- studio
"`main` holds a keyed shape and a moved, turned, doubled instance of `box`,
placed at frame 10; `box` holds a shape of its own."
[]
(let [tri (fn [id x keyed]
{:id id :kind :poly :z "a1" :paint? true :span [4 60]
:channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed))
[:style :color] (ch/framed :brow)}})]
(-> (clip/blank)
(assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40}))
(assoc-in [:symbols :box] {:id :box :frames 50 :nodes {:inner (tri :inner 5 {0 10})}})
(clip/place-symbol nil :main :box 10 a-uuid nil)
(update-in [:symbols :main :nodes a-uuid :channels] merge
{[:xform :pos] (ch/framed [30 20])
[:xform :rot] (ch/framed 0.5)
[:xform :scale] (ch/framed [2 2])}))))
(deftest moving-a-node-into-a-symbol-changes-nothing-on-screen
;; From frame 10, where the instance starts: inside a symbol a node exists only
;; while that symbol is on screen, so moving the shape in cuts off 4–9.
(let [c (studio)
fs [10 16 29 30 45 59 60 70]
{moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)]
(is (nil? (:refused r)) (:refused r))
(is (contains? (get-in moved [:symbols :box :nodes]) :tri) "it is in the symbol now")
(is (not (contains? (get-in moved [:symbols :main :nodes]) :tri)) "and not beside it")
(is (= [4 60] (get-in moved [:symbols :box :nodes :tri :span]))
"its span and keys are its own and do not change")
(is (= -10 (get-in moved [:symbols :box :nodes :tri :time :at]))
"its time map takes up the ten frames the instance starts late")
(is (= (picture c :main fs) (picture moved :main fs)) "and the picture is the same, frame for frame")
(testing "moving it back out is also invisible"
(let [{back :clip} (nest/move-node moved nil :main [a-uuid :tri] [] 16)]
(is (= (picture c :main fs) (picture back :main fs)))))))
(deftest moving-an-instance-moves-only-its-at
(let [c (-> (studio)
(assoc-in [:symbols :holder] {:id :holder :frames 100 :nodes {}})
(clip/place-symbol nil :main :holder 3 b-uuid nil))
fs [0 10 16 40 59]
{moved :clip :as r} (nest/move-node c nil :main [a-uuid] [b-uuid] 16)
n (get-in moved [:symbols :holder :nodes a-uuid])]
(is (nil? (:refused r)) (:refused r))
(is (= 7 (get-in n [:time :at])) "placed at 10 in main is at 7 inside something placed at 3")
(is (= [0 50] (:span n)) "its own frames do not move")
(is (= (picture c :main fs) (picture moved :main fs)))))
(deftest grouping-makes-a-symbol-around-them-and-changes-nothing-on-screen
(let [c (studio)
fs [0 4 10 16 30 59 60]
{grouped :clip :as r} (nest/group c nil :main [[:tri] [a-uuid]] :group-1 b-uuid 16)
inst (get-in grouped [:symbols :main :nodes b-uuid])]
(is (nil? (:refused r)) (:refused r))
(is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes])))))
(is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were")
(is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts")
(is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends")
(is (= (picture c :main fs) (picture grouped :main fs)))
(is (empty? (clip/problems grouped)))))
(deftest what-cannot-move-says-why
(let [c (studio)]
(is (:refused (nest/move-node c nil :main [a-uuid] [a-uuid] 16)) "not into itself")
(is (:refused (nest/move-node c nil :main [:tri] [a-uuid] 2)) "not while the target is off screen")
(let [roto (assoc-in c [:symbols :main :nodes :tri :channels [:geom :pts] :generated] {:by :roto})]
(is (re-find #"generated" (:refused (nest/move-node roto nil :main [:tri] [a-uuid] 16)))))))
(deftest moving-into-a-retimed-instance-keeps-the-timing
(let [c (assoc-in (studio) [:symbols :main :nodes a-uuid :time :rate] 2)
fs [10 12 17 20 29 34]
{moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)]
(is (nil? (:refused r)) (:refused r))
(is (= {:at -20 :rate 0.5}
(select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate]))
"half speed inside something at double speed, so it runs as it did")
(is (= (picture c :main fs) (picture moved :main fs)))))
(deftest sliding-a-shape-inside-a-retimed-instance-moves-it-by-frames-of-the-open-symbol
;; `box` runs at double speed from 10, so six frames of main are twelve of box.
(let [c (-> (studio)
(update-in [:symbols :main :nodes] dissoc :tri)
(assoc-in [:symbols :main :nodes a-uuid :time :rate] 2)
(assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]]
(ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]})))
{slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6)
fs [13 15 18 20]]
(is (nil? (:refused r)) (:refused r))
(is (= {:mode :map :at 12 :rate 1} (get-in slid [:symbols :box :nodes :inner :time])))
(is (= [4 60] (get-in slid [:symbols :box :nodes :inner :span])) "its span and keys are its own")
(is (= (picture c :main fs) (picture slid :main (map #(+ 6 %) fs)))
"what it did at a frame of main it now does six frames later")
(is (seq (first (picture c :main [14]))))
(is (empty? (first (picture slid :main [14]))) "and it is not there yet where it was")
(testing "sliding it again adds to where it is"
(is (= 2 (get-in (:clip (nest/slide slid :main [a-uuid :inner] -5))
[:symbols :box :nodes :inner :time :at]))))))
(deftest sliding-needs-nothing-on-screen-and-refuses-only-a-loop
(let [c (studio)]
(is (= 3 (get-in (:clip (nest/slide c :main [a-uuid :inner] 3))
[:symbols :box :nodes :inner :time :at]))
"the instance starts at 10, and where the playhead is has nothing to do with it")
(is (:refused (nest/slide (assoc-in c [:symbols :main :nodes a-uuid :time :loop?] true)
:main [a-uuid :inner] 3))
"but through a loop one frame outside is many inside")))
(deftest restacking-is-one-write-to-z
(let [shape (fn [z] {:kind :poly :z z :channels {}})
c (-> (clip/blank)
(assoc-in [:symbols :main :nodes] {:a (shape "a1") :b (shape "a2") :c (shape "a3")}))
order (fn [c] (map key (sort-by (comp :z val) (get-in c [:symbols :main :nodes]))))
front (:clip (nest/restack c :main [:a] [:c] true))
back (:clip (nest/restack c :main [:c] [:a] false))
mid (:clip (nest/restack c :main [:a] [:b] true))]
(is (= [:b :c :a] (order front)) "in front of the front one")
(is (= [:c :a :b] (order back)) "behind the back one")
(is (= [:b :a :c] (order mid)) "between two")
(is (= (dissoc (get-in c [:symbols :main :nodes]) :a)
(dissoc (get-in mid [:symbols :main :nodes]) :a))
"and nothing else is renumbered")
(is (:refused (nest/restack c :main [:a] [a-uuid :inner] true))
"only among the things it is beside")))

View file

@ -132,16 +132,16 @@
(is (= (vec (range 8)) (mapv #(node/local-frame {:id :x} %) (range 8))))
(is (= (vec (range 8)) (mapv #(node/local-frame {:id :x :time {:mode :inherit}} %) (range 8)))))
(deftest a-retimed-instance-is-refused-rather-than-ignored
;; :rate is a symbol instance's timing and symbols are out of scope. Silently
;; dropping it would be a retimed blink playing at the wrong speed, which looks
;; like a bad blink and not like a missing feature.
(is (thrown-with-msg? ExceptionInfo #":rate"
(node/local-frame {:id :x :time {:mode :map :rate 0.5}} 0)))
(deftest every-node-has-the-same-time-map
;; One rule, whatever the node is: `local = rate · (parent − at)`.
(is (= 5 (node/local-frame {:id :x :time {:mode :map :rate 0.5}} 10)) "a shape, at half speed")
(is (= 5 (node/local-frame {:id :x :kind :instance :time {:mode :map :rate 0.5}} 10)) "an instance, the same")
(is (= 3 (node/local-frame {:id :x :time {:mode :map :at 7}} 10)) "and :at is where its frame 0 lands")
(is (= 4 (node/local-frame {:id :x :time {:mode :map :expose 2 :rate 1.0}} 5))
"rate 1.0 is the identity and is allowed, because it appears in the spec's example"))
;; ---- the shape ----
"exposure still floors on its own clock")
(let [m {:at 3 :rate 2}]
(is (= {:at 0 :rate 1} (node/then-time m (node/invert-time m)))
"a map followed by its inverse is nothing")))
(deftest transform-channels-default-to-the-identity
(let [chs (node/channels {:id :x :kind :group})]
@ -174,7 +174,7 @@
(is (empty? (node/problems {:id :x :kind :group :z "a1"})))
(is (seq (node/problems {:kind :group :z "a1"})) "no :id")
(is (seq (node/problems {:id :x :kind :blob :z "a1"})) "not a kind")
(is (seq (node/problems {:id :x :kind :symbol :z "a1"})) "a kind that is not built")
(is (seq (node/problems {:id :x :kind :instance :z "a1"})) "a kind that is not built")
(is (seq (node/problems {:id :x :kind :group})) "no :z")
(is (seq (node/problems {:id :x :kind :group :z "a1" :span [3]})) "a malformed span")
(is (seq (node/problems {:id :x :kind :group :z "a1"
@ -183,3 +183,21 @@
(is (seq (node/problems {:id :x :kind :poly :z "a1"
:channels {[:geom :pts] {:animated? true}}}))
"and a channel that is malformed in itself"))
(deftest keying-a-channel-from-the-inspector
(let [n {:id :x :kind :group}
a (node/set-channel n [:xform :rot] 3 1.0)
b (node/toggle-key a [:xform :rot] 3)
c (-> b (node/set-channel [:xform :pos] 9 [5 5])
(node/toggle-key [:xform :pos] 0)
(node/set-channel [:xform :pos] 10 [10 0]))
rot #(ch/value-at (get (node/channels %1) [:xform :rot]) %2)
pos #(ch/value-at (get (node/channels %1) [:xform :pos]) %2)]
(is (= 1.0 (rot a 50)) "an unkeyed channel is its one value")
(is (= {3 1.0} (get-in b [:channels [:xform :rot] :keys])) "the first key is its value here")
(is (= [7.5 2.5] (pos c 5)) "an edit on a keyed channel keys it, and keys tween")
(is (= 1.0 (rot (node/set-channel b [:xform :rot] 8 2.0) 3)) "without moving the key before it")
(let [d (node/toggle-key b [:xform :rot] 3)]
(is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again")
(is (= 1.0 (rot d 0))))
(is (= :hold (get-in (node/toggle-key n [:vis] 0) [:channels [:vis] :interp])) "a boolean holds")))

View file

@ -4,22 +4,22 @@
[arthur.domain.channel :as channel]
[arthur.domain.leaf :as leaf]
[arthur.domain.paint :as paint]
[arthur.domain.timeline :as timeline]))
[arthur.domain.symbol :as symbol]))
(defn- geometry [clip]
(get-in clip [:timelines :main :nodes :paint-test :channels paint/geometry]))
(get-in clip [:symbols :main :nodes :paint-test :channels paint/geometry]))
(deftest drawing-keys-hold-and-tween-on-the-timeline-clock
(deftest drawing-keys-hold-and-tween-on-the-symbol-clock
(let [a [10 10 30 10 20 30]
c0 (paint/new-shape demo/clip :paint-test 3 a :brow)
c1 (paint/add-key c0 :paint-test 9)
c2 (paint/set-vertex c1 :paint-test 9 0 [22 10])
c3 (paint/add-key c2 :paint-test 15)
c4 (paint/set-vertex c3 :paint-test 15 0 [34 10])
c0 (paint/new-shape demo/clip :main :paint-test 3 a :brow)
c1 (paint/add-key c0 :main :paint-test 9)
c2 (paint/set-vertex c1 :main :paint-test 9 0 [22 10])
c3 (paint/add-key c2 :main :paint-test 15)
c4 (paint/set-vertex c3 :main :paint-test 15 0 [34 10])
held (geometry c4)
mixed-clip (paint/set-segment-interp c4 :paint-test 9 :linear)
mixed-clip (paint/set-segment-interp c4 :main :paint-test 9 :linear)
mixed (geometry mixed-clip)]
(is (= [3 229] (get-in c2 [:timelines :main :nodes :paint-test :span])))
(is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span])))
(is (= a (channel/value-at held 8)))
(is (= 10 (first (channel/value-at held 8))))
(is (= 22 (first (channel/value-at held 9))))
@ -28,5 +28,5 @@
(is (empty? (channel/problems mixed)))
;; The demo's root is exposed on 2s. Paint at frame 3 must still appear at 3.
(is (some #(= :paint-test (:node %))
(timeline/eval-frame (get-in c2 [:timelines :main]) 3)))
(symbol/eval-frame (get-in c2 [:symbols :main]) 3)))
(is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))

View file

@ -22,11 +22,11 @@
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.project :as project]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[arthur.flow.freeze :as freeze]
[arthur.support.ops :as ops]))
(defn- face-timeline [c] (clip/timeline c :face-1))
(defn- face-symbol [c] (clip/symbol c :face-1))
(defn- wired
"A clip out and back, over a wire that is really only JSON."
@ -37,7 +37,7 @@
(def ^:private after (delay (wired :c1 @before)))
(deftest what-comes-back-is-a-valid-clip
;; `clip/problems` and not `timeline/problems`: the round trip has to preserve
;; `clip/problems` and not `symbol/problems`: the round trip has to preserve
;; the tracking identities and the timeline map as well as the nodes, and only
;; the clip-level check looks at those.
(let [ps (clip/problems (:clip @after))]
@ -53,14 +53,14 @@
;; The assertion. Both evaluators, both scenes, every frame order — so a block
;; that came back with its offsets shifted, or a cursor that seeks differently
;; over a rebuilt key map, has nowhere to hide.
(let [n (clip/frames (:clip @before))
(let [n (clip/frames (:clip @before) :main)
paths {"specification" [ops/specified ops/specified]
"playback" [ops/resolved ops/resolved]
"spec vs playback, after" [ops/specified ops/resolved]}]
(doseq [[label [f g]] paths
[order fs] (ops/orders n)]
(let [a (f (face-timeline (:clip @before)) (:store @before))
b (g (face-timeline (:clip @after)) (:store @after))]
(let [a (f (face-symbol (:clip @before)) (:store @before))
b (g (face-symbol (:clip @after)) (:store @after))]
(testing (str label ", " order)
(doseq [frame fs]
(is (= (a frame) (b frame))
@ -84,8 +84,8 @@
;; everything above and lose the locked take's identity transform.
(let [locked {:clip @take/locked :store @take/store}
back (wired :c1 locked)
a (ops/resolved (face-timeline (:clip locked)) (:store locked))
b (ops/resolved (face-timeline (:clip back)) (:store back))]
a (ops/resolved (face-symbol (:clip locked)) (:store locked))
b (ops/resolved (face-symbol (:clip back)) (:store back))]
(is (= (:clip locked) (:clip back)))
(doseq [frame (range 0 take/frames 7)]
(is (= (a frame) (b frame)) (str "frame " frame)))))
@ -116,7 +116,7 @@
(deftest an-absence-mask-survives-the-wire
(let [back (wired :c1 @gappy)
at (fn [entry id path f]
(ch/value-at (get-in (:nodes (face-timeline (:clip entry))) [id :channels path])
(ch/value-at (get-in (:nodes (face-symbol (:clip entry))) [id :channels path])
f (:store entry)))
;; Every dense track of the eye, iris, brow and brow-position blocks, and
;; the feature whose gap it must follow — the same table
@ -147,7 +147,7 @@
;; frame rather than hidden, and its partner is not.
(let [back (wired :c1 @gappy)
drawn (into #{} (map :node)
((timeline/resolver (face-timeline (:clip back)) (:store back)) 12))]
((symbol/resolver (face-symbol (:clip back)) (:store back)) 12))]
(is (not (contains? drawn :eye-r)))
(is (contains? drawn :eye-l))
(is (contains? drawn :mouth))))

View file

@ -1,205 +1,412 @@
(ns arthur.domain.symbol-test
"Frame evaluation, and the hand-written scene.
port-plan step 2 exists to find out whether the data model works BEFORE nine
hundred lines of measurement are ported into it, so these assertions are about
the model's claims rather than about a look: that structure is flat and
addressable, that draw order is authored, that time maps compose, that
presence and visibility are different questions, and that the fast path and the
specification give the same frame."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.stage :as stage]
[arthur.demo :as demo]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]
[arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]))
[arthur.domain.raster :as raster]
[arthur.domain.clip :as clip]
[arthur.domain.symbol :as symbol]
[arthur.support.ops :as ops]))
(def source
{:name "source" :fps 30 :width 320 :height 200
:timelines
{:main {:id :main :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
2 [20 0] 3 [30 0]})
[:geom :size] (ch/framed 4)
[:style :color] (ch/framed :brow)}}}}}})
(defn- poly [id parent z pts color & [extra]]
(merge {:id id :kind :poly :parent parent :z z
:channels {[:geom :pts] (ch/framed pts)
[:style :color] (ch/framed color)}}
extra))
(deftest two-instances-own-their-frame-and-placement
(let [document
(-> source
(assoc-in [:timelines :main]
{:id :main :frames 6
:nodes {:root {:id :root :kind :group :z "a1"}
:left {:id :left :kind :symbol :of :sym/test
:parent :root :z "a1" :span [0 4]
:channels {[:xform :pos] (ch/framed [100 50])}}
:right {:id :right :kind :symbol :of :sym/test
:parent :root :z "a2" :span [2 6]
:time {:mode :map :at 2 :in 0 :rate 1}
:channels {[:xform :pos] (ch/framed [120 50])}}}})
(assoc-in [:timelines :sym/test]
(assoc (get-in source [:timelines :main]) :id :sym/test)))
resolve (clip/resolver document nil)
at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
(is (empty? (clip/problems document)))
(is (= [[[:left :mark] 110]] (at 1)))
(is (= [[[:left :mark] 120] [[:right :mark] 120]] (at 2)))
(is (= [[[:right :mark] 150]] (at 5)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- sc [& nodes]
{:nodes (into {} (map (juxt :id identity)) nodes)})
(deftest a-placement-holds-and-cuts-each-generated-shape-independently
(let [values (js/Int16Array. (clj->js (range 2 32)))
visible (ch/keyed {0 true 20 true 21 false})
dense {:animated? true :interp :hold
:dense {:store "sizes" :offset 0 :stride 1 :frames 30}
:pose-sampled? true}
shape (fn [id z group]
{:id id :kind :rect :parent :root :z z :pose-group group
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]})
[:geom :size] dense
[:vis] (assoc visible :pose-sampled? true)
[:style :color] (ch/framed :brow)}})
symbol {:id :sym/poses :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:mouth (shape :mouth "a1" :mouth)
:mouth-detail (shape :mouth-detail "a2" :mouth)
:eye (shape :eye "a3" :eye)
:brow (shape :brow "a4" :brow)}}
document {:fps 30 :width 320 :height 200
:timelines
{:main {:id :main :frames 30
:nodes {:root {:id :root :kind :group :z "a1"}
:first {:id :first :kind :symbol :of :sym/poses
:parent :root :z "a1"
:playback {:tracks {:mouth {0 0, 8 20, 9 21}
[:node :mouth-detail] {0 0, 8 4}
:eye {0 0, 4 4}}}}
:second {:id :second :kind :symbol :of :sym/poses
:parent :root :z "a2"
:playback {:tracks {:mouth {0 0, 8 8}}}}}}
:sym/poses symbol}}
resolve (clip/resolver document {"sizes" {:data values}})
low-resolve (clip/resolver document {"sizes" {:data values}}
pal/index-of :main {:picture-fps 8})
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))
low-at (fn [f] (into {} (map (fn [op] [(:node op) op])) (low-resolve f)))]
(is (empty? (clip/problems document)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (= 2 (:size (get (at 7) [:first :mouth]))) "eight static frames")
(is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20")
(is (= 6 (:size (get (at 8) [:first :mouth-detail])))
"one node may depart from its shared mouth group")
(is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8")
(is (= 6 (:size (get (at 7) [:first :eye]))) "eye has its own timing")
(is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time")
(is (nil? (get (at 9) [:first :mouth]))
"generated visibility is read from the same selected pose")
(is (some? (get (at 9) [:second :mouth])))
(is (= 5 (:size (get (low-at 7) [:first :brow])))
"picture rate samples only generated motion")
(is (= 22 (:size (get (low-at 8) [:first :mouth])))
"an explicit cut occurs at its exact local frame, even off the picture grid")
(is (= 8 (:cx (get (low-at 8) [:first :eye])))
"authored position ignores the picture grid")
(let [tl (get-in document [:timelines :sym/poses])
opts {:source-fps 30 :picture-fps 8}]
(is (= (mapv #(select-keys % [:node :cx :size])
(timeline/eval-frame tl 8 {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts))
(mapv #(select-keys % [:node :cx :size])
((timeline/resolver tl {"sizes" {:data values}}
pal/index-of {:mouth {0 0, 8 20}} opts) 8)))
"pure evaluation and playback apply the same pose choice"))))
(defn- ids-at [scene f]
(mapv :node (symbol/eval-frame scene f)))
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
(let [document (-> source
(assoc-in [:timelines :main :nodes :placed]
{:id :placed :kind :symbol :of :sym/test :parent :root
:z "a2"})
(assoc-in [:timelines :sym/test]
{:id :sym/test :frames 4
:nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root
:z "a1" :pose-group :mark
:channels {[:geom :size]
{:animated? true :interp :hold
:keys {0 2 1 3 2 4 3 5}
:pose-sampled? true}}}}})
(pose/put-cut :placed :mark 2 3))
cuts (get-in document [:timelines :main :nodes :placed :playback :tracks :mark])]
(is (= {2 3} cuts))
(is (= 1 (pose/source-frame (pose/prepare {:mark cuts}) :mark 1 1))
"before the first cut, dense motion continues")
(is (= 3 (pose/source-frame (pose/prepare {:mark cuts}) :mark 2 2)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
(is (nil? (get-in (pose/remove-cut document :placed :mark 2)
[:timelines :main :nodes :placed :playback :tracks :mark])))
(is (seq (clip/problems (assoc-in document
[:timelines :main :nodes :placed :playback :tracks :mark]
{4 3}))))))
(def ^:private pts-of ops/points)
(defn- uuid-of
"The uuid the layout authors for the placement whose handle is `id`.
;; ---- structure ----
Read out of `stage/layout` rather than written here as a literal: what this test
is about is the mapping `compose` performs, and nine copied uuids would assert
that someone copied them correctly."
[id]
(or (->> (concat (:instances stage/layout) (:audio stage/layout))
(some (fn [p] (when (= id (:id p)) (:uuid p)))))
(throw (ex-info "no such placement in the layout" {:id id}))))
(deftest depth-order-puts-every-node-after-its-parent
(let [s (sc {:id :a :kind :group :z "a1"}
{:id :b :kind :group :parent :a :z "a1"}
{:id :c :kind :group :parent :b :z "a1"}
{:id :d :kind :group :parent :a :z "a2"})
ord (symbol/order (:nodes s))]
(is (= 0 (symbol/depth (:nodes s) :a)))
(is (= 2 (symbol/depth (:nodes s) :c)))
(let [pos (into {} (map-indexed (fn [i id] [id i])) ord)]
(doseq [[id p] [[:b :a] [:c :b] [:d :a]]]
(is (< (get pos p) (get pos id)) (str p " must come before " id))))))
(defn- placement
"The composed node for the placement the layout calls `id`."
[document id]
(get-in document [:timelines :main :nodes (uuid-of id)]))
(deftest a-parent-cycle-throws-instead-of-hanging
;; Reachable from one bad :node/set-parent, and a hung tab is a far worse
;; diagnostic than a stack trace naming the nodes.
(let [s (sc {:id :a :kind :group :parent :b :z "a1"}
{:id :b :kind :group :parent :a :z "a1"})]
(is (thrown-with-msg? ExceptionInfo #"cycle" (symbol/order (:nodes s))))
(is (seq (symbol/problems s)))))
(deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)]
(is (empty? (clip/problems document)))
(is (= #{:main :sym/face-8625} (set (keys (:timelines document)))))
(is (= :sym/face-8625 (:of (placement document :left))))
(is (= :sym/face-8625 (:of (placement document :right))))
(testing "every placement is keyed by its own uuid"
;; The identity change: seven placements of one drawing are seven things,
;; and each is named by something that means only itself. Sharing a key, or
;; keying by a description of where a thing sits, is what this rules out.
(let [symbols (filter (comp #{:symbol} :kind val)
(get-in document [:timelines :main :nodes]))]
(is (= 7 (count symbols)))
(is (every? uuid? (map key symbols)))
(is (= 7 (count (distinct (map key symbols)))))
(testing "and each still says which drawing it plays and what to call it"
(is (every? #(= :sym/face-8625 (:of (val %))) symbols))
(is (every? #(string? (:name (val %))) symbols))
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :symbol (:kind %))
(vals (get-in document [:timelines :main :nodes]))))))
(is (= [48 280] (:span (placement document :right))))
(let [left (placement document :left)
scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0)]
(is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos))
(is (not= start-pos (ch/value-at pos 40)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0)))
(is (= [0.56 0.56] (ch/value-at scale 12)))
(is (= [0.52 0.52] (ch/value-at scale 48)))
(doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f) [0 0] anchor)
out (js/Float64Array. 2)]
(node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales"))))
(testing "the editorial link resolves to the placement's uuid"
;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
;; resolves to a node at all; this checks it resolves to the RIGHT one.
(is (= (uuid-of :right) (:linked-to (placement document :voice-right))))
(is (uuid? (:linked-to (placement document :voice-right)))))
(is (= [48 260] (:span (placement document :voice-right))))
(is (= 0.5 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :gain]]) 54)))
(is (< -0.8 (ch/value-at
(get-in (placement document :voice-right)
[:channels [:audio :pan]]) 110) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(deftest a-missing-parent-is-named-rather-than-silently-orphaning
(let [s (sc {:id :a :kind :group :parent :nope :z "a1"})]
(is (seq (symbol/problems s)))))
(deftest reparenting-is-one-field-and-does-not-move-a-subtree
;; The flat-with-pointers claim, asserted as the thing it buys: a reparent is an
;; assoc-in at one node, and nothing else in the map changes identity — which is
;; what keeps re-frame's ancestor subs from invalidating.
(let [s (sc {:id :a :kind :group :z "a1"}
{:id :b :kind :group :z "a2" :channels {[:xform :pos] (ch/framed [100 0])}}
(poly :c :a "a1" [0 0 10 0 10 10] :brow))
s' (assoc-in s [:nodes :c :parent] :b)]
(is (identical? (get-in s [:nodes :a]) (get-in s' [:nodes :a]))
"the old parent is the same object")
(is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b]))
"and so is the new one")
(is (= [[0 0] [10 0] [10 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s 0))))))
(is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s' 0))))))))
;; ---- draw order ----
(deftest draw-order-is-depth-first-by-sibling-z
;; z is a fractional index among siblings, so the sort key is the chain of z
;; values from the root. A parent's chain is a PREFIX of its child's, which is
;; why a parent draws before its children without that being a special case.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :under :root "a0" [0 0 1 0 1 1] :bg)
{:id :mid :kind :group :parent :root :z "a1"}
(poly :deep :mid "a5" [0 0 1 0 1 1] :brow)
(poly :over :root "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:under :deep :over] (ids-at s 0)))))
(deftest a-deep-child-of-an-early-sibling-still-draws-before-a-later-sibling
;; The failure this guards: comparing z paths with `compare` would compare
;; COUNT first, so a painted cel three levels under "a1" would jump in front of
;; a bare "a2". It reads as a layer order that mostly works.
(let [s (sc {:id :root :kind :group :z "a1"}
{:id :g1 :kind :group :parent :root :z "a1"}
{:id :g2 :kind :group :parent :g1 :z "a1"}
(poly :deep :g2 "a1" [0 0 1 0 1 1] :brow)
(poly :shallow :root "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:deep :shallow] (ids-at s 0)))))
(deftest a-fractional-index-inserts-between-two-siblings-without-renumbering
(let [base (sc {:id :root :kind :group :z "a1"}
(poly :a :root "a1" [0 0 1 0 1 1] :bg)
(poly :c :root "a3" [0 0 1 0 1 1] :teeth))
with (assoc-in base [:nodes :b] (poly :b :root "a2" [0 0 1 0 1 1] :brow))]
(is (= [:a :c] (ids-at base 0)))
(is (= [:a :b :c] (ids-at with 0)))
(is (= (get-in base [:nodes :a]) (get-in with [:nodes :a])) "and :a is untouched")))
(deftest z-between-always-finds-room
(let [between? (fn [a b z] (and (or (nil? a) (neg? (compare a z)))
(or (nil? b) (neg? (compare z b)))))]
(testing "on the keys scenes already have"
(doseq [[a b] [[nil "a1"] ["a1" nil] ["a1" "a2"] ["a1" "a3"] ["a" "a1"]
["a1" "z1727000000000-shape"] [nil "0"] [nil "-"] ["c0000" "c0001"]]]
(is (between? a b (symbol/z-between a b)) (pr-str [a b (symbol/z-between a b)]))))
(testing "and again and again: to the back, to the front, and into one gap from either side"
(doseq [[label start step past?] [["back" "a1" #(symbol/z-between nil %) #(between? nil %1 %2)]
["front" "a1" #(symbol/z-between % nil) #(between? %1 nil %2)]
["under a2" "a1" #(symbol/z-between % "a2") #(between? %1 "a2" %2)]
["over a1" "a2" #(symbol/z-between "a1" %) #(between? "a1" %1 %2)]]]
(is (every? (fn [[x y]] (past? x y)) (partition 2 1 (take 300 (iterate step start))))
label)))))
;; ---- transform composition through the tree ----
(deftest geometry-lands-in-the-parents-space
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] (ch/framed [100 50])
[:xform :scale] (ch/framed [2 2])}}
(poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base))
op (first (symbol/eval-frame s 0))]
(is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op)))))
(deftest a-keyed-group-position-moves-its-children-and-holds-between-keys
;; This is the scene the plan asks for, minimally: a rectangle parented to a
;; group whose [:xform :pos] is keyed on four frames.
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos]
(ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]})}}
(poly :p :g "a1" [0 0 2 0 2 2] :skin-base))
at #(first (pts-of (first (symbol/eval-frame s %))))]
(is (= [0 0] (at 0)))
(is (= [0 0] (at 3)) "held")
(is (= [10 0] (at 4)))
(is (= [10 10] (at 8)))
(is (= [0 10] (at 12)))
(is (= [0 10] (at 99)) "and holds the last key")))
;; ---- time maps compose along the chain ----
(deftest exposure-on-the-root-is-inherited-by-everything-under-it
;; docs/design.md is emphatic that everything rides ONE grid: a head cutting on
;; odd frames against a mouth cutting on even ones reads as two performances.
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}}
{:id :g :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (symbol/eval-frame s %)))))]
(is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12)))))
(testing "and a node may set its own grid, which the model permits deliberately"
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}}
{:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4}
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (symbol/eval-frame s %)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
;; 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.
(let [keys (into {} (map (juxt identity #(vector % 0))) (range 12))
s (sc {:id :root :kind :group :z "a1"}
{:id :plate :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed keys)}}
(poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base)
{:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2}
:channels {[:xform :pos] (ch/keyed keys)}}
(poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark))
x-of (fn [f id] (->> (symbol/eval-frame s f)
(filter #(= id (:node %))) first pts-of first first))]
(is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4))))
(is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead")))
;; ---- span and visibility are different questions ----
(deftest span-removes-a-node-and-vis-switches-it-off
;; :span is Lottie's ip/op and Flash's PlaceObject/RemoveObject: the range over
;; which the node EXISTS. [:vis] blinks an existing node on and off. Conflating
;; them is how you end up with a part that holds a stale pose outside its range.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 1 0 1 1] :brow
{:span [2 5]
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])
[:style :color] (ch/framed :brow)
[:vis] (ch/keyed {0 true, 3 false, 4 true})}}))]
(is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7))))))
(deftest a-hidden-group-takes-its-children-with-it
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:vis] (ch/keyed {0 true, 2 false})}}
(poly :p :g "a1" [0 0 1 0 1 1] :brow))]
(is (= [:p] (ids-at s 0)))
(is (= [] (ids-at s 2)))))
(deftest an-absent-transform-drops-the-subtree-and-an-absent-geometry-does-not
;; The asymmetry is the whole reason presence is tracked per CHANNEL rather than
;; per node. An absent mouth outline has nothing to draw, but the head it hangs
;; off is still exactly where it was.
(let [state (js/Uint8Array. #js [ch/present ch/absent-bit])
store {"pos" {:data (js/Float32Array. #js [0 0, 0 0]) :state state}
"pts" {:data (js/Int16Array. #js [0 0 1 0 1 1, 0 0 1 0 1 1]) :state state}}
absent-pos (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] {:animated? true
:dense {:store "pos" :offset 0 :stride 2 :frames 2}}}}
(poly :child :g "a1" [0 0 1 0 1 1] :brow))
absent-pts (sc {:id :g :kind :group :z "a1"}
{:id :m :kind :poly :parent :g :z "a1"
:channels {[:geom :pts] {:animated? true
:dense {:store "pts" :offset 0 :stride 6 :frames 2}}
[:style :color] (ch/framed :mouth-dark)}}
(poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:child] (mapv :node (symbol/eval-frame absent-pos 0 store))))
(is (= [] (mapv :node (symbol/eval-frame absent-pos 1 store)))
"an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (symbol/eval-frame absent-pts 0 store))))
(is (= [:teeth] (mapv :node (symbol/eval-frame absent-pts 1 store)))
"an absent outline removes only itself")))
;; ---- stencils ----
(deftest a-stencil-resolves-to-the-stencil-nodes-palette-index
;; A stencil is a COLOUR KEY, not a node reference — the take format's clip= —
;; and the indexed buffer being its own clip mask is what keeps the iris inside
;; the eye at any gaze and any radius with no clamp anywhere.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white)
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})
ops (symbol/eval-frame s 0)]
(is (= [:sclera :iris] (mapv :node ops)))
(is (= (:eye-white pal/index-of) (:stencil (second ops))))))
(deftest a-node-stencilled-by-something-that-drew-nothing-is-dropped
;; Unclipped would be an iris floating over the cheek on exactly the frames
;; where the eye is missing, which is worse than a missing iris.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white
{:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10])
[:style :color] (ch/framed :eye-white)
[:vis] (ch/keyed {0 true, 1 false})}})
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})]
(is (= [:sclera :iris] (ids-at s 0)))
(is (= [] (ids-at s 1)))))
;; ---- discs and rects ----
(deftest disc-and-rect-extents-retain-precision-for-enclosing-instances
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] (ch/framed [50 60]) [:xform :scale] (ch/framed [2 2])}}
{:id :d :kind :disc :parent :g :z "a1"
:channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}}
{:id :r :kind :rect :parent :g :z "a2"
:channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}})
[d r] (symbol/eval-frame s 0)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
(is (= 3.4 (:size r)))))
;; ---- the fast path and the specification agree ----
(deftest the-resolver-agrees-with-eval-frame-in-any-frame-order
;; THE assertion of this step. The resolver caches the topological order and the
;; z paths, holds a cursor per channel and reuses one point buffer per node, and
;; every one of those is a way to be subtly wrong on some frames and not others
;; — which presents as a bad take rather than as an error.
;; The frame orders and the snapshot live in `arthur.support.ops`, because the
;; same comparison is what proves a scene survived the server — see
;; flow/project-test.
(let [s demo/main
spec (ops/specified s nil)
fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders (:frames s))]
(testing label
(doseq [f fs]
(is (= (spec f) (fast f)) (str label " at frame " f)))))))
(deftest the-resolver-reuses-one-buffer-per-node
;; At 30fps per-frame allocation is the only thing that will make this stutter,
;; and fixed topology is what makes the buffer size knowable at all.
(let [res (symbol/resolver demo/main)
buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))]
(is (identical? (buf-of 0 :card) (buf-of 30 :card)))))
;; ---- the hand-written scene, end to end ----
(deftest the-hand-written-clip-is-valid
;; `clip/problems` rather than `symbol/problems`: it checks the clip's fields,
;; the timeline map and the tracking identities as well as the nodes, so it is
;; the check a save would make.
(let [ps (clip/problems demo/clip)]
(is (empty? ps) (pr-str ps)))
(is (pos? demo/frames))
(testing "a clip is not a symbol, and handing one over fails loudly"
;; The mistake this split makes easy: both are maps with an :id, and the wrong
;; one resolves to no ops rather than to an error.
(is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/resolver demo/clip)))
(is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/eval-frame demo/clip 0)))))
(deftest the-hand-written-clip-renders-and-moves
;; port-plan step 2's done condition, as an assertion rather than a look: the
;; scene rasterises, it writes only palette indices, and the pixels are not the
;; same on every frame.
(let [res (symbol/resolver demo/main)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
r))
frames (mapv render (range 0 demo/frames 6))
sig (fn [r] (vec (array-seq (:buf r))))]
(is (every? (fn [r] (every? #(< % (count pal/rgb)) (array-seq (:buf r)))) frames)
"every byte written is a real palette index")
(is (> (count (distinct (map sig frames))) 1) "something moves")
(testing "the mark actually covers pixels"
(is (pos? (count (remove zero? (sig (first frames)))))))))
(deftest the-hand-written-clip-steps-on-the-exposure-grid
;; Exposure 2 on the clip root, inherited, so odd frames are identical to the
;; even frame before them. If this fails, exposure is being applied somewhere
;; other than the frame the channels are sampled at.
(let [res (symbol/resolver demo/main)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
(vec (array-seq (:buf r)))))]
(doseq [f (range 0 demo/frames 2)]
(is (= (render f) (render (inc f))) (str "frame " (inc f) " must hold frame " f)))
;; Two grid slots that straddle a key, not two adjacent ones: between keys
;; nothing changes, because that is what hold MEANS. The scene's second key
;; is at 57, and exposure 2 floors that onto 58 — which is itself the
;; expose-before-anything-else rule showing up in pixels.
(is (not= (render 56) (render 58)) "and a key on the grid is seen")))
(deftest the-hand-written-clip-keeps-the-iris-and-pupil-inside-the-card
;; The stencil chain, on real pixels: the iris is clipped by the card and the
;; pupil by the iris, and neither is expressed anywhere as a chain.
(let [res (symbol/resolver demo/main)]
(doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/clip) (:height demo/clip))
ops (res f)
card? (fn [op] (= :card (:node op)))]
(raster/clear! before (:bg pal/index-of))
(raster/draw-ops! before (filter card? ops))
(raster/clear! after (:bg pal/index-of))
(raster/draw-ops! after ops)
(let [ci (:skin-base pal/index-of)
card (set (for [i (range (alength (:buf before)))
:when (= ci (aget (:buf before) i))]
i))
eye (set (for [i (range (alength (:buf after)))
:when (#{(:iris pal/index-of) (:pupil pal/index-of)}
(aget (:buf after) i))]
i))]
(is (pos? (count eye)) (str "frame " f ": the iris drew something"))
(is (empty? (remove card eye))
(str "frame " f ": " (count (remove card eye)) " pixels outside the card")))))))
;; ---- the palette is a parameter, not a global ----
(deftest the-same-scene-resolves-differently-under-a-different-ramp
;; A node names a TONE; which ramp that tone is read in belongs to the timeline
;; it sits in. So resolution must not reach for one ambient answer — the same
;; drawing has to read day or night without a stored value changing, which is
;; the entire payoff of indexed colour.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))
day {:skin-base 1}
night {:skin-base 17}]
(is (= 1 (:color (first (symbol/eval-frame s 0 nil day)))))
(is (= 17 (:color (first (symbol/eval-frame s 0 nil night)))))
(is (= 17 (:color (first ((symbol/resolver s nil night) 0))))
"and the playback path agrees")))
(deftest a-tone-the-ramp-does-not-define-is-loudly-wrong
;; 255 renders magenta. Naming a colour the ramp has no entry for is a bug in
;; authored data and should be impossible to miss.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))]
(is (= 255 (:color (first (symbol/eval-frame s 0 nil {})))))))
(deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil
;; A stencil is a colour key, so two nodes sharing a tone share a stencil —
;; a real weakness of the technique. Concatenating the named palettes into one
;; index space means two nodes in DIFFERENT palettes cannot collide at all.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 20 0 20 20] :eye-white)
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})
;; :night's tones sit above :day's in one concatenated space
night {:eye-white 14 :iris 15}
ops (symbol/eval-frame s 0 nil night)]
(is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in")))

View file

@ -1,397 +0,0 @@
(ns arthur.domain.timeline-test
"Frame evaluation, and the hand-written scene.
port-plan step 2 exists to find out whether the data model works BEFORE nine
hundred lines of measurement are ported into it, so these assertions are about
the model's claims rather than about a look: that structure is flat and
addressable, that draw order is authored, that time maps compose, that
presence and visibility are different questions, and that the fast path and the
specification give the same frame."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo :as demo]
[arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.clip :as clip]
[arthur.domain.timeline :as timeline]
[arthur.support.ops :as ops]))
(defn- poly [id parent z pts color & [extra]]
(merge {:id id :kind :poly :parent parent :z z
:channels {[:geom :pts] (ch/framed pts)
[:style :color] (ch/framed color)}}
extra))
(defn- sc [& nodes]
{:nodes (into {} (map (juxt :id identity)) nodes)})
(defn- ids-at [scene f]
(mapv :node (timeline/eval-frame scene f)))
(def ^:private pts-of ops/points)
;; ---- structure ----
(deftest depth-order-puts-every-node-after-its-parent
(let [s (sc {:id :a :kind :group :z "a1"}
{:id :b :kind :group :parent :a :z "a1"}
{:id :c :kind :group :parent :b :z "a1"}
{:id :d :kind :group :parent :a :z "a2"})
ord (timeline/order (:nodes s))]
(is (= 0 (timeline/depth (:nodes s) :a)))
(is (= 2 (timeline/depth (:nodes s) :c)))
(let [pos (into {} (map-indexed (fn [i id] [id i])) ord)]
(doseq [[id p] [[:b :a] [:c :b] [:d :a]]]
(is (< (get pos p) (get pos id)) (str p " must come before " id))))))
(deftest a-parent-cycle-throws-instead-of-hanging
;; Reachable from one bad :node/set-parent, and a hung tab is a far worse
;; diagnostic than a stack trace naming the nodes.
(let [s (sc {:id :a :kind :group :parent :b :z "a1"}
{:id :b :kind :group :parent :a :z "a1"})]
(is (thrown-with-msg? ExceptionInfo #"cycle" (timeline/order (:nodes s))))
(is (seq (timeline/problems s)))))
(deftest a-missing-parent-is-named-rather-than-silently-orphaning
(let [s (sc {:id :a :kind :group :parent :nope :z "a1"})]
(is (seq (timeline/problems s)))))
(deftest reparenting-is-one-field-and-does-not-move-a-subtree
;; The flat-with-pointers claim, asserted as the thing it buys: a reparent is an
;; assoc-in at one node, and nothing else in the map changes identity — which is
;; what keeps re-frame's ancestor subs from invalidating.
(let [s (sc {:id :a :kind :group :z "a1"}
{:id :b :kind :group :z "a2" :channels {[:xform :pos] (ch/framed [100 0])}}
(poly :c :a "a1" [0 0 10 0 10 10] :brow))
s' (assoc-in s [:nodes :c :parent] :b)]
(is (identical? (get-in s [:nodes :a]) (get-in s' [:nodes :a]))
"the old parent is the same object")
(is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b]))
"and so is the new one")
(is (= [[0 0] [10 0] [10 10]]
(pts-of (first (filter #(= :c (:node %)) (timeline/eval-frame s 0))))))
(is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (timeline/eval-frame s' 0))))))))
;; ---- draw order ----
(deftest draw-order-is-depth-first-by-sibling-z
;; z is a fractional index among siblings, so the sort key is the chain of z
;; values from the root. A parent's chain is a PREFIX of its child's, which is
;; why a parent draws before its children without that being a special case.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :under :root "a0" [0 0 1 0 1 1] :bg)
{:id :mid :kind :group :parent :root :z "a1"}
(poly :deep :mid "a5" [0 0 1 0 1 1] :brow)
(poly :over :root "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:under :deep :over] (ids-at s 0)))))
(deftest a-deep-child-of-an-early-sibling-still-draws-before-a-later-sibling
;; The failure this guards: comparing z paths with `compare` would compare
;; COUNT first, so a painted cel three levels under "a1" would jump in front of
;; a bare "a2". It reads as a layer order that mostly works.
(let [s (sc {:id :root :kind :group :z "a1"}
{:id :g1 :kind :group :parent :root :z "a1"}
{:id :g2 :kind :group :parent :g1 :z "a1"}
(poly :deep :g2 "a1" [0 0 1 0 1 1] :brow)
(poly :shallow :root "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:deep :shallow] (ids-at s 0)))))
(deftest a-fractional-index-inserts-between-two-siblings-without-renumbering
(let [base (sc {:id :root :kind :group :z "a1"}
(poly :a :root "a1" [0 0 1 0 1 1] :bg)
(poly :c :root "a3" [0 0 1 0 1 1] :teeth))
with (assoc-in base [:nodes :b] (poly :b :root "a2" [0 0 1 0 1 1] :brow))]
(is (= [:a :c] (ids-at base 0)))
(is (= [:a :b :c] (ids-at with 0)))
(is (= (get-in base [:nodes :a]) (get-in with [:nodes :a])) "and :a is untouched")))
;; ---- transform composition through the tree ----
(deftest geometry-lands-in-the-parents-space
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] (ch/framed [100 50])
[:xform :scale] (ch/framed [2 2])}}
(poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base))
op (first (timeline/eval-frame s 0))]
(is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op)))))
(deftest a-keyed-group-position-moves-its-children-and-holds-between-keys
;; This is the scene the plan asks for, minimally: a rectangle parented to a
;; group whose [:xform :pos] is keyed on four frames.
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos]
(ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]})}}
(poly :p :g "a1" [0 0 2 0 2 2] :skin-base))
at #(first (pts-of (first (timeline/eval-frame s %))))]
(is (= [0 0] (at 0)))
(is (= [0 0] (at 3)) "held")
(is (= [10 0] (at 4)))
(is (= [10 10] (at 8)))
(is (= [0 10] (at 12)))
(is (= [0 10] (at 99)) "and holds the last key")))
;; ---- time maps compose along the chain ----
(deftest exposure-on-the-root-is-inherited-by-everything-under-it
;; docs/design.md is emphatic that everything rides ONE grid: a head cutting on
;; odd frames against a mouth cutting on even ones reads as two performances.
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}}
{:id :g :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (timeline/eval-frame s %)))))]
(is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12)))))
(testing "and a node may set its own grid, which the model permits deliberately"
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}}
{:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4}
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (timeline/eval-frame s %)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
;; 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.
(let [keys (into {} (map (juxt identity #(vector % 0))) (range 12))
s (sc {:id :root :kind :group :z "a1"}
{:id :plate :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed keys)}}
(poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base)
{:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2}
:channels {[:xform :pos] (ch/keyed keys)}}
(poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark))
x-of (fn [f id] (->> (timeline/eval-frame s f)
(filter #(= id (:node %))) first pts-of first first))]
(is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4))))
(is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead")))
;; ---- span and visibility are different questions ----
(deftest span-removes-a-node-and-vis-switches-it-off
;; :span is Lottie's ip/op and Flash's PlaceObject/RemoveObject: the range over
;; which the node EXISTS. [:vis] blinks an existing node on and off. Conflating
;; them is how you end up with a part that holds a stale pose outside its range.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 1 0 1 1] :brow
{:span [2 5]
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])
[:style :color] (ch/framed :brow)
[:vis] (ch/keyed {0 true, 3 false, 4 true})}}))]
(is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7))))))
(deftest a-hidden-group-takes-its-children-with-it
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:vis] (ch/keyed {0 true, 2 false})}}
(poly :p :g "a1" [0 0 1 0 1 1] :brow))]
(is (= [:p] (ids-at s 0)))
(is (= [] (ids-at s 2)))))
(deftest an-absent-transform-drops-the-subtree-and-an-absent-geometry-does-not
;; The asymmetry is the whole reason presence is tracked per CHANNEL rather than
;; per node. An absent mouth outline has nothing to draw, but the head it hangs
;; off is still exactly where it was.
(let [state (js/Uint8Array. #js [ch/present ch/absent-bit])
store {"pos" {:data (js/Float32Array. #js [0 0, 0 0]) :state state}
"pts" {:data (js/Int16Array. #js [0 0 1 0 1 1, 0 0 1 0 1 1]) :state state}}
absent-pos (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] {:animated? true
:dense {:store "pos" :offset 0 :stride 2 :frames 2}}}}
(poly :child :g "a1" [0 0 1 0 1 1] :brow))
absent-pts (sc {:id :g :kind :group :z "a1"}
{:id :m :kind :poly :parent :g :z "a1"
:channels {[:geom :pts] {:animated? true
:dense {:store "pts" :offset 0 :stride 6 :frames 2}}
[:style :color] (ch/framed :mouth-dark)}}
(poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:child] (mapv :node (timeline/eval-frame absent-pos 0 store))))
(is (= [] (mapv :node (timeline/eval-frame absent-pos 1 store)))
"an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (timeline/eval-frame absent-pts 0 store))))
(is (= [:teeth] (mapv :node (timeline/eval-frame absent-pts 1 store)))
"an absent outline removes only itself")))
;; ---- stencils ----
(deftest a-stencil-resolves-to-the-stencil-nodes-palette-index
;; A stencil is a COLOUR KEY, not a node reference — the take format's clip= —
;; and the indexed buffer being its own clip mask is what keeps the iris inside
;; the eye at any gaze and any radius with no clamp anywhere.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white)
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})
ops (timeline/eval-frame s 0)]
(is (= [:sclera :iris] (mapv :node ops)))
(is (= (:eye-white pal/index-of) (:stencil (second ops))))))
(deftest a-node-stencilled-by-something-that-drew-nothing-is-dropped
;; Unclipped would be an iris floating over the cheek on exactly the frames
;; where the eye is missing, which is worse than a missing iris.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white
{:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10])
[:style :color] (ch/framed :eye-white)
[:vis] (ch/keyed {0 true, 1 false})}})
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})]
(is (= [:sclera :iris] (ids-at s 0)))
(is (= [] (ids-at s 1)))))
;; ---- discs and rects ----
(deftest disc-and-rect-extents-retain-precision-for-enclosing-instances
(let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] (ch/framed [50 60]) [:xform :scale] (ch/framed [2 2])}}
{:id :d :kind :disc :parent :g :z "a1"
:channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}}
{:id :r :kind :rect :parent :g :z "a2"
:channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}})
[d r] (timeline/eval-frame s 0)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
(is (= 3.4 (:size r)))))
;; ---- the fast path and the specification agree ----
(deftest the-resolver-agrees-with-eval-frame-in-any-frame-order
;; THE assertion of this step. The resolver caches the topological order and the
;; z paths, holds a cursor per channel and reuses one point buffer per node, and
;; every one of those is a way to be subtly wrong on some frames and not others
;; — which presents as a bad take rather than as an error.
;; The frame orders and the snapshot live in `arthur.support.ops`, because the
;; same comparison is what proves a scene survived the server — see
;; flow/project-test.
(let [s demo/timeline
spec (ops/specified s nil)
fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders (:frames s))]
(testing label
(doseq [f fs]
(is (= (spec f) (fast f)) (str label " at frame " f)))))))
(deftest the-resolver-reuses-one-buffer-per-node
;; At 30fps per-frame allocation is the only thing that will make this stutter,
;; and fixed topology is what makes the buffer size knowable at all.
(let [res (timeline/resolver demo/timeline)
buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))]
(is (identical? (buf-of 0 :card) (buf-of 30 :card)))))
;; ---- the hand-written scene, end to end ----
(deftest the-hand-written-clip-is-valid
;; `clip/problems` rather than `timeline/problems`: it checks the clip's fields,
;; the timeline map and the tracking identities as well as the nodes, so it is
;; the check a save would make.
(let [ps (clip/problems demo/clip)]
(is (empty? ps) (pr-str ps)))
(is (pos? demo/frames))
(testing "a clip is not a timeline, and handing one over fails loudly"
;; The mistake this split makes easy: both are maps with an :id, and the wrong
;; one resolves to no ops rather than to an error.
(is (thrown-with-msg? ExceptionInfo #"not a timeline"
(timeline/resolver demo/clip)))
(is (thrown-with-msg? ExceptionInfo #"not a timeline"
(timeline/eval-frame demo/clip 0)))))
(deftest the-hand-written-clip-renders-and-moves
;; port-plan step 2's done condition, as an assertion rather than a look: the
;; scene rasterises, it writes only palette indices, and the pixels are not the
;; same on every frame.
(let [res (timeline/resolver demo/timeline)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
r))
frames (mapv render (range 0 demo/frames 6))
sig (fn [r] (vec (array-seq (:buf r))))]
(is (every? (fn [r] (every? #(< % (count pal/rgb)) (array-seq (:buf r)))) frames)
"every byte written is a real palette index")
(is (> (count (distinct (map sig frames))) 1) "something moves")
(testing "the mark actually covers pixels"
(is (pos? (count (remove zero? (sig (first frames)))))))))
(deftest the-hand-written-clip-steps-on-the-exposure-grid
;; Exposure 2 on the clip root, inherited, so odd frames are identical to the
;; even frame before them. If this fails, exposure is being applied somewhere
;; other than the frame the channels are sampled at.
(let [res (timeline/resolver demo/timeline)
render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of))
(raster/draw-ops! r (res f))
(vec (array-seq (:buf r)))))]
(doseq [f (range 0 demo/frames 2)]
(is (= (render f) (render (inc f))) (str "frame " (inc f) " must hold frame " f)))
;; Two grid slots that straddle a key, not two adjacent ones: between keys
;; nothing changes, because that is what hold MEANS. The scene's second key
;; is at 57, and exposure 2 floors that onto 58 — which is itself the
;; expose-before-anything-else rule showing up in pixels.
(is (not= (render 56) (render 58)) "and a key on the grid is seen")))
(deftest the-hand-written-clip-keeps-the-iris-and-pupil-inside-the-card
;; The stencil chain, on real pixels: the iris is clipped by the card and the
;; pupil by the iris, and neither is expressed anywhere as a chain.
(let [res (timeline/resolver demo/timeline)]
(doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/clip) (:height demo/clip))
ops (res f)
card? (fn [op] (= :card (:node op)))]
(raster/clear! before (:bg pal/index-of))
(raster/draw-ops! before (filter card? ops))
(raster/clear! after (:bg pal/index-of))
(raster/draw-ops! after ops)
(let [ci (:skin-base pal/index-of)
card (set (for [i (range (alength (:buf before)))
:when (= ci (aget (:buf before) i))]
i))
eye (set (for [i (range (alength (:buf after)))
:when (#{(:iris pal/index-of) (:pupil pal/index-of)}
(aget (:buf after) i))]
i))]
(is (pos? (count eye)) (str "frame " f ": the iris drew something"))
(is (empty? (remove card eye))
(str "frame " f ": " (count (remove card eye)) " pixels outside the card")))))))
;; ---- the palette is a parameter, not a global ----
(deftest the-same-scene-resolves-differently-under-a-different-ramp
;; A node names a TONE; which ramp that tone is read in belongs to the timeline
;; it sits in. So resolution must not reach for one ambient answer — the same
;; drawing has to read day or night without a stored value changing, which is
;; the entire payoff of indexed colour.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))
day {:skin-base 1}
night {:skin-base 17}]
(is (= 1 (:color (first (timeline/eval-frame s 0 nil day)))))
(is (= 17 (:color (first (timeline/eval-frame s 0 nil night)))))
(is (= 17 (:color (first ((timeline/resolver s nil night) 0))))
"and the playback path agrees")))
(deftest a-tone-the-ramp-does-not-define-is-loudly-wrong
;; 255 renders magenta. Naming a colour the ramp has no entry for is a bug in
;; authored data and should be impossible to miss.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))]
(is (= 255 (:color (first (timeline/eval-frame s 0 nil {})))))))
(deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil
;; A stencil is a colour key, so two nodes sharing a tone share a stencil —
;; a real weakness of the technique. Concatenating the named palettes into one
;; index space means two nodes in DIFFERENT palettes cannot collide at all.
(let [s (sc {:id :root :kind :group :z "a1"}
(poly :sclera :root "a1" [0 0 20 0 20 20] :eye-white)
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})
;; :night's tones sit above :day's in one concatenated space
night {:eye-white 14 :iris 15}
ops (timeline/eval-frame s 0 nil night)]
(is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in")))

View file

@ -5,7 +5,7 @@
is NAMESPACED (`:sym/face-8625`) and a placement's is a UUID, and the panel puts
both into `<option value>`s and reads them back out of a change event. Writing
that value with `name` drops the `sym`, the id comes back `:face-8625`, it
matches no key in `:timelines`, and `export/run!` throws from inside re-frame's
matches no key in `:symbols`, and `export/run!` throws from inside re-frame's
`:do-fx` where nothing catches it: `:busy?` latches on and the readout sits at
\"frame 0 /\" forever with nothing in the status line.
@ -17,12 +17,12 @@
(def ^:private a-uuid #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218")
(deftest every-kind-of-target-survives-the-round-trip
(doseq [t [{:timeline :main}
{:timeline :sym/face-8625}
{:timeline :main :isolate a-uuid}
{:timeline :sym/face-8625 :isolate a-uuid}]]
(doseq [t [{:symbol :main}
{:symbol :sym/face-8625}
{:symbol :main :isolate a-uuid}
{:symbol :sym/face-8625 :isolate a-uuid}]]
(let [back (export/target-id (export/target-value t))]
(is (= (:timeline t) (:timeline back))
(is (= (:symbol t) (:symbol back))
(str (pr-str t) " -> " (pr-str (export/target-value t))))
(is (= (:isolate t) (:isolate back)))
(testing "and a placement comes back a uuid, not a string or a keyword"
@ -31,15 +31,15 @@
(deftest the-value-keeps-the-namespace-and-marks-the-two-kinds
;; Spelled out, because these are the strings that end up in the DOM.
(is (= "t:main" (export/target-value {:timeline :main})))
(is (= "t:sym/face-8625" (export/target-value {:timeline :sym/face-8625})))
(is (= "s:main" (export/target-value {:symbol :main})))
(is (= "s:sym/face-8625" (export/target-value {:symbol :sym/face-8625})))
(is (= (str "n:main:" a-uuid)
(export/target-value {:timeline :main :isolate a-uuid}))))
(export/target-value {:symbol :main :isolate a-uuid}))))
(deftest a-whole-timeline-has-no-isolate
(deftest a-whole-symbol-has-no-isolate
;; Switching from a placement back to the clip must clear it, or the new target
;; would still be filtered down to one node that may not even be in it.
(is (nil? (:isolate (export/target-id "t:main")))))
(is (nil? (:isolate (export/target-id "s:main")))))
(deftest the-old-encoding-is-the-bug
;; A guard against someone "simplifying" this back to `name`. `name` is lossy on
@ -55,37 +55,37 @@
"A clip with one symbol in its library, placed twice, plus a decoy: a node that
is not a symbol must not show up as a face."
{:fps 30 :width 320 :height 200
:timelines
:symbols
{:main {:frames 280
:nodes {:root {:id :root :kind :group :z "a1"}
#uuid "22222222-2222-4222-8222-222222222222"
{:id #uuid "22222222-2222-4222-8222-222222222222"
:kind :symbol :of :sym/face :parent :root :z "a2"
:kind :instance :of :sym/face :parent :root :z "a2"
:name "8625 right"}
#uuid "11111111-1111-4111-8111-111111111111"
{:id #uuid "11111111-1111-4111-8111-111111111111"
:kind :symbol :of :sym/face :parent :root :z "a1"
:kind :instance :of :sym/face :parent :root :z "a1"
:name "8625 left"}
:a-rect {:id :a-rect :kind :rect :parent :root :z "a3"}}}
:sym/face {:frames 40 :nodes {:root {:id :root :kind :group :z "a1"}}}}})
(deftest the-picker-offers-the-clip-the-drawing-and-every-placement
(let [ts (export/targets clip)]
(is (= ["main (the clip)" "face" "8625 left" "8625 right"] (mapv :label ts))
"the clip, then the library, then the placements")
(testing "the placements isolate a node on :main and the library ones do not"
(deftest the-picker-offers-every-symbol-then-every-instance-in-the-open-one
(let [ts (export/targets clip :main)]
(is (= ["main" "face" "8625 left" "8625 right"] (mapv :label ts))
"every symbol, then the instances in the open one")
(testing "the instances isolate a node in the open symbol and the symbols do not"
(is (= [nil nil] (mapv :isolate (take 2 ts))))
(is (every? uuid? (mapv :isolate (drop 2 ts))))
(is (every? #(= :main (:timeline %)) (drop 2 ts))))
(is (every? #(= :main (:symbol %)) (drop 2 ts))))
(testing "ordered by label, because a uuid sorts at random"
(is (= ["8625 left" "8625 right"] (mapv :label (drop 2 ts)))))
(testing "and a node that is not a symbol is not a placement"
(testing "and a node that is not an instance is not offered"
(is (not-any? #{"a-rect"} (map :label ts))))))
(deftest every-offered-target-round-trips
;; The picker and the encoding asserted against each other, so neither can drift
;; into offering something that cannot be selected.
(doseq [t (export/targets clip)]
(let [norm #(merge {:isolate nil} (select-keys % [:timeline :isolate]))
(doseq [t (export/targets clip :main)]
(let [norm #(merge {:isolate nil} (select-keys % [:symbol :isolate]))
back (export/target-id (export/target-value t))]
(is (= (norm t) (norm back)) (pr-str t)))))

View file

@ -144,7 +144,7 @@
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest a-silent-timeline-produces-no-wav
(deftest a-silent-symbol-produces-no-wav
(async done
(-> (run-default! {:n 2 :audio nil})
(.then (fn [{:keys [entries]}]

View file

@ -24,7 +24,7 @@
{:id id :kind :poly :z z
:channels {[:geom :pts] (ch/framed pts) [:style :color] (ch/framed color)}})
(defn- a-timeline
(defn- a-symbol
"One authored square under a `:root` group. Picture sampling now applies to
marked generated channels in the shared resolver, leaving this square alone."
[frames]
@ -37,7 +37,7 @@
matters is its frame space — so it is the smallest thing that resolves to an op."
[{:keys [frames fps w h] :or {frames 10 fps 24 w 8 h 6}}]
{:name "t" :fps fps :width w :height h
:timelines {clip/root-id (a-timeline frames)}})
:symbols {:main (a-symbol frames)}})
(defn- recorder
"An `Exporter` that records the calls rather than encoding anything.
@ -57,7 +57,7 @@
"Run an export over `clip`, returning a promise of the recorded log."
[clip & {:as opts}]
(let [log (atom {})]
(-> (export/run! (merge {:clip clip :timeline clip/root-id :store {}
(-> (export/run! (merge {:clip clip :symbol :main :store {}
:palette pal/index-of :ramp pal/rgb :zoom 1
:name "t"}
opts)
@ -68,7 +68,7 @@
;; ---- plan ----
(deftest plan-reports-what-the-export-will-be
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24 :w 320 :h 200}) :timeline clip/root-id :zoom 3})]
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24 :w 320 :h 200}) :symbol :main :zoom 3})]
(is (= 48 (:frames p)))
(is (= 24 (:fps p)))
(is (= 3 (:zoom p)))
@ -78,7 +78,7 @@
(deftest the-zoom-is-an-integer-of-at-least-one
;; Anything else resamples, and a zoom of 0 would be a zero-byte picture.
(let [zoom-of #(:zoom (export/plan {:clip (a-clip {}) :timeline clip/root-id :zoom %}))]
(let [zoom-of #(:zoom (export/plan {:clip (a-clip {}) :symbol :main :zoom %}))]
(is (= 2 (zoom-of 2.7)) "truncated, not rounded")
(is (= 1 (zoom-of 0)))
(is (= 1 (zoom-of -4)))
@ -90,19 +90,19 @@
;; 12fps picture rate it is still 48 frames and two seconds, holding 24 poses.
;; If :frames ever tracks :poses here, every export at a reduced picture rate
;; comes out half length with the audio sliding off it.
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :timeline clip/root-id
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :symbol :main
:picture-fps 12})]
(is (= 48 (:frames p)) "the frame count does not move")
(is (= 2 (:seconds p)) "and neither does the duration")
(is (= 24 (:poses p)) "but the picture holds half as many poses"))
(testing "a picture rate at or above the clip's rate changes nothing"
(doseq [fps [24 48 nil]]
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :timeline clip/root-id
(let [p (export/plan {:clip (a-clip {:frames 48 :fps 24}) :symbol :main
:picture-fps fps})]
(is (= 48 (:poses p)) (str "picture-fps " fps))))))
(deftest plan-of-a-timeline-that-is-not-there-is-nothing
(is (nil? (export/plan {:clip (a-clip {}) :timeline :nope :zoom 1}))))
(deftest plan-of-a-symbol-that-is-not-there-is-nothing
(is (nil? (export/plan {:clip (a-clip {}) :symbol :nope :zoom 1}))))
;; ---- the walk ----
@ -176,25 +176,25 @@
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest exporting-a-timeline-that-is-not-there-is-an-error
(deftest exporting-a-symbol-that-is-not-there-is-an-error
;; And it names the timelines that ARE there, because the id came from a UI and
;; "no such timeline" alone does not say what went wrong.
(let [thrown (try (export/run! {:clip (a-clip {}) :timeline :nope :store {}
(let [thrown (try (export/run! {:clip (a-clip {}) :symbol :nope :store {}
:palette pal/index-of :ramp pal/rgb}
(recorder (atom {})) nil)
nil
(catch :default e e))]
(is (some? thrown) "it throws rather than resolving to an empty archive")
(is (= [clip/root-id] (:timelines (ex-data thrown))))))
(is (= [:main] (:symbols (ex-data thrown))))))
(deftest a-symbol-is-exported-by-being-rooted-at-its-own-frame-space
;; "Render that symbol" is rooting the resolver at it, so the walk's length is
;; the SYMBOL's frame count and not the clip's.
(async done
(let [c (assoc-in (a-clip {:frames 30})
[:timelines :sym]
(a-timeline 4))]
(-> (run!* c :timeline :sym)
[:symbols :sym]
(a-symbol 4))]
(-> (run!* c :symbol :sym)
(.then (fn [{:keys [frames spec]}]
(is (= 4 (count frames)) "the symbol's four frames, not the clip's 30")
(is (= 4 (:frames spec)))
@ -218,23 +218,23 @@
it needs no clock."
[& {:keys [voice?]}]
{:name "stage" :fps 30 :width 8 :height 6
:timelines
{clip/root-id
:symbols
{:main
{:frames 12
:nodes (cond-> {:root {:id :root :kind :group :z "a1"}
p1 {:id p1 :kind :symbol :of :sym/face :parent :root :z "a1"
p1 {:id p1 :kind :instance :of :sym/face :parent :root :z "a1"
:name "left" :channels {[:xform :pos] (ch/framed [0 0])}}
p2 {:id p2 :kind :symbol :of :sym/face :parent :root :z "a2"
p2 {:id p2 :kind :instance :of :sym/face :parent :root :z "a2"
:name "right" :channels {[:xform :pos] (ch/framed [4 0])}}
:loose (assoc (poly :loose "a4" [0 0 1 0 1 1] :brow)
:parent :root)}
voice? (assoc v1 {:id v1 :kind :audio :parent :root :z "a3"
:linked-to p1 :source {:footage "f"} :span [0 12]}))}
:sym/face (a-timeline 6)}})
:sym/face (a-symbol 6)}})
(deftest isolating-keeps-the-placement-its-chain-and-its-voice
(let [tl (clip/timeline (staged :voice? true) clip/root-id)
kept (set (keys (:nodes (export/isolate tl p1))))]
(let [sym (clip/symbol (staged :voice? true) :main)
kept (set (keys (:nodes (export/isolate sym p1))))]
(is (contains? kept p1) "the placement itself")
(is (contains? kept :root) "and the root it hangs from, or it would move")
(is (contains? kept v1) "and the voice linked to it")
@ -246,24 +246,24 @@
(deftest isolating-the-other-placement-drops-the-first-s-voice
;; The voice is linked to p1, so isolating p2 must not carry it: an isolated
;; export that kept every track would have the whole stage's sound over one face.
(let [tl (clip/timeline (staged :voice? true) clip/root-id)
kept (set (keys (:nodes (export/isolate tl p2))))]
(let [sym (clip/symbol (staged :voice? true) :main)
kept (set (keys (:nodes (export/isolate sym p2))))]
(is (= #{:root p2} kept))))
(deftest isolating-nothing-leaves-the-timeline-alone
(let [tl (clip/timeline (staged :voice? true) clip/root-id)]
(is (= tl (export/isolate tl nil)))
(deftest isolating-nothing-leaves-the-symbol-alone
(let [sym (clip/symbol (staged :voice? true) :main)]
(is (= sym (export/isolate sym nil)))
(testing "and so does isolating a node that is not there"
(is (= tl (export/isolate tl (random-uuid)))))))
(is (= sym (export/isolate sym (random-uuid)))))))
(deftest isolating-keeps-the-frame-space
;; What makes this different from exporting the symbol the placement plays: the
;; STAGE's length and rate are what comes out, not the drawing's own.
(let [c (staged)]
(is (= 12 (:frames (export/plan {:clip c :timeline clip/root-id :isolate p1}))))
(is (= 6 (:frames (export/plan {:clip c :timeline :sym/face})))
(is (= 12 (:frames (export/plan {:clip c :symbol :main :isolate p1}))))
(is (= 6 (:frames (export/plan {:clip c :symbol :sym/face})))
"the drawing's own frame space is its own")
(is (= 30 (:fps (export/plan {:clip c :timeline clip/root-id :isolate p1}))))))
(is (= 30 (:fps (export/plan {:clip c :symbol :main :isolate p1}))))))
(deftest an-isolated-walk-emits-the-stage-s-frames
(async done

View file

@ -5,7 +5,7 @@
[arthur.domain.clip :as clip]
[arthur.domain.landmarks :as lm]
[arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[arthur.flow.condition.eyes :as condition-eyes]
[arthur.flow.ingest :as ingest]
[arthur.flow.measure.eyes :as eyes]
@ -50,7 +50,7 @@
(assoc take/params :aspect 1 :name "observed-gap")
{:face-1 {:dense @take/analysis :presence presence}})
sample (fn [id frame]
(ch/value-at (get-in (:nodes (clip/timeline clip :face-1)) [id :channels [:geom :pts]])
(ch/value-at (get-in (:nodes (clip/symbol clip :face-1)) [id :channels [:geom :pts]])
frame store))]
(is (empty? (clip/problems clip)))
(is (= [:face-1/eye-r :face-1/eye-l] (get-in clip [:groups :face-1/eyes :members])))
@ -59,7 +59,7 @@
(is (not (ch/nothing? (sample :eye-l f))))
(is (not (ch/nothing? (sample :mouth f)))))
(let [drawn (into #{} (map :node)
((timeline/resolver (clip/timeline clip :face-1) store pal/index-of) 11))]
((symbol/resolver (clip/symbol clip :face-1) store pal/index-of) 11))]
(is (not (contains? drawn :eye-r)))
(is (not (contains? drawn :iris-r)))
(is (contains? drawn :eye-l))

View file

@ -18,7 +18,7 @@
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
[arthur.domain.ring :as ring]
[arthur.domain.timeline :as timeline]
[arthur.domain.symbol :as symbol]
[arthur.flow.freeze :as freeze]))
(def ^:private W 320)
@ -32,9 +32,9 @@
(def clip* (delay (:clip @frozen)))
;; Geometry assertions read the face timeline. Rendering assertions resolve
;; the whole clip, including placement and inherited exposure.
(defn- face-timeline [c] (clip/timeline c :face-1))
(defn- nodes [c] (merge (clip/nodes c) (:nodes (face-timeline c))))
(def tl* (delay (face-timeline @clip*)))
(defn- face-symbol [c] (clip/symbol c :face-1))
(defn- nodes [c] (merge (:nodes (clip/symbol c :main)) (:nodes (face-symbol c))))
(def sym* (delay (face-symbol @clip*)))
(def store (delay (:store @frozen)))
(defn- node [id] (get (nodes @clip*) id))
@ -53,8 +53,8 @@
(defn- ops-at
"Ops for one frame of a TIMELINE."
[tl f]
((timeline/resolver tl @store pal/index-of) f))
[sym f]
((symbol/resolver sym @store pal/index-of) f))
(defn- render
"One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
@ -62,7 +62,7 @@
[c f]
(let [r (raster/make (:width c) (:height c))]
(raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r ((clip/resolver c @store pal/index-of) f))
(raster/draw-ops! r ((clip/resolver c @store pal/index-of :main) f))
(vec (array-seq (:buf r)))))
(defn- drawn
@ -86,11 +86,11 @@
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))))
(deftest the-tree-is-the-one-the-model-specifies
(is (= [:face :root] (timeline/lineage (clip/nodes @clip*) :face)))
(is (= :face-1 (get-in @clip* [:timelines :main :nodes :face-1 :of])))
(is (= [:head] (timeline/lineage (:nodes @tl*) :head)))
(is (= [:mouth :head] (timeline/lineage (:nodes @tl*) :mouth)))
(is (= [:mouth-in :mouth :head] (timeline/lineage (:nodes @tl*) :mouth-in)))
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
(is (= :face-1 (get-in @clip* [:symbols :main :nodes :face-1 :of])))
(is (= [:head] (symbol/lineage (:nodes @sym*) :head)))
(is (= [:mouth :head] (symbol/lineage (:nodes @sym*) :mouth)))
(is (= [:mouth-in :mouth :head] (symbol/lineage (:nodes @sym*) :mouth-in)))
(is (= {:mode :map :expose 2} (:time (node :root))))
(is (every? #(nil? (:time (node %))) [:face :head :mouth :mouth-in])))
@ -195,7 +195,7 @@
;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
;; and `emit` as well.
(let [c (freeze/head-mode {:mode :free} @frozen)
res (clip/resolver c @store pal/index-of)
res (clip/resolver c @store pal/index-of :main)
k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos]))
@ -252,16 +252,16 @@
"anchor source addresses survive the document round trip")))
(deftest head-anchor-keys-hold-the-whole-measured-transform
(let [free (timeline/resolver (face-timeline
(let [free (symbol/resolver (face-symbol
(freeze/head-mode {:mode :free} @frozen))
@store pal/index-of)
held (timeline/resolver (face-timeline
held (symbol/resolver (face-symbol
(freeze/head-mode {:mode :anchored
:anchors {0 12, 40 88}} @frozen))
@store pal/index-of)
world (fn [resolver frame]
(resolver frame)
(vec (array-seq (timeline/world-of resolver :head))))]
(vec (array-seq (symbol/world-of resolver :head))))]
(is (= (world free 12) (world held 0)))
(is (= (world free 12) (world held 38)))
(is (= (world free 88) (world held 40)))
@ -285,7 +285,7 @@
(get-in (nodes x) [:head :measured])))
;; And nothing above the timeline moved either: the toggle is one node's
;; channels, so the clip's own fields and its other timelines are untouched.
(is (= (dissoc a :timelines) (dissoc x :timelines))))))
(is (= (dissoc a :symbols) (dissoc x :symbols))))))
(deftest invalid-head-anchor-maps-are-refused
(is (thrown-with-msg? ExceptionInfo #"free or anchored"
@ -371,7 +371,7 @@
;; interior comes and goes.
(is (nil? (chan :mouth [:vis])))
(doseq [f (range 0 take/frames 9)]
(is (some #(= :mouth (:node %)) (ops-at @tl* f))
(is (some #(= :mouth (:node %)) (ops-at @sym* f))
(str "frame " f " drew no mouth outline"))))
;; ---------------------------------------------------------------------------
@ -403,8 +403,8 @@
(let [strip-node (fn [n]
(update n :channels
#(into {} (map (fn [[p c]] [p (dissoc c :generated)])) %)))
stripped (clip/update-root
@clip*
stripped (clip/update-symbol
@clip* :main
update :nodes
#(into {} (map (fn [[id n]] [id (strip-node n)])) %))]
(doseq [f (range 0 take/frames 17)]
@ -419,9 +419,9 @@
presence {:eye-r (mapv #(not (contains? gap %)) (range take/frames))}
c (freeze/clip (assoc take/params :name "one-eye-gappy")
{:face-1 (assoc @take/measured :presence presence)})
tl (face-timeline (:clip c))
sym (face-symbol (:clip c))
at (fn [id f]
(ch/value-at (get-in (:nodes tl) [id :channels [:geom :pts]]) f (:store c)))]
(ch/value-at (get-in (:nodes sym) [id :channels [:geom :pts]]) f (:store c)))]
;; The identities are the CLIP's, and a gap does not touch them: a feature keeps
;; its id and its pair membership across the frames it was not observed on.
(is (= [:face-1/eye-r :face-1/eye-l] (get-in (:clip c) [:groups :face-1/eyes :members])))
@ -431,7 +431,7 @@
(is (not (ch/nothing? (at :eye-r 60))))
(is (not (ch/nothing? (at :eye-l 50))))
(is (not (ch/nothing? (at :mouth 50))))
(let [drawn-nodes (into #{} (map :node) ((timeline/resolver tl (:store c) pal/index-of) 50))]
(let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of) 50))]
(is (not (contains? drawn-nodes :eye-r)))
(is (contains? drawn-nodes :eye-l))
(is (contains? drawn-nodes :mouth)))
@ -457,9 +457,9 @@
windows)
c (freeze/clip (assoc take/params :name "per-track-gaps")
{:face-1 (assoc @take/measured :presence presence)})
tl (face-timeline (:clip c))
sym (face-symbol (:clip c))
at (fn [id path f]
(ch/value-at (get-in (:nodes tl) [id :channels path]) f (:store c)))
(ch/value-at (get-in (:nodes sym) [id :channels path]) f (:store c)))
;; Node, channel, and the feature whose gap it must follow. Every dense
;; track of the eye, iris, brow and brow-position blocks appears once.
tracks [[:eye-r [:geom :pts] :eye-r]
@ -485,7 +485,7 @@
(deftest teeth-follow-the-mouth-through-their-stencil-and-not-through-a-mask
;; Teeth are their own feature, so that they can carry their own :area :teeth
;; parameters — which means an occluded MOUTH sets no absence bit on them. They
;; do not need one: they are stencilled by :mouth-in, and timeline/finish drops a
;; do not need one: they are stencilled by :mouth-in, and symbol/finish drops a
;; node whose stencil drew nothing. So the coupling is real, and it is the
;; stencil rule rather than the mask that enforces it. The rule itself is
;; asserted in timeline-test; what is pinned here is the wiring that relies on it.
@ -506,7 +506,7 @@
;; Hoisted: the resolver caches its order and reuses its buffers, so the
;; node ids come out before the next frame is asked for.
nodes-at (fn [c]
(let [r (timeline/resolver (face-timeline (:clip c)) (:store c) pal/index-of)]
(let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of)]
(fn [f] (into #{} (map :node) (r f)))))
ref-at (nodes-at ref)
occ-at (nodes-at occ)
@ -542,8 +542,8 @@
det (mapv #(not (contains? gap %)) (range take/frames))
c (freeze/clip (assoc take/params :name "gappy")
{:face-1 (assoc @take/measured :detected det)})
tl (face-timeline (:clip c))
res (timeline/resolver tl (:store c) pal/index-of)]
sym (face-symbol (:clip c))
res (symbol/resolver sym (:store c) pal/index-of)]
(doseq [f [39 40 50 59 60]]
(let [ops (res f)]
(if (contains? gap f)
@ -552,7 +552,7 @@
;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is
;; unchanged across the gap, because hiding and absence are different
;; questions with different answers.
(is (= (mapv #(ch/value-at (get-in (:nodes tl) [:mouth-in :channels [:vis]]) %)
(is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) %)
(range take/frames))
(mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames))))))
@ -602,7 +602,7 @@
shot (fn [f]
(let [r (raster/make W H)
mouth (filter #(= [:face-1 :mouth] (:node %))
((clip/resolver locked @store pal/index-of) f))]
((clip/resolver locked @store pal/index-of :main) f))]
(raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r mouth)
(vec (array-seq (:buf r)))))

View file

@ -4,6 +4,7 @@
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.feature :as feature]
[arthur.domain.palette :as pal]
[arthur.domain.pose :as pose]
[arthur.domain.project :as project]
[arthur.events.footage :as footage]
@ -33,20 +34,20 @@
(delay (assoc (take/build settings @inputs) :source-inputs {:subjects @inputs})))
(defn channel [entry subject node path]
(get-in entry [:clip :timelines subject :nodes node :channels path]))
(defn snapshot [c store f] (ops/snapshot ((clip/resolver c store) f)))
(get-in entry [:clip :symbols subject :nodes node :channels path]))
(defn snapshot [c store f] (ops/snapshot ((clip/resolver c store pal/index-of :main) f)))
(defn by-node [c store f] (into {} (map (juxt :node identity)) (snapshot c store f)))
(deftest subjects-share-local-names-without-sharing-blocks
(let [{:keys [clip store]} @initial
a (get-in clip [:timelines :face-1 :nodes])
b (get-in clip [:timelines :face-2 :nodes])]
a (get-in clip [:symbols :face-1 :nodes])
b (get-in clip [:symbols :face-2 :nodes])]
(is (empty? (clip/problems clip)))
(is (= (set (keys a)) (set (keys b))))
(is (= :head (get-in b [:mouth :parent])))
(is (= :eye-r-in (get-in b [:iris-r :stencil])))
(is (= :mouth (get-in b [:mouth :pose-group])))
(is (= :face-2 (get-in clip [:features :face-2/mouth :timeline])))
(is (= :face-2 (get-in clip [:features :face-2/mouth :symbol])))
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (not= (:store (:dense (get-in a [:head :measured path])))
(:store (:dense (get-in b [:head :measured path]))))))
@ -63,20 +64,20 @@
(deftest one-subjects-edit-and-anchor-do-not-change-its-neighbor
(let [before @initial
at [:clip :timelines :face-2 :nodes :iris-r :channels [:style :color]]
at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]]
before (assoc-in before at (ch/framed :brow))
after (regenerate/change before {:scope :feature :id :face-2/eye-r
:knob :gaze-gain :value 2})
anchored (freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 12}} after)]
(is (= (get-in before at) (get-in after at)) "authored channels survive regeneration")
(is (= (get-in before [:clip :timelines :face-1])
(get-in after [:clip :timelines :face-1])
(get-in anchored [:timelines :face-1])))
(is (= (get-in before [:clip :symbols :face-1])
(get-in after [:clip :symbols :face-1])
(get-in anchored [:symbols :face-1])))
(is (not= (channel before :face-2 :iris-r [:xform :pos])
(channel after :face-2 :iris-r [:xform :pos])))
(is (= (channel before :face-2 :iris-l [:xform :pos])
(channel after :face-2 :iris-l [:xform :pos])))
(is (= {0 12} (get-in anchored [:timelines :face-2 :nodes :head :anchors])))
(is (= {0 12} (get-in anchored [:symbols :face-2 :nodes :head :anchors])))
(is (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage
@ -84,11 +85,11 @@
after (regenerate/change before {:scope :subject :id :face-2
:knob :anchor-avg :value 4})
full (take/build (assoc settings :anchor-avg 4) @inputs)]
(is (= (get-in full [:clip :timelines :face-2 :nodes :head :measured])
(get-in after [:clip :timelines :face-2 :nodes :head :measured])))
(doseq [tid [:main :sym/face-8625 :face-1]]
(is (= (get-in before [:clip :timelines tid])
(get-in after [:clip :timelines tid]))))
(is (= (get-in full [:clip :symbols :face-2 :nodes :head :measured])
(get-in after [:clip :symbols :face-2 :nodes :head :measured])))
(doseq [sid [:main :sym/face-8625 :face-1]]
(is (= (get-in before [:clip :symbols sid])
(get-in after [:clip :symbols sid]))))
(is (empty? (clip/problems (:clip after))))
(is (thrown? ExceptionInfo
(freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 frames}}
@ -97,7 +98,7 @@
(deftest an-instance-pose-cut-only-holds-that-faces-mouth
(let [{:keys [clip store]} @initial
cut (pose/put-cut clip :face-2 :mouth 0 20)
cut (pose/put-cut clip :main :face-2 :mouth 0 20)
original (by-node clip store 4)
held (by-node cut store 4)
source (by-node clip store 20)]
@ -133,7 +134,7 @@
(let [before (snapshot (:clip entry) (:store entry) f)
after (snapshot (:clip back) (:store back) f)]
(is (seq before))
(is (some #(= [:face-2 :mouth] (second (:node %))) before)))
(is (some #(= [:face-2 :mouth] (rest (:node %))) before)))
(is (= (snapshot (:clip entry) (:store entry) f)
(snapshot (:clip back) (:store back) f))))))
@ -173,12 +174,12 @@
(deftest the-instance-boundary-preserves-the-single-face-geometry
(let [{:keys [clip store]} (take/build settings (select-keys @inputs [:face-1]))
flat (assoc-in clip [:timelines :main :nodes]
(merge (dissoc (clip/nodes clip) :face-1)
(assoc-in (get-in clip [:timelines :face-1 :nodes])
flat (assoc-in clip [:symbols :main :nodes]
(merge (dissoc (:nodes (clip/symbol clip :main)) :face-1)
(assoc-in (get-in clip [:symbols :face-1 :nodes])
[:head :parent] :face)))
nested (clip/resolver clip store)
reference (clip/resolver flat store)]
nested (clip/resolver clip store pal/index-of :main)
reference (clip/resolver flat store pal/index-of :main)]
(doseq [f [0 1 7 20 39]]
(let [a (ops/snapshot (nested f)) b (ops/snapshot (reference f))]
(is (= (mapv (comp second :node) a) (mapv :node b)))

View file

@ -33,7 +33,7 @@
{:face-1 @inputs}))
(defn- channel [entry node path]
(get-in entry [:clip :timelines :face-1 :nodes node :channels path]))
(get-in entry [:clip :symbols :face-1 :nodes node :channels path]))
(deftest eye-rebuild-is-confined-to-the-edited-feature
(let [before @initial
@ -45,8 +45,8 @@
(channel after :iris-l [:xform :pos])))
(is (= (channel before :mouth [:geom :pts])
(channel after :mouth [:geom :pts])))
(is (= (get-in before [:clip :timelines :main :nodes :face])
(get-in after [:clip :timelines :main :nodes :face])))
(is (= (get-in before [:clip :symbols :main :nodes :face])
(get-in after [:clip :symbols :main :nodes :face])))
(is (= (channel (full-at {:gaze-gain 2}) :iris-r [:xform :pos])
(channel after :iris-r [:xform :pos])))))
@ -68,8 +68,8 @@
{:scope :feature :id :face-1/mouth :knob :verts :value 10})]
(is (not= (channel before :mouth [:geom :pts])
(channel after :mouth [:geom :pts])))
(is (= (get-in before [:clip :timelines :face-1 :nodes :head])
(get-in after [:clip :timelines :face-1 :nodes :head])))
(is (= (get-in before [:clip :symbols :face-1 :nodes :head])
(get-in after [:clip :symbols :face-1 :nodes :head])))
(is (= (channel before :eye-r [:geom :pts])
(channel after :eye-r [:geom :pts])))
(is (= (channel (full-at {:verts 10}) :mouth [:geom :pts])
@ -80,19 +80,19 @@
after (regenerate/change before
{:scope :subject :id :face-1 :knob :anchor-avg :value 4})
full (full-at {:anchor-avg 4})]
(is (not= (get-in before [:clip :timelines :face-1 :nodes :head :measured])
(get-in after [:clip :timelines :face-1 :nodes :head :measured])))
(is (= (get-in full [:clip :timelines :face-1 :nodes :head :measured])
(get-in after [:clip :timelines :face-1 :nodes :head :measured])))
(is (= (get-in before [:clip :timelines :main :nodes :face])
(get-in after [:clip :timelines :main :nodes :face])))))
(is (not= (get-in before [:clip :symbols :face-1 :nodes :head :measured])
(get-in after [:clip :symbols :face-1 :nodes :head :measured])))
(is (= (get-in full [:clip :symbols :face-1 :nodes :head :measured])
(get-in after [:clip :symbols :face-1 :nodes :head :measured])))
(is (= (get-in before [:clip :symbols :main :nodes :face])
(get-in after [:clip :symbols :main :nodes :face])))))
(deftest contour-edit-does-not-rebuild-head-or-teeth
(let [before @initial
after (regenerate/change before
{:scope :subject :id :face-1 :knob :contour-avg :value 3})]
(is (= (get-in before [:clip :timelines :face-1 :nodes :head])
(get-in after [:clip :timelines :face-1 :nodes :head])))
(is (= (get-in before [:clip :symbols :face-1 :nodes :head])
(get-in after [:clip :symbols :face-1 :nodes :head])))
(is (= (channel before :teeth [:geom :pts])
(channel after :teeth [:geom :pts])))))
@ -215,7 +215,7 @@
"the composed stage keeps the analysis the edit needs")
(is (some? (:source-inputs entry)))
(testing "and the features still say which timeline they live in"
(is (every? #(= :face-1 (:timeline %))
(is (every? #(= :face-1 (:symbol %))
(vals (:features (:clip entry))))))))
(deftest a-stage-edit-plans-the-same-features-as-a-take-edit
@ -238,8 +238,8 @@
(sym-channel after :iris-l [:geom :radius]))
"and only the edited side of it")
(testing "the placements are left exactly as they were"
(is (= (get-in before [:clip :timelines :main :nodes])
(get-in after [:clip :timelines :main :nodes]))))
(is (= (get-in before [:clip :symbols :main :nodes])
(get-in after [:clip :symbols :main :nodes]))))
(testing "and the document is still a document"
(is (empty? (clip/problems (:clip after)))))))
@ -249,8 +249,8 @@
;; successful edit of the drawing.
(let [after (regenerate/change (staged)
{:scope :feature :id :face-1/eye-r :knob :iris-size :value 0.6})
nodes (get-in after [:clip :timelines :main :nodes])
syms (filter (comp #{:symbol} :kind val) nodes)]
nodes (get-in after [:clip :symbols :main :nodes])
syms (filter (comp #{:instance} :kind val) nodes)]
(is (= 7 (count syms)))
(is (every? uuid? (map key syms)))
(doseq [[_ n] (filter (comp #{:audio} :kind val) nodes)]

View file

@ -1,7 +1,7 @@
(ns arthur.support.ops
"Comparing two evaluations of a timeline, frame for frame.
`domain/timeline` has two evaluators on purpose — `eval-frame` is the
`domain/symbol` has two evaluators on purpose — `eval-frame` is the
specification and `resolver` is what playback uses — and timeline-test's central
assertion is that they agree in forward, backward and random frame order.
Step 9 needs the same comparison for a different question: that a document which
@ -13,14 +13,14 @@
scrub, and a copy of this list that forgot 'backward' would test the easy half.
Every entry point takes a TIMELINE, not a clip: what produces ops is a bag of
nodes in a frame space, and a caller with a clip says `(clip/root c)`.
nodes in a frame space, and a caller with a clip says `(clip/symbol c :main)`.
`snapshot` is what makes ops comparable at all: a resolved op carries `:pts` as
a VIEW into a reused buffer, so two ops from different frames can be `=` while
naming the same array, and holding one and then asking for the next frame
changes what the first one says. Reading the points out is what pins the frame."
(:require [arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]))
[arthur.domain.symbol :as symbol]))
(defn points
"An op's points as a vector of [x y], read out of its buffer."
@ -50,13 +50,13 @@
(defn specified
"(fn [f] -> snapshot) through `eval-frame`, the specification."
([tl store] (specified tl store pal/index-of))
([tl store palette]
(fn [f] (snapshot (timeline/eval-frame tl f store palette)))))
([sym store] (specified sym store pal/index-of))
([sym store palette]
(fn [f] (snapshot (symbol/eval-frame sym f store palette)))))
(defn resolved
"(fn [f] -> snapshot) through `resolver`, the playback path."
([tl store] (resolved tl store pal/index-of))
([tl store palette]
(let [res (timeline/resolver tl store palette)]
([sym store] (resolved sym store pal/index-of))
([sym store palette]
(let [res (symbol/resolver sym store palette)]
(fn [f] (snapshot (res f))))))

View file

@ -185,33 +185,90 @@ const PROBE = `(() => {
w: c.width, h: c.height, drawn, tones: [...tones].length, toneSet: [...tones],
cx: drawn ? cx / drawn : null, cy: drawn ? cy / drawn : null,
hash: h >>> 0,
frame: document.querySelector('.readout span')?.textContent ?? '',
selectedClip: [...document.querySelectorAll('.transport .row button')]
.filter((b) => b.classList.contains('on')).map((b) => b.textContent),
frame: document.querySelector('.time .pane-head .dim')?.textContent ?? '',
// What the top bar says about the document. The media pool holds the OPEN
// document's library now and no longer names documents at all, so the status
// line is the page's own answer to "what am I looking at".
doc: document.querySelector('.top .status')?.textContent ?? '',
};
})()`;
// The scrubber is the timeline's ruler — there is no range input any more — so a
// seek is a pointer event at the frame's own column. The ruler maps x to
// floor(x / width * frames), and a mark that names one frame sits at its centre,
// so (f + 0.5) lands inside f and nowhere near its neighbours.
//
// The frame count comes off the readout rather than being passed in: the caller
// knows which frame it wants, not how long the clip it is looking at happens to
// be, and reading it here is one place instead of every call site.
const SEEK = (f) => `(() => {
const el = document.querySelector('input.scrub');
// React installs its own value setter on the element, so assigning .value
// directly updates the DOM and not React's idea of it, and onChange never
// fires. The prototype-level setter plus a bubbling 'input' event is what
// React's synthetic onChange actually listens for.
const set = Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set;
set.call(el, '${f}');
el.dispatchEvent(new Event('input', { bubbles: true }));
return el.value;
const read = document.querySelector('.time .pane-head .dim').textContent;
// Split, not a regex: this is inside a template literal, where an escaped
// slash collapses to a bare one and the two together open a line comment that
// eats the rest of the statement. The readout is "12 / 229" and nothing else.
const frames = Number(read.split('/')[1]);
if (!frames) return 'no readout';
const ruler = document.querySelector('.tl-ruler');
const box = ruler.getBoundingClientRect();
ruler.dispatchEvent(new PointerEvent('pointerdown', {
bubbles: true, pointerId: 1,
clientX: box.left + (${f} + 0.5) * box.width / frames,
clientY: box.top + box.height / 2,
}));
ruler.dispatchEvent(new PointerEvent('pointerup', { bubbles: true, pointerId: 1 }));
return document.querySelector('.time .pane-head .dim').textContent;
})()`;
// Everything the page has to say about loading, saving and opening. Read off the
// page rather than out of app-db, for the same reason the playhead is: what the
// page SHOWS is what a person would check.
const STATUS = `[...document.querySelectorAll('.load-status')].map((d) => d.textContent).join(' | ')`;
const STATUS = `[...document.querySelectorAll('.top .status, .pool .pane-body > .dim')]
.map((d) => d.textContent).join(' | ')`;
// Any button on the page, by its own label. The controls are spread across five
// panes now — the transport is in the timeline's header, save and open are in the
// top bar, the clips are rows in the media pool — and a helper that knew which
// pane each one lived in would be a second copy of the layout.
//
// `firstChild` is the label: a media-pool row has a second line in a child span,
// so matching on textContent would never find "take".
const CLICK = (label) => `(() => {
const b = [...document.querySelectorAll('.transport button')]
.find((b) => b.textContent.trim() === ${JSON.stringify(label)});
if (!b) return false;
const b = [...document.querySelectorAll('button')]
.find((b) => (b.firstChild?.textContent ?? '').trim() === ${JSON.stringify(label)});
if (!b || b.disabled) return false;
b.click();
return true;
})()`;
// Documents are behind File -> Open now, not in the media pool: the pool holds
// the OPEN document's library, and a whole project is not a thing you put on a
// stage. So reaching a built-in scene or a saved project is two clicks with a
// turn of the event loop between them, as it is for anybody using the app.
const MENU_OPEN = `(() => {
if (document.querySelector('.menu')) return true;
const b = [...document.querySelectorAll('button')]
.find((b) => b.textContent.trim() === 'open \u25be');
if (!b || b.disabled) return false;
b.click();
return true;
})()`;
// Scoped to `.example`, and it has to be: the local server accumulates a saved
// project called "take" on every run of this suite, so an unscoped match by
// label picks whichever of those sorted first and the fixture is never reached.
const MENU_PICK = (label) => `(() => {
const b = [...document.querySelectorAll('.menu .menu-item.example')]
.find((b) => (b.firstChild?.textContent ?? '').trim() === ${JSON.stringify(label)});
if (!b || b.disabled) return false;
b.click();
return true;
})()`;
// The first row under PROJECTS, which the server orders by -updated: this is
// what "open" meant before there was a list to pick from.
const MENU_PICK_NEWEST = `(() => {
const b = document.querySelector('.menu .menu-item:not(.example)');
if (!b || b.disabled) return false;
b.click();
return true;
})()`;
@ -223,24 +280,61 @@ async function main() {
mkdirSync(OUT, { recursive: true });
const page = await connect();
const fromMenu = async (what) => {
if (!(await page.eval(MENU_OPEN))) return false;
await sleep(150);
return page.eval(what);
};
try {
// Mounted, and painting. Polled rather than waited on a fixed delay: the
// canvas :ref fires after the loop starts, so there genuinely is a window in
// which the page is up and the canvas is blank.
// Mounted. Polled rather than waited on a fixed delay: the canvas :ref fires
// after the loop starts, so there genuinely is a window in which the page is
// up and there is nothing to measure.
//
// It is NOT polled for pixels any more. The app opens on a blank document —
// no clip is loaded until one is asked for — so "the canvas has drawn
// something" is now a thing this suite makes happen rather than a thing it
// waits for.
let probe = null;
for (let i = 0; i < 100; i++) {
probe = await page.eval(PROBE);
if (probe && probe.drawn > 0) break;
if (probe && probe.w) break;
await sleep(100);
}
if (!probe) throw new Error('no canvas.stage on the page — ' +
(page.logs.slice(0, 3).join(' | ') || 'is `shadow-cljs watch app` running?'));
console.log(`\ncanvas ${probe.w}x${probe.h}, clip ${JSON.stringify(probe.selectedClip)}`);
// `/` is the index, and a project is only ever at its own address, so the
// suite signs up, makes one, and opens it — the page's own navigation, so
// this CDP session and its console stay attached.
const home = await page.eval(`(async () => {
const post = (url, body) => fetch(url, {method: 'POST', body: JSON.stringify(body),
headers: {'Content-Type': 'application/json',
'X-CSRFToken': document.cookie.match(/csrftoken=([^;]+)/)[1]}}).then(r => r.json());
await post('/api/signup', {username: 'suite-' + Date.now().toString(36), password: 'password1'});
const made = await post('/api/projects', {name: 'untitled'});
arthur.events.collab.navigate_BANG_(arthur.events.collab.project_path(made.id, made.name));
return location.pathname; })()`);
for (let i = 0; i < 100; i++) {
probe = await page.eval(PROBE);
if (/opened/.test(probe.doc)) break;
await sleep(100);
}
check(probe.selectedClip.includes('take'), 'the take is the clip that opens');
console.log(`\ncanvas ${probe.w}x${probe.h}, ${probe.doc} at ${home}`);
check(probe.drawn === 0 && /opened untitled/.test(probe.doc),
'a new project opens on a blank document',
`${probe.drawn} px drawn — ${probe.doc}`);
check(probe.w === 320 && probe.h === 200, 'the canvas is the stage size',
`${probe.w}x${probe.h}`);
// Everything below is about the frozen take, so open it out of the pool.
check(await fromMenu(MENU_PICK('take')), 'the take opens from the open menu');
for (let i = 0; i < 100; i++) {
probe = await page.eval(PROBE);
if (probe.drawn > 0) break;
await sleep(100);
}
check(probe.drawn > 200, 'the first frame is not blank', `${probe.drawn} px drawn`);
// --- it is a mouth: two tones, one inside the other ---
@ -283,7 +377,7 @@ async function main() {
'as filmed, the head carries the mouth across the stage',
`centroid x spans ${(Math.max(...xs) - Math.min(...xs)).toFixed(1)} px`);
check(await page.eval(CLICK('locked')), 'the locked take is selectable');
check(await fromMenu(MENU_PICK('locked')), 'the locked take is selectable');
await sleep(200);
const locked = [];
for (const f of [0, 40, 80, 120, 160, 200]) {
@ -304,7 +398,7 @@ async function main() {
'and it is still a performance, not a still frame');
// --- it PLAYS, against the audio clock ---
check(await page.eval(CLICK('take')), 'back to the take');
check(await fromMenu(MENU_PICK('take')), 'back to the take');
await sleep(150);
await page.eval(SEEK(0));
await sleep(150);
@ -312,7 +406,7 @@ async function main() {
const during = [];
for (let i = 0; i < 8; i++) { await sleep(180); during.push(await page.eval(PROBE)); }
await page.eval(CLICK('pause'));
// The readout is "frame 12 / 229", so the first run of digits is the
// The readout is "12 / 229", so the first run of digits is the
// playhead. Parsed rather than reached for in app-db on purpose: what the
// page SHOWS is what a person would check, and the readout agreeing with the
// picture is half of what the transport is for.
@ -351,13 +445,14 @@ async function main() {
}
const FRAMES = [0, 10, 28, 80, 160];
check(await page.eval(CLICK('take')), 'back to the take, for the round trip');
check(await fromMenu(MENU_PICK('take')), 'back to the take, for the round trip');
await sleep(150);
const sent = await sample(FRAMES);
check(await page.eval(CLICK('save')), 'save is clickable');
// There is no save: every edit saves itself, and a built-in example opened
// in a project becomes a project of its own at once.
const saved = await statusMatching(/saved r\d+/);
check(saved !== null, 'the document saves', saved ?? (await page.eval(STATUS)));
check(saved !== null, 'the take becomes a saved project by itself', saved ?? (await page.eval(STATUS)));
// Upload count may be zero when the content-addressed blocks already exist
// on this server. The saved clip must still reference them.
const savedBlocks = await page.eval(`(async () => {
@ -368,16 +463,18 @@ async function main() {
check(savedBlocks > 0, 'the saved clip references its tier 2 blocks',
`${savedBlocks} blocks`);
// Again, unchanged. Content addressing means the second save uploads nothing
// and rewrites nothing: this is the assertion that the keys are stable across
// two independent freezes of the same take, and that an unchanged leaf keeps
// its version rather than being rewritten.
check(await page.eval(CLICK('save')), 'save is clickable again');
const resaved = await statusMatching(/saved r\d+ · 0 leaves · 0 blocks/);
check(resaved !== null, 'saving an unchanged document writes nothing',
resaved ?? (await page.eval(STATUS)));
// Unchanged, nothing is written: the project's seq stands still. This is
// the assertion that the keys are stable and a clean document is clean.
const seqOf = `(async () => {
const id = location.pathname.split('/')[2];
return (await fetch('/api/projects/' + id).then(r => r.json())).seq; })()`;
const seqBefore = await page.eval(seqOf);
await sleep(800);
const seqAfter = await page.eval(seqOf);
check(seqBefore === seqAfter, 'an unchanged document writes nothing',
`seq ${seqBefore} -> ${seqAfter}`);
check(await page.eval(CLICK('open')), 'open is clickable');
check(await fromMenu(MENU_PICK_NEWEST), 'open is clickable');
const opened = await statusMatching(/opened /);
check(opened !== null, 'the project opens', opened ?? (await page.eval(STATUS)));
@ -392,8 +489,8 @@ async function main() {
'and the open mouth still has an interior on the far side');
// The reopened clip is not one of the built-ins: this is the document that came
// back from the server, not the one that was in the page all along.
check(!back[0].selectedClip.includes('take'), 'the picture is the reopened document',
JSON.stringify(back[0].selectedClip));
check(/opened /.test(back[0].doc), 'the picture is the reopened document',
back[0].doc);
// Paint through the visible controls. This exercises the SVG pointer path,
// the authored node, the raster preview and the document round trip.
@ -404,10 +501,20 @@ async function main() {
const d = c.getContext('2d').getImageData(25, 20, 1, 1).data;
return [...d];
})()`);
const painted = await page.eval(`(() => {
const button = [...document.querySelectorAll('.paint-tools button')]
.find(b => b.textContent === 'new polygon');
// Arming the tool and clicking the vertices are two evals with a turn of the
// event loop between them, and they have to be: picking the tool dispatches a
// re-frame event, which is queued rather than applied, so a pointerdown in the
// same synchronous block arrives while the tool is still unset and is dropped.
// A person cannot click twice inside one microtask; a test should not either.
const armed = await page.eval(`(() => {
const button = [...document.querySelectorAll('.palette-bar button')]
.find(b => b.textContent === 'polygon');
if (!button) return false;
button.click();
return true;
})()`);
await sleep(100);
const painted = armed && await page.eval(`(() => {
const svg = document.querySelector('.paint-overlay');
const box = svg.getBoundingClientRect();
for (const [x, y] of [[10, 10], [40, 10], [25, 40]]) {
@ -420,8 +527,8 @@ async function main() {
})()`);
await sleep(100);
const finished = await page.eval(`(() => {
const button = [...document.querySelectorAll('.paint-tools button')]
.find(b => b.textContent === 'finish shape');
const button = [...document.querySelectorAll('.palette-bar button')]
.find(b => b.textContent === 'finish');
if (!button || button.disabled) return false;
button.click();
return true;
@ -438,8 +545,8 @@ async function main() {
await page.eval(SEEK(f));
await sleep(100);
check(await page.eval(`(() => {
const button = [...document.querySelectorAll('.paint-tools button')]
.find(b => b.textContent === 'new drawing key');
const button = [...document.querySelectorAll('.params button')]
.find(b => b.textContent === 'drawing key here');
if (!button || button.disabled) return false;
button.click();
return true;
@ -449,7 +556,7 @@ async function main() {
await page.eval(SEEK(8));
await sleep(100);
const tweenSelected = await page.eval(`(() => {
const label = [...document.querySelectorAll('.paint-tools label')]
const label = [...document.querySelectorAll('.params label')]
.find(el => el.textContent.startsWith('key 8 → 16'));
const select = label?.querySelector('select');
if (!select) return false;
@ -459,14 +566,13 @@ async function main() {
})()`);
await sleep(100);
check(tweenSelected && await page.eval(`(() => {
const label = [...document.querySelectorAll('.paint-tools label')]
const label = [...document.querySelectorAll('.params label')]
.find(el => el.textContent.startsWith('key 8 → 16'));
return label?.querySelector('select')?.value === 'linear';
})()`), 'the second drawing gap can be set to tween');
check(await page.eval(CLICK('save')), 'the painted document can be saved');
check((await statusMatching(/saved r\d+ · \d+ leaves/)) !== null,
'the painted shape is saved', await page.eval(STATUS));
check(await page.eval(CLICK('open')), 'the painted document can be reopened');
check((await statusMatching(/saved r\d+/)) !== null,
'the painted shape saves by itself', await page.eval(STATUS));
check(await fromMenu(MENU_PICK_NEWEST), 'the painted document can be reopened');
check((await statusMatching(/opened /)) !== null,
'the painted shape is reopened', await page.eval(STATUS));
await sleep(150);
@ -479,7 +585,7 @@ async function main() {
await page.eval(SEEK(8));
await sleep(100);
check(await page.eval(`(() => {
const label = [...document.querySelectorAll('.paint-tools label')]
const label = [...document.querySelectorAll('.params label')]
.find(el => el.textContent.startsWith('key 8 → 16'));
return label?.querySelector('select')?.value === 'linear';
})()`), 'the per-gap tween setting survives the project round trip');
@ -489,11 +595,11 @@ async function main() {
const stageSource = await page.eval(`fetch('/api/projects/4379f900-bdd2-409b-acf6-32081f8ce01f')
.then(r => r.ok)`);
if (stageSource) {
check(await page.eval(CLICK('stage 8625')), 'the 8625 stage loads');
check(await fromMenu(MENU_PICK('8625 stage study')), 'the 8625 stage loads');
const stageLoaded = await statusMatching(/loaded 8625 stage study/, 160);
check(stageLoaded !== null, 'the 8625 stage is ready', stageLoaded ?? (await page.eval(STATUS)));
const eyeSelected = await page.eval(`(() => {
const select = document.querySelector('.controls select');
const select = document.querySelector('.params .section:last-child select');
// Settings belong to tracked features shared by the stage placements.
const option = [...select.options]
.find(o => o.textContent.trim().endsWith('feature · face-1/eye-r'));
@ -505,8 +611,8 @@ async function main() {
check(eyeSelected, 'a stage instance exposes its tracked right eye');
await sleep(100);
const irisSlider = await page.eval(`(() => {
const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.textContent === 'iris-size');
const row = [...document.querySelectorAll('.params .knob')]
.find(row => row.querySelector('.name')?.textContent === 'iris-size');
if (!row) return null;
// Scrolled into view FIRST, because the click below is dispatched at
// viewport coordinates: a control panel that has grown past the fold
@ -520,7 +626,7 @@ async function main() {
check(irisSlider !== null, 'the stage eye has an iris-size slider');
if (irisSlider) {
check(await page.eval(CLICK('play')), 'the stage starts playing');
const startFrame = await page.eval(`Number(document.querySelector('.readout span').textContent.match(/\\d+/)[0])`);
const startFrame = await page.eval(`Number(document.querySelector('.time .pane-head .dim').textContent.match(/\\d+/)[0])`);
await page.send('Input.dispatchMouseEvent', {
type: 'mousePressed', x: irisSlider.x, y: irisSlider.y, button: 'left', clickCount: 1,
});
@ -532,12 +638,12 @@ async function main() {
check(preview !== null, 'the slider updates the stage preview', preview ?? debug);
check(debug.includes(':face-1/eye-r') && debug.includes('tier 1 only'),
'the panel reports the affected feature and tier', debug);
const endFrame = await page.eval(`Number(document.querySelector('.readout span').textContent.match(/\\d+/)[0])`);
const endFrame = await page.eval(`Number(document.querySelector('.time .pane-head .dim').textContent.match(/\\d+/)[0])`);
check(endFrame > startFrame, 'playback continues during tuning', `${startFrame} -> ${endFrame}`);
await page.eval(CLICK('pause'));
}
const subjectSelected = await page.eval(`(() => {
const select = document.querySelector('.controls select');
const select = document.querySelector('.params .section:last-child select');
const option = [...select.options]
.find(o => o.textContent.includes('subject · face-1'));
if (!option) return false;
@ -549,8 +655,8 @@ async function main() {
if (subjectSelected) {
await sleep(100);
const anchorSlider = await page.eval(`(() => {
const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.textContent === 'anchor-avg');
const row = [...document.querySelectorAll('.params .knob')]
.find(row => row.querySelector('.name')?.textContent === 'anchor-avg');
if (!row) return null;
// Scrolled into view FIRST, because the click below is dispatched at
// viewport coordinates: a control panel that has grown past the fold
@ -586,7 +692,7 @@ async function main() {
}
}
const teethSelected = await page.eval(`(() => {
const select = document.querySelector('.controls select');
const select = document.querySelector('.params .section:last-child select');
const option = [...select.options]
.find(o => o.textContent.trim().endsWith('feature · face-1/teeth'));
if (!option) return false;
@ -598,8 +704,8 @@ async function main() {
if (teethSelected) {
await sleep(100);
const slider = await page.eval(`(() => {
const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.textContent === 'cavity-erode');
const row = [...document.querySelectorAll('.params .knob')]
.find(row => row.querySelector('.name')?.textContent === 'cavity-erode');
if (!row) return null;
// Scrolled into view FIRST, because the click below is dispatched at
// viewport coordinates: a control panel that has grown past the fold
@ -623,10 +729,10 @@ async function main() {
let debug = '';
for (let i = 0; i < 160; i++) {
debug = await page.eval(`document.querySelector('.regeneration-debug')?.textContent ?? ''`);
if (debug.includes('dirty features: [:face-1/teeth]')) break;
if (debug.includes('dirty: [:face-1/teeth]')) break;
await sleep(250);
}
check(debug.includes('dirty features: [:face-1/teeth]'),
check(debug.includes('dirty: [:face-1/teeth]'),
'the pixel setting invalidates only teeth', debug);
const preview = await statusMatching(/preview · unsaved/, 160);
check(preview !== null, 'the teeth edit finishes previewing',
@ -650,7 +756,17 @@ async function main() {
nodeId: root.nodeId, selector: 'input[type=file]',
});
await page.send('DOM.setFileInputFiles', { files: [video], nodeId });
const extracted = await statusMatching(/video extracted/, 160);
// Waited for in the MEDIA POOL rather than in the status line: the row
// appearing under this project's media is the durable evidence, and it is
// what a person would look at.
let extracted = null;
for (let i = 0; i < 160 && extracted === null; i++) {
await sleep(250);
if (await page.eval(`[...document.querySelectorAll('.pool-item')]
.some((b) => (b.querySelector('.text')?.firstChild?.textContent ?? '').trim() === 'browser-upload.mp4')`)) {
extracted = 'listed in the media pool';
}
}
check(extracted !== null, 'the page uploads and extracts a video',
extracted ?? (await page.eval(STATUS)));
const uploadedFootage = await page.eval(`(async () => {

View file

@ -6,7 +6,9 @@
# arthur.domain.leaf. No Pillow either; the one thing the backend needs from a PNG
# is its dimensions, which is a 24-byte header read in clips/blobs.py.
#
# Channels arrives with the websocket consumers, which are out of step 9's scope.
# Channels for the one websocket — presence and broadcast deltas — and daphne to
# serve it; `daphne` in INSTALLED_APPS makes `runserver` the same server.
Django>=5.0,<6.0
gunicorn>=23.0,<24.0
channels>=4.2,<5.0
daphne>=4.1,<5.0
whitenoise>=6.9,<7.0

View file

@ -1,12 +1,25 @@
"""ASGI entry point.
ASGI and not only WSGI because the collaboration design in docs/architecture.md
puts presence and document deltas on a websocket. Those consumers are out of step
9's scope; this is the half of their setup that costs nothing now.
HTTP is Django as usual. The websocket carries presence and the document deltas
the server broadcasts after a write — never writes, which stay on HTTP. See
docs/architecture.md, Collaboration.
"""
import os
from django.core.asgi import get_asgi_application
os.environ.setdefault("DJANGO_SETTINGS_MODULE", "server.settings")
application = get_asgi_application()
django_asgi_app = get_asgi_application()
from channels.auth import AuthMiddlewareStack # noqa: E402
from channels.routing import ProtocolTypeRouter, URLRouter # noqa: E402
from channels.security.websocket import AllowedHostsOriginValidator # noqa: E402
from clips.routing import websocket_urlpatterns # noqa: E402
application = ProtocolTypeRouter({
"http": django_asgi_app,
"websocket": AllowedHostsOriginValidator(
AuthMiddlewareStack(URLRouter(websocket_urlpatterns))
),
})

View file

@ -32,6 +32,9 @@ CSRF_TRUSTED_ORIGINS = [
]
INSTALLED_APPS = [
# First, so `runserver` is daphne's and serves the websocket too.
"daphne",
"channels",
"django.contrib.admin",
"django.contrib.auth",
"django.contrib.contenttypes",
@ -51,6 +54,10 @@ MIDDLEWARE = [
"django.contrib.messages.middleware.MessageMiddleware",
]
# Process-local, like the consumer's ROOMS: one worker. docs/architecture.md
# names the move — Redis — for the day there is a second.
CHANNEL_LAYERS = {"default": {"BACKEND": "channels.layers.InMemoryChannelLayer"}}
ROOT_URLCONF = "server.urls"
WSGI_APPLICATION = "server.wsgi.application"
ASGI_APPLICATION = "server.asgi.application"

Some files were not shown because too many files have changed in this diff Show more